From 7241a22fbf2fd0cf47841a09b19be30171e891f7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 10 Jun 2022 08:58:52 -0400 Subject: [PATCH 001/589] initial commit --- .../CLM51/CMakeLists.txt | 18 + .../CLM51/CNCLM51_Photosynthesis.F90 | 427 + .../CLM51/CNCLM_CNProductsMod.F90 | 137 + .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 1450 +++ .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 1234 +++ .../CLM51/CNCLM_CNVegStateType.F90 | 251 + .../CLM51/CNCLM_CanopyStateType.F90 | 183 + .../CLM51/CNCLM_GridcellType.F90 | 101 + .../CLM51/CNCLM_OzoneBaseMod.F90 | 61 + .../CLM51/CNCLM_PhotoParamsType.F90 | 233 + .../CLM51/CNCLM_PhotosynsType.F90 | 290 + .../CNCLM_SoilBiogeochemCarbonFluxType.F90 | 264 + .../CNCLM_SoilBiogeochemCarbonStateType.F90 | 155 + .../CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 439 + .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 166 + .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 97 + .../CLM51/CNCLM_SoilStateType.F90 | 158 + .../CLM51/CNCLM_SolarAbsorbedType.F90 | 145 + .../CLM51/CNCLM_SurfaceAlbedoType.F90 | 164 + .../CLM51/CNCLM_TemperatureType.F90 | 240 + .../CLM51/CNCLM_VegCarbonStateType.F90 | 521 + .../CLM51/CNCLM_VegNitrogenStateType.F90 | 489 + .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 134 + .../CLM51/CNCLM_WaterFluxBulkType.F90 | 105 + .../CLM51/CNCLM_WaterFluxType.F90 | 180 + .../CLM51/CNCLM_atm2lndType.F90 | 145 + .../CLM51/CNCLM_decompMod.F90 | 46 + .../CLM51/CNCLM_filterMod.F90 | 216 + .../CLM51/CNCLM_pftconMod.F90 | 966 ++ .../CLM51/CNNDynamicsMod.F90 | 441 + .../CLM51/CNSharedParamsMod.F90 | 191 + .../CLM51/CNVegetationFacade.F90 | 1600 ++++ .../CLM51/CN_DriverMod.F90 | 62 + .../CLM51/CN_init_mod.F90 | 162 + .../CLM51/PhotosynthesisMod.F90 | 4978 ++++++++++ .../CLM51/SurfaceAlbedoMod.F90 | 1699 ++++ .../CLM51/SurfaceRadiationMod.F90 | 1025 ++ .../CLM51/clm_time_manager.F90 | 229 + .../CLM51/clm_varcon.F90 | 52 + .../CLM51/clm_varcon_old.F90 | 317 + .../CLM51/clm_varctl.F90 | 60 + .../CLM51/clm_varpar.F90 | 195 + .../CLM51/shr_const_mod.F90 | 24 + .../CLM51/shr_kind_mod.F90 | 21 + .../GEOS_CatchCNCLM51GridComp.F90 | 8374 +++++++++++++++++ 45 files changed, 28445 insertions(+) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotoParamsType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon_old.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_const_mod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_kind_mod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt new file mode 100644 index 000000000..904cd9cbf --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -0,0 +1,18 @@ +esma_set_this () +string (REPLACE GEOScatchCN_GridComp_ "" is_openmp ${this}) + +set (srcs + CNCLM_Photosynthesis.F90 + PhotosynthesisMod.F90 + ) + +esma_add_library (${this} + SRCS ${srcs} + DEPENDENCIES MAPL GEOS_LandShared GEOS_CatchCNShared + TYPE SHARED) +target_include_directories (${this} PUBLIC ${INC_ESMF} ${INC_NETCDF}) + +if (is_openmp) + target_compile_options(${this} PRIVATE ${OpenMP_Fortran_FLAGS}) +endif () + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 new file mode 100644 index 000000000..fd116e84a --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -0,0 +1,427 @@ + module CNCLM_Photosynthesis + + use MAPL_ConstantsMod + use clm_varpar, only : numpft, numrad, num_veg, num_zon + use CNCLM_decompMod, only : bounds_type + use PatchType, only : patch + use clm_varcon only : rair + + use CNCLM_VegNitrogenstateType + use CNCLM_VegCarbonstateType + use CNCLM_atm2lndType + use CNCLM_TemperatureType + use CNCLM_SoilStateType + use CNCLM_pftconMod + use CNCLM_WaterDiagnosticBulkType + use CNCLM_SurfaceAlbedoType + use CNCLM_SolarAbsorbedType + use CNCLM_CanopyStateType + use CNCLM_OzoneBaseMod + use CNCLM_PhotosynsType + use CNCLM_WaterFluxBulkType + use CNCLM_filterMod, only: filter + + implicit none + + private + public catchcn_calc_rc + + contains + +!--------------------------------------------------- + subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & + t10,tm,cond,psis,wet3,bee,capac,fwet,coszen,ityp,& + pardir,pardif,albdir,albdif,dtc,dea,rc,rc_dea,rc_dt,& + laisun_out,laisha_out,psnsun_out,psnsha_out,lmrsun_out,& + lmrsha_out,parabs,btran_out) + + use MAPL_SatVaporMod + + ! INPUTS + integer, intent(in) :: nch ! vector length + + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! catchment vegetation fractions + real, intent(in) :: tc(nch,num_zon) ! canopy temperature (K) + real, intent(in) :: qa(nch,num_zon) ! canopy air specific humidity (kg/kg) + real, intent(in) :: pbot(nch) ! surface pressure (Pa) + real, intent(in) :: co2v(nch) ! atmospheric carbon dioxide concentration + real, intent(in) :: dayl_factor(nch) ! daylength factor (0-1) + real, intent(in) :: t10(nch) ! 10-day "running mean" of the 2 m temperature (K) + real, intent(in) :: tm(nch) ! air temperature at agcm reference height (K) + real, intent(in) :: cond(nch) ! saturated hydraulic conductivity (m/s) + real, intent(in) :: psis(nch) ! saturated matric potential [m] + real, intent(in) :: wet3(nch) ! average soil profile wetness [-] + real, intent(in) :: bee(nch) ! Clapp-Hornberger 'b' [-] + real, intent(in) :: capac(nch) ! interception reservoir capacity [kg m^-2] + real, intent(in) :: fwet(nch) ! fraction of canopy that is wet (0-1) + real, intent(in) :: coszen(nch) ! cosine solar zenith angle + integer, intent(in) :: ityp(nch,num_veg,num_zon) ! canopy vegetation index (PFT) + real, intent(in) :: pardir(nch) ! direct PAR (W/m2) + real, intent(in) :: pardif(nch) ! diffuse PAR (W/m2) + real, intent(in) :: albdir(nch,num_veg,num_zon,numrad) ! direct albedo + real, intent(in) :: albdif(nch,num_veg,num_zon,numrad) ! diffuse albedo + real, intent(in) :: dtc ! canopy temperature perturbation (K) [approx 1:10000] + real, intent(in) :: dea ! vapor pressure perturbation (Pa) [approx 1:10000] + + + ! OUTPUTS + real, dimension(nch,num_zon), intent(out) :: rc ! unperturbed canopy stomatal resistance [s/m] + real, dimension(nch,num_zon), intent(out) :: rc_dea ! canopy stomatal resistance with vapor pressure pertubation [s/m] + real, dimension(nch,num_zon), intent(out) :: rc_dt ! canopy stomatal resistance with canopy temperature pertubation [s/m] + real, dimension(nch,num_veg,num_zon), intent(out) :: laisun_out + real, dimension(nch,num_veg,num_zon), intent(out) :: laisha_out + real, dimension(nch,num_veg,num_zon), intent(out) :: psnsun_out + real, dimension(nch,num_veg,num_zon), intent(out) :: psnsha_out + real, dimension(nch,num_veg,num_zon), intent(out) :: lmrsun_out + real, dimension(nch,num_veg,num_zon), intent(out) :: lmrsha_out + real, dimension(nch,num_veg,num_zon), intent(out) :: parabs + real, dimension(nch,num_veg,num_zon), intent(out) :: btran_out + +! LOCAL + + ! temporary and loop variables + integer :: n, p, pft_num, nv, nc, nz, np + real :: bare, elai_pft, esai_pft, tmp_albgrd_vis,tmp_albgrd_nir,& + tmp_albgri_vis,tmp_albgri_nir + + ! constants and parameters + real :: rair = MAPL_RDRY + real :: extkn = 0.30_r8 ! nitrogen allocation coefficient + integer, parameter :: npft = numpft+1 + + ! local variables for stomatal resistance calculations + real :: rs, rs_dea, rs_dt, rcs, rcs_dea, rcs_dt + real, dimension(nch*NUM_ZON*(numpft+1)) :: laisun, laisha, rssun, rssha + real, dimension(nch*NUM_ZON*(numpft+1)) :: laisun_dea, laisha_dea, rssun_dea, rssha_dea + real, dimension(nch*NUM_ZON*(numpft+1)) :: laisun_dt, laisha_dt, rssun_dt, rssha_dt + + ! local variables to compute Photosynthesis inputs + real, dimension (nch) :: esat_tv ! vapor pressure inside leaf (sat vapor press at tc) (Pa) + real, dimension (nch) :: eair ! vapor pressure of canopy air + real, dimension (nch) :: oair ! Atmospheric O2 partial pressure (Pa) + real, dimension (nch) :: deldT ! d(es)/d(T) + real, dimension (nch) :: cair ! compute CO2 partial pressure + real, dimension (nch) :: rb ! boundary layer resistance (s/m) + real, dimension (nch) :: el ! vapor pressure on leaf surface [pa] + real, dimension (nch) :: qsatl ! leaf specific humidity [kg/kg] + real, dimension (nch) :: qsatldT ! derivative of "qsatl" on "t_veg" + real, dimension (nch) :: qaf ! canopy air humidity [kg/kg] + real, dimension (nch*num_zon*(numpft+1)) :: coszen_clm ! cosine solar zenith angle for next time step in CLM dimensions + + ! local inputs to Photosynthesis in CLM space + real, dimension(nch*NUM_ZON*(numpft+1)) :: esat_tv_clm + real, dimension(nch*NUM_ZON*(numpft+1)) :: eair_clm + real, dimension(nch*NUM_ZON*(numpft+1)) :: cair_clm + real, dimension(nch*NUM_ZON*(numpft+1)) :: oair_clm + real, dimension(nch*NUM_ZON*(numpft+1)) :: rb_clm + real, dimension(nch*NUM_ZON*(numpft+1)) :: dayl_factor_clm + real, dimension(nch*NUM_ZON*(numpft+1)) :: qsatl_clm + real, dimension(nch*NUM_ZON*(numpft+1)) :: qaf_clm + + ! local pointers for Photosynthesis inputs + real, pointer :: leafn(:) ! leaf N (gN/m2) + real, pointer :: froot_carbon(:) ! fine root carbon (gC/m2) [pft] + real, pointer :: croot_carbon(:) ! live coarse root carbon (gC/m2) [pft] + + ! CLM variables + type(bounds_type) :: bounds + type(atm2lnd_type) :: atm2lnd_inst + type(temperature_type) :: temperature_inst + type(soilstate_type) :: soilstate_inst + type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst + type(surfalb_type) :: surfalb_inst + type(solarabs_type) :: solarabs_inst + type(canopystate_type) :: canopystate_inst + type(ozone_base_type) :: ozone_inst + type(photosyns_type) :: photosyns_inst + type(waterfluxbulk_type) :: waterfluxbulk_inst + + ! associate variables + + associate(& + vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & + vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & + f_sun_z => surfalb_inst%fsun_z_patch , & + xl => pftcon%xl , & + rhol => pftcon%rhol , & + taul => pftcon%taul , & + leafn => cnveg_nitrogenstate%leafn_patch , & + froot_carbon => cnveg_carbonstate%frootc_patch , & + croot_carbon => cnveg_carbonstate%liverootc_patch, & + elai => canopystate_inst%elai_patch , & + esai => canopystate_inst%esai_patch , & + ) + +! compute saturation vapor pressure +! --------------------------------- + do n = 1,nch + esat_tv(n) = MAPL_EQsat(tc(n),DQ=deldT(n)) + end do + + ! compute canopy air vapor pressure + !---------------------------------- + eair(:) = pbot(:) * qa(:) / (0.622 + qa(:)) ! canopy air vapor pressure (Pa); jk: this is different from the formulation in the CLM code, which is different from the formulation in the CLM documentation + + ! compute atmospheric O2 partial pressure + !----------------------------------------- + oair(:) = 0.20946*pbot + + ! compute CO2 partial pressure constant ratio [internal leaf CO2 partial pressure] + !------------------------------- + cair(:) = co2v(:)*pbot + + ! leaf boundary layer resistance + !-------------------------------- + rb = 10. ! jk: in the original Catchment-CN this was arbitrarily set to 10 by gkw, not sure why + + ! leaf specific humidity + !------------------------ + do n = 1,nch + call QSat(tc(n), pbot(n), qsatl(n), & + el(n), & + qsatldT(n)) + end do + + ! canopy air humidity + !-------------------- + qaf = qa + + ! atmospheric pressure and density downscaled to column level + ! vegetation temperature, 2m 10-day running mean temperature, temperature at AGCM ref. height + !------------------------------------------------ + p = 0 + n = 0 + + num_vegsol = 0 + num_novegsol = 0 + + do nc = 1,nch + atm2lnd_inst%forc_solad (nc,1) = pardir(nc) + atm2lnd_inst%forc_solai (nc,1) = pardif(nc) + do nz = 1,num_zon + n = n + 1 + atm2lnd_inst%forc_pbot_downscaled_col (n) = pbot(nc) + atm2lnd_inst%forc_rho_downscaled_col (n) = pbot(nc)-0.378*eair(nc)/(rair*tc(nc)) + + soilstate_inst%hk_sat_col (n) = 1000.*COND(nc) ! saturated hydraulic conductivity mapped to CLM space + ! and converted to [mm/s] + soilstate_inst%hk_l_col (n) = 1000.*COND(nc)*(wet3(nc)^(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space + ! and converted to [mm/s] + soilstate_inst%smp_l_col (n) = 1000.*PSIS(nc)*(wet3(nc)^(-bee(nc))) ! actual soil matric potential mapped to CLM space + ! and converted to [mm] + soilstate_inst%bsw_col (n) = bee(nc) ! Clapp-Hornberger 'b' + soilstate_inst%sucsat_col (n) = 1000.*psis(nc)*(-1) ! minimum soil suction [mm] + + ! compute column level direct and diffuse albedos (vis and nir) from pft level quantities + tmp_albgrd_vis = 0. + tmp_albgrd_nir = 0. + tmp_albgri_vis = 0. + tmp_albgri_nir = 0. + + do nv = 1,num_veg + tmp_albgrd_vis = tmp_albgrd_vis + albdir(nc,nv,nz,1)*fveg(nc,nv,nz) + tmp_albgrd_nir = tmp_albgrd_nir + albdir(nc,nv,nz,2)*fveg(nc,nv,nz) + + tmp_albgri_vis = tmp_albgri_vis + albdif(nc,nv,nz,1)*fveg(nc,nv,nz) + tmp_albgri_nir = tmp_albgri_nir + albdif(nc,nv,nz,2)*fveg(nc,nv,nz) + end do + + surfalb_inst%albgrd_col (n,1) = tmp_albgrd_vis + surfalb_inst%albgrd_col (n,2) = tmp_albgrd_nir + surfalb_inst%albgri_col (n,1) = tmp_albgri_vis + surfalb_inst%albgri_col (n,2) = tmp_albgri_nir + + do np = 0,numpft + p = p + 1 + + ! initialize temperature_inst here and not in its own F90 file, because values of tc, t10, and tm are computed in GridComp + temperature_inst%t_veg_patch(p) = tc(nc,nz) + temperature_inst%t_a10_patch(p) = t10(nc) + temperature_inst%thm_patch(p) = tm(nc) + + soilstate_inst%rootfr_patch(p,1) = 0. + + ! map Photosynthesis inputs to CLM space + esat_tv_clm (p) = esat_tv(nc) + oair_clm (p) = oair(nc) + cair_clm (p) = cair(nc) + rb_clm (p) = rb(nc) + qsatl_clm (p) = qsatl(nc) + qaf_clm (p) = qaf(nc) + dayl_factor_clm(p) = dayl_factor(nc) + coszen_clm (p) = coszen(nc) + + ! compute canopy air vapor pressure (in CLM space) + eair_ clm (p) = pbot(nc) * qa(nc,nz) / (0.622 + qa(nc,nz)) + + do nv = 1,num_veg + if (ityp(nc,nv,nz).eq.np) then + elai_pft = elai(nc,nv,nz) + esai_pft = esai(nc,nv,nz) + + if (fveg(nc,nv,nz).gt.1.e-4) then + soilstate_inst%rootfr_patch(p,1) = 1.0 ! jkolassa: since we only use one soil layer, we are setting rootfr to 1 for all vegetated areas; ! if we ever introduce more soil layers, CTSM5.1 offers different options for the root distribution + + end if + end if + end do ! nv + + if (coszen_clm(p)>0. .and. (elai_pft + esai_pft)>0.) then + ! calculate solar vegetated filter + num_vegsol = num_vegsol + 1 + filter_vegsol(num_vegsol) = p + + ! calculate rho (weighted reflectance) and tau (weighted transmittance) needed for call to TwoStream later + wl = elai_pft / max( elai_pft+esai_pft, 1.e-06_r8 ) + ws = esai_pft / max( elai_pft+esai_pft, 1.e-06_r8 ) + + do ib = 1, numrad + rho(p,ib) = max( rhol(np,ib)*wl + rhos(np,ib)*ws, 1.e-06_r8 ) + tau(p,ib) = max( taul(np,ib)*wl + taus(np,ib)*ws, 1.e-06_r8 ) + end do + else + num_novegsol = num_novegsol + 1 + filter_novegsol(num_novegsol) = p + end if + + waterstate_inst%fdry_patch(p) = (1-fwet(nc))*elai_pft/(elai_pft+esai_pft) + waterstate_inst%fwet_patch(p) = fwet(nc) + waterstate_inst%fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet + end do + end do + end do + + + ! call TwoStream subroutine which computes surface albedo variables needed for the subsequent calls; + ! jk Jan 2022: In older versions of CatchCN, the calculations were copy and pasted prior to the Photsynthesis calls; + ! In CLM this subroutine is called *after* the canopy flux calculations, but I decided to add it here to + ! have all required inputs on first time step (similar to how it was done in older CatchCN versions) + + call TwoStream(bounds, & + filter_vegsol, num_vegsol, & + coszen, rho, tau, & + canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst) + + ! compute canopy shaded and sunlit variables (jk: needed to fill solarabs_inst before PHS call) + call CanopySunShadeFracs(filter%nourbanp, filter%num_nourbanp, & + atm2lnd_inst, surfalb_inst, & + canopystate_inst, solarabs_inst) + +! jkolassa: Below are three calls to the photosynthesis subroutine, one unperturbed, +! one with perturbed vapor pressure and one with perturbed canopy temperature. +! The unperturbed call is issued last, so that CLM objects have unperturbed values +! going forward. + +! compute resistance with small delta ea + + eair_pert(:) = eair(:) + dea + + call PhotosynthesisHydraulicStress ( bounds, filter%num_exposedvegp, filter%exposedvegp, & + esat_tv, eair_pert, oair, cair, rb, bsun, bsha, btran, dayl_factor, leafn, & + qsatl, qaf, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & + surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & + photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) + + laisun_dea = canopystate_inst%laisun_patch + laisha_dea = canopystate_inst%laisha_patch + rssun_dea = photosyns_inst%rssun_patch + rssha_dea = photosyns_inst%rssha_patch + +! compute resistance with small delta Tc + + temp_unpert = temperature_inst%t_veg_patch + temperature_inst%t_veg_patch = temperature_inst%t_veg_patch + dtc + esat_tv_pert(:) = esat_tv(:) + deldT(:)*dtc + + call PhotosynthesisHydraulicStress ( bounds, fn, filterp, & + esat_tv_pert, eair, oair, cair, rb, bsun, bsha, btran, dayl_factor, leafn, & + qsatl, qaf, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & + surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & + photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) + + laisun_dt = canopystate_inst%laisun_patch + laisha_dt = canopystate_inst%laisha_patch + rssun_dt = photosyns_inst%rssun_patch + rssha_dt = photosyns_inst%rssha_patch + +! compute unperturbed resistance + + temperature_inst%t_veg_patch = temp_unpert ! reset canopy temperature to unperturbed value + + call PhotosynthesisHydraulicStress ( bounds, fn, filterp, & + esat_tv, eair, oair, cair, rb, bsun, bsha, btran, dayl_factor, leafn, & + qsatl, qaf, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & + surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & + photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) + + laisun = canopystate_inst%laisun_patch + laisha = canopystate_inst%laisha_patch + rssun = photosyns_inst%rssun_patch + rssha = photosyns_inst%rssha_patch + + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + + rcs = 0. + rcs_dea = 0. + rcs_dt = 0. + + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + + ! stomatal resistances + rs = laisun(np)/rssun(np) + laisha(np)/rssha(np) + rcs = rcs + fveg(nc,nv,nz)*rs + + rs_dea = laisun_dea(np)/rssun_dea(np) + laisha_dea(np)/rssha_dea(np) + rcs_dea = rcs_dea + fveg(nc,nv,nz)*rs_dea + + rs_dt = laisun_dt(np)/rssun_dt(np) + laisha_dt(np)/rssha_dt(np) + rcs_dt = rcs_dt + fveg(nc,nv,nz)*rs_dt + + ! LAI + laisun_out(nc,nv,nz) = laisun(np) + laisha_out(nc,nv,nz) = laisha(np) + + ! Photosynthesis + psnsun_out(nc,nv,nz) = photosyns_inst%psnsun_patch(np) + psnsha_out(nc,nv,nz) = photosyns_inst%psnsha_patch(np) + + ! Leaf maintenance respiration + lmrsun_out(nc,nv,nz) = photosyns_inst%lmrsun_patch(np) + lmrsha_out(nc,nv,nz) = photosyns_inst%lmrsha_patch(np) + + ! total absorbed PAR + tmp_parsun = 0. + tmp_parsha = 0. + do nl = 1,nlevcan + tmp_parsun = tmp_parsun + solarabs_inst%parsun_z_patch(np,nl) + tmp_parsha = tmp_parsha + solarabs_inst%parsha_z_patch(np,nl) + end do + + parabs(nc,nv,nz) = tmp_parsun * laisun(np) + tmp_parsha * laisha(np) + + ! transpiration wetness factor / water stress + + btran_out(nc,nv,nz) = btran(np) + + end if ! ityp = p + end do !nv + end do ! p + rc(n,nz) = 1./max(rcs,5.e-5) + rb(n) ! rc: unperturbed stomatal resistance (rs is stomatal conductance) + rc_dea(n,nz) = 1./max(rcs_dea,5.e-5) + rb(n) ! rc_dea: stomatal resistance with vapor pressure perturbation + rc_dt(n,nz) = 1./max(rcs_dt,5.e-5) + rb(n) ! rc_dt: stomatal resistance with canopy temperature perturbation + end do ! nz + end do ! nc + + + end subroutine catchcn_calc_rc + +end module CNCLM_Photosynthesis + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 new file mode 100644 index 000000000..dc9c09b9b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -0,0 +1,137 @@ +module CNCLM_CNProductsMod + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ExceptionHandling + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + use clm_varpar , only : num_zon, var_col, cn_zone_weight + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_cn_products_type + + ! !PUBLIC TYPES: + type, public :: cn_products_type + private + ! ------------------------------------------------------------------------ + ! Public instance variables + ! ------------------------------------------------------------------------ + + real(r8), pointer, public :: product_loss_grc(:) ! (g[C or N]/m2/s) total decomposition loss from ALL product pools + real(r8), pointer, public :: cropprod1_grc(:) ! (g[C or N]/m2) crop product pool (grain + biofuel), 1-year lifespan + real(r8), pointer, public :: tot_woodprod_grc(:) ! (g[C or N]/m2) total wood product pool + + ! ------------------------------------------------------------------------ + ! Private instance variables + ! ------------------------------------------------------------------------ + + ! class(species_base_type), allocatable :: species ! C, N, C13, C14, etc. + + ! States + real(r8), pointer :: prod10_grc(:) ! (g[C or N]/m2) wood product pool, 10-year lifespan + real(r8), pointer :: prod100_grc(:) ! (g[C or N]/m2) wood product pool, 100-year lifespan + + ! Fluxes: gains + real(r8), pointer :: dwt_prod10_gain_grc(:) ! (g[C or N]/m2/s) dynamic landcover addition to 10-year wood product pool + real(r8), pointer :: dwt_prod100_gain_grc(:) ! (g[C or N]/m2/s) dynamic landcover addition to 100-year wood product pool + real(r8), pointer :: dwt_woodprod_gain_grc(:) ! (g[C or N]/m2/s) dynamic landcover addition to wood product pools + real(r8), pointer :: dwt_cropprod1_gain_grc(:) ! (g[C or N]/m2/s) dynamic landcover addition to 1-year crop product pool + real(r8), pointer :: hrv_deadstem_to_prod10_patch(:) ! (g[C or N]/m2/s) dead stem harvest to 10-year wood product pool + real(r8), pointer :: hrv_deadstem_to_prod10_grc(:) ! (g[C or N]/m2/s) dead stem harvest to 10-year wood product pool + real(r8), pointer :: hrv_deadstem_to_prod100_patch(:) ! (g[C or N]/m2/s) dead stem harvest to 100-year wood product pool + real(r8), pointer :: hrv_deadstem_to_prod100_grc(:) ! (g[C or N]/m2/s) dead stem harvest to 100-year wood product pool + real(r8), pointer :: grain_to_cropprod1_patch(:) ! (g[C or N]/m2/s) grain to 1-year crop product pool + real(r8), pointer :: grain_to_cropprod1_grc(:) ! (g[C or N]/m2/s) grain to 1-year crop product pool + + ! Fluxes: losses + real(r8), pointer :: cropprod1_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 1-yr crop product pool + real(r8), pointer :: prod10_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 10-yr wood product pool + real(r8), pointer :: prod100_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 100-yr wood product pool + real(r8), pointer :: tot_woodprod_loss_grc(:) ! (g[C or N]/m2/s) decompomposition loss from all wood product pools + + end type cn_products_type + type(cn_products_type), public, target, save :: cn_products_inst + +contains + +!-------------------------------------------------------------- + subroutine init_cn_products_type(bounds, nch, cncol, species, this) + + ! !DESCRIPTION: + ! Initialize CTSM wood products type needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + ! INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array + character(*), intent(in) :: species ! C or N + type(cn_products_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp + integer :: begg, endg + integer :: nc, nz + !--------------------------------- + + begp = bounds%begp ; endp = bounds%endp + begg = bounds%begg ; endg = bounds%endg + + allocate(this%cropprod1_grc(begg:endg)) ; this%cropprod1_grc(:) = nan + allocate(this%prod10_grc(begg:endg)) ; this%prod10_grc(:) = nan + allocate(this%prod100_grc(begg:endg)) ; this%prod100_grc(:) = nan + allocate(this%tot_woodprod_grc(begg:endg)) ; this%tot_woodprod_grc(:) = nan + + allocate(this%dwt_prod10_gain_grc(begg:endg)) ; this%dwt_prod10_gain_grc(:) = nan + allocate(this%dwt_prod100_gain_grc(begg:endg)) ; this%dwt_prod100_gain_grc(:) = nan + allocate(this%dwt_woodprod_gain_grc(begg:endg)) ; this%dwt_woodprod_gain_grc(:) = nan + + allocate(this%dwt_cropprod1_gain_grc(begg:endg)) ; this%dwt_cropprod1_gain_grc(:) = nan + + allocate(this%hrv_deadstem_to_prod10_patch(begp:endp)) ; this%hrv_deadstem_to_prod10_patch(:) = nan + allocate(this%hrv_deadstem_to_prod10_grc(begg:endg)) ; this%hrv_deadstem_to_prod10_grc(:) = nan + + allocate(this%hrv_deadstem_to_prod100_patch(begp:endp)) ; this%hrv_deadstem_to_prod100_patch(:) = nan + allocate(this%hrv_deadstem_to_prod100_grc(begg:endg)) ; this%hrv_deadstem_to_prod100_grc(:) = nan + + allocate(this%grain_to_cropprod1_patch(begp:endp)) ; this%grain_to_cropprod1_patch(:) = nan + allocate(this%grain_to_cropprod1_grc(begg:endg)) ; this%grain_to_cropprod1_grc(:) = nan + + allocate(this%cropprod1_loss_grc(begg:endg)) ; this%cropprod1_loss_grc(:) = nan + allocate(this%prod10_loss_grc(begg:endg)) ; this%prod10_loss_grc(:) = nan + allocate(this%prod100_loss_grc(begg:endg)) ; this%prod100_loss_grc(:) = nan + allocate(this%tot_woodprod_loss_grc(begg:endg)) ; this%tot_woodprod_loss_grc(:) = nan + allocate(this%product_loss_grc(begg:endg)) ; this%product_loss_grc(:) = nan + + + ! initialize variables from restart file or set to cold start value + + do nc = 1,nch ! catchment tile loop + + this%prod100_grc(nc) = 0 + this%prod10_grc(nc) = 0 + + do nz = 1,num_zon ! CN zone loop + + if (trim(species) == 'C') then + this%prod100_grc(nc) = this%prod100_grc(nc) + cncol(nc,nz,7)*CN_zone_weight(nz) + this%prod10_grc(nc) = this%prod10_grc(nc) + cncol(nc,nz,8)*CN_zone_weight(nz) + elseif (trim(species) == 'N') then + this%prod100_grc(nc) = this%prod100_grc(nc) + cncol(nc,nz,21)*CN_zone_weight(nz) + this%prod10_grc(nc) = this%prod10_grc(nc) + cncol(nc,nz,22)*CN_zone_weight(nz) + else + _ASSERT(.FALSE.,'unknown species') + end if + + end do ! nz + end do ! nc + end subroutine init_cn_products_type + +end module CNCLM_CNProductsMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 new file mode 100644 index 000000000..35cd16b7d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -0,0 +1,1450 @@ +module CNCLM_CNVegCarbonFluxType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools,& + nvegcpool,ncphtrans,ncgmtrans,ncfitrans,& + ncphouttrans,ncgmouttrans,ncfiouttrans + use clm_varpar , only : nlevdecomp_full, nlevgrnd,nlevdecomp + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,ioutc + use clm_varpar , only : numpft, num_zon, num_veg, & + var_col, var_pft, CN_zone_weight + use clm_varcon , only : spval + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_cnveg_carbonflux_type + + type, public :: cnveg_carbonflux_type + + ! gap mortality fluxes + real(r8), pointer :: m_leafc_to_litter_patch (:) ! leaf C mortality (gC/m2/s) + real(r8), pointer :: m_leafc_storage_to_litter_patch (:) ! leaf C storage mortality (gC/m2/s) + real(r8), pointer :: m_leafc_xfer_to_litter_patch (:) ! leaf C transfer mortality (gC/m2/s) + real(r8), pointer :: m_frootc_to_litter_patch (:) ! fine root C mortality (gC/m2/s) + real(r8), pointer :: m_frootc_storage_to_litter_patch (:) ! fine root C storage mortality (gC/m2/s) + real(r8), pointer :: m_frootc_xfer_to_litter_patch (:) ! fine root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_to_litter_patch (:) ! live stem C mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_storage_to_litter_patch (:) ! live stem C storage mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_xfer_to_litter_patch (:) ! live stem C transfer mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_to_litter_patch (:) ! dead stem C mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_storage_to_litter_patch (:) ! dead stem C storage mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_xfer_to_litter_patch (:) ! dead stem C transfer mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_to_litter_patch (:) ! live coarse root C mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_storage_to_litter_patch (:) ! live coarse root C storage mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_xfer_to_litter_patch (:) ! live coarse root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_to_litter_patch (:) ! dead coarse root C mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_storage_to_litter_patch (:) ! dead coarse root C storage mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_xfer_to_litter_patch (:) ! dead coarse root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_gresp_storage_to_litter_patch (:) ! growth respiration storage mortality (gC/m2/s) + real(r8), pointer :: m_gresp_xfer_to_litter_patch (:) ! growth respiration transfer mortality (gC/m2/s) + + ! harvest mortality fluxes + real(r8), pointer :: hrv_leafc_to_litter_patch (:) ! leaf C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_leafc_storage_to_litter_patch (:) ! leaf C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_leafc_xfer_to_litter_patch (:) ! leaf C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_to_litter_patch (:) ! fine root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_storage_to_litter_patch (:) ! fine root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_xfer_to_litter_patch (:) ! fine root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_to_litter_patch (:) ! live stem C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_storage_to_litter_patch (:) ! live stem C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_xfer_to_litter_patch (:) ! live stem C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_storage_to_litter_patch (:) ! dead stem C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter_patch (:) ! dead stem C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_to_litter_patch (:) ! live coarse root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_storage_to_litter_patch (:) ! live coarse root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter_patch (:) ! live coarse root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_to_litter_patch (:) ! dead coarse root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter_patch (:) ! dead coarse root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter_patch (:) ! dead coarse root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_gresp_storage_to_litter_patch (:) ! growth respiration storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_gresp_xfer_to_litter_patch (:) ! growth respiration transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_xsmrpool_to_atm_patch (:) ! excess MR pool harvest mortality (gC/m2/s) + + ! fire fluxes + real(r8), pointer :: m_leafc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc + real(r8), pointer :: m_leafc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc_storage + real(r8), pointer :: m_leafc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc_xfer + real(r8), pointer :: m_livestemc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc + real(r8), pointer :: m_livestemc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc_storage + real(r8), pointer :: m_livestemc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc_xfer + real(r8), pointer :: m_deadstemc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_xfer + real(r8), pointer :: m_deadstemc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_storage + real(r8), pointer :: m_deadstemc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_xfer + real(r8), pointer :: m_frootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc + real(r8), pointer :: m_frootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc_storage + real(r8), pointer :: m_frootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc_xfer + real(r8), pointer :: m_livecrootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc + real(r8), pointer :: m_livecrootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc_storage + real(r8), pointer :: m_livecrootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc_xfer + real(r8), pointer :: m_deadcrootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc + real(r8), pointer :: m_deadcrootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc_storage + real(r8), pointer :: m_deadcrootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc_xfer + real(r8), pointer :: m_gresp_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from gresp_storage + real(r8), pointer :: m_gresp_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from gresp_xfer + real(r8), pointer :: m_leafc_to_litter_fire_patch (:) ! (gC/m2/s) from leafc to litter c due to fire + real(r8), pointer :: m_leafc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from leafc_storage to litter C due to fire + real(r8), pointer :: m_leafc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from leafc_xfer to litter C due to fire + real(r8), pointer :: m_livestemc_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc to litter C due to fire + real(r8), pointer :: m_livestemc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc_storage to litter C due to fire + real(r8), pointer :: m_livestemc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc_xfer to litter C due to fire + real(r8), pointer :: m_livestemc_to_deadstemc_fire_patch (:) ! (gC/m2/s) from livestemc to deadstemc due to fire + real(r8), pointer :: m_deadstemc_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc to litter C due to fire + real(r8), pointer :: m_deadstemc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc_storage to litter C due to fire + real(r8), pointer :: m_deadstemc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc_xfer to litter C due to fire + real(r8), pointer :: m_frootc_to_litter_fire_patch (:) ! (gC/m2/s) from frootc to litter C due to fire + real(r8), pointer :: m_frootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from frootc_storage to litter C due to fire + real(r8), pointer :: m_frootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from frootc_xfer to litter C due to fire + real(r8), pointer :: m_livecrootc_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc to litter C due to fire + real(r8), pointer :: m_livecrootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc_storage to litter C due to fire + real(r8), pointer :: m_livecrootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc_xfer to litter C due to fire + real(r8), pointer :: m_livecrootc_to_deadcrootc_fire_patch (:) ! (gC/m2/s) from livecrootc to deadstemc due to fire + real(r8), pointer :: m_deadcrootc_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc to litter C due to fire + real(r8), pointer :: m_deadcrootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc_storage to litter C due to fire + real(r8), pointer :: m_deadcrootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc_xfer to litter C due to fire + real(r8), pointer :: m_gresp_storage_to_litter_fire_patch (:) ! (gC/m2/s) from gresp_storage to litter C due to fire + real(r8), pointer :: m_gresp_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from gresp_xfer to litter C due to fire + + ! phenology fluxes from transfer pools + real(r8), pointer :: grainc_xfer_to_grainc_patch (:) ! grain C growth from storage for prognostic crop(gC/m2/s) + real(r8), pointer :: leafc_xfer_to_leafc_patch (:) ! leaf C growth from storage (gC/m2/s) + real(r8), pointer :: frootc_xfer_to_frootc_patch (:) ! fine root C growth from storage (gC/m2/s) + real(r8), pointer :: livestemc_xfer_to_livestemc_patch (:) ! live stem C growth from storage (gC/m2/s) + real(r8), pointer :: deadstemc_xfer_to_deadstemc_patch (:) ! dead stem C growth from storage (gC/m2/s) + real(r8), pointer :: livecrootc_xfer_to_livecrootc_patch (:) ! live coarse root C growth from storage (gC/m2/s) + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc_patch (:) ! dead coarse root C growth from storage (gC/m2/s) + + ! leaf and fine root litterfall fluxes + real(r8), pointer :: leafc_to_litter_patch (:) ! leaf C litterfall (gC/m2/s) + real(r8), pointer :: leafc_to_litter_fun_patch (:) ! leaf C litterfall used by FUN (gC/m2/s) + real(r8), pointer :: frootc_to_litter_patch (:) ! fine root C litterfall (gC/m2/s) + real(r8), pointer :: livestemc_to_litter_patch (:) ! live stem C litterfall (gC/m2/s) + real(r8), pointer :: grainc_to_food_patch (:) ! grain C to food for prognostic crop(gC/m2/s) + + real(r8), pointer :: leafc_to_biofuelc_patch (:) ! leaf C to biofuel C (gC/m2/s) + real(r8), pointer :: livestemc_to_biofuelc_patch (:) ! livestem C to biofuel C (gC/m2/s) + real(r8), pointer :: grainc_to_seed_patch (:) ! grain C to seed for prognostic crop(gC/m2/s) + + ! maintenance respiration fluxes + real(r8), pointer :: cpool_to_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: cpool_to_leafc_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: cpool_to_leafc_storage_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: cpool_to_frootc_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: cpool_to_frootc_storage_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc_storage_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc_storage_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s) + real(r8), pointer :: leaf_mr_patch (:) ! leaf maintenance respiration (gC/m2/s) + real(r8), pointer :: froot_mr_patch (:) ! fine root maintenance respiration (gC/m2/s) + real(r8), pointer :: livestem_mr_patch (:) ! live stem maintenance respiration (gC/m2/s) + real(r8), pointer :: livecroot_mr_patch (:) ! live coarse root maintenance respiration (gC/m2/s) + real(r8), pointer :: grain_mr_patch (:) ! crop grain or organs maint. respiration (gC/m2/s) + real(r8), pointer :: leaf_curmr_patch (:) ! leaf maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: froot_curmr_patch (:) ! fine root maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: livestem_curmr_patch (:) ! live stem maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: livecroot_curmr_patch (:) ! live coarse root maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: grain_curmr_patch (:) ! crop grain or organs maint. respiration from current GPP (gC/m2/s) + real(r8), pointer :: leaf_xsmr_patch (:) ! leaf maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: froot_xsmr_patch (:) ! fine root maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: livestem_xsmr_patch (:) ! live stem maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: livecroot_xsmr_patch (:) ! live coarse root maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: grain_xsmr_patch (:) ! crop grain or organs maint. respiration from storage (gC/m2/s) + + ! photosynthesis fluxes + real(r8), pointer :: psnsun_to_cpool_patch (:) ! C fixation from sunlit canopy (gC/m2/s) + real(r8), pointer :: psnshade_to_cpool_patch (:) ! C fixation from shaded canopy (gC/m2/s) + + ! allocation fluxes, from current GPP + real(r8), pointer :: cpool_to_xsmrpool_patch (:) ! allocation to maintenance respiration storage pool (gC/m2/s) + real(r8), pointer :: cpool_to_grainc_patch (:) ! allocation to grain C for prognostic crop(gC/m2/s) + real(r8), pointer :: cpool_to_grainc_storage_patch (:) ! allocation to grain C storage for prognostic crop(gC/m2/s) + real(r8), pointer :: cpool_to_leafc_patch (:) ! allocation to leaf C (gC/m2/s) + real(r8), pointer :: cpool_to_leafc_storage_patch (:) ! allocation to leaf C storage (gC/m2/s) + real(r8), pointer :: cpool_to_frootc_patch (:) ! allocation to fine root C (gC/m2/s) + real(r8), pointer :: cpool_to_frootc_storage_patch (:) ! allocation to fine root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc_patch (:) ! allocation to live stem C (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc_storage_patch (:) ! allocation to live stem C storage (gC/m2/s) + real(r8), pointer :: cpool_to_deadstemc_patch (:) ! allocation to dead stem C (gC/m2/s) + real(r8), pointer :: cpool_to_deadstemc_storage_patch (:) ! allocation to dead stem C storage (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc_patch (:) ! allocation to live coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc_storage_patch (:) ! allocation to live coarse root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_deadcrootc_patch (:) ! allocation to dead coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_deadcrootc_storage_patch (:) ! allocation to dead coarse root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_gresp_storage_patch (:) ! allocation to growth respiration storage (gC/m2/s) + + + ! growth respiration fluxes + real(r8), pointer :: xsmrpool_to_atm_patch (:) ! excess MR pool harvest mortality (gC/m2/s) + real(r8), pointer :: xsmrpool_to_atm_col (:) ! excess MR pool harvest mortality (gC/m2/s) (p2c) + real(r8), pointer :: xsmrpool_to_atm_grc (:) ! excess MR pool harvest mortality (gC/m2/s) (p2g) + real(r8), pointer :: cpool_leaf_gr_patch (:) ! leaf growth respiration (gC/m2/s) + real(r8), pointer :: cpool_leaf_storage_gr_patch (:) ! leaf growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_leaf_gr_patch (:) ! leaf growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_froot_gr_patch (:) ! fine root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_froot_storage_gr_patch (:) ! fine root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_froot_gr_patch (:) ! fine root growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_livestem_gr_patch (:) ! live stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livestem_storage_gr_patch (:) ! live stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_livestem_gr_patch (:) ! live stem growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_deadstem_gr_patch (:) ! dead stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_deadstem_storage_gr_patch (:) ! dead stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_deadstem_gr_patch (:) ! dead stem growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_livecroot_gr_patch (:) ! live coarse root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livecroot_storage_gr_patch (:) ! live coarse root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_livecroot_gr_patch (:) ! live coarse root growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_deadcroot_gr_patch (:) ! dead coarse root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_deadcroot_storage_gr_patch (:) ! dead coarse root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_deadcroot_gr_patch (:) ! dead coarse root growth respiration from storage (gC/m2/s) + + ! growth respiration for prognostic crop model + real(r8), pointer :: cpool_grain_gr_patch (:) ! grain growth respiration (gC/m2/s) + real(r8), pointer :: cpool_grain_storage_gr_patch (:) ! grain growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_grain_gr_patch (:) ! grain growth respiration from storage (gC/m2/s) + + ! annual turnover of storage to transfer pools + real(r8), pointer :: grainc_storage_to_xfer_patch (:) ! grain C shift storage to transfer for prognostic crop model (gC/m2/s) + real(r8), pointer :: leafc_storage_to_xfer_patch (:) ! leaf C shift storage to transfer (gC/m2/s) + real(r8), pointer :: frootc_storage_to_xfer_patch (:) ! fine root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: livestemc_storage_to_xfer_patch (:) ! live stem C shift storage to transfer (gC/m2/s) + real(r8), pointer :: deadstemc_storage_to_xfer_patch (:) ! dead stem C shift storage to transfer (gC/m2/s) + real(r8), pointer :: livecrootc_storage_to_xfer_patch (:) ! live coarse root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: deadcrootc_storage_to_xfer_patch (:) ! dead coarse root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: gresp_storage_to_xfer_patch (:) ! growth respiration shift storage to transfer (gC/m2/s) + + ! turnover of livewood to deadwood + real(r8), pointer :: livestemc_to_deadstemc_patch (:) ! live stem C turnover (gC/m2/s) + real(r8), pointer :: livecrootc_to_deadcrootc_patch (:) ! live coarse root C turnover (gC/m2/s) + + ! phenology: litterfall and crop fluxes + real(r8), pointer :: phenology_c_to_litr_met_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gC/m3/s) + real(r8), pointer :: phenology_c_to_litr_cel_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gC/m3/s) + real(r8), pointer :: phenology_c_to_litr_lig_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter lignin pool (gC/m3/s) + + ! gap mortality + real(r8), pointer :: gap_mortality_c_to_litr_met_c_col (:,:) ! C fluxes associated with gap mortality to litter metabolic pool (gC/m3/s) + real(r8), pointer :: gap_mortality_c_to_litr_cel_c_col (:,:) ! C fluxes associated with gap mortality to litter cellulose pool (gC/m3/s) + real(r8), pointer :: gap_mortality_c_to_litr_lig_c_col (:,:) ! C fluxes associated with gap mortality to litter lignin pool (gC/m3/s) + real(r8), pointer :: gap_mortality_c_to_cwdc_col (:,:) ! C fluxes associated with gap mortality to CWD pool (gC/m3/s) + + ! fire + real(r8), pointer :: fire_mortality_c_to_cwdc_col (:,:) ! C fluxes associated with fire mortality to CWD pool (gC/m3/s) + + + ! harvest + real(r8), pointer :: harvest_c_to_litr_met_c_col (:,:) ! C fluxes associated with harvest to litter metabolic pool (gC/m3/s) + real(r8), pointer :: harvest_c_to_litr_cel_c_col (:,:) ! C fluxes associated with harvest to litter cellulose pool (gC/m3/s) + real(r8), pointer :: harvest_c_to_litr_lig_c_col (:,:) ! C fluxes associated with harvest to litter lignin pool (gC/m3/s) + real(r8), pointer :: harvest_c_to_cwdc_col (:,:) ! C fluxes associated with harvest to CWD pool (gC/m3/s) + real(r8), pointer :: grainc_to_cropprodc_patch (:) ! grain C to crop product pool (gC/m2/s) + real(r8), pointer :: grainc_to_cropprodc_col (:) ! grain C to crop product pool (gC/m2/s) + + ! fire fluxes + real(r8), pointer :: m_decomp_cpools_to_fire_vr_col (:,:,:) ! vertically-resolved decomposing C fire loss (gC/m3/s) + real(r8), pointer :: m_decomp_cpools_to_fire_col (:,:) ! vertically-integrated (diagnostic) decomposing C fire loss (gC/m2/s) + real(r8), pointer :: m_c_to_litr_met_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter labile C by fire (gC/m3/s) + real(r8), pointer :: m_c_to_litr_cel_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter cellulose C by fire (gC/m3/s) + real(r8), pointer :: m_c_to_litr_lig_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter lignin C by fire (gC/m3/s) + + ! dynamic landcover fluxes + real(r8), pointer :: dwt_seedc_to_leaf_patch (:) ! (gC/m2/s) seed source to patch-level; although this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_seedc_to_leaf_grc (:) ! (gC/m2/s) dwt_seedc_to_leaf_patch summed to the gridcell-level + real(r8), pointer :: dwt_seedc_to_deadstem_patch (:) ! (gC/m2/s) seed source to patch-level; although this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_seedc_to_deadstem_grc (:) ! (gC/m2/s) dwt_seedc_to_leaf_patch summed to the gridcell-level + real(r8), pointer :: dwt_conv_cflux_patch (:) ! (gC/m2/s) conversion C flux (immediate loss to atm); although this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_conv_cflux_grc (:) ! (gC/m2/s) dwt_conv_cflux_patch summed to the gridcell-level + real(r8), pointer :: dwt_conv_cflux_dribbled_grc (:) ! (gC/m2/s) dwt_conv_cflux_grc dribbled evenly throughout the year + real(r8), pointer :: dwt_wood_productc_gain_patch (:) ! (gC/m2/s) addition to wood product pools from landcover change; although this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_crop_productc_gain_patch (:) ! (gC/m2/s) addition to crop product pools from landcover change; although this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_slash_cflux_patch (:) ! (gC/m2/s) conversion slash flux due to landcover change + real(r8), pointer :: dwt_slash_cflux_grc (:) ! (gC/m2/s) dwt_slash_cflux_patch summed to the gridcell-level + real(r8), pointer :: dwt_frootc_to_litr_met_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootc_to_litr_cel_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootc_to_litr_lig_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_livecrootc_to_cwdc_col (:,:) ! (gC/m3/s) live coarse root to CWD due to landcover change + real(r8), pointer :: dwt_deadcrootc_to_cwdc_col (:,:) ! (gC/m3/s) dead coarse root to CWD due to landcover change + + ! crop fluxes + real(r8), pointer :: crop_seedc_to_leaf_patch (:) ! (gC/m2/s) seed source to leaf, for crops + + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: gpp_before_downreg_patch (:) ! (gC/m2/s) gross primary production before down regulation + real(r8), pointer :: current_gr_patch (:) ! (gC/m2/s) growth resp for new growth displayed in this timestep + real(r8), pointer :: transfer_gr_patch (:) ! (gC/m2/s) growth resp for transfer growth displayed in this timestep + real(r8), pointer :: storage_gr_patch (:) ! (gC/m2/s) growth resp for growth sent to storage for later display + real(r8), pointer :: plant_calloc_patch (:) ! (gC/m2/s) total allocated C flux + real(r8), pointer :: excess_cflux_patch (:) ! (gC/m2/s) C flux not allocated due to downregulation + real(r8), pointer :: prev_leafc_to_litter_patch (:) ! (gC/m2/s) previous timestep leaf C litterfall flux + real(r8), pointer :: prev_frootc_to_litter_patch (:) ! (gC/m2/s) previous timestep froot C litterfall flux + real(r8), pointer :: availc_patch (:) ! (gC/m2/s) C flux available for allocation + real(r8), pointer :: xsmrpool_recover_patch (:) ! (gC/m2/s) C flux assigned to recovery of negative cpool + real(r8), pointer :: xsmrpool_c13ratio_patch (:) ! C13/C(12+13) ratio for xsmrpool (proportion) + + real(r8), pointer :: cwdc_hr_col (:) ! (gC/m2/s) col-level coarse woody debris C heterotrophic respiration + real(r8), pointer :: cwdc_loss_col (:) ! (gC/m2/s) col-level coarse woody debris C loss + real(r8), pointer :: litterc_loss_col (:) ! (gC/m2/s) col-level litter C loss + real(r8), pointer :: frootc_alloc_patch (:) ! (gC/m2/s) patch-level fine root C alloc + real(r8), pointer :: frootc_loss_patch (:) ! (gC/m2/s) patch-level fine root C loss + real(r8), pointer :: leafc_alloc_patch (:) ! (gC/m2/s) patch-level leaf C alloc + real(r8), pointer :: leafc_loss_patch (:) ! (gC/m2/s) patch-level leaf C loss + real(r8), pointer :: woodc_alloc_patch (:) ! (gC/m2/s) patch-level wood C alloc + real(r8), pointer :: woodc_loss_patch (:) ! (gC/m2/s + + + real(r8), pointer :: gpp_patch (:) ! (gC/m2/s) patch gross primary production + real(r8), pointer :: gpp_col (:) ! (gC/m2/s) column GPP flux before downregulation (p2c) + real(r8), pointer :: rr_patch (:) ! (gC/m2/s) root respiration (fine root MR + total root GR) + real(r8), pointer :: rr_col (:) ! (gC/m2/s) root respiration (fine root MR + total root GR) (p2c) + real(r8), pointer :: mr_patch (:) ! (gC/m2/s) maintenance respiration + real(r8), pointer :: gr_patch (:) ! (gC/m2/s) total growth respiration + real(r8), pointer :: ar_patch (:) ! (gC/m2/s) patch autotrophic respiration (MR + GR) + real(r8), pointer :: ar_col (:) ! (gC/m2/s) column autotrophic respiration (MR + GR) (p2c) + real(r8), pointer :: npp_patch (:) ! (gC/m2/s) patch net primary production + real(r8), pointer :: npp_col (:) ! (gC/m2/s) column net primary production (p2c) + real(r8), pointer :: agnpp_patch (:) ! (gC/m2/s) aboveground NPP + real(r8), pointer :: bgnpp_patch (:) ! (gC/m2/s) belowground NPP + real(r8), pointer :: litfall_patch (:) ! (gC/m2/s) patch litterfall (leaves and fine roots) + real(r8), pointer :: wood_harvestc_patch (:) ! (gC/m2/s) patch-level wood harvest (to product pools) + real(r8), pointer :: wood_harvestc_col (:) ! (gC/m2/s) column-level wood harvest (to product pools) (p2c) + real(r8), pointer :: slash_harvestc_patch (:) ! (gC/m2/s) patch-level slash from harvest (to litter) + real(r8), pointer :: cinputs_patch (:) ! (gC/m2/s) patch-level carbon inputs (for balance checking) + real(r8), pointer :: coutputs_patch (:) ! (gC/m2/s) patch-level carbon outputs (for balance checking) + real(r8), pointer :: sr_col (:) ! (gC/m2/s) total soil respiration (HR + root resp) + real(r8), pointer :: er_col (:) ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic + real(r8), pointer :: litfire_col (:) ! (gC/m2/s) litter fire losses + real(r8), pointer :: somfire_col (:) ! (gC/m2/s) soil organic matter fire losses + real(r8), pointer :: totfire_col (:) ! (gC/m2/s) total ecosystem fire losses + real(r8), pointer :: hrv_xsmrpool_to_atm_col (:) ! (gC/m2/s) excess MR pool harvest mortality (p2c) + + ! fire code + real(r8), pointer :: fire_closs_patch (:) ! (gC/m2/s) total fire C loss + real(r8), pointer :: fire_closs_p2c_col (:) ! (gC/m2/s) patch2col averaged column-level fire C loss (p2c) + real(r8), pointer :: fire_closs_col (:) ! (gC/m2/s) total patch-level fire C loss + + + ! temporary and annual sums + real(r8), pointer :: tempsum_litfall_patch (:) ! (gC/m2/yr) temporary annual sum of litfall (CNDV only for now) + real(r8), pointer :: annsum_litfall_patch (:) ! (gC/m2/yr) annual sum of litfall (CNDV only for now) + real(r8), pointer :: tempsum_npp_patch (:) ! (gC/m2/yr) temporary annual sum of NPP + real(r8), pointer :: annsum_npp_patch (:) ! (gC/m2/yr) annual sum of NPP + real(r8), pointer :: annsum_npp_col (:) ! (gC/m2/yr) annual sum of NPP, averaged from patch-level + real(r8), pointer :: lag_npp_col (:) ! (gC/m2/yr) lagged net primary production + + ! Summary C fluxes. + real(r8), pointer :: nep_col (:) ! (gC/m2/s) net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink + real(r8), pointer :: nbp_grc (:) ! (gC/m2/s) net biome production, includes fire, landuse, harvest and hrv_xsmrpool flux, positive for sink (same as net carbon exchange between land and atmosphere) + real(r8), pointer :: nee_grc (:) ! (gC/m2/s) net ecosystem exchange of carbon, includes fire and hrv_xsmrpool, excludes landuse and harvest flux, positive for source + + ! Dynamic landcover fluxnes + real(r8), pointer :: landuseflux_grc(:) ! (gC/m2/s) dwt_conv_cflux+product_closs + real(r8), pointer :: npp_Nactive_patch (:) ! C used by mycorrhizal uptake (gC/m2/s) + real(r8), pointer :: npp_burnedoff_patch (:) ! C that cannot be used for N uptake (gC/m2/s) + real(r8), pointer :: npp_Nnonmyc_patch (:) ! C used by non-myc uptake (gC/m2/s) + real(r8), pointer :: npp_Nam_patch (:) ! C used by AM plant (gC/m2/s) + real(r8), pointer :: npp_Necm_patch (:) ! C used by ECM plant (gC/m2/s) + real(r8), pointer :: npp_Nactive_no3_patch (:) ! C used by mycorrhizal uptake (gC/m2/s) + real(r8), pointer :: npp_Nactive_nh4_patch (:) ! C used by mycorrhizal uptake (gC/m2/s) + real(r8), pointer :: npp_Nnonmyc_no3_patch (:) ! C used by non-myc (gC/m2/s) + real(r8), pointer :: npp_Nnonmyc_nh4_patch (:) ! C used by non-myc (gC/m2/s) + real(r8), pointer :: npp_Nam_no3_patch (:) ! C used by AM plant (gC/m2/s) + real(r8), pointer :: npp_Nam_nh4_patch (:) ! C used by AM plant (gC/m2/s) + real(r8), pointer :: npp_Necm_no3_patch (:) ! C used by ECM plant (gC/m2/s) + real(r8), pointer :: npp_Necm_nh4_patch (:) ! C used by ECM plant (gC/m2/s) + real(r8), pointer :: npp_Nfix_patch (:) ! C used by Symbiotic BNF (gC/m2/s) + real(r8), pointer :: npp_Nretrans_patch (:) ! C used by retranslocation (gC/m2/s) + real(r8), pointer :: npp_Nuptake_patch (:) ! Total C used by N uptake in FUN (gC/m2/s) + real(r8), pointer :: npp_growth_patch (:) ! Total C u for growth in FUN (gC/m2/s) + real(r8), pointer :: leafc_change_patch (:) ! Total used C from leaves (gC/m2/s) + real(r8), pointer :: soilc_change_patch (:) ! Total used C from soil (gC/m2/s) + + ! Matrix for C flux index + real(r8), pointer :: matrix_Cinput_patch (:) ! I-matrix for carbon input + real(r8), pointer :: matrix_C13input_patch (:) ! I-matrix for C13 input + real(r8), pointer :: matrix_C14input_patch (:) ! I-matrix for C14 input + real(r8), pointer :: matrix_alloc_patch (:,:) ! B-matrix for carbon allocation + + real(r8), pointer :: matrix_phtransfer_patch (:,:) ! A-matrix_phenology + real(r8), pointer :: matrix_phturnover_patch (:,:) ! K-matrix_phenology + integer, pointer :: matrix_phtransfer_doner_patch (:) ! A-matrix_phenology non-zero indices (column indices) + integer, pointer :: matrix_phtransfer_receiver_patch (:) ! A-matrix_phenology non-zero indices (row indices) + integer, pointer :: actpatch_fire (:) ! Patch indices with fire in current time step + integer :: num_actpatch_fire ! Number of patches with fire in current time step + + real(r8), pointer :: matrix_gmtransfer_patch (:,:) ! A-matrix_gap mortality + real(r8), pointer :: matrix_gmturnover_patch (:,:) ! K-matrix_gap mortality + integer, pointer :: matrix_gmtransfer_doner_patch (:) ! A-matrix_gap mortality non-zero indices (column indices) + integer, pointer :: matrix_gmtransfer_receiver_patch (:) ! A-matrix_gap mortality non-zero indices (row indices) + + real(r8), pointer :: matrix_fitransfer_patch (:,:) ! A-matrix_fire + real(r8), pointer :: matrix_fiturnover_patch (:,:) ! K-matrix_fire + integer, pointer :: matrix_fitransfer_doner_patch (:) ! A-matrix_fire non-zero indices (column indices) + integer, pointer :: matrix_fitransfer_receiver_patch (:) ! A-matrix_fire non-zero indices (row indices) + +! real(r8), pointer :: soilc_change_col (:) ! Total used C from soil (gC/m2/s) +! matrix variables + integer ileafst_to_ileafxf_ph ! Index of phenology related C transfer from leaf storage pool to leaf transfer pool + integer ileafxf_to_ileaf_ph ! Index of phenology related C transfer from leaf transfer pool to leaf pool + integer ifrootst_to_ifrootxf_ph ! Index of phenology related C transfer from fine root storage pool to fine root transfer pool + integer ifrootxf_to_ifroot_ph ! Index of phenology related C transfer from fine root transfer pool to fine root pool + integer ilivestemst_to_ilivestemxf_ph ! Index of phenology related C transfer from live stem storage pool to live stem transfer pool + integer ilivestemxf_to_ilivestem_ph ! Index of phenology related C transfer from live stem transfer pool to live stem pool + integer ideadstemst_to_ideadstemxf_ph ! Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + integer ideadstemxf_to_ideadstem_ph ! Index of phenology related C transfer from dead stem transfer pool to dead stem pool + integer ilivecrootst_to_ilivecrootxf_ph ! Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + integer ilivecrootxf_to_ilivecroot_ph ! Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + integer ideadcrootst_to_ideadcrootxf_ph ! Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + integer ideadcrootxf_to_ideadcroot_ph ! Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + integer ilivestem_to_ideadstem_ph ! Index of phenology related C transfer from live stem pool to dead stem pool + integer ilivecroot_to_ideadcroot_ph ! Index of phenology related C transfer from live coarse root pool to dead coarse root pool + integer ileaf_to_iout_ph ! Index of phenology related C transfer from leaf pool to outside of vegetation pools + integer ifroot_to_iout_ph ! Index of phenology related C transfer from fine root pool to outside of vegetation pools + integer ilivestem_to_iout_ph ! Index of phenology related C transfer from live stem pool to outside of vegetation pools + integer igrain_to_iout_ph ! Index of phenology related C transfer from grain pool to outside of vegetation pools + integer ileaf_to_iout_gm ! Index of gap mortality related C transfer from leaf pool to outside of vegetation pools + integer ileafst_to_iout_gm ! Index of gap mortality related C transfer from leaf storage pool to outside of vegetation pools + integer ileafxf_to_iout_gm ! Index of gap mortality related C transfer from leaf transfer pool to outside of vegetation pools + integer ifroot_to_iout_gm ! Index of gap mortality related C transfer from fine root pool to outside of vegetation pools + integer ifrootst_to_iout_gm ! Index of gap mortality related C transfer from fine root storage pool to outside of vegetation pools + integer ifrootxf_to_iout_gm ! Index of gap mortality related C transfer from fine root transfer pool to outside of vegetation pools + integer ilivestem_to_iout_gm ! Index of gap mortality related C transfer from live stem pool to outside of vegetation pools + integer ilivestemst_to_iout_gm ! Index of gap mortality related C transfer from live stem storage pool to outside of vegetation pools + integer ilivestemxf_to_iout_gm ! Index of gap mortality related C transfer from live stem transfer pool to outside of vegetation pools + integer ideadstem_to_iout_gm ! Index of gap mortality related C transfer from dead stem pool to outside of vegetation pools + integer ideadstemst_to_iout_gm ! Index of gap mortality related C transfer from dead stem storage pool to outside of vegetation pools + integer ideadstemxf_to_iout_gm ! Index of gap mortality related C transfer from dead stem transfer pool to outside of vegetation pools + integer ilivecroot_to_iout_gm ! Index of gap mortality related C transfer from live coarse root pool to outside of vegetation pools + integer ilivecrootst_to_iout_gm ! Index of gap mortality related C transfer from live coarse root storage pool to outside of vegetation pools + integer ilivecrootxf_to_iout_gm ! Index of gap mortality related C transfer from live coarse root transfer pool to outside of vegetation pools + integer ideadcroot_to_iout_gm ! Index of gap mortality related C transfer from dead coarse root pool to outside of vegetation pools + integer ideadcrootst_to_iout_gm ! Index of gap mortality related C transfer from dead coarse root storage pool to outside of vegetation pools + integer ideadcrootxf_to_iout_gm ! Index of gap mortality related C transfer from dead coarse root transfer pool to outside of vegetation pools + integer ileaf_to_iout_fi ! Index of fire related C transfer from leaf pool to outside of vegetation pools + integer ileafst_to_iout_fi ! Index of fire related C transfer from leaf storage pool to outside of vegetation pools + integer ileafxf_to_iout_fi ! Index of fire related C transfer from leaf transfer pool to outside of vegetation pools + integer ifroot_to_iout_fi ! Index of fire related C transfer from fine root pool to outside of vegetation pools + integer ifrootst_to_iout_fi ! Index of fire related C transfer from fine root storage pool to outside of vegetation pools + integer ifrootxf_to_iout_fi ! Index of fire related C transfer from fine root transfer pool to outside of vegetation pools + integer ilivestem_to_iout_fi ! Index of fire related C transfer from live stem pool to outside of vegetation pools + integer ilivestemst_to_iout_fi ! Index of fire related C transfer from live stem storage pool to outside of vegetation pools + integer ilivestemxf_to_iout_fi ! Index of fire related C transfer from live stem transfer pool to outside of vegetation pools + integer ideadstem_to_iout_fi ! Index of fire related C transfer from dead stem pool to outside of vegetation pools + integer ideadstemst_to_iout_fi ! Index of fire related C transfer from dead stem storage pool to outside of vegetation pools + integer ideadstemxf_to_iout_fi ! Index of fire related C transfer from dead stem transfer pool to outside of vegetation pools + integer ilivecroot_to_iout_fi ! Index of fire related C transfer from live coarse root pool to outside of vegetation pools + integer ilivecrootst_to_iout_fi ! Index of fire related C transfer from live coarse root storage pool to outside of vegetation pools + integer ilivecrootxf_to_iout_fi ! Index of fire related C transfer from live coarse root transfer pool to outside of vegetation pools + integer ideadcroot_to_iout_fi ! Index of fire related C transfer from dead coarse root pool to outside of vegetation pools + integer ideadcrootst_to_iout_fi ! Index of fire related C transfer from dead coarse root storage pool to outside of vegetation pools + integer ideadcrootxf_to_iout_fi ! Index of fire related C transfer from dead coarse root transfer pool to outside of vegetation pools + integer ilivestem_to_ideadstem_fi ! Index of fire related C transfer from live stem pool to dead stem pools + integer ilivecroot_to_ideadcroot_fi ! Index of fire related C transfer from live coarse root pool to dead coarse root pools + + integer,pointer :: list_phc_phgmc (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKphc to AKphc+AKgmc + integer,pointer :: list_gmc_phgmc (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKgmc to AKphc+AKgmc + integer,pointer :: list_phc_phgmfic (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKphc to AKphc+AKgmc+AKfic + integer,pointer :: list_gmc_phgmfic (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKgmc to AKphc+AKgmc+AKfic + integer,pointer :: list_fic_phgmfic (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKfic to AKphc+AKgmc+AKfic + integer,pointer :: list_aphc (:) ! Indices of non-diagnoal entries in full sparse matrix Aph for C cycle + integer,pointer :: list_agmc (:) ! Indices of non-diagnoal entries in full sparse matrix Agm for C cycle + integer,pointer :: list_afic (:) ! Indices of non-diagnoal entries in full sparse matrix Afi for C cycle + + end type cnveg_carbonflux_type + +type(cnveg_carbonflux_type), public, target, save :: cnveg_carbonflux_inst + +contains + +!--------------------------------------- + subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, this) + +! !DESCRIPTION: +! Initialize CTSM carbon fluxes +! jk Apr 2021: type is allocated and initialized to NaN; +! if data arrays from restart file are passed (cncol and cnpft), the type is then initialized with these values +! +! !ARGUMENTS: + implicit none + + ! INPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: ityp ! PFT index + real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart + type(cnveg_carbonflux_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + integer :: np, nc, nz, p, nv, n + !-------------------------------------------------------- + + this%ileafst_to_ileafxf_ph = 1 + this%matrix_phtransfer_doner_patch(this%ileafst_to_ileafxf_ph) = ileaf_st + this%matrix_phtransfer_receiver_patch(this%ileafst_to_ileafxf_ph) = ileaf_xf + + this%ileafxf_to_ileaf_ph = 2 + this%matrix_phtransfer_doner_patch(this%ileafxf_to_ileaf_ph) = ileaf_xf + this%matrix_phtransfer_receiver_patch(this%ileafxf_to_ileaf_ph) = ileaf + + this%ifrootst_to_ifrootxf_ph = 3 + this%matrix_phtransfer_doner_patch(this%ifrootst_to_ifrootxf_ph) = ifroot_st + this%matrix_phtransfer_receiver_patch(this%ifrootst_to_ifrootxf_ph) = ifroot_xf + + this%ifrootxf_to_ifroot_ph = 4 + this%matrix_phtransfer_doner_patch(this%ifrootxf_to_ifroot_ph) = ifroot_xf + this%matrix_phtransfer_receiver_patch(this%ifrootxf_to_ifroot_ph) = ifroot + + this%ilivestem_to_ideadstem_ph = 5 + this%matrix_phtransfer_doner_patch(this%ilivestem_to_ideadstem_ph) = ilivestem + this%matrix_phtransfer_receiver_patch(this%ilivestem_to_ideadstem_ph) = ideadstem + + this%ilivestemst_to_ilivestemxf_ph = 6 + this%matrix_phtransfer_doner_patch(this%ilivestemst_to_ilivestemxf_ph) = ilivestem_st + this%matrix_phtransfer_receiver_patch(this%ilivestemst_to_ilivestemxf_ph) = ilivestem_xf + + this%ilivestemxf_to_ilivestem_ph = 7 + this%matrix_phtransfer_doner_patch(this%ilivestemxf_to_ilivestem_ph) = ilivestem_xf + this%matrix_phtransfer_receiver_patch(this%ilivestemxf_to_ilivestem_ph) = ilivestem + + this%ideadstemst_to_ideadstemxf_ph = 8 + this%matrix_phtransfer_doner_patch(this%ideadstemst_to_ideadstemxf_ph) = ideadstem_st + this%matrix_phtransfer_receiver_patch(this%ideadstemst_to_ideadstemxf_ph) = ideadstem_xf + + this%ideadstemxf_to_ideadstem_ph = 9 + this%matrix_phtransfer_doner_patch(this%ideadstemxf_to_ideadstem_ph) = ideadstem_xf + this%matrix_phtransfer_receiver_patch(this%ideadstemxf_to_ideadstem_ph) = ideadstem + + this%ilivecroot_to_ideadcroot_ph = 10 + this%matrix_phtransfer_doner_patch(this%ilivecroot_to_ideadcroot_ph) = ilivecroot + this%matrix_phtransfer_receiver_patch(this%ilivecroot_to_ideadcroot_ph) = ideadcroot + + this%ilivecrootst_to_ilivecrootxf_ph = 11 + this%matrix_phtransfer_doner_patch(this%ilivecrootst_to_ilivecrootxf_ph) = ilivecroot_st + this%matrix_phtransfer_receiver_patch(this%ilivecrootst_to_ilivecrootxf_ph) = ilivecroot_xf + + this%ilivecrootxf_to_ilivecroot_ph = 12 + this%matrix_phtransfer_doner_patch(this%ilivecrootxf_to_ilivecroot_ph) = ilivecroot_xf + this%matrix_phtransfer_receiver_patch(this%ilivecrootxf_to_ilivecroot_ph) = ilivecroot + + this%ideadcrootst_to_ideadcrootxf_ph = 13 + this%matrix_phtransfer_doner_patch(this%ideadcrootst_to_ideadcrootxf_ph) = ideadcroot_st + this%matrix_phtransfer_receiver_patch(this%ideadcrootst_to_ideadcrootxf_ph) = ideadcroot_xf + + this%ideadcrootxf_to_ideadcroot_ph = 14 + this%matrix_phtransfer_doner_patch(this%ideadcrootxf_to_ideadcroot_ph) = ideadcroot_xf + this%matrix_phtransfer_receiver_patch(this%ideadcrootxf_to_ideadcroot_ph) = ideadcroot + + this%ileaf_to_iout_ph = 15 + this%matrix_phtransfer_doner_patch(this%ileaf_to_iout_ph) = ileaf + this%matrix_phtransfer_receiver_patch(this%ileaf_to_iout_ph) = ioutc + + this%ifroot_to_iout_ph = 16 + this%matrix_phtransfer_doner_patch(this%ifroot_to_iout_ph) = ifroot + this%matrix_phtransfer_receiver_patch(this%ifroot_to_iout_ph) = ioutc + + this%ilivestem_to_iout_ph = 17 + this%matrix_phtransfer_doner_patch(this%ilivestem_to_iout_ph) = ilivestem + this%matrix_phtransfer_receiver_patch(this%ilivestem_to_iout_ph) = ioutc + + if(use_crop)then + this%igrain_to_iout_ph = 18 + this%matrix_phtransfer_doner_patch(this%igrain_to_iout_ph) = igrain + this%matrix_phtransfer_receiver_patch(this%igrain_to_iout_ph) = ioutc + end if + + this%ileaf_to_iout_gm = 1 + this%matrix_gmtransfer_doner_patch(this%ileaf_to_iout_gm) = ileaf + this%matrix_gmtransfer_receiver_patch(this%ileaf_to_iout_gm) = ioutc + + this%ileafst_to_iout_gm = 2 + this%matrix_gmtransfer_doner_patch(this%ileafst_to_iout_gm) = ileaf_st + this%matrix_gmtransfer_receiver_patch(this%ileafst_to_iout_gm) = ioutc + + this%ileafxf_to_iout_gm = 3 + this%matrix_gmtransfer_doner_patch(this%ileafxf_to_iout_gm) = ileaf_xf + this%matrix_gmtransfer_receiver_patch(this%ileafxf_to_iout_gm) = ioutc + + this%ifroot_to_iout_gm = 4 + this%matrix_gmtransfer_doner_patch(this%ifroot_to_iout_gm) = ifroot + this%matrix_gmtransfer_receiver_patch(this%ifroot_to_iout_gm) = ioutc + + this%ifrootst_to_iout_gm = 5 + this%matrix_gmtransfer_doner_patch(this%ifrootst_to_iout_gm) = ifroot_st + this%matrix_gmtransfer_receiver_patch(this%ifrootst_to_iout_gm) = ioutc + + this%ifrootxf_to_iout_gm = 6 + this%matrix_gmtransfer_doner_patch(this%ifrootxf_to_iout_gm) = ifroot_xf + this%matrix_gmtransfer_receiver_patch(this%ifrootxf_to_iout_gm) = ioutc + + this%ilivestem_to_iout_gm = 7 + this%matrix_gmtransfer_doner_patch(this%ilivestem_to_iout_gm) = ilivestem + this%matrix_gmtransfer_receiver_patch(this%ilivestem_to_iout_gm) = ioutc + + this%ilivestemst_to_iout_gm = 8 + this%matrix_gmtransfer_doner_patch(this%ilivestemst_to_iout_gm) = ilivestem_st + this%matrix_gmtransfer_receiver_patch(this%ilivestemst_to_iout_gm) = ioutc + + this%ilivestemxf_to_iout_gm = 9 + this%matrix_gmtransfer_doner_patch(this%ilivestemxf_to_iout_gm) = ilivestem_xf + this%matrix_gmtransfer_receiver_patch(this%ilivestemxf_to_iout_gm) = ioutc + + this%ideadstem_to_iout_gm = 10 + this%matrix_gmtransfer_doner_patch(this%ideadstem_to_iout_gm) = ideadstem + this%matrix_gmtransfer_receiver_patch(this%ideadstem_to_iout_gm) = ioutc + + this%ideadstemst_to_iout_gm = 11 + this%matrix_gmtransfer_doner_patch(this%ideadstemst_to_iout_gm) = ideadstem_st + this%matrix_gmtransfer_receiver_patch(this%ideadstemst_to_iout_gm) = ioutc + + this%ideadstemxf_to_iout_gm = 12 + this%matrix_gmtransfer_doner_patch(this%ideadstemxf_to_iout_gm) = ideadstem_xf + this%matrix_gmtransfer_receiver_patch(this%ideadstemxf_to_iout_gm) = ioutc + + this%ilivecroot_to_iout_gm = 13 + this%matrix_gmtransfer_doner_patch(this%ilivecroot_to_iout_gm) = ilivecroot + this%matrix_gmtransfer_receiver_patch(this%ilivecroot_to_iout_gm) = ioutc + + this%ilivecrootst_to_iout_gm = 14 + this%matrix_gmtransfer_doner_patch(this%ilivecrootst_to_iout_gm) = ilivecroot_st + this%matrix_gmtransfer_receiver_patch(this%ilivecrootst_to_iout_gm) = ioutc + + this%ilivecrootxf_to_iout_gm = 15 + this%matrix_gmtransfer_doner_patch(this%ilivecrootxf_to_iout_gm) = ilivecroot_xf + this%matrix_gmtransfer_receiver_patch(this%ilivecrootxf_to_iout_gm) = ioutc + + this%ideadcroot_to_iout_gm = 16 + this%matrix_gmtransfer_doner_patch(this%ideadcroot_to_iout_gm) = ideadcroot + this%matrix_gmtransfer_receiver_patch(this%ideadcroot_to_iout_gm) = ioutc + + this%ideadcrootst_to_iout_gm = 17 + this%matrix_gmtransfer_doner_patch(this%ideadcrootst_to_iout_gm) = ideadcroot_st + this%matrix_gmtransfer_receiver_patch(this%ideadcrootst_to_iout_gm) = ioutc + + this%ideadcrootxf_to_iout_gm = 18 + this%matrix_gmtransfer_doner_patch(this%ideadcrootxf_to_iout_gm) = ideadcroot_xf + this%matrix_gmtransfer_receiver_patch(this%ideadcrootxf_to_iout_gm) = ioutc + + this%ilivestem_to_ideadstem_fi = 1 + this%matrix_fitransfer_doner_patch(this%ilivestem_to_ideadstem_fi) = ilivestem + this%matrix_fitransfer_receiver_patch(this%ilivestem_to_ideadstem_fi) = ideadstem + + this%ilivecroot_to_ideadcroot_fi = 2 + this%matrix_fitransfer_doner_patch(this%ilivecroot_to_ideadcroot_fi) = ilivecroot + this%matrix_fitransfer_receiver_patch(this%ilivecroot_to_ideadcroot_fi) = ideadcroot + + this%ileaf_to_iout_fi = 3 + this%matrix_fitransfer_doner_patch(this%ileaf_to_iout_fi) = ileaf + this%matrix_fitransfer_receiver_patch(this%ileaf_to_iout_fi) = ioutc + + this%ileafst_to_iout_fi = 4 + this%matrix_fitransfer_doner_patch(this%ileafst_to_iout_fi) = ileaf_st + this%matrix_fitransfer_receiver_patch(this%ileafst_to_iout_fi) = ioutc + + this%ileafxf_to_iout_fi = 5 + this%matrix_fitransfer_doner_patch(this%ileafxf_to_iout_fi) = ileaf_xf + this%matrix_fitransfer_receiver_patch(this%ileafxf_to_iout_fi) = ioutc + + this%ifroot_to_iout_fi = 6 + this%matrix_fitransfer_doner_patch(this%ifroot_to_iout_fi) = ifroot + this%matrix_fitransfer_receiver_patch(this%ifroot_to_iout_fi) = ioutc + + this%ifrootst_to_iout_fi = 7 + this%matrix_fitransfer_doner_patch(this%ifrootst_to_iout_fi) = ifroot_st + this%matrix_fitransfer_receiver_patch(this%ifrootst_to_iout_fi) = ioutc + + this%ifrootxf_to_iout_fi = 8 + this%matrix_fitransfer_doner_patch(this%ifrootxf_to_iout_fi) = ifroot_xf + this%matrix_fitransfer_receiver_patch(this%ifrootxf_to_iout_fi) = ioutc + + this%ilivestem_to_iout_fi = 9 + this%matrix_fitransfer_doner_patch(this%ilivestem_to_iout_fi) = ilivestem + this%matrix_fitransfer_receiver_patch(this%ilivestem_to_iout_fi) = ioutc + + this%ilivestemst_to_iout_fi = 10 + this%matrix_fitransfer_doner_patch(this%ilivestemst_to_iout_fi) = ilivestem_st + this%matrix_fitransfer_receiver_patch(this%ilivestemst_to_iout_fi) = ioutc + + this%ilivestemxf_to_iout_fi = 11 + this%matrix_fitransfer_doner_patch(this%ilivestemxf_to_iout_fi) = ilivestem_xf + this%matrix_fitransfer_receiver_patch(this%ilivestemxf_to_iout_fi) = ioutc + + this%ideadstem_to_iout_fi = 12 + this%matrix_fitransfer_doner_patch(this%ideadstem_to_iout_fi) = ideadstem + this%matrix_fitransfer_receiver_patch(this%ideadstem_to_iout_fi) = ioutc + + this%ideadstemst_to_iout_fi = 13 + this%matrix_fitransfer_doner_patch(this%ideadstemst_to_iout_fi) = ideadstem_st + this%matrix_fitransfer_receiver_patch(this%ideadstemst_to_iout_fi) = ioutc + + this%ideadstemxf_to_iout_fi = 14 + this%matrix_fitransfer_doner_patch(this%ideadstemxf_to_iout_fi) = ideadstem_xf + this%matrix_fitransfer_receiver_patch(this%ideadstemxf_to_iout_fi) = ioutc + + this%ilivecroot_to_iout_fi = 15 + this%matrix_fitransfer_doner_patch(this%ilivecroot_to_iout_fi) = ilivecroot + this%matrix_fitransfer_receiver_patch(this%ilivecroot_to_iout_fi) = ioutc + + this%ilivecrootst_to_iout_fi = 16 + this%matrix_fitransfer_doner_patch(this%ilivecrootst_to_iout_fi) = ilivecroot_st + this%matrix_fitransfer_receiver_patch(this%ilivecrootst_to_iout_fi) = ioutc + + this%ilivecrootxf_to_iout_fi = 17 + this%matrix_fitransfer_doner_patch(this%ilivecrootxf_to_iout_fi) = ilivecroot_xf + this%matrix_fitransfer_receiver_patch(this%ilivecrootxf_to_iout_fi) = ioutc + + this%ideadcroot_to_iout_fi = 18 + this%matrix_fitransfer_doner_patch(this%ideadcroot_to_iout_fi) = ideadcroot + this%matrix_fitransfer_receiver_patch(this%ideadcroot_to_iout_fi) = ioutc + + + this%ideadcrootst_to_iout_fi = 19 + this%matrix_fitransfer_doner_patch(this%ideadcrootst_to_iout_fi) = ideadcroot_st + this%matrix_fitransfer_receiver_patch(this%ideadcrootst_to_iout_fi) = ioutc + + this%ideadcrootxf_to_iout_fi = 20 + this%matrix_fitransfer_doner_patch(this%ideadcrootxf_to_iout_fi) = ideadcroot_xf + this%matrix_fitransfer_receiver_patch(this%ideadcrootxf_to_iout_fi) = ioutc + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + + allocate(this%m_leafc_to_litter_patch (begp:endp)) ; this%m_leafc_to_litter_patch (:) = nan + allocate(this%m_frootc_to_litter_patch (begp:endp)) ; this%m_frootc_to_litter_patch (:) = nan + allocate(this%m_leafc_storage_to_litter_patch (begp:endp)) ; this%m_leafc_storage_to_litter_patch (:) = nan + allocate(this%m_frootc_storage_to_litter_patch (begp:endp)) ; this%m_frootc_storage_to_litter_patch (:) = nan + allocate(this%m_livestemc_storage_to_litter_patch (begp:endp)) ; this%m_livestemc_storage_to_litter_patch (:) = nan + allocate(this%m_deadstemc_storage_to_litter_patch (begp:endp)) ; this%m_deadstemc_storage_to_litter_patch (:) = nan + allocate(this%m_livecrootc_storage_to_litter_patch (begp:endp)) ; this%m_livecrootc_storage_to_litter_patch (:) = nan + allocate(this%m_deadcrootc_storage_to_litter_patch (begp:endp)) ; this%m_deadcrootc_storage_to_litter_patch (:) = nan + allocate(this%m_leafc_xfer_to_litter_patch (begp:endp)) ; this%m_leafc_xfer_to_litter_patch (:) = nan + allocate(this%m_frootc_xfer_to_litter_patch (begp:endp)) ; this%m_frootc_xfer_to_litter_patch (:) = nan + allocate(this%m_livestemc_xfer_to_litter_patch (begp:endp)) ; this%m_livestemc_xfer_to_litter_patch (:) = nan + allocate(this%m_deadstemc_xfer_to_litter_patch (begp:endp)) ; this%m_deadstemc_xfer_to_litter_patch (:) = nan + allocate(this%m_livecrootc_xfer_to_litter_patch (begp:endp)) ; this%m_livecrootc_xfer_to_litter_patch (:) = nan + allocate(this%m_deadcrootc_xfer_to_litter_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_litter_patch (:) = nan + allocate(this%m_livestemc_to_litter_patch (begp:endp)) ; this%m_livestemc_to_litter_patch (:) = nan + allocate(this%m_deadstemc_to_litter_patch (begp:endp)) ; this%m_deadstemc_to_litter_patch (:) = nan + allocate(this%m_livecrootc_to_litter_patch (begp:endp)) ; this%m_livecrootc_to_litter_patch (:) = nan + allocate(this%m_deadcrootc_to_litter_patch (begp:endp)) ; this%m_deadcrootc_to_litter_patch (:) = nan + allocate(this%m_gresp_storage_to_litter_patch (begp:endp)) ; this%m_gresp_storage_to_litter_patch (:) = nan + allocate(this%m_gresp_xfer_to_litter_patch (begp:endp)) ; this%m_gresp_xfer_to_litter_patch (:) = nan + allocate(this%hrv_leafc_to_litter_patch (begp:endp)) ; this%hrv_leafc_to_litter_patch (:) = nan + allocate(this%hrv_leafc_storage_to_litter_patch (begp:endp)) ; this%hrv_leafc_storage_to_litter_patch (:) = nan + allocate(this%hrv_leafc_xfer_to_litter_patch (begp:endp)) ; this%hrv_leafc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_frootc_to_litter_patch (begp:endp)) ; this%hrv_frootc_to_litter_patch (:) = nan + allocate(this%hrv_frootc_storage_to_litter_patch (begp:endp)) ; this%hrv_frootc_storage_to_litter_patch (:) = nan + allocate(this%hrv_frootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_frootc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livestemc_to_litter_patch (begp:endp)) ; this%hrv_livestemc_to_litter_patch (:) = nan + allocate(this%hrv_livestemc_storage_to_litter_patch (begp:endp)) ; this%hrv_livestemc_storage_to_litter_patch (:) = nan + allocate(this%hrv_livestemc_xfer_to_litter_patch (begp:endp)) ; this%hrv_livestemc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_deadstemc_storage_to_litter_patch (begp:endp)) ; this%hrv_deadstemc_storage_to_litter_patch (:) = nan + allocate(this%hrv_deadstemc_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadstemc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livecrootc_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_to_litter_patch (:) = nan + allocate(this%hrv_livecrootc_storage_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_storage_to_litter_patch (:) = nan + allocate(this%hrv_livecrootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootc_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootc_storage_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_storage_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_gresp_storage_to_litter_patch (begp:endp)) ; this%hrv_gresp_storage_to_litter_patch (:) = nan + allocate(this%hrv_gresp_xfer_to_litter_patch (begp:endp)) ; this%hrv_gresp_xfer_to_litter_patch (:) = nan + allocate(this%hrv_xsmrpool_to_atm_patch (begp:endp)) ; this%hrv_xsmrpool_to_atm_patch (:) = 0.0_r8 + allocate(this%m_leafc_to_fire_patch (begp:endp)) ; this%m_leafc_to_fire_patch (:) = nan + allocate(this%m_leafc_storage_to_fire_patch (begp:endp)) ; this%m_leafc_storage_to_fire_patch (:) = nan + allocate(this%m_leafc_xfer_to_fire_patch (begp:endp)) ; this%m_leafc_xfer_to_fire_patch (:) = nan + allocate(this%m_livestemc_to_fire_patch (begp:endp)) ; this%m_livestemc_to_fire_patch (:) = nan + allocate(this%m_livestemc_storage_to_fire_patch (begp:endp)) ; this%m_livestemc_storage_to_fire_patch (:) = nan + allocate(this%m_livestemc_xfer_to_fire_patch (begp:endp)) ; this%m_livestemc_xfer_to_fire_patch (:) = nan + allocate(this%m_deadstemc_to_fire_patch (begp:endp)) ; this%m_deadstemc_to_fire_patch (:) = nan + allocate(this%m_deadstemc_storage_to_fire_patch (begp:endp)) ; this%m_deadstemc_storage_to_fire_patch (:) = nan + allocate(this%m_deadstemc_xfer_to_fire_patch (begp:endp)) ; this%m_deadstemc_xfer_to_fire_patch (:) = nan + allocate(this%m_frootc_to_fire_patch (begp:endp)) ; this%m_frootc_to_fire_patch (:) = nan + allocate(this%m_frootc_storage_to_fire_patch (begp:endp)) ; this%m_frootc_storage_to_fire_patch (:) = nan + allocate(this%m_frootc_xfer_to_fire_patch (begp:endp)) ; this%m_frootc_xfer_to_fire_patch (:) = nan + allocate(this%m_livecrootc_to_fire_patch (begp:endp)) ; this%m_livecrootc_to_fire_patch (:) = nan + allocate(this%m_livecrootc_storage_to_fire_patch (begp:endp)) ; this%m_livecrootc_storage_to_fire_patch (:) = nan + allocate(this%m_livecrootc_xfer_to_fire_patch (begp:endp)) ; this%m_livecrootc_xfer_to_fire_patch (:) = nan + allocate(this%m_deadcrootc_to_fire_patch (begp:endp)) ; this%m_deadcrootc_to_fire_patch (:) = nan + allocate(this%m_deadcrootc_storage_to_fire_patch (begp:endp)) ; this%m_deadcrootc_storage_to_fire_patch (:) = nan + allocate(this%m_deadcrootc_xfer_to_fire_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_fire_patch (:) = nan + allocate(this%m_gresp_storage_to_fire_patch (begp:endp)) ; this%m_gresp_storage_to_fire_patch (:) = nan + allocate(this%m_gresp_xfer_to_fire_patch (begp:endp)) ; this%m_gresp_xfer_to_fire_patch (:) = nan + allocate(this%m_leafc_to_litter_fire_patch (begp:endp)) ; this%m_leafc_to_litter_fire_patch (:) = nan + allocate(this%m_leafc_storage_to_litter_fire_patch (begp:endp)) ; this%m_leafc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_leafc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_leafc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livestemc_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_to_litter_fire_patch (:) = nan + allocate(this%m_livestemc_storage_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_livestemc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livestemc_to_deadstemc_fire_patch (begp:endp)) ; this%m_livestemc_to_deadstemc_fire_patch (:) = nan + allocate(this%m_deadstemc_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_to_litter_fire_patch (:) = nan + allocate(this%m_deadstemc_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_deadstemc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_frootc_to_litter_fire_patch (begp:endp)) ; this%m_frootc_to_litter_fire_patch (:) = nan + allocate(this%m_frootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_frootc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_frootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_frootc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootc_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootc_to_deadcrootc_fire_patch (begp:endp)) ; this%m_livecrootc_to_deadcrootc_fire_patch (:) = nan + allocate(this%m_deadcrootc_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_to_litter_fire_patch (:) = nan + allocate(this%m_deadcrootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_deadcrootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_gresp_storage_to_litter_fire_patch (begp:endp)) ; this%m_gresp_storage_to_litter_fire_patch (:) = nan + allocate(this%m_gresp_xfer_to_litter_fire_patch (begp:endp)) ; this%m_gresp_xfer_to_litter_fire_patch (:) = nan + allocate(this%leafc_xfer_to_leafc_patch (begp:endp)) ; this%leafc_xfer_to_leafc_patch (:) = nan + allocate(this%frootc_xfer_to_frootc_patch (begp:endp)) ; this%frootc_xfer_to_frootc_patch (:) = nan + allocate(this%livestemc_xfer_to_livestemc_patch (begp:endp)) ; this%livestemc_xfer_to_livestemc_patch (:) = nan + allocate(this%deadstemc_xfer_to_deadstemc_patch (begp:endp)) ; this%deadstemc_xfer_to_deadstemc_patch (:) = nan + allocate(this%livecrootc_xfer_to_livecrootc_patch (begp:endp)) ; this%livecrootc_xfer_to_livecrootc_patch (:) = nan + allocate(this%deadcrootc_xfer_to_deadcrootc_patch (begp:endp)) ; this%deadcrootc_xfer_to_deadcrootc_patch (:) = nan + allocate(this%leafc_to_litter_patch (begp:endp)) ; this%leafc_to_litter_patch (:) = nan + allocate(this%leafc_to_litter_fun_patch (begp:endp)) ; this%leafc_to_litter_fun_patch (:) = nan + allocate(this%frootc_to_litter_patch (begp:endp)) ; this%frootc_to_litter_patch (:) = nan + allocate(this%cpool_to_resp_patch (begp:endp)) ; this%cpool_to_resp_patch (:) = nan + allocate(this%cpool_to_leafc_resp_patch (begp:endp)) ; this%cpool_to_leafc_resp_patch (:) = nan + allocate(this%cpool_to_leafc_storage_resp_patch (begp:endp)) ; this%cpool_to_leafc_storage_resp_patch (:) = nan + allocate(this%cpool_to_frootc_resp_patch (begp:endp)) ; this%cpool_to_frootc_resp_patch (:) = nan + allocate(this%cpool_to_frootc_storage_resp_patch (begp:endp)) ; this%cpool_to_frootc_storage_resp_patch (:) = nan + allocate(this%cpool_to_livecrootc_resp_patch (begp:endp)) ; this%cpool_to_livecrootc_resp_patch (:) = nan + allocate(this%cpool_to_livecrootc_storage_resp_patch (begp:endp)) ; this%cpool_to_livecrootc_storage_resp_patch (:) = nan + allocate(this%cpool_to_livestemc_resp_patch (begp:endp)) ; this%cpool_to_livestemc_resp_patch (:) = nan + allocate(this%cpool_to_livestemc_storage_resp_patch (begp:endp)) ; this%cpool_to_livestemc_storage_resp_patch (:) = nan + allocate(this%leaf_mr_patch (begp:endp)) ; this%leaf_mr_patch (:) = nan + allocate(this%froot_mr_patch (begp:endp)) ; this%froot_mr_patch (:) = nan + allocate(this%livestem_mr_patch (begp:endp)) ; this%livestem_mr_patch (:) = nan + allocate(this%livecroot_mr_patch (begp:endp)) ; this%livecroot_mr_patch (:) = nan + allocate(this%grain_mr_patch (begp:endp)) ; this%grain_mr_patch (:) = nan + allocate(this%leaf_curmr_patch (begp:endp)) ; this%leaf_curmr_patch (:) = nan + allocate(this%froot_curmr_patch (begp:endp)) ; this%froot_curmr_patch (:) = nan + allocate(this%livestem_curmr_patch (begp:endp)) ; this%livestem_curmr_patch (:) = nan + allocate(this%livecroot_curmr_patch (begp:endp)) ; this%livecroot_curmr_patch (:) = nan + allocate(this%grain_curmr_patch (begp:endp)) ; this%grain_curmr_patch (:) = nan + allocate(this%leaf_xsmr_patch (begp:endp)) ; this%leaf_xsmr_patch (:) = nan + allocate(this%froot_xsmr_patch (begp:endp)) ; this%froot_xsmr_patch (:) = nan + allocate(this%livestem_xsmr_patch (begp:endp)) ; this%livestem_xsmr_patch (:) = nan + allocate(this%livecroot_xsmr_patch (begp:endp)) ; this%livecroot_xsmr_patch (:) = nan + allocate(this%grain_xsmr_patch (begp:endp)) ; this%grain_xsmr_patch (:) = nan + allocate(this%psnsun_to_cpool_patch (begp:endp)) ; this%psnsun_to_cpool_patch (:) = nan + allocate(this%psnshade_to_cpool_patch (begp:endp)) ; this%psnshade_to_cpool_patch (:) = nan + allocate(this%cpool_to_xsmrpool_patch (begp:endp)) ; this%cpool_to_xsmrpool_patch (:) = nan + allocate(this%cpool_to_leafc_patch (begp:endp)) ; this%cpool_to_leafc_patch (:) = nan + allocate(this%cpool_to_leafc_storage_patch (begp:endp)) ; this%cpool_to_leafc_storage_patch (:) = nan + allocate(this%cpool_to_frootc_patch (begp:endp)) ; this%cpool_to_frootc_patch (:) = nan + allocate(this%cpool_to_frootc_storage_patch (begp:endp)) ; this%cpool_to_frootc_storage_patch (:) = nan + allocate(this%cpool_to_livestemc_patch (begp:endp)) ; this%cpool_to_livestemc_patch (:) = nan + allocate(this%cpool_to_livestemc_storage_patch (begp:endp)) ; this%cpool_to_livestemc_storage_patch (:) = nan + allocate(this%cpool_to_deadstemc_patch (begp:endp)) ; this%cpool_to_deadstemc_patch (:) = nan + allocate(this%cpool_to_deadstemc_storage_patch (begp:endp)) ; this%cpool_to_deadstemc_storage_patch (:) = nan + allocate(this%cpool_to_livecrootc_patch (begp:endp)) ; this%cpool_to_livecrootc_patch (:) = nan + allocate(this%cpool_to_livecrootc_storage_patch (begp:endp)) ; this%cpool_to_livecrootc_storage_patch (:) = nan + allocate(this%cpool_to_deadcrootc_patch (begp:endp)) ; this%cpool_to_deadcrootc_patch (:) = nan + allocate(this%cpool_to_deadcrootc_storage_patch (begp:endp)) ; this%cpool_to_deadcrootc_storage_patch (:) = nan + allocate(this%cpool_to_gresp_storage_patch (begp:endp)) ; this%cpool_to_gresp_storage_patch (:) = nan + allocate(this%cpool_leaf_gr_patch (begp:endp)) ; this%cpool_leaf_gr_patch (:) = nan + allocate(this%cpool_leaf_storage_gr_patch (begp:endp)) ; this%cpool_leaf_storage_gr_patch (:) = nan + allocate(this%transfer_leaf_gr_patch (begp:endp)) ; this%transfer_leaf_gr_patch (:) = nan + allocate(this%cpool_froot_gr_patch (begp:endp)) ; this%cpool_froot_gr_patch (:) = nan + allocate(this%cpool_froot_storage_gr_patch (begp:endp)) ; this%cpool_froot_storage_gr_patch (:) = nan + allocate(this%transfer_froot_gr_patch (begp:endp)) ; this%transfer_froot_gr_patch (:) = nan + allocate(this%cpool_livestem_gr_patch (begp:endp)) ; this%cpool_livestem_gr_patch (:) = nan + allocate(this%cpool_livestem_storage_gr_patch (begp:endp)) ; this%cpool_livestem_storage_gr_patch (:) = nan + allocate(this%transfer_livestem_gr_patch (begp:endp)) ; this%transfer_livestem_gr_patch (:) = nan + allocate(this%cpool_deadstem_gr_patch (begp:endp)) ; this%cpool_deadstem_gr_patch (:) = nan + allocate(this%cpool_deadstem_storage_gr_patch (begp:endp)) ; this%cpool_deadstem_storage_gr_patch (:) = nan + allocate(this%transfer_deadstem_gr_patch (begp:endp)) ; this%transfer_deadstem_gr_patch (:) = nan + allocate(this%cpool_livecroot_gr_patch (begp:endp)) ; this%cpool_livecroot_gr_patch (:) = nan + allocate(this%cpool_livecroot_storage_gr_patch (begp:endp)) ; this%cpool_livecroot_storage_gr_patch (:) = nan + allocate(this%transfer_livecroot_gr_patch (begp:endp)) ; this%transfer_livecroot_gr_patch (:) = nan + allocate(this%cpool_deadcroot_gr_patch (begp:endp)) ; this%cpool_deadcroot_gr_patch (:) = nan + allocate(this%cpool_deadcroot_storage_gr_patch (begp:endp)) ; this%cpool_deadcroot_storage_gr_patch (:) = nan + allocate(this%transfer_deadcroot_gr_patch (begp:endp)) ; this%transfer_deadcroot_gr_patch (:) = nan + allocate(this%leafc_storage_to_xfer_patch (begp:endp)) ; this%leafc_storage_to_xfer_patch (:) = nan + allocate(this%frootc_storage_to_xfer_patch (begp:endp)) ; this%frootc_storage_to_xfer_patch (:) = nan + allocate(this%livestemc_storage_to_xfer_patch (begp:endp)) ; this%livestemc_storage_to_xfer_patch (:) = nan + allocate(this%deadstemc_storage_to_xfer_patch (begp:endp)) ; this%deadstemc_storage_to_xfer_patch (:) = nan + allocate(this%livecrootc_storage_to_xfer_patch (begp:endp)) ; this%livecrootc_storage_to_xfer_patch (:) = nan + allocate(this%deadcrootc_storage_to_xfer_patch (begp:endp)) ; this%deadcrootc_storage_to_xfer_patch (:) = nan + allocate(this%gresp_storage_to_xfer_patch (begp:endp)) ; this%gresp_storage_to_xfer_patch (:) = nan + allocate(this%livestemc_to_deadstemc_patch (begp:endp)) ; this%livestemc_to_deadstemc_patch (:) = nan + allocate(this%livecrootc_to_deadcrootc_patch (begp:endp)) ; this%livecrootc_to_deadcrootc_patch (:) = nan + allocate(this%current_gr_patch (begp:endp)) ; this%current_gr_patch (:) = nan + allocate(this%transfer_gr_patch (begp:endp)) ; this%transfer_gr_patch (:) = nan + allocate(this%storage_gr_patch (begp:endp)) ; this%storage_gr_patch (:) = nan + allocate(this%plant_calloc_patch (begp:endp)) ; this%plant_calloc_patch (:) = nan + allocate(this%excess_cflux_patch (begp:endp)) ; this%excess_cflux_patch (:) = nan + allocate(this%prev_leafc_to_litter_patch (begp:endp)) ; this%prev_leafc_to_litter_patch (:) = nan + allocate(this%prev_frootc_to_litter_patch (begp:endp)) ; this%prev_frootc_to_litter_patch (:) = nan + allocate(this%gpp_before_downreg_patch (begp:endp)) ; this%gpp_before_downreg_patch (:) = nan + allocate(this%availc_patch (begp:endp)) ; this%availc_patch (:) = nan + allocate(this%xsmrpool_recover_patch (begp:endp)) ; this%xsmrpool_recover_patch (:) = nan + allocate(this%xsmrpool_c13ratio_patch (begp:endp)) ; this%xsmrpool_c13ratio_patch (:) = nan + + allocate(this%cpool_to_grainc_patch (begp:endp)) ; this%cpool_to_grainc_patch (:) = nan + allocate(this%cpool_to_grainc_storage_patch (begp:endp)) ; this%cpool_to_grainc_storage_patch (:) = nan + allocate(this%livestemc_to_litter_patch (begp:endp)) ; this%livestemc_to_litter_patch (:) = nan + allocate(this%grainc_to_food_patch (begp:endp)) ; this%grainc_to_food_patch (:) = nan + allocate(this%leafc_to_biofuelc_patch (begp:endp)) ; this%leafc_to_biofuelc_patch (:) = nan + allocate(this%livestemc_to_biofuelc_patch (begp:endp)) ; this%livestemc_to_biofuelc_patch (:) = nan + allocate(this%grainc_to_seed_patch (begp:endp)) ; this%grainc_to_seed_patch (:) = nan + allocate(this%grainc_xfer_to_grainc_patch (begp:endp)) ; this%grainc_xfer_to_grainc_patch (:) = nan + allocate(this%cpool_grain_gr_patch (begp:endp)) ; this%cpool_grain_gr_patch (:) = nan + allocate(this%cpool_grain_storage_gr_patch (begp:endp)) ; this%cpool_grain_storage_gr_patch (:) = nan + allocate(this%transfer_grain_gr_patch (begp:endp)) ; this%transfer_grain_gr_patch (:) = nan + allocate(this%xsmrpool_to_atm_patch (begp:endp)) ; this%xsmrpool_to_atm_patch (:) = 0.0_r8 + allocate(this%xsmrpool_to_atm_col (begc:endc)) ; this%xsmrpool_to_atm_col (:) = 0.0_r8 + allocate(this%xsmrpool_to_atm_grc (begg:endg)) ; this%xsmrpool_to_atm_grc (:) = 0.0_r8 + allocate(this%grainc_storage_to_xfer_patch (begp:endp)) ; this%grainc_storage_to_xfer_patch (:) = nan + allocate(this%frootc_alloc_patch (begp:endp)) ; this%frootc_alloc_patch (:) = nan + allocate(this%frootc_loss_patch (begp:endp)) ; this%frootc_loss_patch (:) = nan + allocate(this%leafc_alloc_patch (begp:endp)) ; this%leafc_alloc_patch (:) = nan + allocate(this%leafc_loss_patch (begp:endp)) ; this%leafc_loss_patch (:) = nan + allocate(this%woodc_alloc_patch (begp:endp)) ; this%woodc_alloc_patch (:) = nan + allocate(this%woodc_loss_patch (begp:endp)) ; this%woodc_loss_patch (:) = nan + + allocate(this%phenology_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); + this%phenology_c_to_litr_met_c_col (:,:)=nan + + allocate(this%phenology_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%phenology_c_to_litr_cel_c_col (:,:)=nan + allocate(this%phenology_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%phenology_c_to_litr_lig_c_col (:,:)=nan + + allocate(this%gap_mortality_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_met_c_col(:,:)=nan + allocate(this%gap_mortality_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_cel_c_col(:,:)=nan + allocate(this%gap_mortality_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_lig_c_col(:,:)=nan + + allocate(this%gap_mortality_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_cwdc_col (:,:)=nan + allocate(this%fire_mortality_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%fire_mortality_c_to_cwdc_col (:,:)=nan + allocate(this%m_c_to_litr_met_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_met_fire_col (:,:)=nan + allocate(this%m_c_to_litr_cel_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_cel_fire_col (:,:)=nan + allocate(this%m_c_to_litr_lig_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_lig_fire_col (:,:)=nan + allocate(this%harvest_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_met_c_col (:,:)=nan + allocate(this%harvest_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_cel_c_col (:,:)=nan + allocate(this%harvest_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_lig_c_col (:,:)=nan + allocate(this%harvest_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_cwdc_col (:,:)=nan + + allocate(this%dwt_slash_cflux_patch (begp:endp)) ; this%dwt_slash_cflux_patch (:) =nan + allocate(this%dwt_slash_cflux_grc (begg:endg)) ; this%dwt_slash_cflux_grc (:) =nan + allocate(this%dwt_frootc_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_met_c_col (:,:)=nan + allocate(this%dwt_frootc_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_cel_c_col (:,:)=nan + allocate(this%dwt_frootc_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_lig_c_col (:,:)=nan + allocate(this%dwt_livecrootc_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%dwt_livecrootc_to_cwdc_col (:,:)=nan + allocate(this%dwt_deadcrootc_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%dwt_deadcrootc_to_cwdc_col (:,:)=nan + + allocate(this%dwt_seedc_to_leaf_patch (begp:endp)) ; this%dwt_seedc_to_leaf_patch (:) =nan + allocate(this%dwt_seedc_to_leaf_grc (begg:endg)) ; this%dwt_seedc_to_leaf_grc (:) =nan + allocate(this%dwt_seedc_to_deadstem_patch (begp:endp)) ; this%dwt_seedc_to_deadstem_patch(:) =nan + allocate(this%dwt_seedc_to_deadstem_grc (begg:endg)) ; this%dwt_seedc_to_deadstem_grc (:) =nan + allocate(this%dwt_conv_cflux_patch (begp:endp)) ; this%dwt_conv_cflux_patch (:) =nan + allocate(this%dwt_conv_cflux_grc (begg:endg)) ; this%dwt_conv_cflux_grc (:) =nan + allocate(this%dwt_conv_cflux_dribbled_grc (begg:endg)) ; this%dwt_conv_cflux_dribbled_grc(:) =nan + allocate(this%dwt_wood_productc_gain_patch (begp:endp)) ; this%dwt_wood_productc_gain_patch(:) =nan + allocate(this%dwt_crop_productc_gain_patch (begp:endp)) ; this%dwt_crop_productc_gain_patch(:) =nan + + allocate(this%crop_seedc_to_leaf_patch (begp:endp)) ; this%crop_seedc_to_leaf_patch (:) =nan + + allocate(this%cwdc_hr_col (begc:endc)) ; this%cwdc_hr_col (:) =nan + allocate(this%cwdc_loss_col (begc:endc)) ; this%cwdc_loss_col (:) =nan + allocate(this%litterc_loss_col (begc:endc)) ; this%litterc_loss_col (:) =nan + + allocate(this%grainc_to_cropprodc_patch(begp:endp)) + this%grainc_to_cropprodc_patch(:) = nan + + allocate(this%grainc_to_cropprodc_col(begc:endc)) + this%grainc_to_cropprodc_col(:) = nan + + allocate(this%m_decomp_cpools_to_fire_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%m_decomp_cpools_to_fire_vr_col(:,:,:)= nan + + allocate(this%m_decomp_cpools_to_fire_col(begc:endc,1:ndecomp_pools)) + this%m_decomp_cpools_to_fire_col(:,:)= nan + + allocate(this%m_decomp_cpools_to_fire_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%m_decomp_cpools_to_fire_vr_col(:,:,:)= nan + + allocate(this%m_decomp_cpools_to_fire_col(begc:endc,1:ndecomp_pools)) + this%m_decomp_cpools_to_fire_col(:,:)= nan + + allocate(this%rr_patch (begp:endp)) ; this%rr_patch (:) = nan + allocate(this%mr_patch (begp:endp)) ; this%mr_patch (:) = nan + allocate(this%gr_patch (begp:endp)) ; this%gr_patch (:) = nan + allocate(this%ar_patch (begp:endp)) ; this%ar_patch (:) = nan + allocate(this%npp_patch (begp:endp)) ; this%npp_patch (:) = nan + allocate(this%agnpp_patch (begp:endp)) ; this%agnpp_patch (:) = nan + allocate(this%bgnpp_patch (begp:endp)) ; this%bgnpp_patch (:) = nan + allocate(this%litfall_patch (begp:endp)) ; this%litfall_patch (:) = nan + allocate(this%wood_harvestc_patch (begp:endp)) ; this%wood_harvestc_patch (:) = nan + allocate(this%slash_harvestc_patch (begp:endp)) ; this%slash_harvestc_patch (:) = nan + allocate(this%cinputs_patch (begp:endp)) ; this%cinputs_patch (:) = nan + allocate(this%coutputs_patch (begp:endp)) ; this%coutputs_patch (:) = nan + allocate(this%gpp_patch (begp:endp)) ; this%gpp_patch (:) = nan + allocate(this%fire_closs_patch (begp:endp)) ; this%fire_closs_patch (:) = nan + allocate(this%sr_col (begc:endc)) ; this%sr_col (:) = nan + allocate(this%er_col (begc:endc)) ; this%er_col (:) = nan + allocate(this%litfire_col (begc:endc)) ; this%litfire_col (:) = nan + allocate(this%somfire_col (begc:endc)) ; this%somfire_col (:) = nan + allocate(this%totfire_col (begc:endc)) ; this%totfire_col (:) = nan + allocate(this%rr_col (begc:endc)) ; this%rr_col (:) = nan + allocate(this%ar_col (begc:endc)) ; this%ar_col (:) = nan + allocate(this%gpp_col (begc:endc)) ; this%gpp_col (:) = nan + allocate(this%npp_col (begc:endc)) ; this%npp_col (:) = nan + allocate(this%fire_closs_p2c_col (begc:endc)) ; this%fire_closs_p2c_col (:) = nan + allocate(this%fire_closs_col (begc:endc)) ; this%fire_closs_col (:) = nan + allocate(this%wood_harvestc_col (begc:endc)) ; this%wood_harvestc_col (:) = nan + allocate(this%hrv_xsmrpool_to_atm_col (begc:endc)) ; this%hrv_xsmrpool_to_atm_col (:) = 0.0_r8 + allocate(this%tempsum_npp_patch (begp:endp)) ; this%tempsum_npp_patch (:) = nan + allocate(this%annsum_npp_patch (begp:endp)) ; this%annsum_npp_patch (:) = nan + allocate(this%tempsum_litfall_patch (begp:endp)) ; this%tempsum_litfall_patch (:) = nan + allocate(this%annsum_litfall_patch (begp:endp)) ; this%annsum_litfall_patch (:) = nan + allocate(this%annsum_npp_col (begc:endc)) ; this%annsum_npp_col (:) = nan + allocate(this%lag_npp_col (begc:endc)) ; this%lag_npp_col (:) = spval + + + allocate(this%nep_col (begc:endc)) ; this%nep_col (:) = nan + allocate(this%nbp_grc (begg:endg)) ; this%nbp_grc (:) = nan + allocate(this%nee_grc (begg:endg)) ; this%nee_grc (:) = nan + allocate(this%landuseflux_grc (begg:endg)) ; this%landuseflux_grc (:) = nan + allocate(this%npp_Nactive_patch (begp:endp)) ; this%npp_Nactive_patch (:) = nan + allocate(this%npp_burnedoff_patch (begp:endp)) ; this%npp_burnedoff_patch (:) = nan + allocate(this%npp_Nnonmyc_patch (begp:endp)) ; this%npp_Nnonmyc_patch (:) = nan + allocate(this%npp_Nam_patch (begp:endp)) ; this%npp_Nam_patch (:) = nan + allocate(this%npp_Necm_patch (begp:endp)) ; this%npp_Necm_patch (:) = nan + allocate(this%npp_Nactive_no3_patch (begp:endp)) ; this%npp_Nactive_no3_patch (:) = nan + allocate(this%npp_Nactive_nh4_patch (begp:endp)) ; this%npp_Nactive_nh4_patch (:) = nan + allocate(this%npp_Nnonmyc_no3_patch (begp:endp)) ; this%npp_Nnonmyc_no3_patch (:) = nan + allocate(this%npp_Nnonmyc_nh4_patch (begp:endp)) ; this%npp_Nnonmyc_nh4_patch (:) = nan + allocate(this%npp_Nam_no3_patch (begp:endp)) ; this%npp_Nam_no3_patch (:) = nan + allocate(this%npp_Nam_nh4_patch (begp:endp)) ; this%npp_Nam_nh4_patch (:) = nan + allocate(this%npp_Necm_no3_patch (begp:endp)) ; this%npp_Necm_no3_patch (:) = nan + allocate(this%npp_Necm_nh4_patch (begp:endp)) ; this%npp_Necm_nh4_patch (:) = nan + allocate(this%npp_Nfix_patch (begp:endp)) ; this%npp_Nfix_patch (:) = nan + allocate(this%npp_Nretrans_patch (begp:endp)) ; this%npp_Nretrans_patch (:) = nan + allocate(this%npp_Nuptake_patch (begp:endp)) ; this%npp_Nuptake_patch (:) = nan + allocate(this%npp_growth_patch (begp:endp)) ; this%npp_growth_patch (:) = nan + allocate(this%leafc_change_patch (begp:endp)) ; this%leafc_change_patch (:) = nan + allocate(this%soilc_change_patch (begp:endp)) ; this%soilc_change_patch (:) = nan + + + ! initialize variables from restart file or set to cold start value + n = 0 + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + n = n + 1 + + this%annsum_npp_col (n) = cncol(nc,nz, 33) + + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + + this%annsum_npp_patch (np) = cnpft(nc,nz,nv, 26) + this%prev_frootc_to_litter_patch (np) = cnpft(nc,nz,nv, 41) + this%prev_leafc_to_litter_patch (np) = cnpft(nc,nz,nv, 42) + this%tempsum_npp_patch (np) = cnpft(nc,nz,nv, 45) + this%xsmrpool_recover_patch (np) = cnpft(nc,nz,nv, 47) + + end if + end do !nv + end do ! p + end do ! nz + end do ! nc + + end subroutine init_cnveg_carbonflux_type + +!----------------------------------------- + + subroutine SetValues ( this, nvegcpool, & + num_patch, filter_patch, value_patch, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set carbon state fluxes + ! + ! !ARGUMENTS: + class (cnveg_carbonflux_type) :: this + integer , intent(in) :: num_patch,nvegcpool + integer , intent(in) :: filter_patch(:) + real(r8), intent(in) :: value_patch + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i ! loop index + integer :: j,k,l ! indices + !------------------------------------------------------------------------ + + + do fi = 1,num_patch + i = filter_patch(fi) + + this%m_leafc_to_litter_patch(i) = value_patch + this%m_frootc_to_litter_patch(i) = value_patch + this%m_leafc_storage_to_litter_patch(i) = value_patch + this%m_frootc_storage_to_litter_patch(i) = value_patch + this%m_livestemc_storage_to_litter_patch(i) = value_patch + this%m_deadstemc_storage_to_litter_patch(i) = value_patch + this%m_livecrootc_storage_to_litter_patch(i) = value_patch + this%m_deadcrootc_storage_to_litter_patch(i) = value_patch + this%m_leafc_xfer_to_litter_patch(i) = value_patch + this%m_frootc_xfer_to_litter_patch(i) = value_patch + this%m_livestemc_xfer_to_litter_patch(i) = value_patch + this%m_deadstemc_xfer_to_litter_patch(i) = value_patch + this%m_livecrootc_xfer_to_litter_patch(i) = value_patch + this%m_deadcrootc_xfer_to_litter_patch(i) = value_patch + this%m_livestemc_to_litter_patch(i) = value_patch + this%m_deadstemc_to_litter_patch(i) = value_patch + this%m_livecrootc_to_litter_patch(i) = value_patch + this%m_deadcrootc_to_litter_patch(i) = value_patch + this%m_gresp_storage_to_litter_patch(i) = value_patch + this%m_gresp_xfer_to_litter_patch(i) = value_patch + this%hrv_leafc_to_litter_patch(i) = value_patch + this%hrv_leafc_storage_to_litter_patch(i) = value_patch + this%hrv_leafc_xfer_to_litter_patch(i) = value_patch + this%hrv_frootc_to_litter_patch(i) = value_patch + this%hrv_frootc_storage_to_litter_patch(i) = value_patch + this%hrv_frootc_xfer_to_litter_patch(i) = value_patch + this%hrv_livestemc_to_litter_patch(i) = value_patch + this%hrv_livestemc_storage_to_litter_patch(i) = value_patch + this%hrv_livestemc_xfer_to_litter_patch(i) = value_patch + this%hrv_deadstemc_storage_to_litter_patch(i) = value_patch + this%hrv_deadstemc_xfer_to_litter_patch(i) = value_patch + this%hrv_livecrootc_to_litter_patch(i) = value_patch + this%hrv_livecrootc_storage_to_litter_patch(i) = value_patch + this%hrv_livecrootc_xfer_to_litter_patch(i) = value_patch + this%hrv_deadcrootc_to_litter_patch(i) = value_patch + this%hrv_deadcrootc_storage_to_litter_patch(i) = value_patch + this%hrv_deadcrootc_xfer_to_litter_patch(i) = value_patch + this%hrv_gresp_storage_to_litter_patch(i) = value_patch + this%hrv_gresp_xfer_to_litter_patch(i) = value_patch + this%hrv_xsmrpool_to_atm_patch(i) = value_patch + + + this%m_leafc_to_fire_patch(i) = value_patch + this%m_leafc_storage_to_fire_patch(i) = value_patch + this%m_leafc_xfer_to_fire_patch(i) = value_patch + this%m_livestemc_to_fire_patch(i) = value_patch + this%m_livestemc_storage_to_fire_patch(i) = value_patch + this%m_livestemc_xfer_to_fire_patch(i) = value_patch + this%m_deadstemc_to_fire_patch(i) = value_patch + this%m_deadstemc_storage_to_fire_patch(i) = value_patch + this%m_deadstemc_xfer_to_fire_patch(i) = value_patch + this%m_frootc_to_fire_patch(i) = value_patch + this%m_frootc_storage_to_fire_patch(i) = value_patch + this%m_frootc_xfer_to_fire_patch(i) = value_patch + this%m_livecrootc_to_fire_patch(i) = value_patch + this%m_livecrootc_storage_to_fire_patch(i) = value_patch + this%m_livecrootc_xfer_to_fire_patch(i) = value_patch + this%m_deadcrootc_to_fire_patch(i) = value_patch + this%m_deadcrootc_storage_to_fire_patch(i) = value_patch + this%m_deadcrootc_xfer_to_fire_patch(i) = value_patch + this%m_gresp_storage_to_fire_patch(i) = value_patch + this%m_gresp_xfer_to_fire_patch(i) = value_patch + + this%m_leafc_to_litter_fire_patch(i) = value_patch + this%m_leafc_storage_to_litter_fire_patch(i) = value_patch + this%m_leafc_xfer_to_litter_fire_patch(i) = value_patch + this%m_livestemc_to_litter_fire_patch(i) = value_patch + this%m_livestemc_storage_to_litter_fire_patch(i) = value_patch + this%m_livestemc_xfer_to_litter_fire_patch(i) = value_patch + this%m_livestemc_to_deadstemc_fire_patch(i) = value_patch + this%m_deadstemc_to_litter_fire_patch(i) = value_patch + this%m_deadstemc_storage_to_litter_fire_patch(i) = value_patch + this%m_deadstemc_xfer_to_litter_fire_patch(i) = value_patch + this%m_frootc_to_litter_fire_patch(i) = value_patch + this%m_frootc_storage_to_litter_fire_patch(i) = value_patch + this%m_frootc_xfer_to_litter_fire_patch(i) = value_patch + this%m_livecrootc_to_litter_fire_patch(i) = value_patch + this%m_livecrootc_storage_to_litter_fire_patch(i) = value_patch + this%m_livecrootc_xfer_to_litter_fire_patch(i) = value_patch + this%m_livecrootc_to_deadcrootc_fire_patch(i) = value_patch + this%m_deadcrootc_to_litter_fire_patch(i) = value_patch + this%m_deadcrootc_storage_to_litter_fire_patch(i) = value_patch + this%m_deadcrootc_xfer_to_litter_fire_patch(i) = value_patch + this%m_gresp_storage_to_litter_fire_patch(i) = value_patch + this%m_gresp_xfer_to_litter_fire_patch(i) = value_patch + + this%leafc_xfer_to_leafc_patch(i) = value_patch + this%frootc_xfer_to_frootc_patch(i) = value_patch + this%livestemc_xfer_to_livestemc_patch(i) = value_patch + this%deadstemc_xfer_to_deadstemc_patch(i) = value_patch + this%livecrootc_xfer_to_livecrootc_patch(i) = value_patch + this%deadcrootc_xfer_to_deadcrootc_patch(i) = value_patch + this%leafc_to_litter_patch(i) = value_patch + this%frootc_to_litter_patch(i) = value_patch + this%cpool_to_resp_patch(i) = value_patch + this%cpool_to_leafc_resp_patch(i) = value_patch + this%cpool_to_leafc_storage_resp_patch(i) = value_patch + this%cpool_to_frootc_resp_patch(i) = value_patch + this%cpool_to_frootc_storage_resp_patch(i) = value_patch + this%cpool_to_livecrootc_resp_patch(i) = value_patch + this%cpool_to_livecrootc_storage_resp_patch(i) = value_patch + this%cpool_to_livestemc_resp_patch(i) = value_patch + this%cpool_to_livestemc_storage_resp_patch(i) = value_patch + this%leaf_mr_patch(i) = value_patch + this%froot_mr_patch(i) = value_patch + this%livestem_mr_patch(i) = value_patch + this%livecroot_mr_patch(i) = value_patch + this%grain_mr_patch(i) = value_patch + this%leaf_curmr_patch(i) = value_patch + this%froot_curmr_patch(i) = value_patch + this%livestem_curmr_patch(i) = value_patch + this%livecroot_curmr_patch(i) = value_patch + this%grain_curmr_patch(i) = value_patch + this%leaf_xsmr_patch(i) = value_patch + this%froot_xsmr_patch(i) = value_patch + this%livestem_xsmr_patch(i) = value_patch + this%livecroot_xsmr_patch(i) = value_patch + this%grain_xsmr_patch(i) = value_patch + this%psnsun_to_cpool_patch(i) = value_patch + this%psnshade_to_cpool_patch(i) = value_patch + this%cpool_to_xsmrpool_patch(i) = value_patch + this%cpool_to_leafc_patch(i) = value_patch + this%cpool_to_leafc_storage_patch(i) = value_patch + this%cpool_to_frootc_patch(i) = value_patch + this%cpool_to_frootc_storage_patch(i) = value_patch + this%cpool_to_livestemc_patch(i) = value_patch + this%cpool_to_livestemc_storage_patch(i) = value_patch + this%cpool_to_deadstemc_patch(i) = value_patch + this%cpool_to_deadstemc_storage_patch(i) = value_patch + this%cpool_to_livecrootc_patch(i) = value_patch + this%cpool_to_livecrootc_storage_patch(i) = value_patch + this%cpool_to_deadcrootc_patch(i) = value_patch + this%cpool_to_deadcrootc_storage_patch(i) = value_patch + this%cpool_to_gresp_storage_patch(i) = value_patch + this%cpool_leaf_gr_patch(i) = value_patch + this%cpool_leaf_storage_gr_patch(i) = value_patch + this%transfer_leaf_gr_patch(i) = value_patch + this%cpool_froot_gr_patch(i) = value_patch + this%cpool_froot_storage_gr_patch(i) = value_patch + this%transfer_froot_gr_patch(i) = value_patch + this%cpool_livestem_gr_patch(i) = value_patch + this%cpool_livestem_storage_gr_patch(i) = value_patch + this%transfer_livestem_gr_patch(i) = value_patch + this%cpool_deadstem_gr_patch(i) = value_patch + this%cpool_deadstem_storage_gr_patch(i) = value_patch + this%transfer_deadstem_gr_patch(i) = value_patch + this%cpool_livecroot_gr_patch(i) = value_patch + this%cpool_livecroot_storage_gr_patch(i) = value_patch + this%transfer_livecroot_gr_patch(i) = value_patch + this%cpool_deadcroot_gr_patch(i) = value_patch + this%cpool_deadcroot_storage_gr_patch(i) = value_patch + this%transfer_deadcroot_gr_patch(i) = value_patch + this%leafc_storage_to_xfer_patch(i) = value_patch + this%frootc_storage_to_xfer_patch(i) = value_patch + this%livestemc_storage_to_xfer_patch(i) = value_patch + this%deadstemc_storage_to_xfer_patch(i) = value_patch + this%livecrootc_storage_to_xfer_patch(i) = value_patch + this%deadcrootc_storage_to_xfer_patch(i) = value_patch + this%gresp_storage_to_xfer_patch(i) = value_patch + this%livestemc_to_deadstemc_patch(i) = value_patch + this%livecrootc_to_deadcrootc_patch(i) = value_patch + + this%current_gr_patch(i) = value_patch + this%transfer_gr_patch(i) = value_patch + this%storage_gr_patch(i) = value_patch + this%frootc_alloc_patch(i) = value_patch + this%frootc_loss_patch(i) = value_patch + this%leafc_alloc_patch(i) = value_patch + this%leafc_loss_patch(i) = value_patch + this%woodc_alloc_patch(i) = value_patch + this%woodc_loss_patch(i) = value_patch + + this%crop_seedc_to_leaf_patch(i) = value_patch + this%grainc_to_cropprodc_patch(i) = value_patch +! Matrix + if(use_matrixcn)then + this%matrix_Cinput_patch(i) = value_patch + this%matrix_C13input_patch(i) = value_patch + this%matrix_C14input_patch(i) = value_patch + end if + end do + if(use_matrixcn)then + do j = 1, nvegcpool + do fi = 1,num_patch + i = filter_patch(fi) + this%matrix_alloc_patch(i,j) = value_patch + this%matrix_phturnover_patch (i,j) = value_patch + this%matrix_gmturnover_patch (i,j) = value_patch + this%matrix_fiturnover_patch (i,j) = value_patch + end do + end do + + do j = 1, ncphtrans + do fi = 1,num_patch + i = filter_patch(fi) + this%matrix_phtransfer_patch (i,j) = value_patch + end do + end do + + do j = 1, ncgmtrans + do fi = 1,num_patch + i = filter_patch(fi) + this%matrix_gmtransfer_patch (i,j) = value_patch + end do + end do + + do j = 1, ncfitrans + do fi = 1,num_patch + i = filter_patch(fi) + this%matrix_fitransfer_patch (i,j) = value_patch + end do + end do + end if + + + if ( use_crop )then + do fi = 1,num_patch + i = filter_patch(fi) + this%xsmrpool_to_atm_patch(i) = value_patch + this%livestemc_to_litter_patch(i) = value_patch + this%grainc_to_food_patch(i) = value_patch + + this%leafc_to_biofuelc_patch(i) = value_patch + this%livestemc_to_biofuelc_patch(i) = value_patch + + this%grainc_to_seed_patch(i) = value_patch + this%grainc_xfer_to_grainc_patch(i) = value_patch + this%cpool_to_grainc_patch(i) = value_patch + this%cpool_to_grainc_storage_patch(i) = value_patch + this%cpool_grain_gr_patch(i) = value_patch + this%cpool_grain_storage_gr_patch(i) = value_patch + this%transfer_grain_gr_patch(i) = value_patch + this%grainc_storage_to_xfer_patch(i) = value_patch + end do + end if + + + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + + this%phenology_c_to_litr_met_c_col(i,j) = value_column + this%phenology_c_to_litr_cel_c_col(i,j) = value_column + this%phenology_c_to_litr_lig_c_col(i,j) = value_column + + this%gap_mortality_c_to_litr_met_c_col(i,j) = value_column + this%gap_mortality_c_to_litr_cel_c_col(i,j) = value_column + this%gap_mortality_c_to_litr_lig_c_col(i,j) = value_column + this%gap_mortality_c_to_cwdc_col(i,j) = value_column + + this%fire_mortality_c_to_cwdc_col(i,j) = value_column + this%m_c_to_litr_met_fire_col(i,j) = value_column + this%m_c_to_litr_cel_fire_col(i,j) = value_column + this%m_c_to_litr_lig_fire_col(i,j) = value_column + + this%harvest_c_to_litr_met_c_col(i,j) = value_column + this%harvest_c_to_litr_cel_c_col(i,j) = value_column + this%harvest_c_to_litr_lig_c_col(i,j) = value_column + this%harvest_c_to_cwdc_col(i,j) = value_column + + end do + end do + + + do k = 1, ndecomp_pools + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%m_decomp_cpools_to_fire_vr_col(i,j,k) = value_column + end do + end do + end do + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%m_decomp_cpools_to_fire_col(i,k) = value_column + end do + end do + + do fi = 1,num_column + i = filter_column(fi) + + this%grainc_to_cropprodc_col(i) = value_column + this%cwdc_hr_col(i) = value_column + this%cwdc_loss_col(i) = value_column + this%litterc_loss_col(i) = value_column + + end do + + + do fi = 1,num_patch + i = filter_patch(fi) + + this%gpp_patch(i) = value_patch + this%mr_patch(i) = value_patch + this%gr_patch(i) = value_patch + this%ar_patch(i) = value_patch + this%rr_patch(i) = value_patch + this%npp_patch(i) = value_patch + this%agnpp_patch(i) = value_patch + this%bgnpp_patch(i) = value_patch + this%litfall_patch(i) = value_patch + this%wood_harvestc_patch(i) = value_patch + this%slash_harvestc_patch(i) = value_patch + this%cinputs_patch(i) = value_patch + this%coutputs_patch(i) = value_patch + this%fire_closs_patch(i) = value_patch + this%npp_Nactive_patch(i) = value_patch + this%npp_burnedoff_patch(i) = value_patch + this%npp_Nnonmyc_patch(i) = value_patch + this%npp_Nam_patch(i) = value_patch + this%npp_Necm_patch(i) = value_patch + this%npp_Nactive_no3_patch(i) = value_patch + this%npp_Nactive_nh4_patch(i) = value_patch + this%npp_Nnonmyc_no3_patch(i) = value_patch + this%npp_Nnonmyc_nh4_patch(i) = value_patch + this%npp_Nam_no3_patch(i) = value_patch + this%npp_Nam_nh4_patch(i) = value_patch + this%npp_Necm_no3_patch(i) = value_patch + this%npp_Necm_nh4_patch(i) = value_patch + this%npp_Nfix_patch(i) = value_patch + this%npp_Nretrans_patch(i) = value_patch + this%npp_Nuptake_patch(i) = value_patch + this%npp_growth_patch(i) = value_patch + this%leafc_change_patch(i) = value_patch + this%soilc_change_patch(i) = value_patch + end do + + do fi = 1,num_column + i = filter_column(fi) + + this%sr_col(i) = value_column + this%er_col(i) = value_column + this%litfire_col(i) = value_column + this%somfire_col(i) = value_column + this%totfire_col(i) = value_column + + ! Zero p2c column fluxes + this%rr_col(i) = value_column + this%ar_col(i) = value_column + this%gpp_col(i) = value_column + this%npp_col(i) = value_column + this%fire_closs_col(i) = value_column + this%wood_harvestc_col(i) = value_column + this%hrv_xsmrpool_to_atm_col(i) = value_column + this%nep_col(i) = value_column + if ( use_crop )then + this%xsmrpool_to_atm_col(i) = value_column + end if + + end do + + end subroutine SetValues + + +end module CNCLM_CNVegCarbonFluxType + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 new file mode 100644 index 000000000..1a710595e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -0,0 +1,1234 @@ +module CNCLM_CNVegNitrogenFluxType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools,& + nvegcpool,ncphtrans,ncgmtrans,ncfitrans,& + ncphouttrans,ncgmouttrans,ncfiouttrans + use clm_varpar , only : nlevdecomp_full, nlevgrnd,nlevdecomp + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,ioutc + use clm_varpar , only : numpft, num_zon, num_veg, & + var_col, var_pft, CN_zone_weight + use clm_varcon , only : spval + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_cnveg_nitrogenflux_type + procedure , public :: SetValues + + type, public :: cnveg_nitrogenflux_type + + ! gap mortality fluxes + real(r8), pointer :: m_leafn_to_litter_patch (:) ! patch leaf N mortality (gN/m2/s) + real(r8), pointer :: m_frootn_to_litter_patch (:) ! patch fine root N mortality (gN/m2/s) + real(r8), pointer :: m_leafn_storage_to_litter_patch (:) ! patch leaf N storage mortality (gN/m2/s) + real(r8), pointer :: m_frootn_storage_to_litter_patch (:) ! patch fine root N storage mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_storage_to_litter_patch (:) ! patch live stem N storage mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_storage_to_litter_patch (:) ! patch dead stem N storage mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_storage_to_litter_patch (:) ! patch live coarse root N storage mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_storage_to_litter_patch (:) ! patch dead coarse root N storage mortality (gN/m2/s) + real(r8), pointer :: m_leafn_xfer_to_litter_patch (:) ! patch leaf N transfer mortality (gN/m2/s) + real(r8), pointer :: m_frootn_xfer_to_litter_patch (:) ! patch fine root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_xfer_to_litter_patch (:) ! patch live stem N transfer mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_xfer_to_litter_patch (:) ! patch dead stem N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_xfer_to_litter_patch (:) ! patch live coarse root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_xfer_to_litter_patch (:) ! patch dead coarse root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_to_litter_patch (:) ! patch live stem N mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_to_litter_patch (:) ! patch dead stem N mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_to_litter_patch (:) ! patch live coarse root N mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_to_litter_patch (:) ! patch dead coarse root N mortality (gN/m2/s) + real(r8), pointer :: m_retransn_to_litter_patch (:) ! patch retranslocated N pool mortality (gN/m2/s) + + ! harvest fluxes + real(r8), pointer :: hrv_leafn_to_litter_patch (:) ! patch leaf N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_to_litter_patch (:) ! patch fine root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_leafn_storage_to_litter_patch (:) ! patch leaf N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_storage_to_litter_patch (:) ! patch fine root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_storage_to_litter_patch (:) ! patch live stem N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_storage_to_litter_patch (:) ! patch dead stem N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_storage_to_litter_patch (:) ! patch live coarse root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_storage_to_litter_patch (:) ! patch dead coarse root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_leafn_xfer_to_litter_patch (:) ! patch leaf N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_xfer_to_litter_patch (:) ! patch fine root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_xfer_to_litter_patch (:) ! patch live stem N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_xfer_to_litter_patch (:) ! patch dead stem N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_xfer_to_litter_patch (:) ! patch live coarse root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litter_patch (:) ! patch dead coarse root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_to_litter_patch (:) ! patch live stem N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_to_litter_patch (:) ! patch live coarse root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_to_litter_patch (:) ! patch dead coarse root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_retransn_to_litter_patch (:) ! patch retranslocated N pool harvest mortality (gN/m2/s) + real(r8), pointer :: grainn_to_cropprodn_patch (:) ! patch grain N to crop product pool (gN/m2/s) + real(r8), pointer :: grainn_to_cropprodn_col (:) ! col grain N to crop product pool (gN/m2/s) + real(r8), pointer :: m_n_to_litr_met_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter labile N by fire (gN/m3/s) + real(r8), pointer :: m_n_to_litr_cel_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter cellulose N by fire (gN/m3/s) + real(r8), pointer :: m_n_to_litr_lig_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter lignin N by fire (gN/m3/s) + real(r8), pointer :: harvest_n_to_litr_met_n_col (:,:) ! col N fluxes associated with harvest to litter metabolic pool (gN/m3/s) + real(r8), pointer :: harvest_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with harvest to litter cellulose pool (gN/m3/s) + real(r8), pointer :: harvest_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with harvest to litter lignin pool (gN/m3/s) + real(r8), pointer :: harvest_n_to_cwdn_col (:,:) ! col N fluxes associated with harvest to CWD pool (gN/m3/s) + + ! fire N fluxes + real(r8), pointer :: m_decomp_npools_to_fire_vr_col (:,:,:) ! col vertically-resolved decomposing N fire loss (gN/m3/s) + real(r8), pointer :: m_decomp_npools_to_fire_col (:,:) ! col vertically-integrated (diagnostic) decomposing N fire loss (gN/m2/s) + real(r8), pointer :: m_leafn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn + real(r8), pointer :: m_leafn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn_storage + real(r8), pointer :: m_leafn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn_xfer + real(r8), pointer :: m_livestemn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn + real(r8), pointer :: m_livestemn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn_storage + real(r8), pointer :: m_livestemn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn_xfer + real(r8), pointer :: m_deadstemn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn + real(r8), pointer :: m_deadstemn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn_storage + real(r8), pointer :: m_deadstemn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn_xfer + real(r8), pointer :: m_frootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn + real(r8), pointer :: m_frootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn_storage + real(r8), pointer :: m_frootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn_xfer + real(r8), pointer :: m_livecrootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from m_livecrootn_to_fire + real(r8), pointer :: m_livecrootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livecrootn_storage + real(r8), pointer :: m_livecrootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livecrootn_xfer + real(r8), pointer :: m_deadcrootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn + real(r8), pointer :: m_deadcrootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn_storage + real(r8), pointer :: m_deadcrootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn_xfer + real(r8), pointer :: m_retransn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from retransn + real(r8), pointer :: m_leafn_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn to litter N due to fire + real(r8), pointer :: m_leafn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn_storage to litter N due to fire + real(r8), pointer :: m_leafn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn_xfer to litter N due to fire + real(r8), pointer :: m_livestemn_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn to litter N due to fire + real(r8), pointer :: m_livestemn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn_storage to litter N due to fire + real(r8), pointer :: m_livestemn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn_xfer to litter N due to fire + real(r8), pointer :: m_livestemn_to_deadstemn_fire_patch (:) ! patch (gN/m2/s) from livestemn to deadstemn N due to fire + real(r8), pointer :: m_deadstemn_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn to litter N due to fire + real(r8), pointer :: m_deadstemn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn_storage to litter N due to fire + real(r8), pointer :: m_deadstemn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn_xfer to litter N due to fire + real(r8), pointer :: m_frootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn to litter N due to fire + real(r8), pointer :: m_frootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn_storage to litter N due to fire + real(r8), pointer :: m_frootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn_xfer to litter N due to fire + real(r8), pointer :: m_livecrootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn to litter N due to fire + real(r8), pointer :: m_livecrootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn_storage to litter N due to fire + real(r8), pointer :: m_livecrootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn_xfer to litter N due to fire + real(r8), pointer :: m_livecrootn_to_deadcrootn_fire_patch (:) ! patch (gN/m2/s) from livecrootn_xfer to deadcrootn due to fire + real(r8), pointer :: m_deadcrootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn to deadcrootn due to fire + real(r8), pointer :: m_deadcrootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn_storage to deadcrootn due to fire + real(r8), pointer :: m_deadcrootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn_xfer to deadcrootn due to fire + real(r8), pointer :: m_retransn_to_litter_fire_patch (:) ! patch (gN/m2/s) from retransn to deadcrootn due to fire + real(r8), pointer :: fire_nloss_patch (:) ! patch total patch-level fire N loss (gN/m2/s) + real(r8), pointer :: fire_nloss_col (:) ! col total column-level fire N loss (gN/m2/s) + real(r8), pointer :: fire_nloss_p2c_col (:) ! col patch2col column-level fire N loss (gN/m2/s) (p2c) + real(r8), pointer :: fire_mortality_n_to_cwdn_col (:,:) ! col N fluxes associated with fire mortality to CWD pool (gN/m3/s) + + ! phenology fluxes from transfer pool + real(r8), pointer :: grainn_xfer_to_grainn_patch (:) ! patch grain N growth from storage for prognostic crop model (gN/m2/s) + real(r8), pointer :: leafn_xfer_to_leafn_patch (:) ! patch leaf N growth from storage (gN/m2/s) + real(r8), pointer :: frootn_xfer_to_frootn_patch (:) ! patch fine root N growth from storage (gN/m2/s) + real(r8), pointer :: livestemn_xfer_to_livestemn_patch (:) ! patch live stem N growth from storage (gN/m2/s) + real(r8), pointer :: deadstemn_xfer_to_deadstemn_patch (:) ! patch dead stem N growth from storage (gN/m2/s) + real(r8), pointer :: livecrootn_xfer_to_livecrootn_patch (:) ! patch live coarse root N growth from storage (gN/m2/s) + real(r8), pointer :: deadcrootn_xfer_to_deadcrootn_patch (:) ! patch dead coarse root N growth from storage (gN/m2/s) + + ! litterfall fluxes + real(r8), pointer :: livestemn_to_litter_patch (:) ! patch livestem N to litter (gN/m2/s) + real(r8), pointer :: grainn_to_food_patch (:) ! patch grain N to food for prognostic crop (gN/m2/s) + real(r8), pointer :: leafn_to_biofueln_patch (:) ! patch leaf N to biofuel N (gN/m2/s) + real(r8), pointer :: livestemn_to_biofueln_patch (:) ! patch livestem N to biofuel N (gN/m2/s) + real(r8), pointer :: grainn_to_seed_patch (:) ! patch grain N to seed for prognostic crop (gN/m2/s) + real(r8), pointer :: leafn_to_litter_patch (:) ! patch leaf N litterfall (gN/m2/s) + real(r8), pointer :: leafn_to_retransn_patch (:) ! patch leaf N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: frootn_to_retransn_patch (:) ! patch fine root N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: frootn_to_litter_patch (:) ! patch fine root N litterfall (gN/m2/s) + + ! allocation fluxes + real(r8), pointer :: retransn_to_npool_patch (:) ! patch deployment of retranslocated N (gN/m2/s) + real(r8), pointer :: free_retransn_to_npool_patch (:) ! patch deployment of free retranslocated N (gN/m2/s) + real(r8), pointer :: sminn_to_npool_patch (:) ! patch deployment of soil mineral N uptake (gN/m2/s) + real(r8), pointer :: npool_to_grainn_patch (:) ! patch allocation to grain N for prognostic crop (gN/m2/s) + real(r8), pointer :: npool_to_grainn_storage_patch (:) ! patch allocation to grain N storage for prognostic crop (gN/m2/s) + real(r8), pointer :: npool_to_leafn_patch (:) ! patch allocation to leaf N (gN/m2/s) + real(r8), pointer :: npool_to_leafn_storage_patch (:) ! patch allocation to leaf N storage (gN/m2/s) + real(r8), pointer :: npool_to_frootn_patch (:) ! patch allocation to fine root N (gN/m2/s) + real(r8), pointer :: npool_to_frootn_storage_patch (:) ! patch allocation to fine root N storage (gN/m2/s) + real(r8), pointer :: npool_to_livestemn_patch (:) ! patch allocation to live stem N (gN/m2/s) + real(r8), pointer :: npool_to_livestemn_storage_patch (:) ! patch allocation to live stem N storage (gN/m2/s) + real(r8), pointer :: npool_to_deadstemn_patch (:) ! patch allocation to dead stem N (gN/m2/s) + real(r8), pointer :: npool_to_deadstemn_storage_patch (:) ! patch allocation to dead stem N storage (gN/m2/s) + real(r8), pointer :: npool_to_livecrootn_patch (:) ! patch allocation to live coarse root N (gN/m2/s) + real(r8), pointer :: npool_to_livecrootn_storage_patch (:) ! patch allocation to live coarse root N storage (gN/m2/s) + real(r8), pointer :: npool_to_deadcrootn_patch (:) ! patch allocation to dead coarse root N (gN/m2/s) + real(r8), pointer :: npool_to_deadcrootn_storage_patch (:) ! patch allocation to dead coarse root N storage (gN/m2/s) + + ! annual turnover of storage to transfer pools + real(r8), pointer :: grainn_storage_to_xfer_patch (:) ! patch grain N shift storage to transfer for prognostic crop (gN/m2/s) + real(r8), pointer :: leafn_storage_to_xfer_patch (:) ! patch leaf N shift storage to transfer (gN/m2/s) + real(r8), pointer :: frootn_storage_to_xfer_patch (:) ! patch fine root N shift storage to transfer (gN/m2/s) + real(r8), pointer :: livestemn_storage_to_xfer_patch (:) ! patch live stem N shift storage to transfer (gN/m2/s) + real(r8), pointer :: deadstemn_storage_to_xfer_patch (:) ! patch dead stem N shift storage to transfer (gN/m2/s) + real(r8), pointer :: livecrootn_storage_to_xfer_patch (:) ! patch live coarse root N shift storage to transfer (gN/m2/s) + real(r8), pointer :: deadcrootn_storage_to_xfer_patch (:) ! patch dead coarse root N shift storage to transfer (gN/m2/s) + real(r8), pointer :: fert_patch (:) ! patch applied fertilizer (gN/m2/s) + real(r8), pointer :: fert_counter_patch (:) ! patch >0 fertilize; <=0 not + real(r8), pointer :: soyfixn_patch (:) ! patch soybean fixed N (gN/m2/s) + + ! turnover of livewood to deadwood, with retranslocation + real(r8), pointer :: livestemn_to_deadstemn_patch (:) ! patch live stem N turnover (gN/m2/s) + real(r8), pointer :: livestemn_to_retransn_patch (:) ! patch live stem N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: livecrootn_to_deadcrootn_patch (:) ! patch live coarse root N turnover (gN/m2/s) + real(r8), pointer :: livecrootn_to_retransn_patch (:) ! patch live coarse root N to retranslocated N pool (gN/m2/s) + + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: ndeploy_patch (:) ! patch total N deployed to growth and storage (gN/m2/s) + real(r8), pointer :: wood_harvestn_patch (:) ! patch total N losses to wood product pools (gN/m2/s) + real(r8), pointer :: wood_harvestn_col (:) ! col total N losses to wood product pools (gN/m2/s) (p2c) + ! phenology: litterfall and crop fluxes + real(r8), pointer :: phenology_n_to_litr_met_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gN/m3/s) + real(r8), pointer :: phenology_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gN/m3/s) + real(r8), pointer :: phenology_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter lignin pool (gN/m3/s) + + ! gap mortality fluxes + real(r8), pointer :: gap_mortality_n_to_litr_met_n_col (:,:) ! col N fluxes associated with gap mortality to litter metabolic pool (gN/m3/s) + real(r8), pointer :: gap_mortality_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with gap mortality to litter cellulose pool (gN/m3/s) + real(r8), pointer :: gap_mortality_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with gap mortality to litter lignin pool (gN/m3/s) + real(r8), pointer :: gap_mortality_n_to_cwdn_col (:,:) ! col N fluxes associated with gap mortality to CWD pool (gN/m3/s) + + ! dynamic landcover fluxes + real(r8), pointer :: dwt_seedn_to_leaf_patch (:) ! (gN/m2/s) seed source to patch-level; although this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_seedn_to_leaf_grc (:) ! (gN/m2/s) dwt_seedn_to_leaf_patch summed to the gridcell-level + real(r8), pointer :: dwt_seedn_to_deadstem_patch (:) ! (gN/m2/s) seed source to patch-level; although this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_seedn_to_deadstem_grc (:) ! (gN/m2/s) dwt_seedn_to_deadstem_patch summed to the gridcell-level + real(r8), pointer :: dwt_conv_nflux_patch (:) ! (gN/m2/s) conversion N flux (immediate loss to atm); although this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_conv_nflux_grc (:) ! (gN/m2/s) dwt_conv_nflux_patch summed to the gridcell-level + real(r8), pointer :: dwt_wood_productn_gain_patch (:) ! patch (gN/m2/s) addition to wood product pools from landcover change; even though this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_crop_productn_gain_patch (:) ! patch (gN/m2/s) addition to crop product pool from landcover change; even though this is a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), pointer :: dwt_frootn_to_litr_met_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootn_to_litr_cel_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootn_to_litr_lig_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_livecrootn_to_cwdn_col (:,:) ! col (gN/m3/s) live coarse root to CWD due to landcover change + real(r8), pointer :: dwt_deadcrootn_to_cwdn_col (:,:) ! col (gN/m3/s) dead coarse root to CWD due to landcover change + + ! crop fluxes + real(r8), pointer :: crop_seedn_to_leaf_patch (:) ! patch (gN/m2/s) seed source to leaf, for crops + + ! Misc + real(r8), pointer :: plant_ndemand_patch (:) ! N flux required to support initial GPP (gN/m2/s) + real(r8), pointer :: avail_retransn_patch (:) ! N flux available from retranslocation pool (gN/m2/s) + real(r8), pointer :: plant_nalloc_patch (:) ! total allocated N flux (gN/m2/s) + real(r8), pointer :: plant_ndemand_retrans_patch (:) ! The N demand pool generated for FUN2.0; mainly used for deciduous trees (gN/m2/s) + real(r8), pointer :: plant_ndemand_season_patch (:) ! The N demand pool for seasonal deciduous (gN/m2/s) + real(r8), pointer :: plant_ndemand_stress_patch (:) ! The N demand pool for stress deciduous (gN/m2/s) + real(r8), pointer :: Nactive_patch (:) ! N acquired by mycorrhizal uptake (gN/m2/s) + real(r8), pointer :: Nnonmyc_patch (:) ! N acquired by non-myc uptake (gN/m2/s) + real(r8), pointer :: Nam_patch (:) ! N acquired by AM plant (gN/m2/s) + real(r8), pointer :: Necm_patch (:) ! N acquired by ECM plant (gN/m2/s) + real(r8), pointer :: Nactive_no3_patch (:) ! N acquired by mycorrhizal uptake (gN/m2/s) + real(r8), pointer :: Nactive_nh4_patch (:) ! N acquired by mycorrhizal uptake (gN/m2/s) + real(r8), pointer :: Nnonmyc_no3_patch (:) ! N acquired by non-myc (gN/m2/s) + real(r8), pointer :: Nnonmyc_nh4_patch (:) ! N acquired by non-myc (gN/m2/s) + real(r8), pointer :: Nam_no3_patch (:) ! N acquired by AM plant (gN/m2/s) + real(r8), pointer :: Nam_nh4_patch (:) ! N acquired by AM plant (gN/m2/s) + real(r8), pointer :: Necm_no3_patch (:) ! N acquired by ECM plant (gN/m2/s) + real(r8), pointer :: Necm_nh4_patch (:) ! N acquired by ECM plant (gN/m2/s) + real(r8), pointer :: Nfix_patch (:) ! N acquired by Symbiotic BNF (gN/m2/s) + real(r8), pointer :: Npassive_patch (:) ! N acquired by passive uptake (gN/m2/s) + real(r8), pointer :: Nretrans_patch (:) ! N acquired by retranslocation (gN/m2/s) + real(r8), pointer :: Nretrans_org_patch (:) ! N acquired by retranslocation (gN/m2/s) + real(r8), pointer :: Nretrans_season_patch (:) ! N acquired by retranslocation (gN/m2/s) + real(r8), pointer :: Nretrans_stress_patch (:) ! N acquired by retranslocation (gN/m2/s) + real(r8), pointer :: Nuptake_patch (:) ! Total N uptake of FUN (gN/m2/s) + real(r8), pointer :: sminn_to_plant_fun_patch (:) ! Total soil N uptake of FUN (gN/m2/s) + real(r8), pointer :: sminn_to_plant_fun_vr_patch (:,:) ! Total layer soil N uptake of FUN (gN/m2/s) + real(r8), pointer :: sminn_to_plant_fun_no3_vr_patch (:,:) ! Total layer no3 uptake of FUN (gN/m2/s) + real(r8), pointer :: sminn_to_plant_fun_nh4_vr_patch (:,:) ! Total layer nh4 uptake of FUN (gN/m2/s) + real(r8), pointer :: cost_nfix_patch (:) ! Average cost of fixation (gN/m2/s) + real(r8), pointer :: cost_nactive_patch (:) ! Average cost of active uptake (gN/m2/s) + real(r8), pointer :: cost_nretrans_patch (:) ! Average cost of retranslocation (gN/m2/s) + real(r8), pointer :: nuptake_npp_fraction_patch (:) ! frac of npp spent on N acquisition (gN/m2/s) + ! Matrix + real(r8), pointer :: matrix_nalloc_patch (:,:) ! B-matrix for nitrogen allocation + real(r8), pointer :: matrix_Ninput_patch (:) ! I-matrix for nitrogen input + + real(r8), pointer :: matrix_nphtransfer_patch (:,:) ! A-matrix_phenologh for nitrogen + real(r8), pointer :: matrix_nphturnover_patch (:,:) ! K-matrix_phenologh for nitrogen + integer, pointer :: matrix_nphtransfer_doner_patch (:) ! A-matrix_phenology non-zero indices (column indices) for nitrogen + integer, pointer :: matrix_nphtransfer_receiver_patch (:) ! A-matrix_phenology non-zero indices (row indices) for nitrogen + + real(r8), pointer :: matrix_ngmtransfer_patch (:,:) ! A-matrix_gap mortality for nitrogen + real(r8), pointer :: matrix_ngmturnover_patch (:,:) ! K-matrix_gap mortality for nitrogen + integer, pointer :: matrix_ngmtransfer_doner_patch (:) ! A-matrix_gap mortality non-zero indices (column indices) for nitrogen + + real(r8), pointer :: matrix_nfitransfer_patch (:,:) ! A-matrix_fire for nitrogen + real(r8), pointer :: matrix_nfiturnover_patch (:,:) ! K-matrix_fire for nitrogen + integer, pointer :: matrix_nfitransfer_doner_patch (:) ! A-matrix_fire non-zero indices (column indices) for nitrogen + integer, pointer :: matrix_nfitransfer_receiver_patch (:) ! A-matrix_fire non-zero indices (row indices) for nitrogen + + integer ileafst_to_ileafxf_ph ! Index of phenology related N transfer from leaf storage pool to leaf transfer pool + integer ileafxf_to_ileaf_ph ! Index of phenology related N transfer from leaf transfer pool to leaf pool + integer ifrootst_to_ifrootxf_ph ! Index of phenology related N transfer from fine root storage pool to fine root transfer pool + integer ifrootxf_to_ifroot_ph ! Index of phenology related N transfer from fine root transfer pool to fine root pool + integer ilivestemst_to_ilivestemxf_ph ! Index of phenology related N transfer from live stem storage pool to live stem transfer pool + integer ilivestemxf_to_ilivestem_ph ! Index of phenology related N transfer from live stem transfer pool to live stem pool + integer ideadstemst_to_ideadstemxf_ph ! Index of phenology related N transfer from dead stem storage pool to dead stem transfer pool + integer ideadstemxf_to_ideadstem_ph ! Index of phenology related N transfer from dead stem transfer pool to dead stem pool + integer ilivecrootst_to_ilivecrootxf_ph ! Index of phenology related N transfer from live coarse root storage pool to live coarse root transfer pool + integer ilivecrootxf_to_ilivecroot_ph ! Index of phenology related N transfer from live coarse root transfer pool to live coarse root pool + integer ideadcrootst_to_ideadcrootxf_ph ! Index of phenology related N transfer from dead coarse root storage pool to dead coarse root transfer pool + integer ideadcrootxf_to_ideadcroot_ph ! Index of phenology related N transfer from dead coarse root transfer pool to dead coarse root pool + integer ilivestem_to_ideadstem_ph ! Index of phenology related N transfer from live stem pool to dead stem pool + integer ilivecroot_to_ideadcroot_ph ! Index of phenology related N transfer from live coarse root pool to dead coarse root pool + integer iretransn_to_ileaf_ph ! Index of phenology related N transfer from retranslocation pool to leaf pool + integer iretransn_to_ileafst_ph ! Index of phenology related N transfer from retranslocation pool to leaf storage pool + integer iretransn_to_ifroot_ph ! Index of phenology related N transfer from retranslocation pool to fine root pool + integer iretransn_to_ifrootst_ph ! Index of phenology related N transfer from retranslocation pool to fine root storage pool + integer iretransn_to_ilivestem_ph ! Index of phenology related N transfer from retranslocation pool to live stem pool + integer iretransn_to_ilivestemst_ph ! Index of phenology related N transfer from retranslocation pool to live stem storage pool + integer iretransn_to_ideadstem_ph ! Index of phenology related N transfer from retranslocation pool to dead stem pool + integer iretransn_to_ideadstemst_ph ! Index of phenology related N transfer from retranslocation pool to dead stem storage pool + integer iretransn_to_ilivecroot_ph ! Index of phenology related N transfer from retranslocation pool to live coarse root pool + integer iretransn_to_ilivecrootst_ph ! Index of phenology related N transfer from retranslocation pool to live coarse root storage pool + integer iretransn_to_ideadcroot_ph ! Index of phenology related N transfer from retranslocation pool to dead coarse root pool + integer iretransn_to_ideadcrootst_ph ! Index of phenology related N transfer from retranslocation pool to dead coarse root storage pool + integer iretransn_to_igrain_ph ! Index of phenology related N transfer from retranslocation pool to grain pool + integer iretransn_to_igrainst_ph ! Index of phenology related N transfer from retranslocation pool to grain storage pool + integer ileaf_to_iout_ph ! Index of phenology related N transfer from leaf pool to outside of vegetation pools + integer ifroot_to_iout_ph ! Index of phenology related N transfer from fine root pool to outside of vegetation pools + integer ilivestem_to_iout_ph ! Index of phenology related N transfer from live stem pool to outside of vegetation pools + integer ileaf_to_iretransn_ph ! Index of phenology related N transfer from leaf pool to retranslocation pools + integer ifroot_to_iretransn_ph ! Index of phenology related N transfer from fine root pool to retranslocation pools + integer ilivestem_to_iretransn_ph ! Index of phenology related N transfer from live stem pool to retranslocation pools + integer ilivecroot_to_iretransn_ph ! Index of phenology related N transfer from live coarse root pool to retranslocation pools + integer igrain_to_iout_ph ! Index of phenology related N transfer from grain pool to outside of vegetation pools + integer iretransn_to_iout_ph ! Index of phenology related N transfer from retranslocation pool to outside of vegetation pools + integer ileaf_to_iout_gm ! Index of gap mortality related N transfer from leaf pool to outside of vegetation pools + integer ileafst_to_iout_gm ! Index of gap mortality related N transfer from leaf storage pool to outside of vegetation pools + integer ileafxf_to_iout_gm ! Index of gap mortality related N transfer from leaf transfer pool to outside of vegetation pools + integer ifroot_to_iout_gm ! Index of gap mortality related N transfer from fine root pool to outside of vegetation pools + integer ifrootst_to_iout_gm ! Index of gap mortality related N transfer from fine root storage pool to outside of vegetation pools + integer ifrootxf_to_iout_gm ! Index of gap mortality related N transfer from fine root transfer pool to outside of vegetation pools + integer ilivestem_to_iout_gm ! Index of gap mortality related N transfer from live stem pool to outside of vegetation pools + integer ilivestemst_to_iout_gm ! Index of gap mortality related N transfer from live stem storage pool to outside of vegetation pools + integer ilivestemxf_to_iout_gm ! Index of gap mortality related N transfer from live stem transfer pool to outside of vegetation pools + integer ideadstem_to_iout_gm ! Index of gap mortality related N transfer from dead stem pool to outside of vegetation pools + integer ideadstemst_to_iout_gm ! Index of gap mortality related N transfer from dead stem storage pool to outside of vegetation pools + integer ideadstemxf_to_iout_gm ! Index of gap mortality related N transfer from dead stem transfer pool to outside of vegetation pools + integer ilivecroot_to_iout_gm ! Index of gap mortality related N transfer from live coarse root pool to outside of vegetation pools + integer ilivecrootst_to_iout_gm ! Index of gap mortality related N transfer from live coarse root storage pool to outside of vegetation pools + integer ilivecrootxf_to_iout_gm ! Index of gap mortality related N transfer from live coarse root transfer pool to outside of vegetation pools + integer ideadcroot_to_iout_gm ! Index of gap mortality related N transfer from dead coarse root pool to outside of vegetation pools + integer ideadcrootst_to_iout_gm ! Index of gap mortality related N transfer from dead coarse root storage pool to outside of vegetation pools + integer ideadcrootxf_to_iout_gm ! Index of gap mortality related N transfer from dead coarse root transfer pool to outside of vegetation pools + integer iretransn_to_iout_gm ! Index of gap mortality related N transfer from retranslocation to outside of vegetation pools + integer ileaf_to_iout_fi ! Index of fire related N transfer from leaf pool to outside of vegetation pools + integer ileafst_to_iout_fi ! Index of fire related N transfer from leaf storage pool to outside of vegetation pools + integer ileafxf_to_iout_fi ! Index of fire related N transfer from leaf transfer pool to outside of vegetation pools + integer ifroot_to_iout_fi ! Index of fire related N transfer from fine root pool to outside of vegetation pools + integer ifrootst_to_iout_fi ! Index of fire related N transfer from fine root storage pool to outside of vegetation pools + integer ifrootxf_to_iout_fi ! Index of fire related N transfer from fine root transfer pool to outside of vegetation pools + integer ilivestem_to_iout_fi ! Index of fire related N transfer from live stem pool to outside of vegetation pools + integer ilivestemst_to_iout_fi ! Index of fire related N transfer from live stem storage pool to outside of vegetation pools + integer ilivestemxf_to_iout_fi ! Index of fire related N transfer from live stem transfer pool to outside of vegetation pools + integer ideadstem_to_iout_fi ! Index of fire related N transfer from dead stem pool to outside of vegetation pools + integer ideadstemst_to_iout_fi ! Index of fire related N transfer from dead stem storage pool to outside of vegetation pools + integer ideadstemxf_to_iout_fi ! Index of fire related N transfer from dead stem transfer pool to outside of vegetation pools + integer ilivecroot_to_iout_fi ! Index of fire related N transfer from live coarse root pool to outside of vegetation pools + integer ilivecrootst_to_iout_fi ! Index of fire related N transfer from live coarse root storage pool to outside of vegetation pools + integer ilivecrootxf_to_iout_fi ! Index of fire related N transfer from live coarse root transfer pool to outside of vegetation pools + integer ideadcroot_to_iout_fi ! Index of fire related N transfer from dead coarse root pool to outside of vegetation pools + integer ideadcrootst_to_iout_fi ! Index of fire related N transfer from dead coarse root storage pool to outside of vegetation pools + integer ideadcrootxf_to_iout_fi ! Index of fire related N transfer from dead coarse root transfer pool to outside of vegetation pools + integer iretransn_to_iout_fi ! Index of fire related N transfer from retranslocation transfer pool to outside of vegetation pools + integer ilivestem_to_ideadstem_fi ! Index of fire related N transfer from live stem pool to dead stem pools + integer ilivecroot_to_ideadcroot_fi ! Index of fire related N transfer from live coarse root pool to dead coarse root pools + + integer,pointer :: list_phn_phgmn (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKphn to AKphn+AKgmn + integer,pointer :: list_gmn_phgmn (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKgmn to AKphn+AKgmn + integer,pointer :: list_phn_phgmfin (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKphn to AKphn+AKgmn+AKfin + integer,pointer :: list_gmn_phgmfin (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKgmn to AKphn+AKgmn+AKfin + integer,pointer :: list_fin_phgmfin (:) ! Index mapping for sparse matrix addition (save to reduce computational cost): from AKfin to AKphn+AKgmn+AKfin + integer,pointer :: list_aphn (:) ! Indices of non-diagnoal entries in full sparse matrix Aph for N cycle + integer,pointer :: list_agmn (:) ! Indices of non-diagnoal entries in full sparse matrix Agm for N cycle + integer,pointer :: list_afin (:) ! Indices of non-diagnoal entries in full sparse matrix Afi for N cycle + + end type cnveg_nitrogenflux_type + +type(cnveg_nitrogenflux_type), public, target, save :: cnveg_nitrogenflux_inst + +contains + +!--------------------------------------- + subroutine init_cnveg_nitrogenflux_type(bounds, nch, ityp, fveg, cncol, cnpft, this) + +! !DESCRIPTION: +! Initialize CTSM nitrogen fluxes +! jk Apr 2021: type is allocated and initialized to NaN; +! if data arrays from restart file are passed (cncol and cnpft), the type is then initialized with these values +! +! !ARGUMENTS: + implicit none + + ! INPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: ityp ! PFT index + real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart + type(cnveg_nitrogenflux_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + integer :: np, nc, nz, p, nv, n + !-------------------------------- + + this%ileaf_to_iretransn_ph = 1 + this%matrix_nphtransfer_doner_patch(this%ileaf_to_iretransn_ph) = ileaf + this%matrix_nphtransfer_receiver_patch(this%ileaf_to_iretransn_ph) = iretransn + + this%ileafst_to_ileafxf_ph = 2 + this%matrix_nphtransfer_doner_patch(this%ileafst_to_ileafxf_ph) = ileaf_st + this%matrix_nphtransfer_receiver_patch(this%ileafst_to_ileafxf_ph) = ileaf_xf + + this%ileafxf_to_ileaf_ph = 3 + this%matrix_nphtransfer_doner_patch(this%ileafxf_to_ileaf_ph) = ileaf_xf + this%matrix_nphtransfer_receiver_patch(this%ileafxf_to_ileaf_ph) = ileaf + + this%ifroot_to_iretransn_ph = 4 + this%matrix_nphtransfer_doner_patch(this%ifroot_to_iretransn_ph) = ifroot + this%matrix_nphtransfer_receiver_patch(this%ifroot_to_iretransn_ph) = iretransn + + this%ifrootst_to_ifrootxf_ph = 5 + this%matrix_nphtransfer_doner_patch(this%ifrootst_to_ifrootxf_ph) = ifroot_st + this%matrix_nphtransfer_receiver_patch(this%ifrootst_to_ifrootxf_ph) = ifroot_xf + + this%ifrootxf_to_ifroot_ph = 6 + this%matrix_nphtransfer_doner_patch(this%ifrootxf_to_ifroot_ph) = ifroot_xf + this%matrix_nphtransfer_receiver_patch(this%ifrootxf_to_ifroot_ph) = ifroot + + this%ilivestem_to_ideadstem_ph = 7 + this%matrix_nphtransfer_doner_patch(this%ilivestem_to_ideadstem_ph) = ilivestem + this%matrix_nphtransfer_receiver_patch(this%ilivestem_to_ideadstem_ph) = ideadstem + + this%ilivestem_to_iretransn_ph = 8 + this%matrix_nphtransfer_doner_patch(this%ilivestem_to_iretransn_ph) = ilivestem + this%matrix_nphtransfer_receiver_patch(this%ilivestem_to_iretransn_ph) = iretransn + + this%ilivestemst_to_ilivestemxf_ph = 9 + this%matrix_nphtransfer_doner_patch(this%ilivestemst_to_ilivestemxf_ph) = ilivestem_st + this%matrix_nphtransfer_receiver_patch(this%ilivestemst_to_ilivestemxf_ph) = ilivestem_xf + + this%ilivestemxf_to_ilivestem_ph = 10 + this%matrix_nphtransfer_doner_patch(this%ilivestemxf_to_ilivestem_ph) = ilivestem_xf + this%matrix_nphtransfer_receiver_patch(this%ilivestemxf_to_ilivestem_ph) = ilivestem + + this%ideadstemst_to_ideadstemxf_ph = 11 + this%matrix_nphtransfer_doner_patch(this%ideadstemst_to_ideadstemxf_ph) = ideadstem_st + this%matrix_nphtransfer_receiver_patch(this%ideadstemst_to_ideadstemxf_ph) = ideadstem_xf + + this%ideadstemxf_to_ideadstem_ph = 12 + this%matrix_nphtransfer_doner_patch(this%ideadstemxf_to_ideadstem_ph) = ideadstem_xf + this%matrix_nphtransfer_receiver_patch(this%ideadstemxf_to_ideadstem_ph) = ideadstem + + this%ilivecroot_to_ideadcroot_ph = 13 + this%matrix_nphtransfer_doner_patch(this%ilivecroot_to_ideadcroot_ph) = ilivecroot + this%matrix_nphtransfer_receiver_patch(this%ilivecroot_to_ideadcroot_ph) = ideadcroot + + this%ilivecroot_to_iretransn_ph = 14 + this%matrix_nphtransfer_doner_patch(this%ilivecroot_to_iretransn_ph) = ilivecroot + this%matrix_nphtransfer_receiver_patch(this%ilivecroot_to_iretransn_ph) = iretransn + + this%ilivecrootst_to_ilivecrootxf_ph = 15 + this%matrix_nphtransfer_doner_patch(this%ilivecrootst_to_ilivecrootxf_ph) = ilivecroot_st + this%matrix_nphtransfer_receiver_patch(this%ilivecrootst_to_ilivecrootxf_ph) = ilivecroot_xf + + this%ilivecrootxf_to_ilivecroot_ph = 16 + this%matrix_nphtransfer_doner_patch(this%ilivecrootxf_to_ilivecroot_ph) = ilivecroot_xf + this%matrix_nphtransfer_receiver_patch(this%ilivecrootxf_to_ilivecroot_ph) = ilivecroot + + this%ideadcrootst_to_ideadcrootxf_ph = 17 + this%matrix_nphtransfer_doner_patch(this%ideadcrootst_to_ideadcrootxf_ph) = ideadcroot_st + this%matrix_nphtransfer_receiver_patch(this%ideadcrootst_to_ideadcrootxf_ph) = ideadcroot_xf + + this%ideadcrootxf_to_ideadcroot_ph = 18 + this%matrix_nphtransfer_doner_patch(this%ideadcrootxf_to_ideadcroot_ph) = ideadcroot_xf + this%matrix_nphtransfer_receiver_patch(this%ideadcrootxf_to_ideadcroot_ph) = ideadcroot + + this%iretransn_to_ileaf_ph = 19 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ileaf_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ileaf_ph) = ileaf + + this%iretransn_to_ileafst_ph = 20 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ileafst_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ileafst_ph) = ileaf_st + + this%iretransn_to_ifroot_ph = 21 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ifroot_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ifroot_ph) = ifroot + + this%iretransn_to_ifrootst_ph = 22 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ifrootst_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ifrootst_ph) = ifroot_st + this%iretransn_to_ilivestem_ph = 23 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ilivestem_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ilivestem_ph) = ilivestem + + this%iretransn_to_ilivestemst_ph = 24 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ilivestemst_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ilivestemst_ph) = ilivestem_st + + this%iretransn_to_ideadstem_ph = 25 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ideadstem_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ideadstem_ph) = ideadstem + + this%iretransn_to_ideadstemst_ph = 26 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ideadstemst_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ideadstemst_ph) = ideadstem_st + + this%iretransn_to_ilivecroot_ph = 27 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ilivecroot_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ilivecroot_ph) = ilivecroot + + this%iretransn_to_ilivecrootst_ph = 28 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ilivecrootst_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ilivecrootst_ph) = ilivecroot_st + + this%iretransn_to_ideadcroot_ph = 29 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ideadcroot_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ideadcroot_ph) = ideadcroot + + this%iretransn_to_ideadcrootst_ph = 30 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_ideadcrootst_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_ideadcrootst_ph) = ideadcroot_st + + if(.not. use_crop)then + this%ileaf_to_iout_ph = 31 + this%matrix_nphtransfer_doner_patch(this%ileaf_to_iout_ph) = ileaf + this%matrix_nphtransfer_receiver_patch(this%ileaf_to_iout_ph) = ioutn + + this%ifroot_to_iout_ph = 32 + this%matrix_nphtransfer_doner_patch(this%ifroot_to_iout_ph) = ifroot + this%matrix_nphtransfer_receiver_patch(this%ifroot_to_iout_ph) = ioutn + + this%ilivestem_to_iout_ph = 33 + this%matrix_nphtransfer_doner_patch(this%ilivestem_to_iout_ph) = ilivestem + this%matrix_nphtransfer_receiver_patch(this%ilivestem_to_iout_ph) = ioutn + + this%iretransn_to_iout_ph = 34 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_iout_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_iout_ph) = ioutn + else + this%iretransn_to_igrain_ph = 31 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_igrain_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_igrain_ph) = igrain + + this%iretransn_to_igrainst_ph = 32 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_igrainst_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_igrainst_ph) = igrain_st + + this%ileaf_to_iout_ph = 33 + this%matrix_nphtransfer_doner_patch(this%ileaf_to_iout_ph) = ileaf + this%matrix_nphtransfer_receiver_patch(this%ileaf_to_iout_ph) = ioutn + + this%ifroot_to_iout_ph = 34 + this%matrix_nphtransfer_doner_patch(this%ifroot_to_iout_ph) = ifroot + this%matrix_nphtransfer_receiver_patch(this%ifroot_to_iout_ph) = ioutn + + this%ilivestem_to_iout_ph = 35 + this%matrix_nphtransfer_doner_patch(this%ilivestem_to_iout_ph) = ilivestem + this%matrix_nphtransfer_receiver_patch(this%ilivestem_to_iout_ph) = ioutn + + this%igrain_to_iout_ph = 36 + this%matrix_nphtransfer_doner_patch(this%igrain_to_iout_ph) = igrain + this%matrix_nphtransfer_receiver_patch(this%igrain_to_iout_ph) = ioutn + + this%iretransn_to_iout_ph = 37 + this%matrix_nphtransfer_doner_patch(this%iretransn_to_iout_ph) = iretransn + this%matrix_nphtransfer_receiver_patch(this%iretransn_to_iout_ph) = ioutn + end if + + this%ileaf_to_iout_gm = 1 + this%matrix_ngmtransfer_doner_patch(this%ileaf_to_iout_gm) = ileaf + this%matrix_ngmtransfer_receiver_patch(this%ileaf_to_iout_gm) = ioutn + + this%ileafst_to_iout_gm = 2 + this%matrix_ngmtransfer_doner_patch(this%ileafst_to_iout_gm) = ileaf_st + this%matrix_ngmtransfer_receiver_patch(this%ileafst_to_iout_gm) = ioutn + + this%ileafxf_to_iout_gm = 3 + this%matrix_ngmtransfer_doner_patch(this%ileafxf_to_iout_gm) = ileaf_xf + this%matrix_ngmtransfer_receiver_patch(this%ileafxf_to_iout_gm) = ioutn + + this%ifroot_to_iout_gm = 4 + this%matrix_ngmtransfer_doner_patch(this%ifroot_to_iout_gm) = ifroot + this%matrix_ngmtransfer_receiver_patch(this%ifroot_to_iout_gm) = ioutn + + this%ifrootst_to_iout_gm = 5 + this%matrix_ngmtransfer_doner_patch(this%ifrootst_to_iout_gm) = ifroot_st + this%matrix_ngmtransfer_receiver_patch(this%ifrootst_to_iout_gm) = ioutn + + this%ifrootxf_to_iout_gm = 6 + this%matrix_ngmtransfer_doner_patch(this%ifrootxf_to_iout_gm) = ifroot_xf + this%matrix_ngmtransfer_receiver_patch(this%ifrootxf_to_iout_gm) = ioutn + + this%ilivestem_to_iout_gm = 7 + this%matrix_ngmtransfer_doner_patch(this%ilivestem_to_iout_gm) = ilivestem + this%matrix_ngmtransfer_receiver_patch(this%ilivestem_to_iout_gm) = ioutn + + this%ilivestemst_to_iout_gm = 8 + this%matrix_ngmtransfer_doner_patch(this%ilivestemst_to_iout_gm) = ilivestem_st + this%matrix_ngmtransfer_receiver_patch(this%ilivestemst_to_iout_gm) = ioutn + + this%ilivestemxf_to_iout_gm = 9 + this%matrix_ngmtransfer_doner_patch(this%ilivestemxf_to_iout_gm) = ilivestem_xf + this%matrix_ngmtransfer_receiver_patch(this%ilivestemxf_to_iout_gm) = ioutn + + this%ideadstem_to_iout_gm = 10 + this%matrix_ngmtransfer_doner_patch(this%ideadstem_to_iout_gm) = ideadstem + this%matrix_ngmtransfer_receiver_patch(this%ideadstem_to_iout_gm) = ioutn + + this%ideadstemst_to_iout_gm = 11 + this%matrix_ngmtransfer_doner_patch(this%ideadstemst_to_iout_gm) = ideadstem_st + this%matrix_ngmtransfer_receiver_patch(this%ideadstemst_to_iout_gm) = ioutn + + this%ideadstemxf_to_iout_gm = 12 + this%matrix_ngmtransfer_doner_patch(this%ideadstemxf_to_iout_gm) = ideadstem_xf + this%matrix_ngmtransfer_receiver_patch(this%ideadstemxf_to_iout_gm) = ioutn + + this%ilivecroot_to_iout_gm = 13 + this%matrix_ngmtransfer_doner_patch(this%ilivecroot_to_iout_gm) = ilivecroot + this%matrix_ngmtransfer_receiver_patch(this%ilivecroot_to_iout_gm) = ioutn + + this%ilivecrootst_to_iout_gm = 14 + this%matrix_ngmtransfer_doner_patch(this%ilivecrootst_to_iout_gm) = ilivecroot_st + this%matrix_ngmtransfer_receiver_patch(this%ilivecrootst_to_iout_gm) = ioutn + + + this%ilivecrootxf_to_iout_gm = 15 + this%matrix_ngmtransfer_doner_patch(this%ilivecrootxf_to_iout_gm) = ilivecroot_xf + this%matrix_ngmtransfer_receiver_patch(this%ilivecrootxf_to_iout_gm) = ioutn + + this%ideadcroot_to_iout_gm = 16 + this%matrix_ngmtransfer_doner_patch(this%ideadcroot_to_iout_gm) = ideadcroot + this%matrix_ngmtransfer_receiver_patch(this%ideadcroot_to_iout_gm) = ioutn + + this%ideadcrootst_to_iout_gm = 17 + this%matrix_ngmtransfer_doner_patch(this%ideadcrootst_to_iout_gm) = ideadcroot_st + this%matrix_ngmtransfer_receiver_patch(this%ideadcrootst_to_iout_gm) = ioutn + + this%ideadcrootxf_to_iout_gm = 18 + this%matrix_ngmtransfer_doner_patch(this%ideadcrootxf_to_iout_gm) = ideadcroot_xf + this%matrix_ngmtransfer_receiver_patch(this%ideadcrootxf_to_iout_gm) = ioutn + + this%iretransn_to_iout_gm = 19 + this%matrix_ngmtransfer_doner_patch(this%iretransn_to_iout_gm) = iretransn + this%matrix_ngmtransfer_receiver_patch(this%iretransn_to_iout_gm) = ioutn + + this%ilivestem_to_ideadstem_fi = 1 + this%matrix_nfitransfer_doner_patch(this%ilivestem_to_ideadstem_fi) = ilivestem + this%matrix_nfitransfer_receiver_patch(this%ilivestem_to_ideadstem_fi) = ideadstem + + this%ilivecroot_to_ideadcroot_fi = 2 + this%matrix_nfitransfer_doner_patch(this%ilivecroot_to_ideadcroot_fi) = ilivecroot + this%matrix_nfitransfer_receiver_patch(this%ilivecroot_to_ideadcroot_fi) = ideadcroot + + this%ileaf_to_iout_fi = 3 + this%matrix_nfitransfer_doner_patch(this%ileaf_to_iout_fi) = ileaf + this%matrix_nfitransfer_receiver_patch(this%ileaf_to_iout_fi) = ioutn + + this%ileafst_to_iout_fi = 4 + this%matrix_nfitransfer_doner_patch(this%ileafst_to_iout_fi) = ileaf_st + this%matrix_nfitransfer_receiver_patch(this%ileafst_to_iout_fi) = ioutn + + this%ileafxf_to_iout_fi = 5 + this%matrix_nfitransfer_doner_patch(this%ileafxf_to_iout_fi) = ileaf_xf + this%matrix_nfitransfer_receiver_patch(this%ileafxf_to_iout_fi) = ioutn + + this%ifroot_to_iout_fi = 6 + this%matrix_nfitransfer_doner_patch(this%ifroot_to_iout_fi) = ifroot + this%matrix_nfitransfer_receiver_patch(this%ifroot_to_iout_fi) = ioutn + + this%ifrootst_to_iout_fi = 7 + this%matrix_nfitransfer_doner_patch(this%ifrootst_to_iout_fi) = ifroot_st + this%matrix_nfitransfer_receiver_patch(this%ifrootst_to_iout_fi) = ioutn + + this%ifrootxf_to_iout_fi = 8 + this%matrix_nfitransfer_doner_patch(this%ifrootxf_to_iout_fi) = ifroot_xf + this%matrix_nfitransfer_receiver_patch(this%ifrootxf_to_iout_fi) = ioutn + + this%ilivestem_to_iout_fi = 9 + this%matrix_nfitransfer_doner_patch(this%ilivestem_to_iout_fi) = ilivestem + this%matrix_nfitransfer_receiver_patch(this%ilivestem_to_iout_fi) = ioutn + + this%ilivestemst_to_iout_fi = 10 + this%matrix_nfitransfer_doner_patch(this%ilivestemst_to_iout_fi) = ilivestem_st + this%matrix_nfitransfer_receiver_patch(this%ilivestemst_to_iout_fi) = ioutn + + this%ilivestemxf_to_iout_fi = 11 + this%matrix_nfitransfer_doner_patch(this%ilivestemxf_to_iout_fi) = ilivestem_xf + this%matrix_nfitransfer_receiver_patch(this%ilivestemxf_to_iout_fi) = ioutn + + this%ideadstem_to_iout_fi = 12 + this%matrix_nfitransfer_doner_patch(this%ideadstem_to_iout_fi) = ideadstem + this%matrix_nfitransfer_receiver_patch(this%ideadstem_to_iout_fi) = ioutn + + this%ideadstemst_to_iout_fi = 13 + this%matrix_nfitransfer_doner_patch(this%ideadstemst_to_iout_fi) = ideadstem_st + this%matrix_nfitransfer_receiver_patch(this%ideadstemst_to_iout_fi) = ioutn + + this%ideadstemxf_to_iout_fi = 14 + this%matrix_nfitransfer_doner_patch(this%ideadstemxf_to_iout_fi) = ideadstem_xf + this%matrix_nfitransfer_receiver_patch(this%ideadstemxf_to_iout_fi) = ioutn + + this%ilivecroot_to_iout_fi = 15 + this%matrix_nfitransfer_doner_patch(this%ilivecroot_to_iout_fi) = ilivecroot + this%matrix_nfitransfer_receiver_patch(this%ilivecroot_to_iout_fi) = ioutn + + this%ilivecrootst_to_iout_fi = 16 + this%matrix_nfitransfer_doner_patch(this%ilivecrootst_to_iout_fi) = ilivecroot_st + this%matrix_nfitransfer_receiver_patch(this%ilivecrootst_to_iout_fi) = ioutn + + this%ilivecrootxf_to_iout_fi = 17 + this%matrix_nfitransfer_doner_patch(this%ilivecrootxf_to_iout_fi) = ilivecroot_xf + this%matrix_nfitransfer_receiver_patch(this%ilivecrootxf_to_iout_fi) = ioutn + + + this%ideadcroot_to_iout_fi = 18 + this%matrix_nfitransfer_doner_patch(this%ideadcroot_to_iout_fi) = ideadcroot + this%matrix_nfitransfer_receiver_patch(this%ideadcroot_to_iout_fi) = ioutn + + this%ideadcrootst_to_iout_fi = 19 + this%matrix_nfitransfer_doner_patch(this%ideadcrootst_to_iout_fi) = ideadcroot_st + this%matrix_nfitransfer_receiver_patch(this%ideadcrootst_to_iout_fi) = ioutn + + this%ideadcrootxf_to_iout_fi = 20 + this%matrix_nfitransfer_doner_patch(this%ideadcrootxf_to_iout_fi) = ideadcroot_xf + this%matrix_nfitransfer_receiver_patch(this%ideadcrootxf_to_iout_fi) = ioutn + + this%iretransn_to_iout_fi = 21 + this%matrix_nfitransfer_doner_patch(this%iretransn_to_iout_fi) = iretransn + this%matrix_nfitransfer_receiver_patch(this%iretransn_to_iout_fi) = ioutn + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + + allocate(this%m_leafn_to_litter_patch (begp:endp)) ; this%m_leafn_to_litter_patch (:) = nan + allocate(this%m_frootn_to_litter_patch (begp:endp)) ; this%m_frootn_to_litter_patch (:) = nan + allocate(this%m_leafn_storage_to_litter_patch (begp:endp)) ; this%m_leafn_storage_to_litter_patch (:) = nan + allocate(this%m_frootn_storage_to_litter_patch (begp:endp)) ; this%m_frootn_storage_to_litter_patch (:) = nan + allocate(this%m_livestemn_storage_to_litter_patch (begp:endp)) ; this%m_livestemn_storage_to_litter_patch (:) = nan + allocate(this%m_deadstemn_storage_to_litter_patch (begp:endp)) ; this%m_deadstemn_storage_to_litter_patch (:) = nan + allocate(this%m_livecrootn_storage_to_litter_patch (begp:endp)) ; this%m_livecrootn_storage_to_litter_patch (:) = nan + allocate(this%m_deadcrootn_storage_to_litter_patch (begp:endp)) ; this%m_deadcrootn_storage_to_litter_patch (:) = nan + allocate(this%m_leafn_xfer_to_litter_patch (begp:endp)) ; this%m_leafn_xfer_to_litter_patch (:) = nan + allocate(this%m_frootn_xfer_to_litter_patch (begp:endp)) ; this%m_frootn_xfer_to_litter_patch (:) = nan + allocate(this%m_livestemn_xfer_to_litter_patch (begp:endp)) ; this%m_livestemn_xfer_to_litter_patch (:) = nan + allocate(this%m_deadstemn_xfer_to_litter_patch (begp:endp)) ; this%m_deadstemn_xfer_to_litter_patch (:) = nan + allocate(this%m_livecrootn_xfer_to_litter_patch (begp:endp)) ; this%m_livecrootn_xfer_to_litter_patch (:) = nan + allocate(this%m_deadcrootn_xfer_to_litter_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_litter_patch (:) = nan + allocate(this%m_livestemn_to_litter_patch (begp:endp)) ; this%m_livestemn_to_litter_patch (:) = nan + allocate(this%m_deadstemn_to_litter_patch (begp:endp)) ; this%m_deadstemn_to_litter_patch (:) = nan + allocate(this%m_livecrootn_to_litter_patch (begp:endp)) ; this%m_livecrootn_to_litter_patch (:) = nan + allocate(this%m_deadcrootn_to_litter_patch (begp:endp)) ; this%m_deadcrootn_to_litter_patch (:) = nan + allocate(this%m_retransn_to_litter_patch (begp:endp)) ; this%m_retransn_to_litter_patch (:) = nan + allocate(this%hrv_leafn_to_litter_patch (begp:endp)) ; this%hrv_leafn_to_litter_patch (:) = nan + allocate(this%hrv_frootn_to_litter_patch (begp:endp)) ; this%hrv_frootn_to_litter_patch (:) = nan + allocate(this%hrv_leafn_storage_to_litter_patch (begp:endp)) ; this%hrv_leafn_storage_to_litter_patch (:) = nan + allocate(this%hrv_frootn_storage_to_litter_patch (begp:endp)) ; this%hrv_frootn_storage_to_litter_patch (:) = nan + allocate(this%hrv_livestemn_storage_to_litter_patch (begp:endp)) ; this%hrv_livestemn_storage_to_litter_patch (:) = nan + allocate(this%hrv_deadstemn_storage_to_litter_patch (begp:endp)) ; this%hrv_deadstemn_storage_to_litter_patch (:) = nan + allocate(this%hrv_livecrootn_storage_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_storage_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootn_storage_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_storage_to_litter_patch (:) = nan + allocate(this%hrv_leafn_xfer_to_litter_patch (begp:endp)) ; this%hrv_leafn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_frootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_frootn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livestemn_xfer_to_litter_patch (begp:endp)) ; this%hrv_livestemn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_deadstemn_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadstemn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livecrootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livestemn_to_litter_patch (begp:endp)) ; this%hrv_livestemn_to_litter_patch (:) = nan + allocate(this%hrv_livecrootn_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootn_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_to_litter_patch (:) = nan + allocate(this%hrv_retransn_to_litter_patch (begp:endp)) ; this%hrv_retransn_to_litter_patch (:) = nan + + allocate(this%m_leafn_to_fire_patch (begp:endp)) ; this%m_leafn_to_fire_patch (:) = nan + allocate(this%m_leafn_storage_to_fire_patch (begp:endp)) ; this%m_leafn_storage_to_fire_patch (:) = nan + allocate(this%m_leafn_xfer_to_fire_patch (begp:endp)) ; this%m_leafn_xfer_to_fire_patch (:) = nan + allocate(this%m_livestemn_to_fire_patch (begp:endp)) ; this%m_livestemn_to_fire_patch (:) = nan + allocate(this%m_livestemn_storage_to_fire_patch (begp:endp)) ; this%m_livestemn_storage_to_fire_patch (:) = nan + allocate(this%m_livestemn_xfer_to_fire_patch (begp:endp)) ; this%m_livestemn_xfer_to_fire_patch (:) = nan + allocate(this%m_deadstemn_to_fire_patch (begp:endp)) ; this%m_deadstemn_to_fire_patch (:) = nan + allocate(this%m_deadstemn_storage_to_fire_patch (begp:endp)) ; this%m_deadstemn_storage_to_fire_patch (:) = nan + allocate(this%m_deadstemn_xfer_to_fire_patch (begp:endp)) ; this%m_deadstemn_xfer_to_fire_patch (:) = nan + allocate(this%m_frootn_to_fire_patch (begp:endp)) ; this%m_frootn_to_fire_patch (:) = nan + allocate(this%m_frootn_storage_to_fire_patch (begp:endp)) ; this%m_frootn_storage_to_fire_patch (:) = nan + allocate(this%m_frootn_xfer_to_fire_patch (begp:endp)) ; this%m_frootn_xfer_to_fire_patch (:) = nan + allocate(this%m_livecrootn_to_fire_patch (begp:endp)) ; + allocate(this%m_livecrootn_storage_to_fire_patch (begp:endp)) ; this%m_livecrootn_storage_to_fire_patch (:) = nan + allocate(this%m_livecrootn_xfer_to_fire_patch (begp:endp)) ; this%m_livecrootn_xfer_to_fire_patch (:) = nan + allocate(this%m_deadcrootn_to_fire_patch (begp:endp)) ; this%m_deadcrootn_to_fire_patch (:) = nan + allocate(this%m_deadcrootn_storage_to_fire_patch (begp:endp)) ; this%m_deadcrootn_storage_to_fire_patch (:) = nan + allocate(this%m_deadcrootn_xfer_to_fire_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_fire_patch (:) = nan + allocate(this%m_retransn_to_fire_patch (begp:endp)) ; this%m_retransn_to_fire_patch (:) = nan + + allocate(this%m_leafn_to_litter_fire_patch (begp:endp)) ; this%m_leafn_to_litter_fire_patch (:) = nan + allocate(this%m_leafn_storage_to_litter_fire_patch (begp:endp)) ; this%m_leafn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_leafn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_leafn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livestemn_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_to_litter_fire_patch (:) = nan + allocate(this%m_livestemn_storage_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_livestemn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livestemn_to_deadstemn_fire_patch (begp:endp)) ; this%m_livestemn_to_deadstemn_fire_patch (:) = nan + allocate(this%m_deadstemn_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_to_litter_fire_patch (:) = nan + allocate(this%m_deadstemn_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_deadstemn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_frootn_to_litter_fire_patch (begp:endp)) ; this%m_frootn_to_litter_fire_patch (:) = nan + allocate(this%m_frootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_frootn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_frootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_frootn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootn_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootn_to_deadcrootn_fire_patch (begp:endp)) ; this%m_livecrootn_to_deadcrootn_fire_patch (:) = nan + allocate(this%m_deadcrootn_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_to_litter_fire_patch (:) = nan + allocate(this%m_deadcrootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_deadcrootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_retransn_to_litter_fire_patch (begp:endp)) ; this%m_retransn_to_litter_fire_patch (:) = nan + + + allocate(this%leafn_xfer_to_leafn_patch (begp:endp)) ; this%leafn_xfer_to_leafn_patch (:) = nan + allocate(this%frootn_xfer_to_frootn_patch (begp:endp)) ; this%frootn_xfer_to_frootn_patch (:) = nan + allocate(this%livestemn_xfer_to_livestemn_patch (begp:endp)) ; this%livestemn_xfer_to_livestemn_patch (:) = nan + allocate(this%deadstemn_xfer_to_deadstemn_patch (begp:endp)) ; this%deadstemn_xfer_to_deadstemn_patch (:) = nan + allocate(this%livecrootn_xfer_to_livecrootn_patch (begp:endp)) ; this%livecrootn_xfer_to_livecrootn_patch (:) = nan + allocate(this%deadcrootn_xfer_to_deadcrootn_patch (begp:endp)) ; this%deadcrootn_xfer_to_deadcrootn_patch (:) = nan + allocate(this%leafn_to_litter_patch (begp:endp)) ; this%leafn_to_litter_patch (:) = nan + allocate(this%leafn_to_retransn_patch (begp:endp)) ; this%leafn_to_retransn_patch (:) = nan + allocate(this%frootn_to_retransn_patch (begp:endp)) ; this%frootn_to_retransn_patch (:) = nan + allocate(this%frootn_to_litter_patch (begp:endp)) ; this%frootn_to_litter_patch (:) = nan + allocate(this%retransn_to_npool_patch (begp:endp)) ; this%retransn_to_npool_patch (:) = nan + allocate(this%free_retransn_to_npool_patch (begp:endp)) ; this%free_retransn_to_npool_patch (:) = nan + allocate(this%sminn_to_npool_patch (begp:endp)) ; this%sminn_to_npool_patch (:) = nan + + allocate(this%npool_to_leafn_patch (begp:endp)) ; this%npool_to_leafn_patch (:) = nan + allocate(this%npool_to_leafn_storage_patch (begp:endp)) ; this%npool_to_leafn_storage_patch (:) = nan + allocate(this%npool_to_frootn_patch (begp:endp)) ; this%npool_to_frootn_patch (:) = nan + allocate(this%npool_to_frootn_storage_patch (begp:endp)) ; this%npool_to_frootn_storage_patch (:) = nan + allocate(this%npool_to_livestemn_patch (begp:endp)) ; this%npool_to_livestemn_patch (:) = nan + allocate(this%npool_to_livestemn_storage_patch (begp:endp)) ; this%npool_to_livestemn_storage_patch (:) = nan + allocate(this%npool_to_deadstemn_patch (begp:endp)) ; this%npool_to_deadstemn_patch (:) = nan + allocate(this%npool_to_deadstemn_storage_patch (begp:endp)) ; this%npool_to_deadstemn_storage_patch (:) = nan + allocate(this%npool_to_livecrootn_patch (begp:endp)) ; this%npool_to_livecrootn_patch (:) = nan + allocate(this%npool_to_livecrootn_storage_patch (begp:endp)) ; this%npool_to_livecrootn_storage_patch (:) = nan + allocate(this%npool_to_deadcrootn_patch (begp:endp)) ; this%npool_to_deadcrootn_patch (:) = nan + allocate(this%npool_to_deadcrootn_storage_patch (begp:endp)) ; this%npool_to_deadcrootn_storage_patch (:) = nan + allocate(this%leafn_storage_to_xfer_patch (begp:endp)) ; this%leafn_storage_to_xfer_patch (:) = nan + allocate(this%frootn_storage_to_xfer_patch (begp:endp)) ; this%frootn_storage_to_xfer_patch (:) = nan + allocate(this%livestemn_storage_to_xfer_patch (begp:endp)) ; this%livestemn_storage_to_xfer_patch (:) = nan + allocate(this%deadstemn_storage_to_xfer_patch (begp:endp)) ; this%deadstemn_storage_to_xfer_patch (:) = nan + allocate(this%livecrootn_storage_to_xfer_patch (begp:endp)) ; this%livecrootn_storage_to_xfer_patch (:) = nan + allocate(this%deadcrootn_storage_to_xfer_patch (begp:endp)) ; this%deadcrootn_storage_to_xfer_patch (:) = nan + allocate(this%livestemn_to_deadstemn_patch (begp:endp)) ; this%livestemn_to_deadstemn_patch (:) = nan + allocate(this%livestemn_to_retransn_patch (begp:endp)) ; this%livestemn_to_retransn_patch (:) = nan + allocate(this%livecrootn_to_deadcrootn_patch (begp:endp)) ; this%livecrootn_to_deadcrootn_patch (:) = nan + allocate(this%livecrootn_to_retransn_patch (begp:endp)) ; this%livecrootn_to_retransn_patch (:) = nan + allocate(this%ndeploy_patch (begp:endp)) ; this%ndeploy_patch (:) = nan + allocate(this%wood_harvestn_patch (begp:endp)) ; this%wood_harvestn_patch (:) = nan + allocate(this%fire_nloss_patch (begp:endp)) ; this%fire_nloss_patch (:) = nan + allocate(this%npool_to_grainn_patch (begp:endp)) ; this%npool_to_grainn_patch (:) = nan + allocate(this%npool_to_grainn_storage_patch (begp:endp)) ; this%npool_to_grainn_storage_patch (:) = nan + allocate(this%livestemn_to_litter_patch (begp:endp)) ; this%livestemn_to_litter_patch (:) = nan + allocate(this%grainn_to_food_patch (begp:endp)) ; this%grainn_to_food_patch (:) = nan + allocate(this%leafn_to_biofueln_patch (begp:endp)) ; this%leafn_to_biofueln_patch (:) = nan + allocate(this%livestemn_to_biofueln_patch (begp:endp)) ; this%livestemn_to_biofueln_patch (:) = nan + allocate(this%grainn_to_seed_patch (begp:endp)) ; this%grainn_to_seed_patch (:) = nan + allocate(this%grainn_xfer_to_grainn_patch (begp:endp)) ; this%grainn_xfer_to_grainn_patch (:) = nan + allocate(this%grainn_storage_to_xfer_patch (begp:endp)) ; this%grainn_storage_to_xfer_patch (:) = nan + allocate(this%fert_patch (begp:endp)) ; this%fert_patch (:) = nan + allocate(this%fert_counter_patch (begp:endp)) ; this%fert_counter_patch (:) = nan + allocate(this%soyfixn_patch (begp:endp)) ; this%soyfixn_patch (:) = nan + + allocate(this%grainn_to_cropprodn_patch (begp:endp)) ; this%grainn_to_cropprodn_patch (:) = nan + allocate(this%grainn_to_cropprodn_col (begc:endc)) ; this%grainn_to_cropprodn_col (:) = nan + + allocate(this%fire_nloss_col (begc:endc)) ; this%fire_nloss_col (:) = nan + allocate(this%fire_nloss_p2c_col (begc:endc)) ; this%fire_nloss_p2c_col (:) = nan + + allocate(this%m_n_to_litr_met_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_met_fire_col (:,:) = nan + allocate(this%m_n_to_litr_cel_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_cel_fire_col (:,:) = nan + allocate(this%m_n_to_litr_lig_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_lig_fire_col (:,:) = nan + + allocate(this%dwt_seedn_to_leaf_patch (begp:endp)) ; this%dwt_seedn_to_leaf_patch (:) = nan + allocate(this%dwt_seedn_to_leaf_grc (begg:endg)) ; this%dwt_seedn_to_leaf_grc (:) = nan + allocate(this%dwt_seedn_to_deadstem_patch (begp:endp)) ; this%dwt_seedn_to_deadstem_patch (:) = nan + allocate(this%dwt_seedn_to_deadstem_grc (begg:endg)) ; this%dwt_seedn_to_deadstem_grc (:) = nan + allocate(this%dwt_conv_nflux_patch (begp:endp)) ; this%dwt_conv_nflux_patch (:) = nan + allocate(this%dwt_conv_nflux_grc (begg:endg)) ; this%dwt_conv_nflux_grc (:) = nan + allocate(this%dwt_wood_productn_gain_patch (begp:endp)) ; this%dwt_wood_productn_gain_patch (:) = nan + allocate(this%dwt_crop_productn_gain_patch (begp:endp)) ; this%dwt_crop_productn_gain_patch (:) = nan + allocate(this%wood_harvestn_col (begc:endc)) ; this%wood_harvestn_col (:) = nan + + allocate(this%dwt_frootn_to_litr_met_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_met_n_col (:,:) = nan + allocate(this%dwt_frootn_to_litr_cel_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_cel_n_col (:,:) = nan + allocate(this%dwt_frootn_to_litr_lig_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_lig_n_col (:,:) = nan + allocate(this%dwt_livecrootn_to_cwdn_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_livecrootn_to_cwdn_col (:,:) = nan + allocate(this%dwt_deadcrootn_to_cwdn_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_deadcrootn_to_cwdn_col (:,:) = nan + + allocate(this%crop_seedn_to_leaf_patch (begp:endp)) ; this%crop_seedn_to_leaf_patch (:) = nan + + allocate(this%m_decomp_npools_to_fire_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + allocate(this%m_decomp_npools_to_fire_col (begc:endc,1:ndecomp_pools )) + + this%m_decomp_npools_to_fire_vr_col (:,:,:) = nan + this%m_decomp_npools_to_fire_col (:,:) = nan + + allocate(this%phenology_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%phenology_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%phenology_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%gap_mortality_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%gap_mortality_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%gap_mortality_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%gap_mortality_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%fire_mortality_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%harvest_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%harvest_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%harvest_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%harvest_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full)) + + this%phenology_n_to_litr_met_n_col (:,:) = nan + this%phenology_n_to_litr_cel_n_col (:,:) = nan + this%phenology_n_to_litr_lig_n_col (:,:) = nan + this%gap_mortality_n_to_litr_met_n_col (:,:) = nan + this%gap_mortality_n_to_litr_cel_n_col (:,:) = nan + this%gap_mortality_n_to_litr_lig_n_col (:,:) = nan + this%gap_mortality_n_to_cwdn_col (:,:) = nan + this%fire_mortality_n_to_cwdn_col (:,:) = nan + this%harvest_n_to_litr_met_n_col (:,:) = nan + this%harvest_n_to_litr_cel_n_col (:,:) = nan + this%harvest_n_to_litr_lig_n_col (:,:) = nan + this%harvest_n_to_cwdn_col (:,:) = nan + + allocate(this%plant_ndemand_patch (begp:endp)) ; this%plant_ndemand_patch (:) = nan + allocate(this%avail_retransn_patch (begp:endp)) ; this%avail_retransn_patch (:) = nan + allocate(this%plant_nalloc_patch (begp:endp)) ; this%plant_nalloc_patch (:) = nan + + allocate(this%plant_ndemand_retrans_patch (begp:endp)) ; this%plant_ndemand_retrans_patch (:) = nan + allocate(this%plant_ndemand_season_patch (begp:endp)) ; this%plant_ndemand_season_patch (:) = nan + allocate(this%plant_ndemand_stress_patch (begp:endp)) ; this%plant_ndemand_stress_patch (:) = nan + allocate(this%Nactive_patch (begp:endp)) ; this%Nactive_patch (:) = nan + allocate(this%Nnonmyc_patch (begp:endp)) ; this%Nnonmyc_patch (:) = nan + allocate(this%Nam_patch (begp:endp)) ; this%Nam_patch (:) = nan + allocate(this%Necm_patch (begp:endp)) ; this%Necm_patch (:) = nan + allocate(this%Nactive_no3_patch (begp:endp)) ; this%Nactive_no3_patch (:) = nan + allocate(this%Nactive_nh4_patch (begp:endp)) ; this%Nactive_nh4_patch (:) = nan + allocate(this%Nnonmyc_no3_patch (begp:endp)) ; this%Nnonmyc_no3_patch (:) = nan + allocate(this%Nnonmyc_nh4_patch (begp:endp)) ; this%Nnonmyc_nh4_patch (:) = nan + allocate(this%Nam_no3_patch (begp:endp)) ; this%Nam_no3_patch (:) = nan + allocate(this%Nam_nh4_patch (begp:endp)) ; this%Nam_nh4_patch (:) = nan + allocate(this%Necm_no3_patch (begp:endp)) ; this%Necm_no3_patch (:) = nan + allocate(this%Necm_nh4_patch (begp:endp)) ; this%Necm_nh4_patch (:) = nan + allocate(this%Npassive_patch (begp:endp)) ; this%Npassive_patch (:) = nan + allocate(this%Nfix_patch (begp:endp)) ; this%Nfix_patch (:) = nan + allocate(this%Nretrans_patch (begp:endp)) ; this%Nretrans_patch (:) = nan + allocate(this%Nretrans_org_patch (begp:endp)) ; this%Nretrans_org_patch (:) = nan + allocate(this%Nretrans_season_patch (begp:endp)) ; this%Nretrans_season_patch (:) = nan + allocate(this%Nretrans_stress_patch (begp:endp)) ; this%Nretrans_stress_patch (:) = nan + allocate(this%Nuptake_patch (begp:endp)) ; this%Nuptake_patch (:) = nan + allocate(this%sminn_to_plant_fun_patch (begp:endp)) ; this%sminn_to_plant_fun_patch (:) = nan + allocate(this%sminn_to_plant_fun_vr_patch (begp:endp,1:nlevdecomp_full)) + this%sminn_to_plant_fun_vr_patch (:,:) = nan + allocate(this%sminn_to_plant_fun_no3_vr_patch (begp:endp,1:nlevdecomp_full)) + this%sminn_to_plant_fun_no3_vr_patch (:,:) = nan + allocate(this%sminn_to_plant_fun_nh4_vr_patch (begp:endp,1:nlevdecomp_full)) + this%sminn_to_plant_fun_nh4_vr_patch (:,:) = nan + allocate(this%cost_nfix_patch (begp:endp)) ; this%cost_nfix_patch (:) = nan + allocate(this%cost_nactive_patch (begp:endp)) ; this%cost_nactive_patch (:) = nan + allocate(this%cost_nretrans_patch (begp:endp)) ; this%cost_nretrans_patch (:) = nan + allocate(this%nuptake_npp_fraction_patch (begp:endp)) ; this%nuptake_npp_fraction_patch (:) = nan + + + ! initialize variables from restart file or set to cold start value + n = 0 + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + n = n + 1 + + + + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + + this%plant_ndemand_patch (np) = cnpft(nc,nz,nv, 75) + + end if + end do !nv + end do ! p + end do ! nz + end do ! nc + + end subroutine init_cnveg_nitrogenflux_type + +!------------------------------------------ + subroutine SetValues ( this,nvegnpool, & + num_patch, filter_patch, value_patch, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set nitrogen flux variables + ! + ! !ARGUMENTS: + ! !ARGUMENTS: + class (cnveg_nitrogenflux_type) :: this + integer , intent(in) :: num_patch,nvegnpool + integer , intent(in) :: filter_patch(:) + real(r8), intent(in) :: value_patch + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i,j,k,l ! loop index + !------------------------------------------------------------------------ + + do fi = 1,num_patch + i=filter_patch(fi) + + this%m_leafn_to_litter_patch(i) = value_patch + this%m_frootn_to_litter_patch(i) = value_patch + this%m_leafn_storage_to_litter_patch(i) = value_patch + this%m_frootn_storage_to_litter_patch(i) = value_patch + this%m_livestemn_storage_to_litter_patch(i) = value_patch + this%m_deadstemn_storage_to_litter_patch(i) = value_patch + this%m_livecrootn_storage_to_litter_patch(i) = value_patch + this%m_deadcrootn_storage_to_litter_patch(i) = value_patch + this%m_leafn_xfer_to_litter_patch(i) = value_patch + this%m_frootn_xfer_to_litter_patch(i) = value_patch + this%m_livestemn_xfer_to_litter_patch(i) = value_patch + this%m_deadstemn_xfer_to_litter_patch(i) = value_patch + this%m_livecrootn_xfer_to_litter_patch(i) = value_patch + this%m_deadcrootn_xfer_to_litter_patch(i) = value_patch + this%m_livestemn_to_litter_patch(i) = value_patch + this%m_deadstemn_to_litter_patch(i) = value_patch + this%m_livecrootn_to_litter_patch(i) = value_patch + this%m_deadcrootn_to_litter_patch(i) = value_patch + this%m_retransn_to_litter_patch(i) = value_patch + this%hrv_leafn_to_litter_patch(i) = value_patch + this%hrv_frootn_to_litter_patch(i) = value_patch + this%hrv_leafn_storage_to_litter_patch(i) = value_patch + this%hrv_frootn_storage_to_litter_patch(i) = value_patch + this%hrv_livestemn_storage_to_litter_patch(i) = value_patch + this%hrv_deadstemn_storage_to_litter_patch(i) = value_patch + this%hrv_livecrootn_storage_to_litter_patch(i) = value_patch + this%hrv_deadcrootn_storage_to_litter_patch(i) = value_patch + this%hrv_leafn_xfer_to_litter_patch(i) = value_patch + this%hrv_frootn_xfer_to_litter_patch(i) = value_patch + this%hrv_livestemn_xfer_to_litter_patch(i) = value_patch + this%hrv_deadstemn_xfer_to_litter_patch(i) = value_patch + this%hrv_livecrootn_xfer_to_litter_patch(i) = value_patch + this%hrv_deadcrootn_xfer_to_litter_patch(i) = value_patch + this%hrv_livestemn_to_litter_patch(i) = value_patch + this%hrv_livecrootn_to_litter_patch(i) = value_patch + this%hrv_deadcrootn_to_litter_patch(i) = value_patch + this%hrv_retransn_to_litter_patch(i) = value_patch + + this%m_leafn_to_fire_patch(i) = value_patch + this%m_leafn_storage_to_fire_patch(i) = value_patch + this%m_leafn_xfer_to_fire_patch(i) = value_patch + this%m_livestemn_to_fire_patch(i) = value_patch + this%m_livestemn_storage_to_fire_patch(i) = value_patch + this%m_livestemn_xfer_to_fire_patch(i) = value_patch + this%m_deadstemn_to_fire_patch(i) = value_patch + this%m_deadstemn_storage_to_fire_patch(i) = value_patch + this%m_deadstemn_xfer_to_fire_patch(i) = value_patch + this%m_frootn_to_fire_patch(i) = value_patch + this%m_frootn_storage_to_fire_patch(i) = value_patch + this%m_frootn_xfer_to_fire_patch(i) = value_patch + this%m_livecrootn_to_fire_patch(i) = value_patch + this%m_livecrootn_storage_to_fire_patch(i) = value_patch + this%m_livecrootn_xfer_to_fire_patch(i) = value_patch + this%m_deadcrootn_to_fire_patch(i) = value_patch + this%m_deadcrootn_storage_to_fire_patch(i) = value_patch + this%m_deadcrootn_xfer_to_fire_patch(i) = value_patch + this%m_retransn_to_fire_patch(i) = value_patch + + + this%m_leafn_to_litter_fire_patch(i) = value_patch + this%m_leafn_storage_to_litter_fire_patch(i) = value_patch + this%m_leafn_xfer_to_litter_fire_patch(i) = value_patch + this%m_livestemn_to_litter_fire_patch(i) = value_patch + this%m_livestemn_storage_to_litter_fire_patch(i) = value_patch + this%m_livestemn_xfer_to_litter_fire_patch(i) = value_patch + this%m_livestemn_to_deadstemn_fire_patch(i) = value_patch + this%m_deadstemn_to_litter_fire_patch(i) = value_patch + this%m_deadstemn_storage_to_litter_fire_patch(i) = value_patch + this%m_deadstemn_xfer_to_litter_fire_patch(i) = value_patch + this%m_frootn_to_litter_fire_patch(i) = value_patch + this%m_frootn_storage_to_litter_fire_patch(i) = value_patch + this%m_frootn_xfer_to_litter_fire_patch(i) = value_patch + this%m_livecrootn_to_litter_fire_patch(i) = value_patch + this%m_livecrootn_storage_to_litter_fire_patch(i) = value_patch + this%m_livecrootn_xfer_to_litter_fire_patch(i) = value_patch + this%m_livecrootn_to_deadcrootn_fire_patch(i) = value_patch + this%m_deadcrootn_to_litter_fire_patch(i) = value_patch + this%m_deadcrootn_storage_to_litter_fire_patch(i) = value_patch + this%m_deadcrootn_xfer_to_litter_fire_patch(i) = value_patch + this%m_retransn_to_litter_fire_patch(i) = value_patch + + + this%leafn_xfer_to_leafn_patch(i) = value_patch + this%frootn_xfer_to_frootn_patch(i) = value_patch + this%livestemn_xfer_to_livestemn_patch(i) = value_patch + this%deadstemn_xfer_to_deadstemn_patch(i) = value_patch + this%livecrootn_xfer_to_livecrootn_patch(i) = value_patch + this%deadcrootn_xfer_to_deadcrootn_patch(i) = value_patch + this%leafn_to_litter_patch(i) = value_patch + this%leafn_to_retransn_patch(i) = value_patch + this%frootn_to_litter_patch(i) = value_patch + this%retransn_to_npool_patch(i) = value_patch + this%free_retransn_to_npool_patch(i) = value_patch + this%sminn_to_npool_patch(i) = value_patch + this%npool_to_leafn_patch(i) = value_patch + this%npool_to_leafn_storage_patch(i) = value_patch + this%npool_to_frootn_patch(i) = value_patch + this%npool_to_frootn_storage_patch(i) = value_patch + this%npool_to_livestemn_patch(i) = value_patch + this%npool_to_livestemn_storage_patch(i) = value_patch + this%npool_to_deadstemn_patch(i) = value_patch + this%npool_to_deadstemn_storage_patch(i) = value_patch + this%npool_to_livecrootn_patch(i) = value_patch + this%npool_to_livecrootn_storage_patch(i) = value_patch + this%npool_to_deadcrootn_patch(i) = value_patch + this%npool_to_deadcrootn_storage_patch(i) = value_patch + this%leafn_storage_to_xfer_patch(i) = value_patch + this%frootn_storage_to_xfer_patch(i) = value_patch + this%livestemn_storage_to_xfer_patch(i) = value_patch + this%deadstemn_storage_to_xfer_patch(i) = value_patch + this%livecrootn_storage_to_xfer_patch(i) = value_patch + this%deadcrootn_storage_to_xfer_patch(i) = value_patch + this%livestemn_to_deadstemn_patch(i) = value_patch + this%livestemn_to_retransn_patch(i) = value_patch + this%livecrootn_to_deadcrootn_patch(i) = value_patch + this%livecrootn_to_retransn_patch(i) = value_patch + this%ndeploy_patch(i) = value_patch + this%wood_harvestn_patch(i) = value_patch + this%fire_nloss_patch(i) = value_patch + + this%crop_seedn_to_leaf_patch(i) = value_patch + this%grainn_to_cropprodn_patch(i) = value_patch + end do + + if ( use_crop )then + do fi = 1,num_patch + i = filter_patch(fi) + this%livestemn_to_litter_patch(i) = value_patch + this%grainn_to_food_patch(i) = value_patch + this%leafn_to_biofueln_patch(i) = value_patch + this%livestemn_to_biofueln_patch(i) = value_patch + this%grainn_to_seed_patch(i) = value_patch + this%grainn_xfer_to_grainn_patch(i) = value_patch + this%npool_to_grainn_patch(i) = value_patch + this%npool_to_grainn_storage_patch(i) = value_patch + this%grainn_storage_to_xfer_patch(i) = value_patch + this%soyfixn_patch(i) = value_patch + this%frootn_to_retransn_patch(i) = value_patch + end do + end if + + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + + ! phenology: litterfall and crop fluxes associated wit + this%phenology_n_to_litr_met_n_col(i,j) = value_column + this%phenology_n_to_litr_cel_n_col(i,j) = value_column + this%phenology_n_to_litr_lig_n_col(i,j) = value_column + + ! gap mortality + this%gap_mortality_n_to_litr_met_n_col(i,j) = value_column + this%gap_mortality_n_to_litr_cel_n_col(i,j) = value_column + this%gap_mortality_n_to_litr_lig_n_col(i,j) = value_column + this%gap_mortality_n_to_cwdn_col(i,j) = value_column + + ! fire + this%fire_mortality_n_to_cwdn_col(i,j) = value_column + this%m_n_to_litr_met_fire_col(i,j) = value_column + this%m_n_to_litr_cel_fire_col(i,j) = value_column + this%m_n_to_litr_lig_fire_col(i,j) = value_column + + ! harvest + this%harvest_n_to_litr_met_n_col(i,j) = value_column + this%harvest_n_to_litr_cel_n_col(i,j) = value_column + this%harvest_n_to_litr_lig_n_col(i,j) = value_column + this%harvest_n_to_cwdn_col(i,j) = value_column + end do + end do + + do fi = 1,num_column + i = filter_column(fi) + + this%grainn_to_cropprodn_col(i) = value_column + this%fire_nloss_col(i) = value_column + + ! Zero p2c column fluxes + this%fire_nloss_col(i) = value_column + this%wood_harvestn_col(i) = value_column + end do + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%m_decomp_npools_to_fire_col(i,k) = value_column + end do + end do +! Matrix + if(use_matrixcn)then + do j = 1, nvegnpool + do fi = 1,num_patch + i = filter_patch(fi) + this%matrix_nalloc_patch(i,j) = value_patch + this%matrix_nphturnover_patch (i,j) = value_patch + this%matrix_ngmturnover_patch (i,j) = value_patch + this%matrix_nfiturnover_patch (i,j) = value_patch + end do + end do + + do j = 1, nnphtrans + do fi = 1,num_patch + i = filter_patch(fi) + this%matrix_nphtransfer_patch (i,j) = value_patch + end do + end do + + do j = 1, nngmtrans + do fi = 1,num_patch + i = filter_patch(fi) + this%matrix_ngmtransfer_patch (i,j) = value_patch + end do + end do + + do j = 1, nnfitrans + do fi = 1,num_patch + i = filter_patch(fi) + this%matrix_nfitransfer_patch (i,j) = value_patch + end do + end do + + end if + do k = 1, ndecomp_pools + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%m_decomp_npools_to_fire_vr_col(i,j,k) = value_column + end do + end do + end do + + end subroutine SetValues + +end module CNCLM_CNVegNitrogenFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 new file mode 100644 index 000000000..b9afcf3c0 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -0,0 +1,251 @@ +module CNCLM_CNVegStateType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoi + use clm_varcon , only : spval, ispval + use CNCLM_decompMod , only : bounds_type + + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_cnveg_state_type + + type, public :: cnveg_state_type + + integer , pointer :: burndate_patch (:) ! patch crop burn date + type(annual_flux_dribbler_type) :: dwt_dribbler_patch ! object to convert instantaneous dwt values into values that are smoothed / dribbled throughout the year + real(r8) , pointer :: dwt_smoothed_patch (:) ! change in patch weight (-1 to 1) on the gridcell in this time step; changes in first time step of year are smoothed (dribbled) over the whole year + + ! Prognostic crop model + ! + ! TODO(wjs, 2016-02-22) Most / all of these crop-specific state variables should be + ! moved to CropType + real(r8) , pointer :: hdidx_patch (:) ! patch cold hardening index? + real(r8) , pointer :: cumvd_patch (:) ! patch cumulative vernalization d?ependence? + real(r8) , pointer :: gddmaturity_patch (:) ! patch growing degree days (gdd) needed to harvest (ddays) + real(r8) , pointer :: huileaf_patch (:) ! patch heat unit index needed from planting to leaf emergence + real(r8) , pointer :: huigrain_patch (:) ! patch heat unit index needed to reach vegetative maturity + real(r8) , pointer :: aleafi_patch (:) ! patch saved leaf allocation coefficient from phase 2 + real(r8) , pointer :: astemi_patch (:) ! patch saved stem allocation coefficient from phase 2 + real(r8) , pointer :: aleaf_patch (:) ! patch leaf allocation coefficient + real(r8) , pointer :: astem_patch (:) ! patch stem allocation coefficient + real(r8) , pointer :: htmx_patch (:) ! patch max hgt attained by a crop during yr (m) + integer , pointer :: peaklai_patch (:) ! patch 1: max allowed lai; 0: not at max + + integer , pointer :: idop_patch (:) ! patch date of planting + + real(r8) , pointer :: gdp_lf_col (:) ! col global real gdp data (k US$/capita) + real(r8) , pointer :: peatf_lf_col (:) ! col global peatland fraction data (0-1) + integer , pointer :: abm_lf_col (:) ! col global peak month of crop fire emissions + + real(r8) , pointer :: lgdp_col (:) ! col gdp limitation factor for fire occurrence (0-1) + real(r8) , pointer :: lgdp1_col (:) ! col gdp limitation factor for fire spreading (0-1) + real(r8) , pointer :: lpop_col (:) ! col pop limitation factor for fire spreading (0-1) + + real(r8) , pointer :: tempavg_t2m_patch (:) ! patch temporary average 2m air temperature (K) + real(r8) , pointer :: annavg_t2m_patch (:) ! patch annual average 2m air temperature (K) + real(r8) , pointer :: annavg_t2m_col (:) ! col annual average of 2m air temperature, averaged from patch-level (K) + real(r8) , pointer :: annsum_counter_col (:) ! col seconds since last annual accumulator turnover + + ! Fire + real(r8) , pointer :: nfire_col (:) ! col fire counts (count/km2/sec), valid only in Reg. C + real(r8) , pointer :: fsr_col (:) ! col fire spread rate at column level (m/s) + real(r8) , pointer :: fd_col (:) ! col fire duration at column level (hr) + real(r8) , pointer :: lfc_col (:) ! col conversion area fraction of BET and BDT that haven't burned before (/timestep) + real(r8) , pointer :: lfc2_col (:) ! col conversion area fraction of BET and BDT that burned (/sec) + real(r8) , pointer :: dtrotr_col (:) ! col annual decreased fraction coverage of BET on the gridcell (0-1) + real(r8) , pointer :: trotr1_col (:) ! col patch weight of BET on the column (0-1) + real(r8) , pointer :: trotr2_col (:) ! col patch weight of BDT on the column (0-1) + real(r8) , pointer :: cropf_col (:) ! col crop fraction in veg column (0-1) + real(r8) , pointer :: baf_crop_col (:) ! col baf for cropland(/sec) + real(r8) , pointer :: baf_peatf_col (:) ! col baf for peatland (/sec) + real(r8) , pointer :: fbac_col (:) ! col total burned area out of conversion (/sec) + real(r8) , pointer :: fbac1_col (:) ! col burned area out of conversion region due to land use fire (/sec) + real(r8) , pointer :: wtlf_col (:) ! col fractional coverage of non-crop Patches (0-1) + real(r8) , pointer :: lfwt_col (:) ! col fractional coverage of non-crop and non-bare-soil Patches (0-1) + real(r8) , pointer :: farea_burned_col (:) ! col fractional area burned (/sec) + + real(r8), pointer :: dormant_flag_patch (:) ! patch dormancy flag + real(r8), pointer :: days_active_patch (:) ! patch number of days since last dormancy + real(r8), pointer :: onset_flag_patch (:) ! patch onset flag + real(r8), pointer :: onset_counter_patch (:) ! patch onset days counter + real(r8), pointer :: onset_gddflag_patch (:) ! patch onset flag for growing degree day sum + real(r8), pointer :: onset_fdd_patch (:) ! patch onset freezing degree days counter + real(r8), pointer :: onset_gdd_patch (:) ! patch onset growing degree days + real(r8), pointer :: onset_swi_patch (:) ! patch onset soil water index + real(r8), pointer :: offset_flag_patch (:) ! patch offset flag + real(r8), pointer :: offset_counter_patch (:) ! patch offset days counter + real(r8), pointer :: offset_fdd_patch (:) ! patch offset freezing degree days counter + real(r8), pointer :: offset_swi_patch (:) ! patch offset soil water index + real(r8), pointer :: grain_flag_patch (:) ! patch 1: grain fill stage; 0: not + real(r8), pointer :: lgsf_patch (:) ! patch long growing season factor [0-1] + real(r8), pointer :: bglfr_patch (:) ! patch background litterfall rate (1/s) + real(r8), pointer :: bgtr_patch (:) ! patch background transfer growth rate (1/s) + real(r8), pointer :: c_allometry_patch (:) ! patch C allocation index (DIM) + real(r8), pointer :: n_allometry_patch (:) ! patch N allocation index (DIM) + + real(r8), pointer :: tempsum_potential_gpp_patch (:) ! patch temporary annual sum of potential GPP + real(r8), pointer :: annsum_potential_gpp_patch (:) ! patch annual sum of potential GPP + real(r8), pointer :: tempmax_retransn_patch (:) ! patch temporary annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: annmax_retransn_patch (:) ! patch annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: downreg_patch (:) ! patch fractional reduction in GPP due to N limitation (DIM) + real(r8), pointer :: leafcn_offset_patch (:) ! patch leaf C:N used by FUN + real(r8), pointer :: plantCN_patch (:) ! patch plant C:N used by FUN + + end type cnveg_state_type + + type(cnveg_state_type), public, target, save :: cnveg_state_inst + +contains + +!----------------------------------------------------- +!---------------------------------------------- + subroutine init_cnveg_state_type(bounds, nch, ityp, fveg, cncol, cnpft, this) + +! !DESCRIPTION: +! Initialize CTSM vegetation states +! jk Apr 2021: type is allocated and initialized to NaN; +! if data arrays from restart file are passed (cncol and cnpft), the type is then initialized with these values +! +! !ARGUMENTS: + implicit none + + ! INPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: ityp ! PFT index + real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart + type(cnveg_state_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: np, nc, nz, p, nv, n + !-------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%burndate_patch (begp:endp)) ; this%burndate_patch (:) = ispval + allocate(this%dwt_smoothed_patch (begp:endp)) ; this%dwt_smoothed_patch (:) = nan + + allocate(this%hdidx_patch (begp:endp)) ; this%hdidx_patch (:) = nan + allocate(this%cumvd_patch (begp:endp)) ; this%cumvd_patch (:) = nan + allocate(this%gddmaturity_patch (begp:endp)) ; this%gddmaturity_patch (:) = spval + allocate(this%huileaf_patch (begp:endp)) ; this%huileaf_patch (:) = nan + allocate(this%huigrain_patch (begp:endp)) ; this%huigrain_patch (:) = 0.0_r8 + allocate(this%aleafi_patch (begp:endp)) ; this%aleafi_patch (:) = nan + allocate(this%astemi_patch (begp:endp)) ; this%astemi_patch (:) = nan + allocate(this%aleaf_patch (begp:endp)) ; this%aleaf_patch (:) = nan + allocate(this%astem_patch (begp:endp)) ; this%astem_patch (:) = nan + allocate(this%htmx_patch (begp:endp)) ; this%htmx_patch (:) = 0.0_r8 + allocate(this%peaklai_patch (begp:endp)) ; this%peaklai_patch (:) = 0 + + allocate(this%idop_patch (begp:endp)) ; this%idop_patch (:) = huge(1) + + allocate(this%gdp_lf_col (begc:endc)) ; + allocate(this%peatf_lf_col (begc:endc)) ; + allocate(this%abm_lf_col (begc:endc)) ; + + allocate(this%lgdp_col (begc:endc)) ; + allocate(this%lgdp1_col (begc:endc)) ; + allocate(this%lpop_col (begc:endc)) ; + + allocate(this%tempavg_t2m_patch (begp:endp)) ; this%tempavg_t2m_patch (:) = nan + allocate(this%annsum_counter_col (begc:endc)) ; this%annsum_counter_col (:) = nan + allocate(this%annavg_t2m_col (begc:endc)) ; this%annavg_t2m_col (:) = nan + allocate(this%annavg_t2m_patch (begp:endp)) ; this%annavg_t2m_patch (:) = nan + + allocate(this%nfire_col (begc:endc)) ; this%nfire_col (:) = spval + allocate(this%fsr_col (begc:endc)) ; this%fsr_col (:) = nan + allocate(this%fd_col (begc:endc)) ; this%fd_col (:) = nan + allocate(this%lfc_col (begc:endc)) ; this%lfc_col (:) = spval + allocate(this%lfc2_col (begc:endc)) ; this%lfc2_col (:) = 0._r8 + allocate(this%dtrotr_col (begc:endc)) ; this%dtrotr_col (:) = 0._r8 + allocate(this%trotr1_col (begc:endc)) ; this%trotr1_col (:) = 0._r8 + allocate(this%trotr2_col (begc:endc)) ; this%trotr2_col (:) = 0._r8 + allocate(this%cropf_col (begc:endc)) ; this%cropf_col (:) = nan + allocate(this%baf_crop_col (begc:endc)) ; this%baf_crop_col (:) = nan + allocate(this%baf_peatf_col (begc:endc)) ; this%baf_peatf_col (:) = nan + allocate(this%fbac_col (begc:endc)) ; this%fbac_col (:) = nan + allocate(this%fbac1_col (begc:endc)) ; this%fbac1_col (:) = nan + allocate(this%wtlf_col (begc:endc)) ; this%wtlf_col (:) = nan + allocate(this%lfwt_col (begc:endc)) ; this%lfwt_col (:) = nan + allocate(this%farea_burned_col (begc:endc)) ; this%farea_burned_col (:) = nan + + allocate(this%dormant_flag_patch (begp:endp)) ; this%dormant_flag_patch (:) = nan + allocate(this%days_active_patch (begp:endp)) ; this%days_active_patch (:) = nan + allocate(this%onset_flag_patch (begp:endp)) ; this%onset_flag_patch (:) = nan + allocate(this%onset_counter_patch (begp:endp)) ; this%onset_counter_patch (:) = nan + allocate(this%onset_gddflag_patch (begp:endp)) ; this%onset_gddflag_patch (:) = nan + allocate(this%onset_fdd_patch (begp:endp)) ; this%onset_fdd_patch (:) = nan + allocate(this%onset_gdd_patch (begp:endp)) ; this%onset_gdd_patch (:) = nan + allocate(this%onset_swi_patch (begp:endp)) ; this%onset_swi_patch (:) = nan + allocate(this%offset_flag_patch (begp:endp)) ; this%offset_flag_patch (:) = nan + allocate(this%offset_counter_patch (begp:endp)) ; this%offset_counter_patch (:) = nan + allocate(this%offset_fdd_patch (begp:endp)) ; this%offset_fdd_patch (:) = nan + allocate(this%offset_swi_patch (begp:endp)) ; this%offset_swi_patch (:) = nan + allocate(this%grain_flag_patch (begp:endp)) ; this%grain_flag_patch (:) = nan + allocate(this%lgsf_patch (begp:endp)) ; this%lgsf_patch (:) = nan + allocate(this%bglfr_patch (begp:endp)) ; this%bglfr_patch (:) = nan + allocate(this%bgtr_patch (begp:endp)) ; this%bgtr_patch (:) = nan + allocate(this%c_allometry_patch (begp:endp)) ; this%c_allometry_patch (:) = nan + allocate(this%n_allometry_patch (begp:endp)) ; this%n_allometry_patch (:) = nan + allocate(this%tempsum_potential_gpp_patch (begp:endp)) ; this%tempsum_potential_gpp_patch (:) = nan + allocate(this%annsum_potential_gpp_patch (begp:endp)) ; this%annsum_potential_gpp_patch (:) = nan + allocate(this%tempmax_retransn_patch (begp:endp)) ; this%tempmax_retransn_patch (:) = nan + allocate(this%annmax_retransn_patch (begp:endp)) ; this%annmax_retransn_patch (:) = nan + allocate(this%downreg_patch (begp:endp)) ; this%downreg_patch (:) = nan + allocate(this%leafcn_offset_patch (begp:endp)) ; this%leafcn_offset_patch (:) = nan + allocate(this%plantCN_patch (begp:endp)) ; this%plantCN_patch (:) = nan + + ! initialize variables from restart file or set to cold start value + n = 0 + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,nzone ! CN zone loop + n = n + 1 + this%annsum_counter_col (n) = cncol(nc,nz, 31) + this%annavg_t2m_col (n) = cncol(nc,nz, 32) + this%farea_burned_col (n) = cncol(nc,nz, 34) + + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,nveg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + + this%annavg_t2m_patch (np) = cnpft(nc,nz,nv, 24) + this%annmax_retransn_patch (np) = cnpft(nc,nz,nv, 25) + this%annsum_potential_gpp_patch (np) = cnpft(nc,nz,nv, 27) + this%days_active_patch (np) = cnpft(nc,nz,nv, 29) + this%dormant_flag_patch (np) = cnpft(nc,nz,nv, 30) + this%offset_counter_patch (np) = cnpft(nc,nz,nv, 31) + this%offset_fdd_patch (np) = cnpft(nc,nz,nv, 32) + this%offset_flag_patch (np) = cnpft(nc,nz,nv, 33) + this%offset_swi_patch (np) = cnpft(nc,nz,nv, 34) + this%onset_counter_patch (np) = cnpft(nc,nz,nv, 35) + this%onset_fdd_patch (np) = cnpft(nc,nz,nv, 36) + this%onset_flag_patch (np) = cnpft(nc,nz,nv, 37) + this%onset_gdd_patch (np) = cnpft(nc,nz,nv, 38) + this%onset_gddflag_patch (np) = cnpft(nc,nz,nv, 39) + this%onset_swi_patch (np) = cnpft(nc,nz,nv, 40) + this%tempavg_t2m_patch (np) = cnpft(nc,nz,nv, 43) + this%tempmax_retransn_patch (np) = cnpft(nc,nz,nv, 44) + this%tempsum_potential_gpp_patch (np) = cnpft(nc,nz,nv, 46) + + end if + end do !nv + end do ! p + end do ! nz + end do ! nc + + end subroutine init_cnveg_state_type + + +end module CNCLM_CNVegStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 new file mode 100644 index 000000000..7fe00375f --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -0,0 +1,183 @@ +module CNCLM_CanopyStateType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varpar , only : nlevcan, nvegwcs, numpft, num_zon, num_veg, & + var_col, var_pft + use clm_varcon , only : spval + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_canopystate_type + + type, public :: canopystate_type + + integer , pointer :: frac_veg_nosno_patch (:) ! patch fraction of vegetation not covered by snow (0 OR 1) [-] + integer , pointer :: frac_veg_nosno_alb_patch (:) ! patch fraction of vegetation not covered by snow (0 OR 1) [-] + + real(r8) , pointer :: tlai_patch (:) ! patch canopy one-sided leaf area index, no burying by snow + real(r8) , pointer :: tsai_patch (:) ! patch canopy one-sided stem area index, no burying by snow + real(r8) , pointer :: elai_patch (:) ! patch canopy one-sided leaf area index with burying by snow + real(r8) , pointer :: esai_patch (:) ! patch canopy one-sided stem area index with burying by snow + real(r8) , pointer :: elai240_patch (:) ! patch canopy one-sided leaf area index with burying by snow average over 10days + real(r8) , pointer :: laisun_patch (:) ! patch patch sunlit projected leaf area index + real(r8) , pointer :: laisha_patch (:) ! patch patch shaded projected leaf area index + real(r8) , pointer :: laisun_z_patch (:,:) ! patch patch sunlit leaf area for canopy layer + real(r8) , pointer :: laisha_z_patch (:,:) ! patch patch shaded leaf area for canopy layer + real(r8) , pointer :: mlaidiff_patch (:) ! patch difference between lai month one and month two (for dry deposition of chemical tracers) + real(r8) , pointer :: annlai_patch (:,:) ! patch 12 months of monthly lai from input data set (for dry deposition of chemical tracers) + real(r8) , pointer :: stem_biomass_patch (:) ! Aboveground stem biomass (kg/m**2) + real(r8) , pointer :: leaf_biomass_patch (:) ! Aboveground leaf biomass (kg/m**2) + real(r8) , pointer :: htop_patch (:) ! patch canopy top (m) + real(r8) , pointer :: hbot_patch (:) ! patch canopy bottom (m) + real(r8) , pointer :: z0m_patch (:) ! patch momentum roughness length (m) + real(r8) , pointer :: displa_patch (:) ! patch displacement height (m) + real(r8) , pointer :: fsun_patch (:) ! patch sunlit fraction of canopy + real(r8) , pointer :: fsun24_patch (:) ! patch 24hr average of sunlit fraction of canopy + real(r8) , pointer :: fsun240_patch (:) ! patch 240hr average of sunlit fraction of canopy + + real(r8) , pointer :: dleaf_patch (:) ! patch characteristic leaf width (diameter) [m] + ! for non-ED/FATES this is the same as pftcon%dleaf() + real(r8) , pointer :: rscanopy_patch (:) ! patch canopy stomatal resistance (s/m) (ED specific) + + real(r8) , pointer :: vegwp_patch (:,:) ! patch vegetation water matric potential (mm) + real(r8) , pointer :: vegwp_ln_patch (:,:) ! patch vegetation water matric potential at local noon (mm) + real(r8) , pointer :: vegwp_pd_patch (:,:) ! patch predawn vegetation water matric potential (mm) + + real(r8) :: leaf_mr_vcm = spval ! Scalar constant of leaf respiration with Vcmax + + end type canopystate_type + type(canopystate_type), public, target, save :: canopystate_inst + +contains + +!-------------------------------------------------------------- + subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) + + ! !DESCRIPTION: + ! Initialize CTSM canopy state type needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + ! INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction + real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array + real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array + logical, optional, intent(in) :: cn5_cold_start + type(canopystate_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + integer :: np, nc, nz, p, nv, nw + logical :: cold_start = .false. + !--------------------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + begg = bounds%begg ; endg = bounds%endg + + ! check whether a cn5_cold_start option was set and change cold_start accordingly + if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + cold_start = .true. + end if + + ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + (size(cnpft,3).ne.var_pft))) + _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') + end if + + allocate(this%frac_veg_nosno_patch (begp:endp)) ; this%frac_veg_nosno_patch (:) = huge(1) + allocate(this%frac_veg_nosno_alb_patch (begp:endp)) ; this%frac_veg_nosno_alb_patch (:) = 0 + allocate(this%tlai_patch (begp:endp)) ; this%tlai_patch (:) = nan + allocate(this%tsai_patch (begp:endp)) ; this%tsai_patch (:) = nan + allocate(this%elai_patch (begp:endp)) ; this%elai_patch (:) = nan + allocate(this%elai240_patch (begp:endp)) ; this%elai240_patch (:) = nan + allocate(this%esai_patch (begp:endp)) ; this%esai_patch (:) = nan + allocate(this%laisun_patch (begp:endp)) ; this%laisun_patch (:) = nan + allocate(this%laisha_patch (begp:endp)) ; this%laisha_patch (:) = nan + allocate(this%laisun_z_patch (begp:endp,1:nlevcan)) ; this%laisun_z_patch (:,:) = nan + allocate(this%laisha_z_patch (begp:endp,1:nlevcan)) ; this%laisha_z_patch (:,:) = nan + allocate(this%mlaidiff_patch (begp:endp)) ; this%mlaidiff_patch (:) = nan + allocate(this%annlai_patch (12,begp:endp)) ; this%annlai_patch (:,:) = nan + allocate(this%stem_biomass_patch (begp:endp)) ; this%stem_biomass_patch (:) = nan + allocate(this%leaf_biomass_patch (begp:endp)) ; this%leaf_biomass_patch (:) = nan + allocate(this%htop_patch (begp:endp)) ; this%htop_patch (:) = nan + allocate(this%hbot_patch (begp:endp)) ; this%hbot_patch (:) = nan + allocate(this%z0m_patch (begp:endp)) ; this%z0m_patch (:) = nan + allocate(this%displa_patch (begp:endp)) ; this%displa_patch (:) = nan + allocate(this%fsun_patch (begp:endp)) ; this%fsun_patch (:) = nan + allocate(this%fsun24_patch (begp:endp)) ; this%fsun24_patch (:) = nan + allocate(this%fsun240_patch (begp:endp)) ; this%fsun240_patch (:) = nan + + allocate(this%dleaf_patch (begp:endp)) ; this%dleaf_patch (:) = nan + allocate(this%rscanopy_patch (begp:endp)) ; this%rscanopy_patch (:) = nan +! allocate(this%gccanopy_patch (begp:endp)) ; this%gccanopy_patch (:) = 0.0_r8 + allocate(this%vegwp_patch (begp:endp,1:nvegwcs)) ; this%vegwp_patch (:,:) = nan + allocate(this%vegwp_ln_patch (begp:endp,1:nvegwcs)) ; this%vegwp_ln_patch (:,:) = nan + allocate(this%vegwp_pd_patch (begp:endp,1:nvegwcs)) ; this%vegwp_pd_patch (:,:) = nan + + ! set parameters to default values or read from parameter file + + this%leaf_mr_vcm = 0.015 ! jkolassa Mar 2022: default value in CTSM5.1 + + + ! initialize variables from restart file or set to cold start value + + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + + ! "old" variables: CNCLM45 and before + this%elai_patch (np) = cnpft(nc,nz,nv, 69) + this%esai_patch (np) = cnpft(nc,nz,nv, 70) + this%hbot_patch (np) = cnpft(nc,nz,nv, 71) + this%htop_patch (np) = cnpft(nc,nz,nv, 72) + this%tlai_patch (np) = cnpft(nc,nz,nv, 73) + this%tsai_patch (np) = cnpft(nc,nz,nv, 74) + + ! "new" variables: introduced in CNCLM50 + if (cold_start==.false.) then + do nw = 1,nvegwcs + this%vegwp_patch(np,nw) = cnpft(nc,nz,nv, 77+(nw-1)) + end do + elseif (cold_start) then + this%vegwp_patch(np,1:nvegwcs) = -2.5e4_r8 + else + _ASSERT(.FALSE.,'missing CNCLM50_cold_start setting') + end if + + ! jkolassa Mar 2022: these two quantites are computed in Photosynthesis, + ! so maybe the do not need to be initialized here + this%vegwp_ln_patch(np) = -2.5e4_r8 + this%vegwp_pd_patch(np) = -2.5e4_r8 + + ! jkolassa May 2022: we do not model vegetation on snow, so the variable below is 1 always + this%frac_veg_nosno_patch(np) = 1 + + end if ! ityp = p + + end do !nv + end do ! p + end do ! nz + end do ! nc + + end subroutine init_canopystate_type + +end module CNCLM_CanopyStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 new file mode 100644 index 000000000..3688058b3 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -0,0 +1,101 @@ +module CNCLM_GridcellType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4, MAPL_PI + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + use clm_varcon , only : ispval + use clm_varpar , only : numpft, num_zon, num_veg, var_pft + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_gridcell_type + + type, public :: gridcell_type + + ! topological mapping functionality, local 1d gdc arrays + integer , pointer :: gindex (:) ! global index + real(r8), pointer :: area (:) ! total land area, gridcell (km^2) + real(r8), pointer :: lat (:) ! latitude (radians) + real(r8), pointer :: lon (:) ! longitude (radians) + real(r8), pointer :: latdeg (:) ! latitude (degrees) + real(r8), pointer :: londeg (:) ! longitude (degrees) + logical , pointer :: active (:) ! just needed for symmetry with other subgrid types + + integer, pointer :: nbedrock (:) ! index of uppermost bedrock layer + + ! Daylength + real(r8) , pointer :: max_dayl (:) ! maximum daylength for this grid cell (s) + real(r8) , pointer :: dayl (:) ! daylength (seconds) + real(r8) , pointer :: prev_dayl (:) ! daylength from previous timestep (seconds) + + ! indices into landunit-level arrays for landunits in this grid cell (ispval implies + ! this landunit doesn't exist on this grid cell) [1:max_lunit, begg:endg] + ! (note that the spatial dimension is last here, in contrast to most 2-d variables; + ! this is for efficiency, since most loops will go over g in the outer loop, and + ! landunit type in the inner loop) + integer , pointer :: landunit_indices (:,:) + + end type gridcell_type + type(gridcell_type), public, target, save :: grc + + contains + +!----------------------------------------------- + subroutine init_gridcell_type(bounds, nch, cnpft, lats, lons, this) + + ! !DESCRIPTION: +! Initialize CTSM gridcell type needed for calling CTSM routines +! jk Apr 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made +! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect +! +! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array + real, dimension(nch), intent(in) :: lats ! Catchment tile latitudes in radians + real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes in radians + type(gridcell_type), intent(inout):: this + + !LOCAL + integer :: begg, endg + integer :: nc + !---------------------------- + + begg = bounds%begg; endg = bounds%endg + + + ! The following is set in InitGridCells + allocate(this%gindex (begg:endg)) ; this%gindex (:) = ispval + allocate(this%area (begg:endg)) ; this%area (:) = nan + allocate(this%lat (begg:endg)) ; this%lat (:) = nan + allocate(this%lon (begg:endg)) ; this%lon (:) = nan + allocate(this%latdeg (begg:endg)) ; this%latdeg (:) = nan + allocate(this%londeg (begg:endg)) ; this%londeg (:) = nan + allocate(this%active (begg:endg)) ; this%active (:) = .true. + allocate(this%nbedrock (begg:endg)) ; this%nbedrock (:) = ispval + + ! This is initiailized in module DayLength + allocate(this%max_dayl (begg:endg)) ; this%max_dayl (:) = nan + allocate(this%dayl (begg:endg)) ; this%dayl (:) = nan + allocate(this%prev_dayl (begg:endg)) ; this%prev_dayl (:) = nan + + allocate(this%landunit_indices(1:max_lunit, begg:endg)); this%landunit_indices(:,:) = ispval + + ! initialize variables from restart file or set to cold start value + + do nc = 1,nch ! catchment tile loop + + this%lat (nc) = lats(nc) + this%lon (nc) = lons(nc) + this%latdeg (nc) = lats(nc) / MAPL_PI * 180. + this%londeg (nc) = lons(nc) / MAPL_PI * 180. + this%dayl (nc) = cnpft (nc,1,1, 28) ! variable used to be patch level and is now gridcell level; assume all patches in gridcell have same day length + + end do ! nc + end subroutine init_gridcell_type +end module CNCLM_GridcellType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 new file mode 100644 index 000000000..9225f3e17 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 @@ -0,0 +1,61 @@ +module CNCLM_OzoneBaseMod + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_ozone_base_type + + type, public :: ozone_base_type + + ! Public data members + ! These should be treated as read-only by other modules (except that they can be + ! modified by extensions of the ozone_base_type) + real(r8), pointer, public :: o3coefvsha_patch(:) ! ozone coefficient for photosynthesis, shaded leaves (0 - 1) + real(r8), pointer, public :: o3coefvsun_patch(:) ! ozone coefficient for photosynthesis, sunlit leaves (0 - 1) + real(r8), pointer, public :: o3coefgsha_patch(:) ! ozone coefficient for conductance, shaded leaves (0 - 1) + real(r8), pointer, public :: o3coefgsun_patch(:) ! ozone coefficient for conductance, sunlit leaves (0 - 1) + + end type ozone_base_type + type(ozone_base_type), public, target, save :: ozone_inst + +contains + +!------------------------------------------------ + subroutine init_ozone_base_type(bounds, this) + + ! !DESCRIPTION: + ! Initialize CTSM ozone base type needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(ozone_base_type), intent(inout) :: this + + ! LOCAL + integer :: begp, endp + !----------------------- + + begp = bounds%begp ; endp = bounds%endp + + allocate(this%o3coefvsha_patch(begp:endp)) ; this%o3coefvsha_patch(:) = nan + allocate(this%o3coefvsun_patch(begp:endp)) ; this%o3coefvsun_patch(:) = nan + allocate(this%o3coefgsha_patch(begp:endp)) ; this%o3coefgsha_patch(:) = nan + allocate(this%o3coefgsun_patch(begp:endp)) ; this%o3coefgsun_patch(:) = nan + + this%o3coefvsha_patch = 1. + this%o3coefvsun_patch = 1. + this%o3coefgsha_patch = 1. + this%o3coefgsun_patch = 1. + + end subroutine init_ozone_base_type + +end module CNCLM_OzoneBaseMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotoParamsType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotoParamsType.F90 new file mode 100644 index 000000000..c39da9bf8 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotoParamsType.F90 @@ -0,0 +1,233 @@ +module CNCLM_PhotoParamsType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ExceptionHandling + use clm_varctl , only : use_hydrstress + use clm_varpar , only : mxpft, nvegwcs + use nanMod , only : nan + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_photo_params_type + + type :: photo_params_type + real(r8) :: act25 ! Rubisco activity at 25 C (umol CO2/gRubisco/s) + real(r8) :: fnr ! Mass ratio of total Rubisco molecular mass to nitrogen in Rubisco (gRubisco/gN in Rubisco) + real(r8) :: cp25_yr2000 ! CO2 compensation point at 25°C at present day O2 (mol/mol) + real(r8) :: kc25_coef ! Michaelis-Menten const. at 25°C for CO2 (unitless) + real(r8) :: ko25_coef ! Michaelis-Menten const. at 25°C for O2 (unitless) + real(r8) :: fnps ! Fraction of light absorbed by non-photosynthetic pigment (unitless) + real(r8) :: theta_psii ! Empirical curvature parameter for electron transport rate (unitless) + real(r8) :: theta_ip ! Empirical curvature parameter for ap photosynthesis co-limitation (unitless) + real(r8) :: vcmaxha ! Activation energy for vcmax (J/mol) + real(r8) :: jmaxha ! Activation energy for jmax (J/mol) + real(r8) :: tpuha ! Activation energy for tpu (J/mol) + real(r8) :: lmrha ! Activation energy for lmr (J/mol) + real(r8) :: kcha ! Activation energy for kc (J/mol) + real(r8) :: koha ! Activation energy for ko (J/mol) + real(r8) :: cpha ! Activation energy for cp (J/mol) + real(r8) :: vcmaxhd ! Deactivation energy for vcmax (J/mol) + real(r8) :: jmaxhd ! Deactivation energy for jmax (J/mol) + real(r8) :: tpuhd ! Deactivation energy for tpu (J/mol) + real(r8) :: lmrhd ! Deactivation energy for lmr (J/mol) + real(r8) :: lmrse ! Entropy term for lmr (J/mol/K) + real(r8) :: tpu25ratio ! Ratio of tpu25top to vcmax25top (unitless) + real(r8) :: kp25ratio ! Ratio of kp25top to vcmax25top (unitless) + real(r8) :: vcmaxse_sf ! Scale factor for vcmaxse (unitless) + real(r8) :: jmaxse_sf ! Scale factor for jmaxse (unitless) + real(r8) :: tpuse_sf ! Scale factor for tpuse (unitless) + real(r8) :: jmax25top_sf ! Scale factor for jmax25top (unitless) + real(r8), allocatable, public :: krmax (:) + real(r8), allocatable, private :: kmax (:,:) + real(r8), allocatable, private :: psi50 (:,:) + real(r8), allocatable, private :: ck (:,:) + real(r8), allocatable, private :: lmr_intercept_atkin(:) + real(r8), allocatable, private :: theta_cj (:) ! Empirical curvature parameter for ac, aj photosynthesis co-limitation (unitless) + + end type photo_params_type + type(photo_params_type), public, target, save :: params_inst + +contains + +!-------------------------------------- + subroutine init_photo_params_type(this) + + ! !DESCRIPTION: + ! Initialize CTSM photosynthesis parameters needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + + type(photo_params_type), intent(inout):: this + + character(300) :: paramfile + integer :: ierr, clm_varid + + real(r8), allocatable, dimension(:) :: read_tmp_1 + real(r8), allocatable, dimension(:,:) :: read_tmp_2 + real(r8) :: read_tmp_3 + !--------------------------------------------------- + + allocate( read_tmp_1 (0:mxpft)) + allocate( read_tmp_2 (0:mxpft,nvegwcs)) + + + + allocate( this%krmax (0:mxpft) ) ; this%krmax(:) = nan + allocate( this%theta_cj (0:mxpft) ) ; this%theta_cj(:) = nan + allocate( this%kmax (0:mxpft,nvegwcs) ) ; this%kmax(:,:) = nan + allocate( this%psi50 (0:mxpft,nvegwcs) ) ; this%psi50(:,:) = nan + allocate( this%ck (0:mxpft,nvegwcs) ) ; this%ck(:,:) = nan + + if ( use_hydrstress .and. nvegwcs /= 4 )then + _ASSERT(.FALSE.,'Error:: the Plant Hydraulics Stress methodology is for the spacA function is hardcoded for nvegwcs==4') + end if + + ! jkolassa, Dec 2021: read in parameters from CLM parameter file + ! TO DO: pass parameter file through rc files rather than hardcoding name here + + paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' + ierr = NF90_OPEN(trim(paramfile),NF90_NOWRITE,ncid) + if (ierr/=0) then + _ASSERT(.FALSE.,'Error:: the Plant Hydraulics Stress methodology is for the spacA function is hardcoded for nvegwcs==4') + end if + + ierr = NF90_INQ_VARID(ncid,'krmax',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%krmax(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'lmr_intercept_atkin',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%lmr_intercept_atkin(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'theta_cj',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%theta_cj(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'kmax',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_2) + this%theta_cj(:,:) = read_tmp_2(0:mxpft,:) + + ierr = NF90_INQ_VARID(ncid,'psi50',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_2) + this%psi50(:,:) = read_tmp_2(0:mxpft,:) + + ierr = NF90_INQ_VARID(ncid,'ck',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_2) + this%theta_ck(:,:) = read_tmp_2(0:mxpft,:) + + ierr = NF90_INQ_VARID(ncid,'ko25_coef',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%ko25_coef = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'kc25_coef',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%kc25_coef = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'cp25_yr2000',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%cp25_yr2000 = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'act25',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%act25 = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'fnr',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%fnr = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'fnps',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%fnps = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'theta_psii',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%theta_psii = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'theta_ip',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%theta_ip = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'vcmaxha',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%vcmaxha = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'jmaxha',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%jmaxha = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'tpuha',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%tpuha = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'lmrha',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%lmrha = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'kcha',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%kcha = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'koha',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%koha = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'cpha',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%cpha = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'vcmaxhd',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%vcmaxhd = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'jmaxhd',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%jmaxhd = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'tpuhd',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%tpuhd = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'lmrhd',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%lmrhd = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'lmrse',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%lmrse = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'tpu25ratio',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%tpu25ratio = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'kp25ratio',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%kp25ratio = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'vcmaxse_sf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%vcmaxse_sf = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'jmaxse_sf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%jmaxse_sf = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'tpuse_sf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%tpuse_sf = read_tmp_3 + + ierr = NF90_INQ_VARID(ncid,'jmax25top_sf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%jmax25top_sf = read_tmp_3 + + ierr = NF90_CLOSE(ncid) + + end subroutine init_photo_params_type + +end module CNCLM_PhotoParamsType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 new file mode 100644 index 000000000..512f9ad86 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 @@ -0,0 +1,290 @@ +module CNCLM_PhotosynsType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varctl , only : use_luna + use clm_varpar , only : numpft, num_zon, num_veg, & + var_col, var_pft + use nanMod , only : nan + use CNCLM_pftconMod , only : pftcon + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_photosyns_type + + type, public :: photosyns_type + + logical , pointer, private :: c3flag_patch (:) ! patch true if C3 and false if C4 + ! Plant hydraulic stress specific variables + real(r8), pointer, private :: ac_phs_patch (:,:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: aj_phs_patch (:,:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ap_phs_patch (:,:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ag_phs_patch (:,:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: an_sun_patch (:,:) ! patch sunlit net leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: an_sha_patch (:,:) ! patch shaded net leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: vcmax_z_phs_patch (:,:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s) + real(r8), pointer, private :: kp_z_phs_patch (:,:,:) ! patch initial slope of CO2 response curve (C4 plants) + real(r8), pointer, private :: tpu_z_phs_patch (:,:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s) + real(r8), pointer, public :: gs_mol_sun_patch (:,:) ! patch sunlit leaf stomatal conductance (umol H2O/m**2/s) + real(r8), pointer, public :: gs_mol_sha_patch (:,:) ! patch shaded leaf stomatal conductance (umol H2O/m**2/s) + real(r8), pointer, private :: gs_mol_sun_ln_patch (:,:) ! patch sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) + real(r8), pointer, private :: gs_mol_sha_ln_patch (:,:) ! patch shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) + real(r8), pointer, private :: ac_patch (:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: aj_patch (:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ap_patch (:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ag_patch (:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: an_patch (:,:) ! patch net leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: vcmax_z_patch (:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s) + real(r8), pointer, private :: cp_patch (:) ! patch CO2 compensation point (Pa) + real(r8), pointer, private :: kc_patch (:) ! patch Michaelis-Menten constant for CO2 (Pa) + real(r8), pointer, private :: ko_patch (:) ! patch Michaelis-Menten constant for O2 (Pa) + real(r8), pointer, private :: qe_patch (:) ! patch quantum efficiency, used only for C4 (mol CO2 / mol photons) + real(r8), pointer, private :: tpu_z_patch (:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s) + real(r8), pointer, private :: kp_z_patch (:,:) ! patch initial slope of CO2 response curve (C4 plants) + real(r8), pointer, private :: bbb_patch (:) ! patch Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + real(r8), pointer, private :: mbb_patch (:) ! patch Ball-Berry slope of conductance-photosynthesis relationship + real(r8), pointer, private :: gs_mol_patch (:,:) ! patch leaf stomatal conductance (umol H2O/m**2/s) + real(r8), pointer, private :: gb_mol_patch (:) ! patch leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), pointer, private :: rh_leaf_patch (:) ! patch fractional humidity at leaf surface (dimensionless) + real(r8), pointer, private :: vpd_can_patch (:) ! patch canopy vapor pressure deficit (kPa) + real(r8), pointer, private :: alphapsnsun_patch (:) ! patch sunlit 13c fractionation ([]) + real(r8), pointer, private :: alphapsnsha_patch (:) ! patch shaded 13c fractionation ([]) + + real(r8), pointer, public :: rc13_canair_patch (:) ! patch C13O2/C12O2 in canopy air + real(r8), pointer, public :: rc13_psnsun_patch (:) ! patch C13O2/C12O2 in sunlit canopy psn flux + real(r8), pointer, public :: rc13_psnsha_patch (:) ! patch C13O2/C12O2 in shaded canopy psn flux + + real(r8), pointer, public :: psnsun_patch (:) ! patch sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, public :: psnsha_patch (:) ! patch shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, public :: c13_psnsun_patch (:) ! patch c13 sunlit leaf photosynthesis (umol 13CO2/m**2/s) + real(r8), pointer, public :: c13_psnsha_patch (:) ! patch c13 shaded leaf photosynthesis (umol 13CO2/m**2/s) + real(r8), pointer, public :: c14_psnsun_patch (:) ! patch c14 sunlit leaf photosynthesis (umol 14CO2/m**2/s) + real(r8), pointer, public :: c14_psnsha_patch (:) ! patch c14 shaded leaf photosynthesis (umol 14CO2/m**2/s) + + real(r8), pointer, private :: psnsun_z_patch (:,:) ! patch canopy layer: sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_z_patch (:,:) ! patch canopy layer: shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wc_patch (:) ! patch Rubsico-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wc_patch (:) ! patch Rubsico-limited shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wj_patch (:) ! patch RuBP-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wj_patch (:) ! patch RuBP-limited shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wp_patch (:) ! patch product-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wp_patch (:) ! patch product-limited shaded leaf photosynthesis (umol CO2/m**2/s) + + real(r8), pointer, public :: fpsn_patch (:) ! patch photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wc_patch (:) ! patch Rubisco-limited photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wj_patch (:) ! patch RuBP-limited photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wp_patch (:) ! patch product-limited photosynthesis (umol CO2/m**2 ground/s) + + real(r8), pointer, public :: lnca_patch (:) ! top leaf layer leaf N concentration (gN leaf/m^2) + + real(r8), pointer, public :: lmrsun_patch (:) ! patch sunlit leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, public :: lmrsha_patch (:) ! patch shaded leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, private :: lmrsun_z_patch (:,:) ! patch canopy layer: sunlit leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, private :: lmrsha_z_patch (:,:) ! patch canopy layer: shaded leaf maintenance respiration rate (umol CO2/m**2/s) + + real(r8), pointer, public :: cisun_z_patch (:,:) ! patch intracellular sunlit leaf CO2 (Pa) + real(r8), pointer, public :: cisha_z_patch (:,:) ! patch intracellular shaded leaf CO2 (Pa) + + real(r8), pointer, private :: rssun_z_patch (:,:) ! patch canopy layer: sunlit leaf stomatal resistance (s/m) + real(r8), pointer, private :: rssha_z_patch (:,:) ! patch canopy layer: shaded leaf stomatal resistance (s/m) + real(r8), pointer, public :: rssun_patch (:) ! patch sunlit stomatal resistance (s/m) + real(r8), pointer, public :: rssha_patch (:) ! patch shaded stomatal resistance (s/m) + real(r8), pointer, public :: luvcmax25top_patch (:) ! vcmax25 ! (umol/m2/s) + real(r8), pointer, public :: lujmax25top_patch (:) ! vcmax25 (umol/m2/s) + real(r8), pointer, public :: lutpu25top_patch (:) ! vcmax25 (umol/m2/s) +!! + + + ! LUNA specific variables + real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer + real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer + real(r8), pointer, public :: vcmx25_z_last_valid_patch (:,:) ! patch leaf Vc,max25 at the end of the growing season for the previous year + real(r8), pointer, public :: jmx25_z_last_valid_patch (:,:) ! patch leaf Jmax25 at the end of the growing season for the previous year + real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer + real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress + real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day) + + ! Logical switches for different options + logical, public :: rootstem_acc ! Respiratory acclimation for roots and stems + logical, private :: light_inhibit ! If light should inhibit respiration + integer, private :: leafresp_method ! leaf maintencence respiration at 25C for canopy top method to use + integer, private :: stomatalcond_mtd ! Stomatal conduction method type + logical, private :: modifyphoto_and_lmr_forcrop ! Modify photosynthesis and LMR for crop + + end type photosyns_type + type(photosyns_type), public, target, save :: photosyns_inst + +contains + +!------------------------------------------------------------- + subroutine init_photosyns_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) + + ! !DESCRIPTION: + ! Initialize CTSM photosynthesis type needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + ! INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction + real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array + real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array + logical, optional, intent(in) :: cn5_cold_start + type(photosyns_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp ! patch-level beginning and end index + integer :: begc, endc ! column-level beginning and end index + integer :: np, nc, nz, p, nv + logical :: cold_start = .false. + !------------------------------ + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + + ! check whether a cn5_cold_start option was set and change cold_start accordingly + if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + cold_start = .true. + end if + + ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + (size(cnpft,3).ne.var_pft))) + _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') + end if + + + allocate(this%c3flag_patch (begp:endp)) ; this%c3flag_patch (:) =.false. + allocate(this%ac_phs_patch (begp:endp,2,1:nlevcan)) ; this%ac_phs_patch (:,:,:) = nan + allocate(this%aj_phs_patch (begp:endp,2,1:nlevcan)) ; this%aj_phs_patch (:,:,:) = nan + allocate(this%ap_phs_patch (begp:endp,2,1:nlevcan)) ; this%ap_phs_patch (:,:,:) = nan + allocate(this%ag_phs_patch (begp:endp,2,1:nlevcan)) ; this%ag_phs_patch (:,:,:) = nan + allocate(this%an_sun_patch (begp:endp,1:nlevcan)) ; this%an_sun_patch (:,:) = nan + allocate(this%an_sha_patch (begp:endp,1:nlevcan)) ; this%an_sha_patch (:,:) = nan + allocate(this%vcmax_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%vcmax_z_phs_patch (:,:,:) = nan + allocate(this%tpu_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%tpu_z_phs_patch (:,:,:) = nan + allocate(this%kp_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%kp_z_phs_patch (:,:,:) = nan + allocate(this%gs_mol_sun_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sun_patch (:,:) = nan + allocate(this%gs_mol_sha_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sha_patch (:,:) = nan + allocate(this%gs_mol_sun_ln_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sun_ln_patch (:,:) = nan + allocate(this%gs_mol_sha_ln_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sha_ln_patch (:,:) = nan + allocate(this%ac_patch (begp:endp,1:nlevcan)) ; this%ac_patch (:,:) = nan + allocate(this%aj_patch (begp:endp,1:nlevcan)) ; this%aj_patch (:,:) = nan + allocate(this%ap_patch (begp:endp,1:nlevcan)) ; this%ap_patch (:,:) = nan + allocate(this%ag_patch (begp:endp,1:nlevcan)) ; this%ag_patch (:,:) = nan + allocate(this%an_patch (begp:endp,1:nlevcan)) ; this%an_patch (:,:) = nan + allocate(this%vcmax_z_patch (begp:endp,1:nlevcan)) ; this%vcmax_z_patch (:,:) = nan + allocate(this%tpu_z_patch (begp:endp,1:nlevcan)) ; this%tpu_z_patch (:,:) = nan + allocate(this%kp_z_patch (begp:endp,1:nlevcan)) ; this%kp_z_patch (:,:) = nan + allocate(this%gs_mol_patch (begp:endp,1:nlevcan)) ; this%gs_mol_patch (:,:) = nan + allocate(this%cp_patch (begp:endp)) ; this%cp_patch (:) = nan + allocate(this%kc_patch (begp:endp)) ; this%kc_patch (:) = nan + allocate(this%ko_patch (begp:endp)) ; this%ko_patch (:) = nan + allocate(this%qe_patch (begp:endp)) ; this%qe_patch (:) = nan + allocate(this%bbb_patch (begp:endp)) ; this%bbb_patch (:) = nan + allocate(this%mbb_patch (begp:endp)) ; this%mbb_patch (:) = nan + allocate(this%gb_mol_patch (begp:endp)) ; this%gb_mol_patch (:) = nan + allocate(this%rh_leaf_patch (begp:endp)) ; this%rh_leaf_patch (:) = nan + allocate(this%vpd_can_patch (begp:endp)) ; this%vpd_can_patch (:) = nan + allocate(this%psnsun_patch (begp:endp)) ; this%psnsun_patch (:) = nan + allocate(this%psnsha_patch (begp:endp)) ; this%psnsha_patch (:) = nan + allocate(this%c13_psnsun_patch (begp:endp)) ; this%c13_psnsun_patch (:) = nan + allocate(this%c13_psnsha_patch (begp:endp)) ; this%c13_psnsha_patch (:) = nan + allocate(this%c14_psnsun_patch (begp:endp)) ; this%c14_psnsun_patch (:) = nan + allocate(this%c14_psnsha_patch (begp:endp)) ; this%c14_psnsha_patch (:) = nan + + allocate(this%psnsun_z_patch (begp:endp,1:nlevcan)) ; this%psnsun_z_patch (:,:) = nan + allocate(this%psnsha_z_patch (begp:endp,1:nlevcan)) ; this%psnsha_z_patch (:,:) = nan + allocate(this%psnsun_wc_patch (begp:endp)) ; this%psnsun_wc_patch (:) = nan + allocate(this%psnsha_wc_patch (begp:endp)) ; this%psnsha_wc_patch (:) = nan + allocate(this%psnsun_wj_patch (begp:endp)) ; this%psnsun_wj_patch (:) = nan + allocate(this%psnsha_wj_patch (begp:endp)) ; this%psnsha_wj_patch (:) = nan + allocate(this%psnsun_wp_patch (begp:endp)) ; this%psnsun_wp_patch (:) = nan + allocate(this%psnsha_wp_patch (begp:endp)) ; this%psnsha_wp_patch (:) = nan + allocate(this%fpsn_patch (begp:endp)) ; this%fpsn_patch (:) = nan + allocate(this%fpsn_wc_patch (begp:endp)) ; this%fpsn_wc_patch (:) = nan + allocate(this%fpsn_wj_patch (begp:endp)) ; this%fpsn_wj_patch (:) = nan + allocate(this%fpsn_wp_patch (begp:endp)) ; this%fpsn_wp_patch (:) = nan + + allocate(this%lnca_patch (begp:endp)) ; this%lnca_patch (:) = nan + + allocate(this%lmrsun_z_patch (begp:endp,1:nlevcan)) ; this%lmrsun_z_patch (:,:) = nan + allocate(this%lmrsha_z_patch (begp:endp,1:nlevcan)) ; this%lmrsha_z_patch (:,:) = nan + allocate(this%lmrsun_patch (begp:endp)) ; this%lmrsun_patch (:) = nan + allocate(this%lmrsha_patch (begp:endp)) ; this%lmrsha_patch (:) = nan + + allocate(this%alphapsnsun_patch (begp:endp)) ; this%alphapsnsun_patch (:) = nan + allocate(this%alphapsnsha_patch (begp:endp)) ; this%alphapsnsha_patch (:) = nan + allocate(this%rc13_canair_patch (begp:endp)) ; this%rc13_canair_patch (:) = nan + allocate(this%rc13_psnsun_patch (begp:endp)) ; this%rc13_psnsun_patch (:) = nan + allocate(this%rc13_psnsha_patch (begp:endp)) ; this%rc13_psnsha_patch (:) = nan + + allocate(this%cisun_z_patch (begp:endp,1:nlevcan)) ; this%cisun_z_patch (:,:) = nan + allocate(this%cisha_z_patch (begp:endp,1:nlevcan)) ; this%cisha_z_patch (:,:) = nan + + allocate(this%rssun_z_patch (begp:endp,1:nlevcan)) ; this%rssun_z_patch (:,:) = nan + allocate(this%rssha_z_patch (begp:endp,1:nlevcan)) ; this%rssha_z_patch (:,:) = nan + allocate(this%rssun_patch (begp:endp)) ; this%rssun_patch (:) = nan + allocate(this%rssha_patch (begp:endp)) ; this%rssha_patch (:) = nan + allocate(this%luvcmax25top_patch(begp:endp)) ; this%luvcmax25top_patch(:) = nan + allocate(this%lujmax25top_patch (begp:endp)) ; this%lujmax25top_patch(:) = nan + allocate(this%lutpu25top_patch (begp:endp)) ; this%lutpu25top_patch(:) = nan +!! +! allocate(this%psncanopy_patch (begp:endp)) ; this%psncanopy_patch (:) = nan +! allocate(this%lmrcanopy_patch (begp:endp)) ; this%lmrcanopy_patch (:) = nan + if(use_luna)then + ! NOTE(bja, 2015-09) because these variables are only allocated + ! when luna is turned on, they can not be placed into associate + ! statements. + allocate(this%vcmx25_z_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_patch (:,:) = 30._r8 + allocate(this%jmx25_z_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_patch (:,:) = 60._r8 + allocate(this%vcmx25_z_last_valid_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_last_valid_patch (:,:) = 30._r8 + allocate(this%jmx25_z_last_valid_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_last_valid_patch (:,:) = 60._r8 + allocate(this%pnlc_z_patch (begp:endp,1:nlevcan)) ; this%pnlc_z_patch (:,:) = 0.01_r8 + allocate(this%fpsn24_patch (begp:endp)) ; this%fpsn24_patch (:) = nan + allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 + endif + + + this%light_inhibit = .true. ! jkolassa, Feb 2022: This is the default value for CTSM5.1; we could in the future control this through resource files + + this%leafresp_method = 2 ! jkolassa, Feb 2022: Default for CTSM5.1 if use_cn is true (2 corresponds to Atkin et al., 2015) + + this%stomatalcond_mtd = 2 ! jkolassa, Feb 2022: Default for CTSM5.1, corresponds to Medlyn et al., 2011 + + this%modifyphoto_and_lmr_forcrop = .true. ! jkolassa, Feb 2022: Default for CLM50 and up + + + ! initialize types from restart file or through cold start values + + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + if (cold_start) then + photosyns_inst%alphapsnsun_patch(np) = 0._r8 + photosyns_inst%alphapsnsha_patch(np) = 0._r8 + else (cold_start=.false.) then + photosyns_inst%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 75) + photosyns_inst%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 76) + end if + end if ! ityp =p + end do !nv + end do ! p + end do ! nz + end do ! nc + + end subroutine init_photosyns_type + +end module CNCLM_PhotosynsType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 new file mode 100644 index 000000000..5936f45c9 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -0,0 +1,264 @@ +module CNCLM_SoilBiogeochemCarbonFluxType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan, ndecomp_cascade_outtransitions + use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp, nlevsoi, ndecomp_pools_vr + use clm_varctl , only : use_fates, use_soil_matrixcn, use_vertsoilc + use clm_varcon , only : spval, ispval + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_soilbiogeochem_carbonflux_type + procedure, public :: SetValues + + type, public :: soilbiogeochem_carbonflux_type + + ! fire fluxes + real(r8), pointer :: somc_fire_col (:) ! (gC/m2/s) carbon emissions due to peat burning + + ! decomposition fluxes + real(r8), pointer :: decomp_cpools_sourcesink_col (:,:,:) ! change in decomposing c pools. Used to update concentrations concurrently with vertical transport (gC/m3/timestep) + real(r8), pointer :: decomp_cascade_hr_vr_col (:,:,:) ! vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + real(r8), pointer :: decomp_cascade_hr_col (:,:) ! vertically-integrated (diagnostic) het. resp. from decomposing C pools (gC/m2/s) + real(r8), pointer :: decomp_cascade_ctransfer_vr_col (:,:,:) ! vertically-resolved C transferred along deomposition cascade (gC/m3/s) + real(r8), pointer :: decomp_cascade_ctransfer_col (:,:) ! vertically-integrated (diagnostic) C transferred along decomposition cascade (gC/m2/s) + real(r8), pointer :: decomp_k_col (:,:,:) ! rate constant for decomposition (1./sec) +! for soil-matrix + real(r8), pointer :: hr_vr_col (:,:) ! (gC/m3/s) total vertically-resolved het. resp. from decomposing C pools + real(r8), pointer :: o_scalar_col (:,:) ! fraction by which decomposition is limited by anoxia + real(r8), pointer :: w_scalar_col (:,:) ! fraction by which decomposition is limited by moisture availability + real(r8), pointer :: t_scalar_col (:,:) ! fraction by which decomposition is limited by temperature + real(r8), pointer :: som_c_leached_col (:) ! (gC/m^2/s) total SOM C loss from vertical transport + real(r8), pointer :: decomp_cpools_leached_col (:,:) ! (gC/m^2/s) C loss from vertical transport from each decomposing C pool + real(r8), pointer :: decomp_cpools_transport_tendency_col (:,:,:) ! (gC/m^3/s) C tendency due to vertical transport in decomposing C pools + + ! nitrif_denitrif + real(r8), pointer :: phr_vr_col (:,:) ! (gC/m3/s) potential hr (not N-limited) + real(r8), pointer :: fphr_col (:,:) ! fraction of potential heterotrophic respiration + + real(r8), pointer :: hr_col (:) ! (gC/m2/s) total heterotrophic respiration + real(r8), pointer :: lithr_col (:) ! (gC/m2/s) litter heterotrophic respiration + real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res + real(r8), pointer :: soilc_change_col (:) ! (gC/m2/s) FUN used soil C + + + ! fluxes to receive carbon inputs from FATES + real(r8), pointer :: FATES_c_to_litr_lab_c_col (:,:) ! total labile litter coming from ED. gC/m3/s + real(r8), pointer :: FATES_c_to_litr_cel_c_col (:,:) ! total cellulose litter coming from ED. gC/m3/s + real(r8), pointer :: FATES_c_to_litr_lig_c_col (:,:) ! total lignin litter coming from ED. gC/m3/s + + ! track tradiagonal matrix + real(r8), pointer :: matrix_decomp_fire_k_col (:,:) ! decomposition rate due to fire (gC*m3)/(gC*m3*step)) + real(r8), pointer :: tri_ma_vr (:,:) ! vertical C transfer rate in sparse matrix format (gC*m3)/(gC*m3*step)) + + +! type(sparse_matrix_type) :: AKsoilc ! A*K for C transfers between pools +! type(sparse_matrix_type) :: AVsoil ! V for C and N transfers between soil layers +! type(sparse_matrix_type) :: AKfiresoil ! Kfire for CN transfers from soil to atm due to fire +! type(sparse_matrix_type) :: AKallsoilc ! (A*K+V-Kfire) for soil C cycle +! integer :: NE_AKallsoilc ! Number of entries in AKallsoilc, Automatically generated by functions SPMP_* +! integer,pointer,dimension(:) :: RI_AKallsoilc ! Row numbers of entries in AKallsoilc, Automatically generated by functions SPMP_* +! integer,pointer,dimension(:) :: CI_AKallsoilc ! Column numbers of entries in AKallsoilc, Automatically generated by functions SPMP_* +! integer,pointer,dimension(:) :: RI_a ! Row numbers of all entries from AKsoilc, Automatically generated by SetValueA +! integer,pointer,dimension(:) :: CI_a ! Column numbers of all entries from AKsoilc, Automatically generated by SetValueA +! +! type(diag_matrix_type) :: Ksoil ! CN turnover rate in different soil pools and layers +! type(diag_matrix_type) :: Xdiagsoil ! Temporary C and N state variable to calculate accumulation transfers +! +! type(vector_type) :: matrix_Cinput ! C input to different soil compartments (pools and layers) (gC/m3/step) + + end type soilbiogeochem_carbonflux_type + type(soilbiogeochem_carbonflux_type), public, target, save :: soilbiogeochem_carbonflux_inst + +contains + +!-------------------------------------------------------------- + subroutine init_soilbiogeochem_carbonflux_type(bounds,this) + + type(bounds_type), intent(in) :: bounds + type(soilbiogeochem_carbonflux_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc,Ntrans,Ntrans_diag + + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%t_scalar_col (begc:endc,1:nlevdecomp_full)); this%t_scalar_col (:,:) =spval + allocate(this%w_scalar_col (begc:endc,1:nlevdecomp_full)); this%w_scalar_col (:,:) =spval + allocate(this%o_scalar_col (begc:endc,1:nlevdecomp_full)); this%o_scalar_col (:,:) =spval + allocate(this%phr_vr_col (begc:endc,1:nlevdecomp_full)); this%phr_vr_col (:,:) =nan + allocate(this%fphr_col (begc:endc,1:nlevgrnd)) ; this%fphr_col (:,:) =nan + allocate(this%som_c_leached_col (begc:endc)) ; this%som_c_leached_col (:) =nan + allocate(this%somc_fire_col (begc:endc)) ; this%somc_fire_col (:) =nan + allocate(this%hr_vr_col (begc:endc,1:nlevdecomp_full)); this%hr_vr_col (:,:) =nan + + allocate(this%decomp_cpools_sourcesink_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_cpools_sourcesink_col(:,:,:)= nan + + allocate(this%decomp_cascade_hr_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) + this%decomp_cascade_hr_vr_col(:,:,:)= spval + + allocate(this%decomp_cascade_hr_col(begc:endc,1:ndecomp_cascade_transitions)) + this%decomp_cascade_hr_col(:,:)= nan + + allocate(this%decomp_cascade_ctransfer_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) + this%decomp_cascade_ctransfer_vr_col(:,:,:)= nan + + allocate(this%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions)) + this%decomp_cascade_ctransfer_col(:,:)= nan + + allocate(this%decomp_k_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) + this%decomp_k_col(:,:,:)= spval + + allocate(this%decomp_cpools_leached_col(begc:endc,1:ndecomp_pools)) + this%decomp_cpools_leached_col(:,:)= nan + + allocate(this%decomp_cpools_transport_tendency_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_cpools_transport_tendency_col(:,:,:)= nan + + allocate(this%hr_col (begc:endc)) ; this%hr_col (:) = nan + allocate(this%lithr_col (begc:endc)) ; this%lithr_col (:) = nan + allocate(this%somhr_col (begc:endc)) ; this%somhr_col (:) = nan + allocate(this%soilc_change_col (begc:endc)) ; this%soilc_change_col (:) = nan + +! if(use_soil_matrixcn)then +! allocate(this%matrix_decomp_fire_k_col(begc:endc,1:nlevdecomp*ndecomp_pools)); this%matrix_decomp_fire_k_col(:,:)= nan +! Ntrans = (ndecomp_cascade_transitions-ndecomp_cascade_outtransitions)*nlevdecomp +! call this%AKsoilc%InitSM (ndecomp_pools*nlevdecomp,begc,endc,Ntrans+ndecomp_pools*nlevdecomp) +! call this%AVsoil%InitSM (ndecomp_pools*nlevdecomp,begc,endc,decomp_cascade_con%Ntri_setup) +! call this%AKfiresoil%InitSM (ndecomp_pools*nlevdecomp,begc,endc,ndecomp_pools*nlevdecomp) +! call this%AKallsoilc%InitSM (ndecomp_pools*nlevdecomp,begc,endc,Ntrans+decomp_cascade_con%Ntri_setup+nlevdecomp) +! this%NE_AKallsoilc = Ntrans+ndecomp_pools*nlevdecomp+decomp_cascade_con%Ntri_setup+ndecomp_pools*nlevdecomp +! allocate(this%RI_AKallsoilc(1:this%NE_AKallsoilc)); this%RI_AKallsoilc(1:this%NE_AKallsoilc)=-9999 +! allocate(this%CI_AKallsoilc(1:this%NE_AKallsoilc)); this%CI_AKallsoilc(1:this%NE_AKallsoilc)=-9999 +! Ntrans_diag = (ndecomp_cascade_transitions-ndecomp_cascade_outtransitions)*nlevdecomp+ndecomp_pools_vr +! allocate(this%RI_a(1:Ntrans_diag)); this%RI_a(1:Ntrans_diag) = -9999 +! allocate(this%CI_a(1:Ntrans_diag)); this%CI_a(1:Ntrans_diag) = -9999 +! call this%Ksoil%InitDM (ndecomp_pools*nlevdecomp,begc,endc) +! call this%Xdiagsoil%InitDM (ndecomp_pools*nlevdecomp,begc,endc) +! call this%matrix_Cinput%InitV(ndecomp_pools*nlevdecomp,begc,endc) +! end if + if(use_soil_matrixcn .and. use_vertsoilc)then + allocate(this%tri_ma_vr(begc:endc,1:decomp_cascade_con%Ntri_setup)) + else + allocate(this%tri_ma_vr(1,1)); this%tri_ma_vr(:,:) = nan + end if + if ( use_fates ) then + ! initialize these variables to be zero rather than a bad number since they are not zeroed every timestep (due to a need for them to persist) + + allocate(this%FATES_c_to_litr_lab_c_col(begc:endc,1:nlevdecomp_full)) + this%FATES_c_to_litr_lab_c_col(begc:endc,1:nlevdecomp_full) = 0._r8 + + allocate(this%FATES_c_to_litr_cel_c_col(begc:endc,1:nlevdecomp_full)) + this%FATES_c_to_litr_cel_c_col(begc:endc,1:nlevdecomp_full) = 0._r8 + + allocate(this%FATES_c_to_litr_lig_c_col(begc:endc,1:nlevdecomp_full)) + this%FATES_c_to_litr_lig_c_col(begc:endc,1:nlevdecomp_full) = 0._r8 + + endif + + end subroutine init_soilbiogeochem_carbonflux_type + + !----------------------------------------------------------------------- + subroutine SetValues ( this, num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set carbon fluxes + ! + ! !ARGUMENTS: + class (soilbiogeochem_carbonflux_type) :: this + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i ! loop index + integer :: j,k,l ! indices + !------------------------------------------------------------------------ + + do l = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cascade_hr_col(i,l) = value_column + this%decomp_cascade_hr_vr_col(i,j,l) = value_column + this%decomp_cascade_ctransfer_col(i,l) = value_column + this%decomp_cascade_ctransfer_vr_col(i,j,l) = value_column + this%decomp_k_col(i,j,l) = value_column + end do + end do + end do + + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cpools_leached_col(i,k) = value_column + end do + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cpools_transport_tendency_col(i,j,k) = value_column + this%decomp_cpools_sourcesink_col(i,j,k) = value_column + end do + end do + end do + +! for matrix + if(use_soil_matrixcn)then + do k = 1, ndecomp_pools + do j = 1, nlevdecomp + do fi = 1,num_column + i = filter_column(fi) + this%matrix_decomp_fire_k_col(i,j+nlevdecomp*(k-1)) = value_column + end do + end do + end do + call this%matrix_Cinput%SetValueV_scaler(num_column,filter_column(1:num_column),value_column) + ! IMPORTANT NOTE: Although it looks like the following if appears to be + ! backwards (it should be 'if use_versoilc'), fixing it causes Carbon + ! balance checks to fail. EBK 10/21/2019 + ! Both use_vertsoilc and .not. use_vertsoilc should reset tri_ma_vr to 0. + ! Because single soil layer still add V matrix but as a zero matrix. CL 10/23/2019 + if(use_vertsoilc)then + do k = 1,decomp_cascade_con%Ntri_setup + do fi = 1,num_column + i = filter_column(fi) + this%tri_ma_vr(i,k) = value_column + end do + end do + end if + end if + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%hr_vr_col(i,j) = value_column + end do + end do + + do fi = 1,num_column + i = filter_column(fi) + this%hr_col(i) = value_column + this%somc_fire_col(i) = value_column + this%som_c_leached_col(i) = value_column + this%somhr_col(i) = value_column + this%lithr_col(i) = value_column + this%soilc_change_col(i) = value_column + end do + + ! NOTE: do not zero the fates to BGC C flux variables since they need to persist from the daily fates timestep s to the half-hourly BGC timesteps. I.e. FATES_c_to_litr_lab_c_col, FATES_c_to_litr_cel_c_col, FATES_c_to_litr_lig_c_col + + end subroutine SetValues + +end module CNCLM_SoilBiogeochemCarbonFluxType + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 new file mode 100644 index 000000000..b7d02810a --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -0,0 +1,155 @@ +module CNCLM_SoilBiogeochemCarbonStateType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan + use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi + use clm_varctl , only : use_soil_matrixcn + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_soilbiogeochem_carbonstate_type + + type, public :: soilbiogeochem_carbonstate_type + + ! all c pools involved in decomposition + real(r8), pointer :: decomp_cpools_vr_col (:,:,:) ! (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + real(r8), pointer :: decomp0_cpools_vr_col(:,:,:) ! (gC/m3) vertically-resolved C baseline (initial value of this year) in decomposing (litter, cwd, soil) pools in dimension (col,nlev,npools) + real(r8), pointer :: decomp_cpools_vr_SASUsave_col(:,:,:) ! (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + real(r8), pointer :: decomp_soilc_vr_col (:,:) ! (gC/m3) vertically-resolved decomposing total soil c pool + real(r8), pointer :: ctrunc_vr_col (:,:) ! (gC/m3) vertically-resolved column-level sink for C truncation + + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: ctrunc_col (:) ! (gC/m2) column-level sink for C truncation + real(r8), pointer :: totlitc_col (:) ! (gC/m2) total litter carbon + real(r8), pointer :: totlitc_1m_col (:) ! (gC/m2) total litter carbon to 1 meter + real(r8), pointer :: totsomc_col (:) ! (gC/m2) total soil organic matter carbon + real(r8), pointer :: totsomc_1m_col (:) ! (gC/m2) total soil organic matter carbon to 1 meter + real(r8), pointer :: cwdc_col (:) ! (gC/m2) coarse woody debris C (diagnostic) + real(r8), pointer :: decomp_cpools_1m_col (:,:) ! (gC/m2) Diagnostic: decomposing (litter, cwd, soil) c pools to 1 meter + real(r8), pointer :: decomp_cpools_col (:,:) ! (gC/m2) decomposing (litter, cwd, soil) c pools + real(r8), pointer :: dyn_cbal_adjustments_col(:) ! (gC/m2) adjustments to each column made in this timestep via dynamic column area adjustments (note: this variable only makes sense at the column-level: it is meaningless if averaged to the gridcell-level) + integer :: restart_file_spinup_state ! spinup state as read from restart file, for determining whether to enter or exit spinup mode. + real(r8) :: totvegcthresh ! threshold for total vegetation carbon to zero out decomposition pools + + ! Matrix-cn + real(r8), pointer :: matrix_cap_decomp_cpools_col (:,:) ! (gC/m2) C capacity in decomposing (litter, cwd, soil) N pools in dimension (col,npools) + real(r8), pointer :: matrix_cap_decomp_cpools_vr_col (:,:,:) ! (gC/m3) vertically-resolved C capacity in decomposing (litter, cwd, soil) pools in dimension(col,nlev,npools) + real(r8), pointer :: in_acc (:,:) ! (gC/m3/yr) accumulated litter fall C input per year in dimension(col,nlev*npools) + real(r8), pointer :: in_acc_2d (:,:,:) ! (gC/m3/yr) accumulated litter fall C input per year in dimension(col,nlev,npools) + real(r8), pointer :: tran_acc (:,:,:) ! (gC/m3/yr) accumulated C transfers from j to i (col,i,j) per year in dimension(col,nlev*npools,nlev*npools) + real(r8), pointer :: vert_up_tran_acc (:,:,:) ! (gC/m3/yr) accumulated upward vertical C transport in dimension(col,nlev,npools) + real(r8), pointer :: vert_down_tran_acc (:,:,:) ! (gC/m3/yr) accumulated downward vertical C transport in dimension(col,nlev,npools) + real(r8), pointer :: exit_acc (:,:,:) ! (gC/m3/yr) accumulated exit C in dimension(col,nlev,npools) + real(r8), pointer :: hori_tran_acc (:,:,:) ! (gC/m3/yr) accumulated C transport between pools at the same level in dimension(col,nlev,ntransfers) + ! type(sparse_matrix_type) :: AKXcacc ! (gC/m3/yr) accumulated N transfers from j to i (col,i,j) per year in dimension(col,nlev*npools,nlev*npools) in sparse matrix type + ! type(vector_type) :: matrix_Cinter ! (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools in dimension(col,nlev*npools) in vector type + + end type soilbiogeochem_carbonstate_type + type(soilbiogeochem_carbonstate_type), public, target, save :: soilbiogeochem_carbonstate_inst + +contains + +!------------------------------------------- + subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) + + ! + ! !ARGUMENTS: + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + type(soilbiogeochem_carbonstate_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: begc,endc + integer :: n, nc, nz, n + integer, dimension(8) :: decomp_cpool_cncol_index = (/ 3, 4, 5, 2, 10, 11, 12, 13 /) + !----------------------------------- + + begc = bounds%begc ; endc = bounds%endc + + allocate( this%decomp_cpools_col (begc :endc,1:ndecomp_pools)) ; this%decomp_cpools_col (:,:) = nan + allocate( this%decomp_cpools_1m_col (begc :endc,1:ndecomp_pools)) ; this%decomp_cpools_1m_col (:,:) = nan + if(use_soil_matrixcn)then + allocate( this%matrix_cap_decomp_cpools_col (begc :endc,1:ndecomp_pools)) ; this%matrix_cap_decomp_cpools_col (:,:) = nan + end if + + allocate( this%ctrunc_vr_col(begc :endc,1:nlevdecomp_full)) ; + this%ctrunc_vr_col (:,:) = nan + + allocate(this%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_cpools_vr_col(:,:,:)= nan + !matrix-spinup + if(use_soil_matrixcn)then + allocate(this%matrix_cap_decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%matrix_cap_decomp_cpools_vr_col(:,:,:)= nan + allocate(this%decomp0_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp0_cpools_vr_col(:,:,:)= nan + allocate(this%decomp_cpools_vr_SASUsave_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_cpools_vr_SASUsave_col(:,:,:)= nan + allocate(this%in_acc(begc:endc,1:nlevdecomp*ndecomp_pools)) + this%in_acc(:,:)= nan + allocate(this%tran_acc(begc:endc,1:nlevdecomp*ndecomp_pools,1:nlevdecomp*ndecomp_pools)) + this%tran_acc(:,:,:)= nan + + allocate(this%in_acc_2d(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%in_acc_2d(:,:,:)= nan + allocate(this%vert_up_tran_acc(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%vert_up_tran_acc(:,:,:)= nan + allocate(this%vert_down_tran_acc(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%vert_down_tran_acc(:,:,:)= nan + allocate(this%exit_acc(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%exit_acc(:,:,:)= nan + allocate(this%hori_tran_acc(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) + this%hori_tran_acc(:,:,:)= nan + ! jkolassa May 2022: comment out the two functions below as currently use_soil_matrixcn = .false. + !call this%AKXcacc%InitSM(ndecomp_pools*nlevdecomp,begc,endc,decomp_cascade_con%n_all_entries) + !call this%matrix_Cinter%InitV (ndecomp_pools*nlevdecomp,begc,endc) + end if + allocate(this%decomp_soilc_vr_col(begc:endc,1:nlevdecomp_full)) + this%decomp_soilc_vr_col(:,:)= nan + + allocate(this%ctrunc_col (begc :endc)) ; this%ctrunc_col (:) = nan + if ( .not. use_fates ) then + allocate(this%cwdc_col (begc :endc)) ; this%cwdc_col (:) = nan + endif + allocate(this%totlitc_col (begc :endc)) ; this%totlitc_col (:) = nan + allocate(this%totsomc_col (begc :endc)) ; this%totsomc_col (:) = nan + allocate(this%totlitc_1m_col (begc :endc)) ; this%totlitc_1m_col (:) = nan + allocate(this%totsomc_1m_col (begc :endc)) ; this%totsomc_1m_col (:) = nan + allocate(this%dyn_cbal_adjustments_col (begc:endc)) ; this%dyn_cbal_adjustments_col (:) = nan + + this%restart_file_spinup_state = huge(1) + + ! initialize variables from restart file or set to cold start value + n = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + n = n + 1 + + this%ctrunc_vr_col (n) = cncol(nc,nz,1) + this%totlitc_col (n) = cncol(nc,nz,15) + + do np = 1,ndecomp_pools + ! jkolassa May 2022: accounting for fact that pool order in CNCOL is different from CTSM + this%decomp_cpools_col (n,np) = cncol(nc,nz,decomp_cpool_cncol_index(np)) + this%decomp_cpools_col_1m (n,np) = cncol(nc,nz,decomp_cpool_cncol_index(np)) + ! jkolassa May 2022: loop has to be added below of we add more biogeochemical (or soil) layers + this%decomp_cpools_vr_col (n,1,np) cncol(nc,nz,decomp_cpool_cncol_index(np)) + end do !np + + ! sum soil carbon pools + this%totsomc_col (n) = this%decomp_cpools_col(n,5) + this%decomp_cpools_col(n,6) & + + this%decomp_cpools_col(n,7) + this%decomp_cpools_col(n,8) + end do !nz + end do ! nc + + end init_soilbiogeochem_carbonstate_type + +end module CNCLM_SoilBiogeochemCarbonStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 new file mode 100644 index 000000000..090d5044c --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -0,0 +1,439 @@ +module CNCLM_SoilBiogeochemNitrogenFluxType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, ndecomp_cascade_outtransitions + use clm_varpar , only : nlevdecomp_full, nlevdecomp, ndecomp_pools_vr + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_soil_matrixcn + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_soilbiogeochem_nitrogenflux_type + procedure, public :: SetValues + + type, public :: SoilBiogeochem_nitrogenflux_type + + ! deposition fluxes + real(r8), pointer :: ndep_to_sminn_col (:) ! col atmospheric N deposition to soil mineral N (gN/m2/s) + real(r8), pointer :: nfix_to_sminn_col (:) ! col symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) + real(r8), pointer :: ffix_to_sminn_col (:) ! col free living N fixation to soil mineral N (gN/m2/s) + real(r8), pointer :: fert_to_sminn_col (:) ! col fertilizer N to soil mineral N (gN/m2/s) + real(r8), pointer :: soyfixn_to_sminn_col (:) ! col soybean fixation to soil mineral N (gN/m2/s) + + ! decomposition fluxes + real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) + real(r8), pointer :: decomp_cascade_ntransfer_col (:,:) ! col vert-int (diagnostic) transfer of N from donor to receiver pool along decomp. cascade (gN/m2/s) + real(r8), pointer :: decomp_cascade_sminn_flux_vr_col (:,:,:) ! col vert-res mineral N flux for transition along decomposition cascade (gN/m3/s) + real(r8), pointer :: decomp_cascade_sminn_flux_col (:,:) ! col vert-int (diagnostic) mineral N flux for transition along decomposition cascade (gN/m2/s) + + ! Used to update concentrations concurrently with vertical transport + ! vertically-resolved immobilization fluxes + real(r8), pointer :: potential_immob_vr_col (:,:) ! col vertically-resolved potential N immobilization (gN/m3/s) at each level + real(r8), pointer :: potential_immob_col (:) ! col vert-int (diagnostic) potential N immobilization (gN/m2/s) + real(r8), pointer :: actual_immob_vr_col (:,:) ! col vertically-resolved actual N immobilization (gN/m3/s) at each level + real(r8), pointer :: actual_immob_col (:) ! col vert-int (diagnostic) actual N immobilization (gN/m2/s) + real(r8), pointer :: sminn_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil mineral N (gN/m3/s) + real(r8), pointer :: sminn_to_plant_col (:) ! col vert-int (diagnostic) plant uptake of soil mineral N (gN/m2/s) + real(r8), pointer :: supplement_to_sminn_vr_col (:,:) ! col vertically-resolved supplemental N supply (gN/m3/s) + real(r8), pointer :: supplement_to_sminn_col (:) ! col vert-int (diagnostic) supplemental N supply (gN/m2/s) + real(r8), pointer :: gross_nmin_vr_col (:,:) ! col vertically-resolved gross rate of N mineralization (gN/m3/s) + real(r8), pointer :: gross_nmin_col (:) ! col vert-int (diagnostic) gross rate of N mineralization (gN/m2/s) + real(r8), pointer :: net_nmin_vr_col (:,:) ! col vertically-resolved net rate of N mineralization (gN/m3/s) + real(r8), pointer :: net_nmin_col (:) ! col vert-int (diagnostic) net rate of N mineralization (gN/m2/s) + real(r8), pointer :: sminn_to_plant_fun_col (:) ! col total soil N uptake of FUN (gN/m2/s) + ! ---------- NITRIF_DENITRIF --------------------- + + ! nitrification / denitrification fluxes + real(r8), pointer :: f_nit_vr_col (:,:) ! col (gN/m3/s) soil nitrification flux + real(r8), pointer :: f_denit_vr_col (:,:) ! col (gN/m3/s) soil denitrification flux + real(r8), pointer :: f_nit_col (:) ! col (gN/m2/s) soil nitrification flux + real(r8), pointer :: f_denit_col (:) ! col (gN/m2/s) soil denitrification flux + + real(r8), pointer :: pot_f_nit_vr_col (:,:) ! col (gN/m3/s) potential soil nitrification flux + real(r8), pointer :: pot_f_denit_vr_col (:,:) ! col (gN/m3/s) potential soil denitrification flux + real(r8), pointer :: pot_f_nit_col (:) ! col (gN/m2/s) potential soil nitrification flux + real(r8), pointer :: pot_f_denit_col (:) ! col (gN/m2/s) potential soil denitrification flux + real(r8), pointer :: n2_n2o_ratio_denit_vr_col (:,:) ! col ratio of N2 to N2O production by denitrification [gN/gN] + real(r8), pointer :: f_n2o_denit_col (:) ! col flux of N2o from denitrification [gN/m^2/s] + real(r8), pointer :: f_n2o_nit_vr_col (:,:) ! col flux of N2o from nitrification [gN/m^3/s] + real(r8), pointer :: f_n2o_nit_col (:) ! col flux of N2o from nitrification [gN/m^2/s] + + ! immobilization / uptake fluxes + real(r8), pointer :: actual_immob_no3_vr_col (:,:) ! col vertically-resolved actual immobilization of NO3 (gN/m3/s) + real(r8), pointer :: actual_immob_nh4_vr_col (:,:) ! col vertically-resolved actual immobilization of NH4 (gN/m3/s) + real(r8), pointer :: smin_no3_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil NO3 (gN/m3/s) + real(r8), pointer :: smin_nh4_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil NH4 (gN/m3/s) + real(r8), pointer :: actual_immob_no3_col (:) ! col actual immobilization of NO3 (gN/m2/s) + real(r8), pointer :: actual_immob_nh4_col (:) ! col actual immobilization of NH4 (gN/m2/s) + real(r8), pointer :: smin_no3_to_plant_col (:) ! col plant uptake of soil NO3 (gN/m2/s) + real(r8), pointer :: smin_nh4_to_plant_col (:) ! col plant uptake of soil Nh4 (gN/m2/s) + + ! leaching fluxes + real(r8), pointer :: smin_no3_leached_vr_col (:,:) ! col vertically-resolved soil mineral NO3 loss to leaching (gN/m3/s) + real(r8), pointer :: smin_no3_leached_col (:) ! col soil mineral NO3 pool loss to leaching (gN/m2/s) + real(r8), pointer :: smin_no3_runoff_vr_col (:,:) ! col vertically-resolved rate of mineral NO3 loss with runoff (gN/m3/s) + real(r8), pointer :: smin_no3_runoff_col (:) ! col soil mineral NO3 pool loss to runoff (gN/m2/s) + + ! nitrification /denitrification diagnostic quantities + real(r8), pointer :: smin_no3_massdens_vr_col (:,:) ! col (ugN / g soil) soil nitrate concentration + real(r8), pointer :: soil_bulkdensity_col (:,:) ! col (kg soil / m3) bulk density of soil + real(r8), pointer :: k_nitr_t_vr_col (:,:) + real(r8), pointer :: k_nitr_ph_vr_col (:,:) + real(r8), pointer :: k_nitr_h2o_vr_col (:,:) + real(r8), pointer :: k_nitr_vr_col (:,:) + real(r8), pointer :: wfps_vr_col (:,:) + real(r8), pointer :: fmax_denit_carbonsubstrate_vr_col (:,:) + real(r8), pointer :: fmax_denit_nitrate_vr_col (:,:) + real(r8), pointer :: f_denit_base_vr_col (:,:) ! col nitrification and denitrification fluxes + real(r8), pointer :: diffus_col (:,:) ! col diffusivity (m2/s) + real(r8), pointer :: ratio_k1_col (:,:) + real(r8), pointer :: ratio_no3_co2_col (:,:) + real(r8), pointer :: soil_co2_prod_col (:,:) + real(r8), pointer :: fr_WFPS_col (:,:) + + real(r8), pointer :: r_psi_col (:,:) + real(r8), pointer :: anaerobic_frac_col (:,:) + real(r8), pointer :: sminn_to_plant_fun_no3_vr_col (:,:) ! col total layer no3 uptake of FUN (gN/m2/s) + real(r8), pointer :: sminn_to_plant_fun_nh4_vr_col (:,:) ! col total layer nh4 uptake of FUN (gN/m2/s) + !----------- no NITRIF_DENITRIF-------------- + + + ! denitrification fluxes + real(r8), pointer :: sminn_to_denit_decomp_cascade_vr_col (:,:,:) ! col vertically-resolved denitrification along decomp cascade (gN/m3/s) + real(r8), pointer :: sminn_to_denit_decomp_cascade_col (:,:) ! col vertically-integrated (diagnostic) denitrification along decomp cascade (gN/m2/s) + real(r8), pointer :: sminn_to_denit_excess_vr_col (:,:) ! col vertically-resolved denitrification from excess mineral N pool (gN/m3/s) + real(r8), pointer :: sminn_to_denit_excess_col (:) ! col vertically-integrated (diagnostic) denitrification from excess mineral N pool (gN/m2/s) + + ! leaching fluxes + real(r8), pointer :: sminn_leached_vr_col (:,:) ! col vertically-resolved soil mineral N pool loss to leaching (gN/m3/s) + real(r8), pointer :: sminn_leached_col (:) ! col soil mineral N pool loss to leaching (gN/m2/s) + + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: denit_col (:) ! col total rate of denitrification (gN/m2/s) + real(r8), pointer :: ninputs_col (:) ! col column-level N inputs (gN/m2/s) + real(r8), pointer :: noutputs_col (:) ! col column-level N outputs (gN/m2/s) + real(r8), pointer :: som_n_leached_col (:) ! col total SOM N loss from vertical transport (gN/m^2/s) + real(r8), pointer :: decomp_npools_leached_col (:,:) ! col N loss from vertical transport from each decomposing N pool (gN/m^2/s) + real(r8), pointer :: decomp_npools_transport_tendency_col (:,:,:) ! col N tendency due to vertical transport in decomposing N pools (gN/m^3/s) + + ! all n pools involved in decomposition + real(r8), pointer :: decomp_npools_sourcesink_col (:,:,:) ! col (gN/m3) change in decomposing n pools + ! (sum of all additions and subtractions from stateupdate1). + real(r8), pointer :: sminn_to_plant_fun_vr_col (:,:) ! col total layer soil N uptake of FUN (gN/m2/s) + + ! track tradiagonal matrix +! type(sparse_matrix_type) :: AKsoiln ! A*K for N transfers between pools +! type(sparse_matrix_type) :: AKallsoiln ! (A*K+V-Kfire) for soil N cycle + integer :: NE_AKallsoiln ! Number of non-zero entries in AKallsoiln. Automatically generated by functions SPMP_* + integer,pointer,dimension(:) :: RI_AKallsoiln ! Row numbers of entries in AKallsoiln. Automatically generated by functions in SPMP_* + integer,pointer,dimension(:) :: CI_AKallsoiln ! Column numbers of entries in AKallsoiln, Automatically generated by functions in SPMP_* + integer,pointer,dimension(:) :: RI_na ! Row numbers of all entries from AKsoiln. Automatically generated by SetValueA + integer,pointer,dimension(:) :: CI_na ! Column numbers of all entries from AKsoiln. Automatically generated by SetValueA +! type(vector_type) :: matrix_Ninput ! N input to different soil compartments (pools and layers) (gN/m3/step) + + end type soilbiogeochem_nitrogenflux_type + type(soilbiogeochem_nitrogenflux_type), public, target, save :: soilbiogeochem_nitrogenflux_inst + +contains + +!-------------------------------------------------------------- + subroutine init_soilbiogeochem_nitrogenflux_type(bounds,this) + + !ARGUMENTS + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(soilbiogeochem_nitrogenflux_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: begc,endc,Ntrans,Ntrans_diag + !------------------------------------------------------------------------ + + begc = bounds%begc; endc = bounds%endc + allocate(this%ndep_to_sminn_col (begc:endc)) ; this%ndep_to_sminn_col (:) = nan + allocate(this%nfix_to_sminn_col (begc:endc)) ; this%nfix_to_sminn_col (:) = nan + allocate(this%ffix_to_sminn_col (begc:endc)) ; this%ffix_to_sminn_col (:) = nan + allocate(this%fert_to_sminn_col (begc:endc)) ; this%fert_to_sminn_col (:) = nan + allocate(this%soyfixn_to_sminn_col (begc:endc)) ; this%soyfixn_to_sminn_col (:) = nan + allocate(this%sminn_to_plant_col (begc:endc)) ; this%sminn_to_plant_col (:) = nan + allocate(this%potential_immob_col (begc:endc)) ; this%potential_immob_col (:) = nan + allocate(this%actual_immob_col (begc:endc)) ; this%actual_immob_col (:) = nan + allocate(this%gross_nmin_col (begc:endc)) ; this%gross_nmin_col (:) = nan + allocate(this%net_nmin_col (begc:endc)) ; this%net_nmin_col (:) = nan + allocate(this%denit_col (begc:endc)) ; this%denit_col (:) = nan + allocate(this%supplement_to_sminn_col (begc:endc)) ; this%supplement_to_sminn_col (:) = nan + allocate(this%ninputs_col (begc:endc)) ; this%ninputs_col (:) = nan + allocate(this%noutputs_col (begc:endc)) ; this%noutputs_col (:) = nan + allocate(this%som_n_leached_col (begc:endc)) ; this%som_n_leached_col (:) = nan + + + allocate(this%r_psi_col (begc:endc,1:nlevdecomp_full)) ; this%r_psi_col (:,:) = spval + allocate(this%anaerobic_frac_col (begc:endc,1:nlevdecomp_full)) ; this%anaerobic_frac_col (:,:) = spval + allocate(this%potential_immob_vr_col (begc:endc,1:nlevdecomp_full)) ; this%potential_immob_vr_col (:,:) = nan + allocate(this%actual_immob_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_vr_col (:,:) = nan + allocate(this%sminn_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_vr_col (:,:) = nan + allocate(this%supplement_to_sminn_vr_col (begc:endc,1:nlevdecomp_full)) ; this%supplement_to_sminn_vr_col (:,:) = nan + allocate(this%gross_nmin_vr_col (begc:endc,1:nlevdecomp_full)) ; this%gross_nmin_vr_col (:,:) = nan + allocate(this%net_nmin_vr_col (begc:endc,1:nlevdecomp_full)) ; this%net_nmin_vr_col (:,:) = nan + allocate(this%sminn_to_plant_fun_col (begc:endc)) ; this%sminn_to_plant_fun_col (:) = nan + allocate(this%sminn_to_plant_fun_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_fun_vr_col (:,:) = nan + allocate(this%sminn_to_plant_fun_no3_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_fun_no3_vr_col(:,:) = nan + allocate(this%sminn_to_plant_fun_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_fun_nh4_vr_col(:,:) = nan + allocate(this%f_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nit_vr_col (:,:) = nan + allocate(this%f_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_denit_vr_col (:,:) = nan + allocate(this%smin_no3_leached_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_leached_vr_col (:,:) = nan + allocate(this%smin_no3_leached_col (begc:endc)) ; this%smin_no3_leached_col (:) = nan + allocate(this%smin_no3_runoff_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_runoff_vr_col (:,:) = nan + allocate(this%smin_no3_runoff_col (begc:endc)) ; this%smin_no3_runoff_col (:) = nan + allocate(this%pot_f_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%pot_f_nit_vr_col (:,:) = nan + allocate(this%pot_f_nit_col (begc:endc)) ; this%pot_f_nit_col (:) = nan + allocate(this%pot_f_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%pot_f_denit_vr_col (:,:) = nan + allocate(this%pot_f_denit_col (begc:endc)) ; this%pot_f_denit_col (:) = nan + allocate(this%actual_immob_no3_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_no3_vr_col (:,:) = nan + allocate(this%actual_immob_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_nh4_vr_col (:,:) = nan + allocate(this%smin_no3_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_to_plant_vr_col (:,:) = nan + allocate(this%smin_nh4_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_nh4_to_plant_vr_col (:,:) = nan + allocate(this%f_nit_col (begc:endc)) ; this%f_nit_col (:) = nan + allocate(this%f_denit_col (begc:endc)) ; this%f_denit_col (:) = nan + allocate(this%n2_n2o_ratio_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%n2_n2o_ratio_denit_vr_col (:,:) = nan + allocate(this%f_n2o_denit_col (begc:endc)) ; this%f_n2o_denit_col (:) = nan + allocate(this%f_n2o_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_n2o_denit_vr_col (:,:) = nan + allocate(this%f_n2o_nit_col (begc:endc)) ; this%f_n2o_nit_col (:) = nan + allocate(this%f_n2o_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_n2o_nit_vr_col (:,:) = nan + + + allocate(this%smin_no3_massdens_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_massdens_vr_col (:,:) = nan + allocate(this%soil_bulkdensity_col (begc:endc,1:nlevdecomp_full)) ; this%soil_bulkdensity_col (:,:) = nan + allocate(this%k_nitr_t_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_t_vr_col (:,:) = nan + allocate(this%k_nitr_ph_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_ph_vr_col (:,:) = nan + allocate(this%k_nitr_h2o_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_h2o_vr_col (:,:) = nan + allocate(this%k_nitr_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_vr_col (:,:) = nan + allocate(this%wfps_vr_col (begc:endc,1:nlevdecomp_full)) ; this%wfps_vr_col (:,:) = nan + allocate(this%f_denit_base_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_denit_base_vr_col (:,:) = nan + allocate(this%diffus_col (begc:endc,1:nlevdecomp_full)) ; this%diffus_col (:,:) = spval + allocate(this%ratio_k1_col (begc:endc,1:nlevdecomp_full)) ; this%ratio_k1_col (:,:) = nan + allocate(this%ratio_no3_co2_col (begc:endc,1:nlevdecomp_full)) ; this%ratio_no3_co2_col (:,:) = spval + allocate(this%soil_co2_prod_col (begc:endc,1:nlevdecomp_full)) ; this%soil_co2_prod_col (:,:) = nan + allocate(this%fr_WFPS_col (begc:endc,1:nlevdecomp_full)) ; this%fr_WFPS_col (:,:) = spval + + allocate(this%fmax_denit_carbonsubstrate_vr_col (begc:endc,1:nlevdecomp_full)) ; + this%fmax_denit_carbonsubstrate_vr_col (:,:) = nan + allocate(this%fmax_denit_nitrate_vr_col (begc:endc,1:nlevdecomp_full)) ; + this%fmax_denit_nitrate_vr_col (:,:) = nan + + allocate(this%decomp_cascade_ntransfer_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions )) + allocate(this%decomp_cascade_sminn_flux_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions )) + allocate(this%decomp_cascade_ntransfer_col (begc:endc,1:ndecomp_cascade_transitions )) + allocate(this%decomp_cascade_sminn_flux_col (begc:endc,1:ndecomp_cascade_transitions )) + + this%decomp_cascade_ntransfer_vr_col (:,:,:) = nan + this%decomp_cascade_sminn_flux_vr_col (:,:,:) = nan + this%decomp_cascade_ntransfer_col (:,:) = nan + this%decomp_cascade_sminn_flux_col (:,:) = nan + + allocate(this%sminn_to_denit_decomp_cascade_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions )) + allocate(this%sminn_to_denit_decomp_cascade_col (begc:endc,1:ndecomp_cascade_transitions )) + allocate(this%sminn_to_denit_excess_vr_col (begc:endc,1:nlevdecomp_full )) + allocate(this%sminn_to_denit_excess_col (begc:endc )) + allocate(this%sminn_leached_vr_col (begc:endc,1:nlevdecomp_full )) + allocate(this%sminn_leached_col (begc:endc )) + allocate(this%decomp_npools_leached_col (begc:endc,1:ndecomp_pools )) + allocate(this%decomp_npools_transport_tendency_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools )) + + this%sminn_to_denit_decomp_cascade_vr_col (:,:,:) = nan + this%sminn_to_denit_decomp_cascade_col (:,:) = nan + this%sminn_to_denit_excess_vr_col (:,:) = nan + this%sminn_to_denit_excess_col (:) = nan + this%sminn_leached_vr_col (:,:) = nan + this%sminn_leached_col (:) = nan + this%decomp_npools_leached_col (:,:) = nan + this%decomp_npools_transport_tendency_col (:,:,:) = nan + + allocate(this%decomp_npools_sourcesink_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_npools_sourcesink_col (:,:,:) = nan + if(use_soil_matrixcn)then + + Ntrans = (ndecomp_cascade_transitions-ndecomp_cascade_outtransitions)*nlevdecomp + ! call this%AKsoiln%InitSM (ndecomp_pools*nlevdecomp,begc,endc,Ntrans+ndecomp_pools*nlevdecomp) + ! call this%AKallsoiln%InitSM (ndecomp_pools*nlevdecomp,begc,endc,Ntrans+decomp_cascade_con%Ntri_setup+nlevdecomp) + this%NE_AKallsoiln = (Ntrans+nlevdecomp*ndecomp_pools) + (Ntrans+decomp_cascade_con%Ntri_setup + nlevdecomp) + (ndecomp_pools*nlevdecomp) + allocate(this%RI_AKallsoiln(1:this%NE_AKallsoiln)); this%RI_AKallsoiln(1:this%NE_AKallsoiln)=-9999 + allocate(this%CI_AKallsoiln(1:this%NE_AKallsoiln)); this%CI_AKallsoiln(1:this%NE_AKallsoiln)=-9999 + Ntrans_diag = (ndecomp_cascade_transitions-ndecomp_cascade_outtransitions)*nlevdecomp+ndecomp_pools_vr + allocate(this%RI_na(1:Ntrans_diag)); this%RI_na(1:Ntrans_diag) = -9999 + allocate(this%CI_na(1:Ntrans_diag)); this%CI_na(1:Ntrans_diag) = -9999 + ! call this%matrix_Ninput%InitV (ndecomp_pools*nlevdecomp,begc,endc) + end if + + end subroutine init_soilbiogeochem_nitrogenflux_type + + !----------------------------------------------------------------------- + subroutine SetValues ( this, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set nitrogen flux variables + ! + ! !ARGUMENTS: + ! !ARGUMENTS: + class(soilbiogeochem_nitrogenflux_type) :: this + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i,j,k,l ! loop index + !------------------------------------------------------------------------ + + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + + if (.not. use_nitrif_denitrif) then + this%sminn_to_denit_excess_vr_col(i,j) = value_column + this%sminn_leached_vr_col(i,j) = value_column + this%sminn_to_plant_fun_vr_col(i,j) = value_column + else + this%f_nit_vr_col(i,j) = value_column + this%f_denit_vr_col(i,j) = value_column + this%smin_no3_leached_vr_col(i,j) = value_column + this%smin_no3_runoff_vr_col(i,j) = value_column + this%n2_n2o_ratio_denit_vr_col(i,j) = value_column + this%pot_f_nit_vr_col(i,j) = value_column + this%pot_f_denit_vr_col(i,j) = value_column + this%actual_immob_no3_vr_col(i,j) = value_column + this%actual_immob_nh4_vr_col(i,j) = value_column + this%smin_no3_to_plant_vr_col(i,j) = value_column + this%smin_nh4_to_plant_vr_col(i,j) = value_column + this%f_n2o_denit_vr_col(i,j) = value_column + this%f_n2o_nit_vr_col(i,j) = value_column + + this%smin_no3_massdens_vr_col(i,j) = value_column + this%k_nitr_t_vr_col(i,j) = value_column + this%k_nitr_ph_vr_col(i,j) = value_column + this%k_nitr_h2o_vr_col(i,j) = value_column + this%k_nitr_vr_col(i,j) = value_column + this%wfps_vr_col(i,j) = value_column + this%fmax_denit_carbonsubstrate_vr_col(i,j) = value_column + this%fmax_denit_nitrate_vr_col(i,j) = value_column + this%f_denit_base_vr_col(i,j) = value_column + + this%diffus_col(i,j) = value_column + this%ratio_k1_col(i,j) = value_column + this%ratio_no3_co2_col(i,j) = value_column + this%soil_co2_prod_col(i,j) = value_column + this%fr_WFPS_col(i,j) = value_column + this%soil_bulkdensity_col(i,j) = value_column + + this%r_psi_col(i,j) = value_column + this%anaerobic_frac_col(i,j) = value_column + end if + this%potential_immob_vr_col(i,j) = value_column + this%actual_immob_vr_col(i,j) = value_column + this%sminn_to_plant_vr_col(i,j) = value_column + this%supplement_to_sminn_vr_col(i,j) = value_column + this%gross_nmin_vr_col(i,j) = value_column + this%net_nmin_vr_col(i,j) = value_column + this%sminn_to_plant_fun_no3_vr_col(i,j) = value_column + this%sminn_to_plant_fun_nh4_vr_col(i,j) = value_column + end do + end do + + + do fi = 1,num_column + i = filter_column(fi) + + this%ndep_to_sminn_col(i) = value_column + this%nfix_to_sminn_col(i) = value_column + this%ffix_to_sminn_col(i) = value_column + this%fert_to_sminn_col(i) = value_column + this%soyfixn_to_sminn_col(i) = value_column + this%potential_immob_col(i) = value_column + this%actual_immob_col(i) = value_column + this%sminn_to_plant_col(i) = value_column + this%supplement_to_sminn_col(i) = value_column + this%gross_nmin_col(i) = value_column + this%net_nmin_col(i) = value_column + this%denit_col(i) = value_column + this%sminn_to_plant_fun_col(i) = value_column + if (use_nitrif_denitrif) then + this%f_nit_col(i) = value_column + this%pot_f_nit_col(i) = value_column + this%f_denit_col(i) = value_column + this%pot_f_denit_col(i) = value_column + this%f_n2o_denit_col(i) = value_column + this%f_n2o_nit_col(i) = value_column + this%smin_no3_leached_col(i) = value_column + this%smin_no3_runoff_col(i) = value_column + else + this%sminn_to_denit_excess_col(i) = value_column + this%sminn_leached_col(i) = value_column + end if + this%ninputs_col(i) = value_column + this%noutputs_col(i) = value_column + this%som_n_leached_col(i) = value_column + end do + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%decomp_npools_leached_col(i,k) = value_column + end do + end do + + if(use_soil_matrixcn)then +! call this%matrix_Ninput%SetValueV_scaler(num_column,filter_column(1:num_column),value_column) + end if + + + do k = 1, ndecomp_pools + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_npools_transport_tendency_col(i,j,k) = value_column + end do + end do + end do + + do l = 1, ndecomp_cascade_transitions + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cascade_ntransfer_col(i,l) = value_column + this%decomp_cascade_sminn_flux_col(i,l) = value_column + if (.not. use_nitrif_denitrif) then + this%sminn_to_denit_decomp_cascade_col(i,l) = value_column + end if + end do + end do + + do l = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cascade_ntransfer_vr_col(i,j,l) = value_column + this%decomp_cascade_sminn_flux_vr_col(i,j,l) = value_column + if (.not. use_nitrif_denitrif) then + this%sminn_to_denit_decomp_cascade_vr_col(i,j,l) = value_column + end if + end do + end do + end do + + do k = 1, ndecomp_pools + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_npools_sourcesink_col(i,j,k) = value_column + end do + end do + end do + + end subroutine SetValues + + +end module CNCLM_SoilBiogeochemNitrogenFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 new file mode 100644 index 000000000..7d8fae6af --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -0,0 +1,166 @@ +module CNCLM_SoilBiogeochemNitrogenStateType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan + use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi + use clm_varctl , only : use_soil_matrixcn + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_soilbiogeochem_nitrogenstate_type + + type, public :: soilbiogeochem_nitrogenstate_type + + real(r8), pointer :: decomp_npools_vr_col (:,:,:) ! col (gN/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + real(r8), pointer :: decomp0_npools_vr_col (:,:,:) ! col (gN/m3) vertically-resolved N baseline (initial value of this year) in decomposing (litter, cwd, soil) pools in dimension (col,nlev,npools) + real(r8), pointer :: decomp_npools_vr_SASUsave_col(:,:,:) ! col (gN/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + + real(r8), pointer :: decomp_soiln_vr_col (:,:) ! col (gN/m3) vertically-resolved decomposing total soil N pool + + real(r8), pointer :: sminn_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral N + real(r8), pointer :: ntrunc_vr_col (:,:) ! col (gN/m3) vertically-resolved column-level sink for N truncation + + ! nitrif_denitrif + real(r8), pointer :: smin_no3_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NO3 + real(r8), pointer :: smin_no3_col (:) ! col (gN/m2) soil mineral NO3 pool + real(r8), pointer :: smin_nh4_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NH4 + real(r8), pointer :: smin_nh4_col (:) ! col (gN/m2) soil mineral NH4 pool + + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: decomp_npools_col (:,:) ! col (gN/m2) decomposing (litter, cwd, soil) N pools + real(r8), pointer :: decomp_npools_1m_col (:,:) ! col (gN/m2) diagnostic: decomposing (litter, cwd, soil) N pools to 1 meter + real(r8), pointer :: sminn_col (:) ! col (gN/m2) soil mineral N + real(r8), pointer :: ntrunc_col (:) ! col (gN/m2) column-level sink for N truncation + real(r8), pointer :: cwdn_col (:) ! col (gN/m2) Diagnostic: coarse woody debris N + real(r8), pointer :: totlitn_col (:) ! col (gN/m2) total litter nitrogen + real(r8), pointer :: totsomn_col (:) ! col (gN/m2) total soil organic matter nitrogen + real(r8), pointer :: totlitn_1m_col (:) ! col (gN/m2) total litter nitrogen to 1 meter + real(r8), pointer :: totsomn_1m_col (:) ! col (gN/m2) total soil organic matter nitrogen to 1 meter + real(r8), pointer :: dyn_nbal_adjustments_col (:) ! (gN/m2) adjustments to each column made in this timestep via dynamic column adjustments (note: this variable only makes sense at the column-level: it is meaningless if averaged to the gridcell-level) + + ! Track adjustments to no3 and nh4 pools separately, since those aren't included in + ! the N balance check + real(r8), pointer :: dyn_no3bal_adjustments_col (:) ! (gN/m2) NO3 adjustments to each column made in this timestep via dynamic column area adjustments (only makes sense at the column-level: meaningless if averaged to the gridcell-level) + real(r8), pointer :: dyn_nh4bal_adjustments_col (:) ! (gN/m2) NH4 adjustments to each column made in this timestep via dynamic column adjustments (only makes sense at the column-level: meaningless if averaged to the gridcell-level) + real(r8) :: totvegcthresh ! threshold for total vegetation carbon to zero out decomposition pools + + ! Matrix-cn + real(r8), pointer :: matrix_cap_decomp_npools_col (:,:) ! col (gN/m2) N capacity in decomposing (litter, cwd, soil) N pools in dimension (col,npools) + real(r8), pointer :: matrix_cap_decomp_npools_vr_col (:,:,:) ! col (gN/m3) vertically-resolved N capacity in decomposing (litter, cwd, soil) pools in dimension(col,nlev,npools) + real(r8), pointer :: in_nacc (:,:) ! col (gN/m3/yr) accumulated litter fall N input per year in dimension(col,nlev*npools) + real(r8), pointer :: in_nacc_2d (:,:,:) ! col (gN/m3/yr) accumulated litter fall N input per year in dimension(col,nlev,npools) + real(r8), pointer :: tran_nacc (:,:,:) ! col (gN/m3/yr) accumulated N transfers from j to i (col,i,j) per year in dimension(col,nlev*npools,nlev*npools) + real(r8), pointer :: vert_up_tran_nacc (:,:,:) ! col (gN/m3/yr) accumulated upward vertical N transport in dimension(col,nlev,npools) + real(r8), pointer :: vert_down_tran_nacc (:,:,:) ! col (gN/m3/yr) accumulated downward vertical N transport in dimension(col,nlev,npools) + real(r8), pointer :: exit_nacc (:,:,:) ! col (gN/m3/yr) accumulated exit N in dimension(col,nlev,npools) + real(r8), pointer :: hori_tran_nacc (:,:,:) ! col (gN/m3/yr) accumulated N transport between pools at the same level in dimension(col,nlev,ntransfers) + ! type(sparse_matrix_type) :: AKXnacc ! col (gN/m3/yr) accumulated N transfers from j to i (col,i,j) per year in dimension(col,nlev*npools,nlev*npools) in sparse matrix type + ! type(vector_type) :: matrix_Ninter ! col (gN/m3) vertically-resolved decomposing (litter, cwd, soil) N pools in dimension(col,nlev*npools) in vector type + + end type soilbiogeochem_nitrogenstate_type + type(soilbiogeochem_nitrogenstate_type), public, target, save :: soilbiogeochem_nitrogenstate_inst + +contains + +!------------------------------------------- + subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) + + ! + ! !ARGUMENTS: + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + type(soilbiogeochem_nitrogenstate_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: begc,endc + integer, dimension(8) :: decomp_npool_cncol_index = (/ 18, 19, 20, 17,25, 26, 27, 28 /) + !----------------------------------- + + begc = bounds%begc ; endc = bounds%endc + + allocate(this%sminn_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_vr_col (:,:) = nan + allocate(this%ntrunc_vr_col (begc:endc,1:nlevdecomp_full)) ; this%ntrunc_vr_col (:,:) = nan + allocate(this%smin_no3_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_vr_col (:,:) = nan + allocate(this%smin_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_nh4_vr_col (:,:) = nan + allocate(this%smin_no3_col (begc:endc)) ; this%smin_no3_col (:) = nan + allocate(this%smin_nh4_col (begc:endc)) ; this%smin_nh4_col (:) = nan + allocate(this%cwdn_col (begc:endc)) ; this%cwdn_col (:) = nan + allocate(this%sminn_col (begc:endc)) ; this%sminn_col (:) = nan + allocate(this%ntrunc_col (begc:endc)) ; this%ntrunc_col (:) = nan + allocate(this%totlitn_col (begc:endc)) ; this%totlitn_col (:) = nan + allocate(this%totsomn_col (begc:endc)) ; this%totsomn_col (:) = nan + allocate(this%totlitn_1m_col (begc:endc)) ; this%totlitn_1m_col (:) = nan + allocate(this%totsomn_1m_col (begc:endc)) ; this%totsomn_1m_col (:) = nan + allocate(this%dyn_nbal_adjustments_col (begc:endc)) ; this%dyn_nbal_adjustments_col (:) = nan + allocate(this%dyn_no3bal_adjustments_col (begc:endc)) ; this%dyn_no3bal_adjustments_col (:) = nan + allocate(this%dyn_nh4bal_adjustments_col (begc:endc)) ; this%dyn_nh4bal_adjustments_col (:) = nan + allocate(this%decomp_npools_col (begc:endc,1:ndecomp_pools)) ; this%decomp_npools_col (:,:) = nan + allocate(this%decomp_npools_1m_col (begc:endc,1:ndecomp_pools)) ; this%decomp_npools_1m_col (:,:) = nan + if(use_soil_matrixcn)then + allocate(this%matrix_cap_decomp_npools_col (begc:endc,1:ndecomp_pools)) ; this%matrix_cap_decomp_npools_col (:,:) = nan + end if + + allocate(this%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)); + this%decomp_npools_vr_col(:,:,:)= nan + if(use_soil_matrixcn)then + allocate(this%matrix_cap_decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)); + this%matrix_cap_decomp_npools_vr_col(:,:,:)= nan +! for matrix-spinup + allocate(this%decomp0_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)); + this%decomp0_npools_vr_col(:,:,:)= nan + allocate(this%decomp_npools_vr_SASUsave_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)); + this%decomp_npools_vr_SASUsave_col(:,:,:)= nan + allocate(this%in_nacc(begc:endc,1:nlevdecomp*ndecomp_pools)) + this%in_nacc(:,:)= nan + allocate(this%tran_nacc(begc:endc,1:nlevdecomp*ndecomp_pools,1:nlevdecomp*ndecomp_pools)) + this%tran_nacc(:,:,:)= nan + + allocate(this%in_nacc_2d(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%in_nacc_2d(:,:,:)= nan + allocate(this%vert_up_tran_nacc(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%vert_up_tran_nacc(:,:,:)= nan + allocate(this%vert_down_tran_nacc(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%vert_down_tran_nacc(:,:,:)= nan + allocate(this%exit_nacc(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%exit_nacc(:,:,:)= nan + allocate(this%hori_tran_nacc(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) + this%hori_tran_nacc(:,:,:)= nan + call this%AKXnacc%InitSM(ndecomp_pools*nlevdecomp,begc,endc,decomp_cascade_con%n_all_entries) + call this%matrix_Ninter%InitV (ndecomp_pools*nlevdecomp,begc,endc) + end if + allocate(this%decomp_soiln_vr_col(begc:endc,1:nlevdecomp_full)) + this%decomp_soiln_vr_col(:,:)= nan + + + ! initialize variables from restart file or set to cold start value + n = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,nzone ! CN zone loop + n = n + 1 + + this%ntrunc_vr_col (n) = cncol(nc,nz,16) + ! jkolassa May 2022: for now nlevdecomp_full = 1; will need to add loop if we introduce more soil layers + this%sminn_vr_col (n,1) = cncol(nc,nz,24) + this%sminn_col (n) = this%sminn_vr_col(n,1) + + do np = 1,ndecomp_pools + ! jkolassa May 2022: accounting for fact that pool order in CNCOL is different from CTSM + this%decomp_npools_col (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) + this%decomp_npools_col_1m (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) + ! jkolassa May 2022: loop has to be added below of we add more biogeochemical (or soil) layers + this%decomp_npools_vr_col (n,1,np) cncol(nc,nz,decomp_npool_cncol_index(np)) + end do !np + end do !nz + end do + + end subroutine init_soilbiogeochem_nitrogenstate_type + +end CNCLM_SoilBiogeochemNitrogenStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 new file mode 100644 index 000000000..8a2d00763 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -0,0 +1,97 @@ +module CNCLM_SoilBiogeochemStateType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan, & + nlevsno, nlevgrnd, nlevlak, nlevsoifl + use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi + use clm_varctl , only : use_cn + use clm_varcon , only : spval + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_soilbiogeochem_state_type + + ! !PUBLIC TYPES: + type, public :: soilbiogeochem_state_type + + real(r8) , pointer :: leaf_prof_patch (:,:) ! (1/m) profile of leaves (vertical profiles for calculating fluxes) + real(r8) , pointer :: froot_prof_patch (:,:) ! (1/m) profile of fine roots (vertical profiles for calculating fluxes) + real(r8) , pointer :: croot_prof_patch (:,:) ! (1/m) profile of coarse roots (vertical profiles for calculating fluxes) + real(r8) , pointer :: stem_prof_patch (:,:) ! (1/m) profile of stems (vertical profiles for calculating fluxes) + real(r8) , pointer :: fpi_vr_col (:,:) ! (no units) fraction of potential immobilization + real(r8) , pointer :: fpi_col (:) ! (no units) fraction of potential immobilization + real(r8), pointer :: fpg_col (:) ! (no units) fraction of potential gpp + real(r8) , pointer :: rf_decomp_cascade_col (:,:,:) ! (frac) respired fraction in decomposition step + real(r8) , pointer :: pathfrac_decomp_cascade_col (:,:,:) ! (frac) what fraction of C leaving a given pool passes through a given transition + real(r8) , pointer :: nfixation_prof_col (:,:) ! (1/m) profile for N fixation additions + real(r8) , pointer :: ndep_prof_col (:,:) ! (1/m) profile for N fixation additions + real(r8) , pointer :: som_adv_coef_col (:,:) ! (m2/s) SOM advective flux + real(r8) , pointer :: som_diffus_coef_col (:,:) ! (m2/s) SOM diffusivity due to bio/cryo-turbation + real(r8) , pointer :: plant_ndemand_col (:) ! column-level plant N demand + + end type soilbiogeochem_state_type + type(soilbiogeochem_state_type), public, target, save :: soilbiogeochem_state_inst + +contains + +!--------------------------------------- + subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this) + + ! + ! !ARGUMENTS: + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + type(soilbiogeochem_state_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc,endc + integer :: n, nc, nz, n, np + !----------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%leaf_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%leaf_prof_patch (:,:) = spval + allocate(this%froot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%froot_prof_patch (:,:) = spval + allocate(this%croot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%croot_prof_patch (:,:) = spval + allocate(this%stem_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%stem_prof_patch (:,:) = spval + allocate(this%fpi_vr_col (begc:endc,1:nlevdecomp_full)) ; this%fpi_vr_col (:,:) = nan + allocate(this%fpi_col (begc:endc)) ; this%fpi_col (:) = nan + allocate(this%fpg_col (begc:endc)) ; this%fpg_col (:) = nan + allocate(this%nfixation_prof_col (begc:endc,1:nlevdecomp_full)) ; this%nfixation_prof_col (:,:) = spval + allocate(this%ndep_prof_col (begc:endc,1:nlevdecomp_full)) ; this%ndep_prof_col (:,:) = spval + allocate(this%som_adv_coef_col (begc:endc,1:nlevdecomp_full)) ; this%som_adv_coef_col (:,:) = spval + allocate(this%som_diffus_coef_col (begc:endc,1:nlevdecomp_full)) ; this%som_diffus_coef_col (:,:) = spval + allocate(this%plant_ndemand_col (begc:endc)) ; this%plant_ndemand_col (:) = nan + + allocate(this%rf_decomp_cascade_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)); + this%rf_decomp_cascade_col(:,:,:) = nan + + allocate(this%pathfrac_decomp_cascade_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)); + this%pathfrac_decomp_cascade_col(:,:,:) = nan + + ! initialize variables from restart file or set to cold start value + n = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + n = n + 1 + + this%fpg_col(n) = cncol(nc,nz, 30) + this%fpi_col(n) = cncol(nc,nz, 35) + do np = 1,nlevdecomp_full + this%fpi_vr_col(n,np) = cncol(nc,nz, 35) + end do + end do !nz + end do ! nc + + end subroutine init_soilbiogeochem_state_type +end module CNCLM_SoilBiogeochemStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 new file mode 100644 index 000000000..5b6babec2 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -0,0 +1,158 @@ +module CNCLM_SoilStateType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varpar , only : nlevsoi, nlevgrnd, nlevmaxurbgrnd, & + nlayer, nlevsno + use clm_varcon , only : spval + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_soilstate_type + + ! + type, public :: soilstate_type + + ! sand/ clay/ organic matter + real(r8), pointer :: sandfrac_patch (:) ! patch sand fraction + real(r8), pointer :: clayfrac_patch (:) ! patch clay fraction + real(r8), pointer :: mss_frc_cly_vld_col (:) ! col mass fraction clay limited to 0.20 + real(r8), pointer :: cellorg_col (:,:) ! col organic matter for gridcell containing column (1:nlevsoi) + real(r8), pointer :: cellsand_col (:,:) ! sand value for gridcell containing column (1:nlevsoi) + real(r8), pointer :: cellclay_col (:,:) ! clay value for gridcell containing column (1:nlevsoi) + real(r8), pointer :: bd_col (:,:) ! col bulk density of dry soil material [kg/m^3] (CN) + + ! hydraulic properties + real(r8), pointer :: hksat_col (:,:) ! col hydraulic conductivity at saturation (mm H2O /s) + real(r8), pointer :: hksat_min_col (:,:) ! col mineral hydraulic conductivity at saturation (hksat) (mm/s) + real(r8), pointer :: hk_l_col (:,:) ! col hydraulic conductivity (mm/s) + real(r8), pointer :: smp_l_col (:,:) ! col soil matric potential (mm) + real(r8), pointer :: smpmin_col (:) ! col restriction for min of soil potential (mm) + real(r8), pointer :: bsw_col (:,:) ! col Clapp and Hornberger "b" (nlevgrnd) + real(r8), pointer :: watsat_col (:,:) ! col volumetric soil water at saturation (porosity) + real(r8), pointer :: watdry_col (:,:) ! col btran parameter for btran = 0 + real(r8), pointer :: watopt_col (:,:) ! col btran parameter for btran = 1 + real(r8), pointer :: watfc_col (:,:) ! col volumetric soil water at field capacity (nlevsoi) + real(r8), pointer :: sucsat_col (:,:) ! col minimum soil suction (mm) (nlevgrnd) + real(r8), pointer :: dsl_col (:) ! col dry surface layer thickness (mm) + real(r8), pointer :: soilresis_col (:) ! col soil evaporative resistance S&L14 (s/m) + real(r8), pointer :: soilbeta_col (:) ! col factor that reduces ground evaporation L&P1992(-) + real(r8), pointer :: soilalpha_col (:) ! col factor that reduces ground saturated specific humidity (-) + real(r8), pointer :: soilalpha_u_col (:) ! col urban factor that reduces ground saturated specific humidity (-) + real(r8), pointer :: soilpsi_col (:,:) ! col soil water potential in each soil layer (MPa) (CN) + real(r8), pointer :: wtfact_col (:) ! col maximum saturated fraction for a gridcell + real(r8), pointer :: porosity_col (:,:) ! col soil porisity (1-bulk_density/soil_density) (VIC) + real(r8), pointer :: eff_porosity_col (:,:) ! col effective porosity = porosity - vol_ice (nlevgrnd) + real(r8), pointer :: gwc_thr_col (:) ! col threshold soil moisture based on clay content +!scs: vangenuchten + real(r8), pointer :: msw_col (:,:) ! col vanGenuchtenClapp "m" + real(r8), pointer :: nsw_col (:,:) ! col vanGenuchtenClapp "n" + real(r8), pointer :: alphasw_col (:,:) ! col vanGenuchtenClapp "nalpha" + real(r8), pointer :: watres_col (:,:) ! residual soil water content + ! thermal conductivity / heat capacity + real(r8), pointer :: thk_col (:,:) ! col thermal conductivity of each layer [W/m-K] + real(r8), pointer :: tkmg_col (:,:) ! col thermal conductivity, soil minerals [W/m-K] (new) (nlevgrnd) + real(r8), pointer :: tkdry_col (:,:) ! col thermal conductivity, dry soil (W/m/Kelvin) (nlevgrnd) + real(r8), pointer :: tksatu_col (:,:) ! col thermal conductivity, saturated soil [W/m-K] (new) (nlevgrnd) + real(r8), pointer :: csol_col (:,:) ! col heat capacity, soil solids (J/m**3/Kelvin) (nlevgrnd) + + ! roots + real(r8), pointer :: rootr_patch (:,:) ! patch effective fraction of roots in each soil layer (SMS method only) (nlevgrnd) + real(r8), pointer :: rootr_col (:,:) ! col effective fraction of roots in each soil layer (SMS method only) (nlevgrnd) + real(r8), pointer :: rootfr_col (:,:) ! col fraction of roots in each soil layer (nlevgrnd) + real(r8), pointer :: rootfr_patch (:,:) ! patch fraction of roots for water in each soil layer (nlevgrnd) + real(r8), pointer :: crootfr_patch (:,:) ! patch fraction of roots for carbon in each soil layer (nlevgrnd) + real(r8), pointer :: root_depth_patch (:) ! root depth + real(r8), pointer :: rootr_road_perv_col (:,:) ! col effective fraction of roots in each soil layer of urban pervious road + real(r8), pointer :: rootfr_road_perv_col (:,:) ! col effective fraction of roots in each soil layer of urban pervious road + real(r8), pointer :: k_soil_root_patch (:,:) ! patch soil-root interface conductance [mm/s] + real(r8), pointer :: root_conductance_patch(:,:) ! patch root conductance [mm/s] + real(r8), pointer :: soil_conductance_patch(:,:) ! patch soil conductance [mm/s] + +end type soilstate_type +type(soilstate_type), public, target, save :: soilstate_inst + +contains + +!----------------------------------------------------------- + subroutine init_soilstate_type(bounds, this) + + ! !DESCRIPTION: + ! Initialize CTSM soil state type needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + !INPUT + type(bounds_type), intent(in) :: bounds + type(soilstate_type), intent(inout):: this + + !LOCAL + integer :: begp, endp + integer :: begc, endc + !----------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + + allocate(this%mss_frc_cly_vld_col (begc:endc)) ; this%mss_frc_cly_vld_col (:) = nan + allocate(this%sandfrac_patch (begp:endp)) ; this%sandfrac_patch (:) = nan + allocate(this%clayfrac_patch (begp:endp)) ; this%clayfrac_patch (:) = nan + allocate(this%cellorg_col (begc:endc,nlevsoi)) ; this%cellorg_col (:,:) = nan + allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = nan + allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = nan + allocate(this%bd_col (begc:endc,nlevgrnd)) ; this%bd_col (:,:) = nan + + allocate(this%hksat_col (begc:endc,nlevgrnd)) ; this%hksat_col (:,:) = spval + allocate(this%hksat_min_col (begc:endc,nlevgrnd)) ; this%hksat_min_col (:,:) = spval + allocate(this%hk_l_col (begc:endc,nlevgrnd)) ; this%hk_l_col (:,:) = nan + allocate(this%smp_l_col (begc:endc,nlevgrnd)) ; this%smp_l_col (:,:) = nan + allocate(this%smpmin_col (begc:endc)) ; this%smpmin_col (:) = nan + + allocate(this%bsw_col (begc:endc,nlevgrnd)) ; this%bsw_col (:,:) = nan + allocate(this%watsat_col (begc:endc,nlevmaxurbgrnd)) ; this%watsat_col (:,:) = nan + allocate(this%watdry_col (begc:endc,nlevgrnd)) ; this%watdry_col (:,:) = spval + allocate(this%watopt_col (begc:endc,nlevgrnd)) ; this%watopt_col (:,:) = spval + allocate(this%watfc_col (begc:endc,nlevgrnd)) ; this%watfc_col (:,:) = nan + allocate(this%sucsat_col (begc:endc,nlevgrnd)) ; this%sucsat_col (:,:) = spval + allocate(this%dsl_col (begc:endc)) ; this%dsl_col (:) = spval!nan + allocate(this%soilresis_col (begc:endc)) ; this%soilresis_col (:) = spval!nan + allocate(this%soilbeta_col (begc:endc)) ; this%soilbeta_col (:) = nan + allocate(this%soilalpha_col (begc:endc)) ; this%soilalpha_col (:) = nan + allocate(this%soilalpha_u_col (begc:endc)) ; this%soilalpha_u_col (:) = nan + allocate(this%soilpsi_col (begc:endc,nlevgrnd)) ; this%soilpsi_col (:,:) = nan + allocate(this%wtfact_col (begc:endc)) ; this%wtfact_col (:) = nan + allocate(this%porosity_col (begc:endc,nlayer)) ; this%porosity_col (:,:) = spval + allocate(this%eff_porosity_col (begc:endc,nlevgrnd)) ; this%eff_porosity_col (:,:) = spval + allocate(this%gwc_thr_col (begc:endc)) ; this%gwc_thr_col (:) = nan + + allocate(this%thk_col (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%thk_col (:,:) = nan + allocate(this%tkmg_col (begc:endc,nlevgrnd)) ; this%tkmg_col (:,:) = nan + allocate(this%tkdry_col (begc:endc,nlevgrnd)) ; this%tkdry_col (:,:) = nan + allocate(this%tksatu_col (begc:endc,nlevgrnd)) ; this%tksatu_col (:,:) = nan + allocate(this%csol_col (begc:endc,nlevgrnd)) ; this%csol_col (:,:) = nan + + allocate(this%rootr_patch (begp:endp,1:nlevgrnd)) ; this%rootr_patch (:,:) = nan + allocate(this%root_depth_patch (begp:endp)) ; this%root_depth_patch (:) = nan + allocate(this%rootr_col (begc:endc,nlevgrnd)) ; this%rootr_col (:,:) = nan + allocate(this%rootr_road_perv_col (begc:endc,1:nlevgrnd)) ; this%rootr_road_perv_col (:,:) = nan + allocate(this%rootfr_patch (begp:endp,1:nlevgrnd)) ; this%rootfr_patch (:,:) = nan + allocate(this%crootfr_patch (begp:endp,1:nlevgrnd)) ; this%crootfr_patch (:,:) = nan + allocate(this%rootfr_col (begc:endc,1:nlevgrnd)) ; this%rootfr_col (:,:) = nan + allocate(this%rootfr_road_perv_col (begc:endc,1:nlevgrnd)) ; this%rootfr_road_perv_col (:,:) = nan + allocate(this%k_soil_root_patch (begp:endp,1:nlevsoi)) ; this%k_soil_root_patch (:,:) = nan + allocate(this%root_conductance_patch(begp:endp,1:nlevsoi)) ; this%root_conductance_patch (:,:) = nan + allocate(this%soil_conductance_patch(begp:endp,1:nlevsoi)) ; this%soil_conductance_patch (:,:) = nan + allocate(this%msw_col (begc:endc,1:nlevgrnd)) ; this%msw_col (:,:) = nan + allocate(this%nsw_col (begc:endc,1:nlevgrnd)) ; this%nsw_col (:,:) = nan + allocate(this%alphasw_col (begc:endc,1:nlevgrnd)) ; this%alphasw_col (:,:) = nan + allocate(this%watres_col (begc:endc,1:nlevgrnd)) ; this%watres_col (:,:) = nan + + end subroutine init_soilstate_type + +end module CNCLM_SoilStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 new file mode 100644 index 000000000..24e95d9f4 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -0,0 +1,145 @@ +module CNCLM_SolarAbsorbedType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varcon , only : spval + use clm_varpar , only : nlevcan, numrad + use clm_varctl , only : use_luna + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_solarabs_type + + type, public :: solarabs_type + + ! Solar reflected + real(r8), pointer :: fsr_patch (:) ! patch solar radiation reflected (W/m**2) + real(r8), pointer :: fsrSF_patch (:) ! diagnostic snow-free patch solar radiation reflected (W/m**2) + real(r8), pointer :: ssre_fsr_patch (:) ! snow radiative effect on patch solar radiation reflected (W/m**2) + ! Solar Absorbed + real(r8), pointer :: fsa_patch (:) ! patch solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsa_u_patch (:) ! patch urban solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsa_r_patch (:) ! patch rural solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: parsun_z_patch (:,:) ! patch absorbed PAR for sunlit leaves in canopy layer (W/m**2) + real(r8), pointer :: parsha_z_patch (:,:) ! patch absorbed PAR for shaded leaves in canopy layer (W/m**2) + real(r8), pointer :: par240d_z_patch (:,:) ! 10-day running mean of daytime patch absorbed PAR for leaves in canopy layer (W/m**2) + real(r8), pointer :: par240x_z_patch (:,:) ! 10-day running mean of maximum patch absorbed PAR for leaves in canopy layer (W/m**2) + real(r8), pointer :: par24d_z_patch (:,:) ! daily accumulated absorbed PAR for leaves in canopy layer from midnight to current step(J/m**2) + real(r8), pointer :: par24x_z_patch (:,:) ! daily max of patch absorbed PAR for leaves in canopy layer from midnight to current step(W/m**2) + real(r8), pointer :: sabg_soil_patch (:) ! patch solar radiation absorbed by soil (W/m**2) + real(r8), pointer :: sabg_snow_patch (:) ! patch solar radiation absorbed by snow (W/m**2) + real(r8), pointer :: sabg_patch (:) ! patch solar radiation absorbed by ground (W/m**2) + real(r8), pointer :: sabg_chk_patch (:) ! patch fsno weighted sum (W/m**2) + real(r8), pointer :: sabg_lyr_patch (:,:) ! patch absorbed radiation in each snow layer and top soil layer (pft,lyr) [W/m2] + real(r8), pointer :: sabg_pen_patch (:) ! patch (rural) shortwave radiation penetrating top soisno layer [W/m2] + + real(r8), pointer :: sub_surf_abs_SW_patch (:) ! patch fraction of solar radiation absorbed below first snow layer + real(r8), pointer :: sabv_patch (:) ! patch solar radiation absorbed by vegetation (W/m**2) + + real(r8), pointer :: sabs_roof_dir_lun (:,:) ! lun direct solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_roof_dif_lun (:,:) ! lun diffuse solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_sunwall_dir_lun (:,:) ! lun direct solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_sunwall_dif_lun (:,:) ! lun diffuse solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dir_lun (:,:) ! lun direct solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dif_lun (:,:) ! lun diffuse solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_improad_dir_lun (:,:) ! lun direct solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_improad_dif_lun (:,:) ! lun diffuse solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dir_lun (:,:) ! lun direct solar absorbed by pervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dif_lun (:,:) ! lun diffuse solar absorbed by pervious road per unit ground area per unit incident flux + + ! Currently needed by lake code + ! TODO (MV 8/20/2014) should be moved in the future + real(r8), pointer :: fsds_nir_d_patch (:) ! patch incident direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_i_patch (:) ! patch incident diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_d_ln_patch (:) ! patch incident direct beam nir solar radiation at local noon (W/m**2) + real(r8), pointer :: fsr_nir_d_patch (:) ! patch reflected direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_i_patch (:) ! patch reflected diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_d_ln_patch (:) ! patch reflected direct beam nir solar radiation at local noon (W/m**2) + ! optional diagnostic fluxes: + real(r8), pointer :: fsrSF_nir_d_patch (:) ! snow-free patch reflected direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsrSF_nir_i_patch (:) ! snow-free patch reflected diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsrSF_nir_d_ln_patch (:) ! snow-free patch reflected direct beam nir solar radiation at local noon (W/m**2) + real(r8), pointer :: ssre_fsr_nir_d_patch (:) ! snow-free patch reflected direct beam nir solar radiation (W/m**2) + real(r8), pointer :: ssre_fsr_nir_i_patch (:) ! snow-free patch reflected diffuse nir solar radiation (W/m**2) + real(r8), pointer :: ssre_fsr_nir_d_ln_patch(:) ! snow-free patch reflected direct beam nir solar radiation at local noon (W/m**2) + + end type solarabs_type + type(solarabs_type), public, target, save :: solarabs_inst + +contains + +!------------------------------------------------------ + subroutine init_solarabs_type(bounds, this) + + ! !DESCRIPTION: + ! Initialize CTSM solar absorbed type needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(solarabs_type), intent(inout):: this + + !LOCAL + integer, intent(in) :: begp, endp + integer, intent(in) :: begc, endc + integer, intent(in) :: begl, endl + !--------------------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + begl = bounds%begl ; endl = bounds%endl + + allocate(this%fsa_patch (begp:endp)) ; this%fsa_patch (:) = nan + allocate(this%fsa_u_patch (begp:endp)) ; this%fsa_u_patch (:) = nan + allocate(this%fsa_r_patch (begp:endp)) ; this%fsa_r_patch (:) = nan + allocate(this%parsun_z_patch (begp:endp,1:nlevcan)) ; this%parsun_z_patch (:,:) = nan + allocate(this%parsha_z_patch (begp:endp,1:nlevcan)) ; this%parsha_z_patch (:,:) = nan + if(use_luna)then + allocate(this%par240d_z_patch (begp:endp,1:nlevcan)) ; this%par240d_z_patch (:,:) = spval + allocate(this%par240x_z_patch (begp:endp,1:nlevcan)) ; this%par240x_z_patch (:,:) = spval + allocate(this%par24d_z_patch (begp:endp,1:nlevcan)) ; this%par24d_z_patch (:,:) = spval + allocate(this%par24x_z_patch (begp:endp,1:nlevcan)) ; this%par24x_z_patch (:,:) = spval + endif + allocate(this%sabv_patch (begp:endp)) ; this%sabv_patch (:) = nan + allocate(this%sabg_patch (begp:endp)) ; this%sabg_patch (:) = nan + allocate(this%sabg_lyr_patch (begp:endp,-nlevsno+1:1)) ; this%sabg_lyr_patch (:,:) = nan + allocate(this%sabg_pen_patch (begp:endp)) ; this%sabg_pen_patch (:) = nan + allocate(this%sabg_soil_patch (begp:endp)) ; this%sabg_soil_patch (:) = nan + allocate(this%sabg_snow_patch (begp:endp)) ; this%sabg_snow_patch (:) = nan + allocate(this%sabg_chk_patch (begp:endp)) ; this%sabg_chk_patch (:) = nan + allocate(this%sabs_roof_dir_lun (begl:endl,1:numrad)) ; this%sabs_roof_dir_lun (:,:) = nan + allocate(this%sabs_roof_dif_lun (begl:endl,1:numrad)) ; this%sabs_roof_dif_lun (:,:) = nan + allocate(this%sabs_sunwall_dir_lun (begl:endl,1:numrad)) ; this%sabs_sunwall_dir_lun (:,:) = nan + allocate(this%sabs_sunwall_dif_lun (begl:endl,1:numrad)) ; this%sabs_sunwall_dif_lun (:,:) = nan + allocate(this%sabs_shadewall_dir_lun (begl:endl,1:numrad)) ; this%sabs_shadewall_dir_lun (:,:) = nan + allocate(this%sabs_shadewall_dif_lun (begl:endl,1:numrad)) ; this%sabs_shadewall_dif_lun (:,:) = nan + allocate(this%sabs_improad_dir_lun (begl:endl,1:numrad)) ; this%sabs_improad_dir_lun (:,:) = nan + allocate(this%sabs_improad_dif_lun (begl:endl,1:numrad)) ; this%sabs_improad_dif_lun (:,:) = nan + allocate(this%sabs_perroad_dir_lun (begl:endl,1:numrad)) ; this%sabs_perroad_dir_lun (:,:) = nan + allocate(this%sabs_perroad_dif_lun (begl:endl,1:numrad)) ; this%sabs_perroad_dif_lun (:,:) = nan + allocate(this%sub_surf_abs_SW_patch (begp:endp)) ; this%sub_surf_abs_SW_patch (:) = nan + allocate(this%fsr_patch (begp:endp)) ; this%fsr_patch (:) = nan + allocate(this%fsr_nir_d_patch (begp:endp)) ; this%fsr_nir_d_patch (:) = nan + allocate(this%fsr_nir_i_patch (begp:endp)) ; this%fsr_nir_i_patch (:) = nan + allocate(this%fsr_nir_d_ln_patch (begp:endp)) ; this%fsr_nir_d_ln_patch (:) = nan + allocate(this%fsrSF_patch (begp:endp)) ; this%fsrSF_patch (:) = nan + allocate(this%fsrSF_nir_d_patch (begp:endp)) ; this%fsrSF_nir_d_patch (:) = nan + allocate(this%fsrSF_nir_i_patch (begp:endp)) ; this%fsrSF_nir_i_patch (:) = nan + allocate(this%fsrSF_nir_d_ln_patch (begp:endp)) ; this%fsrSF_nir_d_ln_patch (:) = nan + allocate(this%ssre_fsr_patch (begp:endp)) ; this%ssre_fsr_patch (:) = nan + allocate(this%ssre_fsr_nir_d_patch (begp:endp)) ; this%ssre_fsr_nir_d_patch (:) = nan + allocate(this%ssre_fsr_nir_i_patch (begp:endp)) ; this%ssre_fsr_nir_i_patch (:) = nan + allocate(this%ssre_fsr_nir_d_ln_patch(begp:endp)) ; this%ssre_fsr_nir_d_ln_patch(:) = nan + allocate(this%fsds_nir_d_patch (begp:endp)) ; this%fsds_nir_d_patch (:) = nan + allocate(this%fsds_nir_i_patch (begp:endp)) ; this%fsds_nir_i_patch (:) = nan + allocate(this%fsds_nir_d_ln_patch (begp:endp)) ; this%fsds_nir_d_ln_patch (:) = nan + + end subroutine init_solarabs_type + +end module CNCLM_SolarAbsorbedType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 new file mode 100644 index 000000000..97e1009ac --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -0,0 +1,164 @@ +module CNCLM_SurfaceAlbedoType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : numrad, nlevcan, nlevsno, numpft, num_zon, num_veg, & + var_col, var_pft + use clm_varcon , only : spval, ispval + use CNCLM_decompMod , only : bounds_type + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_surfalb_type + + ! + type, public :: surfalb_type + + real(r8), pointer :: coszen_col (:) ! col cosine of solar zenith angle + real(r8), pointer :: albd_patch (:,:) ! patch surface albedo (direct) (numrad) + real(r8), pointer :: albi_patch (:,:) ! patch surface albedo (diffuse) (numrad) + real(r8), pointer :: albdSF_patch (:,:) ! patch snow-free surface albedo (direct) (numrad) + real(r8), pointer :: albiSF_patch (:,:) ! patch snow-free surface albedo (diffuse) (numrad) + real(r8), pointer :: albgrd_pur_col (:,:) ! col pure snow ground direct albedo (numrad) + real(r8), pointer :: albgri_pur_col (:,:) ! col pure snow ground diffuse albedo (numrad) + real(r8), pointer :: albgrd_bc_col (:,:) ! col ground direct albedo without BC (numrad) + real(r8), pointer :: albgri_bc_col (:,:) ! col ground diffuse albedo without BC (numrad) + real(r8), pointer :: albgrd_oc_col (:,:) ! col ground direct albedo without OC (numrad) + real(r8), pointer :: albgri_oc_col (:,:) ! col ground diffuse albedo without OC (numrad) + real(r8), pointer :: albgrd_dst_col (:,:) ! col ground direct albedo without dust (numrad) + real(r8), pointer :: albgri_dst_col (:,:) ! col ground diffuse albedo without dust (numrad) + real(r8), pointer :: albgrd_col (:,:) ! col ground albedo (direct) (numrad) + real(r8), pointer :: albgri_col (:,:) ! col ground albedo (diffuse) (numrad) + real(r8), pointer :: albsod_col (:,:) ! col soil albedo: direct (col,bnd) [frc] + real(r8), pointer :: albsoi_col (:,:) ! col soil albedo: diffuse (col,bnd) [frc] + real(r8), pointer :: albsnd_hst_col (:,:) ! col snow albedo, direct , for history files (col,bnd) [frc] + real(r8), pointer :: albsni_hst_col (:,:) ! col snow albedo, diffuse, for history files (col,bnd) [frc] + + real(r8), pointer :: ftdd_patch (:,:) ! patch down direct flux below canopy per unit direct flx (numrad) + real(r8), pointer :: ftid_patch (:,:) ! patch down diffuse flux below canopy per unit direct flx (numrad) + real(r8), pointer :: ftii_patch (:,:) ! patch down diffuse flux below canopy per unit diffuse flx (numrad) + real(r8), pointer :: fabd_patch (:,:) ! patch flux absorbed by canopy per unit direct flux (numrad) + real(r8), pointer :: fabd_sun_patch (:,:) ! patch flux absorbed by sunlit canopy per unit direct flux (numrad) + real(r8), pointer :: fabd_sha_patch (:,:) ! patch flux absorbed by shaded canopy per unit direct flux (numrad) + real(r8), pointer :: fabi_patch (:,:) ! patch flux absorbed by canopy per unit diffuse flux (numrad) + real(r8), pointer :: fabi_sun_patch (:,:) ! patch flux absorbed by sunlit canopy per unit diffuse flux (numrad) + real(r8), pointer :: fabi_sha_patch (:,:) ! patch flux absorbed by shaded canopy per unit diffuse flux (numrad) + real(r8), pointer :: fabd_sun_z_patch (:,:) ! patch absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + real(r8), pointer :: fabd_sha_z_patch (:,:) ! patch absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + real(r8), pointer :: fabi_sun_z_patch (:,:) ! patch absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + real(r8), pointer :: fabi_sha_z_patch (:,:) ! patch absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + real(r8), pointer :: flx_absdv_col (:,:) ! col absorbed flux per unit incident direct flux: VIS (col,lyr) [frc] + real(r8), pointer :: flx_absdn_col (:,:) ! col absorbed flux per unit incident direct flux: NIR (col,lyr) [frc] + real(r8), pointer :: flx_absiv_col (:,:) ! col absorbed flux per unit incident diffuse flux: VIS (col,lyr) [frc] + real(r8), pointer :: flx_absin_col (:,:) ! col absorbed flux per unit incident diffuse flux: NIR (col,lyr) [frc] + + real(r8) , pointer :: fsun_z_patch (:,:) ! patch patch sunlit fraction of canopy layer + real(r8) , pointer :: tlai_z_patch (:,:) ! patch tlai increment for canopy layer + real(r8) , pointer :: tsai_z_patch (:,:) ! patch tsai increment for canopy layer + integer , pointer :: ncan_patch (:) ! patch number of canopy layers + integer , pointer :: nrad_patch (:) ! patch number of canopy layers, above snow for radiative transfer + real(r8) , pointer :: vcmaxcintsun_patch (:) ! patch leaf to canopy scaling coefficient, sunlit leaf vcmax + real(r8) , pointer :: vcmaxcintsha_patch (:) ! patch leaf to canopy scaling coefficient, shaded leaf vcmax + + +end type surfalb_type +type(surfalb_type), public, target, save :: surfalb_inst + +contains + +!--------------------------------------------------- + subroutine init_surfalb_type(bounds, nch, cncol, cnpft, this) + + ! !DESCRIPTION: +! Initialize CTSM surface albedo needed for calling CTSM routines +! jk Apr 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made +! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect +! +! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array + real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array + type(surfalb_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: np, nc, nz, p, nv, n + !------------------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + + allocate(this%coszen_col (begc:endc)) ; this%coszen_col (:) = nan + allocate(this%albgrd_col (begc:endc,numrad)) ; this%albgrd_col (:,:) = nan + allocate(this%albgri_col (begc:endc,numrad)) ; this%albgri_col (:,:) = nan + allocate(this%albsnd_hst_col (begc:endc,numrad)) ; this%albsnd_hst_col (:,:) = spval + allocate(this%albsni_hst_col (begc:endc,numrad)) ; this%albsni_hst_col (:,:) = spval + allocate(this%albsod_col (begc:endc,numrad)) ; this%albsod_col (:,:) = spval + allocate(this%albsoi_col (begc:endc,numrad)) ; this%albsoi_col (:,:) = spval + allocate(this%albgrd_pur_col (begc:endc,numrad)) ; this%albgrd_pur_col (:,:) = nan + allocate(this%albgri_pur_col (begc:endc,numrad)) ; this%albgri_pur_col (:,:) = nan + allocate(this%albgrd_bc_col (begc:endc,numrad)) ; this%albgrd_bc_col (:,:) = nan + allocate(this%albgri_bc_col (begc:endc,numrad)) ; this%albgri_bc_col (:,:) = nan + allocate(this%albgrd_oc_col (begc:endc,numrad)) ; this%albgrd_oc_col (:,:) = nan + allocate(this%albgri_oc_col (begc:endc,numrad)) ; this%albgri_oc_col (:,:) = nan + allocate(this%albgrd_dst_col (begc:endc,numrad)) ; this%albgrd_dst_col (:,:) = nan + allocate(this%albgri_dst_col (begc:endc,numrad)) ; this%albgri_dst_col (:,:) = nan + allocate(this%albd_patch (begp:endp,numrad)) ; this%albd_patch (:,:) = nan + allocate(this%albi_patch (begp:endp,numrad)) ; this%albi_patch (:,:) = nan + allocate(this%albdSF_patch (begp:endp,numrad)) ; this%albdSF_patch (:,:) = nan + allocate(this%albiSF_patch (begp:endp,numrad)) ; this%albiSF_patch (:,:) = nan + allocate(this%ftdd_patch (begp:endp,numrad)) ; this%ftdd_patch (:,:) = nan + allocate(this%ftid_patch (begp:endp,numrad)) ; this%ftid_patch (:,:) = nan + allocate(this%ftii_patch (begp:endp,numrad)) ; this%ftii_patch (:,:) = nan + allocate(this%fabd_patch (begp:endp,numrad)) ; this%fabd_patch (:,:) = nan + allocate(this%fabd_sun_patch (begp:endp,numrad)) ; this%fabd_sun_patch (:,:) = nan + allocate(this%fabd_sha_patch (begp:endp,numrad)) ; this%fabd_sha_patch (:,:) = nan + allocate(this%fabi_patch (begp:endp,numrad)) ; this%fabi_patch (:,:) = nan + allocate(this%fabi_sun_patch (begp:endp,numrad)) ; this%fabi_sun_patch (:,:) = nan + allocate(this%fabi_sha_patch (begp:endp,numrad)) ; this%fabi_sha_patch (:,:) = nan + allocate(this%fabd_sun_z_patch (begp:endp,nlevcan)) ; this%fabd_sun_z_patch (:,:) = 0._r8 + allocate(this%fabd_sha_z_patch (begp:endp,nlevcan)) ; this%fabd_sha_z_patch (:,:) = 0._r8 + allocate(this%fabi_sun_z_patch (begp:endp,nlevcan)) ; this%fabi_sun_z_patch (:,:) = 0._r8 + allocate(this%fabi_sha_z_patch (begp:endp,nlevcan)) ; this%fabi_sha_z_patch (:,:) = 0._r8 + allocate(this%flx_absdv_col (begc:endc,-nlevsno+1:1)) ; this%flx_absdv_col (:,:) = spval + allocate(this%flx_absdn_col (begc:endc,-nlevsno+1:1)) ; this%flx_absdn_col (:,:) = spval + allocate(this%flx_absiv_col (begc:endc,-nlevsno+1:1)) ; this%flx_absiv_col (:,:) = spval + allocate(this%flx_absin_col (begc:endc,-nlevsno+1:1)) ; this%flx_absin_col (:,:) = spval + + allocate(this%fsun_z_patch (begp:endp,nlevcan)) ; this%fsun_z_patch (:,:) = 0._r8 + allocate(this%tlai_z_patch (begp:endp,nlevcan)) ; this%tlai_z_patch (:,:) = 0._r8 + allocate(this%tsai_z_patch (begp:endp,nlevcan)) ; this%tsai_z_patch (:,:) = 0._r8 + allocate(this%ncan_patch (begp:endp)) ; this%ncan_patch (:) = 0 + allocate(this%nrad_patch (begp:endp)) ; this%nrad_patch (:) = 0 + allocate(this%vcmaxcintsun_patch (begp:endp)) ; this%vcmaxcintsun_patch (:) = nan + allocate(this%vcmaxcintsha_patch (begp:endp)) ; this%vcmaxcintsha_patch (:) = nan + + ! initialize variables from restart files + + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,nzone ! CN zone loop + do p = 0,numpft ! PFT index loop + np = np + 1 + + this%nrad_patch(np) = 1 + + do nv = 1,nveg ! defined veg loop + do n = 1,nlevcan + this%tlai_z_patch(np,n) = cnpft(nc,nz,nv, 73) + this%tsai_z_patch(np,n) = cnpft(nc,nz,nv, 74) + end do + end do !nv + end do ! p + end do ! nz + end do ! nc + + end subroutine init_surfalb_type + +end module CNCLM_SurfaceAlbedoType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 new file mode 100644 index 000000000..f3e993091 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 @@ -0,0 +1,240 @@ +module CNCLM_TemperatureType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevurb, nlevmaxurbgrnd + use clm_varctl , only : use_fates, use_luna + use clm_varcon , only : spval, ispval + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_temperature_type + + ! + type, public :: temperature_type + + ! Temperatures + real(r8), pointer :: t_stem_patch (:) ! patch stem temperatu\re (Kelvin) + real(r8), pointer :: t_veg_patch (:) ! patch vegetation temperature (Kelvin) + real(r8), pointer :: t_skin_patch (:) ! patch skin temperature (Kelvin) + real(r8), pointer :: t_veg_day_patch (:) ! patch daytime accumulative vegetation temperature (Kelvinx*nsteps), LUNA specific, from midnight to current step + real(r8), pointer :: t_veg_night_patch (:) ! patch night-time accumulative vegetation temperature (Kelvin*nsteps), LUNA specific, from midnight to current step + real(r8), pointer :: t_veg10_day_patch (:) ! 10 day running mean of patch daytime time vegetation temperature (Kelvin), LUNA specific, but can be reused + real(r8), pointer :: t_veg10_night_patch (:) ! 10 day running mean of patch night time vegetation temperature (Kelvin), LUNA specific, but can be reused + integer, pointer :: ndaysteps_patch (:) ! number of daytime steps accumulated from mid-night, LUNA specific + integer, pointer :: nnightsteps_patch (:) ! number of nighttime steps accumulated from mid-night, LUNA specific + real(r8), pointer :: t_h2osfc_col (:) ! col surface water temperature + real(r8), pointer :: t_h2osfc_bef_col (:) ! col surface water temperature from time-step before + real(r8), pointer :: t_ssbef_col (:,:) ! col soil/snow temperature before update (-nlevsno+1:nlevgrnd) + real(r8), pointer :: t_soisno_col (:,:) ! col soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: tsl_col (:) ! col temperature of near-surface soil layer (Kelvin) + real(r8), pointer :: t_soi10cm_col (:) ! col soil temperature in top 10cm of soil (Kelvin) + real(r8), pointer :: t_soi17cm_col (:) ! col soil temperature in top 17cm of soil (Kelvin) + real(r8), pointer :: t_sno_mul_mss_col (:) ! col snow temperature multiplied by layer mass, layer sum (K * kg/m2) + real(r8), pointer :: t_lake_col (:,:) ! col lake temperature (Kelvin) (1:nlevlak) + real(r8), pointer :: t_grnd_col (:) ! col ground temperature (Kelvin) + real(r8), pointer :: t_grnd_r_col (:) ! col rural ground temperature (Kelvin) + real(r8), pointer :: t_grnd_u_col (:) ! col urban ground temperature (Kelvin) (needed by Hydrology2Mod) + real(r8), pointer :: t_building_lun (:) ! lun internal building air temperature (K) + real(r8), pointer :: t_roof_inner_lun (:) ! lun roof inside surface temperature (K) + real(r8), pointer :: t_sunw_inner_lun (:) ! lun sunwall inside surface temperature (K) + real(r8), pointer :: t_shdw_inner_lun (:) ! lun shadewall inside surface temperature (K) + real(r8), pointer :: t_floor_lun (:) ! lun floor temperature (K) + real(r8), pointer :: snot_top_col (:) ! col temperature of top snow layer [K] + real(r8), pointer :: dTdz_top_col (:) ! col temperature gradient in top layer [K m-1] + real(r8), pointer :: dt_veg_patch (:) ! patch change in t_veg, last iteration (Kelvin) + + real(r8), pointer :: dt_grnd_col (:) ! col change in t_grnd, last iteration (Kelvin) + real(r8), pointer :: thv_col (:) ! col virtual potential temperature (kelvin) + real(r8), pointer :: thm_patch (:) ! patch intermediate variable (forc_t+0.0098*forc_hgt_t_patch) + real(r8), pointer :: t_a10_patch (:) ! patch 10-day running mean of the 2 m temperature (K) + real(r8), pointer :: soila10_patch (:) ! patch 10-day running mean of the soil layer 3 temperature (K) + real(r8), pointer :: t_a10min_patch (:) ! patch 10-day running mean of min 2-m temperature + real(r8), pointer :: t_a5min_patch (:) ! patch 5-day running mean of min 2-m temperature + + real(r8), pointer :: taf_lun (:) ! lun urban canopy air temperature (K) + + real(r8), pointer :: t_ref2m_patch (:) ! patch 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_r_patch (:) ! patch rural 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_u_patch (:) ! patch urban 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_min_patch (:) ! patch daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_r_patch (:) ! patch daily minimum of average 2 m height surface air temperature - rural(K) + real(r8), pointer :: t_ref2m_min_u_patch (:) ! patch daily minimum of average 2 m height surface air temperature - urban (K) + real(r8), pointer :: t_ref2m_max_patch (:) ! patch daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_r_patch (:) ! patch daily maximum of average 2 m height surface air temperature - rural(K) + real(r8), pointer :: t_ref2m_max_u_patch (:) ! patch daily maximum of average 2 m height surface air temperature - urban (K) + real(r8), pointer :: t_ref2m_min_inst_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_min_inst_r_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp - rural (K) + real(r8), pointer :: t_ref2m_min_inst_u_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp - urban (K) + real(r8), pointer :: t_ref2m_max_inst_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst_r_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp - rural (K) + real(r8), pointer :: t_ref2m_max_inst_u_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp - urban (K) + + ! Accumulated quantities + ! + ! TODO(wjs, 2014-08-05) Move these to the module(s) where they are used, to improve + ! modularity. In cases where they are used by two completely different modules, + ! which only use the same variable out of convenience, introduce a duplicate (point + ! being: that way one parameterization is free to change the exact meaning of its + ! accumulator without affecting the other). + ! + real(r8), pointer :: t_veg24_patch (:) ! patch 24hr average vegetation temperature (K) + real(r8), pointer :: t_veg240_patch (:) ! patch 240hr average vegetation temperature (Kelvin) + real(r8), pointer :: gdd0_patch (:) ! patch growing degree-days base 0C from planting (ddays) + real(r8), pointer :: gdd8_patch (:) ! patch growing degree-days base 8C from planting (ddays) + real(r8), pointer :: gdd10_patch (:) ! patch growing degree-days base 10C from planting (ddays) + real(r8), pointer :: gdd020_patch (:) ! patch 20-year average of gdd0 (ddays) + real(r8), pointer :: gdd820_patch (:) ! patch 20-year average of gdd8 (ddays) + real(r8), pointer :: gdd1020_patch (:) ! patch 20-year average of gdd10 (ddays) + + ! Heat content + real(r8), pointer :: beta_col (:) ! coefficient of convective velocity [-] + ! For the following dynbal baseline variable: positive values are subtracted to avoid + ! counting liquid water content of "virtual" states; negative values are added to + ! account for missing states in the model. + real(r8), pointer :: dynbal_baseline_heat_col (:) ! baseline heat content subtracted from each column's total heat calculation [J/m^2] + real(r8), pointer :: heat1_grc (:) ! grc initial gridcell total heat content + real(r8), pointer :: heat2_grc (:) ! grc post land cover change total heat content + real(r8), pointer :: liquid_water_temp1_grc (:) ! grc initial weighted average liquid water temperature (K) + real(r8), pointer :: liquid_water_temp2_grc (:) ! grc post land cover change weighted average liquid water temperature (K) + + ! Flags + integer , pointer :: imelt_col (:,:) ! flag for melting (=1), freezing (=2), Not=0 (-nlevsno+1:nlevgrnd) + + ! Emissivities + real(r8), pointer :: emv_patch (:) ! patch vegetation emissivity + real(r8), pointer :: emg_col (:) ! col ground emissivity + + ! Misc + real(r8), pointer :: xmf_col (:) ! total latent heat of phase change of ground water + real(r8), pointer :: xmf_h2osfc_col (:) ! latent heat of phase change of surface water + real(r8), pointer :: fact_col (:,:) ! used in computing tridiagonal matrix + real(r8), pointer :: c_h2osfc_col (:) ! heat capacity of surface water + +end type temperature_type +type(temperature_type), public, target, save :: temperature_inst + + contains + +!------------------------------------------------------------------- + subroutine init_temperature_type(bounds, this) + + ! !DESCRIPTION: +! Initialize CTSM temperature (forcing type) needed for calling CTSM routines +! jk Apr 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made +! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect +! +! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + type(temperature_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp + integer :: begg, endg + integer :: begc, endc + integer :: begl, endl + !------------------------ + + begp = bounds%begp ; endp = bounds%endp + begg = bounds%begg ; endg = bounds%endg + begc = bounds%begc ; endc = bounds%endc + begl = bounds%begl ; endl = bounds%endl + + ! Temperatures + allocate(this%t_stem_patch (begp:endp)) ; this%t_stem_patch (:) = nan + allocate(this%t_veg_patch (begp:endp)) ; this%t_veg_patch (:) = nan + allocate(this%t_skin_patch (begp:endp)) ; this%t_skin_patch (:) = nan + if(use_luna) then + allocate(this%t_veg_day_patch (begp:endp)) ; this%t_veg_day_patch (:) = spval + allocate(this%t_veg_night_patch (begp:endp)) ; this%t_veg_night_patch (:) = spval + allocate(this%t_veg10_day_patch (begp:endp)) ; this%t_veg10_day_patch (:) = spval + allocate(this%t_veg10_night_patch (begp:endp)) ; this%t_veg10_night_patch (:) = spval + allocate(this%ndaysteps_patch (begp:endp)) ; this%ndaysteps_patch (:) = ispval + allocate(this%nnightsteps_patch (begp:endp)) ; this%nnightsteps_patch (:) = ispval + endif + allocate(this%t_h2osfc_col (begc:endc)) ; this%t_h2osfc_col (:) = nan + allocate(this%t_h2osfc_bef_col (begc:endc)) ; this%t_h2osfc_bef_col (:) = nan + allocate(this%t_ssbef_col (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%t_ssbef_col (:,:) = nan + allocate(this%t_soisno_col (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%t_soisno_col (:,:) = nan + allocate(this%t_lake_col (begc:endc,1:nlevlak)) ; this%t_lake_col (:,:) = nan + allocate(this%t_grnd_col (begc:endc)) ; this%t_grnd_col (:) = nan + allocate(this%t_grnd_r_col (begc:endc)) ; this%t_grnd_r_col (:) = nan + allocate(this%t_grnd_u_col (begc:endc)) ; this%t_grnd_u_col (:) = nan + allocate(this%t_building_lun (begl:endl)) ; this%t_building_lun (:) = nan + allocate(this%t_roof_inner_lun (begl:endl)) ; this%t_roof_inner_lun (:) = nan + allocate(this%t_sunw_inner_lun (begl:endl)) ; this%t_sunw_inner_lun (:) = nan + allocate(this%t_shdw_inner_lun (begl:endl)) ; this%t_shdw_inner_lun (:) = nan + allocate(this%t_floor_lun (begl:endl)) ; this%t_floor_lun (:) = nan + allocate(this%snot_top_col (begc:endc)) ; this%snot_top_col (:) = nan + allocate(this%dTdz_top_col (begc:endc)) ; this%dTdz_top_col (:) = nan + allocate(this%dt_veg_patch (begp:endp)) ; this%dt_veg_patch (:) = nan + + allocate(this%tsl_col (begc:endc)) ; this%tsl_col (:) = nan + allocate(this%t_sno_mul_mss_col (begc:endc)) ; this%t_sno_mul_mss_col (:) = nan + allocate(this%tsl_col (begc:endc)) ; this%tsl_col (:) = nan + allocate(this%t_soi10cm_col (begc:endc)) ; this%t_soi10cm_col (:) = nan + allocate(this%t_soi17cm_col (begc:endc)) ; this%t_soi17cm_col (:) = spval + allocate(this%dt_grnd_col (begc:endc)) ; this%dt_grnd_col (:) = nan + allocate(this%thv_col (begc:endc)) ; this%thv_col (:) = nan + allocate(this%thm_patch (begp:endp)) ; this%thm_patch (:) = nan + allocate(this%t_a10_patch (begp:endp)) ; this%t_a10_patch (:) = nan + allocate(this%soila10_patch (begp:endp)) ; this%soila10_patch (:) = nan + allocate(this%t_a10min_patch (begp:endp)) ; this%t_a10min_patch (:) = nan + allocate(this%t_a5min_patch (begp:endp)) ; this%t_a5min_patch (:) = nan + + allocate(this%taf_lun (begl:endl)) ; this%taf_lun (:) = nan + + allocate(this%t_ref2m_patch (begp:endp)) ; this%t_ref2m_patch (:) = nan + allocate(this%t_ref2m_r_patch (begp:endp)) ; this%t_ref2m_r_patch (:) = nan + allocate(this%t_ref2m_u_patch (begp:endp)) ; this%t_ref2m_u_patch (:) = nan + allocate(this%t_ref2m_min_patch (begp:endp)) ; this%t_ref2m_min_patch (:) = nan + allocate(this%t_ref2m_min_r_patch (begp:endp)) ; this%t_ref2m_min_r_patch (:) = nan + allocate(this%t_ref2m_min_u_patch (begp:endp)) ; this%t_ref2m_min_u_patch (:) = nan + allocate(this%t_ref2m_max_patch (begp:endp)) ; this%t_ref2m_max_patch (:) = nan + allocate(this%t_ref2m_max_r_patch (begp:endp)) ; this%t_ref2m_max_r_patch (:) = nan + allocate(this%t_ref2m_max_u_patch (begp:endp)) ; this%t_ref2m_max_u_patch (:) = nan + allocate(this%t_ref2m_max_inst_patch (begp:endp)) ; this%t_ref2m_max_inst_patch (:) = nan + allocate(this%t_ref2m_max_inst_r_patch (begp:endp)) ; this%t_ref2m_max_inst_r_patch (:) = nan + allocate(this%t_ref2m_max_inst_u_patch (begp:endp)) ; this%t_ref2m_max_inst_u_patch (:) = nan + allocate(this%t_ref2m_min_inst_patch (begp:endp)) ; this%t_ref2m_min_inst_patch (:) = nan + allocate(this%t_ref2m_min_inst_r_patch (begp:endp)) ; this%t_ref2m_min_inst_r_patch (:) = nan + allocate(this%t_ref2m_min_inst_u_patch (begp:endp)) ; this%t_ref2m_min_inst_u_patch (:) = nan + + ! Accumulated fields + allocate(this%t_veg24_patch (begp:endp)) ; this%t_veg24_patch (:) = nan + allocate(this%t_veg240_patch (begp:endp)) ; this%t_veg240_patch (:) = nan + allocate(this%gdd0_patch (begp:endp)) ; this%gdd0_patch (:) = spval + allocate(this%gdd8_patch (begp:endp)) ; this%gdd8_patch (:) = spval + allocate(this%gdd10_patch (begp:endp)) ; this%gdd10_patch (:) = spval + allocate(this%gdd020_patch (begp:endp)) ; this%gdd020_patch (:) = spval + allocate(this%gdd820_patch (begp:endp)) ; this%gdd820_patch (:) = spval + allocate(this%gdd1020_patch (begp:endp)) ; this%gdd1020_patch (:) = spval + + ! Heat content + allocate(this%beta_col (begc:endc)) ; this%beta_col (:) = nan + allocate(this%dynbal_baseline_heat_col (begc:endc)) ; this%dynbal_baseline_heat_col (:) = nan + allocate(this%heat1_grc (begg:endg)) ; this%heat1_grc (:) = nan + allocate(this%heat2_grc (begg:endg)) ; this%heat2_grc (:) = nan + allocate(this%liquid_water_temp1_grc (begg:endg)) ; this%liquid_water_temp1_grc (:) = nan + allocate(this%liquid_water_temp2_grc (begg:endg)) ; this%liquid_water_temp2_grc (:) = nan + + ! flags + allocate(this%imelt_col (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%imelt_col (:,:) = huge(1) + + ! emissivities + allocate(this%emv_patch (begp:endp)) ; this%emv_patch (:) = nan + allocate(this%emg_col (begc:endc)) ; this%emg_col (:) = nan + + allocate(this%xmf_col (begc:endc)) ; this%xmf_col (:) = nan + allocate(this%xmf_h2osfc_col (begc:endc)) ; this%xmf_h2osfc_col (:) = nan + allocate(this%fact_col (begc:endc, -nlevsno+1:nlevmaxurbgrnd)) ; this%fact_col (:,:) = nan + allocate(this%c_h2osfc_col (begc:endc)) ; this%c_h2osfc_col (:) = nan + + end subroutine init_temperature_type + +end module CNCLM_TemperatureType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 new file mode 100644 index 000000000..58967a136 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 @@ -0,0 +1,521 @@ +module CNCLM_VegCarbonStateType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varctl , only : use_matrixcn + use clm_varpar , only : numpft, num_zon, num_veg, & + var_col, var_pft, CN_zone_weight + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_cnveg_carbonstate_type + + type, public :: cnveg_carbonstate_type + + integer :: species ! c12, c13, c14 + + real(r8), pointer :: grainc_patch (:) ! (gC/m2) grain C (crop model) + real(r8), pointer :: grainc_storage_patch (:) ! (gC/m2) grain C storage (crop model) + real(r8), pointer :: grainc_xfer_patch (:) ! (gC/m2) grain C transfer (crop model) + real(r8), pointer :: matrix_cap_grainc_patch (:) ! (gC/m2) Capacity of grain C + real(r8), pointer :: matrix_cap_grainc_storage_patch (:) ! (gC/m2) Capacity of grain storage C + real(r8), pointer :: matrix_cap_grainc_xfer_patch (:) ! (gC/m2) Capacity of grain transfer C + real(r8), pointer :: leafc_patch (:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage_patch (:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer_patch (:) ! (gC/m2) leaf C transfer + real(r8), pointer :: matrix_cap_leafc_patch (:) ! (gC/m2) Capacity of leaf C + real(r8), pointer :: matrix_cap_leafc_storage_patch (:) ! (gC/m2) Capacity of leaf C storage + real(r8), pointer :: matrix_cap_leafc_xfer_patch (:) ! (gC/m2) Capacity of leaf C transfer + real(r8), pointer :: leafc_storage_xfer_acc_patch (:) ! (gC/m2) Accmulated leaf C transfer + real(r8), pointer :: storage_cdemand_patch (:) ! (gC/m2) C use from the C storage pool + real(r8), pointer :: frootc_patch (:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage_patch (:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer_patch (:) ! (gC/m2) fine root C transfer + real(r8), pointer :: matrix_cap_frootc_patch (:) ! (gC/m2) Capacity of fine root C + real(r8), pointer :: matrix_cap_frootc_storage_patch (:) ! (gC/m2) Capacity of fine root C storage + real(r8), pointer :: matrix_cap_frootc_xfer_patch (:) ! (gC/m2) Capacity of fine root C transfer + real(r8), pointer :: livestemc_patch (:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage_patch (:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer_patch (:) ! (gC/m2) live stem C transfer + real(r8), pointer :: matrix_cap_livestemc_patch (:) ! (gC/m2) Capacity of live stem C + real(r8), pointer :: matrix_cap_livestemc_storage_patch (:) ! (gC/m2) Capacity of live stem C storage + real(r8), pointer :: matrix_cap_livestemc_xfer_patch (:) ! (gC/m2) Capacity of live stem C transfer + real(r8), pointer :: deadstemc_patch (:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage_patch (:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer_patch (:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: matrix_cap_deadstemc_storage_patch (:) ! (gC/m2) Capacity of dead stem C storage + real(r8), pointer :: matrix_cap_deadstemc_xfer_patch (:) ! (gC/m2) Capacity of dead stem C transfer + real(r8), pointer :: livecrootc_patch (:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage_patch (:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer_patch (:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: matrix_cap_livecrootc_patch (:) ! (gC/m2) Capacity of live coarse root C + real(r8), pointer :: matrix_cap_livecrootc_storage_patch (:) ! (gC/m2) Capacity of live coarse root C storage + real(r8), pointer :: matrix_cap_livecrootc_xfer_patch (:) ! (gC/m2) Capacity of live coarse root C transfer + real(r8), pointer :: deadcrootc_patch (:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage_patch (:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer_patch (:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: matrix_cap_deadcrootc_patch (:) ! (gC/m2) Capacity of dead coarse root C + real(r8), pointer :: matrix_cap_deadcrootc_storage_patch (:) ! (gC/m2) Capacity of dead coarse root C storage + real(r8), pointer :: matrix_cap_deadcrootc_xfer_patch (:) ! (gC/m2) Capacity of dead coarse root C transfer + real(r8), pointer :: gresp_storage_patch (:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer_patch (:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: cpool_patch (:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: xsmrpool_patch (:) ! (gC/m2) abstract C pool to meet excess MR demand + real(r8), pointer :: xsmrpool_loss_patch (:) ! (gC/m2) abstract C pool to meet excess MR demand loss + real(r8), pointer :: ctrunc_patch (:) ! (gC/m2) patch-level sink for C truncation + real(r8), pointer :: woodc_patch (:) ! (gC/m2) wood C + real(r8), pointer :: leafcmax_patch (:) ! (gC/m2) ann max leaf C + real(r8), pointer :: totc_patch (:) ! (gC/m2) total patch-level carbon, including cpool + real(r8), pointer :: rootc_col (:) ! (gC/m2) root carbon at column level (fire) + real(r8), pointer :: leafc_col (:) ! (gC/m2) column-level leafc (fire) + real(r8), pointer :: deadstemc_col (:) ! (gC/m2) column-level deadstemc (fire) + real(r8), pointer :: fuelc_col (:) ! fuel load outside cropland + real(r8), pointer :: fuelc_crop_col (:) ! fuel load for cropland + real(r8), pointer :: cropseedc_deficit_patch (:) ! (gC/m2) pool for seeding new crop growth; this is a NEGATIVE term, indicating the amount of seed usage that needs to be repaid +! initial pool size of year for matrix + real(r8), pointer :: leafc0_patch (:) ! (gC/m2) Initial value of leaf C for SASU + real(r8), pointer :: leafc0_storage_patch (:) ! (gC/m2) Initial value of leaf C storage for SASU + real(r8), pointer :: leafc0_xfer_patch (:) ! (gC/m2) Initial value of leaf C transfer for SASU + real(r8), pointer :: frootc0_patch (:) ! (gC/m2) Initial value of fine root C for SASU + real(r8), pointer :: frootc0_storage_patch (:) ! (gC/m2) Initial value of fine root C storage for SASU + real(r8), pointer :: frootc0_xfer_patch (:) ! (gC/m2) Initial value of fine root C transfer for SASU + real(r8), pointer :: livestemc0_patch (:) ! (gC/m2) Initial value of live stem C for SASU + real(r8), pointer :: livestemc0_storage_patch (:) ! (gC/m2) Initial value of live stem C storage for SASU + real(r8), pointer :: livestemc0_xfer_patch (:) ! (gC/m2) Initial value of live stem C transfer for SASU + real(r8), pointer :: deadstemc0_patch (:) ! (gC/m2) Initial value of dead stem C for SASU + real(r8), pointer :: deadstemc0_storage_patch (:) ! (gC/m2) Initial value of dead stem C storage for SASU + real(r8), pointer :: deadstemc0_xfer_patch (:) ! (gC/m2) Initial value of dead stem C transfer for SASU + real(r8), pointer :: livecrootc0_patch (:) ! (gC/m2) Initial value of live coarse root C for SASU + real(r8), pointer :: livecrootc0_storage_patch (:) ! (gC/m2) Initial value of live coarse root C storage for SASU + real(r8), pointer :: livecrootc0_xfer_patch (:) ! (gC/m2) Initial value of live coarse root C transfer for SASU + real(r8), pointer :: deadcrootc0_patch (:) ! (gC/m2) Initial value of dead coarse root C for SASU + real(r8), pointer :: deadcrootc0_storage_patch (:) ! (gC/m2) Initial value of dead coarse root C storage for SASU + real(r8), pointer :: deadcrootc0_xfer_patch (:) ! (gC/m2) Initial value of dead coarse root C transfer for SASU + real(r8), pointer :: grainc0_patch (:) ! (gC/m2) Initial value of fine grain C for SASU + real(r8), pointer :: grainc0_storage_patch (:) ! (gC/m2) Initial value of fine grain C storage for SASU + real(r8), pointer :: grainc0_xfer_patch (:) ! (gC/m2) Initial value of fine grain C transfer for SASU + + ! pools for dynamic landcover + real(r8), pointer :: seedc_grc (:) ! (gC/m2) gridcell-level pool for seeding new PFTs via dynamic landcover + + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: dispvegc_patch (:) ! (gC/m2) displayed veg carbon, excluding storage and cpool + real(r8), pointer :: storvegc_patch (:) ! (gC/m2) stored vegetation carbon, excluding cpool + real(r8), pointer :: totvegc_patch (:) ! (gC/m2) total vegetation carbon, excluding cpool + real(r8), pointer :: totvegc_col (:) ! (gC/m2) total vegetation carbon, excluding cpool averaged to column (p2c) + + ! Total C pools + real(r8), pointer :: totc_p2c_col (:) ! (gC/m2) totc_patch averaged to col + real(r8), pointer :: totc_col (:) ! (gC/m2) total column carbon, incl veg and cpool + real(r8), pointer :: totecosysc_col (:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool + real(r8), pointer :: totc_grc (:) ! (gC/m2) total gridcell carbon + +! Accumulation variables are accumulated for a whole year. They are used for matrix spinup and calculation of diagnostic variables + real(r8), pointer :: matrix_calloc_leaf_acc_patch (:) ! (gC/m2/year) Input C allocated to leaf during this year + real(r8), pointer :: matrix_calloc_leafst_acc_patch (:) ! (gC/m2/year) Input C allocated to leaf storage during this year + real(r8), pointer :: matrix_calloc_froot_acc_patch (:) ! (gC/m2/year) Input C allocated to fine root during this year + real(r8), pointer :: matrix_calloc_frootst_acc_patch (:) ! (gC/m2/year) Input C allocated to fine root storage during this year + real(r8), pointer :: matrix_calloc_livestem_acc_patch (:) ! (gC/m2/year) Input C allocated to live stem during this year + real(r8), pointer :: matrix_calloc_livestemst_acc_patch (:) ! (gC/m2/year) Input C allocated to live stem storage during this year + real(r8), pointer :: matrix_calloc_deadstem_acc_patch (:) ! (gC/m2/year) Input C allocated to dead stem during this year + real(r8), pointer :: matrix_calloc_deadstemst_acc_patch (:) ! (gC/m2/year) Input C allocated to dead stem storage during this year + real(r8), pointer :: matrix_calloc_livecroot_acc_patch (:) ! (gC/m2/year) Input C allocated to live coarse root during this year + real(r8), pointer :: matrix_calloc_livecrootst_acc_patch (:) ! (gC/m2/year) Input C allocated to live coarse root storage during this year + real(r8), pointer :: matrix_calloc_deadcroot_acc_patch (:) ! (gC/m2/year) Input C allocated to dead coarse root during this year + real(r8), pointer :: matrix_calloc_deadcrootst_acc_patch (:) ! (gC/m2/year) Input C allocated to dead coarse root storage during this year + real(r8), pointer :: matrix_calloc_grain_acc_patch (:) ! (gC/m2/year) Input C allocated to grain during this year + real(r8), pointer :: matrix_calloc_grainst_acc_patch (:) ! (gC/m2/year) Input C allocated to grain storage during this year + + real(r8), pointer :: matrix_ctransfer_leafst_to_leafxf_acc_patch (:) ! (gC/m2/year) C transfer from leaf storage to leaf transfer pool during this year + real(r8), pointer :: matrix_ctransfer_leafxf_to_leaf_acc_patch (:) ! (gC/m2/year) C transfer from leaf transfer to leaf pool during this year + real(r8), pointer :: matrix_ctransfer_frootst_to_frootxf_acc_patch (:) ! (gC/m2/year) C transfer from fine root storage to fine root transfer pool during this year + real(r8), pointer :: matrix_ctransfer_frootxf_to_froot_acc_patch (:) ! (gC/m2/year) C transfer from fine root transfer to fine root pool during this year + real(r8), pointer :: matrix_ctransfer_livestemst_to_livestemxf_acc_patch (:) ! (gC/m2/year) C transfer from live stem storage to live stem transfer pool during this year + real(r8), pointer :: matrix_ctransfer_livestemxf_to_livestem_acc_patch (:) ! (gC/m2/year) C transfer from live stem transfer to live stem pool during this year + real(r8), pointer :: matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch (:) ! (gC/m2/year) C transfer from dead stem storage to dead stem transfer pool during this year + real(r8), pointer :: matrix_ctransfer_deadstemxf_to_deadstem_acc_patch (:) ! (gC/m2/year) C transfer from dead stem transfer to dead stem pool during this year + real(r8), pointer :: matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch (:) ! (gC/m2/year) C transfer from live coarse root storage to live coarse root transfer pool during this year + real(r8), pointer :: matrix_ctransfer_livecrootxf_to_livecroot_acc_patch (:) ! (gC/m2/year) C transfer from live coarse root transfer to live coarse root pool during this year + real(r8), pointer :: matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch (:) ! (gC/m2/year) C transfer from dead coarse root storage to dead coarse root transfer pool during this year + real(r8), pointer :: matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch (:) ! (gC/m2/year) C transfer from dead coarse root transfer to dead coarse root pool during this year + real(r8), pointer :: matrix_ctransfer_grainst_to_grainxf_acc_patch (:) ! (gC/m2/year) C transfer from grain storage to grain transfer pool during this year + real(r8), pointer :: matrix_ctransfer_grainxf_to_grain_acc_patch (:) ! (gC/m2/year) C transfer from grain transfer to grain pool during this year + real(r8), pointer :: matrix_ctransfer_livestem_to_deadstem_acc_patch (:) ! (gC/m2/year) C transfer from live stem to dead stem pool during this year + real(r8), pointer :: matrix_ctransfer_livecroot_to_deadcroot_acc_patch (:) ! (gC/m2/year) C transfer from live coarse root to dead coarse root pool during this year + + real(r8), pointer :: matrix_cturnover_leaf_acc_patch (:) ! (gC/m2/year) C turnover from leaf + real(r8), pointer :: matrix_cturnover_leafst_acc_patch (:) ! (gC/m2/year) C turnover from leaf storage + real(r8), pointer :: matrix_cturnover_leafxf_acc_patch (:) ! (gC/m2/year) C turnover from leaf transfer + real(r8), pointer :: matrix_cturnover_froot_acc_patch (:) ! (gC/m2/year) C turnover from fine root + real(r8), pointer :: matrix_cturnover_frootst_acc_patch (:) ! (gC/m2/year) C turnover from fine root storage + real(r8), pointer :: matrix_cturnover_frootxf_acc_patch (:) ! (gC/m2/year) C turnover from fine root transfer + real(r8), pointer :: matrix_cturnover_livestem_acc_patch (:) ! (gC/m2/year) C turnover from live stem + real(r8), pointer :: matrix_cturnover_livestemst_acc_patch (:) ! (gC/m2/year) C turnover from live stem storage + real(r8), pointer :: matrix_cturnover_livestemxf_acc_patch (:) ! (gC/m2/year) C turnover from live stem transfer + real(r8), pointer :: matrix_cturnover_deadstem_acc_patch (:) ! (gC/m2/year) C turnover from dead stem + real(r8), pointer :: matrix_cturnover_deadstemst_acc_patch (:) ! (gC/m2/year) C turnover from dead stem storage + real(r8), pointer :: matrix_cturnover_deadstemxf_acc_patch (:) ! (gC/m2/year) C turnover from dead stem transfer + real(r8), pointer :: matrix_cturnover_livecroot_acc_patch (:) ! (gC/m2/year) C turnover from live coarse root + real(r8), pointer :: matrix_cturnover_livecrootst_acc_patch (:) ! (gC/m2/year) C turnover from live coarse root storage + real(r8), pointer :: matrix_cturnover_livecrootxf_acc_patch (:) ! (gC/m2/year) C turnover from live coarse root transfer + real(r8), pointer :: matrix_cturnover_deadcroot_acc_patch (:) ! (gC/m2/year) C turnover from dead coarse root + real(r8), pointer :: matrix_cturnover_deadcrootst_acc_patch (:) ! (gC/m2/year) C turnover from dead coarse root storage + real(r8), pointer :: matrix_cturnover_deadcrootxf_acc_patch (:) ! (gC/m2/year) C turnover from dead coarse root transfer + real(r8), pointer :: matrix_cturnover_grain_acc_patch (:) ! (gC/m2/year) C turnover from grain + real(r8), pointer :: matrix_cturnover_grainst_acc_patch (:) ! (gC/m2/year) C turnover from grain storage + real(r8), pointer :: matrix_cturnover_grainxf_acc_patch (:) ! (gC/m2/year) C turnover from grain transfer + + real(r8), pointer :: grainc_SASUsave_patch (:) ! (gC/m2) grain C (crop model) + real(r8), pointer :: grainc_storage_SASUsave_patch (:) ! (gC/m2) grain C storage (crop model) + real(r8), pointer :: leafc_SASUsave_patch (:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage_SASUsave_patch (:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer_SASUsave_patch (:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc_SASUsave_patch (:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage_SASUsave_patch (:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer_SASUsave_patch (:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc_SASUsave_patch (:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage_SASUsave_patch (:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer_SASUsave_patch (:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc_SASUsave_patch (:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage_SASUsave_patch (:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer_SASUsave_patch (:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc_SASUsave_patch (:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage_SASUsave_patch (:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer_SASUsave_patch (:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc_SASUsave_patch (:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage_SASUsave_patch (:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer_SASUsave_patch (:) ! (gC/m2) dead coarse root C transfer + logical, private :: dribble_crophrv_xsmrpool_2atm + + end type cnveg_carbonstate_type + +type(cnveg_carbonstate_type), public, target, save :: cnveg_carbonstate_inst + +contains + +!---------------------------------------------- + subroutine init_cnveg_carbonstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) + +! !DESCRIPTION: +! Initialize CTSM carbon states +! jk Apr 2021: type is allocated and initialized to NaN; +! if data arrays from restart file are passed (cncol and cnpft), the type is then initialized with these values +! +! !ARGUMENTS: + implicit none + + ! INPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: ityp ! PFT index + real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart + type(cnveg_carbonstate_type), intent(inout):: this + logical, optional, intent(in) :: cn5_cold_start + + ! LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + integer :: np, nc, nz, p, nv, n + logical :: cold_start = .false. + !-------------------------------------------------------- + + begp = bounds%begp ; endp = bounds%endp + begg = bounds%begg ; endg = bounds%endg + begc = bounds%begc ; endc = bounds%endc + + ! check whether a cn5_cold_start option was set and change cold_start accordingly + if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + cold_start = .true. + end if + + ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + (size(cnpft,3).ne.var_pft))) + _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') + end if + + allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan + allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan + allocate(this%leafc_xfer_patch (begp:endp)) ; this%leafc_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_leafc_patch (begp:endp)) ; this%matrix_cap_leafc_patch (:) = nan + allocate(this%matrix_cap_leafc_storage_patch (begp:endp)) ; this%matrix_cap_leafc_storage_patch (:) = nan + allocate(this%matrix_cap_leafc_xfer_patch (begp:endp)) ; this%matrix_cap_leafc_xfer_patch (:) = nan + end if + allocate(this%leafc_storage_xfer_acc_patch (begp:endp)) ; this%leafc_storage_xfer_acc_patch (:) = nan + allocate(this%storage_cdemand_patch (begp:endp)) ; this%storage_cdemand_patch (:) = nan + allocate(this%frootc_patch (begp:endp)) ; this%frootc_patch (:) = nan + allocate(this%frootc_storage_patch (begp:endp)) ; this%frootc_storage_patch (:) = nan + allocate(this%frootc_xfer_patch (begp:endp)) ; this%frootc_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_frootc_patch (begp:endp)) ; this%matrix_cap_frootc_patch (:) = nan + allocate(this%matrix_cap_frootc_storage_patch (begp:endp)) ; this%matrix_cap_frootc_storage_patch (:) = nan + allocate(this%matrix_cap_frootc_xfer_patch (begp:endp)) ; this%matrix_cap_frootc_xfer_patch (:) = nan + end if + allocate(this%livestemc_patch (begp:endp)) ; this%livestemc_patch (:) = nan + allocate(this%livestemc_storage_patch (begp:endp)) ; this%livestemc_storage_patch (:) = nan + allocate(this%livestemc_xfer_patch (begp:endp)) ; this%livestemc_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_livestemc_patch (begp:endp)) ; this%matrix_cap_livestemc_patch (:) = nan + allocate(this%matrix_cap_livestemc_storage_patch (begp:endp)) ; this%matrix_cap_livestemc_storage_patch (:) = nan + allocate(this%matrix_cap_livestemc_xfer_patch (begp:endp)) ; this%matrix_cap_livestemc_xfer_patch (:) = nan + end if + allocate(this%deadstemc_patch (begp:endp)) ; this%deadstemc_patch (:) = nan + allocate(this%deadstemc_storage_patch (begp:endp)) ; this%deadstemc_storage_patch (:) = nan + allocate(this%deadstemc_xfer_patch (begp:endp)) ; this%deadstemc_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_deadstemc_patch (begp:endp)) ; this%matrix_cap_deadstemc_patch (:) = nan + allocate(this%matrix_cap_deadstemc_storage_patch (begp:endp)) ; this%matrix_cap_deadstemc_storage_patch (:) = nan + allocate(this%matrix_cap_deadstemc_xfer_patch (begp:endp)) ; this%matrix_cap_deadstemc_xfer_patch (:) = nan + end if + allocate(this%livecrootc_patch (begp:endp)) ; this%livecrootc_patch (:) = nan + allocate(this%livecrootc_storage_patch (begp:endp)) ; this%livecrootc_storage_patch (:) = nan + allocate(this%livecrootc_xfer_patch (begp:endp)) ; this%livecrootc_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_livecrootc_patch (begp:endp)) ; this%matrix_cap_livecrootc_patch (:) = nan + allocate(this%matrix_cap_livecrootc_storage_patch (begp:endp)) ; this%matrix_cap_livecrootc_storage_patch(:) = nan + allocate(this%matrix_cap_livecrootc_xfer_patch (begp:endp)) ; this%matrix_cap_livecrootc_xfer_patch (:) = nan + end if + allocate(this%deadcrootc_patch (begp:endp)) ; this%deadcrootc_patch (:) = nan + allocate(this%deadcrootc_storage_patch (begp:endp)) ; this%deadcrootc_storage_patch (:) = nan + allocate(this%deadcrootc_xfer_patch (begp:endp)) ; this%deadcrootc_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_deadcrootc_patch (begp:endp)) ; this%matrix_cap_deadcrootc_patch (:) = nan + allocate(this%matrix_cap_deadcrootc_storage_patch (begp:endp)) ; this%matrix_cap_deadcrootc_storage_patch(:) = nan + allocate(this%matrix_cap_deadcrootc_xfer_patch (begp:endp)) ; this%matrix_cap_deadcrootc_xfer_patch (:) = nan + end if + allocate(this%gresp_storage_patch (begp:endp)) ; this%gresp_storage_patch (:) = nan + allocate(this%gresp_xfer_patch (begp:endp)) ; this%gresp_xfer_patch (:) = nan + allocate(this%cpool_patch (begp:endp)) ; this%cpool_patch (:) = nan + allocate(this%xsmrpool_patch (begp:endp)) ; this%xsmrpool_patch (:) = nan + allocate(this%xsmrpool_loss_patch (begp:endp)) ; this%xsmrpool_loss_patch (:) = nan + allocate(this%ctrunc_patch (begp:endp)) ; this%ctrunc_patch (:) = nan + allocate(this%dispvegc_patch (begp:endp)) ; this%dispvegc_patch (:) = nan + allocate(this%storvegc_patch (begp:endp)) ; this%storvegc_patch (:) = nan + allocate(this%leafcmax_patch (begp:endp)) ; this%leafcmax_patch (:) = nan + allocate(this%totc_patch (begp:endp)) ; this%totc_patch (:) = nan + allocate(this%grainc_patch (begp:endp)) ; this%grainc_patch (:) = nan + allocate(this%grainc_storage_patch (begp:endp)) ; this%grainc_storage_patch (:) = nan + allocate(this%grainc_xfer_patch (begp:endp)) ; this%grainc_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_grainc_patch (begp:endp)) ; this%matrix_cap_grainc_patch (:) = nan + allocate(this%matrix_cap_grainc_storage_patch (begp:endp)) ; this%matrix_cap_grainc_storage_patch (:) = nan + allocate(this%matrix_cap_grainc_xfer_patch (begp:endp)) ; this%matrix_cap_grainc_xfer_patch (:) = nan + end if + allocate(this%woodc_patch (begp:endp)) ; this%woodc_patch (:) = nan +!initial pool size of year for matrix + if(use_matrixcn)then + allocate(this%leafc0_patch (begp:endp)) ; this%leafc0_patch (:) = nan + allocate(this%leafc0_storage_patch (begp:endp)) ; this%leafc0_storage_patch (:) = nan + allocate(this%leafc0_xfer_patch (begp:endp)) ; this%leafc0_xfer_patch (:) = nan + allocate(this%frootc0_patch (begp:endp)) ; this%frootc0_patch (:) = nan + allocate(this%frootc0_storage_patch (begp:endp)) ; this%frootc0_storage_patch (:) = nan + allocate(this%frootc0_xfer_patch (begp:endp)) ; this%frootc0_xfer_patch (:) = nan + allocate(this%livestemc0_patch (begp:endp)) ; this%livestemc0_patch (:) = nan + allocate(this%livestemc0_storage_patch (begp:endp)) ; this%livestemc0_storage_patch (:) = nan + allocate(this%livestemc0_xfer_patch (begp:endp)) ; this%livestemc0_xfer_patch (:) = nan + allocate(this%deadstemc0_patch (begp:endp)) ; this%deadstemc0_patch (:) = nan + allocate(this%deadstemc0_storage_patch (begp:endp)) ; this%deadstemc0_storage_patch (:) = nan + allocate(this%deadstemc0_xfer_patch (begp:endp)) ; this%deadstemc0_xfer_patch (:) = nan + allocate(this%livecrootc0_patch (begp:endp)) ; this%livecrootc0_patch (:) = nan + allocate(this%livecrootc0_storage_patch (begp:endp)) ; this%livecrootc0_storage_patch (:) = nan + allocate(this%livecrootc0_xfer_patch (begp:endp)) ; this%livecrootc0_xfer_patch (:) = nan + allocate(this%deadcrootc0_patch (begp:endp)) ; this%deadcrootc0_patch (:) = nan + allocate(this%deadcrootc0_storage_patch (begp:endp)) ; this%deadcrootc0_storage_patch (:) = nan + allocate(this%deadcrootc0_xfer_patch (begp:endp)) ; this%deadcrootc0_xfer_patch (:) = nan + allocate(this%grainc0_patch (begp:endp)) ; this%grainc0_patch (:) = nan + allocate(this%grainc0_storage_patch (begp:endp)) ; this%grainc0_storage_patch (:) = nan + allocate(this%grainc0_xfer_patch (begp:endp)) ; this%grainc0_xfer_patch (:) = nan + + allocate(this%leafc_SASUsave_patch (begp:endp)) ; this%leafc_SASUsave_patch (:) = nan + allocate(this%leafc_storage_SASUsave_patch (begp:endp)) ; this%leafc_storage_SASUsave_patch (:) = nan + allocate(this%leafc_xfer_SASUsave_patch (begp:endp)) ; this%leafc_xfer_SASUsave_patch (:) = nan + allocate(this%frootc_SASUsave_patch (begp:endp)) ; this%frootc_SASUsave_patch (:) = nan + allocate(this%frootc_storage_SASUsave_patch (begp:endp)) ; this%frootc_storage_SASUsave_patch (:) = nan + allocate(this%frootc_xfer_SASUsave_patch (begp:endp)) ; this%frootc_xfer_SASUsave_patch (:) = nan + allocate(this%livestemc_SASUsave_patch (begp:endp)) ; this%livestemc_SASUsave_patch (:) = nan + allocate(this%livestemc_storage_SASUsave_patch (begp:endp)) ; this%livestemc_storage_SASUsave_patch (:) = nan + allocate(this%livestemc_xfer_SASUsave_patch (begp:endp)) ; this%livestemc_xfer_SASUsave_patch (:) = nan + allocate(this%deadstemc_SASUsave_patch (begp:endp)) ; this%deadstemc_SASUsave_patch (:) = nan + allocate(this%deadstemc_storage_SASUsave_patch (begp:endp)) ; this%deadstemc_storage_SASUsave_patch (:) = nan + allocate(this%deadstemc_xfer_SASUsave_patch (begp:endp)) ; this%deadstemc_xfer_SASUsave_patch (:) = nan + allocate(this%livecrootc_SASUsave_patch (begp:endp)) ; this%livecrootc_SASUsave_patch (:) = nan + allocate(this%livecrootc_storage_SASUsave_patch (begp:endp)) ; this%livecrootc_storage_SASUsave_patch (:) = nan + allocate(this%livecrootc_xfer_SASUsave_patch (begp:endp)) ; this%livecrootc_xfer_SASUsave_patch (:) = nan + allocate(this%deadcrootc_SASUsave_patch (begp:endp)) ; this%deadcrootc_SASUsave_patch (:) = nan + allocate(this%deadcrootc_storage_SASUsave_patch (begp:endp)) ; this%deadcrootc_storage_SASUsave_patch (:) = nan + allocate(this%deadcrootc_xfer_SASUsave_patch (begp:endp)) ; this%deadcrootc_xfer_SASUsave_patch (:) = nan + allocate(this%grainc_SASUsave_patch (begp:endp)) ; this%grainc_SASUsave_patch (:) = nan + allocate(this%grainc_storage_SASUsave_patch (begp:endp)) ; this%grainc_storage_SASUsave_patch (:) = nan + + allocate(this%matrix_calloc_leaf_acc_patch (begp:endp)); this%matrix_calloc_leaf_acc_patch (:) = nan + allocate(this%matrix_calloc_leafst_acc_patch (begp:endp)); this%matrix_calloc_leafst_acc_patch (:) = nan + allocate(this%matrix_calloc_froot_acc_patch (begp:endp)); this%matrix_calloc_froot_acc_patch (:) = nan + allocate(this%matrix_calloc_frootst_acc_patch (begp:endp)); this%matrix_calloc_frootst_acc_patch (:) = nan + allocate(this%matrix_calloc_livestem_acc_patch (begp:endp)); this%matrix_calloc_livestem_acc_patch (:) = nan + allocate(this%matrix_calloc_livestemst_acc_patch (begp:endp)); this%matrix_calloc_livestemst_acc_patch (:) = nan + allocate(this%matrix_calloc_deadstem_acc_patch (begp:endp)); this%matrix_calloc_deadstem_acc_patch (:) = nan + allocate(this%matrix_calloc_deadstemst_acc_patch (begp:endp)); this%matrix_calloc_deadstemst_acc_patch (:) = nan + allocate(this%matrix_calloc_livecroot_acc_patch (begp:endp)); this%matrix_calloc_livecroot_acc_patch (:) = nan + allocate(this%matrix_calloc_livecrootst_acc_patch (begp:endp)); this%matrix_calloc_livecrootst_acc_patch (:) = nan + allocate(this%matrix_calloc_deadcroot_acc_patch (begp:endp)); this%matrix_calloc_deadcroot_acc_patch (:) = nan + allocate(this%matrix_calloc_deadcrootst_acc_patch (begp:endp)); this%matrix_calloc_deadcrootst_acc_patch (:) = nan + allocate(this%matrix_calloc_grain_acc_patch (begp:endp)); this%matrix_calloc_grain_acc_patch (:) = nan + allocate(this%matrix_calloc_grainst_acc_patch (begp:endp)); this%matrix_calloc_grainst_acc_patch (:) = nan + + allocate(this%matrix_ctransfer_leafst_to_leafxf_acc_patch (begp:endp)) + this%matrix_ctransfer_leafst_to_leafxf_acc_patch (:) = nan + allocate(this%matrix_ctransfer_leafxf_to_leaf_acc_patch (begp:endp)) + this%matrix_ctransfer_leafxf_to_leaf_acc_patch (:) = nan + allocate(this%matrix_ctransfer_frootst_to_frootxf_acc_patch (begp:endp)) + this%matrix_ctransfer_frootst_to_frootxf_acc_patch (:) = nan + allocate(this%matrix_ctransfer_frootxf_to_froot_acc_patch (begp:endp)) + this%matrix_ctransfer_frootxf_to_froot_acc_patch (:) = nan + allocate(this%matrix_ctransfer_livestemst_to_livestemxf_acc_patch (begp:endp)) + this%matrix_ctransfer_livestemst_to_livestemxf_acc_patch (:) = nan + allocate(this%matrix_ctransfer_livestemxf_to_livestem_acc_patch (begp:endp)) + this%matrix_ctransfer_livestemxf_to_livestem_acc_patch (:) = nan + allocate(this%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch (begp:endp)) + this%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch (:) = nan + allocate(this%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch (begp:endp)) + this%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch (:) = nan + allocate(this%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch (begp:endp)) + this%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch (:) = nan + allocate(this%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch (begp:endp)) + this%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch (:) = nan + allocate(this%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch (begp:endp)) + this%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch (:) = nan + allocate(this%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch (begp:endp)) + this%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch (:) = nan + allocate(this%matrix_ctransfer_grainst_to_grainxf_acc_patch (begp:endp)) + this%matrix_ctransfer_grainst_to_grainxf_acc_patch (:) = nan + allocate(this%matrix_ctransfer_grainxf_to_grain_acc_patch (begp:endp)) + this%matrix_ctransfer_grainxf_to_grain_acc_patch (:) = nan + allocate(this%matrix_ctransfer_livestem_to_deadstem_acc_patch (begp:endp)) + this%matrix_ctransfer_livestem_to_deadstem_acc_patch (:) = nan + allocate(this%matrix_ctransfer_livecroot_to_deadcroot_acc_patch (begp:endp)) + this%matrix_ctransfer_livecroot_to_deadcroot_acc_patch (:) = nan + + allocate(this%matrix_cturnover_leaf_acc_patch (begp:endp)) ; this%matrix_cturnover_leaf_acc_patch (:) = nan + allocate(this%matrix_cturnover_leafst_acc_patch (begp:endp)) ; this%matrix_cturnover_leafst_acc_patch (:) = nan + allocate(this%matrix_cturnover_leafxf_acc_patch (begp:endp)) ; this%matrix_cturnover_leafxf_acc_patch (:) = nan + allocate(this%matrix_cturnover_froot_acc_patch (begp:endp)) ; this%matrix_cturnover_froot_acc_patch (:) = nan + allocate(this%matrix_cturnover_frootst_acc_patch (begp:endp)) ; this%matrix_cturnover_frootst_acc_patch (:) = nan + allocate(this%matrix_cturnover_frootxf_acc_patch (begp:endp)) ; this%matrix_cturnover_frootxf_acc_patch (:) = nan + allocate(this%matrix_cturnover_livestem_acc_patch (begp:endp)) ; this%matrix_cturnover_livestem_acc_patch (:) = nan + allocate(this%matrix_cturnover_livestemst_acc_patch (begp:endp)) ; this%matrix_cturnover_livestemst_acc_patch (:) = nan + allocate(this%matrix_cturnover_livestemxf_acc_patch (begp:endp)) ; this%matrix_cturnover_livestemxf_acc_patch (:) = nan + allocate(this%matrix_cturnover_deadstem_acc_patch (begp:endp)) ; this%matrix_cturnover_deadstem_acc_patch (:) = nan + allocate(this%matrix_cturnover_deadstemst_acc_patch (begp:endp)) ; this%matrix_cturnover_deadstemst_acc_patch (:) = nan + allocate(this%matrix_cturnover_deadstemxf_acc_patch (begp:endp)) ; this%matrix_cturnover_deadstemxf_acc_patch (:) = nan + allocate(this%matrix_cturnover_livecroot_acc_patch (begp:endp)) ; this%matrix_cturnover_livecroot_acc_patch (:) = nan + allocate(this%matrix_cturnover_livecrootst_acc_patch (begp:endp)) ; this%matrix_cturnover_livecrootst_acc_patch (:) = nan + allocate(this%matrix_cturnover_livecrootxf_acc_patch (begp:endp)) ; this%matrix_cturnover_livecrootxf_acc_patch (:) = nan + allocate(this%matrix_cturnover_deadcroot_acc_patch (begp:endp)) ; this%matrix_cturnover_deadcroot_acc_patch (:) = nan + allocate(this%matrix_cturnover_deadcrootst_acc_patch (begp:endp)) ; this%matrix_cturnover_deadcrootst_acc_patch (:) = nan + allocate(this%matrix_cturnover_deadcrootxf_acc_patch (begp:endp)) ; this%matrix_cturnover_deadcrootxf_acc_patch (:) = nan + allocate(this%matrix_cturnover_grain_acc_patch (begp:endp)) ; this%matrix_cturnover_grain_acc_patch (:) = nan + allocate(this%matrix_cturnover_grainst_acc_patch (begp:endp)) ; this%matrix_cturnover_grainst_acc_patch (:) = nan + allocate(this%matrix_cturnover_grainxf_acc_patch (begp:endp)) ; this%matrix_cturnover_grainxf_acc_patch (:) = nan + end if + + allocate(this%cropseedc_deficit_patch (begp:endp)) ; this%cropseedc_deficit_patch (:) = nan + allocate(this%seedc_grc (begg:endg)) ; this%seedc_grc (:) = nan + allocate(this%rootc_col (begc:endc)) ; this%rootc_col (:) = nan + allocate(this%leafc_col (begc:endc)) ; this%leafc_col (:) = nan + allocate(this%deadstemc_col (begc:endc)) ; this%deadstemc_col (:) = nan + allocate(this%fuelc_col (begc:endc)) ; this%fuelc_col (:) = nan + allocate(this%fuelc_crop_col (begc:endc)) ; this%fuelc_crop_col (:) = nan + + allocate(this%totvegc_patch (begp:endp)) ; this%totvegc_patch (:) = nan + allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan + + allocate(this%totc_p2c_col (begc:endc)) ; this%totc_p2c_col (:) = nan + allocate(this%totc_col (begc:endc)) ; this%totc_col (:) = nan + allocate(this%totecosysc_col (begc:endc)) ; this%totecosysc_col (:) = nan + allocate(this%totc_grc (begg:endg)) ; this%totc_grc (:) = nan + + ! initialize variables from restart file or set to cold start value + n = 0 + np = 0 + do nc = 1,nch ! catchment tile loop + + this%seedc_grc(nc) = 0. + + do nz = 1,num_zon ! CN zone loop + n = n + 1 + + this%totvegc_col(n) = cncol(nc,nz, 6) + this%seedc_grc (nc) = this%seedc_grc(nc) + cncol(nc,nz,9)*CN_zone_weight(nz) + this%totc_col (n) = cncol(nc,nz,14) + + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + + ! "old" variables: CNCLM45 and before + this%cpool_patch (np) = cnpft(nc,nz,nv, 1) + this%deadcrootc_patch (np) = cnpft(nc,nz,nv, 2) + this%deadcrootc_storage_patch(np) = cnpft(nc,nz,nv, 3) + this%deadcrootc_xfer_patch (np) = cnpft(nc,nz,nv, 4) + this%deadstemc_patch (np) = cnpft(nc,nz,nv, 5) + this%deadstemc_storage_patch (np) = cnpft(nc,nz,nv, 6) + this%deadstemc_xfer_patch (np) = cnpft(nc,nz,nv, 7) + this%frootc_patch (np) = cnpft(nc,nz,nv, 8) + this%frootc_storage_patch (np) = cnpft(nc,nz,nv, 9) + this%frootc_xfer_patch (np) = cnpft(nc,nz,nv, 10) + this%gresp_storage_patch (np) = cnpft(nc,nz,nv, 11) + this%gresp_xfer_patch (np) = cnpft(nc,nz,nv, 12) + this%leafc_patch (np) = cnpft(nc,nz,nv, 13) + this%leafc_storage_patch (np) = cnpft(nc,nz,nv, 14) + this%leafc_xfer_patch (np) = cnpft(nc,nz,nv, 15) + this%livecrootc_patch (np) = cnpft(nc,nz,nv, 16) + this%livecrootc_storage_patch(np) = cnpft(nc,nz,nv, 17) + this%livecrootc_xfer_patch (np) = cnpft(nc,nz,nv, 18) + this%livestemc_patch (np) = cnpft(nc,nz,nv, 19) + this%livestemc_storage_patch (np) = cnpft(nc,nz,nv, 20) + this%livestemc_xfer_patch (np) = cnpft(nc,nz,nv, 21) + this%ctrunc_patch (np) = cnpft(nc,nz,nv, 22) + this%xsmrpool_patch (np) = cnpft(nc,nz,nv, 23) + + this%totvegc_patch (np) = & + this%leafc_patch(np) + & + this%leafc_storage_patch(np) + & + this%leafc_xfer_patch(np) + & + this%frootc_patch(np) + & + this%frootc_storage_patch(np) + & + this%frootc_xfer_patch(np) + & + this%livestemc_patch(np) + & + this%livestemc_storage_patch(np) + & + this%livestemc_xfer_patch(np) + & + this%deadstemc_patch(np) + & + this%deadstemc_storage_patch(np) + & + this%deadstemc_xfer_patch(np) + & + this%livecrootc_patch(np) + & + this%livecrootc_storage_patch(np) + & + this%livecrootc_xfer_patch(np) + & + this%deadcrootc_patch(np) + & + this%deadcrootc_storage_patch(np) + & + this%deadcrootc_xfer_patch(np) + & + this%gresp_storage_patch(np) + & + this%gresp_xfer_patch(np) + & + this%cpool_patch(np) + + end if + end do !nv + end do ! p + end do ! nz + end do ! nc + + end subroutine init_cnveg_carbonstate_type + +end module CNCLM_VegCarbonStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 new file mode 100644 index 000000000..7bfcd15db --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 @@ -0,0 +1,489 @@ +module CNCLM_VegNitrogenStateType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ExceptionHandling + use clm_varctl , only : use_matrixcn + use clm_varpar , only : NUM_ZON, NUM_VEG, VAR_COL, VAR_PFT, & + numpft, CN_zone_weight + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_cnveg_nitrogenstate_type + + ! + type, public :: cnveg_nitrogenstate_type + + real(r8), pointer :: grainn_patch (:) ! (gN/m2) grain N (crop) + real(r8), pointer :: grainn_storage_patch (:) ! (gN/m2) grain N storage (crop) + real(r8), pointer :: grainn_xfer_patch (:) ! (gN/m2) grain N transfer (crop) + real(r8), pointer :: matrix_cap_grainn_patch (:) ! (gN/m2) Capacity of grain N + real(r8), pointer :: matrix_cap_grainn_storage_patch (:) ! (gN/m2) Capacity of grain N storage + real(r8), pointer :: matrix_cap_grainn_xfer_patch (:) ! (gN/m2) Capacity of grain N transfer + real(r8), pointer :: leafn_patch (:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage_patch (:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer_patch (:) ! (gN/m2) leaf N transfer + real(r8), pointer :: matrix_cap_leafn_patch (:) ! (gN/m2) Capacity of leaf N + real(r8), pointer :: matrix_cap_leafn_storage_patch (:) ! (gN/m2) Capacity of leaf N storage + real(r8), pointer :: matrix_cap_leafn_xfer_patch (:) ! (gN/m2) Capacity of leaf N transfer + real(r8), pointer :: leafn_storage_xfer_acc_patch (:) ! (gN/m2) Accmulated leaf N transfer + real(r8), pointer :: storage_ndemand_patch (:) ! (gN/m2) N demand during the offset period + real(r8), pointer :: frootn_patch (:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage_patch (:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer_patch (:) ! (gN/m2) fine root N transfer + real(r8), pointer :: matrix_cap_frootn_patch (:) ! (gN/m2) Capacity of fine root N + real(r8), pointer :: matrix_cap_frootn_storage_patch (:) ! (gN/m2) Capacity of fine root N storage + real(r8), pointer :: matrix_cap_frootn_xfer_patch (:) ! (gN/m2) Capacity of fine root N transfer + real(r8), pointer :: livestemn_patch (:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage_patch (:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer_patch (:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn_patch (:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage_patch (:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer_patch (:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn_patch (:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage_patch (:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer_patch (:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn_patch (:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage_patch (:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer_patch (:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: matrix_cap_livestemn_patch (:) ! (gN/m2) Capacity of live stem N + real(r8), pointer :: matrix_cap_livestemn_storage_patch (:) ! (gN/m2) Capacity of live stem N storage + real(r8), pointer :: matrix_cap_livestemn_xfer_patch (:) ! (gN/m2) Capacity of live stem N transfer + real(r8), pointer :: matrix_cap_deadstemn_patch (:) ! (gN/m2) Capacity of dead stem N + real(r8), pointer :: matrix_cap_deadstemn_storage_patch (:) ! (gN/m2) Capacity of dead stem N storage + real(r8), pointer :: matrix_cap_deadstemn_xfer_patch (:) ! (gN/m2) Capacity of dead stem N transfer + real(r8), pointer :: matrix_cap_livecrootn_patch (:) ! (gN/m2) Capacity of live coarse root N + real(r8), pointer :: matrix_cap_livecrootn_storage_patch (:) ! (gN/m2) Capacity of live coarse root N storage + real(r8), pointer :: matrix_cap_livecrootn_xfer_patch (:) ! (gN/m2) Capacity of live coarse root N transfer + real(r8), pointer :: matrix_cap_deadcrootn_patch (:) ! (gN/m2) Capacity of dead coarse root N + real(r8), pointer :: matrix_cap_deadcrootn_storage_patch (:) ! (gN/m2) Capacity of dead coarse root N storage + real(r8), pointer :: matrix_cap_deadcrootn_xfer_patch (:) ! (gN/m2) Capacity of dead coarse root N transfer + real(r8), pointer :: retransn_patch (:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: npool_patch (:) ! (gN/m2) temporary plant N pool + real(r8), pointer :: ntrunc_patch (:) ! (gN/m2) patch-level sink for N truncation + real(r8), pointer :: cropseedn_deficit_patch (:) ! (gN/m2) pool for seeding new crop growth; this is a NEGATIVE term, indicating the amount of seed usage that needs to be repaid + real(r8), pointer :: seedn_grc (:) ! (gN/m2) gridcell-level pool for seeding new pFTs via dynamic landcover +! Pool for initial step of year for matrix + real(r8), pointer :: leafn0_patch (:) ! (gN/m2) Initial value of leaf N for SASU + real(r8), pointer :: leafn0_storage_patch (:) ! (gN/m2) Initial value of leaf N storage for SASU + real(r8), pointer :: leafn0_xfer_patch (:) ! (gN/m2) Initial value of leaf N transfer for SASU + real(r8), pointer :: frootn0_patch (:) ! (gN/m2) Initial value of fine root N for SASU + real(r8), pointer :: frootn0_storage_patch (:) ! (gN/m2) Initial value of fine root N storage for SASU + real(r8), pointer :: frootn0_xfer_patch (:) ! (gN/m2) Initial value of fine root N transfer for SASU + real(r8), pointer :: livestemn0_patch (:) ! (gN/m2) Initial value of live stem N for SASU + real(r8), pointer :: livestemn0_storage_patch (:) ! (gN/m2) Initial value of live stem N storage for SASU + real(r8), pointer :: livestemn0_xfer_patch (:) ! (gN/m2) Initial value of live stem N transfer for SASU + real(r8), pointer :: deadstemn0_patch (:) ! (gN/m2) Initial value of dead stem N for SASU + real(r8), pointer :: deadstemn0_storage_patch (:) ! (gN/m2) Initial value of dead stem N storage for SASU + real(r8), pointer :: deadstemn0_xfer_patch (:) ! (gN/m2) Initial value of dead stem N transfer for SASU + real(r8), pointer :: livecrootn0_patch (:) ! (gN/m2) Initial value of live coarse root N for SASU + real(r8), pointer :: livecrootn0_storage_patch (:) ! (gN/m2) Initial value of live coarse root N storage for SASU + real(r8), pointer :: livecrootn0_xfer_patch (:) ! (gN/m2) Initial value of live coarse root N transfer for SASU + real(r8), pointer :: deadcrootn0_patch (:) ! (gN/m2) Initial value of dead coarse root N for SASU + real(r8), pointer :: deadcrootn0_storage_patch (:) ! (gN/m2) Initial value of dead coarse root N storage for SASU + real(r8), pointer :: deadcrootn0_xfer_patch (:) ! (gN/m2) Initial value of dead coarse root N transfer for SASU + real(r8), pointer :: retransn0_patch (:) ! (gN/m2) Initial value of dead coarse root N transfer for SASU + real(r8), pointer :: grainn0_patch (:) ! (gN/m2) Initial value of grain N for SASU + real(r8), pointer :: grainn0_storage_patch (:) ! (gN/m2) Initial value of grain N storage for SASU + real(r8), pointer :: grainn0_xfer_patch (:) ! (gN/m2) Initial value of grain N transfer for SASU + + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: dispvegn_patch (:) ! (gN/m2) displayed veg nitrogen, excluding storage + real(r8), pointer :: storvegn_patch (:) ! (gN/m2) stored vegetation nitrogen + real(r8), pointer :: totvegn_patch (:) ! (gN/m2) total vegetation nitrogen + real(r8), pointer :: totvegn_col (:) ! (gN/m2) total vegetation nitrogen (p2c) + real(r8), pointer :: totn_patch (:) ! (gN/m2) total patch-level nitrogen + real(r8), pointer :: totn_p2c_col (:) ! (gN/m2) totn_patch averaged to col + real(r8), pointer :: totn_col (:) ! (gN/m2) total column nitrogen, incl veg + real(r8), pointer :: totecosysn_col (:) ! (gN/m2) total ecosystem nitrogen, incl veg + real(r8), pointer :: totn_grc (:) ! (gN/m2) total gridcell nitrogen +! acc spinup + real(r8), pointer :: matrix_nalloc_leaf_acc_patch (:) ! (gN/m2/year) Input N allocated to leaf during this year + real(r8), pointer :: matrix_nalloc_leafst_acc_patch (:) ! (gN/m2/year) Input N allocated to leaf storage during this year + real(r8), pointer :: matrix_nalloc_froot_acc_patch (:) ! (gN/m2/year) Input N allocated to fine root during this year + real(r8), pointer :: matrix_nalloc_frootst_acc_patch (:) ! (gN/m2/year) Input N allocated to fine root storage during this year + real(r8), pointer :: matrix_nalloc_livestem_acc_patch (:) ! (gN/m2/year) Input N allocated to live stem during this year + real(r8), pointer :: matrix_nalloc_livestemst_acc_patch (:) ! (gN/m2/year) Input N allocated to live stem storage during this year + real(r8), pointer :: matrix_nalloc_deadstem_acc_patch (:) ! (gN/m2/year) Input N allocated to dead stem during this year + real(r8), pointer :: matrix_nalloc_deadstemst_acc_patch (:) ! (gN/m2/year) Input N allocated to dead stem storage during this year + real(r8), pointer :: matrix_nalloc_livecroot_acc_patch (:) ! (gN/m2/year) Input N allocated to live coarse root during this year + real(r8), pointer :: matrix_nalloc_livecrootst_acc_patch (:) ! (gN/m2/year) Input N allocated to live coarse root storage during this year + real(r8), pointer :: matrix_nalloc_deadcroot_acc_patch (:) ! (gN/m2/year) Input N allocated to dead coarse root during this year + real(r8), pointer :: matrix_nalloc_deadcrootst_acc_patch (:) ! (gN/m2/year) Input N allocated to dead coarse root storage during this year + real(r8), pointer :: matrix_nalloc_grain_acc_patch (:) ! (gN/m2/year) Input N allocated to grain during this year + real(r8), pointer :: matrix_nalloc_grainst_acc_patch (:) ! (gN/m2/year) Input N allocated to grain storage during this year + + real(r8), pointer :: matrix_ntransfer_leafst_to_leafxf_acc_patch (:) ! (gN/m2/year) N transfer from leaf storage to leaf transfer pool during this year + real(r8), pointer :: matrix_ntransfer_leafxf_to_leaf_acc_patch (:) ! (gN/m2/year) N transfer from leaf transfer to leaf pool during this year + real(r8), pointer :: matrix_ntransfer_frootst_to_frootxf_acc_patch (:) ! (gN/m2/year) N transfer from fine root storage to fine root transfer pool during this year + real(r8), pointer :: matrix_ntransfer_frootxf_to_froot_acc_patch (:) ! (gN/m2/year) N transfer from fine root transfer to fine root pool during this year + real(r8), pointer :: matrix_ntransfer_livestemst_to_livestemxf_acc_patch (:) ! (gN/m2/year) N transfer from live stem storage to live stem transfer pool during this year + real(r8), pointer :: matrix_ntransfer_livestemxf_to_livestem_acc_patch (:) ! (gN/m2/year) N transfer from live stem transfer to live stem pool during this year + real(r8), pointer :: matrix_ntransfer_deadstemst_to_deadstemxf_acc_patch (:) ! (gN/m2/year) N transfer from dead stem storage to dead stem transfer pool during this year + real(r8), pointer :: matrix_ntransfer_deadstemxf_to_deadstem_acc_patch (:) ! (gN/m2/year) N transfer from dead stem transfer to dead stem pool during this year + real(r8), pointer :: matrix_ntransfer_livecrootst_to_livecrootxf_acc_patch (:) ! (gN/m2/year) N transfer from live coarse root storage to live coarse root transfer pool during this year + real(r8), pointer :: matrix_ntransfer_livecrootxf_to_livecroot_acc_patch (:) ! (gN/m2/year) N transfer from live coarse root transfer to live coarse root pool during this year + real(r8), pointer :: matrix_ntransfer_deadcrootst_to_deadcrootxf_acc_patch (:) ! (gN/m2/year) N transfer from dead coarse root storage to dead coarse root transfer pool during this year + real(r8), pointer :: matrix_ntransfer_deadcrootxf_to_deadcroot_acc_patch (:) ! (gN/m2/year) N transfer from dead coarse root transfer to dead coarse root pool during this year + real(r8), pointer :: matrix_ntransfer_grainst_to_grainxf_acc_patch (:) ! (gN/m2/year) N transfer from grain storage to grain transfer pool during this year + real(r8), pointer :: matrix_ntransfer_grainxf_to_grain_acc_patch (:) ! (gN/m2/year) N transfer from grain transfer to grain pool during this year + real(r8), pointer :: matrix_ntransfer_livestem_to_deadstem_acc_patch (:) ! (gN/m2/year) N transfer from live stem to dead stem pool during this year + real(r8), pointer :: matrix_ntransfer_livecroot_to_deadcroot_acc_patch (:) ! (gN/m2/year) N transfer from live coarse root to dead coarse root pool during this year + + real(r8), pointer :: matrix_ntransfer_retransn_to_leaf_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to leaf pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_leafst_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to leaf storage pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_froot_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to fine root pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_frootst_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to fine root storage pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_livestem_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to live stem pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_livestemst_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to live stem storage pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_deadstem_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to dead stem pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_deadstemst_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to dead stem storage pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_livecroot_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to live coarse root pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_livecrootst_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to live coarse root storage pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_deadcroot_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to dead coarse root pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_deadcrootst_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to dead coarse root storage pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_grain_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to grain pool during this year + real(r8), pointer :: matrix_ntransfer_retransn_to_grainst_acc_patch (:) ! (gN/m2/year) N transfer from retranslocation to grain storage pool during this year + + real(r8), pointer :: matrix_ntransfer_leaf_to_retransn_acc_patch (:) ! (gN/m2/year) N transfer from leaf to retranslocation pool during this year + real(r8), pointer :: matrix_ntransfer_froot_to_retransn_acc_patch (:) ! (gN/m2/year) N transfer from fine root to retranslocation pool during this year + real(r8), pointer :: matrix_ntransfer_livestem_to_retransn_acc_patch (:) ! (gN/m2/year) N transfer from live stem to retranslocation pool during this year + real(r8), pointer :: matrix_ntransfer_livecroot_to_retransn_acc_patch (:) ! (gN/m2/year) N transfer from live coarse root to retranslocation pool during this year + + real(r8), pointer :: matrix_nturnover_leaf_acc_patch (:) ! (gN/m2/year) N turnover from leaf + real(r8), pointer :: matrix_nturnover_leafst_acc_patch (:) ! (gN/m2/year) N turnover from leaf storage + real(r8), pointer :: matrix_nturnover_leafxf_acc_patch (:) ! (gN/m2/year) N turnover from leaf transfer + real(r8), pointer :: matrix_nturnover_froot_acc_patch (:) ! (gN/m2/year) N turnover from root + real(r8), pointer :: matrix_nturnover_frootst_acc_patch (:) ! (gN/m2/year) N turnover from root storage + real(r8), pointer :: matrix_nturnover_frootxf_acc_patch (:) ! (gN/m2/year) N turnover from root transfer + real(r8), pointer :: matrix_nturnover_livestem_acc_patch (:) ! (gN/m2/year) N turnover from live stem + real(r8), pointer :: matrix_nturnover_livestemst_acc_patch (:) ! (gN/m2/year) N turnover from live stem storage + real(r8), pointer :: matrix_nturnover_livestemxf_acc_patch (:) ! (gN/m2/year) N turnover from live stem transfer + real(r8), pointer :: matrix_nturnover_deadstem_acc_patch (:) ! (gN/m2/year) N turnover from dead stem + real(r8), pointer :: matrix_nturnover_deadstemst_acc_patch (:) ! (gN/m2/year) N turnover from dead stem storage + real(r8), pointer :: matrix_nturnover_deadstemxf_acc_patch (:) ! (gN/m2/year) N turnover from dead stem transfer + real(r8), pointer :: matrix_nturnover_livecroot_acc_patch (:) ! (gN/m2/year) N turnover from live coarse root + real(r8), pointer :: matrix_nturnover_livecrootst_acc_patch (:) ! (gN/m2/year) N turnover from live coarse root storage + real(r8), pointer :: matrix_nturnover_livecrootxf_acc_patch (:) ! (gN/m2/year) N turnover from live coarse root transfer + real(r8), pointer :: matrix_nturnover_deadcroot_acc_patch (:) ! (gN/m2/year) N turnover from dead coarse root + real(r8), pointer :: matrix_nturnover_deadcrootst_acc_patch (:) ! (gN/m2/year) N turnover from dead coarse root storage + real(r8), pointer :: matrix_nturnover_deadcrootxf_acc_patch (:) ! (gN/m2/year) N turnover from dead coarse root transfer + real(r8), pointer :: matrix_nturnover_grain_acc_patch (:) ! (gN/m2/year) N turnover from grain + real(r8), pointer :: matrix_nturnover_grainst_acc_patch (:) ! (gN/m2/year) N turnover from grain storage + real(r8), pointer :: matrix_nturnover_grainxf_acc_patch (:) ! (gN/m2/year) N turnover from grain transfer + real(r8), pointer :: matrix_nturnover_retransn_acc_patch (:) ! (gN/m2/year) N turnover from retranslocation transfer + + real(r8), pointer :: grainn_SASUsave_patch (:) ! (gC/m2) grain C (crop model) + real(r8), pointer :: grainn_storage_SASUsave_patch (:) ! (gC/m2) grain C storage (crop model) + real(r8), pointer :: leafn_SASUsave_patch (:) ! (gC/m2) leaf C + real(r8), pointer :: leafn_storage_SASUsave_patch (:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafn_xfer_SASUsave_patch (:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootn_SASUsave_patch (:) ! (gC/m2) fine root C + real(r8), pointer :: frootn_storage_SASUsave_patch (:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootn_xfer_SASUsave_patch (:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemn_SASUsave_patch (:) ! (gC/m2) live stem C + real(r8), pointer :: livestemn_storage_SASUsave_patch (:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemn_xfer_SASUsave_patch (:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemn_SASUsave_patch (:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemn_storage_SASUsave_patch (:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemn_xfer_SASUsave_patch (:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootn_SASUsave_patch (:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootn_storage_SASUsave_patch (:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootn_xfer_SASUsave_patch (:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootn_SASUsave_patch (:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootn_storage_SASUsave_patch (:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootn_xfer_SASUsave_patch (:) ! (gC/m2) dead coarse root C transfer:wq + +end type cnveg_nitrogenstate_type +type(cnveg_nitrogenstate_type), public, target, save :: cnveg_nitrogenstate_inst + +contains + +!------------------------------------------------------------- + subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) + +! !DESCRIPTION: +! Initialize CTSM nitrogen states +! jk Apr 2021: type is allocated and initialized to NaN; +! if data arrays from restart file are passed (cncol and cnpft), the type is then initialized with these values +! +! !ARGUMENTS: + implicit none + + ! INPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: ityp ! PFT index + real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart + type(cnveg_nitrogenstate_type), intent(inout):: this + logical, optional, intent(in) :: cn5_cold_start + + + ! LOCAL: + + integer :: begp, endp, begg, endgg, begc, endc + integer :: np, nc, nz, p, nv, n + logical :: cold_start = .false. + !--------------------------------------------------------------------- + + begp = bounds%begp ; endp = bounds%endp + begg = bounds%begg ; endg = bounds%endg + begc = bounds%begc ; endc = bounds%endc + + ! check whether a cn5_cold_start option was set and change cold_start accordingly + if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + cold_start = .true. + end if + + ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + (size(cnpft,3).ne.var_pft))) + _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') + end if + + allocate(this%grainn_patch (begp:endp)) ; this%grainn_patch (:) = nan + allocate(this%grainn_storage_patch (begp:endp)) ; this%grainn_storage_patch (:) = nan + allocate(this%grainn_xfer_patch (begp:endp)) ; this%grainn_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_grainn_patch (begp:endp)) ; this%matrix_cap_grainn_patch (:) = nan + allocate(this%matrix_cap_grainn_storage_patch (begp:endp)) ; this%matrix_cap_grainn_storage_patch (:) = nan + allocate(this%matrix_cap_grainn_xfer_patch (begp:endp)) ; this%matrix_cap_grainn_xfer_patch (:) = nan + end if + allocate(this%leafn_patch (begp:endp)) ; this%leafn_patch (:) = nan + allocate(this%leafn_storage_patch (begp:endp)) ; this%leafn_storage_patch (:) = nan + allocate(this%leafn_xfer_patch (begp:endp)) ; this%leafn_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_leafn_patch (begp:endp)) ; this%matrix_cap_leafn_patch (:) = nan + allocate(this%matrix_cap_leafn_storage_patch (begp:endp)) ; this%matrix_cap_leafn_storage_patch (:) = nan + allocate(this%matrix_cap_leafn_xfer_patch (begp:endp)) ; this%matrix_cap_leafn_xfer_patch (:) = nan + end if + allocate(this%leafn_storage_xfer_acc_patch (begp:endp)) ; this%leafn_storage_xfer_acc_patch (:) = nan + allocate(this%storage_ndemand_patch (begp:endp)) ; this%storage_ndemand_patch (:) = nan + allocate(this%frootn_patch (begp:endp)) ; this%frootn_patch (:) = nan + allocate(this%frootn_storage_patch (begp:endp)) ; this%frootn_storage_patch (:) = nan + allocate(this%frootn_xfer_patch (begp:endp)) ; this%frootn_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_frootn_patch (begp:endp)) ; this%matrix_cap_frootn_patch (:) = nan + allocate(this%matrix_cap_frootn_storage_patch (begp:endp)) ; this%matrix_cap_frootn_storage_patch (:) = nan + allocate(this%matrix_cap_frootn_xfer_patch (begp:endp)) ; this%matrix_cap_frootn_xfer_patch (:) = nan + end if + allocate(this%livestemn_patch (begp:endp)) ; this%livestemn_patch (:) = nan + allocate(this%livestemn_storage_patch (begp:endp)) ; this%livestemn_storage_patch (:) = nan + allocate(this%livestemn_xfer_patch (begp:endp)) ; this%livestemn_xfer_patch (:) = nan + allocate(this%deadstemn_patch (begp:endp)) ; this%deadstemn_patch (:) = nan + allocate(this%deadstemn_storage_patch (begp:endp)) ; this%deadstemn_storage_patch (:) = nan + allocate(this%deadstemn_xfer_patch (begp:endp)) ; this%deadstemn_xfer_patch (:) = nan + allocate(this%livecrootn_patch (begp:endp)) ; this%livecrootn_patch (:) = nan + allocate(this%livecrootn_storage_patch (begp:endp)) ; this%livecrootn_storage_patch (:) = nan + allocate(this%livecrootn_xfer_patch (begp:endp)) ; this%livecrootn_xfer_patch (:) = nan + allocate(this%deadcrootn_patch (begp:endp)) ; this%deadcrootn_patch (:) = nan + allocate(this%deadcrootn_storage_patch (begp:endp)) ; this%deadcrootn_storage_patch (:) = nan + allocate(this%deadcrootn_xfer_patch (begp:endp)) ; this%deadcrootn_xfer_patch (:) = nan + if(use_matrixcn)then + allocate(this%matrix_cap_livestemn_patch (begp:endp)) ; this%matrix_cap_livestemn_patch (:) = nan + allocate(this%matrix_cap_livestemn_storage_patch (begp:endp)) ; this%matrix_cap_livestemn_storage_patch (:) = nan + allocate(this%matrix_cap_livestemn_xfer_patch (begp:endp)) ; this%matrix_cap_livestemn_xfer_patch (:) = nan + allocate(this%matrix_cap_deadstemn_patch (begp:endp)) ; this%matrix_cap_deadstemn_patch (:) = nan + allocate(this%matrix_cap_deadstemn_storage_patch (begp:endp)) ; this%matrix_cap_deadstemn_storage_patch (:) = nan + allocate(this%matrix_cap_deadstemn_xfer_patch (begp:endp)) ; this%matrix_cap_deadstemn_xfer_patch (:) = nan + allocate(this%matrix_cap_livecrootn_patch (begp:endp)) ; this%matrix_cap_livecrootn_patch (:) = nan + allocate(this%matrix_cap_livecrootn_storage_patch (begp:endp)) ; this%matrix_cap_livecrootn_storage_patch (:) = nan + allocate(this%matrix_cap_livecrootn_xfer_patch (begp:endp)) ; this%matrix_cap_livecrootn_xfer_patch (:) = nan + allocate(this%matrix_cap_deadcrootn_patch (begp:endp)) ; this%matrix_cap_deadcrootn_patch (:) = nan + allocate(this%matrix_cap_deadcrootn_storage_patch (begp:endp)) ; this%matrix_cap_deadcrootn_storage_patch (:) = nan + allocate(this%matrix_cap_deadcrootn_xfer_patch (begp:endp)) ; this%matrix_cap_deadcrootn_xfer_patch (:) = nan + end if + allocate(this%retransn_patch (begp:endp)) ; this%retransn_patch (:) = nan + allocate(this%npool_patch (begp:endp)) ; this%npool_patch (:) = nan + allocate(this%ntrunc_patch (begp:endp)) ; this%ntrunc_patch (:) = nan + allocate(this%dispvegn_patch (begp:endp)) ; this%dispvegn_patch (:) = nan + allocate(this%storvegn_patch (begp:endp)) ; this%storvegn_patch (:) = nan + allocate(this%totvegn_patch (begp:endp)) ; this%totvegn_patch (:) = nan + allocate(this%totn_patch (begp:endp)) ; this%totn_patch (:) = nan + + allocate(this%cropseedn_deficit_patch (begp:endp)) ; this%cropseedn_deficit_patch (:) = nan + allocate(this%seedn_grc (begg:endg)) ; this%seedn_grc (:) = nan + allocate(this%totvegn_col (begc:endc)) ; this%totvegn_col (:) = nan + allocate(this%totn_p2c_col (begc:endc)) ; this%totn_p2c_col (:) = nan + allocate(this%totn_col (begc:endc)) ; this%totn_col (:) = nan + allocate(this%totecosysn_col (begc:endc)) ; this%totecosysn_col (:) = nan + allocate(this%totn_grc (begg:endg)) ; this%totn_grc (:) = nan + + if(use_matrixcn)then + allocate(this%leafn0_patch (begp:endp)) ; this%leafn0_patch (:) = nan + allocate(this%leafn0_storage_patch (begp:endp)) ; this%leafn0_storage_patch (:) = nan + allocate(this%leafn0_xfer_patch (begp:endp)) ; this%leafn0_xfer_patch (:) = nan + allocate(this%frootn0_patch (begp:endp)) ; this%frootn0_patch (:) = nan + allocate(this%frootn0_storage_patch (begp:endp)) ; this%frootn0_storage_patch (:) = nan + allocate(this%frootn0_xfer_patch (begp:endp)) ; this%frootn0_xfer_patch (:) = nan + allocate(this%livestemn0_patch (begp:endp)) ; this%livestemn0_patch (:) = nan + allocate(this%livestemn0_storage_patch (begp:endp)) ; this%livestemn0_storage_patch (:) = nan + allocate(this%livestemn0_xfer_patch (begp:endp)) ; this%livestemn0_xfer_patch (:) = nan + allocate(this%deadstemn0_patch (begp:endp)) ; this%deadstemn0_patch (:) = nan + allocate(this%deadstemn0_storage_patch (begp:endp)) ; this%deadstemn0_storage_patch (:) = nan + allocate(this%deadstemn0_xfer_patch (begp:endp)) ; this%deadstemn0_xfer_patch (:) = nan + allocate(this%livecrootn0_patch (begp:endp)) ; this%livecrootn0_patch (:) = nan + allocate(this%livecrootn0_storage_patch (begp:endp)) ; this%livecrootn0_storage_patch (:) = nan + allocate(this%livecrootn0_xfer_patch (begp:endp)) ; this%livecrootn0_xfer_patch (:) = nan + allocate(this%deadcrootn0_patch (begp:endp)) ; this%deadcrootn0_patch (:) = nan + allocate(this%deadcrootn0_storage_patch (begp:endp)) ; this%deadcrootn0_storage_patch (:) = nan + allocate(this%deadcrootn0_xfer_patch (begp:endp)) ; this%deadcrootn0_xfer_patch (:) = nan + allocate(this%grainn0_patch (begp:endp)) ; this%grainn0_patch (:) = nan + allocate(this%grainn0_storage_patch (begp:endp)) ; this%grainn0_storage_patch (:) = nan + allocate(this%grainn0_xfer_patch (begp:endp)) ; this%grainn0_xfer_patch (:) = nan + allocate(this%retransn0_patch (begp:endp)) ; this%retransn0_patch (:) = nan + + allocate(this%leafn_SASUsave_patch (begp:endp)) ; this%leafn_SASUsave_patch (:) = nan + allocate(this%leafn_storage_SASUsave_patch (begp:endp)) ; this%leafn_storage_SASUsave_patch (:) = nan + allocate(this%leafn_xfer_SASUsave_patch (begp:endp)) ; this%leafn_xfer_SASUsave_patch (:) = nan + allocate(this%frootn_SASUsave_patch (begp:endp)) ; this%frootn_SASUsave_patch (:) = nan + allocate(this%frootn_storage_SASUsave_patch (begp:endp)) ; this%frootn_storage_SASUsave_patch (:) = nan + allocate(this%frootn_xfer_SASUsave_patch (begp:endp)) ; this%frootn_xfer_SASUsave_patch (:) = nan + allocate(this%livestemn_SASUsave_patch (begp:endp)) ; this%livestemn_SASUsave_patch (:) = nan + allocate(this%livestemn_storage_SASUsave_patch (begp:endp)) ; this%livestemn_storage_SASUsave_patch (:) = nan + allocate(this%livestemn_xfer_SASUsave_patch (begp:endp)) ; this%livestemn_xfer_SASUsave_patch (:) = nan + allocate(this%deadstemn_SASUsave_patch (begp:endp)) ; this%deadstemn_SASUsave_patch (:) = nan + allocate(this%deadstemn_storage_SASUsave_patch (begp:endp)) ; this%deadstemn_storage_SASUsave_patch (:) = nan + allocate(this%deadstemn_xfer_SASUsave_patch (begp:endp)) ; this%deadstemn_xfer_SASUsave_patch (:) = nan + allocate(this%livecrootn_SASUsave_patch (begp:endp)) ; this%livecrootn_SASUsave_patch (:) = nan + allocate(this%livecrootn_storage_SASUsave_patch (begp:endp)) ; this%livecrootn_storage_SASUsave_patch (:) = nan + allocate(this%livecrootn_xfer_SASUsave_patch (begp:endp)) ; this%livecrootn_xfer_SASUsave_patch (:) = nan + allocate(this%deadcrootn_SASUsave_patch (begp:endp)) ; this%deadcrootn_SASUsave_patch (:) = nan + allocate(this%deadcrootn_storage_SASUsave_patch (begp:endp)) ; this%deadcrootn_storage_SASUsave_patch (:) = nan + allocate(this%deadcrootn_xfer_SASUsave_patch (begp:endp)) ; this%deadcrootn_xfer_SASUsave_patch (:) = nan + allocate(this%grainn_SASUsave_patch (begp:endp)) ; this%grainn_SASUsave_patch (:) = nan + allocate(this%grainn_storage_SASUsave_patch (begp:endp)) ; this%grainn_storage_SASUsave_patch (:) = nan + + allocate(this%matrix_nalloc_leaf_acc_patch (begp:endp)) ; this%matrix_nalloc_leaf_acc_patch (:) = nan + allocate(this%matrix_nalloc_leafst_acc_patch (begp:endp)) ; this%matrix_nalloc_leafst_acc_patch (:) = nan + allocate(this%matrix_nalloc_froot_acc_patch (begp:endp)) ; this%matrix_nalloc_froot_acc_patch (:) = nan + allocate(this%matrix_nalloc_frootst_acc_patch (begp:endp)) ; this%matrix_nalloc_frootst_acc_patch (:) = nan + allocate(this%matrix_nalloc_livestem_acc_patch (begp:endp)) ; this%matrix_nalloc_livestem_acc_patch (:) = nan + allocate(this%matrix_nalloc_livestemst_acc_patch (begp:endp)) ; this%matrix_nalloc_livestemst_acc_patch (:) = nan + allocate(this%matrix_nalloc_deadstem_acc_patch (begp:endp)) ; this%matrix_nalloc_deadstem_acc_patch (:) = nan + allocate(this%matrix_nalloc_deadstemst_acc_patch (begp:endp)) ; this%matrix_nalloc_deadstemst_acc_patch (:) = nan + allocate(this%matrix_nalloc_livecroot_acc_patch (begp:endp)) ; this%matrix_nalloc_livecroot_acc_patch (:) = nan + allocate(this%matrix_nalloc_livecrootst_acc_patch (begp:endp)) ; this%matrix_nalloc_livecrootst_acc_patch (:) = nan + allocate(this%matrix_nalloc_deadcroot_acc_patch (begp:endp)) ; this%matrix_nalloc_deadcroot_acc_patch (:) = nan + allocate(this%matrix_nalloc_deadcrootst_acc_patch (begp:endp)) ; this%matrix_nalloc_deadcrootst_acc_patch (:) = nan + allocate(this%matrix_nalloc_grain_acc_patch (begp:endp)) ; this%matrix_nalloc_grain_acc_patch (:) = nan + allocate(this%matrix_nalloc_grainst_acc_patch (begp:endp)) ; this%matrix_nalloc_grainst_acc_patch (:) = nan + + allocate(this%matrix_ntransfer_leafst_to_leafxf_acc_patch (begp:endp)) ; this%matrix_ntransfer_leafst_to_leafxf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_leafxf_to_leaf_acc_patch (begp:endp)) ; this%matrix_ntransfer_leafxf_to_leaf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_frootst_to_frootxf_acc_patch (begp:endp)) ; this%matrix_ntransfer_frootst_to_frootxf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_frootxf_to_froot_acc_patch (begp:endp)) ; this%matrix_ntransfer_frootxf_to_froot_acc_patch (:) = nan + allocate(this%matrix_ntransfer_livestemst_to_livestemxf_acc_patch (begp:endp)) ; this%matrix_ntransfer_livestemst_to_livestemxf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_livestemxf_to_livestem_acc_patch (begp:endp)) ; this%matrix_ntransfer_livestemxf_to_livestem_acc_patch (:) = nan + allocate(this%matrix_ntransfer_deadstemst_to_deadstemxf_acc_patch (begp:endp)) ; this%matrix_ntransfer_deadstemst_to_deadstemxf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_deadstemxf_to_deadstem_acc_patch (begp:endp)) ; this%matrix_ntransfer_deadstemxf_to_deadstem_acc_patch (:) = nan + allocate(this%matrix_ntransfer_livecrootst_to_livecrootxf_acc_patch (begp:endp)) ; this%matrix_ntransfer_livecrootst_to_livecrootxf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_livecrootxf_to_livecroot_acc_patch (begp:endp)) ; this%matrix_ntransfer_livecrootxf_to_livecroot_acc_patch (:) = nan + allocate(this%matrix_ntransfer_deadcrootst_to_deadcrootxf_acc_patch (begp:endp)) ; this%matrix_ntransfer_deadcrootst_to_deadcrootxf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_deadcrootxf_to_deadcroot_acc_patch (begp:endp)) ; this%matrix_ntransfer_deadcrootxf_to_deadcroot_acc_patch (:) = nan + allocate(this%matrix_ntransfer_grainst_to_grainxf_acc_patch (begp:endp)) ; this%matrix_ntransfer_grainst_to_grainxf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_grainxf_to_grain_acc_patch (begp:endp)) ; this%matrix_ntransfer_grainxf_to_grain_acc_patch (:) = nan + allocate(this%matrix_ntransfer_livestem_to_deadstem_acc_patch (begp:endp)) ; this%matrix_ntransfer_livestem_to_deadstem_acc_patch (:) = nan + allocate(this%matrix_ntransfer_livecroot_to_deadcroot_acc_patch (begp:endp)) ; this%matrix_ntransfer_livecroot_to_deadcroot_acc_patch (:) = nan + + allocate(this%matrix_ntransfer_retransn_to_leaf_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_leaf_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_leafst_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_leafst_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_froot_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_froot_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_frootst_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_frootst_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_livestem_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_livestem_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_livestemst_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_livestemst_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_deadstem_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_deadstem_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_deadstemst_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_deadstemst_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_livecroot_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_livecroot_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_livecrootst_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_livecrootst_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_deadcroot_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_deadcroot_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_deadcrootst_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_deadcrootst_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_grain_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_grain_acc_patch (:) = nan + allocate(this%matrix_ntransfer_retransn_to_grainst_acc_patch (begp:endp)) ; this%matrix_ntransfer_retransn_to_grainst_acc_patch (:) = nan + + allocate(this%matrix_ntransfer_leaf_to_retransn_acc_patch (begp:endp)) ; this%matrix_ntransfer_leaf_to_retransn_acc_patch (:) = nan + allocate(this%matrix_ntransfer_froot_to_retransn_acc_patch (begp:endp)) ; this%matrix_ntransfer_froot_to_retransn_acc_patch (:) = nan + allocate(this%matrix_ntransfer_livestem_to_retransn_acc_patch (begp:endp)) ; this%matrix_ntransfer_livestem_to_retransn_acc_patch (:) = nan + allocate(this%matrix_ntransfer_livecroot_to_retransn_acc_patch (begp:endp)) ; this%matrix_ntransfer_livecroot_to_retransn_acc_patch (:) = nan + + allocate(this%matrix_nturnover_leaf_acc_patch (begp:endp)) ; this%matrix_nturnover_leaf_acc_patch (:) = nan + allocate(this%matrix_nturnover_leafst_acc_patch (begp:endp)) ; this%matrix_nturnover_leafst_acc_patch (:) = nan + allocate(this%matrix_nturnover_leafxf_acc_patch (begp:endp)) ; this%matrix_nturnover_leafxf_acc_patch (:) = nan + allocate(this%matrix_nturnover_froot_acc_patch (begp:endp)) ; this%matrix_nturnover_froot_acc_patch (:) = nan + allocate(this%matrix_nturnover_frootst_acc_patch (begp:endp)) ; this%matrix_nturnover_frootst_acc_patch (:) = nan + allocate(this%matrix_nturnover_frootxf_acc_patch (begp:endp)) ; this%matrix_nturnover_frootxf_acc_patch (:) = nan + allocate(this%matrix_nturnover_livestem_acc_patch (begp:endp)) ; this%matrix_nturnover_livestem_acc_patch (:) = nan + allocate(this%matrix_nturnover_livestemst_acc_patch (begp:endp)) ; this%matrix_nturnover_livestemst_acc_patch (:) = nan + allocate(this%matrix_nturnover_livestemxf_acc_patch (begp:endp)) ; this%matrix_nturnover_livestemxf_acc_patch (:) = nan + allocate(this%matrix_nturnover_deadstem_acc_patch (begp:endp)) ; this%matrix_nturnover_deadstem_acc_patch (:) = nan + allocate(this%matrix_nturnover_deadstemst_acc_patch (begp:endp)) ; this%matrix_nturnover_deadstemst_acc_patch (:) = nan + allocate(this%matrix_nturnover_deadstemxf_acc_patch (begp:endp)) ; this%matrix_nturnover_deadstemxf_acc_patch (:) = nan + allocate(this%matrix_nturnover_livecroot_acc_patch (begp:endp)) ; this%matrix_nturnover_livecroot_acc_patch (:) = nan + allocate(this%matrix_nturnover_livecrootst_acc_patch (begp:endp)) ; this%matrix_nturnover_livecrootst_acc_patch (:) = nan + allocate(this%matrix_nturnover_livecrootxf_acc_patch (begp:endp)) ; this%matrix_nturnover_livecrootxf_acc_patch (:) = nan + allocate(this%matrix_nturnover_deadcroot_acc_patch (begp:endp)) ; this%matrix_nturnover_deadcroot_acc_patch (:) = nan + allocate(this%matrix_nturnover_deadcrootst_acc_patch (begp:endp)) ; this%matrix_nturnover_deadcrootst_acc_patch (:) = nan + allocate(this%matrix_nturnover_deadcrootxf_acc_patch (begp:endp)) ; this%matrix_nturnover_deadcrootxf_acc_patch (:) = nan + allocate(this%matrix_nturnover_grain_acc_patch (begp:endp)) ; this%matrix_nturnover_grain_acc_patch (:) = nan + allocate(this%matrix_nturnover_grainst_acc_patch (begp:endp)) ; this%matrix_nturnover_grainst_acc_patch (:) = nan + allocate(this%matrix_nturnover_grainxf_acc_patch (begp:endp)) ; this%matrix_nturnover_grainxf_acc_patch (:) = nan + allocate(this%matrix_nturnover_retransn_acc_patch (begp:endp)) ; this%matrix_nturnover_retransn_acc_patch (:) = nan + end if + + ! initialize arrays with values from restarts + + n = 0 + np = 0 + do nc = 1,nch ! catchment tile loop + + this%seedn_grc(nc) = 0 + + do nz = 1,NUM_ZON ! CN zone loop + n = n + 1 + + this%seedn_grc(nc) = this%seedn_grc(nc) + cncol(nc,nz,23)*CN_zone_weight(nz) + this%totn_col(n) = cncol(nc,nz,29) + + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,NUM_VEG ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + + this%deadcrootn_patch (np) = cnpft(nc,nz,nv, 48) + this%deadcrootn_storage_patch (np) = cnpft(nc,nz,nv, 49) + this%deadcrootn_xfer_patch (np) = cnpft(nc,nz,nv, 50) + this%deadstemn_patch (np) = cnpft(nc,nz,nv, 51) + this%deadstemn_storage_patch (np) = cnpft(nc,nz,nv, 52) + this%deadstemn_xfer_patch (np) = cnpft(nc,nz,nv, 53) + this%frootn_patch (np) = cnpft(nc,nz,nv, 54) + this%frootn_storage_patch (np) = cnpft(nc,nz,nv, 55) + this%frootn_xfer_patch (np) = cnpft(nc,nz,nv, 56) + this%leafn_patch (np) = cnpft(nc,nz,nv, 57) + this%leafn_storage_patch (np) = cnpft(nc,nz,nv, 58) + this%leafn_xfer_patch (np) = cnpft(nc,nz,nv, 59) + this%livecrootn_patch (np) = cnpft(nc,nz,nv, 60) + this%livecrootn_storage_patch (np) = cnpft(nc,nz,nv, 61) + this%livecrootn_xfer_patch (np) = cnpft(nc,nz,nv, 62) + this%livestemn_patch (np) = cnpft(nc,nz,nv, 63) + this%livestemn_storage_patch (np) = cnpft(nc,nz,nv, 64) + this%livestemn_xfer_patch (np) = cnpft(nc,nz,nv, 65) + this%npool_patch (np) = cncol(nc,nz,nv, 66) + this%ntrunc_patch (np) = cncol(nc,nz,nv, 67) + this%retransn_patch (np) = cncol(nc,nz,nv, 68) + + end if + end do !nv + end do !p + end do !nz + end do ! nc + + end subroutine init_cnveg_nitrogenstate_type + +end module CNCLM_VegNitrogenStateType + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 new file mode 100644 index 000000000..8b8dfb403 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -0,0 +1,134 @@ +module CNCLM_WaterDiagnosticBulkType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varpar , only : nlevgrnd, nlevsno, nlevcan + use clm_varcon , only : spval + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_waterdiagnosticbulk_type + + ! + type, public :: waterdiagnosticbulk_type + real(r8), pointer :: h2osno_total_col (:) ! col total snow water (mm H2O) + real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m) + real(r8), pointer :: snow_5day_col (:) ! col snow height 5 day avg + real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m) + real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics + real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] + + real(r8), pointer :: h2osoi_liq_tot_col (:) ! vertically summed col liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: h2osoi_ice_tot_col (:) ! vertically summed col ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: air_vol_col (:,:) ! col air filled porosity + real(r8), pointer :: h2osoi_liqvol_col (:,:) ! col volumetric liquid water content (v/v) + real(r8), pointer :: swe_old_col (:,:) ! col initial snow water + + real(r8), pointer :: snw_rds_col (:,:) ! col snow grain radius (col,lyr) [m^-6, microns] + real(r8), pointer :: snw_rds_top_col (:) ! col snow grain radius (top layer) [m^-6, microns] + real(r8), pointer :: h2osno_top_col (:) ! col top-layer mass of snow [kg] + real(r8), pointer :: sno_liq_top_col (:) ! col snow liquid water fraction (mass), top layer [fraction] + + real(r8), pointer :: iwue_ln_patch (:) ! patch intrinsic water use efficiency near local noon (umolCO2/molH2O) + real(r8), pointer :: vpd_ref2m_patch (:) ! patch 2 m height surface vapor pressure deficit (Pa) + real(r8), pointer :: rh_ref2m_patch (:) ! patch 2 m height surface relative humidity (%) + real(r8), pointer :: rh_ref2m_r_patch (:) ! patch 2 m height surface relative humidity - rural (%) + real(r8), pointer :: rh_ref2m_u_patch (:) ! patch 2 m height surface relative humidity - urban (%) + real(r8), pointer :: rh_af_patch (:) ! patch fractional humidity of canopy air (dimensionless) ! private + real(r8), pointer :: rh10_af_patch (:) ! 10-day mean patch fractional humidity of canopy air (dimensionless) + real(r8), pointer :: dqgdT_col (:) ! col d(qg)/dT + + ! Fractions + real(r8), pointer :: frac_sno_col (:) ! col fraction of ground covered by snow (0 to 1) + real(r8), pointer :: frac_sno_eff_col (:) ! col fraction of ground covered by snow (0 to 1) (note: this can be 1 even if there is no snow, but should be ignored in the no-snow case) + real(r8), pointer :: frac_iceold_col (:,:) ! col fraction of ice relative to the tot water (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: frac_h2osfc_col (:) ! col fractional area with surface water greater than zero + real(r8), pointer :: frac_h2osfc_nosnow_col (:) ! col fractional area with surface water greater than zero (if no snow present) + real(r8), pointer :: wf_col (:) ! col soil water as frac. of whc for top 0.05 m (0-1) + real(r8), pointer :: wf2_col (:) ! col soil water as frac. of whc for top 0.17 m (0-1) + real(r8), pointer :: fwet_patch (:) ! patch canopy fraction that is wet (0 to 1) + real(r8), pointer :: fcansno_patch (:) ! patch canopy fraction that is snow covered (0 to 1) + real(r8), pointer :: fdry_patch (:) ! patch canopy fraction of foliage that is green and dry [-] (new) + + ! Summed fluxes + real(r8), pointer :: qflx_prec_intr_patch (:) ! patch interception of precipitation (mm H2O/s) + real(r8), pointer :: qflx_prec_grnd_col (:) ! col water onto ground including canopy runoff (mm H2O/s) + +end type waterdiagnosticbulk_type +type(waterdiagnosticbulk_type), public, target, save :: waterdiagnosticbulk_inst + +contains + +!----------------------------------------------- + subroutine init_waterdiagnosticbulk_type(bounds, this) + + ! !DESCRIPTION: + ! Initialize CTSM type for water diagnostic variables that just apply to bulk water and are needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + !INPUT + type(bounds_type), intent(in) :: bounds + type(waterdiagnosticbulk_type), intent(inout):: this + + !LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + !---------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + begl = bounds%begl ; endl = bounds%endl + begg = bounds%begg ; endg = bounds%endg + + + allocate(this%h2osno_total_col (begc:endc)) ; this%h2osno_total_col (:) = nan + allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan + allocate(this%snow_5day_col (begc:endc)) ; this%snow_5day_col (:) = nan + allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan + allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan + allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan + allocate(this%air_vol_col (begc:endc, 1:nlevgrnd)) ; this%air_vol_col (:,:) = nan + allocate(this%h2osoi_liqvol_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liqvol_col (:,:) = nan + allocate(this%h2osoi_ice_tot_col (begc:endc)) ; this%h2osoi_ice_tot_col (:) = nan + allocate(this%h2osoi_liq_tot_col (begc:endc)) ; this%h2osoi_liq_tot_col (:) = nan + allocate(this%swe_old_col (begc:endc,-nlevsno+1:0)) ; this%swe_old_col (:,:) = nan + + allocate(this%snw_rds_col (begc:endc,-nlevsno+1:0)) ; this%snw_rds_col (:,:) = nan + allocate(this%snw_rds_top_col (begc:endc)) ; this%snw_rds_top_col (:) = nan + allocate(this%h2osno_top_col (begc:endc)) ; this%h2osno_top_col (:) = nan + allocate(this%sno_liq_top_col (begc:endc)) ; this%sno_liq_top_col (:) = nan + + allocate(this%dqgdT_col (begc:endc)) ; this%dqgdT_col (:) = nan + allocate(this%iwue_ln_patch (begp:endp)) ; this%iwue_ln_patch (:) = nan + allocate(this%vpd_ref2m_patch (begp:endp)) ; this%vpd_ref2m_patch (:) = nan + allocate(this%rh_ref2m_patch (begp:endp)) ; this%rh_ref2m_patch (:) = nan + allocate(this%rh_ref2m_u_patch (begp:endp)) ; this%rh_ref2m_u_patch (:) = nan + allocate(this%rh_ref2m_r_patch (begp:endp)) ; this%rh_ref2m_r_patch (:) = nan + allocate(this%rh_af_patch (begp:endp)) ; this%rh_af_patch (:) = nan + allocate(this%rh10_af_patch (begp:endp)) ; this%rh10_af_patch (:) = spval + + allocate(this%frac_sno_col (begc:endc)) ; this%frac_sno_col (:) = nan + allocate(this%frac_sno_eff_col (begc:endc)) ; this%frac_sno_eff_col (:) = nan + allocate(this%frac_iceold_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%frac_iceold_col (:,:) = nan + allocate(this%frac_h2osfc_col (begc:endc)) ; this%frac_h2osfc_col (:) = nan + allocate(this%frac_h2osfc_nosnow_col (begc:endc)) ; this%frac_h2osfc_nosnow_col (:) = nan + allocate(this%wf_col (begc:endc)) ; this%wf_col (:) = nan + allocate(this%wf2_col (begc:endc)) ; this%wf2_col (:) = nan + allocate(this%fwet_patch (begp:endp)) ; this%fwet_patch (:) = nan + allocate(this%fcansno_patch (begp:endp)) ; this%fcansno_patch (:) = nan + allocate(this%fdry_patch (begp:endp)) ; this%fdry_patch (:) = nan + allocate(this%qflx_prec_intr_patch (begp:endp)) ; this%qflx_prec_intr_patch (:) = nan + allocate(this%qflx_prec_grnd_col (begc:endc)) ; this%qflx_prec_grnd_col (:) = nan + + end subroutine init_waterdiagnosticbulk_type + +end module CNCLM_WaterDiagnosticBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 new file mode 100644 index 000000000..3ca03c0a1 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -0,0 +1,105 @@ +module CNCLM_WaterFluxBulkType + + use MAPL_ConstantsMod , ONLY : r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : nlevsno, nlevsoi + use clm_varcon , only : spval + use MAPL_ExceptionHandling + use CNCLM_WaterFluxType , only : waterflux_type + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + type, extends(waterflux_type), public :: waterfluxbulk_type + ! water fluxes are in units or mm/s + + real(r8), pointer :: qflx_phs_neg_col (:) ! col sum of negative hydraulic redistribution fluxes (mm H2O/s) [+] + + real(r8), pointer :: qflx_snowindunload_patch (:) ! patch canopy snow wind unloading (mm H2O /s) + real(r8), pointer :: qflx_snotempunload_patch (:) ! patch canopy snow temp unloading (mm H2O /s) + + real(r8), pointer :: qflx_ev_snow_patch (:) ! patch evaporation heat flux from snow (mm H2O/s) [+ to atm] + real(r8), pointer :: qflx_ev_snow_col (:) ! col evaporation heat flux from snow (mm H2O/s) [+ to atm] + real(r8), pointer :: qflx_ev_soil_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm] + real(r8), pointer :: qflx_ev_soil_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm] + real(r8), pointer :: qflx_ev_h2osfc_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm] + real(r8), pointer :: qflx_ev_h2osfc_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm] + + real(r8), pointer :: qflx_adv_col (:,:) ! col advective flux across different soil layer interfaces [mm H2O/s] [+ downward] + real(r8), pointer :: qflx_rootsoi_col (:,:) ! col root and soil water exchange [mm H2O/s] [+ into root] + real(r8), pointer :: qflx_hydr_redist_patch (:) ! patch hydraulic redistribution [mm H2O/s] + real(r8), pointer :: qflx_sat_excess_surf_col (:) ! col surface runoff due to saturated surface (mm H2O /s) + real(r8), pointer :: qflx_infl_excess_col (:) ! col infiltration excess runoff (mm H2O /s) + real(r8), pointer :: qflx_infl_excess_surf_col(:) ! col surface runoff due to infiltration excess (mm H2O /s) + real(r8), pointer :: qflx_h2osfc_surf_col (:) ! col surface water runoff (mm H2O /s) + real(r8), pointer :: qflx_in_soil_col (:) ! col surface input to soil (mm/s) + real(r8), pointer :: qflx_in_soil_limited_col (:) ! col surface input to soil, limited by max infiltration rate (mm/s) + real(r8), pointer :: qflx_h2osfc_drain_col (:) ! col bottom drainage from h2osfc (mm/s) + real(r8), pointer :: qflx_top_soil_to_h2osfc_col(:) ! col portion of qflx_top_soil going to h2osfc, minus evaporation (mm/s) + real(r8), pointer :: qflx_in_h2osfc_col(:) ! col total surface input to h2osfc + real(r8), pointer :: qflx_deficit_col (:) ! col water deficit to keep non-negative liquid water content (mm H2O) + real(r8), pointer :: qflx_snomelt_lyr_col (:,:) ! col snow melt in each layer (mm H2O /s) + real(r8), pointer :: qflx_drain_vr_col (:,:) ! col liquid water losted as drainage (m /time step) + + ! ET accumulation + real(r8), pointer :: AnnEt (:) ! Annual average ET flux mmH20/s + + end type waterfluxbulk_type + type(waterfluxbulk_type), public, target, save :: waterfluxbulk_inst + +contains + +!--------------------------------------------- + subroutine init_waterfluxbulk_type(bounds, this) + + ! !DESCRIPTION: + ! Initialize CTSM type for water flux bulk variables that just apply to bulk water and are needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(waterfluxbulk_type), intent(inout):: this + + !LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + + allocate(this%qflx_snowindunload_patch (begp:endp)) ; this%qflx_snowindunload_patch (:) = nan + allocate(this%qflx_snotempunload_patch (begp:endp)) ; this%qflx_snotempunload_patch (:) = nan + allocate(this%qflx_hydr_redist_patch (begp:endp)) ; this%qflx_hydr_redist_patch (:) = nan + allocate(this%qflx_phs_neg_col (begc:endc)) ; this%qflx_phs_neg_col (:) = nan + + allocate( this%qflx_ev_snow_patch (begp:endp)) ; this%qflx_ev_snow_patch (:) = nan + allocate( this%qflx_ev_snow_col (begc:endc)) ; this%qflx_ev_snow_col (:) = nan + allocate( this%qflx_ev_soil_patch (begp:endp)) ; this%qflx_ev_soil_patch (:) = nan + allocate( this%qflx_ev_soil_col (begc:endc)) ; this%qflx_ev_soil_col (:) = nan + allocate( this%qflx_ev_h2osfc_patch (begp:endp)) ; this%qflx_ev_h2osfc_patch (:) = nan + allocate( this%qflx_ev_h2osfc_col (begc:endc)) ; this%qflx_ev_h2osfc_col (:) = nan + + allocate(this%qflx_drain_vr_col (begc:endc,1:nlevsoi)) ; this%qflx_drain_vr_col (:,:) = nan + allocate(this%qflx_adv_col (begc:endc,0:nlevsoi)) ; this%qflx_adv_col (:,:) = nan + allocate(this%qflx_rootsoi_col (begc:endc,1:nlevsoi)) ; this%qflx_rootsoi_col (:,:) = nan + allocate(this%qflx_sat_excess_surf_col (begc:endc)) ; this%qflx_sat_excess_surf_col (:) = nan + allocate(this%qflx_infl_excess_col (begc:endc)) ; this%qflx_infl_excess_col (:) = nan + allocate(this%qflx_in_soil_col (begc:endc)) ; this%qflx_in_soil_col (:) = nan + allocate(this%qflx_in_soil_limited_col (begc:endc)) ; this%qflx_in_soil_limited_col (:) = nan + allocate(this%qflx_h2osfc_drain_col (begc:endc)) ; this%qflx_h2osfc_drain_col (:) = nan + allocate(this%qflx_top_soil_to_h2osfc_col(begc:endc)) ; this%qflx_top_soil_to_h2osfc_col(:) = nan + allocate(this%qflx_in_h2osfc_col (begc:endc)) ; this%qflx_in_h2osfc_col(:) = nan + allocate(this%qflx_infl_excess_surf_col(begc:endc)) ; this%qflx_infl_excess_surf_col(:) = nan + allocate(this%qflx_h2osfc_surf_col (begc:endc)) ; this%qflx_h2osfc_surf_col (:) = nan + allocate(this%qflx_snomelt_lyr_col (begc:endc,-nlevsno+1:0)) ; this%qflx_snomelt_lyr_col (:,:) = nan + allocate(this%qflx_deficit_col (begc:endc)) ; this%qflx_deficit_col (:) = nan + allocate(this%AnnET (begc:endc)) ; this%AnnET (:) = nan + + end subroutine init_waterfluxbulk_type +end module CNCLM_WaterFluxBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 new file mode 100644 index 000000000..d9315bb46 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -0,0 +1,180 @@ +module CNCLM_WaterFluxType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : nlevsno + use clm_varcon , only : spval + use netcdf + use MAPL_ExceptionHandling + use CNCLM_decompMod , only : bounds_type + + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_waterflux_type + + ! + type, public :: waterflux_type + + ! water fluxes are in units or mm/s + + real(r8), pointer :: qflx_through_snow_patch (:) ! patch canopy throughfall of snow (mm H2O/s) + real(r8), pointer :: qflx_through_liq_patch (:) ! patch canopy throughfal of liquid (rain+irrigation) (mm H2O/s) + real(r8), pointer :: qflx_intercepted_snow_patch(:) ! patch canopy interception of snow (mm H2O/s) + real(r8), pointer :: qflx_intercepted_liq_patch(:) ! patch canopy interception of liquid (rain+irrigation) (mm H2O/s) + real(r8), pointer :: qflx_snocanfall_patch(:) ! patch rate of excess canopy snow falling off canopy (mm H2O/s) + real(r8), pointer :: qflx_liqcanfall_patch(:) ! patch rate of excess canopy liquid falling off canopy (mm H2O/s) + real(r8), pointer :: qflx_snow_unload_patch(:) ! patch rate of canopy snow unloading (mm H2O/s) + real(r8), pointer :: qflx_liq_grnd_col (:) ! col liquid (rain+irrigation) on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snow_grnd_col (:) ! col snow on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_rain_plus_snomelt_col(:) ! col rain plus snow melt falling on the soil (mm/s) + real(r8), pointer :: qflx_solidevap_from_top_layer_patch(:) ! patch rate of ice evaporated from top soil or snow layer (sublimation) (mm H2O /s) [+] + real(r8), pointer :: qflx_solidevap_from_top_layer_col(:) ! col rate of ice evaporated from top soil or snow layer (sublimation) (mm H2O /s) [+] + real(r8), pointer :: qflx_evap_soi_patch (:) ! patch soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_soi_col (:) ! col soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_veg_patch (:) ! patch vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_veg_col (:) ! col vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_can_patch (:) ! patch evaporation from leaves and stems (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_can_col (:) ! col evaporation from leaves and stems (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_tot_patch (:) ! patch pft_qflx_evap_soi + pft_qflx_evap_veg + qflx_tran_veg + real(r8), pointer :: qflx_evap_tot_col (:) ! col col_qflx_evap_soi + col_qflx_evap_veg + qflx_tran_veg + real(r8), pointer :: qflx_liqevap_from_top_layer_patch(:) ! patch rate of liquid water evaporated from top soil or snow layer (mm H2O/s) [+] + real(r8), pointer :: qflx_liqevap_from_top_layer_col(:) ! col rate of liquid water evaporated from top soil or snow layer (mm H2O/s) [+] + + ! In the snow capping parametrization excess mass above h2osno_max is removed. A breakdown of mass into liquid + ! and solid fluxes is done, these are represented by qflx_snwcp_liq_col and qflx_snwcp_ice_col. + real(r8), pointer :: qflx_snwcp_liq_col (:) ! col excess liquid h2o due to snow capping (outgoing) (mm H2O /s) + real(r8), pointer :: qflx_snwcp_ice_col (:) ! col excess solid h2o due to snow capping (outgoing) (mm H2O /s) + real(r8), pointer :: qflx_snwcp_discarded_liq_col(:) ! col excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) + real(r8), pointer :: qflx_snwcp_discarded_ice_col(:) ! col excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) + real(r8), pointer :: qflx_glcice_col(:) ! col net flux of new glacial ice (growth - melt) (mm H2O/s), passed to GLC; only valid inside the do_smb_c filter + real(r8), pointer :: qflx_glcice_frz_col (:) ! col ice growth (positive definite) (mm H2O/s); only valid inside the do_smb_c filter + real(r8), pointer :: qflx_glcice_melt_col(:) ! col ice melt (positive definite) (mm H2O/s); only valid inside the do_smb_c filter + real(r8), pointer :: qflx_glcice_dyn_water_flux_col(:) ! col water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system); valid for all columns + + real(r8), pointer :: qflx_tran_veg_patch (:) ! patch vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_tran_veg_col (:) ! col vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_soliddew_to_top_layer_patch(:) ! patch rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] + real(r8), pointer :: qflx_soliddew_to_top_layer_col(:) ! col rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] (+ = to atm); usually eflx_bot >= 0) + real(r8), pointer :: qflx_liqdew_to_top_layer_patch(:) ! patch rate of liquid water deposited on top soil or snow layer (dew) (mm H2O /s) [+] + real(r8), pointer :: qflx_liqdew_to_top_layer_col(:) ! col rate of liquid water deposited on top soil or snow layer (dew) (mm H2O /s) [+] + + real(r8), pointer :: qflx_infl_col (:) ! col infiltration (mm H2O /s) + real(r8), pointer :: qflx_surf_col (:) ! col total surface runoff (mm H2O /s) + real(r8), pointer :: qflx_drain_col (:) ! col sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_drain_perched_col (:) ! col sub-surface runoff from perched wt (mm H2O /s) + real(r8), pointer :: qflx_top_soil_col (:) ! col net water input into soil from top (mm/s) + real(r8), pointer :: qflx_floodc_col (:) ! col flood water flux at column level + real(r8), pointer :: qflx_sl_top_soil_col (:) ! col liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) + real(r8), pointer :: qflx_snomelt_col (:) ! col snow melt (mm H2O /s) + real(r8), pointer :: qflx_qrgwl_col (:) ! col qflx_surf at glaciers, wetlands, lakes + real(r8), pointer :: qflx_runoff_col (:) ! col total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: qflx_runoff_r_col (:) ! col Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: qflx_runoff_u_col (:) ! col urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) + real(r8), pointer :: qflx_rsub_sat_col (:) ! col soil saturation excess [mm/s] + real(r8), pointer :: qflx_snofrz_lyr_col (:,:) ! col snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] + real(r8), pointer :: qflx_snofrz_col (:) ! col column-integrated snow freezing rate (positive definite) (col) [kg m-2 s-1] + real(r8), pointer :: qflx_snow_drain_col (:) ! col drainage from snow pack + real(r8), pointer :: qflx_ice_runoff_snwcp_col(:) ! col solid runoff from snow capping (mm H2O /s) + real(r8), pointer :: qflx_ice_runoff_xs_col (:) ! col solid runoff from excess ice in soil (mm H2O /s) + + real(r8), pointer :: qflx_h2osfc_to_ice_col (:) ! col conversion of h2osfc to ice + real(r8), pointer :: qflx_snow_h2osfc_col (:) ! col snow falling on surface water + real(r8), pointer :: qflx_too_small_h2osfc_to_soil_col(:) ! col h2osfc transferred to soil if h2osfc is below some threshold (mm H2O /s) + real(r8), pointer :: qflx_snow_percolation_col(:,:) ! col liquid percolation out of the bottom of snow layer j (mm H2O /s) + + ! Dynamic land cover change + real(r8), pointer :: qflx_liq_dynbal_grc (:) ! grc liq dynamic land cover change conversion runoff flux + real(r8), pointer :: qflx_ice_dynbal_grc (:) ! grc ice dynamic land cover change conversion runoff flux + + real(r8), pointer :: qflx_sfc_irrig_col (:) ! col surface irrigation flux (mm H2O/s) [+] + real(r8), pointer :: qflx_gw_uncon_irrig_col (:) ! col unconfined groundwater irrigation flux (mm H2O/s) + real(r8), pointer :: qflx_gw_uncon_irrig_lyr_col(:,:) ! col unconfined groundwater irrigation flux, separated by layer (mm H2O/s) + real(r8), pointer :: qflx_gw_con_irrig_col (:) ! col confined groundwater irrigation flux (mm H2O/s) + real(r8), pointer :: qflx_irrig_drip_patch (:) ! patch drip irrigation + real(r8), pointer :: qflx_irrig_sprinkler_patch(:) ! patch sprinkler irrigation + + ! Objects that help convert once-per-year dynamic land cover changes into fluxes + ! that are dribbled throughout the year + type(annual_flux_dribbler_type) :: qflx_liq_dynbal_dribbler + type(annual_flux_dribbler_type) :: qflx_ice_dynbal_dribbler + + end type waterflux_type + type(waterflux_type), public, target, save :: waterflux_inst + +contains + +!--------------------------------------------- + subroutine init_waterflux_type(bounds, this) + + ! !DESCRIPTION: + ! Initialize CTSM type for water flux variables that just apply to bulk water and are needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(waterflux_type), intent(inout):: this + + !LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !-------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + begg = bounds%begg ; endg = bounds%endg + + this%qflx_through_liq_patch(begp:endp) = spval + this%qflx_through_snow_patch(begp:endp) = spval + this%qflx_liqcanfall_patch(begp:endp) = spval + this%qflx_snocanfall_patch(begp:endp) = spval + this%qflx_snow_unload_patch(begp:endp) = spval + this%qflx_top_soil_col(begc:endc) = spval + this%qflx_infl_col(begc:endc) = spval + this%qflx_surf_col(begc:endc) = spval + this%qflx_qrgwl_col(begc:endc) = spval + this%qflx_drain_col(begc:endc) = spval + this%qflx_drain_perched_col(begc:endc) = spval + this%qflx_liq_dynbal_grc(begg:endg) = spval + this%qflx_ice_dynbal_grc(begg:endg) = spval + this%qflx_runoff_col(begc:endc) = spval + this%qflx_runoff_u_col(begc:endc) = spval + this%qflx_runoff_r_col(begc:endc) = spval + this%qflx_snomelt_col(begc:endc) = spval + this%qflx_snofrz_col(begc:endc) = spval + this%qflx_snofrz_lyr_col(begc:endc,-nlevsno+1:0) = spval + this%qflx_snow_drain_col(begc:endc) = spval + this%qflx_evap_soi_patch(begp:endp) = spval + this%qflx_evap_can_patch(begp:endp) = spval + this%qflx_tran_veg_patch(begp:endp) = spval + this%qflx_snwcp_liq_col(begc:endc) = spval + this%qflx_snwcp_ice_col(begc:endc) = spval + this%qflx_glcice_col(begc:endc) = spval + this%qflx_glcice_frz_col(begc:endc) = spval + this%qflx_glcice_melt_col(begc:endc) = spval + this%qflx_liq_grnd_col(begc:endc) = spval + this%qflx_snow_grnd_col(begc:endc) = spval + this%qflx_liqevap_from_top_layer_patch(begp:endp) = spval + this%qflx_evap_veg_patch(begp:endp) = spval + this%qflx_evap_tot_patch(begp:endp) = spval + this%qflx_liqdew_to_top_layer_patch(begp:endp) = spval + this%qflx_solidevap_from_top_layer_patch(begp:endp) = spval + this%qflx_soliddew_to_top_layer_patch(begp:endp) = spval + this%qflx_rsub_sat_col(begc:endc) = spval + this%qflx_h2osfc_to_ice_col(begc:endc) = spval + this%qflx_sfc_irrig_col(begc:endc) = spval + this%qflx_gw_uncon_irrig_col(begc:endc) = spval + this%qflx_gw_con_irrig_col(begc:endc) = spval + this%qflx_irrig_drip_patch(begp:endp) = spval + this%qflx_irrig_sprinkler_patch(begp:endp) = spval + + end subroutine init_waterflux_type + +end module CNCLM_WaterFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 new file mode 100644 index 000000000..87316e00a --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 @@ -0,0 +1,145 @@ +module CNCLM_atm2lndType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varpar , only : numrad + use clm_varctl , only : use_fates, use_luna + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_atm2lnd_type + + ! + type, public :: atm2lnd_type + + ! atm->lnd not downscaled + real(r8), pointer :: forc_u_grc (:) => null() ! atm wind speed, east direction (m/s) + real(r8), pointer :: forc_v_grc (:) => null() ! atm wind speed, north direction (m/s) + real(r8), pointer :: forc_wind_grc (:) => null() ! atmospheric wind speed + real(r8), pointer :: forc_hgt_grc (:) => null() ! atmospheric reference height (m) + real(r8), pointer :: forc_topo_grc (:) => null() ! atmospheric surface height (m) + real(r8), pointer :: forc_hgt_u_grc (:) => null() ! obs height of wind [m] (new) + real(r8), pointer :: forc_hgt_t_grc (:) => null() ! obs height of temperature [m] (new) + real(r8), pointer :: forc_hgt_q_grc (:) => null() ! obs height of humidity [m] (new) + real(r8), pointer :: forc_vp_grc (:) => null() ! atmospheric vapor pressure (Pa) + real(r8), pointer :: forc_pco2_grc (:) => null() ! CO2 partial pressure (Pa) + real(r8), pointer :: forc_pco2_240_patch (:) => null() ! 10-day mean CO2 partial pressure (Pa) + real(r8), pointer :: forc_solad_grc (:,:) => null() ! direct beam radiation (numrad) (vis=forc_sols , nir=forc_soll ) + real(r8), pointer :: forc_solai_grc (:,:) => null() ! diffuse radiation (numrad) (vis=forc_solsd, nir=forc_solld) + real(r8), pointer :: forc_solar_grc (:) => null() ! incident solar radiation + real(r8), pointer :: forc_ndep_grc (:) => null() ! nitrogen deposition rate (gN/m2/s) + real(r8), pointer :: forc_pc13o2_grc (:) => null() ! C13O2 partial pressure (Pa) + real(r8), pointer :: forc_po2_grc (:) => null() ! O2 partial pressure (Pa) + real(r8), pointer :: forc_po2_240_patch (:) => null() ! 10-day mean O2 partial pressure (Pa) + real(r8), pointer :: forc_aer_grc (:,:) => null() ! aerosol deposition array + real(r8), pointer :: forc_pch4_grc (:) => null() ! CH4 partial pressure (Pa) + + real(r8), pointer :: forc_t_not_downscaled_grc (:) => null() ! not downscaled atm temperature (Kelvin) + real(r8), pointer :: forc_th_not_downscaled_grc (:) => null() ! not downscaled atm potential temperature (Kelvin) + real(r8), pointer :: forc_pbot_not_downscaled_grc (:) => null() ! not downscaled atm pressure (Pa) + real(r8), pointer :: forc_pbot240_downscaled_patch (:) => null() ! 10-day mean downscaled atm pressure (Pa) + real(r8), pointer :: forc_rho_not_downscaled_grc (:) => null() ! not downscaled atm density (kg/m**3) + real(r8), pointer :: forc_lwrad_not_downscaled_grc (:) => null() ! not downscaled atm downwrd IR longwave radiation (W/m**2) + + ! atm->lnd downscaled + real(r8), pointer :: forc_t_downscaled_col (:) => null() ! downscaled atm temperature (Kelvin) + real(r8), pointer :: forc_th_downscaled_col (:) => null() ! downscaled atm potential temperature (Kelvin) + real(r8), pointer :: forc_pbot_downscaled_col (:) => null() ! downscaled atm pressure (Pa) + real(r8), pointer :: forc_rho_downscaled_col (:) => null() ! downscaled atm density (kg/m**3) + real(r8), pointer :: forc_lwrad_downscaled_col (:) => null() ! downscaled atm downwrd IR longwave radiation (W/m**2) + + + ! time averaged quantities + real(r8) , pointer :: fsd24_patch (:) => null() ! patch 24hr average of direct beam radiation + real(r8) , pointer :: fsd240_patch (:) => null() ! patch 240hr average of direct beam radiation + real(r8) , pointer :: fsi24_patch (:) => null() ! patch 24hr average of diffuse beam radiation + real(r8) , pointer :: fsi240_patch (:) => null() ! patch 240hr average of diffuse beam radiation + real(r8) , pointer :: wind24_patch (:) => null() ! patch 24-hour running mean of wind + real(r8) , pointer :: t_mo_patch (:) => null() ! patch 30-day average temperature (Kelvin) + real(r8) , pointer :: t_mo_min_patch (:) => null() ! patch annual min of t_mo (Kelvin) + +end type atm2lnd_type +type(atm2lnd_type), public, target, save :: atm2lnd_inst + +contains + +!--------------------------------------------------------------------- + subroutine init_atm2lnd_type(bounds, this) + + ! !DESCRIPTION: +! Initialize CTSM atmosphere2land (forcing type) needed for calling CTSM routines +! jk Apr 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made +! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect +! +! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + type(atm2lnd_type), intent(inout):: this + + ! LOCAL: + real(r8) :: ival = 0.0_r8 ! initial value + integer :: begg, endg + integer :: begc, endc + integer :: begp, endp + !------------------------------------------------------------------------ + + begg = bounds%begg; endg= bounds%endg + begc = bounds%begc; endc= bounds%endc + begp = bounds%begp; endp= bounds%endp + + + ! atm->lnd + allocate(this%forc_u_grc (begg:endg)) ; this%forc_u_grc (:) = ival + allocate(this%forc_v_grc (begg:endg)) ; this%forc_v_grc (:) = ival + allocate(this%forc_wind_grc (begg:endg)) ; this%forc_wind_grc (:) = ival + allocate(this%forc_hgt_grc (begg:endg)) ; this%forc_hgt_grc (:) = ival + allocate(this%forc_topo_grc (begg:endg)) ; this%forc_topo_grc (:) = ival + allocate(this%forc_hgt_u_grc (begg:endg)) ; this%forc_hgt_u_grc (:) = ival + allocate(this%forc_hgt_t_grc (begg:endg)) ; this%forc_hgt_t_grc (:) = ival + allocate(this%forc_hgt_q_grc (begg:endg)) ; this%forc_hgt_q_grc (:) = ival + allocate(this%forc_vp_grc (begg:endg)) ; this%forc_vp_grc (:) = ival + allocate(this%forc_pco2_grc (begg:endg)) ; this%forc_pco2_grc (:) = ival + allocate(this%forc_solad_grc (begg:endg,numrad)) ; this%forc_solad_grc (:,:) = ival + allocate(this%forc_solai_grc (begg:endg,numrad)) ; this%forc_solai_grc (:,:) = ival + allocate(this%forc_solar_grc (begg:endg)) ; this%forc_solar_grc (:) = ival + allocate(this%forc_ndep_grc (begg:endg)) ; this%forc_ndep_grc (:) = ival + allocate(this%forc_pc13o2_grc (begg:endg)) ; this%forc_pc13o2_grc (:) = ival + allocate(this%forc_po2_grc (begg:endg)) ; this%forc_po2_grc (:) = ival + allocate(this%forc_aer_grc (begg:endg,14)) ; this%forc_aer_grc (:,:) = ival + allocate(this%forc_pch4_grc (begg:endg)) ; this%forc_pch4_grc (:) = ival + if(use_luna)then + allocate(this%forc_pco2_240_patch (begp:endp)) ; this%forc_pco2_240_patch (:) = ival + allocate(this%forc_po2_240_patch (begp:endp)) ; this%forc_po2_240_patch (:) = ival + allocate(this%forc_pbot240_downscaled_patch(begp:endp)) ; this%forc_pbot240_downscaled_patch (:) = ival + end if + ! atm->lnd not downscaled + allocate(this%forc_t_not_downscaled_grc (begg:endg)) ; this%forc_t_not_downscaled_grc (:) = ival + allocate(this%forc_pbot_not_downscaled_grc (begg:endg)) ; this%forc_pbot_not_downscaled_grc (:) = ival + allocate(this%forc_th_not_downscaled_grc (begg:endg)) ; this%forc_th_not_downscaled_grc (:) = ival + allocate(this%forc_rho_not_downscaled_grc (begg:endg)) ; this%forc_rho_not_downscaled_grc (:) = ival + allocate(this%forc_lwrad_not_downscaled_grc (begg:endg)) ; this%forc_lwrad_not_downscaled_grc (:) = ival + + ! atm->lnd downscaled + allocate(this%forc_t_downscaled_col (begc:endc)) ; this%forc_t_downscaled_col (:) = ival + allocate(this%forc_pbot_downscaled_col (begc:endc)) ; this%forc_pbot_downscaled_col (:) = ival + allocate(this%forc_th_downscaled_col (begc:endc)) ; this%forc_th_downscaled_col (:) = ival + allocate(this%forc_rho_downscaled_col (begc:endc)) ; this%forc_rho_downscaled_col (:) = ival + allocate(this%forc_lwrad_downscaled_col (begc:endc)) ; this%forc_lwrad_downscaled_col (:) = ival + + allocate(this%fsd24_patch (begp:endp)) ; this%fsd24_patch (:) = nan + allocate(this%fsd240_patch (begp:endp)) ; this%fsd240_patch (:) = nan + allocate(this%fsi24_patch (begp:endp)) ; this%fsi24_patch (:) = nan + allocate(this%fsi240_patch (begp:endp)) ; this%fsi240_patch (:) = nan + if (use_fates) then + allocate(this%wind24_patch (begp:endp)) ; this%wind24_patch (:) = nan + end if + allocate(this%t_mo_patch (begp:endp)) ; this%t_mo_patch (:) = nan + allocate(this%t_mo_min_patch (begp:endp)) ; this%t_mo_min_patch (:) = nan ! + + end subroutine init_atm2lnd_type + +end module CNCLM_atm2lndType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 new file mode 100644 index 000000000..cd69e9698 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 @@ -0,0 +1,46 @@ +module CNCLM_decompMod + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use clm_varpar , only: NUM_ZON, NUM_VEG, numpft + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_bounds + + type bounds_type + integer :: begg, endg ! beginning and ending gridcell index + integer :: begl, endl ! beginning and ending landunit index + integer :: begc, endc ! beginning and ending column index + integer :: begp, endp ! beginning and ending patch index + integer :: begCohort, endCohort ! beginning and ending cohort indices + + integer :: level ! whether defined on the proc or clump level + integer :: clump_index ! if defined on the clump level, this gives the clump index + end type bounds_type + type(bounds_type), public, target, save :: bounds + + contains + +!---------------------------------------------------- + subroutine init_bounds(nch, this) + + ! !ARGUMENTS: + implicit none + + ! INPUT: + integer, intent(in) :: nch ! number of Catchment tiles + type(bounds_type), intent(inout) :: this + + this%begg = 1 ; this%endg = nch + this%begl = 1 ; this%endl = nch + this%begc = 1 ; this%endc = nch*NUM_ZON + this%begp = 1 ; this%endp = nch*NUM_ZON*(numpft+1) + + + + +end module CNCLM_decompMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 new file mode 100644 index 000000000..3427aae27 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -0,0 +1,216 @@ +module CNCLM_filterMod + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_filter_type + + + +decomp_cpools_vr_col +endumpfilter + integer, pointer :: allc(:) ! all columns + integer :: num_allc ! number of points in allc filter + + integer, pointer :: natvegp(:) ! CNDV nat-vegetated (present) filter (pfts) + integer :: num_natvegp ! number of pfts in nat-vegetated filter + + integer, pointer :: pcropp(:) ! prognostic crop filter (pfts) + integer :: num_pcropp ! number of pfts in prognostic crop filter + integer, pointer :: soilnopcropp(:) ! soil w/o prog. crops (pfts) + integer :: num_soilnopcropp ! number of pfts in soil w/o prog crops + + integer, pointer :: lakep(:) ! lake filter (pfts) + integer :: num_lakep ! number of pfts in lake filter + integer, pointer :: nolakep(:) ! non-lake filter (pfts) + integer :: num_nolakep ! number of pfts in non-lake filter + integer, pointer :: lakec(:) ! lake filter (columns) + integer :: num_lakec ! number of columns in lake filter + integer, pointer :: nolakec(:) ! non-lake filter (columns) + integer :: num_nolakec ! number of columns in non-lake filter + + integer, pointer :: soilc(:) ! soil filter (columns) + integer :: num_soilc ! number of columns in soil filter + integer, pointer :: soilp(:) ! soil filter (pfts) + integer :: num_soilp ! number of pfts in soil filter + + integer, pointer :: snowc(:) ! snow filter (columns) + integer :: num_snowc ! number of columns in snow filter + integer, pointer :: nosnowc(:) ! non-snow filter (columns) + integer :: num_nosnowc ! number of columns in non-snow filter + + integer, pointer :: lakesnowc(:) ! snow filter (columns) + integer :: num_lakesnowc ! number of columns in snow filter + integer, pointer :: lakenosnowc(:) ! non-snow filter (columns) + integer :: num_lakenosnowc ! number of columns in non-snow filter + + integer, pointer :: exposedvegp(:) ! patches where frac_veg_nosno is non-zero + integer :: num_exposedvegp ! number of patches in exposedvegp filter + integer, pointer :: noexposedvegp(:)! patches where frac_veg_nosno is 0 (does NOT include lake or urban) + integer :: num_noexposedvegp ! number of patches in noexposedvegp filter + + integer, pointer :: hydrologyc(:) ! hydrology filter (columns) + integer :: num_hydrologyc ! number of columns in hydrology filter + + integer, pointer :: urbanl(:) ! urban filter (landunits) + integer :: num_urbanl ! number of landunits in urban filter + + integer, pointer :: nourbanl(:) ! non-urban filter (landunits) + integer :: num_nourbanl ! number of landunits in non-urban filter + + integer, pointer :: urbanc(:) ! urban filter (columns) + integer :: num_urbanc ! number of columns in urban filter + integer, pointer :: nourbanc(:) ! non-urban filter (columns) + integer :: num_nourbanc ! number of columns in non-urban filter + + integer, pointer :: urbanp(:) ! urban filter (pfts) + integer :: num_urbanp ! number of pfts in urban filter + integer, pointer :: nourbanp(:) ! non-urban filter (pfts) + integer :: num_nourbanp ! number of pfts in non-urban filter + + integer, pointer :: nolakeurbanp(:) ! non-lake, non-urban filter (pfts) + integer :: num_nolakeurbanp ! number of pfts in non-lake, non-urban filter + + integer, pointer :: icemecc(:) ! glacier mec filter (cols) + integer :: num_icemecc ! number of columns in glacier mec filter + + integer, pointer :: do_smb_c(:) ! glacier+bareland SMB calculations-on filter (cols) + integer :: num_do_smb_c ! number of columns in glacier+bareland SMB mec filter + + integer, pointer :: actfirec(:) ! glacier+bareland SMB calculations-on filter (cols) + integer :: num_actfirec ! number of columns in glacier+bareland SMB mec filter + + integer, pointer :: actfirep(:) ! glacier+bareland SMB calculations-on filter (cols) + integer :: num_actfirep ! number of columns in glacier+bareland SMB mec filter + + end type clumpfilter + public clumpfilter + + ! This is the standard set of filters, which should be used in most places in the code. + ! These filters only include 'active' points. + type(clumpfilter), allocatable, public :: filter(:) + +contains + +!-------------------------------------------------------------- + subroutine init_filter_type(bounds, nch, this_filter) + + ! !DESCRIPTION: + ! Initialize CTSM filters + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + ! INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate + + !-------------------------------------- + + allocate(this_filter%allc(bounds%endc-bounds%begc+1)) + + allocate(this_filter%lakep(bounds%endp-bounds%begp+1)) + allocate(this_filter%nolakep(bounds%endp-bounds%begp+1)) + allocate(this_filter%nolakeurbanp(bounds%endp-bounds%begp+1)) + + allocate(this_filter%lakec(bounds%endc-bounds%begc+1)) + allocate(this_filter%nolakec(bounds%endc-bounds%begc+1)) + + allocate(this_filter%soilc(bounds%endc-bounds%begc+1)) + allocate(this_filter%soilp(bounds%endp-bounds%begp+1)) + + allocate(this_filter%snowc(bounds%endc-bounds%begc+1)) + allocate(this_filter%nosnowc(bounds%endc-bounds%begc+1)) + + allocate(this_filter%lakesnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter%lakenosnowc(bounds%endc-bounds%begc+1)) + + allocate(this_filter%exposedvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter%noexposedvegp(bounds%endp-bounds%begp+1)) + + allocate(this_filter%natvegp(bounds%endp-bounds%begp+1)) + + allocate(this_filter%hydrologyc(bounds%endc-bounds%begc+1)) + + allocate(this_filter%urbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter%nourbanp(bounds%endp-bounds%begp+1)) + + allocate(this_filter%urbanc(bounds%endc-bounds%begc+1)) + allocate(this_filter%nourbanc(bounds%endc-bounds%begc+1)) + + allocate(this_filter%urbanl(bounds%endl-bounds%begl+1)) + allocate(this_filter%nourbanl(bounds%endl-bounds%begl+1)) + + allocate(this_filter%pcropp(bounds%endp-bounds%begp+1)) + allocate(this_filter%soilnopcropp(bounds%endp-bounds%begp+1)) + + allocate(this_filter%icemecc(bounds%endc-bounds%begc+1)) + allocate(this_filter%do_smb_c(bounds%endc-bounds%begc+1)) + + allocate(this_filter%actfirec(bounds%endc-bounds%begc+1)) + allocate(this_filter%actfirep(bounds%endp-bounds%begp+1)) + + this_filter%num_actfirep = 1 + this_filter%num_actfirec = 1 + + ! initialize + + this_filter%num_soilc = 0 + this_filter%num_soilp = 0 + this_filter%num_pcropp = 0 + this_filter%num_exposedvegp = 0 + this_filter%num_noexposedvegp = 0 + this_filter%num_nourbanp = 0 + + n = 0 + do nc = 1,nch + do nz = 1,nzone + n = n + 1 + this_filter%num_soilc = this_filter%num_soilc + 1 + this_filter%soilc(this%num_soilc) = n + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p) then + + this_filter%num_nourbanp = this_filter%num_nourbanp + 1 + this_filter%nourbanp(num_nourbanp) = np + + this_filter%num_soilp = this_filter%num_soilp + 1 + this_filter%soilp(this_filter%num_soilp) = np + + ! jkolassa: not sure this is needed, since we do not use prognostic crop information + if(ityp(nc,nv,nz) >= npcropmin) then + this_filter%num_pcropp = this_filternum_pcropp + 1 + this_filter%pcropp(this_filter%num_pcropp) = np + endif + + + if (fveg(nc,nv,nz)>1.e-4) then + + this_filter%num_exposedvegp = this_filter%num_exposedvegp + 1 + this_filter%exposedvegp(this_filter%num_exposedvegp) = np + + elseif (fveg(nc,nv,nz)<=1.e-4) then + + this_filter%num_noexposedvegp = this_filter%num_noexposedvegp + 1 + this_filter%noexposedvegp(this_filter%num_noexposedvegp) = np + + end if + end if + end do ! nv + end do !p + end do !nz + end do !nc + + end subroutine init_filter_type +end module CNCLM_filterMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 new file mode 100644 index 000000000..acd6dce42 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -0,0 +1,966 @@ +module CNCLM_pftconMod + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use clm_varpar , only : mxpft, numrad + use netcdf + use MAPL_ExceptionHandling + + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_pftcon_type + +! +! Vegetation type constants +! + integer, public :: noveg = 0 ! Bare + integer, public :: ndllf_evr_tmp_tree = 1 ! Needleleaf evergreen temperate tree + integer, public :: ndllf_evr_brl_tree = 2 ! Needleleaf evergreen boreal tree + integer, public :: ndllf_dcd_brl_tree = 3 ! Needleleaf deciduous boreal tree + integer, public :: nbrdlf_evr_trp_tree = 4 ! Broadleaf evergreen tropical tree + integer, public :: nbrdlf_evr_tmp_tree = 5 ! Broadleaf evergreen temperate tree + integer, public :: nbrdlf_dcd_trp_tree = 6 ! Broadleaf deciduous tropical tree + integer, public :: nbrdlf_dcd_tmp_tree = 7 ! Broadleaf deciduous temperate tree + integer, public :: nbrdlf_dcd_brl_tree = 8 ! Broadleaf deciduous boreal tree + integer, public :: nbrdlf_evr_shrub = 9 ! Broadleaf evergreen temperate shrub + integer, public :: nbrdlf_dcd_tmp_shrub = 10 ! Broadleaf deciduous temperate shrub [moisture + deciduous] + integer, public :: nbrdlf_dcd_brl_shrub = 11 ! Broadleaf deciduous boreal shrub + integer, public :: nc3_arctic_grass = 12 ! Arctic c3 grass + integer, public :: nc3_nonarctic_grass = 13 ! Cool c3 grass [moisture + deciduous] + integer, public :: nc4_grass = 14 ! Warm c4 grass [moisture + deciduous] + integer, public :: nc3crop = 15 ! C3_crop [moisture + deciduous] + integer, public :: npcropmin = nc3crop ! value for first crop + + ! + type, public :: pftcon_type + + integer , allocatable :: noveg (:) ! value for not vegetated + logical , allocatable :: is_tree (:) ! tree or not? + logical , allocatable :: is_shrub (:) ! shrub or not? + logical , allocatable :: is_grass (:) ! grass or not? + + real(r8), allocatable :: dleaf (:) ! characteristic leaf dimension (m) + real(r8), allocatable :: c3psn (:) ! photosynthetic pathway: 0. = c4, 1. = c3 + real(r8), allocatable :: xl (:) ! leaf/stem orientation index + real(r8), allocatable :: rhol (:,:) ! leaf reflectance: 1=vis, 2=nir + real(r8), allocatable :: rhos (:,:) ! stem reflectance: 1=vis, 2=nir + real(r8), allocatable :: taul (:,:) ! leaf transmittance: 1=vis, 2=nir + real(r8), allocatable :: taus (:,:) ! stem transmittance: 1=vis, 2=nir + real(r8), allocatable :: z0mr (:) ! ratio of momentum roughness length to canopy top height (-) + real(r8), allocatable :: displar (:) ! ratio of displacement height to canopy top height (-) + real(r8), allocatable :: roota_par (:) ! CLM rooting distribution parameter [1/m] + real(r8), allocatable :: rootb_par (:) ! CLM rooting distribution parameter [1/m] + real(r8), allocatable :: crop (:) ! crop pft: 0. = not crop, 1. = crop pft + real(r8), allocatable :: irrigated (:) ! irrigated pft: 0. = not, 1. = irrigated + real(r8), allocatable :: smpso (:) ! soil water potential at full stomatal opening (mm) + real(r8), allocatable :: smpsc (:) ! soil water potential at full stomatal closure (mm) + real(r8), allocatable :: fnitr (:) ! foliage nitrogen limitation factor (-) + + ! CN code + real(r8), allocatable :: dwood (:) ! wood density (gC/m3) + real(r8), allocatable :: slatop (:) ! SLA at top of canopy [m^2/gC] + real(r8), allocatable :: dsladlai (:) ! dSLA/dLAI [m^2/gC] + real(r8), allocatable :: leafcn (:) ! leaf C:N [gC/gN] + real(r8), allocatable :: biofuel_harvfrac (:) ! fraction of stem and leaf cut for harvest, sent to biofuels [unitless] + real(r8), allocatable :: flnr (:) ! fraction of leaf N in Rubisco [no units] + real(r8), allocatable :: woody (:) ! woody lifeform flag (0 or 1) + real(r8), allocatable :: lflitcn (:) ! leaf litter C:N (gC/gN) + real(r8), allocatable :: frootcn (:) ! fine root C:N (gC/gN) + real(r8), allocatable :: livewdcn (:) ! live wood (phloem and ray parenchyma) C:N (gC/gN) + real(r8), allocatable :: deadwdcn (:) ! dead wood (xylem and heartwood) C:N (gC/gN) + real(r8), allocatable :: grperc (:) ! growth respiration parameter + real(r8), allocatable :: grpnow (:) ! growth respiration parameter + real(r8), allocatable :: rootprof_beta (:,:) ! CLM rooting distribution parameter for C and N inputs [unitless] + real(r8), allocatable :: root_radius (:) ! root radius (m) + real(r8), allocatable :: root_density (:) ! root density (gC/m3) + + real(r8), allocatable :: dbh (:) ! diameter at breast height (m) + real(r8), allocatable :: fbw (:) ! fraction of biomass that is water + real(r8), allocatable :: nstem (:) ! stem density (#/m2) + real(r8), allocatable :: taper (:) ! tapering ratio of height:radius_breast_height + real(r8), allocatable :: rstem_per_dbh (:) ! stem resistance per dbh (s/m/m) + real(r8), allocatable :: wood_density (:) ! wood density (kg/m3) + + ! crop + + ! These arrays give information about the merge of unused crop types to the types CLM + ! knows about. mergetoclmpft(m) gives the crop type that CLM uses to simulate input + ! type m (and mergetoclmpft(m) == m implies that CLM simulates crop type m + ! directly). is_pft_known_to_model(m) is true if CLM simulates crop type m, and false + ! otherwise. Note that these do NOT relate to whether irrigation is on or off in a + ! given simulation - that is handled separately. + integer , allocatable :: mergetoclmpft (:) + logical , allocatable :: is_pft_known_to_model (:) + + real(r8), allocatable :: graincn (:) ! grain C:N (gC/gN) + real(r8), allocatable :: mxtmp (:) ! parameter used in accFlds + real(r8), allocatable :: baset (:) ! parameter used in accFlds + real(r8), allocatable :: declfact (:) ! parameter used in CNAllocation + real(r8), allocatable :: bfact (:) ! parameter used in CNAllocation + real(r8), allocatable :: aleaff (:) ! parameter used in CNAllocation + real(r8), allocatable :: arootf (:) ! parameter used in CNAllocation + real(r8), allocatable :: astemf (:) ! parameter used in CNAllocation + real(r8), allocatable :: arooti (:) ! parameter used in CNAllocation + real(r8), allocatable :: fleafi (:) ! parameter used in CNAllocation + real(r8), allocatable :: allconsl (:) ! parameter used in CNAllocation + real(r8), allocatable :: allconss (:) ! parameter used in CNAllocation + real(r8), allocatable :: ztopmx (:) ! parameter used in CNVegStructUpdate + real(r8), allocatable :: laimx (:) ! parameter used in CNVegStructUpdate + real(r8), allocatable :: gddmin (:) ! parameter used in CNPhenology + real(r8), allocatable :: hybgdd (:) ! parameter used in CNPhenology + real(r8), allocatable :: lfemerg (:) ! parameter used in CNPhenology + real(r8), allocatable :: grnfill (:) ! parameter used in CNPhenology + integer , allocatable :: mxmat (:) ! parameter used in CNPhenology + real(r8), allocatable :: mbbopt (:) ! Ball-Berry equation slope used in Photosynthesis + real(r8), allocatable :: medlynslope (:) ! Medlyn equation slope used in Photosynthesis + real(r8), allocatable :: medlynintercept(:) ! Medlyn equation intercept used in Photosynthesis + integer , allocatable :: mnNHplantdate (:) ! minimum planting date for NorthHemisphere (YYYYMMDD) + integer , allocatable :: mxNHplantdate (:) ! maximum planting date for NorthHemisphere (YYYYMMDD) + integer , allocatable :: mnSHplantdate (:) ! minimum planting date for SouthHemisphere (YYYYMMDD) + integer , allocatable :: mxSHplantdate (:) ! maximum planting date for SouthHemisphere (YYYYMMDD) + real(r8), allocatable :: planttemp (:) ! planting temperature used in CNPhenology (K) + real(r8), allocatable :: minplanttemp (:) ! mininum planting temperature used in CNPhenology (K) + real(r8), allocatable :: froot_leaf (:) ! allocation parameter: new fine root C per new leaf C (gC/gC) + real(r8), allocatable :: stem_leaf (:) ! allocation parameter: new stem c per new leaf C (gC/gC) + real(r8), allocatable :: croot_stem (:) ! allocation parameter: new coarse root C per new stem C (gC/gC) + real(r8), allocatable :: flivewd (:) ! allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + real(r8), allocatable :: fcur (:) ! allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + real(r8), allocatable :: fcurdv (:) ! alternate fcur for use with cndv + real(r8), allocatable :: lf_flab (:) ! leaf litter labile fraction + real(r8), allocatable :: lf_fcel (:) ! leaf litter cellulose fraction + real(r8), allocatable :: lf_flig (:) ! leaf litter lignin fraction + real(r8), allocatable :: fr_flab (:) ! fine root litter labile fraction + real(r8), allocatable :: fr_fcel (:) ! fine root litter cellulose fraction + real(r8), allocatable :: fr_flig (:) ! fine root litter lignin fraction + real(r8), allocatable :: leaf_long (:) ! leaf longevity (yrs) + real(r8), allocatable :: evergreen (:) ! binary flag for evergreen leaf habit (0 or 1) + real(r8), allocatable :: stress_decid (:) ! binary flag for stress-deciduous leaf habit (0 or 1) + real(r8), allocatable :: season_decid (:) ! binary flag for seasonal-deciduous leaf habit (0 or 1) +!KO + real(r8), allocatable :: season_decid_temperate(:) ! binary flag for seasonal-deciduous temperate leaf habit (0 or 1) +!KO + real(r8), allocatable :: pconv (:) ! proportion of deadstem to conversion flux + real(r8), allocatable :: pprod10 (:) ! proportion of deadstem to 10-yr product pool + real(r8), allocatable :: pprod100 (:) ! proportion of deadstem to 100-yr product pool + real(r8), allocatable :: pprodharv10 (:) ! harvest mortality proportion of deadstem to 10-yr pool + + ! pft paraemeters for fire code + real(r8), allocatable :: cc_leaf (:) + real(r8), allocatable :: cc_lstem (:) + real(r8), allocatable :: cc_dstem (:) + real(r8), allocatable :: cc_other (:) + real(r8), allocatable :: fm_leaf (:) + real(r8), allocatable :: fm_lstem (:) + real(r8), allocatable :: fm_dstem (:) + real(r8), allocatable :: fm_other (:) + real(r8), allocatable :: fm_root (:) + real(r8), allocatable :: fm_lroot (:) + real(r8), allocatable :: fm_droot (:) + real(r8), allocatable :: fsr_pft (:) + real(r8), allocatable :: fd_pft (:) + real(r8), allocatable :: rswf_min (:) + real(r8), allocatable :: rswf_max (:) + + ! pft parameters for crop code + real(r8), allocatable :: manunitro (:) ! manure + real(r8), allocatable :: fleafcn (:) ! C:N during grain fill; leaf + real(r8), allocatable :: ffrootcn (:) ! C:N during grain fill; fine root + real(r8), allocatable :: fstemcn (:) ! C:N during grain fill; stem + + real(r8), allocatable :: i_vcad (:) + real(r8), allocatable :: s_vcad (:) + real(r8), allocatable :: i_flnr (:) + real(r8), allocatable :: s_flnr (:) + + ! pft parameters for CNDV code (from LPJ subroutine pftparameters) + real(r8), allocatable :: pftpar20 (:) ! tree maximum crown area (m2) + real(r8), allocatable :: pftpar28 (:) ! min coldest monthly mean temperature + real(r8), allocatable :: pftpar29 (:) ! max coldest monthly mean temperature + real(r8), allocatable :: pftpar30 (:) ! min growing degree days (>= 5 deg C) + real(r8), allocatable :: pftpar31 (:) ! upper limit of temperature of the warmest month (twmax) + + ! pft parameters for FUN + real(r8), allocatable :: a_fix (:) ! A BNF parameter + real(r8), allocatable :: b_fix (:) ! A BNF parameter + real(r8), allocatable :: c_fix (:) ! A BNF parameter + real(r8), allocatable :: s_fix (:) ! A BNF parameter + real(r8), allocatable :: akc_active (:) ! A mycorrhizal uptake parameter + real(r8), allocatable :: akn_active (:) ! A mycorrhizal uptake parameter + real(r8), allocatable :: ekc_active (:) ! A mycorrhizal uptake parameter + real(r8), allocatable :: ekn_active (:) ! A mycorrhizal uptake parameter + real(r8), allocatable :: kc_nonmyc (:) ! A non-mycorrhizal uptake parameter + real(r8), allocatable :: kn_nonmyc (:) ! A non-mycorrhizal uptake parameter + real(r8), allocatable :: kr_resorb (:) ! A retrasnlcation parameter + real(r8), allocatable :: perecm (:) ! The fraction of ECM-associated PFT + real(r8), allocatable :: fun_cn_flex_a (:) ! Parameter a of FUN-flexcn link code (def 5) + real(r8), allocatable :: fun_cn_flex_b (:) ! Parameter b of FUN-flexcn link code (def 200) + real(r8), allocatable :: fun_cn_flex_c (:) ! Parameter b of FUN-flexcn link code (def 80) + real(r8), allocatable :: FUN_fracfixers(:) ! Fraction of C that can be used for fixation. + + + ! pft parameters for dynamic root code + real(r8), allocatable :: root_dmx(:) !maximum root depth + + end type pftcon_type + +type(pftcon_type), public, target, save :: pftcon + +contains + +!-------------------------------- + subroutine init_pftcon_type(this) + + ! !DESCRIPTION: +! Initialize CTSM PFT constants +! +! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(pftcon_type), intent(inout):: this + + !LOCAL + character(300) :: paramfile + integer :: ierr, clm_varid + + real(r8), allocatable, dimension(:) :: read_tmp_1 + real(r8), allocatable, dimension(:,:) :: read_tmp_2 + integer , allocatable, dimension(:) :: read_tmp_3 + +!--------------------------------------------------------- + + allocate( read_tmp_1 (0:78)) + allocate( read_tmp_2 (0:78,nvariants)) + allocate( read_tmp_3 (0:78)) + + allocate( this%noveg (0:mxpft)); this%noveg (:) = huge(1) + allocate( this%is_tree (0:mxpft)); this%is_tree (:) = .false. + allocate( this%is_shrub (0:mxpft)); this%is_shrub (:) = .false. + allocate( this%is_grass (0:mxpft)); this%is_grass (:) = .false. + + allocate( this%dleaf (0:mxpft) ); this%dleaf (:) = nan !# + allocate( this%c3psn (0:mxpft) ); this%c3psn (:) = nan + allocate( this%xl (0:mxpft) ); this%xl (:) = nan + allocate( this%rhol (0:mxpft,numrad) ); this%rhol (:,:) = nan + allocate( this%rhos (0:mxpft,numrad) ); this%rhos (:,:) = nan + allocate( this%taul (0:mxpft,numrad) ); this%taul (:,:) = nan + allocate( this%taus (0:mxpft,numrad) ); this%taus (:,:) = nan + allocate( this%z0mr (0:mxpft) ); this%z0mr (:) = nan + allocate( this%displar (0:mxpft) ); this%displar (:) = nan + allocate( this%roota_par (0:mxpft) ); this%roota_par(:) = nan + allocate( this%rootb_par (0:mxpft) ); this%rootb_par(:) = nan + allocate( this%crop (0:mxpft) ); this%crop (:) = nan !# + allocate( this%mergetoclmpft (0:mxpft) ); this%mergetoclmpft (:) = nan !# + allocate( this%is_pft_known_to_model (0:mxpft) ); this%is_pft_known_to_model(:) = nan !# + allocate( this%irrigated (0:mxpft) ); this%irrigated (:) = nan !# + allocate( this%smpso (0:mxpft) ); this%smpso (:) = nan !# + allocate( this%smpsc (0:mxpft) ); this%smpsc (:) = nan !# + allocate( this%fnitr (0:mxpft) ); this%fnitr (:) = nan !# + allocate( this%slatop (0:mxpft) ); this%slatop (:) = nan + allocate( this%dsladlai (0:mxpft) ); this%dsladlai (:) = nan + allocate( this%leafcn (0:mxpft) ); this%leafcn (:) = nan + allocate( this%biofuel_harvfrac (0:mxpft) ); this%biofuel_harvfrac(:) = nan !# + allocate( this%flnr (0:mxpft) ); this%flnr (:) = nan + allocate( this%woody (0:mxpft) ); this%woody (:) = nan + allocate( this%lflitcn (0:mxpft) ); this%lflitcn (:) = nan + allocate( this%frootcn (0:mxpft) ); this%frootcn (:) = nan + allocate( this%livewdcn (0:mxpft) ); this%livewdcn (:) = nan + allocate( this%deadwdcn (0:mxpft) ); this%deadwdcn (:) = nan + allocate( this%grperc (0:mxpft) ); this%grperc (:) = nan + allocate( this%grpnow (0:mxpft) ); this%grpnow (:) = nan + allocate( this%rootprof_beta (0:mxpft,nvariants) ); this%rootprof_beta(:,:) = nan + allocate( this%graincn (0:mxpft) ); this%graincn (:) = nan + allocate( this%mxtmp (0:mxpft) ); this%mxtmp (:) = nan + allocate( this%baset (0:mxpft) ); this%baset (:) = nan + allocate( this%declfact (0:mxpft) ); this%declfact (:) = nan + allocate( this%bfact (0:mxpft) ); this%bfact (:) = nan + allocate( this%aleaff (0:mxpft) ); this%aleaff (:) = nan + allocate( this%arootf (0:mxpft) ); this%arootf (:) = nan + allocate( this%astemf (0:mxpft) ); this%astemf (:) = nan + allocate( this%arooti (0:mxpft) ); this%arooti (:) = nan + allocate( this%fleafi (0:mxpft) ); this%fleafi (:) = nan + allocate( this%allconsl (0:mxpft) ); this%allconsl (:) = nan + allocate( this%allconss (0:mxpft) ); this%allconss (:) = nan + allocate( this%ztopmx (0:mxpft) ); this%ztopmx (:) = nan + allocate( this%laimx (0:mxpft) ); this%laimx (:) = nan + allocate( this%gddmin (0:mxpft) ); this%gddmin (:) = nan + allocate( this%hybgdd (0:mxpft) ); this%hybgdd (:) = nan + allocate( this%lfemerg (0:mxpft) ); this%lfemerg (:) = nan + allocate( this%grnfill (0:mxpft) ); this%grnfill (:) = nan + allocate( this%mbbopt (0:mxpft) ); this%mbbopt (:) = nan !# + allocate( this%medlynslope (0:mxpft) ); this%medlynslope (:) = nan !# + allocate( this%medlynintercept(0:mxpft) ); this%medlynintercept = nan !# + allocate( this%mxmat (0:mxpft) ); this%mxmat (:) = nan + allocate( this%mnNHplantdate (0:mxpft) ); this%mnNHplantdate (:) = huge(1) + allocate( this%mxNHplantdate (0:mxpft) ); this%mxNHplantdate (:) = huge(1) + allocate( this%mnSHplantdate (0:mxpft) ); this%mnSHplantdate (:) = huge(1) + allocate( this%mxSHplantdate (0:mxpft) ); this%mxSHplantdate (:) = huge(1) + allocate( this%planttemp (0:mxpft) ); this%planttemp (:) = nan + allocate( this%minplanttemp (0:mxpft) ); this%minplanttemp (:) = nan + allocate( this%froot_leaf (0:mxpft) ); this%froot_leaf (:) = nan + allocate( this%stem_leaf (0:mxpft) ); this%stem_leaf (:) = nan + allocate( this%croot_stem (0:mxpft) ); this%croot_stem (:) = nan + allocate( this%flivewd (0:mxpft) ); this%flivewd (:) = nan + allocate( this%fcur (0:mxpft) ); this%fcur (:) = nan + allocate( this%fcurdv (0:mxpft) ); this%fcurdv (:) = nan !# + allocate( this%lf_flab (0:mxpft) ); this%lf_flab (:) = nan + allocate( this%lf_fcel (0:mxpft) ); this%lf_fcel (:) = nan + allocate( this%lf_flig (0:mxpft) ); this%lf_flig (:) = nan + allocate( this%fr_flab (0:mxpft) ); this%fr_flab (:) = nan + allocate( this%fr_fcel (0:mxpft) ); this%fr_fcel (:) = nan + allocate( this%fr_flig (0:mxpft) ); this%fr_flig (:) = nan + allocate( this%leaf_long (0:mxpft) ); this%leaf_long (:) = nan + allocate( this%evergreen (0:mxpft) ); this%evergreen (:) = nan + allocate( this%stress_decid (0:mxpft) ); this%stress_decid (:) = nan + allocate( this%season_decid (0:mxpft) ); this%season_decid (:) = nan +!KO + allocate( this%season_decid_temperate (0:mxpft) ); this%season_decid_temperate (:) = nan !# +!KO + allocate( this%dwood (0:mxpft) ); this%dwood (:) = nan + allocate( this%root_density (0:mxpft) ); this%root_density (:) = nan !# + allocate( this%root_radius (0:mxpft) ); this%root_radius (:) = nan !# + allocate( this%pconv (0:mxpft) ); this%pconv (:) = nan !# + allocate( this%pprod10 (0:mxpft) ); this%pprod10 (:) = nan !# + allocate( this%pprod100 (0:mxpft) ); this%pprod100 (:) = nan !# + allocate( this%pprodharv10 (0:mxpft) ); this%pprodharv10 (:) = nan !# + allocate( this%cc_leaf (0:mxpft) ); this%cc_leaf (:) = nan + allocate( this%cc_lstem (0:mxpft) ); this%cc_lstem (:) = nan + allocate( this%cc_dstem (0:mxpft) ); this%cc_dstem (:) = nan + allocate( this%cc_other (0:mxpft) ); this%cc_other (:) = nan + allocate( this%fm_leaf (0:mxpft) ); this%fm_leaf (:) = nan + allocate( this%fm_lstem (0:mxpft) ); this%fm_lstem (:) = nan + allocate( this%fm_dstem (0:mxpft) ); this%fm_dstem (:) = nan + allocate( this%fm_other (0:mxpft) ); this%fm_other (:) = nan + allocate( this%fm_root (0:mxpft) ); this%fm_root (:) = nan + allocate( this%fm_lroot (0:mxpft) ); this%fm_lroot (:) = nan + allocate( this%fm_droot (0:mxpft) ); this%fm_droot (:) = nan + allocate( this%fsr_pft (0:mxpft) ); this%fsr_pft (:) = nan + allocate( this%fd_pft (0:mxpft) ); this%fd_pft (:) = nan + allocate( this%rswf_max (0:mxpft) ); this%rswf_max (:) = nan !# + allocate( this%rswf_min (0:mxpft) ); this%rswf_min (:) = nan !# + allocate( this%manunitro (0:mxpft) ); this%manunitro (:) = nan !# + allocate( this%fleafcn (0:mxpft) ); this%fleafcn (:) = nan + allocate( this%ffrootcn (0:mxpft) ); this%ffrootcn (:) = nan + allocate( this%fstemcn (0:mxpft) ); this%fstemcn (:) = nan + allocate( this%i_vcad (0:mxpft) ); this%i_vcad (:) = nan !# + allocate( this%s_vcad (0:mxpft) ); this%s_vcad (:) = nan !# + allocate( this%i_flnr (0:mxpft) ); this%i_flnr (:) = nan !# + allocate( this%s_flnr (0:mxpft) ); this%s_flnr (:) = nan !# + allocate( this%pftpar20 (0:mxpft) ); this%pftpar20 (:) = nan !# + allocate( this%pftpar28 (0:mxpft) ); this%pftpar28 (:) = nan !# + allocate( this%pftpar29 (0:mxpft) ); this%pftpar29 (:) = nan !# + allocate( this%pftpar30 (0:mxpft) ); this%pftpar30 (:) = nan !# + allocate( this%pftpar31 (0:mxpft) ); this%pftpar31 (:) = nan !# + allocate( this%a_fix (0:mxpft) ); this%a_fix (:) = nan !# + allocate( this%b_fix (0:mxpft) ); this%b_fix (:) = nan !# + allocate( this%c_fix (0:mxpft) ); this%c_fix (:) = nan !# + allocate( this%s_fix (0:mxpft) ); this%s_fix (:) = nan !# + allocate( this%akc_active (0:mxpft) ); this%akc_active (:) = nan !# + allocate( this%akn_active (0:mxpft) ); this%akn_active (:) = nan !# + allocate( this%ekc_active (0:mxpft) ); this%ekc_active (:) = nan !# + allocate( this%ekn_active (0:mxpft) ); this%ekn_active (:) = nan !# + allocate( this%kc_nonmyc (0:mxpft) ); this%kc_nonmyc (:) = nan !# + allocate( this%kn_nonmyc (0:mxpft) ); this%kn_nonmyc (:) = nan !# + allocate( this%kr_resorb (0:mxpft) ); this%kr_resorb (:) = nan !# + allocate( this%perecm (0:mxpft) ); this%perecm (:) = nan !# + allocate( this%root_dmx (0:mxpft) ); this%root_dmx (:) = nan !# + allocate( this%fun_cn_flex_a (0:mxpft) ); this%fun_cn_flex_a (:) = nan !# + allocate( this%fun_cn_flex_b (0:mxpft) ); this%fun_cn_flex_b (:) = nan !# + allocate( this%fun_cn_flex_c (0:mxpft) ); this%fun_cn_flex_c (:) = nan !# + allocate( this%FUN_fracfixers(0:mxpft) ); this%FUN_fracfixers (:) = nan !# + allocate( this%dbh (0:mxpft) ); this%dbh (:) = nan !# + allocate( this%fbw (0:mxpft) ); this%fbw (:) = nan !# + allocate( this%nstem (0:mxpft) ); this%nstem (:) = nan !# + allocate( this%taper (0:mxpft) ); this%taper (:) = nan !# + allocate( this%rstem_per_dbh (0:mxpft) ); this%rstem_per_dbh (:) = nan !# + allocate( this%wood_density (0:mxpft) ); this%wood_density (:) = nan !# + + ! jkolassa, Dec 2021: read in parameters from CLM parameter file + ! TO DO: pass parameter file through rc files rather than hardcoding name here + + paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' + ierr = NF90_OPEN(trim(paramfile),NF90_NOWRITE,ncid) + if (ierr/=0) then + _ASSERT(.FALSE.,'error opening netcdf file') + end if + + ierr = NF90_INQ_VARID(ncid,'z0mr',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%z0mr(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'displar',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%displar(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'dleaf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%dleaf(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'c3psn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%c3psn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'rholvis',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%rhol(:,1) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'rholnir',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%rhol(:,2) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'rhosvis',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%rhos(:,1) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'rhosnir',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%rhos(:,2) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'taulvis',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%taul(:,1) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'taulnir',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%taul(:,2) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'tausvis',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%taus(:,1) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'tausnir',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%taus(:,2) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'xl',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%xl(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'roota_par',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%roota_par(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'rootb_par',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%rootb_par(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'slatop',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%slatop(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'dsladlai',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%dsladlai(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'leafcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%leafcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'biofuel_harvfrac',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%biofuel_harvfrac(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'flnr',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%flnr(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'smpso',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%smpso(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'smpsc',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%smpsc(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fnitr',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fnitr(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'woody',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%woody(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'lflitcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%lflitcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'frootcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%frootcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'livewdcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%livewdcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'deadwdcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%deadwdcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'grperc',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%grperc(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'grpnow',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%grpnow(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'froot_leaf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%froot_leaf(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'stem_leaf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%stem_leaf(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'croot_stem',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%croot_stem(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'flivewd',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%flivewd(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fcur',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fcur(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fcurdv',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fcurdv(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'lf_flab',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%lf_flab(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'lf_fcel',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%lf_fcel(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'lf_flig',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%lf_flig(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fr_flab',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fr_flab(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fr_fcel',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fr_fcel(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fr_flig',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fr_flig(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'leaf_long',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%leaf_long(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'evergreen',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%evergreen(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'stress_decid',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%stress_decid(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'season_decid',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%season_decid(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'season_decid_temperate',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%z0mr(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'pftpar20',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pftpar20(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'pftpar28',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pftpar28(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'pftpar29',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pftpar29(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'pftpar30',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pftpar30(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'pftpar31',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pftpar31(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'a_fix',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%a_fix(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'b_fix',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%b_fix(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'c_fix',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%c_fix(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'s_fix',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%s_fix(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'akc_active',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%akc_active(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'akn_active',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%akn_active(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'ekc_active',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%ekc_active(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'ekn_active',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%ekn_active(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'kc_nonmyc',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%kc_nonmyc(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'kn_nonmyc',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%kn_nonmyc(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'kr_resorb',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%kr_resorb(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'perecm',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%perecm(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fun_cn_flex_a',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fun_cn_flex_a(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fun_cn_flex_b',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fun_cn_flex_b(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fun_cn_flex_c',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fun_cn_flex_c(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'FUN_fracfixers',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%FUN_fracfixers(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'manunitro',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%manunitro(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fleafcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fleafcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'ffrootcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%ffrootcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fstemcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fstemcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'rootprof_beta',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_2) + this%rootprof_beta(:,:) = read_tmp_2(0:mxpft,:) + + ierr = NF90_INQ_VARID(ncid,'pconv',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pconv(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'pprod10',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pprod10(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'pprodharv10',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pprodharv10(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'pprod100',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%pprod100(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'graincn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%graincn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'mxtmp',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%mxtmp(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'baset',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%baset(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'declfact',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%declfact(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'bfact',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%bfact(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'aleaff',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%aleaff(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'arootf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%arootf(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'astemf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%astemf(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'arooti',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%arooti(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fleafi',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fleafi(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'allconsl',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%allconsl(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'allconss',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%allconss(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'crop',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%crop(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'mergetoclmpft',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%mergetoclmpft(:) = read_tmp_3(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'irrigated',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%irrigated(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'ztopmx',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%ztopmx(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'laimx',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%laimx(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'gddmin',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%gddmin(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'hybgdd',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%hybgdd(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'lfemerg',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%lfemerg(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'grnfill',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%grnfill(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'mbbopt',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%mbbopt(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'medlynslope',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%medlynslope(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'medlynintercept',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%medlynintercept(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'mxmat',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%mxmat(:) = read_tmp_3(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'cc_leaf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%cc_leaf(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'cc_lstem',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%cc_lstem(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'cc_dstem',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%cc_dstem(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'cc_other',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%cc_other(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fstemcn',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fstemcn(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fm_leaf',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fm_leaf(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fm_lstem',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fm_lstem(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fm_dstem',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fm_dstem(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fm_other',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fm_other(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fm_root',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fm_root(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fm_lroot',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fm_lroot(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fm_droot',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fm_droot(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fsr_pft',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fsr_pft(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'fd_pft',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%fd_pft(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'rswf_min',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%rswf_min(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'rswf_max',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%rswf_max(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'min_planting_temp',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%min_planting_temp(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'min_NH_planting_date',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%min_NH_planting_date(:) = read_tmp_3(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'min_SH_planting_date',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%min_SH_planting_date(:) = read_tmp_3(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'max_NH_planting_date',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%max_NH_planting_date(:) = read_tmp_3(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'max_SH_planting_date',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) + this%max_SH_planting_date(:) = read_tmp_3(0:mxpft) + + do m = 0,mxpft + this%dwood(m) = dwood + this%root_radius(m) = root_radius + this%root_density(m) = root_density + end do + + if (use_flexibleCN) then + ierr = NF90_INQ_VARID(ncid,'i_vcad',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%i_vcad(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'s_vcad',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%s_vcad(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'i_flnr',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%i_flnr(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'s_flnr',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%s_flnr(:) = read_tmp_1(0:mxpft) + + end if + + if ( use_crop .and. use_dynroot )then + ierr = NF90_INQ_VARID(ncid,'root_dmx',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%root_dmx(:) = read_tmp_1(0:mxpft) + end if + + ierr = NF90_INQ_VARID(ncid,'nstem',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%nstem(:) = read_tmp_1(0:mxpft) + + ierr = NF90_INQ_VARID(ncid,'taper',clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) + this%taper(:) = read_tmp_1(0:mxpft) + + ierr = NF90_CLOSE(ncid) + + ! jkolassa, Dec 2021: not using biomass heat storage module, so set the following 4 parameters to 0 + this%dbh = 0.0_r8 + this%fbw = 0.0_r8 + this%rstem_per_dbh = 0.0_r8 + this%wood_density = 0.0_r8 + + ! Set vegetation family identifier (tree/shrub/grass) + do m = 0,mxpft + if (m == ndllf_evr_tmp_tree .or. m == ndllf_evr_brl_tree & + .or. m == ndllf_dcd_brl_tree .or. m == nbrdlf_evr_trp_tree & + .or. m == nbrdlf_evr_tmp_tree .or. m == nbrdlf_dcd_trp_tree & + .or. m == nbrdlf_dcd_tmp_tree .or. m == nbrdlf_dcd_brl_tree) then + this%is_tree(m) = .true. + else + this%is_tree(m) = .false. + endif + if(m == nbrdlf_evr_shrub .or. m == nbrdlf_dcd_tmp_shrub .or. m == nbrdlf_dcd_brl_shrub) then + this%is_shrub(m) = .true. + else + this%is_shrub(m) = .false. + endif + if(m == nc3_arctic_grass .or. m == nc3_nonarctic_grass .or. m == nc4_grass) then + this%is_grass(m) = .true. + else + this%is_grass(m) = .false. + endif + + end do + + if (use_cndv) then + this%fcur(:) = this%fcurdv(:) + end if + + ! jk, Dec 2021: we are not using the crop or irrigation modules at this point, so set the flags to 0 everywhere + + this%irrigated(:) = 0.0_r8 + this%crop(:) = 0.0_r8 + + ! jk Dec 2021: all PFTs are known to model since we are not using the crop model, so set flag to true everywhere + this%is_pft_known_to_model(:) = .true. + + end subroutine init_pftcon_type + +end module CNCLM_pftconMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 new file mode 100644 index 000000000..216f8c23f --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 @@ -0,0 +1,441 @@ +module CNNDynamicsMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for mineral nitrogen dynamics (deposition, fixation, leaching) + ! for coupled carbon-nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varcon , only : dzsoi_decomp, zisoi + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, nfix_timeconst + use subgridAveMod , only : p2c + use atm2lndType , only : atm2lnd_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use CropType , only : crop_type + use ColumnType , only : col + use PatchType , only : patch + use perf_mod , only : t_startf, t_stopf + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNNDynamicsReadNML ! Read in namelist for Mineral Nitrogen Dynamics + public :: CNNDeposition ! Update N deposition rate from atm forcing + public :: CNNFixation ! Update N Fixation rate + public :: CNNFert ! Update N fertilizer for crops + public :: CNSoyfix ! N Fixation for soybeans + public :: CNFreeLivingFixation ! N free living fixation + + ! + ! !PRIVATE DATA MEMBERS: + type, private :: params_type + real(r8) :: freelivfix_intercept ! intercept of line of free living fixation with annual ET + real(r8) :: freelivfix_slope_wET ! slope of line of free living fixation with annual ET + end type params_type + type(params_type) :: params_inst + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNNDynamicsReadNML( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for Mineral Nitrogen Dynamics + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'CNNDynamicsReadNML' + character(len=*), parameter :: nmlname = 'mineral_nitrogen_dynamics' + !----------------------------------------------------------------------- + real(r8) :: freelivfix_intercept ! intercept of line of free living fixation with annual ET + real(r8) :: freelivfix_slope_wET ! slope of line of free living fixation with annual ET + namelist /mineral_nitrogen_dynamics/ freelivfix_slope_wET, freelivfix_intercept + + ! Initialize options to default values, in case they are not specified in + ! the namelist + + + freelivfix_intercept = 0.0117_r8 + freelivfix_slope_wET = 0.0006_r8 + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=mineral_nitrogen_dynamics, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(__FILE__, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(__FILE__, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (freelivfix_intercept, mpicom) + call shr_mpi_bcast (freelivfix_slope_wET, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=mineral_nitrogen_dynamics) + write(iulog,*) ' ' + end if + params_inst%freelivfix_intercept = freelivfix_intercept + params_inst%freelivfix_slope_wET = freelivfix_slope_wET + + end subroutine CNNDynamicsReadNML + + !----------------------------------------------------------------------- + subroutine CNNDeposition( bounds, & + atm2lnd_inst, soilbiogeochem_nitrogenflux_inst ) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen deposition rate + ! from atmospheric forcing. For now it is assumed that all the atmospheric + ! N deposition goes to the soil mineral N pool. + ! This could be updated later to divide the inputs between mineral N absorbed + ! directly into the canopy and mineral N entering the soil pool. + ! + ! !USES: + use CNSharedParamsMod , only: use_fun + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: g,c ! indices + !----------------------------------------------------------------------- + + associate( & + forc_ndep => atm2lnd_inst%forc_ndep_grc , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) + ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col & ! Output: [real(r8) (:)] atmospheric N deposition to soil mineral N (gN/m2/s) + ) + + ! Loop through columns + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + ndep_to_sminn(c) = forc_ndep(g) + + end do + + end associate + + end subroutine CNNDeposition + + !----------------------------------------------------------------------- + subroutine CNFreeLivingFixation(num_soilc, filter_soilc, & + waterfluxbulk_inst, soilbiogeochem_nitrogenflux_inst) + + + use clm_time_manager , only : get_days_per_year + use shr_sys_mod , only : shr_sys_flush + use clm_varcon , only : secspday, spval + + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + ! + ! !LOCAL VARIABLES: + integer :: c,fc !indices + real(r8) :: dayspyr !days per year + real(r8) :: secs_per_year !seconds per year + + associate( & + AnnET => waterfluxbulk_inst%AnnET, & ! Input: [real(:) ] : Annual average ET flux mmH20/s + freelivfix_slope => params_inst%freelivfix_slope_wET, & ! Input: [real ] : slope of fixation with ET + freelivfix_inter => params_inst%freelivfix_intercept, & ! Input: [real ] : intercept of fixation with ET + ffix_to_sminn => soilbiogeochem_nitrogenflux_inst%ffix_to_sminn_col & ! Output: [real(:) ] : free living N fixation to soil mineral N (gN/m2/s) + ) + + dayspyr = get_days_per_year() + secs_per_year = dayspyr*24_r8*3600_r8 + + do fc = 1,num_soilc + c = filter_soilc(fc) + ffix_to_sminn(c) = (freelivfix_slope*(max(0._r8,AnnET(c))*secs_per_year) + freelivfix_inter )/secs_per_year !(units g N m-2 s-1) + + end do + + end associate + end subroutine CNFreeLivingFixation + + !----------------------------------------------------------------------- + subroutine CNNFixation(num_soilc, filter_soilc, & + cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen fixation rate + ! as a function of annual total NPP. This rate gets updated once per year. + ! All N fixation goes to the soil mineral N pool. + ! + ! !USES: + use clm_time_manager , only : get_days_per_year + use shr_sys_mod , only : shr_sys_flush + use clm_varcon , only : secspday, spval + use CNSharedParamsMod , only: use_fun + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,fc ! indices + real(r8) :: t ! temporary + real(r8) :: dayspyr ! days per year + !----------------------------------------------------------------------- + + associate( & + cannsum_npp => cnveg_carbonflux_inst%annsum_npp_col , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) + col_lag_npp => cnveg_carbonflux_inst%lag_npp_col , & ! Input: [real(r8) (:)] (gC/m2/s) lagged net primary production + + nfix_to_sminn => soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col & ! Output: [real(r8) (:)] symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) + ) + + dayspyr = get_days_per_year() + + if ( nfix_timeconst > 0._r8 .and. nfix_timeconst < 500._r8 ) then + ! use exponential relaxation with time constant nfix_timeconst for NPP - NFIX relation + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (col_lag_npp(c) /= spval) then + ! need to put npp in units of gC/m^2/year here first + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * col_lag_npp(c)*(secspday * dayspyr))))/(secspday * dayspyr) + nfix_to_sminn(c) = max(0._r8,t) + else + nfix_to_sminn(c) = 0._r8 + endif + end do + else + ! use annual-mean values for NPP-NFIX relation + do fc = 1,num_soilc + c = filter_soilc(fc) + + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * cannsum_npp(c))))/(secspday * dayspyr) + nfix_to_sminn(c) = max(0._r8,t) + end do + endif + if(use_fun)then + nfix_to_sminn(c) = 0.0_r8 + end if + + end associate + + end subroutine CNNFixation + + !----------------------------------------------------------------------- + subroutine CNNFert(bounds, num_soilc, filter_soilc, & + cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen fertilizer for crops + ! All fertilizer goes into the soil mineral N pool. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,fc ! indices + !----------------------------------------------------------------------- + + associate( & + fert => cnveg_nitrogenflux_inst%fert_patch , & ! Input: [real(r8) (:)] nitrogen fertilizer rate (gN/m2/s) + fert_to_sminn => soilbiogeochem_nitrogenflux_inst%fert_to_sminn_col & ! Output: [real(r8) (:)] + ) + + call p2c(bounds, num_soilc, filter_soilc, & + fert(bounds%begp:bounds%endp), & + fert_to_sminn(bounds%begc:bounds%endc)) + + end associate + + end subroutine CNNFert + + !----------------------------------------------------------------------- + subroutine CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + waterdiagnosticbulk_inst, crop_inst, cnveg_state_inst, cnveg_nitrogenflux_inst , & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! This routine handles the fixation of nitrogen for soybeans based on + ! the EPICPHASE model M. Cabelguenne et al., Agricultural systems 60: 175-196, 1999 + ! N-fixation is based on soil moisture, plant growth phase, and availibility of + ! nitrogen in the soil root zone. + ! + ! !USES: + use pftconMod, only : ntmp_soybean, nirrig_tmp_soybean + use pftconMod, only : ntrp_soybean, nirrig_trp_soybean + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(crop_type) , intent(in) :: crop_inst + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fp,p,c + real(r8):: fxw,fxn,fxg,fxr ! soil water factor, nitrogen factor, growth stage factor + real(r8):: soy_ndemand ! difference between nitrogen supply and demand + real(r8):: GDDfrac + real(r8):: sminnthreshold1, sminnthreshold2 + real(r8):: GDDfracthreshold1, GDDfracthreshold2 + real(r8):: GDDfracthreshold3, GDDfracthreshold4 + !----------------------------------------------------------------------- + + associate( & + wf => waterdiagnosticbulk_inst%wf_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.5 m + + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] gdd since planting (gddplant) + croplive => crop_inst%croplive_patch , & ! Input: [logical (:) ] true if planted and not harvested + + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest + + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Input: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + soyfixn => cnveg_nitrogenflux_inst%soyfixn_patch , & ! Output: [real(r8) (:) ] nitrogen fixed to each soybean crop + + fpg => soilbiogeochem_state_inst%fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units) + + sminn => soilbiogeochem_nitrogenstate_inst%sminn_col , & ! Input: [real(r8) (:) ] (kgN/m2) soil mineral N + soyfixn_to_sminn => soilbiogeochem_nitrogenflux_inst%soyfixn_to_sminn_col & ! Output: [real(r8) (:) ] + ) + + sminnthreshold1 = 30._r8 + sminnthreshold2 = 10._r8 + GDDfracthreshold1 = 0.15_r8 + GDDfracthreshold2 = 0.30_r8 + GDDfracthreshold3 = 0.55_r8 + GDDfracthreshold4 = 0.75_r8 + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! if soybean currently growing then calculate fixation + + if (croplive(p) .and. & + (patch%itype(p) == ntmp_soybean .or. & + patch%itype(p) == nirrig_tmp_soybean .or. & + patch%itype(p) == ntrp_soybean .or. & + patch%itype(p) == nirrig_trp_soybean) ) then + + ! difference between supply and demand + + if (fpg(c) < 1._r8) then + soy_ndemand = 0._r8 + soy_ndemand = plant_ndemand(p) - plant_ndemand(p)*fpg(c) + + ! fixation depends on nitrogen, soil water, and growth stage + + ! soil water factor + + fxw = 0._r8 + fxw = wf(c)/0.85_r8 + + ! soil nitrogen factor (Beth says: CHECK UNITS) + + if (sminn(c) > sminnthreshold1) then + fxn = 0._r8 + else if (sminn(c) > sminnthreshold2 .and. sminn(c) <= sminnthreshold1) then + fxn = 1.5_r8 - .005_r8 * (sminn(c) * 10._r8) + else if (sminn(c) <= sminnthreshold2) then + fxn = 1._r8 + end if + + ! growth stage factor + ! slevis: to replace GDDfrac, assume... + ! Beth's crit_offset_gdd_def is similar to my gddmaturity + ! Beth's ac_gdd (base 5C) similar to my hui=gddplant (base 10 + ! for soy) + ! Ranges below are not firm. Are they lit. based or tuning based? + + GDDfrac = hui(p) / gddmaturity(p) + + if (GDDfrac <= GDDfracthreshold1) then + fxg = 0._r8 + else if (GDDfrac > GDDfracthreshold1 .and. GDDfrac <= GDDfracthreshold2) then + fxg = 6.67_r8 * GDDfrac - 1._r8 + else if (GDDfrac > GDDfracthreshold2 .and. GDDfrac <= GDDfracthreshold3) then + fxg = 1._r8 + else if (GDDfrac > GDDfracthreshold3 .and. GDDfrac <= GDDfracthreshold4) then + fxg = 3.75_r8 - 5._r8 * GDDfrac + else ! GDDfrac > GDDfracthreshold4 + fxg = 0._r8 + end if + + ! calculate the nitrogen fixed by the soybean + + fxr = min(1._r8, fxw, fxn) * fxg + fxr = max(0._r8, fxr) + soyfixn(p) = fxr * soy_ndemand + soyfixn(p) = min(soyfixn(p), soy_ndemand) + + else ! if nitrogen demand met, no fixation + + soyfixn(p) = 0._r8 + + end if + + else ! if not live soybean, no fixation + + soyfixn(p) = 0._r8 + + end if + end do + + call p2c(bounds, num_soilc, filter_soilc, & + soyfixn(bounds%begp:bounds%endp), & + soyfixn_to_sminn(bounds%begc:bounds%endc)) + + end associate + + end subroutine CNSoyfix + +end module CNNDynamicsMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 new file mode 100644 index 000000000..8a4eafc99 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -0,0 +1,191 @@ +module CNSharedParamsMod + + !----------------------------------------------------------------------- + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + + ! CNParamsShareInst. PGI wants the type decl. public but the instance + ! is indeed protected. A generic private statement at the start of the module + ! overrides the protected functionality with PGI + + type, public :: CNParamsShareType + real(r8) :: Q10 ! temperature dependence + real(r8) :: minpsi ! minimum soil water potential for heterotrophic resp + real(r8) :: cwd_fcel ! cellulose fraction of coarse woody debris + real(r8) :: cwd_flig ! lignin fraction of coarse woody debris + real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates + real(r8) :: decomp_depth_efolding ! e-folding depth for reduction in decomposition (m) + real(r8) :: mino2lim ! minimum anaerobic decomposition rate as a fraction of potential aerobic rate + real(r8) :: organic_max ! organic matter content (kg/m3) where soil is assumed to act like peat + logical :: constrain_stress_deciduous_onset ! if true use additional constraint on stress deciduous onset trigger + end type CNParamsShareType + + type(CNParamsShareType), protected :: CNParamsShareInst + + logical, public :: use_fun = .false. ! Use the FUN2.0 model + integer, public :: nlev_soildecomp_standard = 5 + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNParamsReadShared(ncid, namelist_file) + + use ncdio_pio , only : file_desc_t + + type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: namelist_file + + call CNParamsReadShared_netcdf(ncid) + call CNParamsReadShared_namelist(namelist_file) + + end subroutine CNParamsReadShared + + !----------------------------------------------------------------------- + subroutine CNParamsReadShared_netcdf(ncid) + ! + use ncdio_pio , only : file_desc_t, ncd_io + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + character(len=32) :: subname = 'CNParamsReadShared' + character(len=100) :: errCode = '-Error reading in CN and BGC shared params file. Var:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + ! + ! netcdf read here + ! + tString='q10_mr' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + CNParamsShareInst%Q10=tempr + + tString='minpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + CNParamsShareInst%minpsi=tempr + + tString='cwd_fcel' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + CNParamsShareInst%cwd_fcel=tempr + + tString='cwd_flig' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + CNParamsShareInst%cwd_flig=tempr + + tString='froz_q10' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + CNParamsShareInst%froz_q10=tempr + + tString='mino2lim' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + CNParamsShareInst%mino2lim=tempr + !CNParamsShareInst%mino2lim=0.2_r8 + + tString='organic_max' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + CNParamsShareInst%organic_max=tempr + + end subroutine CNParamsReadShared_netcdf + + !----------------------------------------------------------------------- + subroutine CNParamsReadShared_namelist(namelist_file) + ! + ! !DESCRIPTION: + ! Read and initialize CN Shared parameteres from the namelist. + ! + ! !USES: + use fileutils , only : relavu, getavu + use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_LOGICAL + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_mpi_mod , only : shr_mpi_bcast + + ! + implicit none + ! + + character(len=*), intent(in) :: namelist_file + + integer :: i,j,n ! loop indices + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + real(r8) :: decomp_depth_efolding = 0.0_r8 + logical :: constrain_stress_deciduous_onset = .false. + + character(len=32) :: subroutine_name = 'CNParamsReadNamelist' + character(len=10) :: namelist_group = 'bgc_shared' + + !----------------------------------------------------------------------- + + ! ---------------------------------------------------------------------- + ! Namelist Variables + ! ---------------------------------------------------------------------- + + namelist /bgc_shared/ & + decomp_depth_efolding, & + constrain_stress_deciduous_onset + + + ! Read namelist from standard input. + if (masterproc) then + + write(iulog,*) 'Attempting to read CN/BGC shared namelist parameters .....' + unitn = getavu() + write(iulog,*) 'Read in ' // namelist_group // ' namelist from: ', trim(namelist_file) + open( unitn, file=trim(namelist_file), status='old' ) + call shr_nl_find_group_name(unitn, namelist_group, status=ierr) + if (ierr == 0) then + read(unitn, bgc_shared, iostat=ierr) + if (ierr /= 0) then + call endrun(msg='error in reading in ' // namelist_group // ' namelist' // & + errMsg(sourcefile, __LINE__)) + end if + else + call endrun(msg='error in finding ' // namelist_group // ' namelist' // & + errMsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + + end if ! masterproc + + ! Broadcast the parameters from master + call shr_mpi_bcast ( decomp_depth_efolding, mpicom ) + call shr_mpi_bcast ( constrain_stress_deciduous_onset, mpicom ) + + ! Save the parameter to the instance + CNParamsShareInst%decomp_depth_efolding = decomp_depth_efolding + CNParamsShareInst%constrain_stress_deciduous_onset = constrain_stress_deciduous_onset + + ! Output read parameters to the lnd.log + if (masterproc) then + write(iulog,*) 'CN/BGC shared namelist parameters:' + write(iulog,*)' ' + write(iulog,*)' decomp_depth_efolding = ', decomp_depth_efolding + write(iulog,*)' constrain_stress_deciduous_onset = ',constrain_stress_deciduous_onset + + write(iulog,*) + + end if + + end subroutine CNParamsReadShared_namelist + +end module CNSharedParamsMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 new file mode 100644 index 000000000..9b701efb9 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -0,0 +1,1600 @@ +module CNVegetationFacade + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Facade for the CN Vegetation subsystem. + ! + ! (A "facade", in software engineering terms, is a unified interface to a set of + ! interfaces in a subsystem. The facade defines a higher-level interface that makes the + ! subsystem easier to use.) + ! + ! NOTE(wjs, 2016-02-19) I envision that we will introduce an abstract base class + ! (VegBase). Then both CNVeg and EDVeg will extend VegBase. The rest of the CLM code can + ! then have an instance of VegBase, which depending on the run, can be either a CNVeg or + ! EDVeg instance. + ! + ! In addition, we probably want an implementation when running without CN or fates - i.e., + ! an SPVeg inst. This would provide implementations for get_leafn_patch, + ! get_downreg_patch, etc., so that we don't need to handle the non-cn case here (note + ! that, currently, we return NaN for most of these getters, because these arrays are + ! invalid and shouldn't be used when running in SP mode). Also, in its EcosystemDynamics + ! routine, it would call SatellitePhenology (but note that the desired interface for + ! EcosystemDynamics would be quite different... could just pass everything needed by any + ! model, and ignore unneeded arguments). Then we can get rid of comments in this module + ! like, "only call if use_cn is true", as well as use_cn conditionals in this module. + ! + ! NOTE(wjs, 2016-02-23) Currently, SatellitePhenology is called even when running with + ! CN, for the sake of dry deposition. This seems weird to me, and my gut feeling - + ! without understanding it well - is that this should be rewritten to depend on LAI from + ! CN rather than from satellite phenology. Until that is done, the separation between SP + ! and other Veg modes will be messier. + ! + ! NOTE(wjs, 2016-02-23) Currently, this class coordinates calls to soil BGC routines as + ! well as veg BGC routines (even though it doesn't contain any soil BGC types). This is + ! because CNDriver coordinates both the veg & soil BGC. We should probably split up + ! CNDriver so that there is a cleaner separation between veg BGC and soil BGC, to allow + ! easier swapping of (for example) CN and ED. At that point, this class could + ! coordinate just the calls to veg BGC routines, with a similar facade class + ! coordinating the calls to soil BGC routines. + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use perf_mod , only : t_startf, t_stopf + use decompMod , only : bounds_type + use clm_varctl , only : iulog, use_cn, use_cndv, use_c13, use_c14 + use abortutils , only : endrun + use spmdMod , only : masterproc + use clm_time_manager , only : get_curr_date, get_ref_date + use clm_time_manager , only : get_nstep, is_end_curr_year, is_first_step + use CNBalanceCheckMod , only : cn_balance_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use FireMethodType , only : fire_method_type + use CNProductsMod , only : cn_products_type + use NutrientCompetitionMethodMod , only : nutrient_competition_method_type + use SpeciesIsotopeType , only : species_isotope_type + use SpeciesNonIsotopeType , only : species_non_isotope_type + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use atm2lndType , only : atm2lnd_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use CropType , only : crop_type + use ch4Mod , only : ch4_type + use CNDVType , only : dgvs_type + use CNDVDriverMod , only : CNDVDriver, CNDVHIST + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use FrictionVelocityMod , only : frictionvel_type + use ActiveLayerMod , only : active_layer_type + use SoilBiogeochemStateType , only : soilBiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilBiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use CNFireEmissionsMod , only : fireemis_type, CNFireEmisUpdate + use CNDriverMod , only : CNDriverInit + use CNDriverMod , only : CNDriverSummarizeStates, CNDriverSummarizeFluxes + use CNDriverMod , only : CNDriverNoLeaching, CNDriverLeaching + use CNCStateUpdate1Mod , only : CStateUpdateDynPatch + use CNNStateUpdate1Mod , only : NStateUpdateDynPatch + use CNVegStructUpdateMod , only : CNVegStructUpdate + use CNAnnualUpdateMod , only : CNAnnualUpdate + use dynConsBiogeochemMod , only : dyn_cnbal_patch, dyn_cnbal_col + use dynCNDVMod , only : dynCNDV_init, dynCNDV_interp + use CNPrecisionControlMod , only: CNPrecisionControl + use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControl + use GridcellType , only : grc + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + ! + implicit none + private + + ! !PUBLIC TYPES: + + type, public :: cn_vegetation_type + ! FIXME(bja, 2016-06) These need to be public for use when fates is + ! turned on. Should either be moved out of here or create some ED + ! version of the facade.... + type(cnveg_state_type) :: cnveg_state_inst + type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst + + !X!private + + type(cnveg_carbonstate_type) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) :: c14_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst + + type(cn_products_type) :: c_products_inst + type(cn_products_type) :: c13_products_inst + type(cn_products_type) :: c14_products_inst + type(cn_products_type) :: n_products_inst + + type(cn_balance_type) :: cn_balance_inst + class(fire_method_type), allocatable :: cnfire_method + type(dgvs_type) :: dgvs_inst + + ! Control variables + logical, private :: reseed_dead_plants ! Flag to indicate if should reseed dead plants when starting up the model + logical, private :: dribble_crophrv_xsmrpool_2atm = .False. ! Flag to indicate if should harvest xsmrpool to the atmosphere + + ! TODO(wjs, 2016-02-19) Evaluate whether some other variables should be moved in + ! here. Whether they should be moved in depends on how tightly they are tied in with + ! the other CN Vegetation stuff. A question to ask is: Is this module used when + ! running with SP or ED? If so, then it should probably remain outside of CNVeg. + ! + ! From the clm_instMod section on "CN vegetation types": + ! - nutrient_competition_method + ! - I'm pretty sure this should be moved into here; it's just a little messy to do + ! so, because of how it's initialized (specifically, the call to readParameters + ! in clm_initializeMod). + ! + ! From the clm_instMod section on "general biogeochem types": + ! - ch4_inst + ! - probably not: really seems to belong in soilbiogeochem + ! - crop_inst + ! - dust_inst + ! - vocemis_inst + ! - fireemis_inst + ! - drydepvel_inst + + contains + procedure, public :: Init + procedure, public :: InitAccBuffer + procedure, public :: InitAccVars + procedure, public :: UpdateAccVars + procedure, public :: Restart + + procedure, public :: Init2 ! Do initialization in initialize phase, after subgrid weights are determined + procedure, public :: InitEachTimeStep ! Do initializations at the start of each time step + procedure, public :: InterpFileInputs ! Interpolate inputs from files + procedure, public :: UpdateSubgridWeights ! Update subgrid weights if running with prognostic patch weights + procedure, public :: DynamicAreaConservation ! Conserve C & N with updates in subgrid weights + procedure, public :: InitColumnBalance ! Set the starting point for col-level balance checks + procedure, public :: InitGridcellBalance ! Set the starting point for gridcell-level balance checks + procedure, public :: EcosystemDynamicsPreDrainage ! Do the main science that needs to be done before hydrology-drainage + procedure, public :: EcosystemDynamicsPostDrainage ! Do the main science that needs to be done after hydrology-drainage + procedure, public :: BalanceCheck ! Check the carbon and nitrogen balance + procedure, public :: EndOfTimeStepVegDynamics ! Do vegetation dynamics that should be done at the end of each time step + procedure, public :: WriteHistory ! Do any history writes that are specific to veg dynamics + + procedure, public :: get_net_carbon_exchange_grc ! Get gridcell-level net carbon exchange array + procedure, public :: get_leafn_patch ! Get patch-level leaf nitrogen array + procedure, public :: get_downreg_patch ! Get patch-level downregulation array + procedure, public :: get_root_respiration_patch ! Get patch-level root respiration array + procedure, public :: get_annsum_npp_patch ! Get patch-level annual sum NPP array + procedure, public :: get_agnpp_patch ! Get patch-level aboveground NPP array + procedure, public :: get_bgnpp_patch ! Get patch-level belowground NPP array + procedure, public :: get_froot_carbon_patch ! Get patch-level fine root carbon array + procedure, public :: get_croot_carbon_patch ! Get patch-level coarse root carbon array + procedure, public :: get_totvegc_col ! Get column-level total vegetation carbon array + + procedure, private :: CNReadNML ! Read in the CN general namelist + end type cn_vegetation_type + + ! !PRIVATE DATA MEMBERS: + + integer, private :: skip_steps ! Number of steps to skip at startup + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) + ! + ! !DESCRIPTION: + ! Initialize a CNVeg object. + ! + ! Should be called regardless of whether use_cn is true + ! + ! !USES: + use CNFireFactoryMod , only : create_cnfire_method + use clm_varcon , only : c13ratio, c14ratio + use ncdio_pio , only : file_desc_t + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + character(len=*) , intent(in) :: NLFilename ! namelist filename + integer , intent(in) :: nskip_steps ! Number of steps to skip at startup + type(file_desc_t), intent(inout) :: params_ncid ! NetCDF handle to parameter file + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'Init' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + ! Note - always initialize the memory for cnveg_state_inst (used in biogeophys/) + call this%cnveg_state_inst%Init(bounds) + + skip_steps = nskip_steps + + if (use_cn) then + + ! Read in the general CN namelist + call this%CNReadNML( NLFilename ) ! MUST be called first as passes down control information to others + + call this%cnveg_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8, & + NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm ) + if (use_c13) then + call this%c13_cnveg_carbonstate_inst%Init(bounds, carbon_type='c13', ratio=c13ratio, & + NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & + c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) + end if + if (use_c14) then + call this%c14_cnveg_carbonstate_inst%Init(bounds, carbon_type='c14', ratio=c14ratio, & + NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & + c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) + end if + call this%cnveg_carbonflux_inst%Init(bounds, carbon_type='c12', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm ) + if (use_c13) then + call this%c13_cnveg_carbonflux_inst%Init(bounds, carbon_type='c13', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm) + end if + if (use_c14) then + call this%c14_cnveg_carbonflux_inst%Init(bounds, carbon_type='c14', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm) + end if + call this%cnveg_nitrogenstate_inst%Init(bounds, & + this%cnveg_carbonstate_inst%leafc_patch(begp:endp), & + this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), & + this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & + this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & + this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp) ) + call this%cnveg_nitrogenflux_inst%Init(bounds) + + call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) + if (use_c13) then + call this%c13_products_inst%Init(bounds, species_isotope_type('C', '13')) + end if + if (use_c14) then + call this%c14_products_inst%Init(bounds, species_isotope_type('C', '14')) + end if + call this%n_products_inst%Init(bounds, species_non_isotope_type('N')) + + call this%cn_balance_inst%Init(bounds) + + ! Initialize the memory for the dgvs_inst data structure regardless of whether + ! use_cndv is true so that it can be used in associate statements (nag compiler + ! complains otherwise) + call this%dgvs_inst%Init(bounds) + end if + + call create_cnfire_method(NLFilename, this%cnfire_method) + call this%cnfire_method%CNFireReadParams( params_ncid ) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine CNReadNML( this, NLFilename ) + ! + ! !DESCRIPTION: + ! Read in the general CN control namelist + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + character(len=*) , intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'CNReadNML' + character(len=*), parameter :: nmlname = 'cn_general' ! MUST match what is in namelist below + !----------------------------------------------------------------------- + logical :: reseed_dead_plants + logical :: dribble_crophrv_xsmrpool_2atm + namelist /cn_general/ reseed_dead_plants, dribble_crophrv_xsmrpool_2atm + + reseed_dead_plants = this%reseed_dead_plants + dribble_crophrv_xsmrpool_2atm = this%dribble_crophrv_xsmrpool_2atm + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=cn_general, iostat=ierr) ! Namelist name here MUST be the same as in nmlname above! + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (reseed_dead_plants , mpicom) + call shr_mpi_bcast (dribble_crophrv_xsmrpool_2atm , mpicom) + + this%reseed_dead_plants = reseed_dead_plants + this%dribble_crophrv_xsmrpool_2atm = dribble_crophrv_xsmrpool_2atm + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=cn_general) ! Name here MUST be the same as in nmlname above! + write(iulog,*) ' ' + end if + + !----------------------------------------------------------------------- + + end subroutine CNReadNML + + + !----------------------------------------------------------------------- + subroutine InitAccBuffer(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize accumulation buffer for types contained here + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'InitAccBuffer' + !----------------------------------------------------------------------- + + if (use_cndv) then + call this%dgvs_inst%InitAccBuffer(bounds) + end if + + end subroutine InitAccBuffer + + !----------------------------------------------------------------------- + subroutine InitAccVars(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize variables that are associated with accumulated fields + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'InitAccVars' + !----------------------------------------------------------------------- + + if (use_cndv) then + call this%dgvs_inst%initAccVars(bounds) + end if + + end subroutine InitAccVars + + !----------------------------------------------------------------------- + subroutine UpdateAccVars(this, bounds, t_a10_patch, t_ref2m_patch) + ! + ! !DESCRIPTION: + ! Update accumulated variables + ! + ! Should be called every time step + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! NOTE(wjs, 2016-02-23) These need to be pointers to agree with the interface of + ! UpdateAccVars in CNDVType (they are pointers there as a workaround for a compiler + ! bug). + real(r8), pointer , intent(in) :: t_a10_patch(:) ! 10-day running mean of the 2 m temperature (K) + real(r8), pointer , intent(in) :: t_ref2m_patch(:) ! 2 m height surface air temperature (K) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'UpdateAccVars' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(t_a10_patch) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(t_ref2m_patch) == (/bounds%endp/)), sourcefile, __LINE__) + + if (use_cndv) then + call this%dgvs_inst%UpdateAccVars(bounds, & + t_a10_patch = t_a10_patch, & + t_ref2m_patch = t_ref2m_patch) + end if + + end subroutine UpdateAccVars + + + !----------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Handle restart (read / write) for CNVeg + ! + ! Should be called regardless of whether use_cn is true + ! + ! !USES: + use ncdio_pio, only : file_desc_t + use clm_varcon, only : c3_r2, c14ratio + use clm_varctl, only : use_soil_matrixcn, use_matrixcn + use CNVegMatrixMod, only : CNVegMatrixRest + use CNSoilMatrixMod, only : CNSoilMatrixRest + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid + character(len=*) , intent(in) :: flag + integer :: reseed_patch(bounds%endp-bounds%begp+1) + integer :: num_reseed_patch + ! + ! !LOCAL VARIABLES: + + integer :: begp, endp + real(r8) :: spinup_factor4deadwood ! Spinup factor used for deadwood (dead-stem and dead course root) + + character(len=*), parameter :: subname = 'Restart' + !----------------------------------------------------------------------- + + if (use_cn) then + begp = bounds%begp + endp = bounds%endp + call this%cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c12', & + reseed_dead_plants=this%reseed_dead_plants, filter_reseed_patch=reseed_patch, & + num_reseed_patch=num_reseed_patch, spinup_factor4deadwood=spinup_factor4deadwood ) + if ( flag /= 'read' .and. num_reseed_patch /= 0 )then + call endrun(msg="ERROR num_reseed should be zero and is not"//errmsg(sourcefile, __LINE__)) + end if + if ( flag /= 'read' .and. spinup_factor4deadwood /= 10_r8 )then + call endrun(msg="ERROR spinup_factor4deadwood should be 10 and is not"//errmsg(sourcefile, __LINE__)) + end if + if (use_c13) then + call this%c13_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c13', & + reseed_dead_plants=this%reseed_dead_plants, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) + end if + if (use_c14) then + call this%c14_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c14', & + reseed_dead_plants=this%reseed_dead_plants, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) + end if + + call this%cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c12') + if (use_c13) then + call this%c13_cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c13') + end if + if (use_c14) then + call this%c14_cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c14') + end if + + call this%cnveg_nitrogenstate_inst%restart(bounds, ncid, flag=flag, & + leafc_patch=this%cnveg_carbonstate_inst%leafc_patch(begp:endp), & + leafc_storage_patch=this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), & + frootc_patch=this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & + frootc_storage_patch=this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & + deadstemc_patch=this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp), & + filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch, & + spinup_factor_deadwood=spinup_factor4deadwood ) + call this%cnveg_nitrogenflux_inst%restart(bounds, ncid, flag=flag) + call this%cnveg_state_inst%restart(bounds, ncid, flag=flag, & + cnveg_carbonstate=this%cnveg_carbonstate_inst, & + cnveg_nitrogenstate=this%cnveg_nitrogenstate_inst, & + filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch) + + call this%c_products_inst%restart(bounds, ncid, flag) + if (use_c13) then + call this%c13_products_inst%restart(bounds, ncid, flag, & + template_for_missing_fields = this%c_products_inst, & + template_multiplier = c3_r2) + end if + if (use_c14) then + call this%c14_products_inst%restart(bounds, ncid, flag, & + template_for_missing_fields = this%c_products_inst, & + template_multiplier = c14ratio) + end if + call this%n_products_inst%restart(bounds, ncid, flag) + + if ( use_matrixcn )then + call CNVegMatrixRest( ncid, flag ) + end if + end if + + if ( use_soil_matrixcn )then + call CNSoilMatrixRest( ncid, flag ) + end if + + if (use_cndv) then + call this%dgvs_inst%Restart(bounds, ncid, flag=flag) + end if + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine Init2(this, bounds, NLFilename) + ! + ! !DESCRIPTION: + ! Do initialization that is needed in the initialize phase, after subgrid weights are + ! determined + ! + ! Should only be called if use_cn is true + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: NLFilename ! namelist filename + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'Init2' + !----------------------------------------------------------------------- + + call CNDriverInit(bounds, NLFilename, this%cnfire_method) + + if (use_cndv) then + call dynCNDV_init(bounds, this%dgvs_inst) + end if + + end subroutine Init2 + + + !----------------------------------------------------------------------- + subroutine InitEachTimeStep(this, bounds, num_soilc, filter_soilc) + ! + ! !DESCRIPTION: + ! Do initializations that need to be done at the start of every time step + ! + ! This includes zeroing fluxes + ! + ! Should only be called if use_cn is true + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'InitEachTimeStep' + !----------------------------------------------------------------------- + + call this%cnveg_carbonflux_inst%ZeroDWT(bounds) + if (use_c13) then + call this%c13_cnveg_carbonflux_inst%ZeroDWT(bounds) + end if + if (use_c14) then + call this%c14_cnveg_carbonflux_inst%ZeroDWT(bounds) + end if + call this%cnveg_nitrogenflux_inst%ZeroDWT(bounds) + call this%cnveg_carbonstate_inst%ZeroDWT(bounds) + call this%cnveg_nitrogenstate_inst%ZeroDWT(bounds) + + end subroutine InitEachTimeStep + + !----------------------------------------------------------------------- + subroutine InterpFileInputs(this, bounds) + ! + ! !DESCRIPTION: + ! Interpolate inputs from files + ! + ! NOTE(wjs, 2016-02-23) Stuff done here could probably be done at the end of + ! InitEachTimeStep, rather than in this separate routine, except for the fact that + ! (currently) this Interp stuff is done with proc bounds rather thna clump bounds. I + ! think that is needed so that you don't update a given stream multiple times. If we + ! rework the handling of threading / clumps so that there is a separate object for + ! each clump, then I think this problem would disappear - at which point we could + ! remove this Interp routine, moving its body to the end of InitEachTimeStep. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'InterpFileInputs' + !----------------------------------------------------------------------- + + call this%cnfire_method%FireInterp(bounds) + + end subroutine InterpFileInputs + + + !----------------------------------------------------------------------- + subroutine UpdateSubgridWeights(this, bounds) + ! + ! !DESCRIPTION: + ! Update subgrid weights if running with prognostic patch weights + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'UpdateSubgridWeights' + !----------------------------------------------------------------------- + + if (use_cndv) then + call dynCNDV_interp(bounds, this%dgvs_inst) + end if + + end subroutine UpdateSubgridWeights + + + !----------------------------------------------------------------------- + subroutine DynamicAreaConservation(this, bounds, clump_index, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + num_soilc_with_inactive, filter_soilc_with_inactive, & + prior_weights, patch_state_updater, column_state_updater, & + canopystate_inst, photosyns_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, ch4_inst, soilbiogeochem_state_inst) + ! + ! !DESCRIPTION: + ! Conserve C & N with updates in subgrid weights + ! + ! Should only be called if use_cn is true + ! + ! !USES: + use dynPriorWeightsMod , only : prior_weights_type + use dynPatchStateUpdaterMod, only : patch_state_updater_type + use dynColumnStateUpdaterMod, only : column_state_updater_type + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + + ! Index of clump on which we're currently operating. Note that this implies that this + ! routine must be called from within a clump loop. + integer , intent(in) :: clump_index + + integer , intent(in) :: num_soilp_with_inactive ! number of points in filter_soilp_with_inactive + integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points + integer , intent(in) :: num_soilc_with_inactive ! number of points in filter_soilc_with_inactive + integer , intent(in) :: filter_soilc_with_inactive(:) ! soil column filter that includes inactive points + type(prior_weights_type) , intent(in) :: prior_weights ! weights prior to the subgrid weight updates + type(patch_state_updater_type) , intent(in) :: patch_state_updater + type(column_state_updater_type) , intent(in) :: column_state_updater + type(canopystate_type) , intent(inout) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(ch4_type) , intent(inout) :: ch4_inst + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'DynamicAreaConservation' + !----------------------------------------------------------------------- + + call t_startf('dyn_cnbal_patch') + call dyn_cnbal_patch(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + prior_weights, patch_state_updater, & + canopystate_inst, photosyns_inst, & + this%cnveg_state_inst, & + this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, this%c14_cnveg_carbonstate_inst, & + this%cnveg_carbonflux_inst, this%c13_cnveg_carbonflux_inst, this%c14_cnveg_carbonflux_inst, & + this%cnveg_nitrogenstate_inst, this%cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_state_inst) + call t_stopf('dyn_cnbal_patch') + + ! It is important to update column-level state variables based on the fluxes + ! generated by dyn_cnbal_patch (which handles the change in aboveground / patch-level + ! C/N due to shrinking patches), before calling dyn_cnbal_col (which handles the + ! change in belowground / column-level C/N due to changing column areas). This way, + ! any aboveground biomass which is sent to litter or soil due to shrinking patch + ! areas is accounted for by the column-level conservation. This is important if + ! column weights on the grid cell are changing at the same time as patch weights on + ! the grid cell (which will typically be the case when columns change in area). + ! + ! The filters here need to include inactive points as well as active points so that + ! we correctly update column states in columns that have just shrunk to 0 area - + ! since those column states are still important in the following dyn_cnbal_col. + call t_startf('CNUpdateDynPatch') + call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & + this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst ) + if (use_c13) then + call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & + this%c13_cnveg_carbonflux_inst, this%c13_cnveg_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst) + end if + if (use_c14) then + call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & + this%c14_cnveg_carbonflux_inst, this%c14_cnveg_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst) + end if + call NStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & + this%cnveg_nitrogenflux_inst, this%cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst ) + call t_stopf('CNUpdateDynPatch') + + ! This call fixes issue #741 by performing precision control on decomp_cpools_vr_col + call t_startf('SoilBiogeochemPrecisionControl') + call SoilBiogeochemPrecisionControl(num_soilc_with_inactive, filter_soilc_with_inactive, & + soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) + call t_stopf('SoilBiogeochemPrecisionControl') + + call t_startf('dyn_cnbal_col') + call dyn_cnbal_col(bounds, clump_index, column_state_updater, & + soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst, & + ch4_inst) + call t_stopf('dyn_cnbal_col') + + end subroutine DynamicAreaConservation + + !----------------------------------------------------------------------- + subroutine InitColumnBalance(this, bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Set the starting point for column-level balance checks. + ! + ! This should be called after DynamicAreaConservation, since the changes made by + ! DynamicAreaConservation can break column-level conservation checks. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'InitColumnBalance' + !----------------------------------------------------------------------- + + call CNDriverSummarizeStates(bounds, & + num_allc, filter_allc, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + this%cnveg_carbonstate_inst, & + this%c13_cnveg_carbonstate_inst, & + this%c14_cnveg_carbonstate_inst, & + this%cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst) + + call this%cn_balance_inst%BeginCNColumnBalance( & + bounds, num_soilc, filter_soilc, & + this%cnveg_carbonstate_inst, this%cnveg_nitrogenstate_inst) + + end subroutine InitColumnBalance + + + !----------------------------------------------------------------------- + subroutine InitGridcellBalance(this, bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Set the starting point for gridcell-level balance checks. + ! + ! Gridcell level: + ! Called before DynamicAreaConservation. + ! + ! !USES: + use subgridAveMod, only : c2g + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'InitGridcellBalance' + !----------------------------------------------------------------------- + + call CNDriverSummarizeStates(bounds, & + num_allc, filter_allc, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + this%cnveg_carbonstate_inst, & + this%c13_cnveg_carbonstate_inst, & + this%c14_cnveg_carbonstate_inst, & + this%cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst) + + ! total gridcell carbon (TOTGRIDCELLC) + call c2g( bounds = bounds, & + carr = this%cnveg_carbonstate_inst%totc_col(bounds%begc:bounds%endc), & + garr = this%cnveg_carbonstate_inst%totc_grc(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + ! total gridcell nitrogen (TOTGRIDCELLN) + call c2g( bounds = bounds, & + carr = this%cnveg_nitrogenstate_inst%totn_col(bounds%begc:bounds%endc), & + garr = this%cnveg_nitrogenstate_inst%totn_grc(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + call this%cn_balance_inst%BeginCNGridcellBalance( bounds, & + this%cnveg_carbonflux_inst, & + this%cnveg_carbonstate_inst, this%cnveg_nitrogenstate_inst, & + this%c_products_inst, this%n_products_inst) + + end subroutine InitGridcellBalance + + + !----------------------------------------------------------------------- + subroutine EcosystemDynamicsPreDrainage(this, bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, & + num_actfirep, filter_actfirep, & + num_pcropp, filter_pcropp, & + num_exposedvegp, filter_exposedvegp, & + num_noexposedvegp, filter_noexposedvegp, & + doalb, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + active_layer_inst, & + atm2lnd_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, & + wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + soil_water_retention_curve, crop_inst, ch4_inst, & + photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & + nutrient_competition_method, fireemis_inst) + ! + ! !DESCRIPTION: + ! Do the main science for CN vegetation that needs to be done before hydrology-drainage + ! + ! Should only be called if use_cn is true + ! + ! !USES: + + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(out) :: num_actfirec ! number of soil columns on fire in filter + integer , intent(out) :: filter_actfirec(:)! filter for soil columns on fire + integer , intent(out) :: num_actfirep ! number of soil patches on fire in filter + integer , intent(out) :: filter_actfirep(:)! filter for soil patches on fire + integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter + integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + logical , intent(in) :: doalb ! true = surface albedo calculation time step + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(active_layer_type) , intent(in) :: active_layer_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + class(soil_water_retention_curve_type) , intent(in) :: soil_water_retention_curve + type(crop_type) , intent(inout) :: crop_inst + type(ch4_type) , intent(in) :: ch4_inst + type(photosyns_type) , intent(in) :: photosyns_inst + type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst + type(energyflux_type) , intent(in) :: energyflux_inst + class(nutrient_competition_method_type) , intent(inout) :: nutrient_competition_method + type(fireemis_type) , intent(inout) :: fireemis_inst + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'EcosystemDynamicsPreDrainage' + !----------------------------------------------------------------------- + + call crop_inst%CropIncrementYear(num_pcropp, filter_pcropp) + + call CNDriverNoLeaching(bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, & + num_actfirep, filter_actfirep, & + num_pcropp, filter_pcropp, & + num_exposedvegp, filter_exposedvegp, & + num_noexposedvegp, filter_noexposedvegp, & + doalb, & + this%cnveg_state_inst, & + this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, & + this%c13_cnveg_carbonflux_inst, this%c13_cnveg_carbonstate_inst, & + this%c14_cnveg_carbonflux_inst, this%c14_cnveg_carbonstate_inst, & + this%cnveg_nitrogenflux_inst, this%cnveg_nitrogenstate_inst, & + this%c_products_inst, this%c13_products_inst, this%c14_products_inst, & + this%n_products_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + active_layer_inst, & + atm2lnd_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, & + wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + soil_water_retention_curve, crop_inst, ch4_inst, & + this%dgvs_inst, photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & + nutrient_competition_method, this%cnfire_method, this%dribble_crophrv_xsmrpool_2atm) + + ! fire carbon emissions + call CNFireEmisUpdate(bounds, num_soilp, filter_soilp, & + this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, fireemis_inst ) + + call CNAnnualUpdate(bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + this%cnveg_state_inst, this%cnveg_carbonflux_inst) + + end subroutine EcosystemDynamicsPreDrainage + + !----------------------------------------------------------------------- + subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, num_actfirec, filter_actfirec, num_actfirep, filter_actfirep,& + doalb, crop_inst, soilstate_inst, soilbiogeochem_state_inst, & + waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Do the main science for CN vegetation that needs to be done after hydrology-drainage + ! + ! Should only be called if use_cn is true + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_actfirec ! number of soil columns on fire in filter + integer , intent(in) :: filter_actfirec(:) ! filter for soil columns on fire + integer , intent(in) :: num_actfirep ! number of soil patches on fire in filter + integer , intent(in) :: filter_actfirep(:) ! filter for soil patches on fire + logical , intent(in) :: doalb ! true = surface albedo calculation time step + type(crop_type) , intent(in) :: crop_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'EcosystemDynamicsPostDrainage' + !----------------------------------------------------------------------- + + ! Update the nitrogen leaching rate as a function of soluble mineral N + ! and total soil water outflow. + + call CNDriverLeaching(bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, & + num_actfirep, filter_actfirep, & + waterstatebulk_inst, waterfluxbulk_inst, soilstate_inst, this%cnveg_state_inst, & + this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst,soilbiogeochem_state_inst, & + this%cnveg_nitrogenflux_inst, this%cnveg_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst,& + this%c13_cnveg_carbonstate_inst,this%c14_cnveg_carbonstate_inst, & + this%c13_cnveg_carbonflux_inst,this%c14_cnveg_carbonflux_inst, & + c13_soilbiogeochem_carbonstate_inst,c14_soilbiogeochem_carbonstate_inst,& + c13_soilbiogeochem_carbonflux_inst,c14_soilbiogeochem_carbonflux_inst) + + ! Set controls on very low values in critical state variables + + call t_startf('CNPrecisionControl') + call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, & + this%c14_cnveg_carbonstate_inst, this%cnveg_nitrogenstate_inst) + call t_stopf('CNPrecisionControl') + + call t_startf('SoilBiogeochemPrecisionControl') + call SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & + soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) + call t_stopf('SoilBiogeochemPrecisionControl') + + ! Call to all CN summary routines + + call CNDriverSummarizeStates(bounds, & + num_allc, filter_allc, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + this%cnveg_carbonstate_inst, & + this%c13_cnveg_carbonstate_inst, & + this%c14_cnveg_carbonstate_inst, & + this%cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst) + + call CNDriverSummarizeFluxes(bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + this%cnveg_carbonflux_inst, & + this%c13_cnveg_carbonflux_inst, & + this%c14_cnveg_carbonflux_inst, & + this%cnveg_nitrogenflux_inst, & + this%c_products_inst, this%c13_products_inst, this%c14_products_inst, & + soilbiogeochem_carbonflux_inst, & + c13_soilbiogeochem_carbonflux_inst, & + c14_soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst) + + ! On the radiation time step, use C state variables to calculate + ! vegetation structure (LAI, SAI, height) + + if (doalb) then + call CNVegStructUpdate(bounds,num_soilp, filter_soilp, & + waterdiagnosticbulk_inst, frictionvel_inst, this%dgvs_inst, this%cnveg_state_inst, & + crop_inst, this%cnveg_carbonstate_inst, canopystate_inst) + end if + + end subroutine EcosystemDynamicsPostDrainage + + !----------------------------------------------------------------------- + subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & + atm2lnd_inst) + ! + ! !DESCRIPTION: + ! Check the carbon and nitrogen balance + ! + ! Should only be called if use_cn is true + ! + ! !USES: + use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause + ! + ! !ARGUMENTS: + class(cn_vegetation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + ! + ! !LOCAL VARIABLES: + integer :: DA_nstep ! time step number + + character(len=*), parameter :: subname = 'BalanceCheck' + !----------------------------------------------------------------------- + + DA_nstep = get_nstep_since_startup_or_lastDA_restart_or_pause() + if (DA_nstep <= skip_steps )then + if (masterproc) then + write(iulog,*) '--WARNING-- skipping CN balance check for first timesteps after startup or data assimilation' + end if + else + + call this%cn_balance_inst%CBalanceCheck( & + bounds, num_soilc, filter_soilc, & + soilbiogeochem_carbonflux_inst, & + this%cnveg_carbonflux_inst, & + this%cnveg_carbonstate_inst, & + this%c_products_inst) + + call this%cn_balance_inst%NBalanceCheck( & + bounds, num_soilc, filter_soilc, & + soilbiogeochem_nitrogenflux_inst, & + this%cnveg_nitrogenflux_inst, & + this%cnveg_nitrogenstate_inst, & + this%n_products_inst, & + atm2lnd_inst) + + end if + + end subroutine BalanceCheck + + !----------------------------------------------------------------------- + subroutine EndOfTimeStepVegDynamics(this, bounds, num_natvegp, filter_natvegp, & + atm2lnd_inst, wateratm2lndbulk_inst) + ! + ! !DESCRIPTION: + ! Do vegetation dynamics that should be done at the end of each time step + ! + ! Should only be called if use_cn is true + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(inout) :: num_natvegp ! number of naturally-vegetated patches in filter + integer , intent(inout) :: filter_natvegp(:) ! filter for naturally-vegetated patches + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst + type(wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst + ! + ! !LOCAL VARIABLES: + integer :: nstep ! time step number + integer :: yr ! year (0, ...) + integer :: mon ! month (1, ..., 12) + integer :: day ! day of month (1, ..., 31) + integer :: sec ! seconds of the day + integer :: ncdate ! current date + integer :: nbdate ! base date (reference date) + integer :: kyr ! thousand years, equals 2 at end of first year + + character(len=*), parameter :: subname = 'EndOfTimeStepVegDynamics' + !----------------------------------------------------------------------- + + if (use_cndv) then + ! Call dv (dynamic vegetation) at last time step of year + + call t_startf('d2dgvm') + if (is_end_curr_year() .and. .not. is_first_step()) then + + ! Get date info. kyr is used in lpj(). At end of first year, kyr = 2. + call get_curr_date(yr, mon, day, sec) + ncdate = yr*10000 + mon*100 + day + call get_ref_date(yr, mon, day, sec) + nbdate = yr*10000 + mon*100 + day + kyr = ncdate/10000 - nbdate/10000 + 1 + + if (masterproc) then + nstep = get_nstep() + write(iulog,*) 'End of year. CNDV called now: ncdate=', & + ncdate,' nbdate=',nbdate,' kyr=',kyr,' nstep=', nstep + end if + + call CNDVDriver(bounds, & + num_natvegp, filter_natvegp, kyr, & + atm2lnd_inst, wateratm2lndbulk_inst, & + this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, this%dgvs_inst) + end if + call t_stopf('d2dgvm') + end if + + end subroutine EndOfTimeStepVegDynamics + + !----------------------------------------------------------------------- + subroutine WriteHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Do any history writes that are specific to vegetation dynamics + ! + ! NOTE(wjs, 2016-02-23) This could probably be combined with + ! EndOfTimeStepVegDynamics, except for the fact that (currently) history writes are + ! done with proc bounds rather than clump bounds. If that were changed, then the body + ! of this could be moved into EndOfTimeStepVegDynamics, inside a "if (.not. + ! use_noio)" conditional. + ! + ! Should only be called if use_cn is true + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'WriteHistory' + !----------------------------------------------------------------------- + + ! Write to CNDV history buffer if appropriate + if (use_cndv) then + if (is_end_curr_year() .and. .not. is_first_step()) then + call t_startf('clm_drv_io_hdgvm') + call CNDVHist( bounds, this%dgvs_inst ) + if (masterproc) write(iulog,*) 'Annual CNDV calculations are complete' + call t_stopf('clm_drv_io_hdgvm') + end if + end if + + end subroutine WriteHistory + + + !----------------------------------------------------------------------- + function get_net_carbon_exchange_grc(this, bounds) result(net_carbon_exchange_grc) + ! + ! !DESCRIPTION: + ! Get gridcell-level net carbon exchange array + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) :: net_carbon_exchange_grc(bounds%begg:bounds%endg) ! function result: net carbon exchange between land and atmosphere, includes fire, landuse, harvest and hrv_xsmrpool flux, positive for source (gC/m2/s) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_net_carbon_exchange_grc' + !----------------------------------------------------------------------- + + if (use_cn) then + net_carbon_exchange_grc(bounds%begg:bounds%endg) = & + -this%cnveg_carbonflux_inst%nbp_grc(bounds%begg:bounds%endg) + else + net_carbon_exchange_grc(bounds%begg:bounds%endg) = 0._r8 + end if + + end function get_net_carbon_exchange_grc + + + !----------------------------------------------------------------------- + function get_leafn_patch(this, bounds) result(leafn_patch) + ! + ! !DESCRIPTION: + ! Get patch-level leaf nitrogen array + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) :: leafn_patch(bounds%begp:bounds%endp) ! function result: leaf N (gN/m2) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_leafn_patch' + !----------------------------------------------------------------------- + + if (use_cn) then + leafn_patch(bounds%begp:bounds%endp) = & + this%cnveg_nitrogenstate_inst%leafn_patch(bounds%begp:bounds%endp) + else + leafn_patch(bounds%begp:bounds%endp) = nan + end if + + end function get_leafn_patch + + !----------------------------------------------------------------------- + function get_downreg_patch(this, bounds) result(downreg_patch) + ! + ! !DESCRIPTION: + ! Get patch-level downregulation array + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) :: downreg_patch(bounds%begp:bounds%endp) ! function result: fractional reduction in GPP due to N limitation (dimensionless) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_downreg_patch' + !----------------------------------------------------------------------- + + if (use_cn) then + downreg_patch(bounds%begp:bounds%endp) = & + this%cnveg_state_inst%downreg_patch(bounds%begp:bounds%endp) + else + downreg_patch(bounds%begp:bounds%endp) = nan + end if + + end function get_downreg_patch + + !----------------------------------------------------------------------- + function get_root_respiration_patch(this, bounds) result(root_respiration_patch) + ! + ! !DESCRIPTION: + ! Get patch-level root respiration array + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) :: root_respiration_patch(bounds%begp:bounds%endp) ! function result: root respiration (fine root MR + total root GR) (gC/m2/s) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_root_respiration_patch' + !----------------------------------------------------------------------- + + if (use_cn) then + root_respiration_patch(bounds%begp:bounds%endp) = & + this%cnveg_carbonflux_inst%rr_patch(bounds%begp:bounds%endp) + else + root_respiration_patch(bounds%begp:bounds%endp) = nan + end if + + end function get_root_respiration_patch + + ! TODO(wjs, 2016-02-19) annsum_npp, agnpp and bgnpp are all needed for the estimation + ! of tillers in ch4Mod. Rather than providing getters for these three things so that + ! ch4Mod can estimate tillers, it would probably be better if the tiller estimation + ! algorithm was moved into some CNVeg-specific module, and then tillers could be + ! queried directly. + + !----------------------------------------------------------------------- + function get_annsum_npp_patch(this, bounds) result(annsum_npp_patch) + ! + ! !DESCRIPTION: + ! Get patch-level annual sum NPP array + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) :: annsum_npp_patch(bounds%begp:bounds%endp) ! function result: annual sum NPP (gC/m2/yr) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_annsum_npp_patch' + !----------------------------------------------------------------------- + + if (use_cn) then + annsum_npp_patch(bounds%begp:bounds%endp) = & + this%cnveg_carbonflux_inst%annsum_npp_patch(bounds%begp:bounds%endp) + else + annsum_npp_patch(bounds%begp:bounds%endp) = nan + end if + + end function get_annsum_npp_patch + + !----------------------------------------------------------------------- + function get_agnpp_patch(this, bounds) result(agnpp_patch) + ! + ! !DESCRIPTION: + ! Get patch-level aboveground NPP array + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) :: agnpp_patch(bounds%begp:bounds%endp) ! function result: aboveground NPP (gC/m2/s) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_agnpp_patch' + !----------------------------------------------------------------------- + + if (use_cn) then + agnpp_patch(bounds%begp:bounds%endp) = & + this%cnveg_carbonflux_inst%agnpp_patch(bounds%begp:bounds%endp) + else + agnpp_patch(bounds%begp:bounds%endp) = nan + end if + + end function get_agnpp_patch + + !----------------------------------------------------------------------- + function get_bgnpp_patch(this, bounds) result(bgnpp_patch) + ! + ! !DESCRIPTION: + ! Get patch-level belowground NPP array + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) :: bgnpp_patch(bounds%begp:bounds%endp) ! function result: belowground NPP (gC/m2/s) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_bgnpp_patch' + !----------------------------------------------------------------------- + + if (use_cn) then + bgnpp_patch(bounds%begp:bounds%endp) = & + this%cnveg_carbonflux_inst%bgnpp_patch(bounds%begp:bounds%endp) + else + bgnpp_patch(bounds%begp:bounds%endp) = nan + end if + + end function get_bgnpp_patch + + !----------------------------------------------------------------------- + function get_froot_carbon_patch(this, bounds, tlai) result(froot_carbon_patch) + ! + ! !DESCRIPTION: + ! Get patch-level fine root carbon array + ! + ! !USES: + use pftconMod , only : pftcon + use PatchType , only : patch + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) , intent(in) :: tlai( bounds%begp: ) + real(r8) :: froot_carbon_patch(bounds%begp:bounds%endp) ! function result: (gC/m2) + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'get_froot_carbon_patch' + integer :: p + !----------------------------------------------------------------------- + + if (use_cn) then + froot_carbon_patch(bounds%begp:bounds%endp) = & + this%cnveg_carbonstate_inst%frootc_patch(bounds%begp:bounds%endp) + else +! To get leaf biomass: +! bleaf = LAI / slatop +! g/m2 = m2/m2 / m2/g +! To get root biomass: +! broot = bleaf * froot_leaf(ivt(p)) +! g/m2 = g/m2 * g/g + do p=bounds%begp, bounds%endp + if (pftcon%slatop(patch%itype(p)) > 0._r8) then + froot_carbon_patch(p) = tlai(p) & + / pftcon%slatop(patch%itype(p)) & + *pftcon%froot_leaf(patch%itype(p)) + else + froot_carbon_patch(p) = 0._r8 + endif + enddo + end if + + end function get_froot_carbon_patch + + !----------------------------------------------------------------------- + function get_croot_carbon_patch(this, bounds, tlai) result(croot_carbon_patch) + ! + ! !DESCRIPTION: + ! Get patch-level live coarse root carbon array + ! + ! !USES: + use pftconMod , only : pftcon + use PatchType , only : patch + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) , intent(in) :: tlai( bounds%begp: ) + real(r8) :: croot_carbon_patch(bounds%begp:bounds%endp) ! function result: (gC/m2) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_croot_carbon_patch' + integer :: p + !----------------------------------------------------------------------- + + if (use_cn) then + croot_carbon_patch(bounds%begp:bounds%endp) = & + this%cnveg_carbonstate_inst%livecrootc_patch(bounds%begp:bounds%endp) + else +! To get leaf biomass: +! bleaf = LAI / slatop +! g/m2 = m2/m2 / m2/g +! To get root biomass: +! broot = bleaf * froot_leaf(ivt(p)) +! g/m2 = g/m2 * g/g + do p=bounds%begp, bounds%endp + if (pftcon%slatop(patch%itype(p)) > 0._r8) then + croot_carbon_patch(p) = tlai(p) & + / pftcon%slatop(patch%itype(p)) & + *pftcon%stem_leaf(patch%itype(p)) & + *pftcon%croot_stem(patch%itype(p)) + else + croot_carbon_patch(p) = 0._r8 + endif + enddo + end if + + end function get_croot_carbon_patch + + !----------------------------------------------------------------------- + function get_totvegc_col(this, bounds) result(totvegc_col) + ! + ! !DESCRIPTION: + ! Get column-level total vegetation carbon array + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8) :: totvegc_col(bounds%begc:bounds%endc) ! function result: (gC/m2) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_totvegc_col' + !----------------------------------------------------------------------- + + if (use_cn) then + totvegc_col(bounds%begc:bounds%endc) = & + this%cnveg_carbonstate_inst%totvegc_col(bounds%begc:bounds%endc) + else + totvegc_col(bounds%begc:bounds%endc) = nan + end if + + end function get_totvegc_col + + +end module CNVegetationFacade diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 new file mode 100644 index 000000000..4c132d286 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 @@ -0,0 +1,62 @@ +module CN_DriverMod + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use CNVegetationFacade + +contains + +!--------------------------------- + subroutine CN_Driver(nch,ndep) + + use CNCLM_decompMod, only : bounds + use CNCLM_filterMod, only : filter + use CNCLM_SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use CNCLM_SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type + + !ARGUMENTS + implicit none + + !INPUT + integer, intent(in) :: nch ! number of tiles + real, dimension(nch), intent(in) :: ndep ! nitrogen deposition + + + !LOCAL + + ! jkolassa: not sure the below type declarations are necessary or whether use statements + ! above are enough + + type(bounds_type) :: bounds + type(clumpfilter_type) :: filter + type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst + + logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions + + + call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds, & + filter%num_soilc, filter%soilc, & + filter%num_soilp, filter%soilp, & + filter%num_actfirec, filter%actfirec, & + filter%num_actfirep, filter%actfirep, & + filter%num_pcropp, filter%pcropp, & + filter%num_exposedvegp, filter%exposedvegp, & + filter%num_noexposedvegp, filter%noexposedvegp, & + doalb, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + active_layer_inst, & + atm2lnd_inst, water_inst%waterstatebulk_inst, & + water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & + water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + soil_water_retention_curve, crop_inst, ch4_inst, & + photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & + nutrient_competition_method, fireemis_inst) + + end subroutine CN_Driver + +end module CN_DriverMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 new file mode 100644 index 000000000..8ce0fdeb7 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -0,0 +1,162 @@ + module CN_initMod + + use clm_varpar , only : VAR_COL, VAR_PFT + use clm_varctl , only : use_century_decomp + use CNCLM_decompMod + use CNCLM_VegNitrogenStateType + use CNCLM_CarbonStateType + use CNCLM_atm2lndType + use CNCLM_TemperatureType + use CNCLM_SoilStateType + use CNCLM_WaterDiagnosticBulkType + use CNCLM_CanopyStateType + use CNCLM_SolarAbsorbedType + use CNCLM_SurfaceAlbedoType + use CNCLM_OzoneBaseMod + use CNCLM_PhotosynsType + use CNCLM_pftconMod + use CNCLM_PhotoParamsType + use CNCLM_WaterFluxType + use CNCLM_SoilBiogeochemCarbonStateType + use CNCLM_SoilBiogeochemNitrogenStateType + use CNCLM_CNProductsMod + use CNCLM_SoilBiogeochemStateType + use CNCLM_CNVegStateType + use CNCLM_CNVegCarbonFluxType + use CNCLM_CNVegNitrogenFluxType + use CNCLM_GridcellType + use CNCLM_WaterFluxBulkType + use CNCLM_filterMod + use CNCLM_SoilBiogeochemCarbonFluxType + use CNCLM_SoilBiogeochemNitrogenFluxType + + use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc + use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn + + use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col + + implicit none + private + + contains + +!------------------------------------------------------ + subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) + + !ARGUMENTS + implicit none + !INPUT/OUTPUT + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction + real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level CN restart variables + real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! patch/pft-level CN restart variables + real, dimension(nch), intent(in) :: lats ! Catchment tile latitudes [rad] + real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes [rad] + logical, optional, intent(in) :: cn5_cold_start ! cold start for the CLM variables that are new in Catchment-CN5.0 + + !LOCAL + + type(bounds_type) :: bounds + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst + type(atm2lnd_type) :: atm2lnd_inst + type(temperature_type) :: temperature_inst + type(soilstate_type) :: soilstate_inst + type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst + type(canopystate_type) :: canopystate_inst + type(solarabs_type) :: solarabs_inst + type(surfalb_type) :: surfalb_inst + type(ozone_type) :: ozone_inst + type(photosyns_type) :: photosyns_inst + type(pftcon_type) :: pftcon + type(photo_params_type) :: params_inst + type(waterflux_type) :: waterflux_inst + type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst + type(cn_products_type) :: c_products_inst + type(cn_products_type) :: n_products_inst + type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst + type(cnveg_state_type) :: cnveg_state_inst + type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst + type(gridcell_type) :: grc + type(clumpfilter_type) :: filter + type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst + +! initialize CN model +! ------------------- + + call clm_varpar_init() + + call init_clm_varctl() + + call init_bounds (nch, bounds) + + call init_filter_type (bounds, nch, filter) + + call init_cnveg_nitrogenstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenstate_inst, cn5_cold_start) + + call init_cnveg_carbonstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonstate_inst, cn5_cold_start) + + call init_atm2lnd_type (bounds, atm2lnd_inst) + + call init_temperature_type (bounds, temperature_inst) + + call init_soilstate_type (bounds, soilstate_inst) + + call init_waterdiagnosticbulk_type (bounds, waterdiagnosticbulk_inst) + + call init_canopystate_type (bounds, nch, ityp, fveg, cncol, cnpft, canopystate_inst, cn5_cold_start) + + call init_solarabs_type (bounds, solarabs_inst) + + call init_surfalb_type (bounds, nch, cncol, cnpft, surfalb_inst) + + call init_ozone_base_type (bounds, ozone_inst) + + call init_photosyns_type (bounds, nch, ityp, fveg, cncol, cnpft, photosyns_inst, cn5_cold_start) + + call init_pftcon_type (pftcon) + + call init_photo_params_type (params_inst) + + call init_waterflux_type (bounds, waterflux_inst) + + call init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, soilbiogeochem_carbonstate_inst) + + call init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, soilbiogeochem_nitrogenstate_inst) + + call init_cn_products_type (bounds, nch, cncol, 'C', c_products_inst) + + call init_cn_products_type (bounds, nch, cncol, 'N', n_products_inst) + + call init_soilbiogeochem_state_type (bounds, nch, cncol, soilbiogeochem_state_inst) + + if (use_century_decomp) then + call init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, & + soilstate_inst ) + else + call init_decompcascade_cn(bounds, soilbiogeochem_state_inst) + end if + + call init_cnveg_state_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_state_inst) + + call init_cnveg_carbonflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonflux_inst) + + call init_cnveg_nitrogenflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenflux_inst) + + call init_gridcell_type (bounds, nch, cnpft, lats, lons, grc) + + call init_waterfluxbulk_type (bounds, waterfluxbulk_inst) + + call init_soilbiogeochem_carbonflux_type(bounds,soilbiogeochem_carbonflux_inst) + + call init_soilbiogeochem_nitrogenflux_type(bounds,soilbiogeochem_nitrogenflux_inst) + + end subroutine CN_init + +end module CN_initMod + + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 new file mode 100644 index 000000000..297de73d0 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -0,0 +1,4978 @@ +module PhotosynthesisMod + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Leaf photosynthesis and stomatal conductance calculation as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy + ! + ! !USES: + use shr_sys_mod , only : shr_sys_flush + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use abortutils , only : endrun + use clm_varctl , only : use_c13, use_c14, use_cn, use_cndv, use_fates, use_luna, use_hydrstress + use clm_varctl , only : iulog + use clm_varpar , only : nlevcan, nvegwcs, mxpft + use clm_varcon , only : namep, c14ratio, spval, isecspday + use decompMod , only : bounds_type + use QuadraticMod , only : quadratic + use CNCLM_pftconMod , only : pftcon + use CIsoAtmTimeseriesMod, only : C14BombSpike, use_c14_bombspike, C13TimeSeries, use_c13_timeseries, nsectors_c14 + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use SolarAbsorbedType , only : solarabs_type + use SurfaceAlbedoType , only : surfalb_type + use OzoneBaseMod , only : ozone_base_type + use LandunitType , only : lun + use PatchType , only : patch + use GridcellType , only : grc + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: Photosynthesis ! Leaf stomatal resistance and leaf photosynthesis + public :: PhotosynthesisTotal ! Determine of total photosynthesis + public :: Fractionation ! C13 fractionation during photosynthesis + ! For plant hydraulics approach + public :: PhotosynthesisHydraulicStress ! Leaf stomatal resistance and leaf photosynthesis + ! Simultaneous solution of sunlit/shaded per Pierre + ! Gentine/Daniel Kennedy plant hydraulic stress method + public :: plc ! Return value of vulnerability curve at x + + ! !PRIVATE MEMBER FUNCTIONS: + private :: hybrid ! hybrid solver for ci + private :: ci_func ! ci function + private :: brent ! brent solver for root of a single variable function + private :: ft ! photosynthesis temperature response + private :: fth ! photosynthesis temperature inhibition + private :: fth25 ! scaling factor for photosynthesis temperature inhibition + ! For plant hydraulics approach + private :: hybrid_PHS ! hybrid solver for ci + private :: ci_func_PHS ! ci function + private :: brent_PHS ! brent solver for root of a single variable function + private :: calcstress ! compute the root water stress + private :: getvegwp ! calculate vegetation water potential (sun, sha, xylem, root) + private :: getqflx ! calculate sunlit and shaded transpiration + private :: spacF ! flux divergence across each vegetation segment + private :: spacA ! the inverse Jacobian matrix relating delta(vegwp) to f, d(vegwp)=A*f + private :: d1plc ! compute 1st deriv of conductance attenuation for each segment + + ! !PRIVATE DATA: + integer, parameter, private :: leafresp_mtd_ryan1991 = 1 ! Ryan 1991 method for lmr25top + integer, parameter, private :: leafresp_mtd_atkin2015 = 2 ! Atkin 2015 method for lmr25top + integer, parameter, private :: sun=1 ! index for sunlit + integer, parameter, private :: sha=2 ! index for shaded + integer, parameter, private :: xyl=3 ! index for xylem + integer, parameter, private :: root=4 ! index for root + integer, parameter, private :: veg=0 ! index for vegetation + integer, parameter, private :: soil=1 ! index for soil + integer, parameter, private :: stomatalcond_mtd_bb1987 = 1 ! Ball-Berry 1987 method for photosynthesis + integer, parameter, private :: stomatalcond_mtd_medlyn2011 = 2 ! Medlyn 2011 method for photosynthesis + ! !PUBLIC VARIABLES: + + type :: photo_params_type + real(r8) :: act25 ! Rubisco activity at 25 C (umol CO2/gRubisco/s) + real(r8) :: fnr ! Mass ratio of total Rubisco molecular mass to nitrogen in Rubisco (gRubisco/gN in Rubisco) + real(r8) :: cp25_yr2000 ! CO2 compensation point at 25°C at present day O2 (mol/mol) + real(r8) :: kc25_coef ! Michaelis-Menten const. at 25°C for CO2 (unitless) + real(r8) :: ko25_coef ! Michaelis-Menten const. at 25°C for O2 (unitless) + real(r8) :: fnps ! Fraction of light absorbed by non-photosynthetic pigment (unitless) + real(r8) :: theta_psii ! Empirical curvature parameter for electron transport rate (unitless) + real(r8) :: theta_ip ! Empirical curvature parameter for ap photosynthesis co-limitation (unitless) + real(r8) :: vcmaxha ! Activation energy for vcmax (J/mol) + real(r8) :: jmaxha ! Activation energy for jmax (J/mol) + real(r8) :: tpuha ! Activation energy for tpu (J/mol) + real(r8) :: lmrha ! Activation energy for lmr (J/mol) + real(r8) :: kcha ! Activation energy for kc (J/mol) + real(r8) :: koha ! Activation energy for ko (J/mol) + real(r8) :: cpha ! Activation energy for cp (J/mol) + real(r8) :: vcmaxhd ! Deactivation energy for vcmax (J/mol) + real(r8) :: jmaxhd ! Deactivation energy for jmax (J/mol) + real(r8) :: tpuhd ! Deactivation energy for tpu (J/mol) + real(r8) :: lmrhd ! Deactivation energy for lmr (J/mol) + real(r8) :: lmrse ! Entropy term for lmr (J/mol/K) + real(r8) :: tpu25ratio ! Ratio of tpu25top to vcmax25top (unitless) + real(r8) :: kp25ratio ! Ratio of kp25top to vcmax25top (unitless) + real(r8) :: vcmaxse_sf ! Scale factor for vcmaxse (unitless) + real(r8) :: jmaxse_sf ! Scale factor for jmaxse (unitless) + real(r8) :: tpuse_sf ! Scale factor for tpuse (unitless) + real(r8) :: jmax25top_sf ! Scale factor for jmax25top (unitless) + real(r8), allocatable, public :: krmax (:) + real(r8), allocatable, private :: kmax (:,:) + real(r8), allocatable, private :: psi50 (:,:) + real(r8), allocatable, private :: ck (:,:) + real(r8), allocatable, private :: lmr_intercept_atkin(:) + real(r8), allocatable, private :: theta_cj (:) ! Empirical curvature parameter for ac, aj photosynthesis co-limitation (unitless) + contains + procedure, private :: allocParams + end type photo_params_type + ! + type(photo_params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod + + type, public :: photosyns_type + + logical , pointer, private :: c3flag_patch (:) ! patch true if C3 and false if C4 + ! Plant hydraulic stress specific variables + real(r8), pointer, private :: ac_phs_patch (:,:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: aj_phs_patch (:,:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ap_phs_patch (:,:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ag_phs_patch (:,:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: an_sun_patch (:,:) ! patch sunlit net leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: an_sha_patch (:,:) ! patch shaded net leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: vcmax_z_phs_patch (:,:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s) + real(r8), pointer, private :: kp_z_phs_patch (:,:,:) ! patch initial slope of CO2 response curve (C4 plants) + real(r8), pointer, private :: tpu_z_phs_patch (:,:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s) + real(r8), pointer, public :: gs_mol_sun_patch (:,:) ! patch sunlit leaf stomatal conductance (umol H2O/m**2/s) + real(r8), pointer, public :: gs_mol_sha_patch (:,:) ! patch shaded leaf stomatal conductance (umol H2O/m**2/s) + real(r8), pointer, private :: gs_mol_sun_ln_patch (:,:) ! patch sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) + real(r8), pointer, private :: gs_mol_sha_ln_patch (:,:) ! patch shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) + real(r8), pointer, private :: ac_patch (:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: aj_patch (:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ap_patch (:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ag_patch (:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: an_patch (:,:) ! patch net leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: vcmax_z_patch (:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s) + real(r8), pointer, private :: cp_patch (:) ! patch CO2 compensation point (Pa) + real(r8), pointer, private :: kc_patch (:) ! patch Michaelis-Menten constant for CO2 (Pa) + real(r8), pointer, private :: ko_patch (:) ! patch Michaelis-Menten constant for O2 (Pa) + real(r8), pointer, private :: qe_patch (:) ! patch quantum efficiency, used only for C4 (mol CO2 / mol photons) + real(r8), pointer, private :: tpu_z_patch (:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s) + real(r8), pointer, private :: kp_z_patch (:,:) ! patch initial slope of CO2 response curve (C4 plants) + real(r8), pointer, private :: bbb_patch (:) ! patch Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + real(r8), pointer, private :: mbb_patch (:) ! patch Ball-Berry slope of conductance-photosynthesis relationship + real(r8), pointer, private :: gs_mol_patch (:,:) ! patch leaf stomatal conductance (umol H2O/m**2/s) + real(r8), pointer, private :: gb_mol_patch (:) ! patch leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), pointer, private :: rh_leaf_patch (:) ! patch fractional humidity at leaf surface (dimensionless) + real(r8), pointer, private :: vpd_can_patch (:) ! patch canopy vapor pressure deficit (kPa) + real(r8), pointer, private :: alphapsnsun_patch (:) ! patch sunlit 13c fractionation ([]) + real(r8), pointer, private :: alphapsnsha_patch (:) ! patch shaded 13c fractionation ([]) + + real(r8), pointer, public :: rc13_canair_patch (:) ! patch C13O2/C12O2 in canopy air + real(r8), pointer, public :: rc13_psnsun_patch (:) ! patch C13O2/C12O2 in sunlit canopy psn flux + real(r8), pointer, public :: rc13_psnsha_patch (:) ! patch C13O2/C12O2 in shaded canopy psn flux + + real(r8), pointer, public :: psnsun_patch (:) ! patch sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, public :: psnsha_patch (:) ! patch shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, public :: c13_psnsun_patch (:) ! patch c13 sunlit leaf photosynthesis (umol 13CO2/m**2/s) + real(r8), pointer, public :: c13_psnsha_patch (:) ! patch c13 shaded leaf photosynthesis (umol 13CO2/m**2/s) + real(r8), pointer, public :: c14_psnsun_patch (:) ! patch c14 sunlit leaf photosynthesis (umol 14CO2/m**2/s) + real(r8), pointer, public :: c14_psnsha_patch (:) ! patch c14 shaded leaf photosynthesis (umol 14CO2/m**2/s) + + real(r8), pointer, private :: psnsun_z_patch (:,:) ! patch canopy layer: sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_z_patch (:,:) ! patch canopy layer: shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wc_patch (:) ! patch Rubsico-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wc_patch (:) ! patch Rubsico-limited shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wj_patch (:) ! patch RuBP-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wj_patch (:) ! patch RuBP-limited shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wp_patch (:) ! patch product-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wp_patch (:) ! patch product-limited shaded leaf photosynthesis (umol CO2/m**2/s) + + real(r8), pointer, public :: fpsn_patch (:) ! patch photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wc_patch (:) ! patch Rubisco-limited photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wj_patch (:) ! patch RuBP-limited photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wp_patch (:) ! patch product-limited photosynthesis (umol CO2/m**2 ground/s) + + real(r8), pointer, public :: lnca_patch (:) ! top leaf layer leaf N concentration (gN leaf/m^2) + + real(r8), pointer, public :: lmrsun_patch (:) ! patch sunlit leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, public :: lmrsha_patch (:) ! patch shaded leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, private :: lmrsun_z_patch (:,:) ! patch canopy layer: sunlit leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, private :: lmrsha_z_patch (:,:) ! patch canopy layer: shaded leaf maintenance respiration rate (umol CO2/m**2/s) + + real(r8), pointer, public :: cisun_z_patch (:,:) ! patch intracellular sunlit leaf CO2 (Pa) + real(r8), pointer, public :: cisha_z_patch (:,:) ! patch intracellular shaded leaf CO2 (Pa) + + real(r8), pointer, private :: rssun_z_patch (:,:) ! patch canopy layer: sunlit leaf stomatal resistance (s/m) + real(r8), pointer, private :: rssha_z_patch (:,:) ! patch canopy layer: shaded leaf stomatal resistance (s/m) + real(r8), pointer, public :: rssun_patch (:) ! patch sunlit stomatal resistance (s/m) + real(r8), pointer, public :: rssha_patch (:) ! patch shaded stomatal resistance (s/m) + real(r8), pointer, public :: luvcmax25top_patch (:) ! vcmax25 ! (umol/m2/s) + real(r8), pointer, public :: lujmax25top_patch (:) ! vcmax25 (umol/m2/s) + real(r8), pointer, public :: lutpu25top_patch (:) ! vcmax25 (umol/m2/s) +!! + + + ! LUNA specific variables + real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer + real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer + real(r8), pointer, public :: vcmx25_z_last_valid_patch (:,:) ! patch leaf Vc,max25 at the end of the growing season for the previous year + real(r8), pointer, public :: jmx25_z_last_valid_patch (:,:) ! patch leaf Jmax25 at the end of the growing season for the previous year + real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer + real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress + real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day) + + ! Logical switches for different options + logical, public :: rootstem_acc ! Respiratory acclimation for roots and stems + logical, private :: light_inhibit ! If light should inhibit respiration + integer, private :: leafresp_method ! leaf maintencence respiration at 25C for canopy top method to use + integer, private :: stomatalcond_mtd ! Stomatal conduction method type + logical, private :: modifyphoto_and_lmr_forcrop ! Modify photosynthesis and LMR for crop + contains + + ! Public procedures + procedure, public :: Init + procedure, public :: Restart + procedure, public :: ReadNML + procedure, public :: ReadParams + procedure, public :: TimeStepInit + procedure, public :: NewPatchInit + + ! Private procedures + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type photosyns_type + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate (bounds) + call this%InitHistory (bounds) + call this%InitCold (bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%c3flag_patch (begp:endp)) ; this%c3flag_patch (:) =.false. + allocate(this%ac_phs_patch (begp:endp,2,1:nlevcan)) ; this%ac_phs_patch (:,:,:) = nan + allocate(this%aj_phs_patch (begp:endp,2,1:nlevcan)) ; this%aj_phs_patch (:,:,:) = nan + allocate(this%ap_phs_patch (begp:endp,2,1:nlevcan)) ; this%ap_phs_patch (:,:,:) = nan + allocate(this%ag_phs_patch (begp:endp,2,1:nlevcan)) ; this%ag_phs_patch (:,:,:) = nan + allocate(this%an_sun_patch (begp:endp,1:nlevcan)) ; this%an_sun_patch (:,:) = nan + allocate(this%an_sha_patch (begp:endp,1:nlevcan)) ; this%an_sha_patch (:,:) = nan + allocate(this%vcmax_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%vcmax_z_phs_patch (:,:,:) = nan + allocate(this%tpu_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%tpu_z_phs_patch (:,:,:) = nan + allocate(this%kp_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%kp_z_phs_patch (:,:,:) = nan + allocate(this%gs_mol_sun_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sun_patch (:,:) = nan + allocate(this%gs_mol_sha_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sha_patch (:,:) = nan + allocate(this%gs_mol_sun_ln_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sun_ln_patch (:,:) = nan + allocate(this%gs_mol_sha_ln_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sha_ln_patch (:,:) = nan + allocate(this%ac_patch (begp:endp,1:nlevcan)) ; this%ac_patch (:,:) = nan + allocate(this%aj_patch (begp:endp,1:nlevcan)) ; this%aj_patch (:,:) = nan + allocate(this%ap_patch (begp:endp,1:nlevcan)) ; this%ap_patch (:,:) = nan + allocate(this%ag_patch (begp:endp,1:nlevcan)) ; this%ag_patch (:,:) = nan + allocate(this%an_patch (begp:endp,1:nlevcan)) ; this%an_patch (:,:) = nan + allocate(this%vcmax_z_patch (begp:endp,1:nlevcan)) ; this%vcmax_z_patch (:,:) = nan + allocate(this%tpu_z_patch (begp:endp,1:nlevcan)) ; this%tpu_z_patch (:,:) = nan + allocate(this%kp_z_patch (begp:endp,1:nlevcan)) ; this%kp_z_patch (:,:) = nan + allocate(this%gs_mol_patch (begp:endp,1:nlevcan)) ; this%gs_mol_patch (:,:) = nan + allocate(this%cp_patch (begp:endp)) ; this%cp_patch (:) = nan + allocate(this%kc_patch (begp:endp)) ; this%kc_patch (:) = nan + allocate(this%ko_patch (begp:endp)) ; this%ko_patch (:) = nan + allocate(this%qe_patch (begp:endp)) ; this%qe_patch (:) = nan + allocate(this%bbb_patch (begp:endp)) ; this%bbb_patch (:) = nan + allocate(this%mbb_patch (begp:endp)) ; this%mbb_patch (:) = nan + allocate(this%gb_mol_patch (begp:endp)) ; this%gb_mol_patch (:) = nan + allocate(this%rh_leaf_patch (begp:endp)) ; this%rh_leaf_patch (:) = nan + allocate(this%vpd_can_patch (begp:endp)) ; this%vpd_can_patch (:) = nan + allocate(this%psnsun_patch (begp:endp)) ; this%psnsun_patch (:) = nan + allocate(this%psnsha_patch (begp:endp)) ; this%psnsha_patch (:) = nan + allocate(this%c13_psnsun_patch (begp:endp)) ; this%c13_psnsun_patch (:) = nan + allocate(this%c13_psnsha_patch (begp:endp)) ; this%c13_psnsha_patch (:) = nan + allocate(this%c14_psnsun_patch (begp:endp)) ; this%c14_psnsun_patch (:) = nan + allocate(this%c14_psnsha_patch (begp:endp)) ; this%c14_psnsha_patch (:) = nan + + allocate(this%psnsun_z_patch (begp:endp,1:nlevcan)) ; this%psnsun_z_patch (:,:) = nan + allocate(this%psnsha_z_patch (begp:endp,1:nlevcan)) ; this%psnsha_z_patch (:,:) = nan + allocate(this%psnsun_wc_patch (begp:endp)) ; this%psnsun_wc_patch (:) = nan + allocate(this%psnsha_wc_patch (begp:endp)) ; this%psnsha_wc_patch (:) = nan + allocate(this%psnsun_wj_patch (begp:endp)) ; this%psnsun_wj_patch (:) = nan + allocate(this%psnsha_wj_patch (begp:endp)) ; this%psnsha_wj_patch (:) = nan + allocate(this%psnsun_wp_patch (begp:endp)) ; this%psnsun_wp_patch (:) = nan + allocate(this%psnsha_wp_patch (begp:endp)) ; this%psnsha_wp_patch (:) = nan + allocate(this%fpsn_patch (begp:endp)) ; this%fpsn_patch (:) = nan + allocate(this%fpsn_wc_patch (begp:endp)) ; this%fpsn_wc_patch (:) = nan + allocate(this%fpsn_wj_patch (begp:endp)) ; this%fpsn_wj_patch (:) = nan + allocate(this%fpsn_wp_patch (begp:endp)) ; this%fpsn_wp_patch (:) = nan + + allocate(this%lnca_patch (begp:endp)) ; this%lnca_patch (:) = nan + + allocate(this%lmrsun_z_patch (begp:endp,1:nlevcan)) ; this%lmrsun_z_patch (:,:) = nan + allocate(this%lmrsha_z_patch (begp:endp,1:nlevcan)) ; this%lmrsha_z_patch (:,:) = nan + allocate(this%lmrsun_patch (begp:endp)) ; this%lmrsun_patch (:) = nan + allocate(this%lmrsha_patch (begp:endp)) ; this%lmrsha_patch (:) = nan + + allocate(this%alphapsnsun_patch (begp:endp)) ; this%alphapsnsun_patch (:) = nan + allocate(this%alphapsnsha_patch (begp:endp)) ; this%alphapsnsha_patch (:) = nan + allocate(this%rc13_canair_patch (begp:endp)) ; this%rc13_canair_patch (:) = nan + allocate(this%rc13_psnsun_patch (begp:endp)) ; this%rc13_psnsun_patch (:) = nan + allocate(this%rc13_psnsha_patch (begp:endp)) ; this%rc13_psnsha_patch (:) = nan + + allocate(this%cisun_z_patch (begp:endp,1:nlevcan)) ; this%cisun_z_patch (:,:) = nan + allocate(this%cisha_z_patch (begp:endp,1:nlevcan)) ; this%cisha_z_patch (:,:) = nan + + allocate(this%rssun_z_patch (begp:endp,1:nlevcan)) ; this%rssun_z_patch (:,:) = nan + allocate(this%rssha_z_patch (begp:endp,1:nlevcan)) ; this%rssha_z_patch (:,:) = nan + allocate(this%rssun_patch (begp:endp)) ; this%rssun_patch (:) = nan + allocate(this%rssha_patch (begp:endp)) ; this%rssha_patch (:) = nan + allocate(this%luvcmax25top_patch(begp:endp)) ; this%luvcmax25top_patch(:) = nan + allocate(this%lujmax25top_patch (begp:endp)) ; this%lujmax25top_patch(:) = nan + allocate(this%lutpu25top_patch (begp:endp)) ; this%lutpu25top_patch(:) = nan +!! +! allocate(this%psncanopy_patch (begp:endp)) ; this%psncanopy_patch (:) = nan +! allocate(this%lmrcanopy_patch (begp:endp)) ; this%lmrcanopy_patch (:) = nan + if(use_luna)then + ! NOTE(bja, 2015-09) because these variables are only allocated + ! when luna is turned on, they can not be placed into associate + ! statements. + allocate(this%vcmx25_z_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_patch (:,:) = 30._r8 + allocate(this%jmx25_z_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_patch (:,:) = 60._r8 + allocate(this%vcmx25_z_last_valid_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_last_valid_patch (:,:) = 30._r8 + allocate(this%jmx25_z_last_valid_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_last_valid_patch (:,:) = 60._r8 + allocate(this%pnlc_z_patch (begp:endp,1:nlevcan)) ; this%pnlc_z_patch (:,:) = 0.01_r8 + allocate(this%fpsn24_patch (begp:endp)) ; this%fpsn24_patch (:) = nan + allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 + endif + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod , only: hist_addfld1d, hist_addfld2d + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + real(r8), pointer :: ptr_1d(:) ! pointer to 1d patch array + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + !--------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + + this%rh_leaf_patch(begp:endp) = spval + call hist_addfld1d (fname='RH_LEAF', units='fraction', & + avgflag='A', long_name='fractional humidity at leaf surface', & + ptr_patch=this%rh_leaf_patch, set_spec=spval, default='inactive') + + this%vpd_can_patch(begp:endp) = spval + call hist_addfld1d (fname='VPD_CAN', units='kPa', & + avgflag='A', long_name='canopy vapor pressure deficit', & + ptr_patch=this%vpd_can_patch, set_spec=spval, default='active') + + + + this%lnca_patch(begp:endp) = spval + call hist_addfld1d (fname='LNC', units='gN leaf/m^2', & + avgflag='A', long_name='leaf N concentration', & + ptr_patch=this%lnca_patch, set_spec=spval) + + ! Don't output photosynthesis variables when FATES is on as they aren't calculated + if (.not. use_fates) then + this%fpsn_patch(begp:endp) = spval + call hist_addfld1d (fname='FPSN', units='umol m-2 s-1', & + avgflag='A', long_name='photosynthesis', & + ptr_patch=this%fpsn_patch, set_lake=0._r8, set_urb=0._r8) + + ! Don't by default output this rate limiting step as only makes sense if you are outputing + ! the others each time-step + this%fpsn_wc_patch(begp:endp) = spval + call hist_addfld1d (fname='FPSN_WC', units='umol m-2 s-1', & + avgflag='I', long_name='Rubisco-limited photosynthesis', & + ptr_patch=this%fpsn_wc_patch, set_lake=0._r8, set_urb=0._r8, & + default='inactive') + + ! Don't by default output this rate limiting step as only makes sense if you are outputing + ! the others each time-step + this%fpsn_wj_patch(begp:endp) = spval + call hist_addfld1d (fname='FPSN_WJ', units='umol m-2 s-1', & + avgflag='I', long_name='RuBP-limited photosynthesis', & + ptr_patch=this%fpsn_wj_patch, set_lake=0._r8, set_urb=0._r8, & + default='inactive') + + ! Don't by default output this rate limiting step as only makes sense if you are outputing + ! the others each time-step + this%fpsn_wp_patch(begp:endp) = spval + call hist_addfld1d (fname='FPSN_WP', units='umol m-2 s-1', & + avgflag='I', long_name='Product-limited photosynthesis', & + ptr_patch=this%fpsn_wp_patch, set_lake=0._r8, set_urb=0._r8, & + default='inactive') + end if + + if (use_cn) then + this%psnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='PSNSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='sunlit leaf photosynthesis', & + ptr_patch=this%psnsun_patch) + + this%psnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='PSNSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='shaded leaf photosynthesis', & + ptr_patch=this%psnsha_patch) + end if + + if ( use_c13 ) then + this%c13_psnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_PSNSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='C13 sunlit leaf photosynthesis', & + ptr_patch=this%c13_psnsun_patch, default='inactive') + + this%c13_psnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_PSNSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='C13 shaded leaf photosynthesis', & + ptr_patch=this%c13_psnsha_patch, default='inactive') + end if + + if ( use_c14 ) then + this%c14_psnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_PSNSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='C14 sunlit leaf photosynthesis', & + ptr_patch=this%c14_psnsun_patch, default='inactive') + + this%c14_psnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_PSNSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='C14 shaded leaf photosynthesis', & + ptr_patch=this%c14_psnsha_patch, default='inactive') + end if + + if ( use_c13 ) then + this%rc13_canair_patch(begp:endp) = spval + call hist_addfld1d (fname='RC13_CANAIR', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for canopy air', & + ptr_patch=this%rc13_canair_patch, default='inactive') + + this%rc13_psnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='RC13_PSNSUN', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for sunlit photosynthesis', & + ptr_patch=this%rc13_psnsun_patch, default='inactive') + + this%rc13_psnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='RC13_PSNSHA', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for shaded photosynthesis', & + ptr_patch=this%rc13_psnsha_patch, default='inactive') + endif + + ! Canopy physiology + + if ( use_c13 ) then + this%alphapsnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='ALPHAPSNSUN', units='proportion', & + avgflag='A', long_name='sunlit c13 fractionation', & + ptr_patch=this%alphapsnsun_patch, default='inactive') + + this%alphapsnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='ALPHAPSNSHA', units='proportion', & + avgflag='A', long_name='shaded c13 fractionation', & + ptr_patch=this%alphapsnsha_patch, default='inactive') + endif + + this%rssun_patch(begp:endp) = spval + call hist_addfld1d (fname='RSSUN', units='s/m', & + avgflag='M', long_name='sunlit leaf stomatal resistance', & + ptr_patch=this%rssun_patch, l2g_scale_type='veg') + + this%rssha_patch(begp:endp) = spval + call hist_addfld1d (fname='RSSHA', units='s/m', & + avgflag='M', long_name='shaded leaf stomatal resistance', & + ptr_patch=this%rssha_patch, l2g_scale_type='veg') + + this%gs_mol_sun_patch(begp:endp,:) = spval + this%gs_mol_sha_patch(begp:endp,:) = spval + if (nlevcan>1) then + call hist_addfld2d (fname='GSSUN', units='umol H20/m2/s', type2d='nlevcan', & + avgflag='A', long_name='sunlit leaf stomatal conductance', & + ptr_patch=this%gs_mol_sun_patch, set_lake=spval, set_urb=spval) + + call hist_addfld2d (fname='GSSHA', units='umol H20/m2/s', type2d='nlevcan', & + avgflag='A', long_name='shaded leaf stomatal conductance', & + ptr_patch=this%gs_mol_sha_patch, set_lake=spval, set_urb=spval) + else + ptr_1d => this%gs_mol_sun_patch(begp:endp,1) + call hist_addfld1d (fname='GSSUN', units='umol H20/m2/s', & + avgflag='A', long_name='sunlit leaf stomatal conductance', & + ptr_patch=ptr_1d) + + ptr_1d => this%gs_mol_sha_patch(begp:endp,1) + call hist_addfld1d (fname='GSSHA', units='umol H20/m2/s', & + avgflag='A', long_name='shaded leaf stomatal conductance', & + ptr_patch=ptr_1d) + + endif + this%gs_mol_sun_ln_patch(begp:endp,:) = spval + this%gs_mol_sha_ln_patch(begp:endp,:) = spval + if (nlevcan>1) then + call hist_addfld2d (fname='GSSUNLN', units='umol H20/m2/s', type2d='nlevcan', & + avgflag='A', long_name='sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & + ptr_patch=this%gs_mol_sun_ln_patch, set_lake=spval, set_urb=spval) + + call hist_addfld2d (fname='GSSHALN', units='umol H20/m2/s', type2d='nlevcan', & + avgflag='A', long_name='shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & + ptr_patch=this%gs_mol_sha_ln_patch, set_lake=spval, set_urb=spval) + else + ptr_1d => this%gs_mol_sun_ln_patch(begp:endp,1) + call hist_addfld1d (fname='GSSUNLN', units='umol H20/m2/s', & + avgflag='A', long_name='sunlit leaf stomatal conductance at local noon', & + ptr_patch=ptr_1d) + + ptr_1d => this%gs_mol_sha_ln_patch(begp:endp,1) + call hist_addfld1d (fname='GSSHALN', units='umol H20/m2/s', & + avgflag='A', long_name='shaded leaf stomatal conductance at local noon', & + ptr_patch=ptr_1d) + + endif + if(use_luna)then + if(nlevcan>1)then + call hist_addfld2d (fname='Vcmx25Z', units='umol/m2/s', type2d='nlevcan', & + avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', & + ptr_patch=this%vcmx25_z_patch) + + call hist_addfld2d (fname='Jmx25Z', units='umol electrons/m2/s', type2d='nlevcan', & + avgflag='A', long_name='maximum rate of electron transport at 25 Celcius for canopy layers', & + ptr_patch=this%jmx25_z_patch) + + call hist_addfld2d (fname='PNLCZ', units='unitless', type2d='nlevcan', & + avgflag='A', long_name='Proportion of nitrogen allocated for light capture', & + ptr_patch=this%pnlc_z_patch,default='inactive') + else + ptr_1d => this%vcmx25_z_patch(:,1) + call hist_addfld1d (fname='Vcmx25Z', units='umol/m2/s',& + avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', & + ptr_patch=ptr_1d) + ptr_1d => this%jmx25_z_patch(:,1) + call hist_addfld1d (fname='Jmx25Z', units='umol electrons/m2/s',& + avgflag='A', long_name='maximum rate of electron transport at 25 Celcius for canopy layers', & + ptr_patch=ptr_1d) + ptr_1d => this%pnlc_z_patch(:,1) + call hist_addfld1d (fname='PNLCZ', units='unitless', & + avgflag='A', long_name='Proportion of nitrogen allocated for light capture', & + ptr_patch=ptr_1d,default='inactive') + + this%luvcmax25top_patch(begp:endp) = spval + call hist_addfld1d (fname='VCMX25T', units='umol/m2/s', & + avgflag='M', long_name='canopy profile of vcmax25', & + ptr_patch=this%luvcmax25top_patch, set_lake=spval, set_urb=spval) + + this%lujmax25top_patch(begp:endp) = spval + call hist_addfld1d (fname='JMX25T', units='umol/m2/s', & + avgflag='M', long_name='canopy profile of jmax', & + ptr_patch=this%lujmax25top_patch, set_lake=spval, set_urb=spval) + + this%lutpu25top_patch(begp:endp) = spval + call hist_addfld1d (fname='TPU25T', units='umol/m2/s', & + avgflag='M', long_name='canopy profile of tpu', & + ptr_patch=this%lutpu25top_patch, set_lake=spval, set_urb=spval) + + endif + this%fpsn24_patch = spval + call hist_addfld1d (fname='FPSN24', units='umol CO2/m^2 ground/day',& + avgflag='A', long_name='24 hour accumulative patch photosynthesis starting from mid-night', & + ptr_patch=this%fpsn24_patch, default='inactive') + + endif + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,l ! indices + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + + this%alphapsnsun_patch(p) = spval + this%alphapsnsha_patch(p) = spval + + if (lun%ifspecial(l)) then + this%psnsun_patch(p) = 0._r8 + this%psnsha_patch(p) = 0._r8 + if ( use_c13 ) then + this%c13_psnsun_patch(p) = 0._r8 + this%c13_psnsha_patch(p) = 0._r8 + endif + if ( use_c14 ) then + this%c14_psnsun_patch(p) = 0._r8 + this%c14_psnsha_patch(p) = 0._r8 + endif + end if + end do + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine allocParams ( this ) + ! + implicit none + + ! !ARGUMENTS: + class(photo_params_type) :: this + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'allocParams' + !----------------------------------------------------------------------- + + ! allocate parameters + + allocate( this%krmax (0:mxpft) ) ; this%krmax(:) = nan + allocate( this%theta_cj (0:mxpft) ) ; this%theta_cj(:) = nan + allocate( this%kmax (0:mxpft,nvegwcs) ) ; this%kmax(:,:) = nan + allocate( this%psi50 (0:mxpft,nvegwcs) ) ; this%psi50(:,:) = nan + allocate( this%ck (0:mxpft,nvegwcs) ) ; this%ck(:,:) = nan + + if ( use_hydrstress .and. nvegwcs /= 4 )then + call endrun(msg='Error:: the Plant Hydraulics Stress methodology is for the spacA function is hardcoded for nvegwcs==4' & + //errMsg(__FILE__, __LINE__)) + end if + + end subroutine allocParams + + !----------------------------------------------------------------------- + subroutine readParams ( this, ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + use paramUtilMod, only: readNcdioScalar + implicit none + + ! !ARGUMENTS: + class(photosyns_type) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'readParams' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: temp1d(0:mxpft) ! temporary to read in parameter + real(r8) :: temp2d(0:mxpft,nvegwcs) ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + + call params_inst%allocParams() + + tString = "krmax" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%krmax=temp1d + tString = "lmr_intercept_atkin" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%lmr_intercept_atkin=temp1d + tString = "theta_cj" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%theta_cj=temp1d + tString = "kmax" + call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%kmax=temp2d + tString = "psi50" + call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%psi50=temp2d + tString = "ck" + call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%ck=temp2d + + ! read in the scalar parameters + + ! Michaelis-Menten constant at 25°C for O2 (unitless) + call readNcdioScalar(ncid, 'ko25_coef', subname, params_inst%ko25_coef) + ! Michaelis-Menten constant at 25°C for CO2 (unitless) + call readNcdioScalar(ncid, 'kc25_coef', subname, params_inst%kc25_coef) + ! CO2 compensation point at 25°C at present day O2 levels + call readNcdioScalar(ncid, 'cp25_yr2000', subname, params_inst%cp25_yr2000) + ! Rubisco activity at 25 C (umol CO2/gRubisco/s) + call readNcdioScalar(ncid, 'act25', subname, params_inst%act25) + ! Mass ratio of total Rubisco molecular mass to nitrogen in Rubisco (gRubisco/gN(Rubisco)) + call readNcdioScalar(ncid, 'fnr', subname, params_inst%fnr) + ! Fraction of light absorbed by non-photosynthetic pigment (unitless) + call readNcdioScalar(ncid, 'fnps', subname, params_inst%fnps) + ! Empirical curvature parameter for electron transport rate (unitless) + call readNcdioScalar(ncid, 'theta_psii', subname, params_inst%theta_psii) + ! Empirical curvature parameter for ap photosynthesis co-limitation (unitless) + call readNcdioScalar(ncid, 'theta_ip', subname, params_inst%theta_ip) + ! Activation energy for vcmax (J/mol) + call readNcdioScalar(ncid, 'vcmaxha', subname, params_inst%vcmaxha) + ! Activation energy for jmax (J/mol) + call readNcdioScalar(ncid, 'jmaxha', subname, params_inst%jmaxha) + ! Activation energy for tpu (J/mol) + call readNcdioScalar(ncid, 'tpuha', subname, params_inst%tpuha) + ! Activation energy for lmr (J/mol) + call readNcdioScalar(ncid, 'lmrha', subname, params_inst%lmrha) + ! Activation energy for kc (J/mol) + call readNcdioScalar(ncid, 'kcha', subname, params_inst%kcha) + ! Activation energy for ko (J/mol) + call readNcdioScalar(ncid, 'koha', subname, params_inst%koha) + ! Activation energy for cp (J/mol) + call readNcdioScalar(ncid, 'cpha', subname, params_inst%cpha) + ! Deactivation energy for vcmax (J/mol) + call readNcdioScalar(ncid, 'vcmaxhd', subname, params_inst%vcmaxhd) + ! Deactivation energy for jmax (J/mol) + call readNcdioScalar(ncid, 'jmaxhd', subname, params_inst%jmaxhd) + ! Deactivation energy for tpu (J/mol) + call readNcdioScalar(ncid, 'tpuhd', subname, params_inst%tpuhd) + ! Deactivation energy for lmr (J/mol) + call readNcdioScalar(ncid, 'lmrhd', subname, params_inst%lmrhd) + ! Entropy term for lmr (J/mol/K) + call readNcdioScalar(ncid, 'lmrse', subname, params_inst%lmrse) + ! Ratio of tpu25top to vcmax25top (unitless) + call readNcdioScalar(ncid, 'tpu25ratio', subname, params_inst%tpu25ratio) + ! Ratio of kp25top to vcmax25top (unitless) + call readNcdioScalar(ncid, 'kp25ratio', subname, params_inst%kp25ratio) + ! Scale factor for vcmaxse (unitless) + call readNcdioScalar(ncid, 'vcmaxse_sf', subname, params_inst%vcmaxse_sf) + ! Scale factor for jmaxse (unitless) + call readNcdioScalar(ncid, 'jmaxse_sf', subname, params_inst%jmaxse_sf) + ! Scale factor for tpuse (unitless) + call readNcdioScalar(ncid, 'tpuse_sf', subname, params_inst%tpuse_sf) + ! Scale factor for jmax25top (unitless) + call readNcdioScalar(ncid, 'jmax25top_sf', subname, params_inst%jmax25top_sf) + + end subroutine readParams + + + !------------------------------------------------------------------------ + subroutine ReadNML(this, NLFilename) + ! + ! !DESCRIPTION: + ! Read the namelist for Photosynthesis + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + character(len=*), intent(IN) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'Photosyn::ReadNML' + character(len=*), parameter :: nmlname = 'photosyns_inparm' + logical :: rootstem_acc = .false. ! Respiratory acclimation for roots and stems + logical :: light_inhibit = .false. ! If light should inhibit respiration + integer :: leafresp_method = leafresp_mtd_ryan1991 ! leaf maintencence respiration at 25C for canopy top method to use + logical :: modifyphoto_and_lmr_forcrop = .false. ! Modify photosynthesis and LMR for crop + character(len=50) :: stomatalcond_method = 'Ball-Berry1987' ! Photosynthesis method string + !----------------------------------------------------------------------- + + namelist /photosyns_inparm/ leafresp_method, light_inhibit, & + rootstem_acc, stomatalcond_method, modifyphoto_and_lmr_forcrop + + ! Initialize options to default values, in case they are not specified in + ! the namelist + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=photosyns_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + this%rootstem_acc = rootstem_acc + this%leafresp_method = leafresp_method + this%light_inhibit = light_inhibit + this%modifyphoto_and_lmr_forcrop = modifyphoto_and_lmr_forcrop + if ( trim(stomatalcond_method) == 'Ball-Berry1987' ) then + this%stomatalcond_mtd = stomatalcond_mtd_bb1987 + else if ( trim(stomatalcond_method) == 'Medlyn2011' ) then + this%stomatalcond_mtd = stomatalcond_mtd_medlyn2011 + else + call endrun(msg="ERROR bad value for stomtalcond_method in "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + end if + + call shr_mpi_bcast (this%rootstem_acc , mpicom) + call shr_mpi_bcast (this%leafresp_method, mpicom) + call shr_mpi_bcast (this%light_inhibit , mpicom) + call shr_mpi_bcast (this%stomatalcond_mtd, mpicom) + call shr_mpi_bcast (this%modifyphoto_and_lmr_forcrop, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=photosyns_inparm) + write(iulog,*) ' ' + end if + + end subroutine ReadNML + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use restUtilMod + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + if ( use_c13 ) then + call restartvar(ncid=ncid, flag=flag, varname='rc13_canair', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%rc13_canair_patch) + + call restartvar(ncid=ncid, flag=flag, varname='rc13_psnsun', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%rc13_psnsun_patch) + + call restartvar(ncid=ncid, flag=flag, varname='rc13_psnsha', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%rc13_psnsha_patch) + endif + + call restartvar(ncid=ncid, flag=flag, varname='GSSUN', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='sunlit leaf stomatal conductance', units='umol H20/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sun_patch) + + call restartvar(ncid=ncid, flag=flag, varname='GSSHA', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='shaded leaf stomatal conductance', units='umol H20/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sha_patch) + + call restartvar(ncid=ncid, flag=flag, varname='GSSUNLN', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & + units='umol H20/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sun_ln_patch) + + call restartvar(ncid=ncid, flag=flag, varname='GSSHALN', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & + units='umol H20/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sha_ln_patch) + + call restartvar(ncid=ncid, flag=flag, varname='lnca', xtype=ncd_double, & + dim1name='pft', long_name='leaf N concentration', units='gN leaf/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%lnca_patch) + + if(use_luna) then + call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='Maximum carboxylation rate at 25 Celcius for canopy layers', units='umol CO2/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_patch) + call restartvar(ncid=ncid, flag=flag, varname='jmx25_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='Maximum rate of electron transport at 25 Celcius for canopy layers', units='umol electrons/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch) + call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z_last_valid_patch:vcmx_prevyr', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_last_valid_patch) + call restartvar(ncid=ncid, flag=flag, varname='jmx25_z_last_valid_patch:jmx_prevyr', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='avg rate of electron transport at 25 Celcius for canopy layers', units='umol electrons/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_last_valid_patch) + call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='proportion of leaf nitrogen allocated for light capture', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=this%pnlc_z_patch ) + call restartvar(ncid=ncid, flag=flag, varname='enzs_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='enzyme decay status during stress: 1.0-fully active; 0.0-all decayed', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=this%enzs_z_patch ) + call restartvar(ncid=ncid, flag=flag, varname='gpp24', xtype=ncd_double, & + dim1name='pft', long_name='accumulative gross primary production', units='umol CO2/m**2 ground/day', & + interpinic_flag='interp', readvar=readvar, data=this%fpsn24_patch) + endif + call restartvar(ncid=ncid, flag=flag, varname='vcmx25t', xtype=ncd_double, & + dim1name='pft', long_name='canopy profile of vcmax25', & + units='umol/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%luvcmax25top_patch) + + call restartvar(ncid=ncid, flag=flag, varname='jmx25t', xtype=ncd_double, & + dim1name='pft', long_name='canopy profile of jmax', & + units='umol/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%lujmax25top_patch) + + call restartvar(ncid=ncid, flag=flag, varname='tpu25t', xtype=ncd_double, & + dim1name='pft', long_name='canopy profile of tpu', & + units='umol/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%lutpu25top_patch) + + call restartvar(ncid=ncid, flag=flag, varname='VPD_CAN', xtype=ncd_double, & + dim1name='pft', long_name='canopy vapor pressure deficit', & + units='kPa', & + interpinic_flag='interp', readvar=readvar, data=this%vpd_can_patch) + + + + end subroutine Restart + + !------------------------------------------------------------------------------ + subroutine TimeStepInit (this, bounds) + ! + ! Time step initialization + ! + ! !USES: + use landunit_varcon, only : istsoil, istcrop, istice_mec, istwet + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,l ! indices + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + l = patch%landunit(p) + if (.not. lun%lakpoi(l)) then + this%psnsun_patch(p) = 0._r8 + this%psnsun_wc_patch(p) = 0._r8 + this%psnsun_wj_patch(p) = 0._r8 + this%psnsun_wp_patch(p) = 0._r8 + + this%psnsha_patch(p) = 0._r8 + this%psnsha_wc_patch(p) = 0._r8 + this%psnsha_wj_patch(p) = 0._r8 + this%psnsha_wp_patch(p) = 0._r8 + + this%fpsn_patch(p) = 0._r8 + this%fpsn_wc_patch(p) = 0._r8 + this%fpsn_wj_patch(p) = 0._r8 + this%fpsn_wp_patch(p) = 0._r8 + + if ( use_c13 ) then + this%alphapsnsun_patch(p) = 0._r8 + this%alphapsnsha_patch(p) = 0._r8 + this%c13_psnsun_patch(p) = 0._r8 + this%c13_psnsha_patch(p) = 0._r8 + endif + if ( use_c14 ) then + this%c14_psnsun_patch(p) = 0._r8 + this%c14_psnsha_patch(p) = 0._r8 + endif + end if + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop & + .or. lun%itype(l) == istice_mec & + .or. lun%itype(l) == istwet) then + if (use_c13) then + this%rc13_canair_patch(p) = 0._r8 + this%rc13_psnsun_patch(p) = 0._r8 + this%rc13_psnsha_patch(p) = 0._r8 + end if + end if + end do + + end subroutine TimeStepInit + + !------------------------------------------------------------------------------ + subroutine NewPatchInit (this, p) + ! + ! For new run-time pft, modify state and flux variables to maintain + ! carbon and nitrogen balance with dynamic pft-weights. + ! Called from dyn_cnbal_patch + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + integer, intent(in) :: p + !----------------------------------------------------------------------- + + if ( use_c13 ) then + this%alphapsnsun_patch(p) = 0._r8 + this%alphapsnsha_patch(p) = 0._r8 + this%rc13_canair_patch(p) = 0._r8 + this%rc13_psnsun_patch(p) = 0._r8 + this%rc13_psnsha_patch(p) = 0._r8 + endif + + this%psnsun_patch(p) = 0._r8 + this%psnsha_patch(p) = 0._r8 + + if (use_c13) then + this%c13_psnsun_patch(p) = 0._r8 + this%c13_psnsha_patch(p) = 0._r8 + end if + if ( use_c14 ) then + this%c14_psnsun_patch(p) = 0._r8 + this%c14_psnsha_patch(p) = 0._r8 + end if + + end subroutine NewPatchInit + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine Photosynthesis ( bounds, fn, filterp, & + esat_tv, eair, oair, cair, rb, btran, & + dayl_factor, leafn, & + atm2lnd_inst, temperature_inst, surfalb_inst, solarabs_inst, & + canopystate_inst, ozone_inst, photosyns_inst, phase) + ! + ! !DESCRIPTION: + ! Leaf photosynthesis and stomatal conductance calculation as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy + ! + ! !USES: + use clm_varcon , only : rgas, tfrz, spval + use GridcellType , only : grc + use clm_time_manager , only : get_step_size_real, is_near_local_noon + use clm_varctl , only : cnallocate_carbon_only + use clm_varctl , only : lnc_opt, reduce_dayl_factor, vcmax_opt + use pftconMod , only : nbrdlf_dcd_tmp_shrub, npcropmin + + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! patch filter + real(r8) , intent(in) :: esat_tv( bounds%begp: ) ! saturation vapor pressure at t_veg (Pa) [pft] + real(r8) , intent(in) :: eair( bounds%begp: ) ! vapor pressure of canopy air (Pa) [pft] + real(r8) , intent(in) :: oair( bounds%begp: ) ! Atmospheric O2 partial pressure (Pa) [pft] + real(r8) , intent(in) :: cair( bounds%begp: ) ! Atmospheric CO2 partial pressure (Pa) [pft] + real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) [pft] + real(r8) , intent(in) :: btran( bounds%begp: ) ! transpiration wetness factor (0 to 1) [pft] + real(r8) , intent(in) :: dayl_factor( bounds%begp: ) ! scalar (0-1) for daylength + real(r8) , intent(in) :: leafn( bounds%begp: ) ! leaf N (gN/m2) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(temperature_type) , intent(in) :: temperature_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(solarabs_type) , intent(in) :: solarabs_inst + type(canopystate_type) , intent(in) :: canopystate_inst + class(ozone_base_type) , intent(in) :: ozone_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + character(len=*) , intent(in) :: phase ! 'sun' or 'sha' + + ! + ! !LOCAL VARIABLES: + ! + ! Leaf photosynthesis parameters + real(r8) :: jmax_z(bounds%begp:bounds%endp,nlevcan) ! maximum electron transport rate (umol electrons/m**2/s) + !real(r8) :: lnc(bounds%begp:bounds%endp) ! leaf N concentration (gN leaf/m^2) + real(r8) :: bbbopt(bounds%begp:bounds%endp)! Ball-Berry minimum leaf conductance, unstressed (umol H2O/m**2/s) + real(r8) :: kn(bounds%begp:bounds%endp) ! leaf nitrogen decay coefficient + real(r8) :: vcmax25top ! canopy top: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: jmax25top ! canopy top: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: tpu25top ! canopy top: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25top ! canopy top: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: kp25top ! canopy top: initial slope of CO2 response curve (C4 plants) at 25C + + real(r8) :: vcmax25 ! leaf layer: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: jmax25 ! leaf layer: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: tpu25 ! leaf layer: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25 ! leaf layer: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: kp25 ! leaf layer: Initial slope of CO2 response curve (C4 plants) at 25C + real(r8) :: kc25 ! Michaelis-Menten constant for CO2 at 25C (Pa) + real(r8) :: ko25 ! Michaelis-Menten constant for O2 at 25C (Pa) + real(r8) :: cp25 ! CO2 compensation point at 25C (Pa) + + real(r8) :: vcmaxse ! entropy term for vcmax (J/mol/K) + real(r8) :: jmaxse ! entropy term for jmax (J/mol/K) + real(r8) :: tpuse ! entropy term for tpu (J/mol/K) + + real(r8) :: vcmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: jmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: tpuc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: lmrc ! scaling factor for high temperature inhibition (25 C = 1.0) + + ! Other + integer :: f,p,c,iv ! indices + real(r8) :: cf ! s m**2/umol -> s/m + real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] + real(r8) :: gb ! leaf boundary layer conductance (m/s) + real(r8) :: cs ! CO2 partial pressure at leaf surface (Pa) + real(r8) :: gs ! leaf stomatal conductance (m/s) + real(r8) :: hs ! fractional humidity at leaf surface (dimensionless) + real(r8) :: sco ! relative specificity of rubisco + real(r8) :: ft ! photosynthesis temperature response (statement function) + real(r8) :: fth ! photosynthesis temperature inhibition (statement function) + real(r8) :: fth25 ! ccaling factor for photosynthesis temperature inhibition (statement function) + real(r8) :: tl ! leaf temperature in photosynthesis temperature function (K) + real(r8) :: ha ! activation energy in photosynthesis temperature function (J/mol) + real(r8) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) + real(r8) :: se ! entropy term in photosynthesis temperature function (J/mol/K) + real(r8) :: scaleFactor ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: ciold ! previous value of Ci for convergence check + real(r8) :: gs_mol_err ! gs_mol for error check + real(r8) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8) :: qabs ! PAR absorbed by PS II (umol photons/m**2/s) + real(r8) :: aquad,bquad,cquad ! terms for quadratic equations + real(r8) :: r1,r2 ! roots of quadratic equation + real(r8) :: ceair ! vapor pressure of air, constrained (Pa) + integer :: niter ! iteration loop index + real(r8) :: nscaler ! leaf nitrogen scaling coefficient + + real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) + + real(r8) :: psn_wc_z(bounds%begp:bounds%endp,nlevcan) ! Rubisco-limited contribution to psn_z (umol CO2/m**2/s) + real(r8) :: psn_wj_z(bounds%begp:bounds%endp,nlevcan) ! RuBP-limited contribution to psn_z (umol CO2/m**2/s) + real(r8) :: psn_wp_z(bounds%begp:bounds%endp,nlevcan) ! product-limited contribution to psn_z (umol CO2/m**2/s) + + real(r8) :: psncan ! canopy sum of psn_z + real(r8) :: psncan_wc ! canopy sum of psn_wc_z + real(r8) :: psncan_wj ! canopy sum of psn_wj_z + real(r8) :: psncan_wp ! canopy sum of psn_wp_z + real(r8) :: lmrcan ! canopy sum of lmr_z + real(r8) :: gscan ! canopy sum of leaf conductance + real(r8) :: laican ! canopy sum of lai_z + real(r8) :: rh_can + real(r8) , pointer :: lai_z (:,:) + real(r8) , pointer :: par_z (:,:) + real(r8) , pointer :: vcmaxcint (:) + real(r8) , pointer :: alphapsn (:) + real(r8) , pointer :: psn (:) + real(r8) , pointer :: psn_wc (:) + real(r8) , pointer :: psn_wj (:) + real(r8) , pointer :: psn_wp (:) + real(r8) , pointer :: psn_z (:,:) + real(r8) , pointer :: lmr (:) + real(r8) , pointer :: lmr_z (:,:) + real(r8) , pointer :: rs (:) + real(r8) , pointer :: rs_z (:,:) + real(r8) , pointer :: ci_z (:,:) + real(r8) , pointer :: o3coefv (:) ! o3 coefficient used in photo calculation + real(r8) , pointer :: o3coefg (:) ! o3 coefficient used in rs calculation + real(r8) , pointer :: alphapsnsun (:) + real(r8) , pointer :: alphapsnsha (:) + + real(r8) :: sum_nscaler + real(r8) :: total_lai + integer :: nptreemax + + real(r8) :: dtime ! land model time step (sec) + integer :: g ! index + !------------------------------------------------------------------------------ + + ! Temperature and soil water response functions + + ft(tl,ha) = exp( ha / (rgas*1.e-3_r8*(tfrz+25._r8)) * (1._r8 - (tfrz+25._r8)/tl) ) + fth(tl,hd,se,scaleFactor) = scaleFactor / ( 1._r8 + exp( (-hd+se*tl) / (rgas*1.e-3_r8*tl) ) ) + fth25(hd,se) = 1._r8 + exp( (-hd+se*(tfrz+25._r8)) / (rgas*1.e-3_r8*(tfrz+25._r8)) ) + + ! Enforce expected array sizes + + SHR_ASSERT_ALL_FL((ubound(esat_tv) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(eair) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(oair) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(cair) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(rb) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(btran) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(dayl_factor) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(leafn) == (/bounds%endp/)), sourcefile, __LINE__) + + associate( & + c3psn => pftcon%c3psn , & ! Input: photosynthetic pathway: 0. = c4, 1. = c3 + crop => pftcon%crop , & ! Input: crop or not (0 =not crop and 1 = crop) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + flnr => pftcon%flnr , & ! Input: fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) + fnitr => pftcon%fnitr , & ! Input: foliage nitrogen limitation factor (-) + slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis [m^2/gC] + dsladlai => pftcon%dsladlai , & ! Input: change in sla per unit lai + i_vcad => pftcon%i_vcad , & ! Input: [real(r8) (:) ] + s_vcad => pftcon%s_vcad , & ! Input: [real(r8) (:) ] + i_flnr => pftcon%i_flnr , & ! Input: [real(r8) (:) ] + s_flnr => pftcon%s_flnr , & ! Input: [real(r8) (:) ] + mbbopt => pftcon%mbbopt , & ! Input: [real(r8) (:) ] Ball-Berry slope of conduct/photosyn (umol H2O/umol CO2) + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) + tgcm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] air temperature at agcm reference height (kelvin) + + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] pft number of canopy layers, above snow for radiative transfer + tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] pft total leaf area index for canopy layer + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8)(:) ] one-sided leaf area index, no burying by snow + c3flag => photosyns_inst%c3flag_patch , & ! Output: [logical (:) ] true if C3 and false if C4 + ac => photosyns_inst%ac_patch , & ! Output: [real(r8) (:,:) ] Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + aj => photosyns_inst%aj_patch , & ! Output: [real(r8) (:,:) ] RuBP-limited gross photosynthesis (umol CO2/m**2/s) + ap => photosyns_inst%ap_patch , & ! Output: [real(r8) (:,:) ] product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + ag => photosyns_inst%ag_patch , & ! Output: [real(r8) (:,:) ] co-limited gross leaf photosynthesis (umol CO2/m**2/s) + an => photosyns_inst%an_patch , & ! Output: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) + gb_mol => photosyns_inst%gb_mol_patch , & ! Output: [real(r8) (:) ] leaf boundary layer conductance (umol H2O/m**2/s) + gs_mol => photosyns_inst%gs_mol_patch , & ! Output: [real(r8) (:,:) ] leaf stomatal conductance (umol H2O/m**2/s) + gs_mol_sun_ln => photosyns_inst%gs_mol_sun_ln_patch , & ! Output: [real(r8) (:,:) ] sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) + gs_mol_sha_ln => photosyns_inst%gs_mol_sha_ln_patch , & ! Output: [real(r8) (:,:) ] shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) + vcmax_z => photosyns_inst%vcmax_z_patch , & ! Output: [real(r8) (:,:) ] maximum rate of carboxylation (umol co2/m**2/s) + cp => photosyns_inst%cp_patch , & ! Output: [real(r8) (:) ] CO2 compensation point (Pa) + kc => photosyns_inst%kc_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for CO2 (Pa) + ko => photosyns_inst%ko_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for O2 (Pa) + qe => photosyns_inst%qe_patch , & ! Output: [real(r8) (:) ] quantum efficiency, used only for C4 (mol CO2 / mol photons) + tpu_z => photosyns_inst%tpu_z_patch , & ! Output: [real(r8) (:,:) ] triose phosphate utilization rate (umol CO2/m**2/s) + kp_z => photosyns_inst%kp_z_patch , & ! Output: [real(r8) (:,:) ] initial slope of CO2 response curve (C4 plants) + bbb => photosyns_inst%bbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + mbb => photosyns_inst%mbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry slope of conductance-photosynthesis relationship + rh_leaf => photosyns_inst%rh_leaf_patch , & ! Output: [real(r8) (:) ] fractional humidity at leaf surface (dimensionless) + vpd_can => photosyns_inst%vpd_can_patch , & ! Output: [real(r8) (:) ] canopy vapor pressure deficit (kPa) + lnc => photosyns_inst%lnca_patch , & ! Output: [real(r8) (:) ] top leaf layer leaf N concentration (gN leaf/m^2) + light_inhibit=> photosyns_inst%light_inhibit , & ! Input: [logical ] flag if light should inhibit respiration + leafresp_method=> photosyns_inst%leafresp_method , & ! Input: [integer ] method type to use for leaf-maint.-respiration at 25C canopy top + stomatalcond_mtd=> photosyns_inst%stomatalcond_mtd , & ! Input: [integer ] method type to use for stomatal conductance.GC.fnlprmsn15_r22845 + leaf_mr_vcm => canopystate_inst%leaf_mr_vcm & ! Input: [real(r8) ] scalar constant of leaf respiration with Vcmax + ) + + if (phase == 'sun') then + par_z => solarabs_inst%parsun_z_patch ! Input: [real(r8) (:,:) ] par absorbed per unit lai for canopy layer (w/m**2) + lai_z => canopystate_inst%laisun_z_patch ! Input: [real(r8) (:,:) ] leaf area index for canopy layer, sunlit or shaded + vcmaxcint => surfalb_inst%vcmaxcintsun_patch ! Input: [real(r8) (:) ] leaf to canopy scaling coefficient + alphapsn => photosyns_inst%alphapsnsun_patch ! Input: [real(r8) (:) ] 13C fractionation factor for PSN () + o3coefv => ozone_inst%o3coefvsun_patch ! Input: [real(r8) (:) ] O3 coefficient used in photosynthesis calculation + o3coefg => ozone_inst%o3coefgsun_patch ! Input: [real(r8) (:) ] O3 coefficient used in rs calculation + ci_z => photosyns_inst%cisun_z_patch ! Output: [real(r8) (:,:) ] intracellular leaf CO2 (Pa) + rs => photosyns_inst%rssun_patch ! Output: [real(r8) (:) ] leaf stomatal resistance (s/m) + rs_z => photosyns_inst%rssun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf stomatal resistance (s/m) + lmr => photosyns_inst%lmrsun_patch ! Output: [real(r8) (:) ] leaf maintenance respiration rate (umol CO2/m**2/s) + lmr_z => photosyns_inst%lmrsun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + psn => photosyns_inst%psnsun_patch ! Output: [real(r8) (:) ] foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_z => photosyns_inst%psnsun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wc => photosyns_inst%psnsun_wc_patch ! Output: [real(r8) (:) ] Rubisco-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wj => photosyns_inst%psnsun_wj_patch ! Output: [real(r8) (:) ] RuBP-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wp => photosyns_inst%psnsun_wp_patch ! Output: [real(r8) (:) ] product-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + else if (phase == 'sha') then + par_z => solarabs_inst%parsha_z_patch ! Input: [real(r8) (:,:) ] par absorbed per unit lai for canopy layer (w/m**2) + lai_z => canopystate_inst%laisha_z_patch ! Input: [real(r8) (:,:) ] leaf area index for canopy layer, sunlit or shaded + vcmaxcint => surfalb_inst%vcmaxcintsha_patch ! Input: [real(r8) (:) ] leaf to canopy scaling coefficient + alphapsn => photosyns_inst%alphapsnsha_patch ! Input: [real(r8) (:) ] 13C fractionation factor for PSN () + o3coefv => ozone_inst%o3coefvsha_patch ! Input: [real(r8) (:) ] O3 coefficient used in photosynthesis calculation + o3coefg => ozone_inst%o3coefgsha_patch ! Input: [real(r8) (:) ] O3 coefficient used in rs calculation + ci_z => photosyns_inst%cisha_z_patch ! Output: [real(r8) (:,:) ] intracellular leaf CO2 (Pa) + rs => photosyns_inst%rssha_patch ! Output: [real(r8) (:) ] leaf stomatal resistance (s/m) + rs_z => photosyns_inst%rssha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf stomatal resistance (s/m) + lmr => photosyns_inst%lmrsha_patch ! Output: [real(r8) (:) ] leaf maintenance respiration rate (umol CO2/m**2/s) + lmr_z => photosyns_inst%lmrsha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + psn => photosyns_inst%psnsha_patch ! Output: [real(r8) (:) ] foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_z => photosyns_inst%psnsha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wc => photosyns_inst%psnsha_wc_patch ! Output: [real(r8) (:) ] Rubisco-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wj => photosyns_inst%psnsha_wj_patch ! Output: [real(r8) (:) ] RuBP-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wp => photosyns_inst%psnsha_wp_patch ! Output: [real(r8) (:) ] product-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + end if + + !==============================================================================! + ! Photosynthesis and stomatal conductance parameters, from: + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + !==============================================================================! + + ! Determine seconds of current time step + + dtime = get_step_size_real() + + ! Activation energy, from: + ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + ! Bernacchi et al (2003) Plant, Cell and Environment 26:1419-1430 + ! except TPU from: Harley et al (1992) Plant, Cell and Environment 15:271-282 + + ! High temperature deactivation, from: + ! Leuning (2002) Plant, Cell and Environment 25:1205-1210 + ! The factor "c" scales the deactivation to a value of 1.0 at 25C + + lmrc = fth25 (params_inst%lmrhd, params_inst%lmrse) + + ! Miscellaneous parameters, from Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + ! C3 or C4 photosynthesis logical variable + + if (nint(c3psn(patch%itype(p))) == 1) then + c3flag(p) = .true. + else if (nint(c3psn(patch%itype(p))) == 0) then + c3flag(p) = .false. + end if + + ! C3 and C4 dependent parameters + + if (c3flag(p)) then + qe(p) = 0._r8 + bbbopt(p) = 10000._r8 + else + qe(p) = 0.05_r8 + bbbopt(p) = 40000._r8 + end if + + ! Soil water stress applied to Ball-Berry parameters + + bbb(p) = max (bbbopt(p)*btran(p), 1._r8) + mbb(p) = mbbopt(patch%itype(p)) + + ! kc, ko, cp, from: Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + ! + ! kc25_coef = 404.9e-6 mol/mol + ! ko25_coef = 278.4e-3 mol/mol + ! cp25_yr2000 = 42.75e-6 mol/mol + ! + ! Derive sco from cp and O2 using present-day O2 (0.209 mol/mol) and re-calculate + ! cp to account for variation in O2 using cp = 0.5 O2 / sco + ! + + kc25 = params_inst%kc25_coef * forc_pbot(c) + ko25 = params_inst%ko25_coef * forc_pbot(c) + sco = 0.5_r8 * 0.209_r8 / params_inst%cp25_yr2000 + cp25 = 0.5_r8 * oair(p) / sco + + kc(p) = kc25 * ft(t_veg(p), params_inst%kcha) + ko(p) = ko25 * ft(t_veg(p), params_inst%koha) + cp(p) = cp25 * ft(t_veg(p), params_inst%cpha) + + end do + + ! Multi-layer parameters scaled by leaf nitrogen profile. + ! Loop through each canopy layer to calculate nitrogen profile using + ! cumulative lai at the midpoint of the layer + + do f = 1, fn + p = filterp(f) + + if (lnc_opt .eqv. .false.) then + ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) + + if ( (slatop(patch%itype(p)) *leafcn(patch%itype(p))) .le. 0.0_r8)then + call endrun( "ERROR: slatop or leafcn is zero" ) + end if + lnc(p) = 1._r8 / (slatop(patch%itype(p)) * leafcn(patch%itype(p))) + end if + + ! Using the actual nitrogen allocated to the leaf after + ! uptake rather than fixing leaf nitrogen based on SLA and CN + ! ratio + if (lnc_opt .eqv. .true.) then + ! nlevcan and nrad(p) look like the same variable ?? check this later + sum_nscaler = 0.0_r8 + laican = 0.0_r8 + total_lai = 0.0_r8 + + do iv = 1, nrad(p) + + if (iv == 1) then + laican = 0.5_r8 * tlai_z(p,iv) + total_lai = tlai_z(p,iv) + else + laican = laican + 0.5_r8 * (tlai_z(p,iv-1)+tlai_z(p,iv)) + total_lai = total_lai + tlai_z(p,iv) + end if + + ! Scale for leaf nitrogen profile. If multi-layer code, use explicit + ! profile. If sun/shade big leaf code, use canopy integrated factor. + if (nlevcan == 1) then + nscaler = 1.0_r8 + else if (nlevcan > 1) then + nscaler = exp(-kn(p) * laican) + end if + + sum_nscaler = sum_nscaler + nscaler + + end do + + if (tlai(p) > 0.0_r8 .AND. sum_nscaler > 0.0_r8) then + ! dividing by LAI to convert total leaf nitrogen + ! from m2 ground to m2 leaf; dividing by sum_nscaler to + ! convert total leaf N to leaf N at canopy top + lnc(p) = leafn(p) / (tlai(p) * sum_nscaler) + else + lnc(p) = 0.0_r8 + end if + + end if + + + ! reduce_dayl_factor .eqv. .false. + if (reduce_dayl_factor .eqv. .true.) then + if (dayl_factor(p) > 0.25_r8) then + ! dayl_factor(p) = 1.0_r8 + end if + end if + + + ! Default + if (vcmax_opt == 0) then + ! vcmax25 at canopy top, as in CN but using lnc at top of the canopy + vcmax25top = lnc(p) * flnr(patch%itype(p)) * params_inst%fnr * params_inst%act25 * dayl_factor(p) + if (.not. use_cn) then + vcmax25top = vcmax25top * fnitr(patch%itype(p)) + else + if ( CNAllocate_Carbon_only() ) vcmax25top = vcmax25top * fnitr(patch%itype(p)) + end if + else if (vcmax_opt == 3) then + vcmax25top = ( i_vcad(patch%itype(p)) + s_vcad(patch%itype(p)) * lnc(p) ) * dayl_factor(p) + else if (vcmax_opt == 4) then + nptreemax = 9 ! is this number correct? check later + if (patch%itype(p) >= nptreemax) then ! if not tree + ! for shrubs and herbs + vcmax25top = lnc(p) * ( i_flnr(patch%itype(p)) + s_flnr(patch%itype(p)) * lnc(p) ) * params_inst%fnr * params_inst%act25 * & + dayl_factor(p) + else + ! if tree + vcmax25top = lnc(p) * ( i_flnr(patch%itype(p)) * exp(s_flnr(patch%itype(p)) * lnc(p)) ) * params_inst%fnr * params_inst%act25 * & + dayl_factor(p) + ! for trees + end if + end if + + + ! Parameters derived from vcmax25top. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + ! used jmax25 = 1.97 vcmax25, from Wullschleger (1993) Journal of Experimental Botany 44:907-920. + + jmax25top = ((2.59_r8 - 0.035_r8*min(max((t10(p)-tfrz),11._r8),35._r8)) * vcmax25top) * & + params_inst%jmax25top_sf + tpu25top = params_inst%tpu25ratio * vcmax25top + kp25top = params_inst%kp25ratio * vcmax25top + + ! Nitrogen scaling factor. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 used + ! kn = 0.11. Here, derive kn from vcmax25 as in Lloyd et al (2010) Biogeosciences, 7, 1833-1859 + ! Remove daylength factor from vcmax25 so that kn is based on maximum vcmax25 + ! But not used as defined here if using sun/shade big leaf code. Instead, + ! will use canopy integrated scaling factors from SurfaceAlbedo. + + if (dayl_factor(p) < 1.0e-12_r8) then + kn(p) = 0._r8 + else + kn(p) = exp(0.00963_r8 * vcmax25top/dayl_factor(p) - 2.43_r8) + end if + + if (use_cn) then + if ( leafresp_method == leafresp_mtd_ryan1991 ) then + ! Leaf maintenance respiration to match the base rate used in CN + ! but with the new temperature functions for C3 and C4 plants. + ! + ! Base rate for maintenance respiration is from: + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + ! + ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 + ! + ! CN respiration has units: g C / g N [leaf] / s. This needs to be + ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s + ! + ! Then scale this value at the top of the canopy for canopy depth + + lmr25top = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) + lmr25top = lmr25top * lnc(p) / 12.e-06_r8 + + else if ( leafresp_method == leafresp_mtd_atkin2015 ) then + !using new form for respiration base rate from Atkin + !communication. + if ( lnc(p) > 0.0_r8 ) then + lmr25top = params_inst%lmr_intercept_atkin(ivt(p)) + (lnc(p) * 0.2061_r8) - (0.0402_r8 * (t10(p)-tfrz)) + else + lmr25top = 0.0_r8 + end if + end if + + else + ! Leaf maintenance respiration in proportion to vcmax25top + + if (c3flag(p)) then + lmr25top = vcmax25top * leaf_mr_vcm + else + lmr25top = vcmax25top * 0.025_r8 + end if + end if + + ! Loop through canopy layers (above snow). Respiration needs to be + ! calculated every timestep. Others are calculated only if daytime + + laican = 0._r8 + do iv = 1, nrad(p) + + ! Cumulative lai at middle of layer + + if (iv == 1) then + laican = 0.5_r8 * tlai_z(p,iv) + else + laican = laican + 0.5_r8 * (tlai_z(p,iv-1)+tlai_z(p,iv)) + end if + + ! Scale for leaf nitrogen profile. If multi-layer code, use explicit + ! profile. If sun/shade big leaf code, use canopy integrated factor. + + if (nlevcan == 1) then + nscaler = vcmaxcint(p) + else if (nlevcan > 1) then + nscaler = exp(-kn(p) * laican) + end if + + ! Maintenance respiration + + lmr25 = lmr25top * nscaler + + if(use_luna.and.c3flag(p).and.crop(patch%itype(p))== 0) then + if(.not.use_cn)then ! If CN is on, use leaf N to predict respiration (above). Otherwise, use Vcmax term from LUNA. RF + lmr25 = leaf_mr_vcm * photosyns_inst%vcmx25_z_patch(p,iv) + endif + endif + + if (c3flag(p)) then + lmr_z(p,iv) = lmr25 * ft(t_veg(p), params_inst%lmrha) * fth(t_veg(p), params_inst%lmrhd, & + params_inst%lmrse, lmrc) + else + lmr_z(p,iv) = lmr25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + lmr_z(p,iv) = lmr_z(p,iv) / (1._r8 + exp( 1.3_r8*(t_veg(p)-(tfrz+55._r8)) )) + end if + + if (par_z(p,iv) <= 0._r8) then ! night time + + vcmax_z(p,iv) = 0._r8 + jmax_z(p,iv) = 0._r8 + tpu_z(p,iv) = 0._r8 + kp_z(p,iv) = 0._r8 + + if ( use_c13 ) then + alphapsn(p) = 1._r8 + end if + + else ! day time + + if(use_luna.and.c3flag(p).and.crop(patch%itype(p))== 0)then + vcmax25 = photosyns_inst%vcmx25_z_patch(p,iv) + jmax25 = photosyns_inst%jmx25_z_patch(p,iv) + tpu25 = params_inst%tpu25ratio * vcmax25 + !Implement scaling of Vcmax25 from sunlit average to shaded canopy average value. RF & GBB. 1 July 2016 + if(phase == 'sha'.and.surfalb_inst%vcmaxcintsun_patch(p).gt.0._r8.and.nlevcan==1) then + vcmax25 = vcmax25 * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) + jmax25 = jmax25 * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) + tpu25 = tpu25 * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) + end if + + else + vcmax25 = vcmax25top * nscaler + jmax25 = jmax25top * nscaler + tpu25 = tpu25top * nscaler + endif + kp25 = kp25top * nscaler + + ! Adjust for temperature + + vcmaxse = (668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%vcmaxse_sf + jmaxse = (659.70_r8 - 0.75_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%jmaxse_sf + tpuse = (668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%tpuse_sf + vcmaxc = fth25 (params_inst%vcmaxhd, vcmaxse) + jmaxc = fth25 (params_inst%jmaxhd, jmaxse) + tpuc = fth25 (params_inst%tpuhd, tpuse) + vcmax_z(p,iv) = vcmax25 * ft(t_veg(p), params_inst%vcmaxha) * fth(t_veg(p), & + params_inst%vcmaxhd, vcmaxse, vcmaxc) + jmax_z(p,iv) = jmax25 * ft(t_veg(p), params_inst%jmaxha) * fth(t_veg(p), & + params_inst%jmaxhd, jmaxse, jmaxc) + tpu_z(p,iv) = tpu25 * ft(t_veg(p), params_inst%tpuha) * fth(t_veg(p), params_inst%tpuhd, tpuse, tpuc) + + if (.not. c3flag(p)) then + vcmax_z(p,iv) = vcmax25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + vcmax_z(p,iv) = vcmax_z(p,iv) / (1._r8 + exp( 0.2_r8*((tfrz+15._r8)-t_veg(p)) )) + vcmax_z(p,iv) = vcmax_z(p,iv) / (1._r8 + exp( 0.3_r8*(t_veg(p)-(tfrz+40._r8)) )) + end if + + kp_z(p,iv) = kp25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + + end if + + ! Adjust for soil water + + vcmax_z(p,iv) = vcmax_z(p,iv) * btran(p) + lmr_z(p,iv) = lmr_z(p,iv) * btran(p) + + ! Change to add in light inhibition of respiration. 0.67 from Lloyd et al. 2010, & Metcalfe et al. 2012 + ! Also pers. comm from Peter Reich (Nov 2015). Might potentially be updated pending findings of Atkin et al. (in prep) + ! review of light inhibition database. + if ( light_inhibit .and. par_z(p,1) > 0._r8) then ! are the lights on? + lmr_z(p,iv) = lmr_z(p,iv) * 0.67_r8 ! inhibit respiration accordingly. + end if + + end do ! canopy layer loop + end do ! patch loop + + !==============================================================================! + ! Leaf-level photosynthesis and stomatal conductance + !==============================================================================! + + rsmax0 = 2.e4_r8 + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + g = patch%gridcell(p) + + ! Leaf boundary layer conductance, umol/m**2/s + + cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e06_r8 + gb = 1._r8/rb(p) + gb_mol(p) = gb * cf + + ! Loop through canopy layers (above snow). Only do calculations if daytime + + do iv = 1, nrad(p) + + if (par_z(p,iv) <= 0._r8) then ! night time + + ac(p,iv) = 0._r8 + aj(p,iv) = 0._r8 + ap(p,iv) = 0._r8 + ag(p,iv) = 0._r8 + an(p,iv) = ag(p,iv) - lmr_z(p,iv) + psn_z(p,iv) = 0._r8 + psn_wc_z(p,iv) = 0._r8 + psn_wj_z(p,iv) = 0._r8 + psn_wp_z(p,iv) = 0._r8 + rs_z(p,iv) = min(rsmax0, 1._r8/bbb(p) * cf) + ci_z(p,iv) = 0._r8 + rh_leaf(p) = 0._r8 + + else ! day time + + !now the constraint is no longer needed, Jinyun Tang + ceair = min( eair(p), esat_tv(p) ) + if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then + rh_can = ceair / esat_tv(p) + else if ( stomatalcond_mtd == stomatalcond_mtd_medlyn2011 )then + ! Put some constraints on RH in the canopy when Medlyn stomatal conductance is being used + rh_can = max((esat_tv(p) - ceair), 50._r8) * 0.001_r8 + vpd_can(p) = rh_can + end if + + ! Electron transport rate for C3 plants. Convert par from W/m2 to + ! umol photons/m**2/s using the factor 4.6 + + qabs = 0.5_r8 * (1._r8 - params_inst%fnps) * par_z(p,iv) * 4.6_r8 + aquad = params_inst%theta_psii + bquad = -(qabs + jmax_z(p,iv)) + cquad = qabs * jmax_z(p,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + je = min(r1,r2) + + ! Iterative loop for ci beginning with initial guess + + if (c3flag(p)) then + ci_z(p,iv) = 0.7_r8 * cair(p) + else + ci_z(p,iv) = 0.4_r8 * cair(p) + end if + + niter = 0 + + ! Increment iteration counter. Stop if too many iterations + + niter = niter + 1 + + ! Save old ci + + ciold = ci_z(p,iv) + + !find ci and stomatal conductance + call hybrid(ciold, p, iv, c, gb_mol(p), je, cair(p), oair(p), & + lmr_z(p,iv), par_z(p,iv), rh_can, gs_mol(p,iv), niter, & + atm2lnd_inst, photosyns_inst) + + ! End of ci iteration. Check for an < 0, in which case gs_mol = bbb + + if (an(p,iv) < 0._r8) gs_mol(p,iv) = bbb(p) + + ! Use time period 1 hour before and 1 hour after local noon inclusive (11AM-1PM) + if ( is_near_local_noon( grc%londeg(g), deltasec=3600 ) )then + if (phase == 'sun') then + gs_mol_sun_ln(p,iv) = gs_mol(p,iv) + else if (phase == 'sha') then + gs_mol_sha_ln(p,iv) = gs_mol(p,iv) + end if + else + if (phase == 'sun') then + gs_mol_sun_ln(p,iv) = spval + else if (phase == 'sha') then + gs_mol_sha_ln(p,iv) = spval + end if + end if + + ! Final estimates for cs and ci (needed for early exit of ci iteration when an < 0) + + cs = cair(p) - 1.4_r8/gb_mol(p) * an(p,iv) * forc_pbot(c) + cs = max(cs,1.e-06_r8) + ci_z(p,iv) = cair(p) - an(p,iv) * forc_pbot(c) * (1.4_r8*gs_mol(p,iv)+1.6_r8*gb_mol(p)) / (gb_mol(p)*gs_mol(p,iv)) + + ! Trap for values of ci_z less than 1.e-06. This is needed for + ! Megan (which can crash with negative values) + ci_z(p,iv) = max( ci_z(p,iv), 1.e-06_r8 ) + + ! Convert gs_mol (umol H2O/m**2/s) to gs (m/s) and then to rs (s/m) + + gs = gs_mol(p,iv) / cf + rs_z(p,iv) = min(1._r8/gs, rsmax0) + rs_z(p,iv) = rs_z(p,iv) / o3coefg(p) + + ! Photosynthesis. Save rate-limiting photosynthesis + + psn_z(p,iv) = ag(p,iv) + psn_z(p,iv) = psn_z(p,iv) * o3coefv(p) + + psn_wc_z(p,iv) = 0._r8 + psn_wj_z(p,iv) = 0._r8 + psn_wp_z(p,iv) = 0._r8 + + if (ac(p,iv) <= aj(p,iv) .and. ac(p,iv) <= ap(p,iv)) then + psn_wc_z(p,iv) = psn_z(p,iv) + else if (aj(p,iv) < ac(p,iv) .and. aj(p,iv) <= ap(p,iv)) then + psn_wj_z(p,iv) = psn_z(p,iv) + else if (ap(p,iv) < ac(p,iv) .and. ap(p,iv) < aj(p,iv)) then + psn_wp_z(p,iv) = psn_z(p,iv) + end if + + ! Make sure iterative solution is correct + + if (gs_mol(p,iv) < 0._r8) then + write (iulog,*)'Negative stomatal conductance:' + write (iulog,*)'p,iv,gs_mol= ',p,iv,gs_mol(p,iv) + call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) + end if + + ! Compare with Ball-Berry model: gs_mol = m * an * hs/cs p + b + + hs = (gb_mol(p)*ceair + gs_mol(p,iv)*esat_tv(p)) / ((gb_mol(p)+gs_mol(p,iv))*esat_tv(p)) + rh_leaf(p) = hs + gs_mol_err = mbb(p)*max(an(p,iv), 0._r8)*hs/cs*forc_pbot(c) + bbb(p) + + if (abs(gs_mol(p,iv)-gs_mol_err) > 1.e-01_r8) then + write (iulog,*) 'Ball-Berry error check - stomatal conductance error:' + write (iulog,*) gs_mol(p,iv), gs_mol_err + end if + + end if ! night or day if branch + end do ! canopy layer loop + end do ! patch loop + + !==============================================================================! + ! Canopy photosynthesis and stomatal conductance + !==============================================================================! + + ! Sum canopy layer fluxes and then derive effective leaf-level fluxes (per + ! unit leaf area), which are used in other parts of the model. Here, laican + ! sums to either laisun or laisha. + + do f = 1, fn + p = filterp(f) + + psncan = 0._r8 + psncan_wc = 0._r8 + psncan_wj = 0._r8 + psncan_wp = 0._r8 + lmrcan = 0._r8 + gscan = 0._r8 + laican = 0._r8 + do iv = 1, nrad(p) + psncan = psncan + psn_z(p,iv) * lai_z(p,iv) + psncan_wc = psncan_wc + psn_wc_z(p,iv) * lai_z(p,iv) + psncan_wj = psncan_wj + psn_wj_z(p,iv) * lai_z(p,iv) + psncan_wp = psncan_wp + psn_wp_z(p,iv) * lai_z(p,iv) + lmrcan = lmrcan + lmr_z(p,iv) * lai_z(p,iv) + gscan = gscan + lai_z(p,iv) / (rb(p)+rs_z(p,iv)) + laican = laican + lai_z(p,iv) + end do + if (laican > 0._r8) then + psn(p) = psncan / laican + psn_wc(p) = psncan_wc / laican + psn_wj(p) = psncan_wj / laican + psn_wp(p) = psncan_wp / laican + lmr(p) = lmrcan / laican + rs(p) = laican / gscan - rb(p) + else + psn(p) = 0._r8 + psn_wc(p) = 0._r8 + psn_wj(p) = 0._r8 + psn_wp(p) = 0._r8 + lmr(p) = 0._r8 + rs(p) = 0._r8 + end if + end do + + end associate + + end subroutine Photosynthesis + + !------------------------------------------------------------------------------ + subroutine PhotosynthesisTotal (fn, filterp, & + atm2lnd_inst, canopystate_inst, photosyns_inst) + ! + ! Determine total photosynthesis + ! + ! !ARGUMENTS: + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! patch filter + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + ! + ! !LOCAL VARIABLES: + integer :: f,fp,p,l,g ! indices + + real(r8) :: rc14_atm(nsectors_c14), rc13_atm + integer :: sector_c14 + !----------------------------------------------------------------------- + + associate( & + forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] partial pressure co2 (Pa) + forc_pc13o2 => atm2lnd_inst%forc_pc13o2_grc , & ! Input: [real(r8) (:) ] partial pressure c13o2 (Pa) + forc_po2 => atm2lnd_inst%forc_po2_grc , & ! Input: [real(r8) (:) ] partial pressure o2 (Pa) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area + + psnsun => photosyns_inst%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_inst%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf photosynthesis (umol CO2 /m**2/ s) + rc13_canair => photosyns_inst%rc13_canair_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in canopy air + rc13_psnsun => photosyns_inst%rc13_psnsun_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in sunlit canopy psn flux + rc13_psnsha => photosyns_inst%rc13_psnsha_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in shaded canopy psn flux + alphapsnsun => photosyns_inst%alphapsnsun_patch , & ! Output: [real(r8) (:) ] fractionation factor in sunlit canopy psn flux + alphapsnsha => photosyns_inst%alphapsnsha_patch , & ! Output: [real(r8) (:) ] fractionation factor in shaded canopy psn flux + psnsun_wc => photosyns_inst%psnsun_wc_patch , & ! Output: [real(r8) (:) ] Rubsico-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsun_wj => photosyns_inst%psnsun_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsun_wp => photosyns_inst%psnsun_wp_patch , & ! Output: [real(r8) (:) ] product-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wc => photosyns_inst%psnsha_wc_patch , & ! Output: [real(r8) (:) ] Rubsico-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wj => photosyns_inst%psnsha_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wp => photosyns_inst%psnsha_wp_patch , & ! Output: [real(r8) (:) ] product-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_inst%c13_psnsun_patch , & ! Output: [real(r8) (:) ] sunlit leaf photosynthesis (umol 13CO2 /m**2/ s) + c13_psnsha => photosyns_inst%c13_psnsha_patch , & ! Output: [real(r8) (:) ] shaded leaf photosynthesis (umol 13CO2 /m**2/ s) + c14_psnsun => photosyns_inst%c14_psnsun_patch , & ! Output: [real(r8) (:) ] sunlit leaf photosynthesis (umol 14CO2 /m**2/ s) + c14_psnsha => photosyns_inst%c14_psnsha_patch , & ! Output: [real(r8) (:) ] shaded leaf photosynthesis (umol 14CO2 /m**2/ s) + fpsn => photosyns_inst%fpsn_patch , & ! Output: [real(r8) (:) ] photosynthesis (umol CO2 /m**2 /s) + fpsn_wc => photosyns_inst%fpsn_wc_patch , & ! Output: [real(r8) (:) ] Rubisco-limited photosynthesis (umol CO2 /m**2 /s) + fpsn_wj => photosyns_inst%fpsn_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited photosynthesis (umol CO2 /m**2 /s) + fpsn_wp => photosyns_inst%fpsn_wp_patch & ! Output: [real(r8) (:) ] product-limited photosynthesis (umol CO2 /m**2 /s) + ) + + if ( use_c14 ) then + if (use_c14_bombspike) then + call C14BombSpike(rc14_atm) + else + rc14_atm(:) = c14ratio + end if + end if + + if ( use_c13 ) then + if (use_c13_timeseries) then + call C13TimeSeries(rc13_atm) + end if + end if + + do f = 1, fn + p = filterp(f) + g = patch%gridcell(p) + + if (.not. use_fates) then + fpsn(p) = psnsun(p) *laisun(p) + psnsha(p) *laisha(p) + fpsn_wc(p) = psnsun_wc(p)*laisun(p) + psnsha_wc(p)*laisha(p) + fpsn_wj(p) = psnsun_wj(p)*laisun(p) + psnsha_wj(p)*laisha(p) + fpsn_wp(p) = psnsun_wp(p)*laisun(p) + psnsha_wp(p)*laisha(p) + end if + + if (use_cn) then + if ( use_c13 ) then + if (use_c13_timeseries) then + rc13_canair(p) = rc13_atm + else + rc13_canair(p) = forc_pc13o2(g)/(forc_pco2(g) - forc_pc13o2(g)) + endif + rc13_psnsun(p) = rc13_canair(p)/alphapsnsun(p) + rc13_psnsha(p) = rc13_canair(p)/alphapsnsha(p) + c13_psnsun(p) = psnsun(p) * (rc13_psnsun(p)/(1._r8+rc13_psnsun(p))) + c13_psnsha(p) = psnsha(p) * (rc13_psnsha(p)/(1._r8+rc13_psnsha(p))) + + ! use fixed c13 ratio with del13C of -25 to test the overall c13 structure + ! c13_psnsun(p) = 0.01095627 * psnsun(p) + ! c13_psnsha(p) = 0.01095627 * psnsha(p) + endif + if ( use_c14 ) then + + ! determine latitute sector for radiocarbon bomb spike inputs + if ( grc%latdeg(g) .ge. 30._r8 ) then + sector_c14 = 1 + else if ( grc%latdeg(g) .ge. -30._r8 ) then + sector_c14 = 2 + else + sector_c14 = 3 + endif + + c14_psnsun(p) = rc14_atm(sector_c14) * psnsun(p) + c14_psnsha(p) = rc14_atm(sector_c14) * psnsha(p) + endif + end if + + end do + + end associate + + end subroutine PhotosynthesisTotal + + !------------------------------------------------------------------------------ + subroutine Fractionation(bounds, fn, filterp, downreg, & + atm2lnd_inst, canopystate_inst, solarabs_inst, surfalb_inst, photosyns_inst, & + phase) + ! + ! !DESCRIPTION: + ! C13 fractionation during photosynthesis is calculated here after the nitrogen + ! limitation is taken into account in the CNAllocation module. + ! + ! As of CLM5, nutrient downregulation occurs prior to photosynthesis via leafcn, so we may + ! ignore the downregulation term in this and assume that the Ci/Ca used in the photosynthesis + ! calculation is consistent with that in the isotope calculation + ! + !!USES: + use clm_varctl , only : use_hydrstress + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! patch filter + real(r8) , intent(in) :: downreg( bounds%begp: ) ! fractional reduction in GPP due to N limitation (dimensionless) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(solarabs_type) , intent(in) :: solarabs_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(photosyns_type) , intent(in) :: photosyns_inst + character(len=*) , intent(in) :: phase ! 'sun' or 'sha' + ! + ! !LOCAL VARIABLES: + real(r8) , pointer :: par_z (:,:) ! needed for backwards compatiblity + real(r8) , pointer :: alphapsn (:) ! needed for backwards compatiblity + real(r8) , pointer :: gs_mol(:,:) ! leaf stomatal conductance (umol H2O/m**2/s) + real(r8) , pointer :: an(:,:) ! net leaf photosynthesis (umol CO2/m**2/s) + integer :: f,p,c,g,iv ! indices + real(r8) :: co2(bounds%begp:bounds%endp) ! atmospheric co2 partial pressure (pa) + real(r8) :: ci + !------------------------------------------------------------------------------ + + SHR_ASSERT_ALL_FL((ubound(downreg) == (/bounds%endp/)), sourcefile, __LINE__) + + associate( & + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] partial pressure co2 (Pa) + + c3psn => pftcon%c3psn , & ! Input: photosynthetic pathway: 0. = c4, 1. = c3 + + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer + + gb_mol => photosyns_inst%gb_mol_patch & ! Input: [real(r8) (:) ] leaf boundary layer conductance (umol H2O/m**2/s) + ) + + if (phase == 'sun') then + par_z => solarabs_inst%parsun_z_patch ! Input : [real(r8) (:,:)] par absorbed per unit lai for canopy layer (w/m**2) + alphapsn => photosyns_inst%alphapsnsun_patch ! Output: [real(r8) (:)] + if (use_hydrstress) then + gs_mol => photosyns_inst%gs_mol_sun_patch ! Input: [real(r8) (:,:) ] sunlit leaf stomatal conductance (umol H2O/m**2/s) + an => photosyns_inst%an_sun_patch ! Input: [real(r8) (:,:) ] net sunlit leaf photosynthesis (umol CO2/m**2/s) + else + gs_mol => photosyns_inst%gs_mol_patch ! Input: [real(r8) (:,:) ] leaf stomatal conductance (umol H2O/m**2/s) + an => photosyns_inst%an_patch ! Input: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) + end if + else if (phase == 'sha') then + par_z => solarabs_inst%parsha_z_patch ! Input : [real(r8) (:,:)] par absorbed per unit lai for canopy layer (w/m**2) + alphapsn => photosyns_inst%alphapsnsha_patch ! Output: [real(r8) (:)] + if (use_hydrstress) then + gs_mol => photosyns_inst%gs_mol_sha_patch ! Input: [real(r8) (:,:) ] shaded leaf stomatal conductance (umol H2O/m**2/s) + an => photosyns_inst%an_sha_patch ! Input: [real(r8) (:,:) ] net shaded leaf photosynthesis (umol CO2/m**2/s) + else + gs_mol => photosyns_inst%gs_mol_patch ! Input: [real(r8) (:,:) ] leaf stomatal conductance (umol H2O/m**2/s) + an => photosyns_inst%an_patch ! Input: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) + end if + end if + + do f = 1, fn + p = filterp(f) + c= patch%column(p) + g= patch%gridcell(p) + + co2(p) = forc_pco2(g) + do iv = 1,nrad(p) + if (par_z(p,iv) <= 0._r8) then ! night time + alphapsn(p) = 1._r8 + else ! day time + ci = co2(p) - (an(p,iv) * & + forc_pbot(c) * & + (1.4_r8*gs_mol(p,iv)+1.6_r8*gb_mol(p)) / (gb_mol(p)*gs_mol(p,iv))) + alphapsn(p) = 1._r8 + (((c3psn(patch%itype(p)) * & + (4.4_r8 + (22.6_r8*(ci/co2(p))))) + & + ((1._r8 - c3psn(patch%itype(p))) * 4.4_r8))/1000._r8) + end if + end do + end do + + end associate + + end subroutine Fractionation + + !------------------------------------------------------------------------------- + subroutine hybrid(x0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& + rh_can, gs_mol,iter, & + atm2lnd_inst, photosyns_inst) + ! + !! DESCRIPTION: + ! use a hybrid solver to find the root of equation + ! f(x) = x- h(x), + !we want to find x, s.t. f(x) = 0. + !the hybrid approach combines the strength of the newton secant approach (find the solution domain) + !and the bisection approach implemented with the Brent's method to guarrantee convergence. + + ! + !! REVISION HISTORY: + !Dec 14/2012: created by Jinyun Tang + ! + !!USES: + ! + !! ARGUMENTS: + implicit none + real(r8), intent(inout) :: x0 !initial guess and final value of the solution + real(r8), intent(in) :: lmr_z ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), intent(in) :: par_z ! par absorbed per unit lai for canopy layer (w/m**2) + real(r8), intent(in) :: rh_can ! canopy air relative humidity + real(r8), intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), intent(in) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + integer, intent(in) :: p, iv, c ! pft, c3/c4, and column index + real(r8), intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + integer, intent(out) :: iter !number of iterations used, for record only + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type), intent(inout) :: photosyns_inst + ! + !! LOCAL VARIABLES + real(r8) :: a, b + real(r8) :: fa, fb + real(r8) :: x1, f0, f1 + real(r8) :: x, dx + real(r8), parameter :: eps = 1.e-2_r8 !relative accuracy + real(r8), parameter :: eps1= 1.e-4_r8 + integer, parameter :: itmax = 40 !maximum number of iterations + real(r8) :: tol,minx,minf + + call ci_func(x0, f0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + + if(f0 == 0._r8)return + + minx=x0 + minf=f0 + x1 = x0 * 0.99_r8 + + call ci_func(x1,f1, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + + if(f1==0._r8)then + x0 = x1 + return + endif + if(f1itmax)then + !in case of failing to converge within itmax iterations + !stop at the minimum function + !this happens because of some other issues besides the stomatal conductance calculation + !and it happens usually in very dry places and more likely with c4 plants. + + call ci_func(minx,f1, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + + exit + endif + enddo + + end subroutine hybrid + + !------------------------------------------------------------------------------ + subroutine brent(x, x1,x2,f1, f2, tol, ip, iv, ic, gb_mol, je, cair, oair,& + lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + ! + !!DESCRIPTION: + !Use Brent's method to find the root of a single variable function ci_func, which is known to exist between x1 and x2. + !The found root will be updated until its accuracy is tol. + + !!REVISION HISTORY: + !Dec 14/2012: Jinyun Tang, modified from numerical recipes in F90 by press et al. 1188-1189 + ! + !!ARGUMENTS: + real(r8), intent(out) :: x ! indepedent variable of the single value function ci_func(x) + real(r8), intent(in) :: x1, x2, f1, f2 ! minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 + real(r8), intent(in) :: tol ! the error tolerance + real(r8), intent(in) :: lmr_z ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), intent(in) :: par_z ! par absorbed per unit lai for canopy layer (w/m**2) + real(r8), intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), intent(in) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + real(r8), intent(in) :: rh_can ! inside canopy relative humidity + integer, intent(in) :: ip, iv, ic ! pft, c3/c4, and column index + real(r8), intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type), intent(inout) :: photosyns_inst + ! + !!LOCAL VARIABLES: + integer, parameter :: itmax=20 !maximum number of iterations + real(r8), parameter :: eps=1.e-2_r8 !relative error tolerance + integer :: iter + real(r8) :: a,b,c,d,e,fa,fb,fc,p,q,r,s,tol1,xm + !------------------------------------------------------------------------------ + + a=x1 + b=x2 + fa=f1 + fb=f2 + if((fa > 0._r8 .and. fb > 0._r8).or.(fa < 0._r8 .and. fb < 0._r8))then + write(iulog,*) 'root must be bracketed for brent' + call endrun(msg=errmsg(sourcefile, __LINE__)) + endif + c=b + fc=fb + iter = 0 + do + if(iter==itmax)exit + iter=iter+1 + if((fb > 0._r8 .and. fc > 0._r8) .or. (fb < 0._r8 .and. fc < 0._r8))then + c=a !Rename a, b, c and adjust bounding interval d. + fc=fa + d=b-a + e=d + endif + if( abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + endif + tol1=2._r8*eps*abs(b)+0.5_r8*tol !Convergence check. + xm=0.5_r8*(c-b) + if(abs(xm) <= tol1 .or. fb == 0.)then + x=b + return + endif + if(abs(e) >= tol1 .and. abs(fa) > abs(fb)) then + s=fb/fa !Attempt inverse quadratic interpolation. + if(a == c) then + p=2._r8*xm*s + q=1._r8-s + else + q=fa/fc + r=fb/fc + p=s*(2._r8*xm*q*(q-r)-(b-a)*(r-1._r8)) + q=(q-1._r8)*(r-1._r8)*(s-1._r8) + endif + if(p > 0._r8) q=-q !Check whether in bounds. + p=abs(p) + if(2._r8*p < min(3._r8*xm*q-abs(tol1*q),abs(e*q))) then + e=d !Accept interpolation. + d=p/q + else + d=xm !Interpolation failed, use bisection. + e=d + endif + else !Bounds decreasing too slowly, use bisection. + d=xm + e=d + endif + a=b !Move last best guess to a. + fa=fb + if(abs(d) > tol1) then !Evaluate new trial root. + b=b+d + else + b=b+sign(tol1,xm) + endif + + call ci_func(b, fb, ip, iv, ic, gb_mol, je, cair, oair, lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + + if(fb==0._r8)exit + + enddo + + if(iter==itmax)write(iulog,*) 'brent exceeding maximum iterations', b, fb + x=b + + return + end subroutine brent + + !------------------------------------------------------------------------------- + function ft(tl, ha) result(ans) + ! + !!DESCRIPTION: + ! photosynthesis temperature response + ! + ! !REVISION HISTORY + ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 + ! + !!USES + use clm_varcon , only : rgas, tfrz + ! + ! !ARGUMENTS: + real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) + real(r8), intent(in) :: ha ! activation energy in photosynthesis temperature function (J/mol) + ! + ! !LOCAL VARIABLES: + real(r8) :: ans + !------------------------------------------------------------------------------- + + ans = exp( ha / (rgas*1.e-3_r8*(tfrz+25._r8)) * (1._r8 - (tfrz+25._r8)/tl) ) + + return + end function ft + + !------------------------------------------------------------------------------- + function fth(tl,hd,se,scaleFactor) result(ans) + ! + !!DESCRIPTION: + !photosynthesis temperature inhibition + ! + ! !REVISION HISTORY + ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 + ! + use clm_varcon , only : rgas, tfrz + ! + ! !ARGUMENTS: + real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) + real(r8), intent(in) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) + real(r8), intent(in) :: se ! entropy term in photosynthesis temperature function (J/mol/K) + real(r8), intent(in) :: scaleFactor ! scaling factor for high temperature inhibition (25 C = 1.0) + ! + ! !LOCAL VARIABLES: + real(r8) :: ans + !------------------------------------------------------------------------------- + + ans = scaleFactor / ( 1._r8 + exp( (-hd+se*tl) / (rgas*1.e-3_r8*tl) ) ) + + return + end function fth + + !------------------------------------------------------------------------------- + function fth25(hd,se)result(ans) + ! + !!DESCRIPTION: + ! scaling factor for photosynthesis temperature inhibition + ! + ! !REVISION HISTORY: + ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 + ! + !!USES + use clm_varcon , only : rgas, tfrz + ! + ! !ARGUMENTS: + real(r8), intent(in) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) + real(r8), intent(in) :: se ! entropy term in photosynthesis temperature function (J/mol/K) + ! + ! !LOCAL VARIABLES: + real(r8) :: ans + !------------------------------------------------------------------------------- + + ans = 1._r8 + exp( (-hd+se*(tfrz+25._r8)) / (rgas*1.e-3_r8*(tfrz+25._r8)) ) + + return + end function fth25 + + !------------------------------------------------------------------------------ + subroutine ci_func(ci, fval, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& + rh_can, gs_mol, atm2lnd_inst, photosyns_inst) + ! + !! DESCRIPTION: + ! evaluate the function + ! f(ci)=ci - (ca - (1.37rb+1.65rs))*patm*an + ! + ! remark: I am attempting to maintain the original code structure, also + ! considering one may be interested to output relevant variables for the + ! photosynthesis model, I have decided to add these relevant variables to + ! the relevant data types. + ! + !!ARGUMENTS: + real(r8) , intent(in) :: ci ! intracellular leaf CO2 (Pa) + real(r8) , intent(in) :: lmr_z ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8) , intent(in) :: par_z ! par absorbed per unit lai for canopy layer (w/m**2) + real(r8) , intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8) , intent(in) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8) , intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8) , intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + real(r8) , intent(in) :: rh_can ! canopy air realtive humidity + integer , intent(in) :: p, iv, c ! pft, vegetation type and column indexes + real(r8) , intent(out) :: fval ! return function of the value f(ci) + real(r8) , intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + ! + !local variables + real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) + real(r8) :: cs ! CO2 partial pressure at leaf surface (Pa) + + real(r8) :: aquad, bquad, cquad ! terms for quadratic equations + real(r8) :: r1, r2 ! roots of quadratic equation + !------------------------------------------------------------------------------ + + associate(& + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Output: [real(r8) (:) ] atmospheric pressure (Pa) + c3flag => photosyns_inst%c3flag_patch , & ! Output: [logical (:) ] true if C3 and false if C4 + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + ac => photosyns_inst%ac_patch , & ! Output: [real(r8) (:,:) ] Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + aj => photosyns_inst%aj_patch , & ! Output: [real(r8) (:,:) ] RuBP-limited gross photosynthesis (umol CO2/m**2/s) + ap => photosyns_inst%ap_patch , & ! Output: [real(r8) (:,:) ] product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + ag => photosyns_inst%ag_patch , & ! Output: [real(r8) (:,:) ] co-limited gross leaf photosynthesis (umol CO2/m**2/s) + an => photosyns_inst%an_patch , & ! Output: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) + vcmax_z => photosyns_inst%vcmax_z_patch , & ! Input: [real(r8) (:,:) ] maximum rate of carboxylation (umol co2/m**2/s) + cp => photosyns_inst%cp_patch , & ! Output: [real(r8) (:) ] CO2 compensation point (Pa) + kc => photosyns_inst%kc_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for CO2 (Pa) + ko => photosyns_inst%ko_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for O2 (Pa) + qe => photosyns_inst%qe_patch , & ! Output: [real(r8) (:) ] quantum efficiency, used only for C4 (mol CO2 / mol photons) + tpu_z => photosyns_inst%tpu_z_patch , & ! Output: [real(r8) (:,:) ] triose phosphate utilization rate (umol CO2/m**2/s) + kp_z => photosyns_inst%kp_z_patch , & ! Output: [real(r8) (:,:) ] initial slope of CO2 response curve (C4 plants) + bbb => photosyns_inst%bbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + mbb => photosyns_inst%mbb_patch & ! Output: [real(r8) (:) ] Ball-Berry slope of conductance-photosynthesis relationship + ) + + if (c3flag(p)) then + ! C3: Rubisco-limited photosynthesis + ac(p,iv) = vcmax_z(p,iv) * max(ci-cp(p), 0._r8) / (ci+kc(p)*(1._r8+oair/ko(p))) + + ! C3: RuBP-limited photosynthesis + aj(p,iv) = je * max(ci-cp(p), 0._r8) / (4._r8*ci+8._r8*cp(p)) + + ! C3: Product-limited photosynthesis + ap(p,iv) = 3._r8 * tpu_z(p,iv) + + else + + ! C4: Rubisco-limited photosynthesis + ac(p,iv) = vcmax_z(p,iv) + + ! C4: RuBP-limited photosynthesis + aj(p,iv) = qe(p) * par_z * 4.6_r8 + + ! C4: PEP carboxylase-limited (CO2-limited) + ap(p,iv) = kp_z(p,iv) * max(ci, 0._r8) / forc_pbot(c) + + end if + + ! Gross photosynthesis. First co-limit ac and aj. Then co-limit ap + + aquad = params_inst%theta_cj(ivt(p)) + bquad = -(ac(p,iv) + aj(p,iv)) + cquad = ac(p,iv) * aj(p,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + ai = min(r1,r2) + + aquad = params_inst%theta_ip + bquad = -(ai + ap(p,iv)) + cquad = ai * ap(p,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + ag(p,iv) = max(0._r8,min(r1,r2)) + + ! Net photosynthesis. Exit iteration if an < 0 + + an(p,iv) = ag(p,iv) - lmr_z + if (an(p,iv) < 0._r8) then + fval = 0._r8 + return + endif + ! Quadratic gs_mol calculation with an known. Valid for an >= 0. + ! With an <= 0, then gs_mol = bbb + + cs = cair - 1.4_r8/gb_mol * an(p,iv) * forc_pbot(c) + cs = max(cs,1.e-06_r8) + aquad = cs + bquad = cs*(gb_mol - bbb(p)) - mbb(p)*an(p,iv)*forc_pbot(c) + cquad = -gb_mol*(cs*bbb(p) + mbb(p)*an(p,iv)*forc_pbot(c)*rh_can) + call quadratic (aquad, bquad, cquad, r1, r2) + gs_mol = max(r1,r2) + + ! Derive new estimate for ci + + fval =ci - cair + an(p,iv) * forc_pbot(c) * (1.4_r8*gs_mol+1.6_r8*gb_mol) / (gb_mol*gs_mol) + + end associate + + end subroutine ci_func + + !------------------------------------------------------------------------------ + subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & + esat_tv, eair, oair, cair, rb, bsun, bsha, btran, dayl_factor, leafn, & + qsatl, qaf, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & + surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & + photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) + ! + ! !DESCRIPTION: + ! Leaf photosynthesis and stomatal conductance calculation as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy + ! Here, sunlit and shaded photosynthesis and stomatal conductance are solved + ! simultaneously per Pierre Gentine/Daniel Kennedy plant hydraulic stress + ! method + ! + ! !USES: + use clm_varcon , only : rgas, tfrz, rpi, spval + use GridcellType , only : grc + use clm_time_manager , only : get_step_size_real, is_near_local_noon + use clm_varctl , only : cnallocate_carbon_only + use clm_varctl , only : lnc_opt, reduce_dayl_factor, vcmax_opt + use clm_varpar , only : nlevsoi + use pftconMod , only : nbrdlf_dcd_tmp_shrub, npcropmin + use ColumnType , only : col + use shr_infnan_mod , only : shr_infnan_isnan + + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! patch filter + real(r8) , intent(in) :: esat_tv( bounds%begp: ) ! saturation vapor pressure at t_veg (Pa) [pft] + real(r8) , intent(in) :: eair( bounds%begp: ) ! vapor pressure of canopy air (Pa) [pft] + real(r8) , intent(in) :: oair( bounds%begp: ) ! Atmospheric O2 partial pressure (Pa) [pft] + real(r8) , intent(in) :: cair( bounds%begp: ) ! Atmospheric CO2 partial pressure (Pa) [pft] + real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) [pft] + real(r8) , intent(in) :: dayl_factor( bounds%begp: ) ! scalar (0-1) for daylength + real(r8) , intent(in) :: qsatl ( bounds%begp: ) ! leaf specific humidity [kg/kg] + real(r8) , intent(in) :: qaf ( bounds%begp: ) ! humidity of canopy air [kg/kg] + real(r8) , intent(in) :: leafn( bounds%begp: ) ! leaf N (gN/m2) + real(r8) , intent(out) :: bsun( bounds%begp: ) ! sunlit canopy transpiration wetness factor (0 to 1) + real(r8) , intent(out) :: bsha( bounds%begp: ) ! shaded canopy transpiration wetness factor (0 to 1) + real(r8) , intent(out) :: btran( bounds%begp: ) ! transpiration wetness factor (0 to 1) [pft] + real(r8) , intent(in) :: froot_carbon( bounds%begp: ) ! fine root carbon (gC/m2) [pft] + real(r8) , intent(in) :: croot_carbon( bounds%begp: ) ! live coarse root carbon (gC/m2) [pft] + + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(temperature_type) , intent(in) :: temperature_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(solarabs_type) , intent(in) :: solarabs_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + class(ozone_base_type) , intent(in) :: ozone_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + ! + ! !LOCAL VARIABLES: + ! + ! Leaf photosynthesis parameters + real(r8) :: jmax_z(bounds%begp:bounds%endp,2,nlevcan) ! maximum electron transport rate (umol electrons/m**2/s) + real(r8) :: bbbopt(bounds%begp:bounds%endp) ! Ball-Berry minimum leaf conductance, unstressed (umol H2O/m**2/s) + real(r8) :: kn(bounds%begp:bounds%endp) ! leaf nitrogen decay coefficient + real(r8) :: vcmax25top ! canopy top: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: jmax25top ! canopy top: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: tpu25top ! canopy top: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25top ! canopy top: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: kp25top ! canopy top: initial slope of CO2 response curve (C4 plants) at 25C + + real(r8) :: vcmax25_sun ! sunlit leaf layer: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: vcmax25_sha ! shaded leaf layer: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: jmax25_sun ! sunlit leaf layer: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: jmax25_sha ! shaded leaf layer: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: tpu25_sun ! sunlit leaf layer: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: tpu25_sha ! shaded leaf layer: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25_sun ! sunlit leaf layer: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25_sha ! shaded leaf layer: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: kp25_sun ! sunlit leaf layer: Initial slope of CO2 response curve (C4 plants) at 25C + real(r8) :: kp25_sha ! shaded leaf layer: Initial slope of CO2 response curve (C4 plants) at 25C + real(r8) :: kc25 ! Michaelis-Menten constant for CO2 at 25C (Pa) + real(r8) :: ko25 ! Michaelis-Menten constant for O2 at 25C (Pa) + real(r8) :: cp25 ! CO2 compensation point at 25C (Pa) + + real(r8) :: vcmaxse ! entropy term for vcmax (J/mol/K) + real(r8) :: jmaxse ! entropy term for jmax (J/mol/K) + real(r8) :: tpuse ! entropy term for tpu (J/mol/K) + + real(r8) :: vcmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: jmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: tpuc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: lmrc ! scaling factor for high temperature inhibition (25 C = 1.0) + + ! Other + integer :: f,p,c,iv ! indices + real(r8) :: cf ! s m**2/umol -> s/m + real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] + real(r8) :: gb ! leaf boundary layer conductance (m/s) + real(r8) :: cs_sun ! CO2 partial pressure at sunlit leaf surface (Pa) + real(r8) :: cs_sha ! CO2 partial pressure at shaded leaf surface (Pa) + real(r8) :: gs ! leaf stomatal conductance (m/s) + real(r8) :: hs ! fractional humidity at leaf surface (dimensionless) + real(r8) :: sco ! relative specificity of rubisco + real(r8) :: ft ! photosynthesis temperature response (statement function) + real(r8) :: fth ! photosynthesis temperature inhibition (statement function) + real(r8) :: fth25 ! ccaling factor for photosynthesis temperature inhibition (statement function) + real(r8) :: tl ! leaf temperature in photosynthesis temperature function (K) + real(r8) :: ha ! activation energy in photosynthesis temperature function (J/mol) + real(r8) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) + real(r8) :: se ! entropy term in photosynthesis temperature function (J/mol/K) + real(r8) :: scaleFactor ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: ciold ! previous value of Ci for convergence check + real(r8) :: gs_mol_err ! gs_mol for error check + real(r8) :: je_sun ! sunlit leaf electron transport rate (umol electrons/m**2/s) + real(r8) :: je_sha ! shaded leaf electron transport rate (umol electrons/m**2/s) + real(r8) :: qabs ! PAR absorbed by PS II (umol photons/m**2/s) + real(r8) :: aquad,bquad,cquad ! terms for quadratic equations + real(r8) :: r1,r2 ! roots of quadratic equation + real(r8) :: ceair ! vapor pressure of air, constrained (Pa) + integer :: iter1 ! number of iterations used, for record only + integer :: iter2 ! number of iterations used, for record only + real(r8) :: nscaler ! leaf nitrogen scaling coefficient + real(r8) :: nscaler_sun ! sunlit leaf nitrogen scaling coefficient + real(r8) :: nscaler_sha ! shaded leaf nitrogen scaling coefficient + + real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) + + real(r8) :: psn_wc_z_sun(bounds%begp:bounds%endp,nlevcan) ! Rubisco-limited contribution to sunlit psn_z (umol CO2/m**2/s) + real(r8) :: psn_wj_z_sun(bounds%begp:bounds%endp,nlevcan) ! RuBP-limited contribution to sunlit psn_z (umol CO2/m**2/s) + real(r8) :: psn_wp_z_sun(bounds%begp:bounds%endp,nlevcan) ! product-limited contribution to sunlit psn_z (umol CO2/m**2/s) + real(r8) :: psn_wc_z_sha(bounds%begp:bounds%endp,nlevcan) ! Rubisco-limited contribution to shaded psn_z (umol CO2/m**2/s) + real(r8) :: psn_wj_z_sha(bounds%begp:bounds%endp,nlevcan) ! RuBP-limited contribution to shaded psn_z (umol CO2/m**2/s) + real(r8) :: psn_wp_z_sha(bounds%begp:bounds%endp,nlevcan) ! product-limited contribution to shaded psn_z (umol CO2/m**2/s) + real(r8) :: rh_leaf_sun(bounds%begp:bounds%endp) ! fractional humidity at sunlit leaf surface (dimensionless) + real(r8) :: rh_leaf_sha(bounds%begp:bounds%endp) ! fractional humidity at shaded leaf surface (dimensionless) + + real(r8) :: psncan_sun ! canopy sum of sunlit psn_z + real(r8) :: psncan_wc_sun ! canopy sum of sunlit psn_wc_z + real(r8) :: psncan_wj_sun ! canopy sum of sunlit psn_wj_z + real(r8) :: psncan_wp_sun ! canopy sum of sunlit psn_wp_z + real(r8) :: lmrcan_sun ! canopy sum of sunlit lmr_z + real(r8) :: gscan_sun ! canopy sum of sunlit leaf conductance + real(r8) :: laican_sun ! canopy sum of sunlit lai_z + real(r8) :: psncan_sha ! canopy sum of shaded psn_z + real(r8) :: psncan_wc_sha ! canopy sum of shaded psn_wc_z + real(r8) :: psncan_wj_sha ! canopy sum of shaded psn_wj_z + real(r8) :: psncan_wp_sha ! canopy sum of shaded psn_wp_z + real(r8) :: lmrcan_sha ! canopy sum of shaded lmr_z + real(r8) :: gscan_sha ! canopy sum of shaded leaf conductance + real(r8) :: laican_sha ! canopy sum of shaded lai_z + real(r8) :: laican ! canopy sum of lai_z + real(r8) :: rh_can ! canopy air relative humidity + + real(r8) , pointer :: lai_z_sun (:,:) ! leaf area index for canopy layer, sunlit + real(r8) , pointer :: par_z_sun (:,:) ! par absorbed per unit lai for canopy layer, sunlit (w/m**2) + real(r8) , pointer :: vcmaxcint_sun (:) ! leaf to canopy scaling coefficient, sunlit + real(r8) , pointer :: alphapsn_sun (:) ! 13C fractionation factor for PSN, sunlit () + real(r8) , pointer :: psn_sun (:) ! foliage photosynthesis, sunlit (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: psn_wc_sun (:) ! Rubisco-limited foliage photosynthesis, sunlit (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: psn_wj_sun (:) ! RuBP-limited foliage photosynthesis, sunlit (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: psn_wp_sun (:) ! product-limited foliage photosynthesis, sunlit (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: psn_z_sun (:,:) ! canopy layer: foliage photosynthesis, sunlit (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: lmr_sun (:) ! leaf maintenance respiration rate, sunlit (umol CO2/m**2/s) + real(r8) , pointer :: lmr_z_sun (:,:) ! canopy layer: leaf maintenance respiration rate, sunlit (umol CO2/m**2/s) + real(r8) , pointer :: rs_sun (:) ! leaf stomatal resistance, sunlit (s/m) + real(r8) , pointer :: rs_z_sun (:,:) ! canopy layer: leaf stomatal resistance, sunlit (s/m) + real(r8) , pointer :: ci_z_sun (:,:) ! intracellular leaf CO2, sunlit (Pa) + real(r8) , pointer :: o3coefv_sun (:) ! o3 coefficient used in photo calculation, sunlit + real(r8) , pointer :: o3coefg_sun (:) ! o3 coefficient used in rs calculation, sunlit + real(r8) , pointer :: lai_z_sha (:,:) ! leaf area index for canopy layer, shaded + real(r8) , pointer :: par_z_sha (:,:) ! par absorbed per unit lai for canopy layer, shaded (w/m**2) + real(r8) , pointer :: vcmaxcint_sha (:) ! leaf to canopy scaling coefficient, shaded + real(r8) , pointer :: alphapsn_sha (:) ! 13C fractionation factor for PSN, shaded () + real(r8) , pointer :: psn_sha (:) ! foliage photosynthesis, shaded (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: psn_wc_sha (:) ! Rubisco-limited foliage photosynthesis, shaded (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: psn_wj_sha (:) ! RuBP-limited foliage photosynthesis, shaded (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: psn_wp_sha (:) ! product-limited foliage photosynthesis, shaded (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: psn_z_sha (:,:) ! canopy layer: foliage photosynthesis, shaded (umol co2 /m**2/ s) [always +] + real(r8) , pointer :: lmr_sha (:) ! leaf maintenance respiration rate, shaded (umol CO2/m**2/s) + real(r8) , pointer :: lmr_z_sha (:,:) ! canopy layer: leaf maintenance respiration rate, shaded (umol CO2/m**2/s) + real(r8) , pointer :: rs_sha (:) ! leaf stomatal resistance, shaded (s/m) + real(r8) , pointer :: rs_z_sha (:,:) ! canopy layer: leaf stomatal resistance, shaded (s/m) + real(r8) , pointer :: ci_z_sha (:,:) ! intracellular leaf CO2, shaded (Pa) + real(r8) , pointer :: o3coefv_sha (:) ! o3 coefficient used in photo calculation, shaded + real(r8) , pointer :: o3coefg_sha (:) ! o3 coefficient used in rs calculation, shaded + real(r8) :: sum_nscaler + real(r8) :: total_lai + integer :: nptreemax + real(r8) :: dtime ! land model time step (sec) + integer :: j,g ! index + real(r8) :: rs_resis ! combined soil-root resistance [s] + real(r8) :: r_soil ! root spacing [m] + real(r8) :: root_biomass_density ! root biomass density [g/m3] + real(r8) :: root_cross_sec_area ! root cross sectional area [m2] + real(r8) :: root_length_density ! root length density [m/m3] + real(r8) :: froot_average_length ! average coarse root length [m] + real(r8) :: croot_average_length ! average coarse root length [m] + real(r8) :: soil_conductance ! soil to root hydraulic conductance [1/s] + real(r8) :: root_conductance ! root hydraulic conductance [1/s] + real(r8) :: rai(nlevsoi) ! root area index [m2/m2] + real(r8) :: fs(nlevsoi) ! root conductance scale factor (reduction in conductance due to decreasing (more negative) root water potential) + real(r8) :: gsminsun ! Minimum stomatal conductance sunlit + real(r8) :: gsminsha ! Minimum stomatal conductance shaded + real(r8) :: gs_slope_sun ! Slope stomatal conductance sunlit + real(r8) :: gs_slope_sha ! Slope stomatal conductance shaded + real(r8), parameter :: croot_lateral_length = 0.25_r8 ! specified lateral coarse root length [m] + real(r8), parameter :: c_to_b = 2.0_r8 !(g biomass /g C) +!Note that root density is for dry biomass not carbon. CLM provides root biomass as carbon. The conversion is 0.5 g C / g biomass + + !------------------------------------------------------------------------------ + + ! Temperature and soil water response functions + + ft(tl,ha) = exp( ha / (rgas*1.e-3_r8*(tfrz+25._r8)) * (1._r8 - (tfrz+25._r8)/tl) ) + fth(tl,hd,se,scaleFactor) = scaleFactor / ( 1._r8 + exp( (-hd+se*tl) / (rgas*1.e-3_r8*tl) ) ) + fth25(hd,se) = 1._r8 + exp( (-hd+se*(tfrz+25._r8)) / (rgas*1.e-3_r8*(tfrz+25._r8)) ) + + ! Enforce expected array sizes + + SHR_ASSERT_ALL_FL((ubound(esat_tv) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(eair) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(oair) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(cair) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(rb) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(bsun) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(bsha) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(btran) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(dayl_factor) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(qsatl) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(qaf) == (/bounds%endp/)), sourcefile, __LINE__) + + associate( & + k_soil_root => soilstate_inst%k_soil_root_patch , & ! Input: [real(r8) (:,:) ] soil-root interface conductance (mm/s) + hk_l => soilstate_inst%hk_l_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity (mm/s) + hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + smp => soilstate_inst%smp_l_col , & ! Input: [real(r8) (:,:) ] soil matrix potential [mm] + + froot_leaf => pftcon%froot_leaf , & ! fine root to leaf ratio + root_conductance_patch => soilstate_inst%root_conductance_patch , & ! Output: [real(r8) (:,:)] root conductance + soil_conductance_patch => soilstate_inst%soil_conductance_patch , & ! Output: [real(r8) (:,:)] soil conductance + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:)] + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) + root_radius => pftcon%root_radius , & ! Input: 0.29e-03_r8 !(m) + root_density => pftcon%root_density , & ! Input: 0.31e06_r8 !(g biomass / m3 root) + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] patch canopy one-sided stem area index, no burying by snow + c3psn => pftcon%c3psn , & ! Input: photosynthetic pathway: 0. = c4, 1. = c3 + crop => pftcon%crop , & ! Input: crop or not (0 =not crop and 1 = crop) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + flnr => pftcon%flnr , & ! Input: fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) + fnitr => pftcon%fnitr , & ! Input: foliage nitrogen limitation factor (-) + slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis [m^2/gC] + dsladlai => pftcon%dsladlai , & ! Input: change in sla per unit lai + i_vcad => pftcon%i_vcad , & ! Input: [real(r8) (:) ] + s_vcad => pftcon%s_vcad , & ! Input: [real(r8) (:) ] + i_flnr => pftcon%i_flnr , & ! Input: [real(r8) (:) ] + s_flnr => pftcon%s_flnr , & ! Input: [real(r8) (:) ] + mbbopt => pftcon%mbbopt , & + medlynintercept=> pftcon%medlynintercept , & ! Input: [real(r8) (:) ] Intercept for Medlyn stomatal conductance model method + medlynslope=> pftcon%medlynslope , & ! Input: [real(r8) (:) ] Slope for Medlyn stomatal conductance model method + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) + tgcm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] air temperature at agcm reference height (kelvin) + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] pft number of canopy layers, above snow for radiative transfer + tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] pft total leaf area index for canopy layer + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8)(:) ] one-sided leaf area index, no burying by snow + c3flag => photosyns_inst%c3flag_patch , & ! Output: [logical (:) ] true if C3 and false if C4 + ac => photosyns_inst%ac_phs_patch , & ! Output: [real(r8) (:,:,:) ] Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + aj => photosyns_inst%aj_phs_patch , & ! Output: [real(r8) (:,:,:) ] RuBP-limited gross photosynthesis (umol CO2/m**2/s) + ap => photosyns_inst%ap_phs_patch , & ! Output: [real(r8) (:,:,:) ] product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + ag => photosyns_inst%ag_phs_patch , & ! Output: [real(r8) (:,:,:) ] co-limited gross leaf photosynthesis (umol CO2/m**2/s) + vcmax_z => photosyns_inst%vcmax_z_phs_patch , & ! Output: [real(r8) (:,:,:) ] maximum rate of carboxylation (umol co2/m**2/s) + luvcmax25top => photosyns_inst%luvcmax25top_patch , & ! Output: [real(r8) (:) ] maximum rate of carboxylation (umol co2/m**2/s) + lujmax25top => photosyns_inst%lujmax25top_patch , & ! Output: [real(r8) (:) ] maximum rate of carboxylation (umol co2/m**2/s) + lutpu25top => photosyns_inst%lutpu25top_patch , & ! Output: [real(r8) (:) ] maximum rate of carboxylation (umol co2/m**2/s) +!!! + tpu_z => photosyns_inst%tpu_z_phs_patch , & ! Output: [real(r8) (:,:,:) ] triose phosphate utilization rate (umol CO2/m**2/s) + kp_z => photosyns_inst%kp_z_phs_patch , & ! Output: [real(r8) (:,:,:) ] initial slope of CO2 response curve (C4 plants) + gb_mol => photosyns_inst%gb_mol_patch , & ! Output: [real(r8) (:) ] leaf boundary layer conductance (umol H2O/m**2/s) + cp => photosyns_inst%cp_patch , & ! Output: [real(r8) (:) ] CO2 compensation point (Pa) + kc => photosyns_inst%kc_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for CO2 (Pa) + ko => photosyns_inst%ko_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for O2 (Pa) + qe => photosyns_inst%qe_patch , & ! Output: [real(r8) (:) ] quantum efficiency, used only for C4 (mol CO2 / mol photons) + bbb => photosyns_inst%bbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + mbb => photosyns_inst%mbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry slope of conductance-photosynthesis relationship + rh_leaf => photosyns_inst%rh_leaf_patch , & ! Output: [real(r8) (:) ] fractional humidity at leaf surface (dimensionless) + vpd_can => photosyns_inst%vpd_can_patch , & ! Output: [real(r8) (:) ] canopy vapor pressure deficit (kPa) + lnc => photosyns_inst%lnca_patch , & ! Output: [real(r8) (:) ] top leaf layer leaf N concentration (gN leaf/m^2) + light_inhibit=> photosyns_inst%light_inhibit , & ! Input: [logical ] flag if light should inhibit respiration + leafresp_method=> photosyns_inst%leafresp_method , & ! Input: [integer ] method type to use for leaf-maint.-respiration at 25C canopy top + stomatalcond_mtd=> photosyns_inst%stomatalcond_mtd , & ! Input: [integer ] method type to use for stomatal conductance + modifyphoto_and_lmr_forcrop=> photosyns_inst%modifyphoto_and_lmr_forcrop, & ! Input: [logical ] modifyphoto_and_lmr_forcrop + leaf_mr_vcm => canopystate_inst%leaf_mr_vcm , & ! Input: [real(r8) ] scalar constant of leaf respiration with Vcmax + vegwp => canopystate_inst%vegwp_patch , & ! Input/Output: [real(r8) (:,:) ] vegetation water matric potential (mm) + an_sun => photosyns_inst%an_sun_patch , & ! Output: [real(r8) (:,:) ] net sunlit leaf photosynthesis (umol CO2/m**2/s) + an_sha => photosyns_inst%an_sha_patch , & ! Output: [real(r8) (:,:) ] net shaded leaf photosynthesis (umol CO2/m**2/s) + gs_mol_sun => photosyns_inst%gs_mol_sun_patch , & ! Output: [real(r8) (:,:) ] sunlit leaf stomatal conductance (umol H2O/m**2/s) + gs_mol_sha => photosyns_inst%gs_mol_sha_patch , & ! Output: [real(r8) (:,:) ] shaded leaf stomatal conductance (umol H2O/m**2/s) + gs_mol_sun_ln => photosyns_inst%gs_mol_sun_ln_patch , & ! Output: [real(r8) (:,:) ] sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) + gs_mol_sha_ln => photosyns_inst%gs_mol_sha_ln_patch & ! Output: [real(r8) (:,:) ] shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) + ) + + par_z_sun => solarabs_inst%parsun_z_patch ! Input: [real(r8) (:,:) ] par absorbed per unit lai for canopy layer (w/m**2) + lai_z_sun => canopystate_inst%laisun_z_patch ! Input: [real(r8) (:,:) ] leaf area index for canopy layer, sunlit or shaded + vcmaxcint_sun => surfalb_inst%vcmaxcintsun_patch ! Input: [real(r8) (:) ] leaf to canopy scaling coefficient + alphapsn_sun => photosyns_inst%alphapsnsun_patch ! Input: [real(r8) (:) ] 13C fractionation factor for PSN () + o3coefv_sun => ozone_inst%o3coefvsun_patch ! Input: [real(r8) (:) ] O3 coefficient used in photosynthesis calculation + o3coefg_sun => ozone_inst%o3coefgsun_patch ! Input: [real(r8) (:) ] O3 coefficient used in rs calculation + ci_z_sun => photosyns_inst%cisun_z_patch ! Output: [real(r8) (:,:) ] intracellular leaf CO2 (Pa) + rs_sun => photosyns_inst%rssun_patch ! Output: [real(r8) (:) ] leaf stomatal resistance (s/m) + rs_z_sun => photosyns_inst%rssun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf stomatal resistance (s/m) + lmr_sun => photosyns_inst%lmrsun_patch ! Output: [real(r8) (:) ] leaf maintenance respiration rate (umol CO2/m**2/s) + lmr_z_sun => photosyns_inst%lmrsun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + psn_sun => photosyns_inst%psnsun_patch ! Output: [real(r8) (:) ] foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_z_sun => photosyns_inst%psnsun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wc_sun => photosyns_inst%psnsun_wc_patch ! Output: [real(r8) (:) ] Rubisco-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wj_sun => photosyns_inst%psnsun_wj_patch ! Output: [real(r8) (:) ] RuBP-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wp_sun => photosyns_inst%psnsun_wp_patch ! Output: [real(r8) (:) ] product-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + par_z_sha => solarabs_inst%parsha_z_patch ! Input: [real(r8) (:,:) ] par absorbed per unit lai for canopy layer (w/m**2) + lai_z_sha => canopystate_inst%laisha_z_patch ! Input: [real(r8) (:,:) ] leaf area index for canopy layer, sunlit or shaded + vcmaxcint_sha => surfalb_inst%vcmaxcintsha_patch ! Input: [real(r8) (:) ] leaf to canopy scaling coefficient + alphapsn_sha => photosyns_inst%alphapsnsha_patch ! Input: [real(r8) (:) ] 13C fractionation factor for PSN () + o3coefv_sha => ozone_inst%o3coefvsha_patch ! Input: [real(r8) (:) ] O3 coefficient used in photosynthesis calculation + o3coefg_sha => ozone_inst%o3coefgsha_patch ! Input: [real(r8) (:) ] O3 coefficient used in rs calculation + ci_z_sha => photosyns_inst%cisha_z_patch ! Output: [real(r8) (:,:) ] intracellular leaf CO2 (Pa) + rs_sha => photosyns_inst%rssha_patch ! Output: [real(r8) (:) ] leaf stomatal resistance (s/m) + rs_z_sha => photosyns_inst%rssha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf stomatal resistance (s/m) + lmr_sha => photosyns_inst%lmrsha_patch ! Output: [real(r8) (:) ] leaf maintenance respiration rate (umol CO2/m**2/s) + lmr_z_sha => photosyns_inst%lmrsha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + psn_sha => photosyns_inst%psnsha_patch ! Output: [real(r8) (:) ] foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_z_sha => photosyns_inst%psnsha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wc_sha => photosyns_inst%psnsha_wc_patch ! Output: [real(r8) (:) ] Rubisco-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wj_sha => photosyns_inst%psnsha_wj_patch ! Output: [real(r8) (:) ] RuBP-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wp_sha => photosyns_inst%psnsha_wp_patch ! Output: [real(r8) (:) ] product-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + !==============================================================================! + ! Photosynthesis and stomatal conductance parameters, from: + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + !==============================================================================! + + ! Determine seconds off current time step + + dtime = get_step_size_real() + + ! Activation energy, from: + ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + ! Bernacchi et al (2003) Plant, Cell and Environment 26:1419-1430 + ! except TPU from: Harley et al (1992) Plant, Cell and Environment 15:271-282 + + ! High temperature deactivation, from: + ! Leuning (2002) Plant, Cell and Environment 25:1205-1210 + ! The factor "c" scales the deactivation to a value of 1.0 at 25C + + lmrc = fth25 (params_inst%lmrhd, params_inst%lmrse) + +! calculate root-soil interface conductance + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + do j = 1,nlevsoi + +! calculate conversion from conductivity to conductance + root_biomass_density = c_to_b * froot_carbon(p) * rootfr(p,j) / dz(c,j) +! ensure minimum root biomass (using 1gC/m2) + root_biomass_density = max(c_to_b*1._r8,root_biomass_density) + + ! Root length density: m root per m3 soil + root_cross_sec_area = rpi*root_radius(ivt(p))**2 + root_length_density = root_biomass_density / (root_density(ivt(p)) * root_cross_sec_area) + + ! Root-area index (RAI) + rai(j) = (tsai(p)+tlai(p)) * froot_leaf(ivt(p)) * rootfr(p,j) + +! fix coarse root_average_length to specified length + croot_average_length = croot_lateral_length + +! calculate r_soil using Gardner/spa equation (Bonan, GMD, 2014) + r_soil = sqrt(1./(rpi*root_length_density)) + + ! length scale approach + soil_conductance = min(hksat(c,j),hk_l(c,j))/(1.e3*r_soil) + +! use vegetation plc function to adjust root conductance + fs(j)= plc(smp(c,j),p,c,root,veg) + +! krmax is root conductance per area per length + root_conductance = (fs(j)*rai(j)*params_inst%krmax(ivt(p)))/(croot_average_length + z(c,j)) + + soil_conductance = max(soil_conductance, 1.e-16_r8) + root_conductance = max(root_conductance, 1.e-16_r8) + + root_conductance_patch(p,j) = root_conductance + soil_conductance_patch(p,j) = soil_conductance + +! sum resistances in soil and root + rs_resis = 1._r8/soil_conductance + 1._r8/root_conductance + +! conductance is inverse resistance +! explicitly set conductance to zero for top soil layer + if(rai(j)*rootfr(p,j) > 0._r8 .and. j > 1) then + k_soil_root(p,j) = 1._r8/rs_resis + else + k_soil_root(p,j) = 0. + endif + + end do + enddo + + ! Miscellaneous parameters, from Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + ! C3 or C4 photosynthesis logical variable + + if (nint(c3psn(patch%itype(p))) == 1) then + c3flag(p) = .true. + else if (nint(c3psn(patch%itype(p))) == 0) then + c3flag(p) = .false. + end if + + ! C3 and C4 dependent parameters + + if (c3flag(p)) then + qe(p) = 0._r8 + bbbopt(p) = 10000._r8 + else + qe(p) = 0.05_r8 + bbbopt(p) = 40000._r8 + end if + + if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then + ! Soil water stress applied to Ball-Berry parameters later in ci_func_PHS + bbb(p) = bbbopt(p) + mbb(p) = mbbopt(patch%itype(p)) + end if + ! kc, ko, cp, from: Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + ! + ! kc25_coef = 404.9e-6 mol/mol + ! ko25_coef = 278.4e-3 mol/mol + ! cp25_yr2000 = 42.75e-6 mol/mol + ! + ! Derive sco from cp and O2 using present-day O2 (0.209 mol/mol) and re-calculate + ! cp to account for variation in O2 using cp = 0.5 O2 / sco + ! + + kc25 = params_inst%kc25_coef * forc_pbot(c) + ko25 = params_inst%ko25_coef * forc_pbot(c) + sco = 0.5_r8 * 0.209_r8 / params_inst%cp25_yr2000 + cp25 = 0.5_r8 * oair(p) / sco + + kc(p) = kc25 * ft(t_veg(p), params_inst%kcha) + ko(p) = ko25 * ft(t_veg(p), params_inst%koha) + cp(p) = cp25 * ft(t_veg(p), params_inst%cpha) + + end do + + ! Multi-layer parameters scaled by leaf nitrogen profile. + ! Loop through each canopy layer to calculate nitrogen profile using + ! cumulative lai at the midpoint of the layer + + do f = 1, fn + p = filterp(f) + + if (lnc_opt .eqv. .false.) then + ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) + lnc(p) = 1._r8 / (slatop(patch%itype(p)) * leafcn(patch%itype(p))) + end if + + ! Using the actual nitrogen allocated to the leaf after + ! uptake rather than fixing leaf nitrogen based on SLA and CN + ! ratio + if (lnc_opt .eqv. .true.) then + ! nlevcan and nrad(p) look like the same variable ?? check this later + sum_nscaler = 0.0_r8 + laican = 0.0_r8 + total_lai = 0.0_r8 + + do iv = 1, nrad(p) + + if (iv == 1) then + laican = 0.5_r8 * tlai_z(p,iv) + total_lai = tlai_z(p,iv) + else + laican = laican + 0.5_r8 * (tlai_z(p,iv-1)+tlai_z(p,iv)) + total_lai = total_lai + tlai_z(p,iv) + end if + + ! Scale for leaf nitrogen profile. If multi-layer code, use explicit + ! profile. If sun/shade big leaf code, use canopy integrated factor. + if (nlevcan == 1) then + nscaler = 1.0_r8 + else if (nlevcan > 1) then + nscaler = exp(-kn(p) * laican) + end if + + sum_nscaler = sum_nscaler + nscaler + + end do + + if (tlai(p) > 0.0_r8 .AND. sum_nscaler > 0.0_r8) then + ! dividing by LAI to convert total leaf nitrogen + ! from m2 ground to m2 leaf; dividing by sum_nscaler to + ! convert total leaf N to leaf N at canopy top + lnc(p) = leafn(p) / (tlai(p) * sum_nscaler) + else + lnc(p) = 0.0_r8 + end if + + end if + lnc(p) = min(lnc(p),10._r8) + + ! reduce_dayl_factor .eqv. .false. + if (reduce_dayl_factor .eqv. .true.) then + if (dayl_factor(p) > 0.25_r8) then + ! dayl_factor(p) = 1.0_r8 + end if + end if + + + ! Default + if (vcmax_opt == 0) then + ! vcmax25 at canopy top, as in CN but using lnc at top of the canopy + vcmax25top = lnc(p) * flnr(patch%itype(p)) * params_inst%fnr * params_inst%act25 * dayl_factor(p) + if (.not. use_cn) then + vcmax25top = vcmax25top * fnitr(patch%itype(p)) + else + if ( CNAllocate_Carbon_only() ) vcmax25top = vcmax25top * fnitr(patch%itype(p)) + end if + else if (vcmax_opt == 3) then + vcmax25top = ( i_vcad(patch%itype(p)) + s_vcad(patch%itype(p)) * lnc(p) ) * dayl_factor(p) + else if (vcmax_opt == 4) then + nptreemax = 9 ! is this number correct? check later + if (patch%itype(p) >= nptreemax) then ! if not tree + ! for shrubs and herbs + vcmax25top = lnc(p) * ( i_flnr(patch%itype(p)) + s_flnr(patch%itype(p)) * lnc(p) ) * params_inst%fnr * params_inst%act25 * & + dayl_factor(p) + else + ! if tree + vcmax25top = lnc(p) * ( i_flnr(patch%itype(p)) * exp(s_flnr(patch%itype(p)) * lnc(p)) ) * params_inst%fnr * params_inst%act25 * & + dayl_factor(p) + ! for trees + end if + end if + + ! Parameters derived from vcmax25top. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + ! used jmax25 = 1.97 vcmax25, from Wullschleger (1993) Journal of Experimental Botany 44:907-920. + + jmax25top = ((2.59_r8 - 0.035_r8*min(max((t10(p)-tfrz),11._r8),35._r8)) * vcmax25top) * & + params_inst%jmax25top_sf + tpu25top = params_inst%tpu25ratio * vcmax25top + kp25top = params_inst%kp25ratio * vcmax25top + luvcmax25top(p) = vcmax25top + lujmax25top(p) = jmax25top + lutpu25top(p)=tpu25top + + ! Nitrogen scaling factor. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 used + ! kn = 0.11. Here, derive kn from vcmax25 as in Lloyd et al (2010) Biogeosciences, 7, 1833-1859 + ! Remove daylength factor from vcmax25 so that kn is based on maximum vcmax25 + ! But not used as defined here if using sun/shade big leaf code. Instead, + ! will use canopy integrated scaling factors from SurfaceAlbedo. + + if (dayl_factor(p) .eq. 0._r8) then + kn(p) = 0._r8 + else + kn(p) = exp(0.00963_r8 * vcmax25top/dayl_factor(p) - 2.43_r8) + end if + + if (use_cn) then + if ( leafresp_method == leafresp_mtd_ryan1991 ) then + ! Leaf maintenance respiration to match the base rate used in CN + ! but with the new temperature functions for C3 and C4 plants. + ! + ! Base rate for maintenance respiration is from: + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + ! + ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 + ! + ! CN respiration has units: g C / g N [leaf] / s. This needs to be + ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s + ! + ! Then scale this value at the top of the canopy for canopy depth + + lmr25top = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) + lmr25top = lmr25top * lnc(p) / 12.e-06_r8 + + else if ( leafresp_method == leafresp_mtd_atkin2015 ) then + !using new form for respiration base rate from Atkin + !communication. + if ( lnc(p) > 0.0_r8 ) then + lmr25top = params_inst%lmr_intercept_atkin(ivt(p)) + (lnc(p) * 0.2061_r8) - (0.0402_r8 * (t10(p)-tfrz)) + else + lmr25top = 0.0_r8 + end if + end if + + else + ! Leaf maintenance respiration in proportion to vcmax25top + + if (c3flag(p)) then + lmr25top = vcmax25top * leaf_mr_vcm + else + lmr25top = vcmax25top * 0.025_r8 + end if + end if + + ! Loop through canopy layers (above snow). Respiration needs to be + ! calculated every timestep. Others are calculated only if daytime + + laican = 0._r8 + do iv = 1, nrad(p) + + ! Cumulative lai at middle of layer + + if (iv == 1) then + laican = 0.5_r8 * tlai_z(p,iv) + else + laican = laican + 0.5_r8 * (tlai_z(p,iv-1)+tlai_z(p,iv)) + end if + + ! Scale for leaf nitrogen profile. If multi-layer code, use explicit + ! profile. If sun/shade big leaf code, use canopy integrated factor. + + if (nlevcan == 1) then + nscaler_sun = vcmaxcint_sun(p) + nscaler_sha = vcmaxcint_sha(p) + else if (nlevcan > 1) then + nscaler_sun = exp(-kn(p) * laican) + nscaler_sha = exp(-kn(p) * laican) + end if + + ! Maintenance respiration + + lmr25_sun = lmr25top * nscaler_sun + lmr25_sha = lmr25top * nscaler_sha + + if(use_luna.and.c3flag(p).and.crop(patch%itype(p))== 0)then + if(.not.use_cn)then ! If CN is on, use leaf N to predict respiration (above). Otherwise, use Vcmax term from LUNA. RF + lmr25_sun = leaf_mr_vcm * photosyns_inst%vcmx25_z_patch(p,iv) + lmr25_sha = leaf_mr_vcm * photosyns_inst%vcmx25_z_patch(p,iv) + endif + endif + + if (c3flag(p)) then + lmr_z_sun(p,iv) = lmr25_sun * ft(t_veg(p), params_inst%lmrha) * fth(t_veg(p), params_inst%lmrhd, & + params_inst%lmrse, lmrc) + lmr_z_sha(p,iv) = lmr25_sha * ft(t_veg(p), params_inst%lmrha) * fth(t_veg(p), params_inst%lmrhd, & + params_inst%lmrse, lmrc) + else + lmr_z_sun(p,iv) = lmr25_sun * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + lmr_z_sun(p,iv) = lmr_z_sun(p,iv) / (1._r8 + exp( 1.3_r8*(t_veg(p)-(tfrz+55._r8)) )) + lmr_z_sha(p,iv) = lmr25_sha * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + lmr_z_sha(p,iv) = lmr_z_sha(p,iv) / (1._r8 + exp( 1.3_r8*(t_veg(p)-(tfrz+55._r8)) )) + end if + + ! Reduce lmr w/ low lai + lmr_z_sun(p,iv) = lmr_z_sun(p,iv)*min((0.2_r8*exp(3.218_r8*tlai_z(p,iv))),1._r8) + lmr_z_sha(p,iv) = lmr_z_sha(p,iv)*min((0.2_r8*exp(3.218_r8*tlai_z(p,iv))),1._r8) + + if (par_z_sun(p,iv) <= 0._r8) then ! night time + + vcmax_z(p,sun,iv) = 0._r8 + jmax_z(p,sun,iv) = 0._r8 + tpu_z(p,sun,iv) = 0._r8 + kp_z(p,sun,iv) = 0._r8 + + vcmax_z(p,sha,iv) = 0._r8 + jmax_z(p,sha,iv) = 0._r8 + tpu_z(p,sha,iv) = 0._r8 + kp_z(p,sha,iv) = 0._r8 + + if ( use_c13 ) then + alphapsn_sun(p) = 1._r8 + alphapsn_sha(p) = 1._r8 + end if + + else ! day time + + if(use_luna.and.c3flag(p).and.crop(patch%itype(p))== 0)then + vcmax25_sun = photosyns_inst%vcmx25_z_patch(p,iv) + vcmax25_sha = photosyns_inst%vcmx25_z_patch(p,iv) + jmax25_sun = photosyns_inst%jmx25_z_patch(p,iv) + jmax25_sha = photosyns_inst%jmx25_z_patch(p,iv) + tpu25_sun = params_inst%tpu25ratio * vcmax25_sun + tpu25_sha = params_inst%tpu25ratio * vcmax25_sha + if(surfalb_inst%vcmaxcintsun_patch(p).gt.0._r8.and.nlevcan==1) then + vcmax25_sha = vcmax25_sun * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) + jmax25_sha = jmax25_sun * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) + tpu25_sha = tpu25_sun * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) + end if + else + vcmax25_sun = vcmax25top * nscaler_sun + jmax25_sun = jmax25top * nscaler_sun + tpu25_sun = tpu25top * nscaler_sun + vcmax25_sha = vcmax25top * nscaler_sha + jmax25_sha = jmax25top * nscaler_sha + tpu25_sha = tpu25top * nscaler_sha + endif + kp25_sun = kp25top * nscaler_sun + kp25_sha = kp25top * nscaler_sha + + ! Adjust for temperature + ! Acclimation is done for Kattge + vcmaxse = (668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%vcmaxse_sf + jmaxse = (659.70_r8 - 0.75_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%jmaxse_sf + ! These values are used for Leuning + !vcmaxse = 486.0_r8 + !jmaxse = 495.0_r8 + tpuse = (668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%tpuse_sf + vcmaxc = fth25 (params_inst%vcmaxhd, vcmaxse) + jmaxc = fth25 (params_inst%jmaxhd, jmaxse) + tpuc = fth25 (params_inst%tpuhd, tpuse) + vcmax_z(p,sun,iv) = vcmax25_sun * ft(t_veg(p), params_inst%vcmaxha) * fth(t_veg(p), & + params_inst%vcmaxhd, vcmaxse, vcmaxc) + jmax_z(p,sun,iv) = jmax25_sun * ft(t_veg(p), params_inst%jmaxha) * fth(t_veg(p), & + params_inst%jmaxhd, jmaxse, jmaxc) + tpu_z(p,sun,iv) = tpu25_sun * ft(t_veg(p), params_inst%tpuha) * fth(t_veg(p), & + params_inst%tpuhd, tpuse, tpuc) + vcmax_z(p,sha,iv) = vcmax25_sha * ft(t_veg(p), params_inst%vcmaxha) * fth(t_veg(p), & + params_inst%vcmaxhd, vcmaxse, vcmaxc) + jmax_z(p,sha,iv) = jmax25_sha * ft(t_veg(p), params_inst%jmaxha) * fth(t_veg(p), & + params_inst%jmaxhd, jmaxse, jmaxc) + tpu_z(p,sha,iv) = tpu25_sha * ft(t_veg(p), params_inst%tpuha) * fth(t_veg(p), & + params_inst%tpuhd, tpuse, tpuc) + + if (.not. c3flag(p)) then + vcmax_z(p,sun,iv) = vcmax25_sun * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + vcmax_z(p,sun,iv) = vcmax_z(p,sun,iv) / (1._r8 + exp( 0.2_r8*((tfrz+15._r8)-t_veg(p)) )) + vcmax_z(p,sun,iv) = vcmax_z(p,sun,iv) / (1._r8 + exp( 0.3_r8*(t_veg(p)-(tfrz+40._r8)) )) + vcmax_z(p,sha,iv) = vcmax25_sha * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + vcmax_z(p,sha,iv) = vcmax_z(p,sha,iv) / (1._r8 + exp( 0.2_r8*((tfrz+15._r8)-t_veg(p)) )) + vcmax_z(p,sha,iv) = vcmax_z(p,sha,iv) / (1._r8 + exp( 0.3_r8*(t_veg(p)-(tfrz+40._r8)) )) + end if + + kp_z(p,sun,iv) = kp25_sun * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + kp_z(p,sha,iv) = kp25_sha * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + + end if + + ! Change to add in light inhibition of respiration. 0.67 from Lloyd et al. 2010, & Metcalfe et al. 2012 + ! Also pers. comm from Peter Reich (Nov 2015). Might potentially be updated pending findings of Atkin et al. (in prep) + ! review of light inhibition database. + if ( light_inhibit .and. par_z_sun(p,1) > 0._r8) then ! are the lights on? + lmr_z_sun(p,iv) = lmr_z_sun(p,iv) * 0.67_r8 ! inhibit respiration accordingly. + end if + if ( light_inhibit .and. par_z_sha(p,1) > 0._r8) then ! are the lights on? + lmr_z_sha(p,iv) = lmr_z_sha(p,iv) * 0.67_r8 ! inhibit respiration accordingly. + end if + + end do ! canopy layer loop + end do ! patch loop + + !==============================================================================! + ! Leaf-level photosynthesis and stomatal conductance + !==============================================================================! + + rsmax0 = 2.e4_r8 + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + g = patch%gridcell(p) + + ! Leaf boundary layer conductance, umol/m**2/s + + cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e06_r8 + gb = 1._r8/rb(p) + gb_mol(p) = gb * cf + + ! Loop through canopy layers (above snow). Only do calculations if daytime + + do iv = 1, nrad(p) + + if (par_z_sun(p,iv) <= 0._r8) then ! night time + + !zqz temporary signal for night time + vegwp(p,sun)=1._r8 + + if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then + gsminsun = bbb(p) + gsminsha = bbb(p) + else if ( stomatalcond_mtd == stomatalcond_mtd_medlyn2011 )then + gsminsun = medlynintercept(patch%itype(p)) + gsminsha = medlynintercept(patch%itype(p)) + else + gsminsun = nan + gsminsha = nan + end if + call calcstress(p,c,vegwp(p,:),bsun(p),bsha(p),gb_mol(p),gsminsun, gsminsha, & + qsatl(p),qaf(p), atm2lnd_inst,canopystate_inst,waterdiagnosticbulk_inst, & + soilstate_inst,temperature_inst, waterfluxbulk_inst) + + ac(p,sun,iv) = 0._r8 + aj(p,sun,iv) = 0._r8 + ap(p,sun,iv) = 0._r8 + ag(p,sun,iv) = 0._r8 + if(crop(patch%itype(p))== 0 .or. .not. modifyphoto_and_lmr_forcrop) then + an_sun(p,iv) = ag(p,sun,iv) - bsun(p) * lmr_z_sun(p,iv) + else + an_sun(p,iv) = ag(p,sun,iv) - lmr_z_sun(p,iv) + endif + psn_z_sun(p,iv) = 0._r8 + psn_wc_z_sun(p,iv) = 0._r8 + psn_wj_z_sun(p,iv) = 0._r8 + psn_wp_z_sun(p,iv) = 0._r8 + rs_z_sun(p,iv) = min(rsmax0, 1._r8/(max( bsun(p)*gsminsun, 1._r8 )) * cf) + ci_z_sun(p,iv) = 0._r8 + rh_leaf_sun(p) = 0._r8 + + ac(p,sha,iv) = 0._r8 + aj(p,sha,iv) = 0._r8 + ap(p,sha,iv) = 0._r8 + ag(p,sha,iv) = 0._r8 + if(crop(patch%itype(p))== 0 .or. .not. modifyphoto_and_lmr_forcrop) then + an_sha(p,iv) = ag(p,sha,iv) - bsha(p) * lmr_z_sha(p,iv) + else + an_sha(p,iv) = ag(p,sha,iv) - lmr_z_sha(p,iv) + endif + psn_z_sha(p,iv) = 0._r8 + psn_wc_z_sha(p,iv) = 0._r8 + psn_wj_z_sha(p,iv) = 0._r8 + psn_wp_z_sha(p,iv) = 0._r8 + rs_z_sha(p,iv) = min(rsmax0, 1._r8/(max( bsha(p)*gsminsha, 1._r8 )) * cf) + ci_z_sha(p,iv) = 0._r8 + rh_leaf_sha(p) = 0._r8 + + else ! day time + + !now the constraint is no longer needed, Jinyun Tang + ceair = min( eair(p), esat_tv(p) ) + if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then + rh_can = ceair / esat_tv(p) + else if ( stomatalcond_mtd == stomatalcond_mtd_medlyn2011 )then + ! Put some constraints on RH in the canopy when Medlyn stomatal conductance is being used + rh_can = max((esat_tv(p) - ceair), 50._r8) * 0.001_r8 + vpd_can(p) = rh_can + end if + + ! Electron transport rate for C3 plants. Convert par from W/m2 to + ! umol photons/m**2/s using the factor 4.6 + + ! sun + qabs = 0.5_r8 * (1._r8 - params_inst%fnps) * par_z_sun(p,iv) * 4.6_r8 + aquad = params_inst%theta_psii + bquad = -(qabs + jmax_z(p,sun,iv)) + cquad = qabs * jmax_z(p,sun,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + je_sun = min(r1,r2) + + ! sha + qabs = 0.5_r8 * (1._r8 - params_inst%fnps) * par_z_sha(p,iv) * 4.6_r8 + aquad = params_inst%theta_psii + bquad = -(qabs + jmax_z(p,sha,iv)) + cquad = qabs * jmax_z(p,sha,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + je_sha = min(r1,r2) + + ! Iterative loop for ci beginning with initial guess + + if (c3flag(p)) then + ci_z_sun(p,iv) = 0.7_r8 * cair(p) + ci_z_sha(p,iv) = 0.7_r8 * cair(p) + else + ci_z_sun(p,iv) = 0.4_r8 * cair(p) + ci_z_sha(p,iv) = 0.4_r8 * cair(p) + end if + + !find ci and stomatal conductance + call hybrid_PHS(ci_z_sun(p,iv), ci_z_sha(p,iv), p, iv, c, g, gb_mol(p), bsun(p),bsha(p), je_sun, & + je_sha, cair(p), oair(p), lmr_z_sun(p,iv), lmr_z_sha(p,iv), & + par_z_sun(p,iv), par_z_sha(p,iv), rh_can, gs_mol_sun(p,iv), gs_mol_sha(p,iv), & + qsatl(p), qaf(p), iter1, iter2, atm2lnd_inst, photosyns_inst, & + canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, temperature_inst, waterfluxbulk_inst) + if ( stomatalcond_mtd == stomatalcond_mtd_medlyn2011 )then + gsminsun = medlynintercept(patch%itype(p)) + gsminsha = medlynintercept(patch%itype(p)) + gs_slope_sun = medlynslope(patch%itype(p)) + gs_slope_sha = medlynslope(patch%itype(p)) + else if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then + gsminsun = bbb(p) + gsminsha = bbb(p) + gs_slope_sun = mbb(p) + gs_slope_sha = mbb(p) + end if + + ! End of ci iteration. Check for an < 0, in which case gs_mol = bbb + + if (an_sun(p,iv) < 0._r8) gs_mol_sun(p,iv) = max( bsun(p)*gsminsun, 1._r8 ) + if (an_sha(p,iv) < 0._r8) gs_mol_sha(p,iv) = max( bsha(p)*gsminsha, 1._r8 ) + ! Use time period 1 hour before and 1 hour after local noon inclusive (11AM-1PM) + if ( is_near_local_noon( grc%londeg(g), deltasec=3600 ) )then + gs_mol_sun_ln(p,iv) = gs_mol_sun(p,iv) + gs_mol_sha_ln(p,iv) = gs_mol_sha(p,iv) + else + gs_mol_sun_ln(p,iv) = spval + gs_mol_sha_ln(p,iv) = spval + end if + + ! Final estimates for cs and ci (needed for early exit of ci iteration when an < 0) + + cs_sun = cair(p) - 1.4_r8/gb_mol(p) * an_sun(p,iv) * forc_pbot(c) + cs_sun = max(cs_sun,1.e-06_r8) + ci_z_sun(p,iv) = cair(p) - an_sun(p,iv) * forc_pbot(c) * & + (1.4_r8*gs_mol_sun(p,iv)+1.6_r8*gb_mol(p)) / & + (gb_mol(p)*gs_mol_sun(p,iv)) + + ! Trap for values of ci_z_sun less than 1.e-06. This is needed for + ! Megan (which can crash with negative values) + ci_z_sun(p,iv) = max( ci_z_sun(p,iv), 1.e-06_r8 ) + + cs_sha = cair(p) - 1.4_r8/gb_mol(p) * an_sha(p,iv) * forc_pbot(c) + cs_sha = max(cs_sha,1.e-06_r8) + ci_z_sha(p,iv) = cair(p) - an_sha(p,iv) * forc_pbot(c) * & + (1.4_r8*gs_mol_sha(p,iv)+1.6_r8*gb_mol(p)) / & + (gb_mol(p)*gs_mol_sha(p,iv)) + + ! Trap for values of ci_z_sha less than 1.e-06. This is needed for + ! Megan (which can crash with negative values) + ci_z_sha(p,iv) = max( ci_z_sha(p,iv), 1.e-06_r8 ) + + ! Convert gs_mol (umol H2O/m**2/s) to gs (m/s) and then to rs (s/m) + + gs = gs_mol_sun(p,iv) / cf + rs_z_sun(p,iv) = min(1._r8/gs, rsmax0) + rs_z_sun(p,iv) = rs_z_sun(p,iv) / o3coefg_sun(p) + gs = gs_mol_sha(p,iv) / cf + rs_z_sha(p,iv) = min(1._r8/gs, rsmax0) + rs_z_sha(p,iv) = rs_z_sha(p,iv) / o3coefg_sha(p) + + ! Photosynthesis. Save rate-limiting photosynthesis + + psn_z_sun(p,iv) = ag(p,sun,iv) + psn_z_sun(p,iv) = psn_z_sun(p,iv) * o3coefv_sun(p) + + psn_wc_z_sun(p,iv) = 0._r8 + psn_wj_z_sun(p,iv) = 0._r8 + psn_wp_z_sun(p,iv) = 0._r8 + + if (ac(p,sun,iv) <= aj(p,sun,iv) .and. ac(p,sun,iv) <= ap(p,sun,iv)) then + psn_wc_z_sun(p,iv) = psn_z_sun(p,iv) + else if (aj(p,sun,iv) < ac(p,sun,iv) .and. aj(p,sun,iv) <= ap(p,sun,iv)) then + psn_wj_z_sun(p,iv) = psn_z_sun(p,iv) + else if (ap(p,sun,iv) < ac(p,sun,iv) .and. ap(p,sun,iv) < aj(p,sun,iv)) then + psn_wp_z_sun(p,iv) = psn_z_sun(p,iv) + end if + + psn_z_sha(p,iv) = ag(p,sha,iv) + psn_z_sha(p,iv) = psn_z_sha(p,iv) * o3coefv_sha(p) + + psn_wc_z_sha(p,iv) = 0._r8 + psn_wj_z_sha(p,iv) = 0._r8 + psn_wp_z_sha(p,iv) = 0._r8 + + if (ac(p,sha,iv) <= aj(p,sha,iv) .and. ac(p,sha,iv) <= ap(p,sha,iv)) then + psn_wc_z_sha(p,iv) = psn_z_sha(p,iv) + else if (aj(p,sha,iv) < ac(p,sha,iv) .and. aj(p,sha,iv) <= ap(p,sha,iv)) then + psn_wj_z_sha(p,iv) = psn_z_sha(p,iv) + else if (ap(p,sha,iv) < ac(p,sha,iv) .and. ap(p,sha,iv) < aj(p,sha,iv)) then + psn_wp_z_sha(p,iv) = psn_z_sha(p,iv) + end if + + ! Make sure iterative solution is correct + + if (gs_mol_sun(p,iv) < 0._r8 .or. gs_mol_sha(p,iv) < 0._r8) then + write (iulog,*)'Negative stomatal conductance:' + write (iulog,*)'p,iv,gs_mol_sun,gs_mol_sha= ',p,iv,gs_mol_sun(p,iv),gs_mol_sha(p,iv) + call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) + end if + + ! Compare with Ball-Berry model: gs_mol = m * an * hs/cs p + b + + hs = (gb_mol(p)*ceair + gs_mol_sun(p,iv)*esat_tv(p)) / ((gb_mol(p)+gs_mol_sun(p,iv))*esat_tv(p)) + rh_leaf_sun(p) = hs + gs_mol_err = gs_slope_sun*max(an_sun(p,iv), 0._r8)*hs/cs_sun*forc_pbot(c) + max( bsun(p)*gsminsun, 1._r8 ) + + if (abs(gs_mol_sun(p,iv)-gs_mol_err) > 1.e-01_r8 .and. (stomatalcond_mtd == stomatalcond_mtd_bb1987) ) then + write (iulog,*) 'Ball-Berry error check - sunlit stomatal conductance error:' + write (iulog,*) gs_mol_sun(p,iv), gs_mol_err + end if + + hs = (gb_mol(p)*ceair + gs_mol_sha(p,iv)*esat_tv(p)) / ((gb_mol(p)+gs_mol_sha(p,iv))*esat_tv(p)) + rh_leaf_sha(p) = hs + gs_mol_err = gs_slope_sha*max(an_sha(p,iv), 0._r8)*hs/cs_sha*forc_pbot(c) + max( bsha(p)*gsminsha, 1._r8) + + if (abs(gs_mol_sha(p,iv)-gs_mol_err) > 1.e-01_r8 .and. (stomatalcond_mtd == stomatalcond_mtd_bb1987) ) then + write (iulog,*) 'Ball-Berry error check - shaded stomatal conductance error:' + write (iulog,*) gs_mol_sha(p,iv), gs_mol_err + end if + + end if ! night or day if branch + end do ! canopy layer loop + end do ! patch loop + + !==============================================================================! + ! Canopy photosynthesis and stomatal conductance + !==============================================================================! + + ! Sum canopy layer fluxes and then derive effective leaf-level fluxes (per + ! unit leaf area), which are used in other parts of the model. Here, laican + ! sums to either laisun or laisha. + + do f = 1, fn + p = filterp(f) + + psncan_sun = 0._r8 + psncan_wc_sun = 0._r8 + psncan_wj_sun = 0._r8 + psncan_wp_sun = 0._r8 + lmrcan_sun = 0._r8 + gscan_sun = 0._r8 + laican_sun = 0._r8 + do iv = 1, nrad(p) + psncan_sun = psncan_sun + psn_z_sun(p,iv) * lai_z_sun(p,iv) + psncan_wc_sun = psncan_wc_sun + psn_wc_z_sun(p,iv) * lai_z_sun(p,iv) + psncan_wj_sun = psncan_wj_sun + psn_wj_z_sun(p,iv) * lai_z_sun(p,iv) + psncan_wp_sun = psncan_wp_sun + psn_wp_z_sun(p,iv) * lai_z_sun(p,iv) + if(crop(patch%itype(p))== 0 .and. modifyphoto_and_lmr_forcrop) then + lmrcan_sun = lmrcan_sun + lmr_z_sun(p,iv) * lai_z_sun(p,iv) * bsun(p) + else + lmrcan_sun = lmrcan_sun + lmr_z_sun(p,iv) * lai_z_sun(p,iv) + endif + gscan_sun = gscan_sun + lai_z_sun(p,iv) / (rb(p)+rs_z_sun(p,iv)) + laican_sun = laican_sun + lai_z_sun(p,iv) + end do + if (laican_sun > 0._r8) then + psn_sun(p) = psncan_sun / laican_sun + psn_wc_sun(p) = psncan_wc_sun / laican_sun + psn_wj_sun(p) = psncan_wj_sun / laican_sun + psn_wp_sun(p) = psncan_wp_sun / laican_sun + lmr_sun(p) = lmrcan_sun / laican_sun + rs_sun(p) = laican_sun / gscan_sun - rb(p) + else + psn_sun(p) = 0._r8 + psn_wc_sun(p) = 0._r8 + psn_wj_sun(p) = 0._r8 + psn_wp_sun(p) = 0._r8 + lmr_sun(p) = 0._r8 + rs_sun(p) = 0._r8 + end if + psncan_sha = 0._r8 + psncan_wc_sha = 0._r8 + psncan_wj_sha = 0._r8 + psncan_wp_sha = 0._r8 + lmrcan_sha = 0._r8 + gscan_sha = 0._r8 + laican_sha = 0._r8 + do iv = 1, nrad(p) + psncan_sha = psncan_sha + psn_z_sha(p,iv) * lai_z_sha(p,iv) + psncan_wc_sha = psncan_wc_sha + psn_wc_z_sha(p,iv) * lai_z_sha(p,iv) + psncan_wj_sha = psncan_wj_sha + psn_wj_z_sha(p,iv) * lai_z_sha(p,iv) + psncan_wp_sha = psncan_wp_sha + psn_wp_z_sha(p,iv) * lai_z_sha(p,iv) + if(crop(patch%itype(p))== 0 .and. modifyphoto_and_lmr_forcrop) then + lmrcan_sha = lmrcan_sha + lmr_z_sha(p,iv) * lai_z_sha(p,iv) * bsha(p) + else + lmrcan_sha = lmrcan_sha + lmr_z_sha(p,iv) * lai_z_sha(p,iv) + endif + gscan_sha = gscan_sha + lai_z_sha(p,iv) / (rb(p)+rs_z_sha(p,iv)) + laican_sha = laican_sha + lai_z_sha(p,iv) + end do + if (laican_sha > 0._r8) then + psn_sha(p) = psncan_sha / laican_sha + psn_wc_sha(p) = psncan_wc_sha / laican_sha + psn_wj_sha(p) = psncan_wj_sha / laican_sha + psn_wp_sha(p) = psncan_wp_sha / laican_sha + lmr_sha(p) = lmrcan_sha / laican_sha + rs_sha(p) = laican_sha / gscan_sha - rb(p) + else + psn_sha(p) = 0._r8 + psn_wc_sha(p) = 0._r8 + psn_wj_sha(p) = 0._r8 + psn_wp_sha(p) = 0._r8 + lmr_sha(p) = 0._r8 + rs_sha(p) = 0._r8 + end if + + if ( laican_sha+laican_sun > 0._r8 ) then + btran(p) = bsun(p) * (laican_sun / (laican_sun + laican_sha)) + & + bsha(p) * (laican_sha / (laican_sun + laican_sha)) + else + ! In this case, bsun and bsha should have the same value and btran + ! can be set to either bsun or bsha. + btran(p) = bsun(p) + end if + + end do + + end associate + + end subroutine PhotosynthesisHydraulicStress + !------------------------------------------------------------------------------ + + !-------------------------------------------------------------------------------- + subroutine hybrid_PHS(x0sun, x0sha, p, iv, c, g, gb_mol, bsun, bsha, jesun, jesha, & + cair, oair, lmr_z_sun, lmr_z_sha, par_z_sun, par_z_sha, rh_can, & + gs_mol_sun, gs_mol_sha, qsatl, qaf, iter1, iter2, atm2lnd_inst, photosyns_inst, & + canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, temperature_inst, waterfluxbulk_inst) + ! + !! DESCRIPTION: + !use a hybrid solver to find the root of the ci_func equation for sunlit and shaded leaves + ! f(x) = x- h(x) + !we want to find x, s.t. f(x) = 0. + !outside loop iterates for bsun/bsha, which are functions of stomatal conductance + !the hybrid approach combines the strength of the newton secant approach (find the solution domain) + !and the bisection approach implemented with the Brent's method to guarantee convergence. + ! + !! REVISION HISTORY: + ! + ! + !!USES: + use clm_time_manager , only : is_near_local_noon + ! + !! ARGUMENTS: + implicit none + real(r8), intent(inout) :: x0sun,x0sha ! initial guess and final value of the solution for cisun/cisha + integer , intent(in) :: p ! pft index + integer , intent(in) :: iv ! radiation canopy layer index + integer , intent(in) :: c ! column index + integer , intent(in) :: g ! gridcell index + real(r8), intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), intent(out) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) + real(r8), intent(out) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) + real(r8), intent(in) :: jesun ! sunlit leaf electron transport rate (umol electrons/m**2/s) + real(r8), intent(in) :: jesha ! shaded leaf electron transport rate (umol electrons/m**2/s) + real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + real(r8), intent(in) :: lmr_z_sun ! sunlit canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), intent(in) :: lmr_z_sha ! shaded canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), intent(in) :: par_z_sun ! par absorbed per unit lai for sunlit canopy layer (w/m**2) + real(r8), intent(in) :: par_z_sha ! par absorbed per unit lai for shaded canopy layer (w/m**2) + real(r8), intent(in) :: rh_can ! canopy air relative humidity + real(r8), intent(out) :: gs_mol_sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(out) :: gs_mol_sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(in) :: qsatl ! leaf specific humidity [kg/kg] + real(r8), intent(in) :: qaf ! humidity of canopy air [kg/kg] + integer, intent(out) :: iter1 ! number of iterations used to find appropriate bsun/bsha + integer, intent(out) :: iter2 ! number of iterations used to find cisun/cisha + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + ! + !! LOCAL VARIABLES + real(r8) :: x(nvegwcs) ! working copy of vegwp(p,:) + real(r8) :: gs0sun ! unstressed sunlit stomatal conductance + real(r8) :: gs0sha ! unstressed shaded stomatal conductance + logical :: havegs ! signals direction of calculation gs->qflx or qflx->gs + real(r8) :: soilflux ! total soil column transpiration [mm/s] + real(r8) :: x1sun ! second guess for cisun + real(r8) :: f0sun ! error of cifunc(x0sun) + real(r8) :: f1sun ! error of cifunc(x1sun) + real(r8) :: xsun ! open variable for brent to return cisun solution + real(r8) :: dxsun ! delta cisun from iter_i to iter_i+1 + real(r8) :: x1sha ! second guess for cisha + real(r8) :: f0sha ! error of cifunc(x0sha) + real(r8) :: f1sha ! error of cifunc(x1sha) + real(r8) :: xsha ! open variable for brent to return cisha solution + real(r8) :: dxsha ! delta cisha from iter_i to iter_i+1 + real(r8) :: b0sun ! bsun from previous iter + real(r8) :: b0sha ! bsha from previous iter + real(r8) :: dbsun ! delta(bsun) from iter_i to iter_i+1 + real(r8) :: dbsha ! delta(bsun) from iter_i to iter_i+1 + logical :: bflag ! signals to call calcstress to recalc bsun/bsha (or not) + real(r8) :: tolsun ! error tolerance for cisun solution [Pa] + real(r8) :: tolsha ! error tolerance for cisun solution [Pa] + real(r8) :: minf ! storage spot for best cisun/cisha solution + real(r8) :: minxsun ! cisun associated with minf + real(r8) :: minxsha ! cisha associated with minf + real(r8), parameter :: toldb = 1.e-2_r8 ! tolerance for satisfactory bsun/bsha solution + real(r8), parameter :: eps = 1.e-2_r8 ! relative accuracy + real(r8), parameter :: eps1= 1.e-4_r8 ! absolute accuracy threshold for fsun/fsha + integer , parameter :: itmax = 3 ! maximum number of iterations zqz (increase later) + !------------------------------------------------------------------------------ + + associate( & + qflx_tran_veg => waterfluxbulk_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + vegwp => canopystate_inst%vegwp_patch ,& ! Input/Output: [real(r8) (:,:) ] vegetation water matric potential (mm) + vegwp_ln => canopystate_inst%vegwp_ln_patch & ! Output: [real(r8) (:,:) ] vegetation water matric potential (mm) at local noon + ) + + + x1sun = x0sun + x1sha = x0sha + bflag = .false. + b0sun = -1._r8 + b0sha = -1._r8 + gs0sun = 0._r8 ! Initialize to zero as good form, not used on first itteration below because of bflag + gs0sha = 0._r8 ! Initialize to zero as good form, not used on first itteration below because of bflag + bsun = 1._r8 + bsha = 1._r8 + iter1 = 0 + + do !outer loop updates bsun/bsha and makes two ci_func calls for interpolation + x=vegwp(p,:) + iter1=iter1+1 + iter2=0 + x0sun=max(0.1_r8,x1sun) !need to make sure x0 .neq. x1 + x1sun=0.99_r8*x1sun + x0sha=max(0.1_r8,x1sha) + x1sha=0.99_r8*x1sha + tolsun = abs(x1sun) * eps + tolsha = abs(x1sha) * eps + + ! this ci_func_PHS call updates bsun/bsha (except on first iter) + call ci_func_PHS(x,x0sun, x0sha, f0sun, f0sha, p, iv, c, bsun, bsha, bflag, gb_mol, gs0sun, gs0sha,& + gs_mol_sun, gs_mol_sha, jesun, jesha, cair, oair, lmr_z_sun, lmr_z_sha, par_z_sun, par_z_sha, rh_can, & + qsatl, qaf, atm2lnd_inst, photosyns_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + + ! update bsun/bsha convergence vars + dbsun=b0sun-bsun + dbsha=b0sha-bsha + b0sun=bsun + b0sha=bsha + bflag=.false. + + ! this ci_func_PHS call creates second point for ci interpolation + call ci_func_PHS(x,x1sun, x1sha, f1sun, f1sha, p, iv, c, bsun, bsha, bflag, gb_mol, gs0sun, gs0sha,& + gs_mol_sun, gs_mol_sha, jesun, jesha, cair, oair, lmr_z_sun, lmr_z_sha, par_z_sun, par_z_sha, rh_can, & + qsatl, qaf, atm2lnd_inst, photosyns_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + + do !inner loop finds ci + if ( (abs(f0sun) < eps1) .and. (abs(f0sha) < eps1) ) then + x1sun=x0sun + x1sha=x0sha + exit + endif + if ( (abs(f1sun) < eps1) .and. (abs(f1sha) < eps1) ) then + exit + endif + iter2=iter2+1 + + if ( (f1sun - f0sun) == 0._r8) then + !makes next x1sun the midpt between current x1 & x0 + dxsun = 0.5_r8*(x1sun+x0sun)-x1sun + else + dxsun=-f1sun*(x1sun-x0sun)/(f1sun-f0sun) + end if + if ( (f1sha - f0sha) == 0._r8) then + dxsha = 0.5_r8*(x1sha+x0sha)-x1sha + else + dxsha=-f1sha*(x1sha-x0sha)/(f1sha-f0sha) + end if + x0sun=x1sun + x1sun=x1sun+dxsun + x0sha=x1sha + x1sha=x1sha+dxsha + + call ci_func_PHS(x,x1sun, x1sha, f1sun, f1sha, p, iv, c, bsun, bsha, bflag, gb_mol, gs0sun, gs0sha,& + gs_mol_sun, gs_mol_sha, jesun, jesha, cair, oair, lmr_z_sun, lmr_z_sha, par_z_sun, par_z_sha, rh_can, & + qsatl, qaf, atm2lnd_inst, photosyns_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + + if ( (abs(dxsun) < tolsun ) .and. (abs(dxsha) itmax) then + x1sun=minxsun + x1sha=minxsha + call ci_func_PHS(x,x1sun, x1sha, f1sun, f1sha, p, iv, c, bsun, bsha, bflag, gb_mol, gs0sun, gs0sha,& + gs_mol_sun, gs_mol_sha, jesun, jesha, cair, oair, lmr_z_sun, lmr_z_sha, par_z_sun, par_z_sha, rh_can, & + qsatl, qaf, atm2lnd_inst, photosyns_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + exit + endif + + enddo + + !update unstressed stomatal conductance + if (bsun>0.01_r8) then + gs0sun=gs_mol_sun/bsun + endif + if (bsha>0.01_r8) then + gs0sha=gs_mol_sha/bsha + endif + + bflag=.true. + + if ( (abs(dbsun) < toldb) .and. (abs(dbsha) < toldb) ) then + exit + endif + + if (iter1 > itmax) then + exit + endif + + enddo + x0sun=x1sun + x0sha=x1sha + + !set vegwp for the final gs_mol solution + call getvegwp(p, c, x, gb_mol, gs_mol_sun, gs_mol_sha, qsatl, qaf, soilflux, & + atm2lnd_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, temperature_inst) + vegwp(p,:)=x + + !write out local noon vwp (within +/- 1hr) + if ( is_near_local_noon( grc%londeg(g), deltasec=3600 ) )then + vegwp_ln(p,:) = vegwp(p,:) + else + vegwp_ln(p,:) = spval + end if + + if (soilflux<0._r8) soilflux = 0._r8 + qflx_tran_veg(p) = soilflux + + end associate + + end subroutine hybrid_PHS + !-------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------ + subroutine brent_PHS(xsun, x1sun, x2sun, f1sun, f2sun, xsha, x1sha, x2sha, f1sha, f2sha, & + tol, ip, iv, ic, gb_mol, jesun, jesha, cair, oair, lmr_z_sun, lmr_z_sha, par_z_sun, par_z_sha,& + rh_can, gs_mol_sun, gs_mol_sha, bsun, bsha, qsatl, qaf, atm2lnd_inst, photosyns_inst, & + canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, temperature_inst, waterfluxbulk_inst) + !------------------------------------------------------------------------------ + implicit none + ! + !!DESCRIPTION: + !Use Brent's method to find the root of a single variable function ci_func, which is known to exist between x1 and x2. + !The found root will be updated until its accuracy is tol. Performed for cisun and cisha. + ! + !!REVISION HISTORY: + ! + !!ARGUMENTS: + real(r8), intent(out) :: xsun ! independent variable of the single value function ci_func(x) + real(r8), intent(in) :: x1sun, x2sun ! minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 + real(r8), intent(in) :: f1sun, f2sun ! minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 + real(r8), intent(out) :: xsha ! independent variable of the single value function ci_func(x) + real(r8), intent(in) :: x1sha, x2sha ! minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 + real(r8), intent(in) :: f1sha, f2sha ! minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 + real(r8), intent(in) :: tol ! the error tolerance + integer , intent(in) :: ip, iv, ic ! pft, c3/c4, and column index + real(r8), intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), intent(in) :: jesun,jesha ! electron transport rate (umol electrons/m**2/s) + real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + real(r8), intent(in) :: lmr_z_sun, lmr_z_sha ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), intent(in) :: par_z_sun, par_z_sha ! par absorbed per unit lai for canopy layer (w/m**2) + real(r8), intent(in) :: rh_can ! inside canopy relative humidity + real(r8), intent(out) :: gs_mol_sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(out) :: gs_mol_sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) + real(r8), intent(inout) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) + real(r8), intent(in) :: qsatl ! leaf specific humidity [kg/kg] + real(r8), intent(in) :: qaf ! humidity of canopy air [kg/kg] + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + !------------------------------------------------------------------------------ + ! !LOCAL VARIABLES: + real(r8) :: gs0sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) + real(r8) :: gs0sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) + integer :: phase ! sun==1, sha==2 + integer , parameter :: nphs = 2 ! number of phases for sun/shade + integer , parameter :: itmax = 20 ! maximum number of iterations + real(r8), parameter :: eps = 1.e-4_r8 ! relative error tolerance + integer :: iter ! + real(r8) :: a(nphs),b(nphs),c(nphs),d(nphs),e(nphs),fa(nphs),fb(nphs),fc(nphs) + real(r8) :: p(nphs),q(nphs),r(nphs),s(nphs),tol1(nphs),xm(nphs) + real(r8) :: x(nvegwcs) !dummy variable passed to cifunc + logical , parameter :: bflag = .false. !indicates the cifunc should not call calcstress + !------------------------------------------------------------------------------ + + a(:)=(/x1sun,x1sha/) + b(:)=(/x2sun,x2sha/) + fa(:)=(/f1sun,f1sha/) + fb(:)=(/f2sun,f2sha/) + + do phase=1, nphs + if ( (fa(phase) > 0._r8 .and. fb(phase) > 0._r8) .or. (fa(phase) < 0._r8 .and. fb(phase) < 0._r8) ) then + write(iulog,*) 'root must be bracketed for brent' + call endrun(msg=errmsg(sourcefile, __LINE__)) + endif + enddo + + c=b + fc=fb + iter = 0 + do + if( iter == itmax ) exit + iter=iter+1 + + do phase=1, nphs + if( (fb(phase) > 0._r8 .and. fc(phase) > 0._r8) .or. (fb(phase) < 0._r8 .and. fc(phase) < 0._r8)) then + c(phase)=a(phase) !Rename a, b, c and adjust bounding interval d. + fc(phase)=fa(phase) + d(phase)=b(phase)-a(phase) + e(phase)=d(phase) + endif + if( abs(fc(phase)) < abs(fb(phase)) ) then + a(phase)=b(phase) + b(phase)=c(phase) + c(phase)=a(phase) + fa(phase)=fb(phase) + fb(phase)=fc(phase) + fc(phase)=fa(phase) + endif + enddo + tol1=2._r8*eps*abs(b)+0.5_r8*tol !Convergence check. + xm=0.5_r8*(c-b) + + if( abs(xm(sun)) <= tol1(sun) .or. fb(sun) == 0._r8 ) then + if( abs(xm(sha)) <= tol1(sha) .or. fb(sha) == 0._r8 ) then + xsun=b(sun) + xsha=b(sha) + return + endif + endif + + do phase=1, nphs + if( abs(e(phase)) >= tol1(phase) .and. abs(fa(phase)) > abs(fb(phase)) ) then + s(phase)=fb(phase)/fa(phase) !Attempt inverse quadratic interpolation. + if(a(phase) == c(phase)) then + p(phase)=2._r8*xm(phase)*s(phase) + q(phase)=1._r8-s(phase) + else + q(phase)=fa(phase)/fc(phase) + r(phase)=fb(phase)/fc(phase) + p(phase)=s(phase)*(2._r8*xm(phase)*q(phase)*(q(phase)-r(phase))-(b(phase)-a(phase))*(r(phase)-1._r8)) + q(phase)=(q(phase)-1._r8)*(r(phase)-1._r8)*(s(phase)-1._r8) + endif + if( p(phase) > 0._r8 ) q(phase)=-q(phase) !Check whether in bounds. + p(phase)=abs(p(phase)) + if( 2._r8*p(phase) < min(3._r8*xm(phase)*q(phase)-abs(tol1(phase)*q(phase)),abs(e(phase)*q(phase))) ) then + e(phase)=d(phase) !Accept interpolation. + d(phase)=p(phase)/q(phase) + else + d(phase)=xm(phase) !Interpolation failed, use bisection. + e(phase)=d(phase) + endif + else !Bounds decreasing too slowly, use bisection. + d(phase)=xm(phase) + e(phase)=d(phase) + endif + a(phase)=b(phase) !Move last best guess to a. + fa(phase)=fb(phase) + if( abs(d(phase)) > tol1(phase) ) then !Evaluate new trial root. + b(phase)=b(phase)+d(phase) + else + b(phase)=b(phase)+sign(tol1(phase),xm(phase)) + endif + enddo + + gs0sun = gs_mol_sun + gs0sha = gs_mol_sha + call ci_func_PHS(x,b(sun), b(sha), fb(sun), fb(sha), ip, iv, ic, bsun, bsha, bflag, gb_mol, gs0sun, gs0sha, & + gs_mol_sun, gs_mol_sha, jesun, jesha, cair, oair, lmr_z_sun, lmr_z_sha, par_z_sun, par_z_sha, rh_can, & + qsatl, qaf, atm2lnd_inst, photosyns_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + + if( (fb(sun) == 0._r8) .and. (fb(sha) == 0._r8) ) exit + enddo + if( iter == itmax) write(iulog,*) 'brent exceeding maximum iterations', b, fb + xsun=b(sun) + xsha=b(sha) + + return + + end subroutine brent_PHS + !-------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------ + subroutine ci_func_PHS(x,cisun, cisha, fvalsun, fvalsha, p, iv, c, bsun, bsha, bflag, gb_mol, gs0sun, gs0sha,& + gs_mol_sun, gs_mol_sha, jesun, jesha, cair, oair, lmr_z_sun, lmr_z_sha, par_z_sun, par_z_sha, rh_can, & + qsatl, qaf, atm2lnd_inst, photosyns_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + !------------------------------------------------------------------------------ + ! + ! !DESCRIPTION: + ! evaluate the function + ! f(ci)=ci - (ca - (1.37rb+1.65rs))*patm*an for sunlit and shaded leaves + ! + ! !REVISION HISTORY: + ! + ! + ! !USES: + use clm_varpar , only : nlevsoi + implicit none + ! + ! !ARGUMENTS: + real(r8) , intent(inout) :: x(nvegwcs) ! working copy of vegwp(p,:) + real(r8) , intent(in) :: cisun,cisha ! intracellular leaf CO2 (Pa) + real(r8) , intent(out) :: fvalsun,fvalsha ! return function of the value f(ci) + integer , intent(in) :: p,c,iv ! pft, column, and radiation indexes + real(r8) , intent(inout) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) + real(r8) , intent(inout) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) + logical , intent(in) :: bflag ! signals to call calcstress to recalc bsun/bsha (or not) + real(r8) , intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8) , intent(in) :: gs0sun,gs0sha ! local gs_mol copies + real(r8) , intent(inout) :: gs_mol_sun,gs_mol_sha !leaf stomatal conductance (umol H2O/m**2/s) + real(r8) , intent(in) :: jesun, jesha ! electron transport rate (umol electrons/m**2/s) + real(r8) , intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8) , intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + real(r8) , intent(in) :: lmr_z_sun, lmr_z_sha ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8) , intent(in) :: par_z_sun, par_z_sha ! par absorbed per unit lai for canopy layer (w/m**2) + real(r8) , intent(in) :: rh_can ! canopy air relative humidity + real(r8) , intent(in) :: qsatl ! leaf specific humidity [kg/kg] + real(r8) , intent(in) :: qaf ! humidity of canopy air [kg/kg] + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + + ! !LOCAL VARIABLES: + real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) + real(r8) :: cs_sun,cs_sha ! CO2 partial pressure at leaf surface (Pa) + real(r8) :: aquad, bquad, cquad ! terms for quadratic equations + real(r8) :: r1, r2 ! roots of quadratic equation + real(r8) :: term ! intermediate in Medlyn stomatal model + ! + !------------------------------------------------------------------------------ + + associate( & + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + c3flag => photosyns_inst%c3flag_patch , & ! Input: [logical (:) ] true if C3 and false if C4 + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + medlynslope=> pftcon%medlynslope , & ! Input: [real(r8) (:) ] Slope for Medlyn stomatal conductance model method + medlynintercept=> pftcon%medlynintercept , & ! Input: [real(r8) (:) ] Intercept for Medlyn stomatal conductance model method + stomatalcond_mtd=> photosyns_inst%stomatalcond_mtd , & ! Input: [integer ] method type to use for stomatal conductance.GC.fnlprmsn15_r22845 + ac => photosyns_inst%ac_phs_patch , & ! Output: [real(r8) (:,:,:) ] Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + aj => photosyns_inst%aj_phs_patch , & ! Output: [real(r8) (:,:,:) ] RuBP-limited gross photosynthesis (umol CO2/m**2/s) + ap => photosyns_inst%ap_phs_patch , & ! Output: [real(r8) (:,:,:) ] product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + ag => photosyns_inst%ag_phs_patch , & ! Output: [real(r8) (:,:,:) ] co-limited gross leaf photosynthesis (umol CO2/m**2/s) + vcmax_z => photosyns_inst%vcmax_z_phs_patch , & ! Input: [real(r8) (:,:,:) ] maximum rate of carboxylation (umol co2/m**2/s) + cp => photosyns_inst%cp_patch , & ! Output: [real(r8) (:) ] CO2 compensation point (Pa) + kc => photosyns_inst%kc_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for CO2 (Pa) + ko => photosyns_inst%ko_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for O2 (Pa) + qe => photosyns_inst%qe_patch , & ! Output: [real(r8) (:) ] quantum efficiency, used only for C4 (mol CO2 / mol photons) + tpu_z => photosyns_inst%tpu_z_phs_patch , & ! Output: [real(r8) (:,:,:) ] triose phosphate utilization rate (umol CO2/m**2/s) + kp_z => photosyns_inst%kp_z_phs_patch , & ! Output: [real(r8) (:,:,:) ] initial slope of CO2 response curve (C4 plants) + bbb => photosyns_inst%bbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + mbb => photosyns_inst%mbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry slope of conductance-photosynthesis relationship + an_sun => photosyns_inst%an_sun_patch , & ! Output: [real(r8) (:,:) ] net sunlit leaf photosynthesis (umol CO2/m**2/s) + an_sha => photosyns_inst%an_sha_patch & ! Output: [real(r8) (:,:) ] net shaded leaf photosynthesis (umol CO2/m**2/s) + ) + + !------------------------------------------------------------------------------ + + if (bflag) then !zqz what if bsun==0 ... doesn't break... but follow up + + call calcstress(p,c,x,bsun,bsha,gb_mol,gs0sun,gs0sha,qsatl,qaf, & + atm2lnd_inst,canopystate_inst,waterdiagnosticbulk_inst,soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + endif + + if (c3flag(p)) then + ! C3: Rubisco-limited photosynthesis + ac(p,sun,iv) = bsun * vcmax_z(p,sun,iv) * max(cisun-cp(p), 0._r8) / (cisun+kc(p)*(1._r8+oair/ko(p))) + ac(p,sha,iv) = bsha * vcmax_z(p,sha,iv) * max(cisha-cp(p), 0._r8) / (cisha+kc(p)*(1._r8+oair/ko(p))) + + ! C3: RuBP-limited photosynthesis + aj(p,sun,iv) = jesun * max(cisun-cp(p), 0._r8) / (4._r8*cisun+8._r8*cp(p)) + aj(p,sha,iv) = jesha * max(cisha-cp(p), 0._r8) / (4._r8*cisha+8._r8*cp(p)) + + ! C3: Product-limited photosynthesis + ap(p,sun,iv) = 3._r8 * tpu_z(p,sun,iv) + ap(p,sha,iv) = 3._r8 * tpu_z(p,sha,iv) + + else + ! C4: Rubisco-limited photosynthesis + ac(p,sun,iv) = bsun * vcmax_z(p,sun,iv) + ac(p,sha,iv) = bsha * vcmax_z(p,sha,iv) + + ! C4: RuBP-limited photosynthesis + aj(p,sun,iv) = qe(p) * par_z_sun * 4.6_r8 + aj(p,sha,iv) = qe(p) * par_z_sha * 4.6_r8 + + ! C4: PEP carboxylase-limited (CO2-limited) + ap(p,sun,iv) = kp_z(p,sun,iv) * max(cisun, 0._r8) / forc_pbot(c) + ap(p,sha,iv) = kp_z(p,sha,iv) * max(cisha, 0._r8) / forc_pbot(c) + + end if + + ! Gross photosynthesis. First co-limit ac and aj. Then co-limit ap + + ! Sunlit + aquad = params_inst%theta_cj(ivt(p)) + bquad = -(ac(p,sun,iv) + aj(p,sun,iv)) + cquad = ac(p,sun,iv) * aj(p,sun,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + ai = min(r1,r2) + + aquad = params_inst%theta_ip + bquad = -(ai + ap(p,sun,iv)) + cquad = ai * ap(p,sun,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + ag(p,sun,iv) = max(0._r8,min(r1,r2)) + + ! Shaded + aquad = params_inst%theta_cj(ivt(p)) + bquad = -(ac(p,sha,iv) + aj(p,sha,iv)) + cquad = ac(p,sha,iv) * aj(p,sha,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + ai = min(r1,r2) + + aquad = params_inst%theta_ip + bquad = -(ai + ap(p,sha,iv)) + cquad = ai * ap(p,sha,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + ag(p,sha,iv) = max(0._r8,min(r1,r2)) + + ! Net photosynthesis. Exit iteration if an < 0 + an_sun(p,iv) = ag(p,sun,iv) - bsun * lmr_z_sun + an_sha(p,iv) = ag(p,sha,iv) - bsha * lmr_z_sha + + if (an_sun(p,iv) < 0._r8) then + if ( stomatalcond_mtd == stomatalcond_mtd_medlyn2011 )then + gs_mol_sun = medlynintercept(patch%itype(p)) + else if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then + gs_mol_sun = bbb(p) + else + gs_mol_sun = nan + end if + gs_mol_sun = max( bsun*gs_mol_sun, 1._r8) + fvalsun = 0._r8 ! really tho? zqz + endif + if (an_sha(p,iv) < 0._r8) then + if ( stomatalcond_mtd == stomatalcond_mtd_medlyn2011 )then + gs_mol_sha = medlynintercept(patch%itype(p)) + else if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then + gs_mol_sha = bbb(p) + else + gs_mol_sha = nan + end if + gs_mol_sha = max( bsha*gs_mol_sha, 1._r8) + fvalsha = 0._r8 + endif + if ((an_sun(p,iv) < 0._r8) .AND. (an_sha(p,iv) < 0._r8)) then + return + endif + + ! Quadratic gs_mol calculation with an known. Valid for an >= 0. + ! With an <= 0, then gs_mol = bbb + + ! Sunlit + if (an_sun(p,iv) >= 0._r8) then + cs_sun = cair - 1.4_r8/gb_mol * an_sun(p,iv) * forc_pbot(c) + cs_sun = max(cs_sun,10.e-06_r8) + end if + + if ( stomatalcond_mtd == stomatalcond_mtd_medlyn2011 )then + if (an_sun(p,iv) >= 0._r8) then + term = 1.6_r8 * an_sun(p,iv) / (cs_sun / forc_pbot(c) * 1.e06_r8) + aquad = 1.0_r8 + bquad = -(2.0 * (medlynintercept(patch%itype(p))*1.e-06_r8 + term) + (medlynslope(patch%itype(p)) * term)**2 / & + (gb_mol*1.e-06_r8 * rh_can)) + cquad = medlynintercept(patch%itype(p))*medlynintercept(patch%itype(p))*1.e-12_r8 + & + (2.0*medlynintercept(patch%itype(p))*1.e-06_r8 + term * & + (1.0 - medlynslope(patch%itype(p))* medlynslope(patch%itype(p)) / rh_can)) * term + + call quadratic (aquad, bquad, cquad, r1, r2) + gs_mol_sun = max(r1,r2) * 1.e06_r8 + end if + + ! Shaded + if (an_sha(p,iv) >= 0._r8) then + cs_sha = cair - 1.4_r8/gb_mol * an_sha(p,iv) * forc_pbot(c) + cs_sha = max(cs_sha,10.e-06_r8) + + term = 1.6_r8 * an_sha(p,iv) / (cs_sha / forc_pbot(c) * 1.e06_r8) + aquad = 1.0_r8 + bquad = -(2.0 * (medlynintercept(patch%itype(p))*1.e-06_r8 + term) + (medlynslope(patch%itype(p)) * term)**2 / & + (gb_mol*1.e-06_r8 * rh_can)) + cquad = medlynintercept(patch%itype(p))*medlynintercept(patch%itype(p))*1.e-12_r8 + & + (2.0*medlynintercept(patch%itype(p))*1.e-06_r8 + term * (1.0 - medlynslope(patch%itype(p))* & + medlynslope(patch%itype(p)) / rh_can)) * term + + call quadratic (aquad, bquad, cquad, r1, r2) + gs_mol_sha = max(r1,r2)* 1.e06_r8 + end if + else if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then + if (an_sun(p,iv) >= 0._r8) then + aquad = cs_sun + bquad = cs_sun*(gb_mol - max(bsun*bbb(p),1._r8)) - mbb(p)*an_sun(p,iv)*forc_pbot(c) + cquad = -gb_mol*(cs_sun*max(bsun*bbb(p),1._r8) + mbb(p)*an_sun(p,iv)*forc_pbot(c)*rh_can) + call quadratic (aquad, bquad, cquad, r1, r2) + gs_mol_sun = max(r1,r2) + end if + + ! Shaded + if (an_sha(p,iv) >= 0._r8) then + cs_sha = cair - 1.4_r8/gb_mol * an_sha(p,iv) * forc_pbot(c) + cs_sha = max(cs_sha,10.e-06_r8) + + aquad = cs_sha + bquad = cs_sha*(gb_mol - max(bsha*bbb(p),1._r8)) - mbb(p)*an_sha(p,iv)*forc_pbot(c) + cquad = -gb_mol*(cs_sha*max(bsha*bbb(p),1._r8) + mbb(p)*an_sha(p,iv)*forc_pbot(c)*rh_can) + call quadratic (aquad, bquad, cquad, r1, r2) + gs_mol_sha = max(r1,r2) + end if + end if + + ! Derive new estimate for cisun,cisha + if (an_sun(p,iv) >= 0._r8) then + if (gs_mol_sun > 0._r8) then + fvalsun =cisun - cair + an_sun(p,iv) * forc_pbot(c) * (1.4_r8*gs_mol_sun+1.6_r8*gb_mol) / (gb_mol*gs_mol_sun) + else + fvalsun =cisun - cair + endif + endif + if (an_sha(p,iv) >= 0._r8) then + if (gs_mol_sha > 0._r8) then + fvalsha =cisha - cair + an_sha(p,iv) * forc_pbot(c) * (1.4_r8*gs_mol_sha+1.6_r8*gb_mol) / (gb_mol*gs_mol_sha) + else + fvalsha =cisha - cair + endif + endif + end associate + end subroutine ci_func_PHS + !-------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------ + subroutine calcstress(p,c,x,bsun,bsha,gb_mol,gs_mol_sun,gs_mol_sha,qsatl,qaf, & + atm2lnd_inst,canopystate_inst,waterdiagnosticbulk_inst,soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + ! + ! DESCRIPTIONS + ! compute the transpiration stress using a plant hydraulics approach + ! calls spacF, spacA, and getvegwp + ! + ! USES + use clm_varpar , only : nlevsoi + use clm_varcon , only : rgas + use clm_time_manager , only : get_local_time + !! + ! !ARGUMENTS: + integer , intent(in) :: p ! pft index + integer , intent(in) :: c ! column index + real(r8) , intent(inout) :: x(nvegwcs) ! working copy of vegwp(p,:) + real(r8) , intent(out) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) + real(r8) , intent(out) :: bsha ! shaded sunlit canopy transpiration wetness factor (0 to 1) + real(r8) , intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8) , intent(in) :: gs_mol_sun ! Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + real(r8) , intent(in) :: gs_mol_sha ! Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + real(r8) , intent(in) :: qsatl ! leaf specific humidity [kg/kg] + real(r8) , intent(in) :: qaf ! humidity of canopy air [kg/kg] + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: wtl ! heat conductance for leaf [m/s] + real(r8) :: A(nvegwcs,nvegwcs) ! matrix relating d(vegwp) and f: d(vegwp)=A*f + real(r8) :: f(nvegwcs) ! flux divergence (mm/s) + real(r8) :: dx(nvegwcs) ! change in vegwp from one iter to the next [mm] + real(r8) :: efpot ! potential latent energy flux [kg/m2/s] + real(r8) :: rppdry_sun ! fraction of potential evaporation through transp - sunlit [-] + real(r8) :: rppdry_sha ! fraction of potential evaporation through transp - shaded [-] + real(r8) :: qflx_sun ! [kg/m2/s] + real(r8) :: qflx_sha ! [kg/m2/s] + real(r8) :: gs0sun,gs0sha ! local gs_mol copies + real(r8) :: qsun,qsha ! attenuated transpiration fluxes + integer :: j ! index + integer :: g ! gridcell index + real(r8) :: cf ! s m**2/umol -> s/m + integer :: iter ! newton's method iteration number + logical :: flag ! signal that matrix was not invertible + logical :: night ! signal to store vegwp within this routine, b/c it is night-time and full suite won't be called + integer, parameter :: itmax=50 ! exit newton's method if iters>itmax + real(r8), parameter :: tolf=1.e-6,toldx=1.e-9 !tolerances for a satisfactory solution + logical :: havegs ! signals direction of calculation gs->qflx or qflx->gs + real(r8) :: soilflux ! total soil column transpiration [mm/s] + real(r8), parameter :: tol_lai=.001_r8 ! minimum lai where transpiration is calc'd + !------------------------------------------------------------------------------ + + associate( & + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] patch canopy one-sided stem area index, no burying by snow + fdry => waterdiagnosticbulk_inst%fdry_patch , & ! Input: [real(r8) (:) ] fraction of foliage that is green and dry [-] + forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] density (kg/m**3) + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + tgcm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] air temperature at agcm reference height (kelvin) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + qflx_tran_veg => waterfluxbulk_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + vegwp_pd => canopystate_inst%vegwp_pd_patch , & ! Output: [real(r8) (:,:) ] vegetation water matric potential (mm) predawn + sucsat => soilstate_inst%sucsat_col & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + ) + + !temporary flag for night time vegwp(sun)>0 + if (x(sun)>0._r8) then + night=.TRUE. + x(sun)=x(sha) + else + night=.FALSE. + endif + + !copy to avoid rewriting gs_mol_sun + gs0sun=gs_mol_sun + gs0sha=gs_mol_sha + + !compute transpiration demand + havegs=.true. + call getqflx(p,c,gb_mol,gs0sun,gs0sha,qflx_sun,qflx_sha,qsatl,qaf,havegs, & + atm2lnd_inst, canopystate_inst, waterdiagnosticbulk_inst, temperature_inst) + + if ((laisun(p)>tol_lai .or. laisha(p)>tol_lai).and.& + (qflx_sun>0._r8 .or. qflx_sha>0._r8))then + + !newton's method solves for matching fluxes through the spac + iter=0 + do + + iter=iter+1 + + call spacF(p,c,x,f,qflx_sun,qflx_sha, & + atm2lnd_inst,canopystate_inst,soilstate_inst,temperature_inst,waterfluxbulk_inst) + + if ( sqrt(sum(f*f)) < tolf*(qflx_sun+qflx_sha) ) then !fluxes balanced -> exit + flag = .false. + exit + end if + if ( iter>itmax ) then !exceeds max iters -> exit + flag = .false. + exit + end if + + call spacA(p,c,x,A,qflx_sun,qflx_sha,flag, & + atm2lnd_inst,canopystate_inst,soilstate_inst,temperature_inst,waterfluxbulk_inst) + + if (flag) then + ! cannot invert the matrix, solve for x algebraically assuming no flux + exit + end if + + if (laisun(p)>tol_lai.and.laisha(p)>tol_lai)then + dx = matmul(A,f) + else + !reduces to 3x3 system + !in this case, dx is not always [sun,sha,xyl,root] + !sun and sha flip depending on which is lai==0 + dx(sun)=0._r8 + dx(sha:root)=matmul(A(sha:root,sha:root),f(sha:root)) + endif + + + if ( maxval(abs(dx)) > 50000._r8) then + dx = 50000._r8 * dx / maxval(abs(dx)) !rescale step to max of 50000 + end if + + + if (laisun(p)>tol_lai.and.laisha(p)>tol_lai)then + x=x+dx + elseif (laisha(p)>tol_lai) then + x=x+dx + x(sun)=x(xyl) ! psi_sun = psi_xyl because laisun==0 + else + x(xyl:root)=x(xyl:root)+dx(xyl:root) + x(sun)=x(sun)+dx(sha) ! implementation ugly bit, chose to flip dx(sun) and dx(sha) for laisha==0 case + x(sha)=x(xyl) ! psi_sha = psi_xyl because laisha==0 + + endif + + + if ( sqrt(sum(dx*dx)) < toldx) then + !step in vegwp small -> exit + exit + end if + + ! this is a catch to force spac gradient to atmosphere + if ( x(xyl) > x(root) ) x(xyl) = x(root) + if ( x(sun) > x(xyl) ) x(sun) = x(xyl) + if ( x(sha) > x(xyl) ) x(sha) = x(xyl) + + end do + + else + ! both qflxsun and qflxsha==0 + flag=.true. + end if + + if (flag) then + ! solve algebraically + call getvegwp(p, c, x, gb_mol, gs0sun, gs0sha, qsatl, qaf, soilflux, & + atm2lnd_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, temperature_inst) + bsun = plc(x(sun),p,c,sun,veg) + bsha = plc(x(sha),p,c,sha,veg) + else + ! compute attenuated flux + qsun=qflx_sun*plc(x(sun),p,c,sun,veg) + qsha=qflx_sha*plc(x(sha),p,c,sha,veg) + + ! retrieve stressed stomatal conductance + havegs=.FALSE. + call getqflx(p,c,gb_mol,gs0sun,gs0sha,qsun,qsha,qsatl,qaf,havegs, & + atm2lnd_inst, canopystate_inst, waterdiagnosticbulk_inst, temperature_inst) + + ! compute water stress + ! .. generally -> B= gs_stressed / gs_unstressed + ! .. when gs=0 -> B= plc( x ) + if (qflx_sun>0._r8) then + bsun = gs0sun/gs_mol_sun + else + bsun = plc(x(sun),p,c,sun,veg) + endif + if (qflx_sha>0._r8) then + bsha = gs0sha/gs_mol_sha + else + bsha = plc(x(sha),p,c,sha,veg) + endif + endif + if ( bsun < 0.01_r8 ) bsun = 0._r8 + if ( bsha < 0.01_r8 ) bsha = 0._r8 + + !zqz is this the best place to do this? + ! was looking like qflx_tran_veg/vegwp was not being set at night time + ! set vegwp for the final gs_mol solution + if (night) then + gs0sun=bsun*gs_mol_sun + gs0sha=bsha*gs_mol_sha + call getvegwp(p, c, x, gb_mol, gs0sun, gs0sha, qsatl, qaf, soilflux, & + atm2lnd_inst, canopystate_inst, waterdiagnosticbulk_inst, soilstate_inst, temperature_inst) + if (soilflux<0._r8) soilflux = 0._r8 + qflx_tran_veg(p) = soilflux + endif + + !save predawn vegwp + g = patch%gridcell(p) + if (night .and. get_local_time(grc%londeg(g))<(isecspday/2)) then + vegwp_pd(p,:) = x + else + vegwp_pd(p,:) = spval + end if + + + end associate + + end subroutine calcstress + + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + subroutine spacA(p,c,x,invA,qflx_sun,qflx_sha,flag, & + atm2lnd_inst,canopystate_inst,soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + + ! + ! DESCRIPTION + ! Returns invA, the inverse matrix relating delta(vegwp) to f + ! d(vegwp)=invA*f + ! evaluated at vegwp(p) + ! + ! The methodology is currently hardcoded for linear algebra assuming the + ! number of vegetation segments is four. Thus the matrix A and it's inverse + ! invA are both 4x4 matrices. A more general method could be done using for + ! example a LINPACK linear algebra solver. + ! + ! USES + use clm_varpar , only : nlevsoi + use clm_varcon , only : rgas + ! + ! !ARGUMENTS: + integer , intent(in) :: p ! pft index + integer , intent(in) :: c ! column index + real(r8) , intent(in) :: x(nvegwcs) ! working copy of veg water potential for patch p [mm H2O] + real(r8) , intent(out) :: invA(nvegwcs,nvegwcs) ! matrix relating d(vegwp) and f: d(vegwp)=invA*f + real(r8) , intent(in) :: qflx_sun ! Sunlit leaf transpiration [kg/m2/s] + real(r8) , intent(in) :: qflx_sha ! Shaded leaf transpiration [kg/m2/s] + logical , intent(out) :: flag ! tells calling function that the matrix is not invertible + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: wtl ! heat conductance for leaf [m/s] + real(r8) :: fsto1 ! sunlit transpiration reduction function [-] + real(r8) :: fsto2 ! shaded transpiration reduction function [-] + real(r8) :: fx ! fraction of maximum conductance, xylem-to-leaf [-] + real(r8) :: fr ! fraction of maximum conductance, root-to-xylem [-] + real(r8) :: dfsto1 ! 1st derivative of fsto1 w.r.t. change in vegwp + real(r8) :: dfsto2 ! 1st derivative of fsto2 w.r.t. change in vegwp + real(r8) :: dfx ! 1st derivative of fx w.r.t. change in vegwp + real(r8) :: dfr ! 1st derivative of fr w.r.t. change in vegwp + real(r8) :: A(nvegwcs,nvegwcs) ! matrix relating vegwp to flux divergence f=A*d(vegwp) + real(r8) :: leading ! inverse of determiniant + real(r8) :: determ ! determinant of matrix + real(r8) :: grav1 ! gravitational potential surface to canopy top (mm H2O) + real(r8) :: invfactor ! + real(r8), parameter :: tol_lai=.001_r8 ! minimum lai where transpiration is calc'd + integer :: j ! index + !------------------------------------------------------------------------------ +#ifndef NDEBUG + ! Only execute this code if DEBUG=TRUE + if ( nvegwcs /= 4 )then + call endrun(msg='Error:: this function is hardcoded for 4x4 matrices with nvegwcs==4'//errMsg(__FILE__, __LINE__)) + end if +#endif + + associate( & + k_soil_root => soilstate_inst%k_soil_root_patch , & ! Input: [real(r8) (:,:) ] soil-root interface conductance (mm/s) + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area + htop => canopystate_inst%htop_patch , & ! Input: [real(r8) (:) ] patch canopy top (m) + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] patch canopy one-sided stem area index, no burying by snow + ivt => patch%itype & ! Input: [integer (:) ] patch vegetation type + ) + + ! initialize all elements to zero + A = 0._r8 + invA = 0._r8 + + grav1 = htop(p)*1000._r8 + + !compute conductance attentuation for each segment + fsto1= plc(x(sun),p,c,sun,veg) + fsto2= plc(x(sha),p,c,sha,veg) + fx= plc(x(xyl),p,c,xyl,veg) + fr= plc(x(root),p,c,root,veg) + + !compute 1st deriv of conductance attenuation for each segment + dfsto1= d1plc(x(sun),p,c,sun,veg) + dfsto2= d1plc(x(sha),p,c,sha,veg) + dfx= d1plc(x(xyl),p,c,xyl,veg) + dfr= d1plc(x(root),p,c,root,veg) + + !A - f=A*d(vegwp) + A(1,1)= - laisun(p) * params_inst%kmax(ivt(p),sun) * fx& + - qflx_sun * dfsto1 + A(1,3)= laisun(p) * params_inst%kmax(ivt(p),sun) * dfx * (x(xyl)-x(sun))& + + laisun(p) * params_inst%kmax(ivt(p),sun) * fx + A(2,2)= - laisha(p) * params_inst%kmax(ivt(p),sha) * fx& + - qflx_sha * dfsto2 + A(2,3)= laisha(p) * params_inst%kmax(ivt(p),sha) * dfx * (x(xyl)-x(sha))& + + laisha(p) * params_inst%kmax(ivt(p),sha) * fx + A(3,1)= laisun(p) * params_inst%kmax(ivt(p),sun) * fx + A(3,2)= laisha(p) * params_inst%kmax(ivt(p),sha) * fx + A(3,3)= - laisun(p) * params_inst%kmax(ivt(p),sun) * dfx * (x(xyl)-x(sun))& + - laisun(p) * params_inst%kmax(ivt(p),sun) * fx& + - laisha(p) * params_inst%kmax(ivt(p),sha) * dfx * (x(xyl)-x(sha))& + - laisha(p) * params_inst%kmax(ivt(p),sha) * fx& + - tsai(p) * params_inst%kmax(ivt(p),xyl) / htop(p) * fr + A(3,4)= tsai(p) * params_inst%kmax(ivt(p),xyl) / htop(p) * dfr * (x(root)-x(xyl)-grav1)& + + tsai(p) * params_inst%kmax(ivt(p),xyl) / htop(p) * fr + A(4,3)= tsai(p) * params_inst%kmax(ivt(p),xyl) / htop(p) * fr + A(4,4)= - tsai(p) * params_inst%kmax(ivt(p),xyl) / htop(p) * fr& + - tsai(p) * params_inst%kmax(ivt(p),xyl) / htop(p) * dfr * (x(root)-x(xyl)-grav1)& + - sum(k_soil_root(p,1:nlevsoi)) + + invfactor=1._r8 + A=invfactor*A + + !matrix inversion + if (laisun(p)>tol_lai .and. laisha(p)>tol_lai) then + ! general case + + determ=A(4,4)*A(2,2)*A(3,3)*A(1,1) - A(4,4)*A(2,2)*A(3,1)*A(1,3)& + - A(4,4)*A(3,2)*A(2,3)*A(1,1) - A(4,3)*A(1,1)*A(2,2)*A(3,4) + if ( abs(determ) <= 1.e-50_r8 ) then + flag = .true. !tells calling function that the matrix is not invertible + return + else + flag = .false. + end if + + leading = 1._r8/determ + + !algebraic inversion of the matrix + invA(1,1)=leading*A(4,4)*A(2,2)*A(3,3) - leading*A(4,4)*A(3,2)*A(2,3) - leading*A(4,3)*A(2,2)*A(3,4) + invA(2,1)=leading*A(2,3)*A(4,4)*A(3,1) + invA(3,1)=-leading*A(4,4)*A(2,2)*A(3,1) + invA(4,1)=leading*A(4,3)*A(2,2)*A(3,1) + invA(1,2)=leading*A(1,3)*A(4,4)*A(3,2) + invA(2,2)=leading*A(4,4)*A(3,3)*A(1,1)-leading*A(4,4)*A(3,1)*A(1,3)-leading*A(4,3)*A(1,1)*A(3,4) + invA(3,2)=-leading*A(1,1)*A(4,4)*A(3,2) + invA(4,2)=leading*A(4,3)*A(1,1)*A(3,2) + invA(1,3)=-leading*A(1,3)*A(2,2)*A(4,4) + invA(2,3)=-leading*A(2,3)*A(1,1)*A(4,4) + invA(3,3)=leading*A(2,2)*A(1,1)*A(4,4) + invA(4,3)=-leading*A(4,3)*A(1,1)*A(2,2) + invA(1,4)=leading*A(1,3)*A(3,4)*A(2,2) + invA(2,4)=leading*A(2,3)*A(3,4)*A(1,1) + invA(3,4)=-leading*A(3,4)*A(1,1)*A(2,2) + invA(4,4)=leading*A(2,2)*A(3,3)*A(1,1)-leading*A(2,2)*A(3,1)*A(1,3)-leading*A(3,2)*A(2,3)*A(1,1) + invA=invfactor*invA !undo inversion scaling + else + ! if laisun or laisha ==0 invert the corresponding 3x3 matrix + ! if both are zero, this routine is not called + if (laisha(p)<=tol_lai) then + ! shift nonzero matrix values so that both 3x3 cases can be inverted with the same code + A(2,2)=A(1,1) + A(3,2)=A(3,1) + A(2,3)=A(1,3) + endif + determ=A(2,2)*A(3,3)*A(4,4)-A(3,4)*A(2,2)*A(4,3)-A(2,3)*A(3,2)*A(4,4) + if ( abs(determ) <= 1.e-50_r8 ) then + flag = .true. !tells calling function that the matrix is not invertible + return + else + flag = .false. + end if + + !algebraic inversion of the 3x3 matrix stored in A(2:4,2:4) + invA(2,2)=A(3,3)*A(4,4)-A(3,4)*A(4,3) + invA(2,3)=-A(2,3)*A(4,4) + invA(2,4)=A(3,4)*A(2,3) + invA(3,2)=-A(3,2)*A(4,4) + invA(3,3)=A(2,2)*A(4,4) + invA(3,4)=-A(3,4)*A(2,2) + invA(4,2)=A(3,2)*A(4,3) + invA(4,3)=-A(2,2)*A(4,3) + invA(4,4)=A(2,2)*A(3,3)-A(2,3)*A(3,2) + invA=1._r8/determ*invA + + endif + + end associate + + end subroutine spacA + + !-------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------ + subroutine spacF(p,c,x,f,qflx_sun,qflx_sha, & + atm2lnd_inst,canopystate_inst,soilstate_inst, & + temperature_inst, waterfluxbulk_inst) + ! + ! DESCRIPTION + ! Returns f, the flux divergence across each vegetation segment + ! calculated for vegwp(p,:) as passed in via x + ! + ! USES + use clm_varpar , only : nlevsoi + use clm_varcon , only : rgas + use ColumnType , only : col + ! + ! !ARGUMENTS: + integer , intent(in) :: p ! pft index + integer , intent(in) :: c ! column index + real(r8) , intent(in) :: x(nvegwcs) ! working copy of veg water potential for patch p [mm H2O] + real(r8) , intent(out) :: f(nvegwcs) ! water flux divergence [mm/s] + real(r8) , intent(in) :: qflx_sun ! Sunlit leaf transpiration [kg/m2/s] + real(r8) , intent(in) :: qflx_sha ! Shaded leaf transpiration [kg/m2/s] + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: wtl ! heat conductance for leaf [m/s] + real(r8) :: fsto1 ! sunlit transpiration reduction function [-] + real(r8) :: fsto2 ! shaded transpiration reduction function [-] + real(r8) :: fx ! fraction of maximum conductance, xylem-to-leaf [-] + real(r8) :: fr ! fraction of maximum conductance, root-to-xylem [-] + real(r8) :: grav1 ! gravitational potential surface to canopy top (mm H2O) + real(r8) :: grav2(nlevsoi) ! soil layer gravitational potential relative to surface (mm H2O) + real(r8) :: temp ! used to copy f(sun) to f(sha) for special case + real(r8), parameter :: tol_lai=.001_r8 ! needs to be the same as in calcstress and spacA (poor form, refactor)< + integer :: j ! index + !------------------------------------------------------------------------------ + + associate( & + k_soil_root => soilstate_inst%k_soil_root_patch , & ! Input: [real(r8) (:,:) ] soil-root interface conductance (mm/s) + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area + htop => canopystate_inst%htop_patch , & ! Input: [real(r8) (:) ] patch canopy top (m) + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] patch canopy one-sided stem area index, no burying by snow + smp => soilstate_inst%smp_l_col , & ! Input: [real(r8) (:,:) ] soil matrix potential [mm] + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + z => col%z & ! Input: [real(r8) (:,:) ] layer node depth (m) + ) + + grav1 = htop(p) * 1000._r8 + grav2(1:nlevsoi) = z(c,1:nlevsoi) * 1000._r8 + + fsto1= plc(x(sun),p,c,sun,veg) + fsto2= plc(x(sha),p,c,sha,veg) + fx= plc(x(xyl),p,c,xyl,veg) + fr= plc(x(root),p,c,root,veg) + + !compute flux divergence across each plant segment + f(sun)= qflx_sun * fsto1 - laisun(p) * params_inst%kmax(ivt(p),sun) * fx * (x(xyl)-x(sun)) + f(sha)= qflx_sha * fsto2 - laisha(p) * params_inst%kmax(ivt(p),sha) * fx * (x(xyl)-x(sha)) + f(xyl)= laisun(p) * params_inst%kmax(ivt(p),sun) * fx * (x(xyl)-x(sun))& + + laisha(p) * params_inst%kmax(ivt(p),sha) * fx * (x(xyl)-x(sha)) & + - tsai(p) * params_inst%kmax(ivt(p),xyl) / htop(p) * fr * (x(root)-x(xyl)-grav1) + f(root)= tsai(p) * params_inst%kmax(ivt(p),xyl) / htop(p) * fr * (x(root)-x(xyl)-grav1) & + + sum( k_soil_root(p,1:nlevsoi) * (x(root)+grav2(1:nlevsoi)) ) & + - sum( k_soil_root(p,1:nlevsoi) * smp(c,1:nlevsoi) ) + + if (laisha(p)qflx or qflx->gs + !---------------------------------------------------------------------- + associate( & + k_soil_root => soilstate_inst%k_soil_root_patch , & ! Input: [real(r8) (:,:) ] soil-root interface conductance (mm/s) + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area + htop => canopystate_inst%htop_patch , & ! Input: [real(r8) (:) ] patch canopy top (m) + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] patch canopy one-sided stem area index, no burying by snow + smp => soilstate_inst%smp_l_col , & ! Input: [real(r8) (:,:) ] soil matrix potential [mm] + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + hk_l => soilstate_inst%hk_l_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity (mm/s) + hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + z => col%z & ! Input: [real(r8) (:,:) ] layer node depth (m) + ) + + grav1 = 1000._r8 *htop(p) + grav2(1:nlevsoi) = 1000._r8 * z(c,1:nlevsoi) + + !compute transpiration demand + havegs=.true. + call getqflx(p,c,gb_mol,gs_mol_sun,gs_mol_sha,qflx_sun,qflx_sha,qsatl,qaf,havegs, & + atm2lnd_inst, canopystate_inst, waterdiagnosticbulk_inst, temperature_inst) + + !calculate root water potential + if ( abs(sum(k_soil_root(p,1:nlevsoi))) == 0._r8 ) then + x(root) = sum(smp(c,1:nlevsoi) - grav2)/nlevsoi + else + x(root) = (sum(k_soil_root(p,1:nlevsoi)*(smp(c,1:nlevsoi)-grav2))-qflx_sun-qflx_sha) & + /sum(k_soil_root(p,1:nlevsoi)) + endif + + !calculate xylem water potential + fr = plc(x(root),p,c,root,veg) + if ( (tsai(p) > 0._r8) .and. (fr > 0._r8) ) then + x(xyl) = x(root) - grav1 - (qflx_sun+qflx_sha)/(fr*params_inst%kmax(ivt(p),root)/htop(p)*tsai(p))!removed htop conversion + else + x(xyl) = x(root) - grav1 + endif + + !calculate sun/sha leaf water potential + fx = plc(x(xyl),p,c,xyl,veg) + if ( (laisha(p) > 0._r8) .and. (fx > 0._r8) ) then + x(sha) = x(xyl) - (qflx_sha/(fx*params_inst%kmax(ivt(p),xyl)*laisha(p))) + else + x(sha) = x(xyl) + endif + if ( (laisun(p) > 0._r8) .and. (fx > 0._r8) ) then + x(sun) = x(xyl) - (qflx_sun/(fx*params_inst%kmax(ivt(p),xyl)*laisun(p))) + else + x(sun) = x(xyl) + endif + + !calculate soil flux + soilflux = 0._r8 + do j = 1,nlevsoi + soilflux = soilflux + k_soil_root(p,j)*(smp(c,j)-x(root)-grav2(j)) + enddo + + end associate + + end subroutine getvegwp + + !-------------------------------------------------------------------------------- + subroutine getqflx(p,c,gb_mol,gs_mol_sun,gs_mol_sha,qflx_sun,qflx_sha,qsatl,qaf,havegs, & + atm2lnd_inst, canopystate_inst, waterdiagnosticbulk_inst, temperature_inst) + ! !DESCRIPTION: + ! calculate sunlit and shaded transpiration using gb_MOL and gs_MOL + ! !USES: + ! + use clm_varcon , only : rgas + implicit none + ! + ! !ARGUMENTS: + integer , intent(in) :: p ! pft index + integer , intent(in) :: c ! column index + real(r8) , intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8) , intent(inout) :: gs_mol_sun ! Ball-Berry leaf conductance (umol H2O/m**2/s) + real(r8) , intent(inout) :: gs_mol_sha ! Ball-Berry leaf conductance (umol H2O/m**2/s) + real(r8) , intent(inout) :: qflx_sun ! Sunlit leaf transpiration [kg/m2/s] + real(r8) , intent(inout) :: qflx_sha ! Shaded leaf transpiration [kg/m2/s] + real(r8) , intent(in) :: qsatl ! leaf specific humidity [kg/kg] + real(r8) , intent(in) :: qaf ! humidity of canopy air [kg/kg] + logical , intent(in) :: havegs ! signals direction of calculation gs->qflx or qflx->gs + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(temperature_type) , intent(in) :: temperature_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: wtl ! heat conductance for leaf [m/s] + real(r8) :: efpot ! potential latent energy flux [kg/m2/s] + real(r8) :: rppdry_sun ! fraction of potential evaporation through transp - sunlit [-] + real(r8) :: rppdry_sha ! fraction of potential evaporation through transp - shaded [-] + real(r8) :: cf ! s m**2/umol -> s/m + !---------------------------------------------------------------------- + + associate( & + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + fdry => waterdiagnosticbulk_inst%fdry_patch , & ! Input: [real(r8) (:) ] fraction of foliage that is green and dry [-] + forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] density (kg/m**3) + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + tgcm => temperature_inst%thm_patch & ! Input: [real(r8) (:) ] air temperature at agcm reference height (kelvin) + ) + + + cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e6_r8 ! gb->gbmol conversion factor + wtl = (elai(p)+esai(p))*gb_mol + efpot = forc_rho(c)*wtl*(qsatl-qaf) + if (havegs) then + + if ( (efpot > 0._r8) .and. (elai(p) > 0._r8) ) then + if ( gs_mol_sun > 0._r8 ) then + rppdry_sun = fdry(p)/gb_mol*(laisun(p)/(1._r8/gb_mol+1._r8/gs_mol_sun))/elai(p) + qflx_sun = efpot*rppdry_sun/cf + else + qflx_sun = 0._r8 + end if + if ( gs_mol_sha > 0._r8 ) then + rppdry_sha = fdry(p)/gb_mol*(laisha(p)/(1._r8/gb_mol+1._r8/gs_mol_sha))/elai(p) + qflx_sha = efpot*rppdry_sha/cf + else + qflx_sha = 0._r8 + end if + else + qflx_sun = 0._r8 + qflx_sha = 0._r8 + end if + + else + if (qflx_sun > 0._r8) then + gs_mol_sun=gb_mol*qflx_sun*cf*elai(p)/(efpot*fdry(p)*laisun(p)-qflx_sun*cf*elai(p)) + else + gs_mol_sun=0._r8 + endif + if (qflx_sha > 0._r8) then + gs_mol_sha=gb_mol*qflx_sha*cf*elai(p)/(efpot*fdry(p)*laisha(p)-qflx_sha*cf*elai(p)) + else + gs_mol_sha=0._r8 + endif + + endif + + end associate + + end subroutine getqflx + + !-------------------------------------------------------------------------------- + function plc(x,p,c,level,plc_method) + ! !DESCRIPTION + ! Return value of vulnerability curve at x + ! + ! !ARGUMENTS + real(r8) , intent(in) :: x ! water potential input + integer , intent(in) :: p ! index for pft + integer , intent(in) :: c ! index for column + integer , intent(in) :: level ! veg segment lvl (1:nvegwcs) + integer , intent(in) :: plc_method ! + real(r8) :: plc ! attenuated conductance [0:1] 0=no flow + ! + ! !PARAMETERS + integer , parameter :: vegetation_weibull=0 ! case number + !------------------------------------------------------------------------------ + associate( & + ivt => patch%itype & ! Input: [integer (:) ] patch vegetation type + ) + + select case (plc_method) + !possible to add other methods later + case (vegetation_weibull) + plc=2._r8**(-(x/params_inst%psi50(ivt(p),level))**params_inst%ck(ivt(p),level)) + if ( plc < 0.005_r8) plc = 0._r8 + case default + print *,'must choose plc method' + end select + + end associate + + end function plc + !-------------------------------------------------------------------------------- + + !-------------------------------------------------------------------------------- + function d1plc(x,p,c,level,plc_method) + ! !DESCRIPTION + ! Return 1st derivative of vulnerability curve at x + ! + ! !ARGUMENTS + real(r8) , intent(in) :: x ! water potential input + integer , intent(in) :: p ! index for pft + integer , intent(in) :: c ! index for column + integer , intent(in) :: level ! veg segment lvl (1:nvegwcs) + integer , intent(in) :: plc_method ! 0 for vegetation, 1 for soil + real(r8) :: d1plc ! first deriv of plc curve at x + ! + ! !PARAMETERS + integer , parameter :: vegetation_weibull=0 ! case number + !------------------------------------------------------------------------------ + associate( & + ivt => patch%itype & ! Input: [integer (:) ] patch vegetation type + ) + + select case (plc_method) + !possible to add other methods later + case (vegetation_weibull) + d1plc= -params_inst%ck(ivt(p),level) * log(2._r8) * (2._r8**(-(x/params_inst%psi50(ivt(p),level)) & + **params_inst%ck(ivt(p),level))) & + * ((x/params_inst%psi50(ivt(p),level))**params_inst%ck(ivt(p),level)) / x + case default + print *,'must choose plc method' + end select + + end associate + + end function d1plc + +end module PhotosynthesisMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 new file mode 100644 index 000000000..e8f557f9b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 @@ -0,0 +1,1699 @@ +module SurfaceAlbedoMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Performs surface albedo calculations + ! + ! !PUBLIC TYPES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use landunit_varcon , only : istsoil, istcrop, istdlak + use clm_varcon , only : grlnd, namep + use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan + use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE + use pftconMod , only : pftcon + use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC + use AerosolMod , only : aerosol_type + use CanopyStateType , only : canopystate_type + use LakeStateType , only : lakestate_type + use SurfaceAlbedoType , only : surfalb_type + use TemperatureType , only : temperature_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SurfaceAlbedo_readnl + public :: SurfaceAlbedoInitTimeConst + public :: SurfaceAlbedo ! Surface albedo and two-stream fluxes + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: SoilAlbedo ! Determine ground surface albedo + private :: TwoStream ! Two-stream fluxes for canopy radiative transfer + ! + ! !PUBLIC DATA MEMBERS: + ! The CLM default albice values are too high. + ! Full-spectral albedo for land ice is ~0.5 (Paterson, Physics of Glaciers, 1994, p. 59) + ! This is the value used in CAM3 by Pritchard et al., GRL, 35, 2008. + + ! albedo land ice by waveband (1=vis, 2=nir) + real(r8), public :: albice(numrad) = (/ 0.80_r8, 0.55_r8 /) + + ! namelist default setting for inputting alblakwi + real(r8), public :: lake_melt_icealb(numrad) = (/ 0.10_r8, 0.10_r8/) + + ! albedo frozen lakes by waveband (1=vis, 2=nir) + ! unclear what the reference is for this + real(r8), private :: alblak(numrad) = (/0.60_r8, 0.40_r8/) + + ! albedo of melting lakes due to puddling, open water, or white ice + ! From D. Mironov (2010) Boreal Env. Research + ! To revert albedo of melting lakes to the cold snow-free value, set + ! lake_melt_icealb namelist to 0.60, 0.40 like alblak above. + real(r8), private :: alblakwi(numrad) + + ! Coefficient for calculating ice "fraction" for lake surface albedo + ! From D. Mironov (2010) Boreal Env. Research + real(r8), parameter :: calb = 95.6_r8 + + ! + ! !PRIVATE DATA MEMBERS: + logical, private :: snowveg_affects_radiation = .true. ! Whether snow on the vegetation canopy affects the radiation/albedo calculations + + ! + ! !PRIVATE DATA FUNCTIONS: + real(r8), allocatable, private :: albsat(:,:) ! wet soil albedo by color class and waveband (1=vis,2=nir) + real(r8), allocatable, private :: albdry(:,:) ! dry soil albedo by color class and waveband (1=vis,2=nir) + integer , allocatable, private :: isoicol(:) ! column soil color class + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SurfaceAlbedo_readnl( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for SurfaceAlbedo + ! + ! !USES: + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=*), parameter :: nmlname = "surfacealbedo_inparm" + + character(len=*), parameter :: subname = 'SurfaceAlbedo_readnl' + !----------------------------------------------------------------------- + + namelist /surfacealbedo_inparm/ snowveg_affects_radiation + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=surfacealbedo_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast(snowveg_affects_radiation, mpicom) + + if (masterproc) then + write(iulog,*) + write(iulog,*) nmlname, ' settings' + write(iulog,nml=surfacealbedo_inparm) + write(iulog,*) + end if + + end subroutine SurfaceAlbedo_readnl + + + !----------------------------------------------------------------------- + subroutine SurfaceAlbedoInitTimeConst(bounds) + ! + ! !DESCRIPTION: + ! Initialize module time constant variables + ! + ! !USES: + use shr_log_mod, only : errMsg => shr_log_errMsg + use fileutils , only : getfil + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_pio_openfile, ncd_pio_closefile + use spmdMod , only : masterproc + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c,g ! indices + integer :: mxsoil_color ! maximum number of soil color classes + type(file_desc_t) :: ncid ! netcdf id + character(len=256) :: locfn ! local filename + integer :: ier ! error status + logical :: readvar + integer ,pointer :: soic2d (:) ! read in - soil color + !--------------------------------------------------------------------- + + ! Allocate module variable for soil color + + allocate(isoicol(bounds%begc:bounds%endc)) + + ! Determine soil color and number of soil color classes + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_io(ncid=ncid, varname='mxsoil_color', flag='read', data=mxsoil_color, readvar=readvar) + if ( .not. readvar ) then + call endrun(msg=' ERROR: mxsoil_color NOT on surfdata file '//errMsg(sourcefile, __LINE__)) + end if + + allocate(soic2d(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='SOIL_COLOR', flag='read', data=soic2d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: SOIL_COLOR NOT on surfdata file'//errMsg(sourcefile, __LINE__)) + end if + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + isoicol(c) = soic2d(g) + end do + deallocate(soic2d) + + call ncd_pio_closefile(ncid) + + ! Determine saturated and dry soil albedos for n color classes and + ! numrad wavebands (1=vis, 2=nir) + + allocate(albsat(mxsoil_color,numrad), albdry(mxsoil_color,numrad), stat=ier) + if (ier /= 0) then + write(iulog,*)'allocation error for albsat, albdry' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if (masterproc) then + write(iulog,*) 'Attempting to read soil colo data .....' + end if + + if (mxsoil_color == 8) then + albsat(1:8,1) = (/0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8/) + albsat(1:8,2) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) + albdry(1:8,1) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) + albdry(1:8,2) = (/0.48_r8,0.44_r8,0.40_r8,0.36_r8,0.32_r8,0.28_r8,0.24_r8,0.20_r8/) + else if (mxsoil_color == 20) then + albsat(1:20,1) = (/0.25_r8,0.23_r8,0.21_r8,0.20_r8,0.19_r8,0.18_r8,0.17_r8,0.16_r8,& + 0.15_r8,0.14_r8,0.13_r8,0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8,0.04_r8/) + albsat(1:20,2) = (/0.50_r8,0.46_r8,0.42_r8,0.40_r8,0.38_r8,0.36_r8,0.34_r8,0.32_r8,& + 0.30_r8,0.28_r8,0.26_r8,0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) + albdry(1:20,1) = (/0.36_r8,0.34_r8,0.32_r8,0.31_r8,0.30_r8,0.29_r8,0.28_r8,0.27_r8,& + 0.26_r8,0.25_r8,0.24_r8,0.23_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) + albdry(1:20,2) = (/0.61_r8,0.57_r8,0.53_r8,0.51_r8,0.49_r8,0.48_r8,0.45_r8,0.43_r8,& + 0.41_r8,0.39_r8,0.37_r8,0.35_r8,0.33_r8,0.31_r8,0.29_r8,0.27_r8,0.25_r8,0.23_r8,0.21_r8,0.16_r8/) + else + write(iulog,*)'maximum color class = ',mxsoil_color,' is not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Set alblakwi + alblakwi(:) = lake_melt_icealb(:) + + end subroutine SurfaceAlbedoInitTimeConst + + !----------------------------------------------------------------------- + subroutine SurfaceAlbedo(bounds,nc, & + num_nourbanc, filter_nourbanc, & + num_nourbanp, filter_nourbanp, & + num_urbanc , filter_urbanc, & + num_urbanp , filter_urbanp, & + nextsw_cday , declinp1, & + clm_fates, & + aerosol_inst, canopystate_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, & + lakestate_inst, temperature_inst, surfalb_inst) + ! + ! !DESCRIPTION: + ! Surface albedo and two-stream fluxes + ! Surface albedos. Also fluxes (per unit incoming direct and diffuse + ! radiation) reflected, transmitted, and absorbed by vegetation. + ! Calculate sunlit and shaded fluxes as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy to calculate APAR profile + ! + ! The calling sequence is: + ! -> SurfaceAlbedo: albedos for next time step + ! -> SoilAlbedo: soil/lake/glacier/wetland albedos + ! -> SNICAR_RT: snow albedos: direct beam (SNICAR) + ! -> SNICAR_RT: snow albedos: diffuse (SNICAR) + ! -> TwoStream: absorbed, reflected, transmitted solar fluxes (vis dir,vis dif, nir dir, nir dif) + ! + ! Note that this is called with the "inactive_and_active" version of the filters, because + ! the variables computed here are needed over inactive points that might later become + ! active (due to landuse change). Thus, this routine cannot depend on variables that are + ! only computed over active points. + ! + ! !USES: + use shr_orb_mod + use clm_time_manager , only : get_nstep + use abortutils , only : endrun + use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, use_fates + use CLMFatesInterfaceMod, only : hlm_fates_interface_type + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: nc ! clump index + integer , intent(in) :: num_nourbanc ! number of columns in non-urban filter + integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points + integer , intent(in) :: num_nourbanp ! number of patches in non-urban filter + integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points + integer , intent(in) :: num_urbanc ! number of columns in urban filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + integer , intent(in) :: num_urbanp ! number of patches in urban filter + integer , intent(in) :: filter_urbanp(:) ! patch filter for rban points + real(r8) , intent(in) :: nextsw_cday ! calendar day at Greenwich (1.00, ..., days/year) + real(r8) , intent(in) :: declinp1 ! declination angle (radians) for next time step + type(hlm_fates_interface_type), intent(inout) :: clm_fates + type(aerosol_type) , intent(in) :: aerosol_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(lakestate_type) , intent(in) :: lakestate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(surfalb_type) , intent(inout) :: surfalb_inst + ! + ! !LOCAL VARIABLES: + integer :: i ! index for layers [idx] + integer :: aer ! index for sno_nbr_aer + real(r8) :: extkn ! nitrogen allocation coefficient + integer :: fp,fc,g,c,p,iv ! indices + integer :: ib ! band index + integer :: ic ! 0=unit incoming direct; 1=unit incoming diffuse + real(r8) :: dinc ! lai+sai increment for canopy layer + real(r8) :: dincmax ! maximum lai+sai increment for canopy layer + real(r8) :: dincmax_sum ! cumulative sum of maximum lai+sai increment for canopy layer + real(r8) :: laisum ! sum of canopy layer lai for error check + real(r8) :: saisum ! sum of canopy layer sai for error check + integer :: flg_slr ! flag for SNICAR (=1 if direct, =2 if diffuse) + integer :: flg_snw_ice ! flag for SNICAR (=1 when called from CLM, =2 when called from sea-ice) + integer :: num_vegsol ! number of vegetated patches where coszen>0 + integer :: num_novegsol ! number of vegetated patches where coszen>0 + integer :: filter_vegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 + integer :: filter_novegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 + real(r8) :: wl (bounds%begp:bounds%endp) ! fraction of LAI+SAI that is LAI + real(r8) :: ws (bounds%begp:bounds%endp) ! fraction of LAI+SAI that is SAI + real(r8) :: blai(bounds%begp:bounds%endp) ! lai buried by snow: tlai - elai + real(r8) :: bsai(bounds%begp:bounds%endp) ! sai buried by snow: tsai - esai + real(r8) :: coszen_gcell (bounds%begg:bounds%endg) ! cosine solar zenith angle for next time step (grc) + real(r8) :: coszen_patch (bounds%begp:bounds%endp) ! cosine solar zenith angle for next time step (patch) + real(r8) :: rho(bounds%begp:bounds%endp,numrad) ! leaf/stem refl weighted by fraction LAI and SAI + real(r8) :: tau(bounds%begp:bounds%endp,numrad) ! leaf/stem tran weighted by fraction LAI and SAI + real(r8) :: h2osno_total (bounds%begc:bounds%endc) ! total snow water (mm H2O) + real(r8) :: albsfc (bounds%begc:bounds%endc,numrad) ! albedo of surface underneath snow (col,bnd) + real(r8) :: albsnd(bounds%begc:bounds%endc,numrad) ! snow albedo (direct) + real(r8) :: albsni(bounds%begc:bounds%endc,numrad) ! snow albedo (diffuse) + real(r8) :: albsnd_pur (bounds%begc:bounds%endc,numrad) ! direct pure snow albedo (radiative forcing) + real(r8) :: albsni_pur (bounds%begc:bounds%endc,numrad) ! diffuse pure snow albedo (radiative forcing) + real(r8) :: albsnd_bc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without BC (radiative forcing) + real(r8) :: albsni_bc (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without BC (radiative forcing) + real(r8) :: albsnd_oc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without OC (radiative forcing) + real(r8) :: albsni_oc (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without OC (radiative forcing) + real(r8) :: albsnd_dst (bounds%begc:bounds%endc,numrad) ! direct snow albedo without dust (radiative forcing) + real(r8) :: albsni_dst (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without dust (radiative forcing) + real(r8) :: flx_absd_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (direct) [frc] + real(r8) :: flx_absi_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (diffuse) [frc] + real(r8) :: foo_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! dummy array for forcing calls + real(r8) :: h2osno_liq (bounds%begc:bounds%endc,-nlevsno+1:0) ! liquid snow content (col,lyr) [kg m-2] + real(r8) :: h2osno_ice (bounds%begc:bounds%endc,-nlevsno+1:0) ! ice content in snow (col,lyr) [kg m-2] + integer :: snw_rds_in (bounds%begc:bounds%endc,-nlevsno+1:0) ! snow grain size sent to SNICAR (col,lyr) [microns] + real(r8) :: mss_cnc_aer_in_frc_pur (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for forcing calculation (zero) (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_bc (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for BC forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_oc (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for OC forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_dst (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for dust forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_fdb (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of all aerosol species for feedback calculation (col,lyr,aer) [kg kg-1] + real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero + integer , parameter :: nband =numrad ! number of solar radiation waveband classes + !----------------------------------------------------------------------- + + associate(& + rhol => pftcon%rhol , & ! Input: leaf reflectance: 1=vis, 2=nir + rhos => pftcon%rhos , & ! Input: stem reflectance: 1=vis, 2=nir + taul => pftcon%taul , & ! Input: leaf transmittance: 1=vis, 2=nir + taus => pftcon%taus , & ! Input: stem transmittance: 1=vis, 2=nir + + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index, no burying by snow + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + + frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water content (col,lyr) [kg/m2] + h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens content (col,lyr) [kg/m2] + snw_rds => waterdiagnosticbulk_inst%snw_rds_col , & ! Input: [real(r8) (:,:) ] snow grain radius (col,lyr) [microns] + + mss_cnc_bcphi => aerosol_inst%mss_cnc_bcphi_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophilic BC (col,lyr) [kg/kg] + mss_cnc_bcpho => aerosol_inst%mss_cnc_bcpho_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophobic BC (col,lyr) [kg/kg] + mss_cnc_ocphi => aerosol_inst%mss_cnc_ocphi_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophilic OC (col,lyr) [kg/kg] + mss_cnc_ocpho => aerosol_inst%mss_cnc_ocpho_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophobic OC (col,lyr) [kg/kg] + mss_cnc_dst1 => aerosol_inst%mss_cnc_dst1_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 1 (col,lyr) [kg/kg] + mss_cnc_dst2 => aerosol_inst%mss_cnc_dst2_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 2 (col,lyr) [kg/kg] + mss_cnc_dst3 => aerosol_inst%mss_cnc_dst3_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 3 (col,lyr) [kg/kg] + mss_cnc_dst4 => aerosol_inst%mss_cnc_dst4_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 4 (col,lyr) [kg/kg] + + fsun_z => surfalb_inst%fsun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer + tlai_z => surfalb_inst%tlai_z_patch , & ! Output: [real(r8) (:,:) ] tlai increment for canopy layer + tsai_z => surfalb_inst%tsai_z_patch , & ! Output: [real(r8) (:,:) ] tsai increment for canopy layer + vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, sunlit leaf vcmax + vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, shaded leaf vcmax + ncan => surfalb_inst%ncan_patch , & ! Output: [integer (:) ] number of canopy layers + nrad => surfalb_inst%nrad_patch , & ! Output: [integer (:) ] number of canopy layers, above snow for radiative transfer + coszen_col => surfalb_inst%coszen_col , & ! Output: [real(r8) (:) ] cosine of solar zenith angle + albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) + albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) + albsod => surfalb_inst%albsod_col , & ! Output: [real(r8) (:,:) ] direct-beam soil albedo (col,bnd) [frc] + albsoi => surfalb_inst%albsoi_col , & ! Output: [real(r8) (:,:) ] diffuse soil albedo (col,bnd) [frc] + albgrd_pur => surfalb_inst%albgrd_pur_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (direct) + albgri_pur => surfalb_inst%albgri_pur_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (diffuse) + albgrd_bc => surfalb_inst%albgrd_bc_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (direct) + albgri_bc => surfalb_inst%albgri_bc_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (diffuse) + albgrd_oc => surfalb_inst%albgrd_oc_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (direct) + albgri_oc => surfalb_inst%albgri_oc_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (diffuse) + albgrd_dst => surfalb_inst%albgrd_dst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (direct) + albgri_dst => surfalb_inst%albgri_dst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (diffuse) + albsnd_hst => surfalb_inst%albsnd_hst_col , & ! Output: [real(r8) (:,:) ] snow albedo, direct, for history files (col,bnd) [frc] + albsni_hst => surfalb_inst%albsni_hst_col , & ! Output: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd) [frc] + albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) + albdSF => surfalb_inst%albdSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (direct) + albiSF => surfalb_inst%albiSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (diffuse) + fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flux + ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flux + ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flux + flx_absdv => surfalb_inst%flx_absdv_col , & ! Output: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): VIS [frc] + flx_absdn => surfalb_inst%flx_absdn_col , & ! Output: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): NIR [frc] + flx_absiv => surfalb_inst%flx_absiv_col , & ! Output: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): VIS [frc] + flx_absin => surfalb_inst%flx_absin_col , & ! Output: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): NIR [frc] + fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + fabi_sha_z => surfalb_inst%fabi_sha_z_patch & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + ) + + ! Cosine solar zenith angle for next time step + + do g = bounds%begg,bounds%endg + coszen_gcell(g) = shr_orb_cosz (nextsw_cday, grc%lat(g), grc%lon(g), declinp1) + end do + do c = bounds%begc,bounds%endc + g = col%gridcell(c) + coszen_col(c) = coszen_gcell(g) + end do + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + g = patch%gridcell(p) + coszen_patch(p) = coszen_gcell(g) + end do + + ! Initialize output because solar radiation only done if coszen > 0 + + do ib = 1, numrad + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + albsod(c,ib) = 0._r8 + albsoi(c,ib) = 0._r8 + albgrd(c,ib) = 0._r8 + albgri(c,ib) = 0._r8 + albgrd_pur(c,ib) = 0._r8 + albgri_pur(c,ib) = 0._r8 + albgrd_bc(c,ib) = 0._r8 + albgri_bc(c,ib) = 0._r8 + albgrd_oc(c,ib) = 0._r8 + albgri_oc(c,ib) = 0._r8 + albgrd_dst(c,ib) = 0._r8 + albgri_dst(c,ib) = 0._r8 + do i=-nlevsno+1,1,1 + flx_absdv(c,i) = 0._r8 + flx_absdn(c,i) = 0._r8 + flx_absiv(c,i) = 0._r8 + flx_absin(c,i) = 0._r8 + enddo + end do + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + albd(p,ib) = 1._r8 + albi(p,ib) = 1._r8 + if (use_SSRE) then + albdSF(p,ib) = 1._r8 + albiSF(p,ib) = 1._r8 + end if + fabd(p,ib) = 0._r8 + fabd_sun(p,ib) = 0._r8 + fabd_sha(p,ib) = 0._r8 + fabi(p,ib) = 0._r8 + fabi_sun(p,ib) = 0._r8 + fabi_sha(p,ib) = 0._r8 + ftdd(p,ib) = 0._r8 + ftid(p,ib) = 0._r8 + ftii(p,ib) = 0._r8 + end do + + end do ! end of numrad loop + + ! SoilAlbedo called before SNICAR_RT + ! so that reflectance of soil beneath snow column is known + ! ahead of time for snow RT calculation. + + ! Snow albedos + ! Note that snow albedo routine will only compute nonzero snow albedos + ! where h2osno> 0 and coszen > 0 + + ! Ground surface albedos + ! Note that ground albedo routine will only compute nonzero snow albedos + ! where coszen > 0 + + call SoilAlbedo(bounds, & + num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + albsnd(bounds%begc:bounds%endc, :), & + albsni(bounds%begc:bounds%endc, :), & + lakestate_inst, temperature_inst, waterstatebulk_inst, surfalb_inst) + + ! set variables to pass to SNICAR. + + flg_snw_ice = 1 ! calling from CLM, not CSIM + do c=bounds%begc,bounds%endc + albsfc(c,:) = albsoi(c,:) + h2osno_liq(c,:) = h2osoi_liq(c,-nlevsno+1:0) + h2osno_ice(c,:) = h2osoi_ice(c,-nlevsno+1:0) + snw_rds_in(c,:) = nint(snw_rds(c,:)) + end do + + ! zero aerosol input arrays + do aer = 1, sno_nbr_aer + do i = -nlevsno+1, 0 + do c = bounds%begc, bounds%endc + mss_cnc_aer_in_frc_pur(c,i,aer) = 0._r8 + mss_cnc_aer_in_frc_bc(c,i,aer) = 0._r8 + mss_cnc_aer_in_frc_oc(c,i,aer) = 0._r8 + mss_cnc_aer_in_frc_dst(c,i,aer) = 0._r8 + mss_cnc_aer_in_fdb(c,i,aer) = 0._r8 + end do + end do + end do + + ! Set aerosol input arrays + ! feedback input arrays have been zeroed + ! set soot and dust aerosol concentrations: + if (DO_SNO_AER) then + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) + + ! DO_SNO_OC is set in SNICAR_varpar. Default case is to ignore OC concentrations because: + ! 1) Knowledge of their optical properties is primitive + ! 2) When 'water-soluble' OPAC optical properties are applied to OC in snow, + ! it has a negligible darkening effect. + if (DO_SNO_OC) then + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) + endif + + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) + endif + + call waterstatebulk_inst%CalculateTotalH2osno(bounds, num_nourbanc, filter_nourbanc, & + caller = 'SurfaceAlbedo', & + h2osno_total = h2osno_total(bounds%begc:bounds%endc)) + + ! If radiative forcing is being calculated, first estimate clean-snow albedo + + if (use_snicar_frc) then + ! 1. BC input array: + ! set dust and (optionally) OC concentrations, so BC_FRC=[(BC+OC+dust)-(OC+dust)] + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) + endif + + ! BC FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd_bc(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni_bc(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + + ! 2. OC input array: + ! set BC and dust concentrations, so OC_FRC=[(BC+OC+dust)-(BC+dust)] + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) + + ! OC FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd_oc(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni_oc(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + endif + + ! 3. DUST input array: + ! set BC and OC concentrations, so DST_FRC=[(BC+OC+dust)-(BC+OC)] + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) + endif + + ! DUST FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd_dst(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni_dst(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + + ! 4. ALL AEROSOL FORCING CALCULATION + ! (pure snow albedo) + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_pur(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd_pur(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_pur(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni_pur(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + end if + + ! CLIMATE FEEDBACK CALCULATIONS, ALL AEROSOLS: + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd(bounds%begc:bounds%endc, :), & + flx_absd_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni(bounds%begc:bounds%endc, :), & + flx_absi_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + + ! ground albedos and snow-fraction weighting of snow absorption factors + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if (coszen_col(c) > 0._r8) then + ! ground albedo was originally computed in SoilAlbedo, but is now computed here + ! because the order of SoilAlbedo and SNICAR_RT was switched for SNICAR. + albgrd(c,ib) = albsod(c,ib)*(1._r8-frac_sno(c)) + albsnd(c,ib)*frac_sno(c) + albgri(c,ib) = albsoi(c,ib)*(1._r8-frac_sno(c)) + albsni(c,ib)*frac_sno(c) + + ! albedos for radiative forcing calculations: + if (use_snicar_frc) then + ! BC forcing albedo + albgrd_bc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_bc(c,ib)*frac_sno(c) + albgri_bc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_bc(c,ib)*frac_sno(c) + + if (DO_SNO_OC) then + ! OC forcing albedo + albgrd_oc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_oc(c,ib)*frac_sno(c) + albgri_oc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_oc(c,ib)*frac_sno(c) + endif + + ! dust forcing albedo + albgrd_dst(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_dst(c,ib)*frac_sno(c) + albgri_dst(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_dst(c,ib)*frac_sno(c) + + ! pure snow albedo for all-aerosol radiative forcing + albgrd_pur(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_pur(c,ib)*frac_sno(c) + albgri_pur(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_pur(c,ib)*frac_sno(c) + end if + + ! also in this loop (but optionally in a different loop for vectorized code) + ! weight snow layer radiative absorption factors based on snow fraction and soil albedo + ! (NEEDED FOR ENERGY CONSERVATION) + do i = -nlevsno+1,1,1 + if (.not. use_subgrid_fluxes .or. lun%itype(col%landunit(c)) == istdlak) then + if (ib == 1) then + flx_absdv(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) + flx_absiv(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) + elseif (ib == 2) then + flx_absdn(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) + flx_absin(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) + endif + else + if (ib == 1) then + flx_absdv(c,i) = flx_absd_snw(c,i,ib) + flx_absiv(c,i) = flx_absi_snw(c,i,ib) + elseif (ib == 2) then + flx_absdn(c,i) = flx_absd_snw(c,i,ib) + flx_absin(c,i) = flx_absi_snw(c,i,ib) + endif + endif + enddo + endif + enddo + enddo + + ! For diagnostics, set snow albedo to spval over non-snow non-urban points + ! so that it is not averaged in history buffer (OPTIONAL) + ! TODO - this is set to 0 not spval - seems wrong since it will be averaged in + + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if ((coszen_col(c) > 0._r8) .and. (h2osno_total(c) > 0._r8)) then + albsnd_hst(c,ib) = albsnd(c,ib) + albsni_hst(c,ib) = albsni(c,ib) + else + albsnd_hst(c,ib) = 0._r8 + albsni_hst(c,ib) = 0._r8 + endif + enddo + enddo + + ! Create solar-vegetated filter for the following calculations + + num_vegsol = 0 + num_novegsol = 0 + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + if (coszen_patch(p) > 0._r8) then + if ((lun%itype(patch%landunit(p)) == istsoil .or. & + lun%itype(patch%landunit(p)) == istcrop ) & + .and. (elai(p) + esai(p)) > 0._r8) then + num_vegsol = num_vegsol + 1 + filter_vegsol(num_vegsol) = p + else + num_novegsol = num_novegsol + 1 + filter_novegsol(num_novegsol) = p + end if + end if + end do + + ! Weight reflectance/transmittance by lai and sai + ! Only perform on vegetated patches where coszen > 0 + + do fp = 1,num_vegsol + p = filter_vegsol(fp) + wl(p) = elai(p) / max( elai(p)+esai(p), mpe ) + ws(p) = esai(p) / max( elai(p)+esai(p), mpe ) + end do + + do ib = 1, numrad + do fp = 1,num_vegsol + p = filter_vegsol(fp) + rho(p,ib) = max( rhol(patch%itype(p),ib)*wl(p) + rhos(patch%itype(p),ib)*ws(p), mpe ) + tau(p,ib) = max( taul(patch%itype(p),ib)*wl(p) + taus(patch%itype(p),ib)*ws(p), mpe ) + end do + end do + + ! Diagnose number of canopy layers for radiative transfer, in increments of dincmax. + ! Add to number of layers so long as cumulative leaf+stem area does not exceed total + ! leaf+stem area. Then add any remaining leaf+stem area to next layer and exit the loop. + ! Do this first for elai and esai (not buried by snow) and then for the part of the + ! canopy that is buried by snow. + ! ------------------ + ! tlai_z = leaf area increment for a layer + ! tsai_z = stem area increment for a layer + ! nrad = number of canopy layers above snow + ! ncan = total number of canopy layers + ! + ! tlai_z summed from 1 to nrad = elai + ! tlai_z summed from 1 to ncan = tlai + + ! tsai_z summed from 1 to nrad = esai + ! tsai_z summed from 1 to ncan = tsai + ! ------------------ + ! + ! Canopy layering needs to be done for all "num_nourbanp" not "num_vegsol" + ! because layering is needed for all time steps regardless of radiation + ! + ! Sun/shade big leaf code uses only one layer (nrad = ncan = 1), triggered by + ! nlevcan = 1 + + dincmax = 0.25_r8 + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + + if (nlevcan == 1) then + nrad(p) = 1 + ncan(p) = 1 + tlai_z(p,1) = elai(p) + tsai_z(p,1) = esai(p) + else if (nlevcan > 1) then + if (elai(p)+esai(p) == 0._r8) then + nrad(p) = 0 + else + dincmax_sum = 0._r8 + do iv = 1, nlevcan + dincmax_sum = dincmax_sum + dincmax + if (((elai(p)+esai(p))-dincmax_sum) > 1.e-06_r8) then + nrad(p) = iv + dinc = dincmax + tlai_z(p,iv) = dinc * elai(p) / max(elai(p)+esai(p), mpe) + tsai_z(p,iv) = dinc * esai(p) / max(elai(p)+esai(p), mpe) + else + nrad(p) = iv + dinc = dincmax - (dincmax_sum - (elai(p)+esai(p))) + tlai_z(p,iv) = dinc * elai(p) / max(elai(p)+esai(p), mpe) + tsai_z(p,iv) = dinc * esai(p) / max(elai(p)+esai(p), mpe) + exit + end if + end do + + ! Mimumum of 4 canopy layers + + if (nrad(p) < 4) then + nrad(p) = 4 + do iv = 1, nrad(p) + tlai_z(p,iv) = elai(p) / nrad(p) + tsai_z(p,iv) = esai(p) / nrad(p) + end do + end if + end if + end if + + ! Error check: make sure cumulative of increments does not exceed total + + laisum = 0._r8 + saisum = 0._r8 + do iv = 1, nrad(p) + laisum = laisum + tlai_z(p,iv) + saisum = saisum + tsai_z(p,iv) + end do + if (abs(laisum-elai(p)) > 1.e-06_r8 .or. abs(saisum-esai(p)) > 1.e-06_r8) then + write (iulog,*) 'multi-layer canopy error 01 in SurfaceAlbedo: ',& + nrad(p),elai(p),laisum,esai(p),saisum + call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) + end if + + ! Repeat to find canopy layers buried by snow + + if (nlevcan > 1) then + blai(p) = tlai(p) - elai(p) + bsai(p) = tsai(p) - esai(p) + if (blai(p)+bsai(p) == 0._r8) then + ncan(p) = nrad(p) + else + dincmax_sum = 0._r8 + do iv = nrad(p)+1, nlevcan + dincmax_sum = dincmax_sum + dincmax + if (((blai(p)+bsai(p))-dincmax_sum) > 1.e-06_r8) then + ncan(p) = iv + dinc = dincmax + tlai_z(p,iv) = dinc * blai(p) / max(blai(p)+bsai(p), mpe) + tsai_z(p,iv) = dinc * bsai(p) / max(blai(p)+bsai(p), mpe) + else + ncan(p) = iv + dinc = dincmax - (dincmax_sum - (blai(p)+bsai(p))) + tlai_z(p,iv) = dinc * blai(p) / max(blai(p)+bsai(p), mpe) + tsai_z(p,iv) = dinc * bsai(p) / max(blai(p)+bsai(p), mpe) + exit + end if + end do + end if + + ! Error check: make sure cumulative of increments does not exceed total + + laisum = 0._r8 + saisum = 0._r8 + do iv = 1, ncan(p) + laisum = laisum + tlai_z(p,iv) + saisum = saisum + tsai_z(p,iv) + end do + if (abs(laisum-tlai(p)) > 1.e-06_r8 .or. abs(saisum-tsai(p)) > 1.e-06_r8) then + write (iulog,*) 'multi-layer canopy error 02 in SurfaceAlbedo: ',nrad(p),ncan(p) + write (iulog,*) tlai(p),elai(p),blai(p),laisum,tsai(p),esai(p),bsai(p),saisum + call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) + end if + end if + + end do + + ! Zero fluxes for active canopy layers + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + do iv = 1, nrad(p) + fabd_sun_z(p,iv) = 0._r8 + fabd_sha_z(p,iv) = 0._r8 + fabi_sun_z(p,iv) = 0._r8 + fabi_sha_z(p,iv) = 0._r8 + fsun_z(p,iv) = 0._r8 + end do + end do + + ! Default leaf to canopy scaling coefficients, used when coszen <= 0. + ! This is the leaf nitrogen profile integrated over the full canopy. + ! Integrate exp(-kn*x) over x=0 to x=elai and assign to shaded canopy, + ! because sunlit fraction is 0. Canopy scaling coefficients are set in + ! TwoStream for coszen > 0. So kn must be set here and in TwoStream. + + extkn = 0.30_r8 + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + if (nlevcan == 1) then + vcmaxcintsun(p) = 0._r8 + vcmaxcintsha(p) = (1._r8 - exp(-extkn*elai(p))) / extkn + if (elai(p) > 0._r8) then + vcmaxcintsha(p) = vcmaxcintsha(p) / elai(p) + else + vcmaxcintsha(p) = 0._r8 + end if + else if (nlevcan > 1) then + vcmaxcintsun(p) = 0._r8 + vcmaxcintsha(p) = 0._r8 + end if + end do + + ! Calculate surface albedos and fluxes + ! Only perform on vegetated pfts where coszen > 0 + + if (use_fates) then + + call clm_fates%wrap_canopy_radiation(bounds, nc, & + num_vegsol, filter_vegsol, & + coszen_patch(bounds%begp:bounds%endp), surfalb_inst) + + else + + call TwoStream (bounds, filter_vegsol, num_vegsol, & + coszen_patch(bounds%begp:bounds%endp), & + rho(bounds%begp:bounds%endp, :), & + tau(bounds%begp:bounds%endp, :), & + canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst) + ! Run TwoStream again just to calculate the Snow Free (SF) albedo's + if (use_SSRE) then + if ( nlevcan > 1 )then + call endrun( 'ERROR: use_ssre option was NOT developed with allowance for multi-layer canopy: '// & + 'nlevcan can ONLY be 1 in when use_ssre is on') + end if + call TwoStream (bounds, filter_vegsol, num_vegsol, & + coszen_patch(bounds%begp:bounds%endp), & + rho(bounds%begp:bounds%endp, :), & + tau(bounds%begp:bounds%endp, :), & + canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst, & + SFonly=.true.) + end if + + endif + + ! Determine values for non-vegetated patches where coszen > 0 + + do ib = 1,numrad + do fp = 1,num_novegsol + p = filter_novegsol(fp) + c = patch%column(p) + fabd(p,ib) = 0._r8 + fabd_sun(p,ib) = 0._r8 + fabd_sha(p,ib) = 0._r8 + fabi(p,ib) = 0._r8 + fabi_sun(p,ib) = 0._r8 + fabi_sha(p,ib) = 0._r8 + ftdd(p,ib) = 1._r8 + ftid(p,ib) = 0._r8 + ftii(p,ib) = 1._r8 + albd(p,ib) = albgrd(c,ib) + albi(p,ib) = albgri(c,ib) + if (use_SSRE) then + albdSF(p,ib) = albsod(c,ib) + albiSF(p,ib) = albsoi(c,ib) + end if + end do + end do + + end associate + + end subroutine SurfaceAlbedo + + !----------------------------------------------------------------------- + subroutine SoilAlbedo (bounds, & + num_nourbanc, filter_nourbanc, & + coszen, albsnd, albsni, & + lakestate_inst, temperature_inst, waterstatebulk_inst, surfalb_inst) + ! + ! !DESCRIPTION: + ! Determine ground surface albedo, accounting for snow + ! + ! !USES: + use clm_varpar , only : numrad + use clm_varcon , only : tfrz + use landunit_varcon , only : istice_mec, istdlak + use LakeCon , only : lakepuddling + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nourbanc ! number of columns in non-urban points in column filter + integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points + real(r8), intent(in) :: coszen( bounds%begc: ) ! cos solar zenith angle next time step [col] + real(r8), intent(in) :: albsnd( bounds%begc: , 1: ) ! snow albedo (direct) [col, numrad] + real(r8), intent(in) :: albsni( bounds%begc: , 1: ) ! snow albedo (diffuse) [col, numrad] + type(temperature_type) , intent(in) :: temperature_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(lakestate_type) , intent(in) :: lakestate_inst + type(surfalb_type) , intent(inout) :: surfalb_inst + ! + ! !LOCAL VARIABLES: + ! + integer, parameter :: nband =numrad ! number of solar radiation waveband classes + integer :: fc ! non-urban filter column index + integer :: c,l ! indices + integer :: ib ! waveband number (1=vis, 2=nir) + real(r8) :: inc ! soil water correction factor for soil albedo + integer :: soilcol ! soilcolor + real(r8) :: sicefr ! Lake surface ice fraction (based on D. Mironov 2010) + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(coszen) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(albsnd) == (/bounds%endc, numrad/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(albsni) == (/bounds%endc, numrad/)), sourcefile, __LINE__) + + associate(& + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + + h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water [m3/m3] + + lake_icefrac => lakestate_inst%lake_icefrac_col , & ! Input: [real(r8) (:,:) ] mass fraction of lake layer that is frozen + + albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) + albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) + albsod => surfalb_inst%albsod_col , & ! Output: [real(r8) (:,:) ] soil albedo (direct) + albsoi => surfalb_inst%albsoi_col & ! Output: [real(r8) (:,:) ] soil albedo (diffuse) + ) + + ! Compute soil albedos + + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if (coszen(c) > 0._r8) then + l = col%landunit(c) + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then ! soil + inc = max(0.11_r8-0.40_r8*h2osoi_vol(c,1), 0._r8) + soilcol = isoicol(c) + ! changed from local variable to clm_type: + !albsod = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) + !albsoi = albsod + albsod(c,ib) = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) + albsoi(c,ib) = albsod(c,ib) + else if (lun%itype(l) == istice_mec) then ! land ice + ! changed from local variable to clm_type: + !albsod = albice(ib) + !albsoi = albsod + albsod(c,ib) = albice(ib) + albsoi(c,ib) = albsod(c,ib) + ! unfrozen lake, wetland + else if (t_grnd(c) > tfrz .or. (lakepuddling .and. lun%itype(l) == istdlak .and. t_grnd(c) == tfrz .and. & + lake_icefrac(c,1) < 1._r8 .and. lake_icefrac(c,2) > 0._r8) ) then + + albsod(c,ib) = 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8) + ! This expression is apparently from BATS according to Yongjiu Dai. + + ! The diffuse albedo should be an average over the whole sky of an angular-dependent direct expression. + ! The expression above may have been derived to encompass both (e.g. Henderson-Sellers 1986), + ! but I'll assume it applies more appropriately to the direct form for now. + + ! ZMS: Attn EK, currently restoring this for wetlands even though it is wrong in order to try to get + ! bfb baseline comparison when no lakes are present. I'm assuming wetlands will be phased out anyway. + if (lun%itype(l) == istdlak) then + albsoi(c,ib) = 0.10_r8 + else + albsoi(c,ib) = albsod(c,ib) + end if + + else ! frozen lake, wetland + ! Introduce crude surface frozen fraction according to D. Mironov (2010) + ! Attn EK: This formulation is probably just as good for "wetlands" if they are not phased out. + ! Tenatively I'm restricting this to lakes because I haven't tested it for wetlands. But if anything + ! the albedo should be lower when melting over frozen ground than a solid frozen lake. + ! + if (lun%itype(l) == istdlak .and. .not. lakepuddling .and. snl(c) == 0) then + ! Need to reference snow layers here because t_grnd could be over snow or ice + ! but we really want the ice surface temperature with no snow + sicefr = 1._r8 - exp(-calb * (tfrz - t_grnd(c))/tfrz) + albsod(c,ib) = sicefr*alblak(ib) + (1._r8-sicefr)*max(alblakwi(ib), & + 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8)) + albsoi(c,ib) = sicefr*alblak(ib) + (1._r8-sicefr)*max(alblakwi(ib), 0.10_r8) + ! Make sure this is no less than the open water albedo above. + ! Setting lake_melt_icealb(:) = alblak(:) in namelist reverts the melting albedo to the cold + ! snow-free value. + else + albsod(c,ib) = alblak(ib) + albsoi(c,ib) = albsod(c,ib) + end if + end if + + ! Weighting is done in SurfaceAlbedo, after the call to SNICAR_RT + ! This had to be done, because SoilAlbedo is called before SNICAR_RT, so at + ! this point, snow albedo is not yet known. + end if + end do + end do + + end associate + end subroutine SoilAlbedo + + !----------------------------------------------------------------------- + subroutine TwoStream (bounds, & + filter_vegsol, num_vegsol, & + coszen, rho, tau, & + canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst, & + SFonly) + ! + ! !DESCRIPTION: + ! Two-stream fluxes for canopy radiative transfer + ! Use two-stream approximation of Dickinson (1983) Adv Geophysics + ! 25:305-353 and Sellers (1985) Int J Remote Sensing 6:1335-1372 + ! to calculate fluxes absorbed by vegetation, reflected by vegetation, + ! and transmitted through vegetation for unit incoming direct or diffuse + ! flux given an underlying surface with known albedo. + ! Calculate sunlit and shaded fluxes as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy to calculate APAR profile + ! + ! !USES: + use clm_varpar, only : numrad, nlevcan + use clm_varcon, only : omegas, tfrz, betads, betais + use clm_varctl, only : iulog + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: filter_vegsol (:) ! filter for vegetated patches with coszen>0 + integer , intent(in) :: num_vegsol ! number of vegetated patches where coszen>0 + real(r8), intent(in) :: coszen( bounds%begp: ) ! cosine solar zenith angle for next time step [pft] + real(r8), intent(in) :: rho( bounds%begp: , 1: ) ! leaf/stem refl weighted by fraction LAI and SAI [pft, numrad] + real(r8), intent(in) :: tau( bounds%begp: , 1: ) ! leaf/stem tran weighted by fraction LAI and SAI [pft, numrad] + type(canopystate_type) , intent(in) :: canopystate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(surfalb_type) , intent(inout) :: surfalb_inst + logical, optional , intent(in) :: SFonly ! If should just calculate the Snow Free albedos + ! + ! !LOCAL VARIABLES: + integer :: fp,p,c,iv ! array indices + integer :: ib ! waveband number + real(r8) :: cosz ! 0.001 <= coszen <= 1.000 + real(r8) :: asu ! single scattering albedo + real(r8) :: chil(bounds%begp:bounds%endp) ! -0.4 <= xl <= 0.6 + real(r8) :: gdir(bounds%begp:bounds%endp) ! leaf projection in solar direction (0 to 1) + real(r8) :: twostext(bounds%begp:bounds%endp)! optical depth of direct beam per unit leaf area + real(r8) :: avmu(bounds%begp:bounds%endp) ! average diffuse optical depth + real(r8) :: omega(bounds%begp:bounds%endp,numrad) ! fraction of intercepted radiation that is scattered (0 to 1) + real(r8) :: omegal ! omega for leaves + real(r8) :: betai ! upscatter parameter for diffuse radiation + real(r8) :: betail ! betai for leaves + real(r8) :: betad ! upscatter parameter for direct beam radiation + real(r8) :: betadl ! betad for leaves + real(r8) :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 ! temporary + real(r8) :: p1,p2,p3,p4,s1,s2,u1,u2,u3 ! temporary + real(r8) :: b,c1,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 ! temporary + real(r8) :: phi1,phi2,sigma ! temporary + real(r8) :: temp1 ! temporary + real(r8) :: temp0 (bounds%begp:bounds%endp) ! temporary + real(r8) :: temp2(bounds%begp:bounds%endp) ! temporary + real(r8) :: t1 ! temporary + real(r8) :: a1,a2 ! parameter for sunlit/shaded leaf radiation absorption + real(r8) :: v,dv,u,du ! temporary for flux derivatives + real(r8) :: dh2,dh3,dh5,dh6,dh7,dh8,dh9,dh10 ! temporary for flux derivatives + real(r8) :: da1,da2 ! temporary for flux derivatives + real(r8) :: d_ftid,d_ftii ! ftid, ftii derivative with respect to lai+sai + real(r8) :: d_fabd,d_fabi ! fabd, fabi derivative with respect to lai+sai + real(r8) :: d_fabd_sun,d_fabd_sha ! fabd_sun, fabd_sha derivative with respect to lai+sai + real(r8) :: d_fabi_sun,d_fabi_sha ! fabi_sun, fabi_sha derivative with respect to lai+sai + real(r8) :: laisum ! cumulative lai+sai for canopy layer (at middle of layer) + real(r8) :: extkb ! direct beam extinction coefficient + real(r8) :: extkn ! nitrogen allocation coefficient + logical :: lSFonly ! Local version of SFonly (Snow Free) flag + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(coszen) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(rho) == (/bounds%endp, numrad/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(tau) == (/bounds%endp, numrad/)), sourcefile, __LINE__) + + if ( present(SFonly) )then + lSFonly = SFonly + else + lSFonly = .false. + end if + + associate(& + xl => pftcon%xl , & ! Input: ecophys const - leaf/stem orientation index + + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + + fwet => waterdiagnosticbulk_inst%fwet_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is wet (0 to 1) + fcansno => waterdiagnosticbulk_inst%fcansno_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is snow-covered (0 to 1) + + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + + tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] tlai increment for canopy layer + tsai_z => surfalb_inst%tsai_z_patch , & ! Input: [real(r8) (:,:) ] tsai increment for canopy layer + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer + albgrd => surfalb_inst%albgrd_col , & ! Input: [real(r8) (:,:) ] ground albedo (direct) (column-level) + albgri => surfalb_inst%albgri_col , & ! Input: [real(r8) (:,:) ] ground albedo (diffuse)(column-level) + + ! For non-Snow Free + fsun_z => surfalb_inst%fsun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer + vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, sunlit leaf vcmax + vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, shaded leaf vcmax + fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + fabi_sha_z => surfalb_inst%fabi_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) + fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flx + ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flx + ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flx + + ! Needed for SF Snow free case + albsod => surfalb_inst%albsod_col , & ! Input: [real(r8) (:,:) ] soil albedo (direct) + albsoi => surfalb_inst%albsoi_col , & ! Input: [real(r8) (:,:) ] soil albedo (diffuse) + albdSF => surfalb_inst%albdSF_patch , & ! Output: [real(r8) (:,:) ] Snow Free surface albedo (direct) + albiSF => surfalb_inst%albiSF_patch & ! Output: [real(r8) (:,:) ] Snow Free surface albedo (diffuse) + ) + + ! Calculate two-stream parameters that are independent of waveband: + ! chil, gdir, twostext, avmu, and temp0 and temp2 (used for asu) + + do fp = 1,num_vegsol + p = filter_vegsol(fp) + + ! note that the following limit only acts on cosz values > 0 and less than + ! 0.001, not on values cosz = 0, since these zero have already been filtered + ! out in filter_vegsol + cosz = max(0.001_r8, coszen(p)) + + chil(p) = min( max(xl(patch%itype(p)), -0.4_r8), 0.6_r8 ) + if (abs(chil(p)) <= 0.01_r8) chil(p) = 0.01_r8 + phi1 = 0.5_r8 - 0.633_r8*chil(p) - 0.330_r8*chil(p)*chil(p) + phi2 = 0.877_r8 * (1._r8-2._r8*phi1) + gdir(p) = phi1 + phi2*cosz + twostext(p) = gdir(p)/cosz + avmu(p) = ( 1._r8 - phi1/phi2 * log((phi1+phi2)/phi1) ) / phi2 + ! Restrict this calculation of temp0. We have seen cases where small temp0 + ! can cause unrealistic single scattering albedo (asu) associated with the + ! log calculation in temp2 below, thereby eventually causing a negative soil albedo + ! See bugzilla bug 2431: http://bugs.cgd.ucar.edu/show_bug.cgi?id=2431 + temp0(p) = max(gdir(p) + phi2*cosz,1.e-6_r8) + temp1 = phi1*cosz + temp2(p) = ( 1._r8 - temp1/temp0(p) * log((temp1+temp0(p))/temp1) ) + end do + + ! Loop over all wavebands to calculate for the full canopy the scattered fluxes + ! reflected upward and transmitted downward by the canopy and the flux absorbed by the + ! canopy for a unit incoming direct beam and diffuse flux at the top of the canopy given + ! an underlying surface of known albedo. + ! + ! Output: + ! ------------------ + ! Direct beam fluxes + ! ------------------ + ! albd - Upward scattered flux above canopy (per unit direct beam flux) + ! ftid - Downward scattered flux below canopy (per unit direct beam flux) + ! ftdd - Transmitted direct beam flux below canopy (per unit direct beam flux) + ! fabd - Flux absorbed by canopy (per unit direct beam flux) + ! fabd_sun - Sunlit portion of fabd + ! fabd_sha - Shaded portion of fabd + ! fabd_sun_z - absorbed sunlit leaf direct PAR (per unit sunlit lai+sai) for each canopy layer + ! fabd_sha_z - absorbed shaded leaf direct PAR (per unit shaded lai+sai) for each canopy layer + ! ------------------ + ! Diffuse fluxes + ! ------------------ + ! albi - Upward scattered flux above canopy (per unit diffuse flux) + ! ftii - Downward scattered flux below canopy (per unit diffuse flux) + ! fabi - Flux absorbed by canopy (per unit diffuse flux) + ! fabi_sun - Sunlit portion of fabi + ! fabi_sha - Shaded portion of fabi + ! fabi_sun_z - absorbed sunlit leaf diffuse PAR (per unit sunlit lai+sai) for each canopy layer + ! fabi_sha_z - absorbed shaded leaf diffuse PAR (per unit shaded lai+sai) for each canopy layer + + do ib = 1, numrad + do fp = 1,num_vegsol + p = filter_vegsol(fp) + c = patch%column(p) + + ! Calculate two-stream parameters omega, betad, and betai. + ! Omega, betad, betai are adjusted for snow. Values for omega*betad + ! and omega*betai are calculated and then divided by the new omega + ! because the product omega*betai, omega*betad is used in solution. + ! Also, the transmittances and reflectances (tau, rho) are linear + ! weights of leaf and stem values. + + omegal = rho(p,ib) + tau(p,ib) + asu = 0.5_r8*omegal*gdir(p)/temp0(p) *temp2(p) + betadl = (1._r8+avmu(p)*twostext(p))/(omegal*avmu(p)*twostext(p))*asu + betail = 0.5_r8 * ((rho(p,ib)+tau(p,ib)) + (rho(p,ib)-tau(p,ib)) & + * ((1._r8+chil(p))/2._r8)**2) / omegal + + if ( lSFonly .or. ( (.not. snowveg_affects_radiation) .and. (t_veg(p) > tfrz) ) ) then + ! Keep omega, betad, and betai as they are (for Snow free case or + ! when there is no snow + tmp0 = omegal + tmp1 = betadl + tmp2 = betail + else + ! Adjust omega, betad, and betai for intercepted snow + if (snowveg_affects_radiation) then + tmp0 = (1._r8-fcansno(p))*omegal + fcansno(p)*omegas(ib) + tmp1 = ( (1._r8-fcansno(p))*omegal*betadl + fcansno(p)*omegas(ib)*betads ) / tmp0 + tmp2 = ( (1._r8-fcansno(p))*omegal*betail + fcansno(p)*omegas(ib)*betais ) / tmp0 + else + tmp0 = (1._r8-fwet(p))*omegal + fwet(p)*omegas(ib) + tmp1 = ( (1._r8-fwet(p))*omegal*betadl + fwet(p)*omegas(ib)*betads ) / tmp0 + tmp2 = ( (1._r8-fwet(p))*omegal*betail + fwet(p)*omegas(ib)*betais ) / tmp0 + end if + end if ! end Snow free + + omega(p,ib) = tmp0 + betad = tmp1 + betai = tmp2 + + ! Common terms + + b = 1._r8 - omega(p,ib) + omega(p,ib)*betai + c1 = omega(p,ib)*betai + tmp0 = avmu(p)*twostext(p) + d = tmp0 * omega(p,ib)*betad + f = tmp0 * omega(p,ib)*(1._r8-betad) + tmp1 = b*b - c1*c1 + h = sqrt(tmp1) / avmu(p) + sigma = tmp0*tmp0 - tmp1 + p1 = b + avmu(p)*h + p2 = b - avmu(p)*h + p3 = b + tmp0 + p4 = b - tmp0 + + ! Absorbed, reflected, transmitted fluxes per unit incoming radiation + ! for full canopy + + t1 = min(h*(elai(p)+esai(p)), 40._r8) + s1 = exp(-t1) + t1 = min(twostext(p)*(elai(p)+esai(p)), 40._r8) + s2 = exp(-t1) + + ! Direct beam + if ( .not. lSFonly )then + u1 = b - c1/albgrd(c,ib) + u2 = b - c1*albgrd(c,ib) + u3 = f + c1*albgrd(c,ib) + else + ! Snow Free (SF) only + ! albsod instead of albgrd here: + u1 = b - c1/albsod(c,ib) + u2 = b - c1*albsod(c,ib) + u3 = f + c1*albsod(c,ib) + end if + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h1 = -d*p4 - c1*f + tmp6 = d - h1*p3/sigma + tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2 + h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1 + h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1 + h4 = -f*p3 - c1*d + tmp8 = h4/sigma + tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2 + h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2 + h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2 + if ( .not. lSFonly )then + albd(p,ib) = h1/sigma + h2 + h3 + ftid(p,ib) = h4*s2/sigma + h5*s1 + h6/s1 + ftdd(p,ib) = s2 + fabd(p,ib) = 1._r8 - albd(p,ib) - (1._r8-albgrd(c,ib))*ftdd(p,ib) - (1._r8-albgri(c,ib))*ftid(p,ib) + else + albdSF(p,ib) = h1/sigma + h2 + h3 + end if + + + a1 = h1 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & + + h2 * (1._r8 - s2*s1) / (twostext(p) + h) & + + h3 * (1._r8 - s2/s1) / (twostext(p) - h) + + a2 = h4 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & + + h5 * (1._r8 - s2*s1) / (twostext(p) + h) & + + h6 * (1._r8 - s2/s1) / (twostext(p) - h) + if ( .not. lSFonly )then + fabd_sun(p,ib) = (1._r8 - omega(p,ib)) * ( 1._r8 - s2 + 1._r8 / avmu(p) * (a1 + a2) ) + fabd_sha(p,ib) = fabd(p,ib) - fabd_sun(p,ib) + end if + + ! Diffuse + if ( .not. lSFonly )then + u1 = b - c1/albgri(c,ib) + u2 = b - c1*albgri(c,ib) + else + ! Snow Free (SF) only + ! albsoi instead of albgri here: + u1 = b - c1/albsoi(c,ib) + u2 = b - c1*albsoi(c,ib) + end if + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h7 = (c1*tmp2) / (d1*s1) + h8 = (-c1*tmp3*s1) / d1 + h9 = tmp4 / (d2*s1) + h10 = (-tmp5*s1) / d2 + + + ! Final Snow Free albedo + if ( lSFonly )then + albiSF(p,ib) = h7 + h8 + else + ! For non snow Free case, adjustments continue + albi(p,ib) = h7 + h8 + ftii(p,ib) = h9*s1 + h10/s1 + fabi(p,ib) = 1._r8 - albi(p,ib) - (1._r8-albgri(c,ib))*ftii(p,ib) + + a1 = h7 * (1._r8 - s2*s1) / (twostext(p) + h) + h8 * (1._r8 - s2/s1) / (twostext(p) - h) + a2 = h9 * (1._r8 - s2*s1) / (twostext(p) + h) + h10 * (1._r8 - s2/s1) / (twostext(p) - h) + + fabi_sun(p,ib) = (1._r8 - omega(p,ib)) / avmu(p) * (a1 + a2) + fabi_sha(p,ib) = fabi(p,ib) - fabi_sun(p,ib) + + ! Repeat two-stream calculations for each canopy layer to calculate derivatives. + ! tlai_z and tsai_z are the leaf+stem area increment for a layer. Derivatives are + ! calculated at the center of the layer. Derivatives are needed only for the + ! visible waveband to calculate absorbed PAR (per unit lai+sai) for each canopy layer. + ! Derivatives are calculated first per unit lai+sai and then normalized for sunlit + ! or shaded fraction of canopy layer. + + ! Sun/shade big leaf code uses only one layer, with canopy integrated values from above + ! and also canopy-integrated scaling coefficients + + if (ib == 1) then + if (nlevcan == 1) then + + ! sunlit fraction of canopy + fsun_z(p,1) = (1._r8 - s2) / t1 + + ! absorbed PAR (per unit sun/shade lai+sai) + laisum = elai(p)+esai(p) + fabd_sun_z(p,1) = fabd_sun(p,ib) / (fsun_z(p,1)*laisum) + fabi_sun_z(p,1) = fabi_sun(p,ib) / (fsun_z(p,1)*laisum) + fabd_sha_z(p,1) = fabd_sha(p,ib) / ((1._r8 - fsun_z(p,1))*laisum) + fabi_sha_z(p,1) = fabi_sha(p,ib) / ((1._r8 - fsun_z(p,1))*laisum) + + ! leaf to canopy scaling coefficients + extkn = 0.30_r8 + extkb = twostext(p) + vcmaxcintsun(p) = (1._r8 - exp(-(extkn+extkb)*elai(p))) / (extkn + extkb) + vcmaxcintsha(p) = (1._r8 - exp(-extkn*elai(p))) / extkn - vcmaxcintsun(p) + if (elai(p) > 0._r8) then + vcmaxcintsun(p) = vcmaxcintsun(p) / (fsun_z(p,1)*elai(p)) + vcmaxcintsha(p) = vcmaxcintsha(p) / ((1._r8 - fsun_z(p,1))*elai(p)) + else + vcmaxcintsun(p) = 0._r8 + vcmaxcintsha(p) = 0._r8 + end if + + else if (nlevcan > 1)then + do iv = 1, nrad(p) + + ! Cumulative lai+sai at center of layer + + if (iv == 1) then + laisum = 0.5_r8 * (tlai_z(p,iv)+tsai_z(p,iv)) + else + laisum = laisum + 0.5_r8 * ((tlai_z(p,iv-1)+tsai_z(p,iv-1))+(tlai_z(p,iv)+tsai_z(p,iv))) + end if + + ! Coefficients s1 and s2 depend on cumulative lai+sai. s2 is the sunlit fraction + + t1 = min(h*laisum, 40._r8) + s1 = exp(-t1) + t1 = min(twostext(p)*laisum, 40._r8) + s2 = exp(-t1) + fsun_z(p,iv) = s2 + + ! =============== + ! Direct beam + ! =============== + + ! Coefficients h1-h6 and a1,a2 depend of cumulative lai+sai + + u1 = b - c1/albgrd(c,ib) + u2 = b - c1*albgrd(c,ib) + u3 = f + c1*albgrd(c,ib) + + ! Derivatives for h2, h3, h5, h6 and a1, a2 + + v = d1 + dv = h * p1 * tmp2 / s1 + h * p2 * tmp3 * s1 + + u = tmp6 * tmp2 / s1 - p2 * tmp7 + du = h * tmp6 * tmp2 / s1 + twostext(p) * p2 * tmp7 + dh2 = (v * du - u * dv) / (v * v) + + u = -tmp6 * tmp3 * s1 + p1 * tmp7 + du = h * tmp6 * tmp3 * s1 - twostext(p) * p1 * tmp7 + dh3 = (v * du - u * dv) / (v * v) + + v = d2 + dv = h * tmp4 / s1 + h * tmp5 * s1 + + u = -h4/sigma * tmp4 / s1 - tmp9 + du = -h * h4/sigma * tmp4 / s1 + twostext(p) * tmp9 + dh5 = (v * du - u * dv) / (v * v) + + u = h4/sigma * tmp5 * s1 + tmp9 + du = -h * h4/sigma * tmp5 * s1 - twostext(p) * tmp9 + dh6 = (v * du - u * dv) / (v * v) + + da1 = h1/sigma * s2*s2 + h2 * s2*s1 + h3 * s2/s1 & + + (1._r8 - s2*s1) / (twostext(p) + h) * dh2 & + + (1._r8 - s2/s1) / (twostext(p) - h) * dh3 + da2 = h4/sigma * s2*s2 + h5 * s2*s1 + h6 * s2/s1 & + + (1._r8 - s2*s1) / (twostext(p) + h) * dh5 & + + (1._r8 - s2/s1) / (twostext(p) - h) * dh6 + + ! Flux derivatives + + d_ftid = -twostext(p)*h4/sigma*s2 - h*h5*s1 + h*h6/s1 + dh5*s1 + dh6/s1 + d_fabd = -(dh2+dh3) + (1._r8-albgrd(c,ib))*twostext(p)*s2 - (1._r8-albgri(c,ib))*d_ftid + d_fabd_sun = (1._r8 - omega(p,ib)) * (twostext(p)*s2 + 1._r8 / avmu(p) * (da1 + da2)) + d_fabd_sha = d_fabd - d_fabd_sun + + fabd_sun_z(p,iv) = max(d_fabd_sun, 0._r8) + fabd_sha_z(p,iv) = max(d_fabd_sha, 0._r8) + + ! Flux derivatives are APARsun and APARsha per unit (LAI+SAI). Need + ! to normalize derivatives by sunlit or shaded fraction to get + ! APARsun per unit (LAI+SAI)sun and APARsha per unit (LAI+SAI)sha + + fabd_sun_z(p,iv) = fabd_sun_z(p,iv) / fsun_z(p,iv) + fabd_sha_z(p,iv) = fabd_sha_z(p,iv) / (1._r8 - fsun_z(p,iv)) + + ! =============== + ! Diffuse + ! =============== + + ! Coefficients h7-h10 and a1,a2 depend of cumulative lai+sai + + u1 = b - c1/albgri(c,ib) + u2 = b - c1*albgri(c,ib) + + a1 = h7 * (1._r8 - s2*s1) / (twostext(p) + h) + h8 * (1._r8 - s2/s1) / (twostext(p) - h) + a2 = h9 * (1._r8 - s2*s1) / (twostext(p) + h) + h10 * (1._r8 - s2/s1) / (twostext(p) - h) + + ! Derivatives for h7, h8, h9, h10 and a1, a2 + + v = d1 + dv = h * p1 * tmp2 / s1 + h * p2 * tmp3 * s1 + + u = c1 * tmp2 / s1 + du = h * c1 * tmp2 / s1 + dh7 = (v * du - u * dv) / (v * v) + + u = -c1 * tmp3 * s1 + du = h * c1 * tmp3 * s1 + dh8 = (v * du - u * dv) / (v * v) + + v = d2 + dv = h * tmp4 / s1 + h * tmp5 * s1 + + u = tmp4 / s1 + du = h * tmp4 / s1 + dh9 = (v * du - u * dv) / (v * v) + + u = -tmp5 * s1 + du = h * tmp5 * s1 + dh10 = (v * du - u * dv) / (v * v) + + da1 = h7*s2*s1 + h8*s2/s1 + (1._r8-s2*s1)/(twostext(p)+h)*dh7 + (1._r8-s2/s1)/(twostext(p)-h)*dh8 + da2 = h9*s2*s1 + h10*s2/s1 + (1._r8-s2*s1)/(twostext(p)+h)*dh9 + (1._r8-s2/s1)/(twostext(p)-h)*dh10 + + ! Flux derivatives + + d_ftii = -h * h9 * s1 + h * h10 / s1 + dh9 * s1 + dh10 / s1 + d_fabi = -(dh7+dh8) - (1._r8-albgri(c,ib))*d_ftii + d_fabi_sun = (1._r8 - omega(p,ib)) / avmu(p) * (da1 + da2) + d_fabi_sha = d_fabi - d_fabi_sun + + fabi_sun_z(p,iv) = max(d_fabi_sun, 0._r8) + fabi_sha_z(p,iv) = max(d_fabi_sha, 0._r8) + + ! Flux derivatives are APARsun and APARsha per unit (LAI+SAI). Need + ! to normalize derivatives by sunlit or shaded fraction to get + ! APARsun per unit (LAI+SAI)sun and APARsha per unit (LAI+SAI)sha + + fabi_sun_z(p,iv) = fabi_sun_z(p,iv) / fsun_z(p,iv) + fabi_sha_z(p,iv) = fabi_sha_z(p,iv) / (1._r8 - fsun_z(p,iv)) + + end do ! end of iv loop + end if ! nlevcan + end if ! first band + end if ! NOT lSFonly + + end do ! end of pft loop + end do ! end of radiation band loop + + end associate + +end subroutine TwoStream + +end module SurfaceAlbedoMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 new file mode 100644 index 000000000..e14c31dc6 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 @@ -0,0 +1,1025 @@ +module SurfaceRadiationMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Calculate solar fluxes absorbed by vegetation and ground surface + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : use_snicar_frc, use_fates + use decompMod , only : bounds_type + use clm_varcon , only : namec + use atm2lndType , only : atm2lnd_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use CanopyStateType , only : canopystate_type + use SurfaceAlbedoType , only : surfalb_type + use SolarAbsorbedType , only : solarabs_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use landunit_varcon , only : istdlak + + ! !PRIVATE TYPES: + implicit none + private + + logical, parameter :: local_debug = .false. ! for debugging this module + + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SurfaceRadiation ! Solar fluxes absorbed by veg and ground surface + public :: CanopySunShadeFracs ! Sun/Shade fractions and some area indices computations + + ! + ! !PRIVATE DATA: + type, public :: surfrad_type + real(r8), pointer, private :: sfc_frc_aer_patch (:) ! patch surface forcing of snow with all aerosols (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_bc_patch (:) ! patch surface forcing of snow with BC (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_oc_patch (:) ! patch surface forcing of snow with OC (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_dst_patch (:) ! patch surface forcing of snow with dust (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_aer_sno_patch (:) ! patch surface forcing of snow with all aerosols, averaged only when snow is present (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_bc_sno_patch (:) ! patch surface forcing of snow with BC, averaged only when snow is present (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_oc_sno_patch (:) ! patch surface forcing of snow with OC, averaged only when snow is present (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_dst_sno_patch (:) ! patch surface forcing of snow with dust, averaged only when snow is present (patch) [W/m2] + + real(r8), pointer, private :: parveg_ln_patch (:) ! patch absorbed par by vegetation at local noon (W/m**2) + + real(r8), pointer, private :: fsr_sno_vd_patch (:) ! patch reflected direct beam vis solar radiation from snow (W/m**2) + real(r8), pointer, private :: fsr_sno_nd_patch (:) ! patch reflected direct beam NIR solar radiation from snow (W/m**2) + real(r8), pointer, private :: fsr_sno_vi_patch (:) ! patch reflected diffuse vis solar radiation from snow (W/m**2) + real(r8), pointer, private :: fsr_sno_ni_patch (:) ! patch reflected diffuse NIR solar radiation from snow (W/m**2) + + real(r8), pointer, private :: fsr_vis_d_patch (:) ! patch reflected direct beam vis solar radiation (W/m**2) + real(r8), pointer, private :: fsr_vis_i_patch (:) ! patch reflected diffuse vis solar radiation (W/m**2) + real(r8), pointer, private :: fsr_vis_d_ln_patch (:) ! patch reflected direct beam vis solar radiation at local noon (W/m**2) + ! diagnostic fluxes: + real(r8), pointer, private :: fsrSF_vis_d_patch (:) ! snow-free patch reflected direct beam vis solar radiation (W/m**2) + real(r8), pointer, private :: fsrSF_vis_i_patch (:) ! snow-free patch reflected diffuse vis solar radiation (W/m**2) + real(r8), pointer, private :: fsrSF_vis_d_ln_patch (:) ! snow-free patch reflected direct beam vis solar radiation at local noon (W/m**2) + real(r8), pointer, private :: ssre_fsr_vis_d_patch (:) ! snow radiative effect + real(r8), pointer, private :: ssre_fsr_vis_i_patch (:) ! snow radiative effect + real(r8), pointer, private :: ssre_fsr_vis_d_ln_patch(:)! snow radiative effect + real(r8), pointer, private :: fsds_sno_vd_patch (:) ! patch incident visible, direct radiation on snow (for history files) [W/m2] + real(r8), pointer, private :: fsds_sno_nd_patch (:) ! patch incident near-IR, direct radiation on snow (for history files) [W/m2] + real(r8), pointer, private :: fsds_sno_vi_patch (:) ! patch incident visible, diffuse radiation on snow (for history files) [W/m2] + real(r8), pointer, private :: fsds_sno_ni_patch (:) ! patch incident near-IR, diffuse radiation on snow (for history files) [W/m2] + + real(r8), pointer, private :: fsds_vis_d_patch (:) ! patch incident direct beam vis solar radiation (W/m**2) + real(r8), pointer, private :: fsds_vis_i_patch (:) ! patch incident diffuse vis solar radiation (W/m**2) + real(r8), pointer, private :: fsds_vis_d_ln_patch (:) ! patch incident direct beam vis solar radiation at local noon (W/m**2) + real(r8), pointer, private :: fsds_vis_i_ln_patch (:) ! patch incident diffuse beam vis solar radiation at local noon (W/m**2) + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type surfrad_type + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(surfrad_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(surfrad_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + allocate(this%sfc_frc_aer_patch (begp:endp)) ; this%sfc_frc_aer_patch (:) = nan + allocate(this%sfc_frc_bc_patch (begp:endp)) ; this%sfc_frc_bc_patch (:) = nan + allocate(this%sfc_frc_oc_patch (begp:endp)) ; this%sfc_frc_oc_patch (:) = nan + allocate(this%sfc_frc_dst_patch (begp:endp)) ; this%sfc_frc_dst_patch (:) = nan + allocate(this%sfc_frc_aer_sno_patch (begp:endp)) ; this%sfc_frc_aer_sno_patch (:) = nan + allocate(this%sfc_frc_bc_sno_patch (begp:endp)) ; this%sfc_frc_bc_sno_patch (:) = nan + allocate(this%sfc_frc_oc_sno_patch (begp:endp)) ; this%sfc_frc_oc_sno_patch (:) = nan + allocate(this%sfc_frc_dst_sno_patch (begp:endp)) ; this%sfc_frc_dst_sno_patch (:) = nan + + allocate(this%parveg_ln_patch (begp:endp)) ; this%parveg_ln_patch (:) = nan + + allocate(this%fsr_vis_d_patch (begp:endp)) ; this%fsr_vis_d_patch (:) = nan + allocate(this%fsr_vis_d_ln_patch (begp:endp)) ; this%fsr_vis_d_ln_patch (:) = nan + allocate(this%fsr_vis_i_patch (begp:endp)) ; this%fsr_vis_i_patch (:) = nan + allocate(this%fsrSF_vis_d_patch (begp:endp)) ; this%fsrSF_vis_d_patch (:) = nan + allocate(this%fsrSF_vis_d_ln_patch (begp:endp)) ; this%fsrSF_vis_d_ln_patch (:) = nan + allocate(this%fsrSF_vis_i_patch (begp:endp)) ; this%fsrSF_vis_i_patch (:) = nan + allocate(this%ssre_fsr_vis_d_patch (begp:endp)) ; this%ssre_fsr_vis_d_patch (:) = nan + allocate(this%ssre_fsr_vis_d_ln_patch(begp:endp)) ; this%ssre_fsr_vis_d_ln_patch(:) = nan + allocate(this%ssre_fsr_vis_i_patch (begp:endp)) ; this%ssre_fsr_vis_i_patch (:) = nan + allocate(this%fsr_sno_vd_patch (begp:endp)) ; this%fsr_sno_vd_patch (:) = nan + allocate(this%fsr_sno_nd_patch (begp:endp)) ; this%fsr_sno_nd_patch (:) = nan + allocate(this%fsr_sno_vi_patch (begp:endp)) ; this%fsr_sno_vi_patch (:) = nan + allocate(this%fsr_sno_ni_patch (begp:endp)) ; this%fsr_sno_ni_patch (:) = nan + + allocate(this%fsds_vis_d_patch (begp:endp)) ; this%fsds_vis_d_patch (:) = nan + allocate(this%fsds_vis_i_patch (begp:endp)) ; this%fsds_vis_i_patch (:) = nan + allocate(this%fsds_vis_d_ln_patch (begp:endp)) ; this%fsds_vis_d_ln_patch (:) = nan + allocate(this%fsds_vis_i_ln_patch (begp:endp)) ; this%fsds_vis_i_ln_patch (:) = nan + allocate(this%fsds_sno_vd_patch (begp:endp)) ; this%fsds_sno_vd_patch (:) = nan + allocate(this%fsds_sno_nd_patch (begp:endp)) ; this%fsds_sno_nd_patch (:) = nan + allocate(this%fsds_sno_vi_patch (begp:endp)) ; this%fsds_sno_vi_patch (:) = nan + allocate(this%fsds_sno_ni_patch (begp:endp)) ; this%fsds_sno_ni_patch (:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! History fields initialization + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use clm_varcon , only : spval + use histFileMod , only : hist_addfld1d, hist_addfld2d + use clm_varctl , only : use_SSRE + ! + ! !ARGUMENTS: + class(surfrad_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + if (use_snicar_frc) then + this%sfc_frc_aer_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOAERFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of all aerosols in snow (land) ', & + ptr_patch=this%sfc_frc_aer_patch, set_urb=spval) + + this%sfc_frc_aer_sno_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOAERFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of all aerosols in snow, averaged only when snow is present (land)', & + ptr_patch=this%sfc_frc_aer_sno_patch, set_urb=spval) + + this%sfc_frc_bc_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOBCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of BC in snow (land) ', & + ptr_patch=this%sfc_frc_bc_patch, set_urb=spval) + + this%sfc_frc_bc_sno_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOBCFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of BC in snow, averaged only when snow is present (land)', & + ptr_patch=this%sfc_frc_bc_sno_patch, set_urb=spval) + + this%sfc_frc_oc_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow (land) ', & + ptr_patch=this%sfc_frc_oc_patch, set_urb=spval) + + this%sfc_frc_oc_sno_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOOCFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow, averaged only when snow is present (land)', & + ptr_patch=this%sfc_frc_oc_sno_patch, set_urb=spval) + + this%sfc_frc_dst_patch(begp:endp) = spval + call hist_addfld1d (fname='SNODSTFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of dust in snow (land) ', & + ptr_patch=this%sfc_frc_dst_patch, set_urb=spval) + + this%sfc_frc_dst_sno_patch(begp:endp) = spval + call hist_addfld1d (fname='SNODSTFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of dust in snow, averaged only when snow is present (land)', & + ptr_patch=this%sfc_frc_dst_sno_patch, set_urb=spval) + end if + + this%fsds_vis_d_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSVD', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation', & + ptr_patch=this%fsds_vis_d_patch) + + this%fsds_vis_i_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis incident solar radiation', & + ptr_patch=this%fsds_vis_i_patch) + + this%fsr_vis_d_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRVD', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation', & + ptr_patch=this%fsr_vis_d_patch, c2l_scale_type='urbanf') + this%fsr_vis_i_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis reflected solar radiation', & + ptr_patch=this%fsr_vis_i_patch, c2l_scale_type='urbanf') + ! diagnostic fluxes + if (use_SSRE) then + this%fsrSF_vis_d_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRSFVD', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation', & + ptr_patch=this%fsrSF_vis_d_patch, c2l_scale_type='urbanf') + this%fsrSF_vis_i_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRSFVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis reflected solar radiation', & + ptr_patch=this%fsrSF_vis_i_patch, c2l_scale_type='urbanf') + + this%ssre_fsr_vis_d_patch(begp:endp) = spval + call hist_addfld1d (fname='SSRE_FSRVD', units='W/m^2', & + avgflag='A', long_name='surface snow radiatve effect on direct vis reflected solar radiation', & + ptr_patch=this%ssre_fsr_vis_d_patch, c2l_scale_type='urbanf') + this%ssre_fsr_vis_i_patch(begp:endp) = spval + call hist_addfld1d (fname='SSRE_FSRVI', units='W/m^2', & + avgflag='A', long_name='surface snow radiatve effect on diffuse vis reflected solar radiation', & + ptr_patch=this%ssre_fsr_vis_i_patch, c2l_scale_type='urbanf') + end if + this%fsds_vis_d_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSVDLN', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation at local noon', & + ptr_patch=this%fsds_vis_d_ln_patch) + + this%fsds_vis_i_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSVILN', units='W/m^2', & + avgflag='A', long_name='diffuse vis incident solar radiation at local noon', & + ptr_patch=this%fsds_vis_i_ln_patch) + + this%parveg_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='PARVEGLN', units='W/m^2', & + avgflag='A', long_name='absorbed par by vegetation at local noon', & + ptr_patch=this%parveg_ln_patch) + + this%fsr_vis_d_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRVDLN', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation at local noon', & + ptr_patch=this%fsr_vis_d_ln_patch, c2l_scale_type='urbanf') + ! diagnostic flux + if (use_SSRE) then + this%fsrSF_vis_d_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRSFVDLN', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation at local noon', & + ptr_patch=this%fsrSF_vis_d_ln_patch, c2l_scale_type='urbanf') + this%ssre_fsr_vis_d_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='SSRE_FSRVDLN', units='W/m^2', & + avgflag='A', long_name='surface snow radiatve effect on direct vis reflected solar radiation at local noon', & + ptr_patch=this%ssre_fsr_vis_d_ln_patch, c2l_scale_type='urbanf') + end if + this%fsds_sno_vd_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSDSVD', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation on snow', & + ptr_patch=this%fsds_sno_vd_patch, default='inactive') + + this%fsds_sno_nd_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSDSND', units='W/m^2', & + avgflag='A', long_name='direct nir incident solar radiation on snow', & + ptr_patch=this%fsds_sno_nd_patch, default='inactive') + + this%fsds_sno_vi_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSDSVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis incident solar radiation on snow', & + ptr_patch=this%fsds_sno_vi_patch, default='inactive') + + this%fsds_sno_ni_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSDSNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir incident solar radiation on snow', & + ptr_patch=this%fsds_sno_ni_patch, default='inactive') + + this%fsr_sno_vd_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSRVD', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation from snow', & + ptr_patch=this%fsr_sno_vd_patch) + + this%fsr_sno_nd_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSRND', units='W/m^2', & + avgflag='A', long_name='direct nir reflected solar radiation from snow', & + ptr_patch=this%fsr_sno_nd_patch) + + this%fsr_sno_vi_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSRVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis reflected solar radiation from snow', & + ptr_patch=this%fsr_sno_vi_patch) + + this%fsr_sno_ni_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSRNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir reflected solar radiation from snow', & + ptr_patch=this%fsr_sno_ni_patch) + + + end subroutine InitHistory + + !------------------------------------------------------------------------ + subroutine InitCold(this, bounds) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(surfrad_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,l + !----------------------------------------------------------------------- + + ! nothing for now + + end subroutine InitCold + + + subroutine CanopySunShadeFracs(filter_nourbanp, num_nourbanp, & + atm2lnd_inst, surfalb_inst, & + canopystate_inst, solarabs_inst) + + ! ------------------------------------------------------------------------------------ + ! This subroutine calculates and returns patch vectors of + ! + ! 1) absorbed PAR for sunlit leaves in canopy layer + ! 2) absorbed PAR for shaded leaves in canopy layer + ! 3) sunlit leaf area + ! 4) shaded leaf area + ! 5) sunlit leaf area for canopy layer + ! 6) shaded leaf area for canopy layer + ! 7) sunlit fraction of canopy + ! + ! This routine has a counterpart when the fates model is turned on. + ! CLMEDInterf_CanopySunShadeFracs() + ! If changes are applied to this routine, please take a moment to review that + ! subroutine as well and consider if any new information related to these types of + ! variables also needs to be augmented in that routine as well. + ! ------------------------------------------------------------------------------------ + + + implicit none + + ! Arguments (in) + + integer, intent(in),dimension(:) :: filter_nourbanp ! patch filter for non-urban points + integer, intent(in) :: num_nourbanp ! size of the nonurban filter + type(atm2lnd_type), intent(in) :: atm2lnd_inst + type(surfalb_type), intent(in) :: surfalb_inst + + ! Arguments (inout) + type(canopystate_type), intent(inout) :: canopystate_inst + type(solarabs_type), intent(inout) :: solarabs_inst + + ! local variables + integer :: fp ! non-urban filter patch index + integer :: p ! patch index + integer :: g ! gridcell index + integer :: iv ! canopy layer index + integer,parameter :: ipar = 1 ! The band index for PAR + + associate( tlai_z => surfalb_inst%tlai_z_patch, & ! tlai increment for canopy layer + fsun_z => surfalb_inst%fsun_z_patch, & ! sunlit fraction of canopy layer + elai => canopystate_inst%elai_patch, & ! one-sided leaf area index + forc_solad => atm2lnd_inst%forc_solad_grc, & ! direct beam radiation (W/m**2) + forc_solai => atm2lnd_inst%forc_solai_grc, & ! diffuse radiation (W/m**2) + fabd_sun_z => surfalb_inst%fabd_sun_z_patch, & ! absorbed sunlit leaf direct PAR + fabd_sha_z => surfalb_inst%fabd_sha_z_patch, & ! absorbed shaded leaf direct PAR + fabi_sun_z => surfalb_inst%fabi_sun_z_patch, & ! absorbed sunlit leaf diffuse PAR + fabi_sha_z => surfalb_inst%fabi_sha_z_patch, & ! absorbed shaded leaf diffuse PAR + nrad => surfalb_inst%nrad_patch, & ! number of canopy layers + parsun_z => solarabs_inst%parsun_z_patch, & ! absorbed PAR for sunlit leaves + parsha_z => solarabs_inst%parsha_z_patch, & ! absorbed PAR for shaded leaves + laisun => canopystate_inst%laisun_patch, & ! sunlit leaf area + laisha => canopystate_inst%laisha_patch, & ! shaded leaf area + laisun_z => canopystate_inst%laisun_z_patch, & ! sunlit leaf area for canopy layer + laisha_z => canopystate_inst%laisha_z_patch, & ! shaded leaf area for canopy layer + fsun => canopystate_inst%fsun_patch) ! sunlit fraction of canopy + + do fp = 1,num_nourbanp + + p = filter_nourbanp(fp) + + do iv = 1, nrad(p) + parsun_z(p,iv) = 0._r8 + parsha_z(p,iv) = 0._r8 + laisun_z(p,iv) = 0._r8 + laisha_z(p,iv) = 0._r8 + end do + + ! Loop over patches to calculate laisun_z and laisha_z for each layer. + ! Derive canopy laisun, laisha, and fsun from layer sums. + ! If sun/shade big leaf code, nrad=1 and fsun_z(p,1) and tlai_z(p,1) from + ! SurfaceAlbedo is canopy integrated so that layer value equals canopy value. + + laisun(p) = 0._r8 + laisha(p) = 0._r8 + do iv = 1, nrad(p) + laisun_z(p,iv) = tlai_z(p,iv) * fsun_z(p,iv) + laisha_z(p,iv) = tlai_z(p,iv) * (1._r8 - fsun_z(p,iv)) + laisun(p) = laisun(p) + laisun_z(p,iv) + laisha(p) = laisha(p) + laisha_z(p,iv) + end do + if (elai(p) > 0._r8) then + fsun(p) = laisun(p) / elai(p) + else + fsun(p) = 0._r8 + end if + + ! Absorbed PAR profile through canopy + ! If sun/shade big leaf code, nrad=1 and fluxes from SurfaceAlbedo + ! are canopy integrated so that layer values equal big leaf values. + + g = patch%gridcell(p) + + do iv = 1, nrad(p) + parsun_z(p,iv) = forc_solad(g,ipar)*fabd_sun_z(p,iv) + forc_solai(g,ipar)*fabi_sun_z(p,iv) + parsha_z(p,iv) = forc_solad(g,ipar)*fabd_sha_z(p,iv) + forc_solai(g,ipar)*fabi_sha_z(p,iv) + end do + + end do ! end of fp = 1,num_nourbanp loop + end associate + return + end subroutine CanopySunShadeFracs + + !------------------------------------------------------------------------------ + subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & + num_urbanp, filter_urbanp, num_urbanc, filter_urbanc, & + atm2lnd_inst, waterdiagnosticbulk_inst, canopystate_inst, & + surfalb_inst, solarabs_inst, surfrad_inst) + ! + ! !DESCRIPTION: + ! Solar fluxes absorbed by vegetation and ground surface + ! Note possible problem when land is on different grid than atmosphere. + ! Land may have sun above the horizon (coszen > 0) but atmosphere may + ! have sun below the horizon (forc_solad = 0 and forc_solai = 0). This is okay + ! because all fluxes (absorbed, reflected, transmitted) are multiplied + ! by the incoming flux and all will equal zero. + ! Atmosphere may have sun above horizon (forc_solad > 0 and forc_solai > 0) but + ! land may have sun below horizon. This is okay because fabd, fabi, + ! ftdd, ftid, and ftii all equal zero so that sabv=sabg=fsa=0. Also, + ! albd and albi equal one so that fsr=forc_solad+forc_solai. In other words, all + ! the radiation is reflected. NDVI should equal zero in this case. + ! However, the way the code is currently implemented this is only true + ! if (forc_solad+forc_solai)|vis = (forc_solad+forc_solai)|nir. + ! Output variables are parsun,parsha,sabv,sabg,fsa,fsr,ndvi + ! + ! !USES: + use clm_varpar , only : numrad, nlevsno + use clm_varcon , only : spval + use landunit_varcon , only : istsoil, istcrop + use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE + use clm_time_manager , only : get_step_size_real, is_near_local_noon + use SnowSnicarMod , only : DO_SNO_OC + use abortutils , only : endrun + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nourbanp ! number of patches in non-urban points in patch filter + integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points + integer , intent(in) :: num_urbanp ! number of patches in non-urban points in patch filter + integer , intent(in) :: filter_urbanp(:) ! patch filter for non-urban points + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(:) ! urban column filter + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(surfrad_type) , intent(inout) :: surfrad_inst + ! + ! !LOCAL VARIABLES: + integer , parameter :: nband = numrad ! number of solar radiation waveband classes + real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero + integer :: fp ! non-urban filter patch index + integer :: p ! patch index + integer :: c ! column index + integer :: l ! landunit index + integer :: g ! grid cell index + integer :: ib ! waveband number (1=vis, 2=nir) + integer :: iv ! canopy layer + real(r8) :: absrad ! absorbed solar radiation (W/m**2) + integer :: i ! layer index [idx] + real(r8) :: rnir ! reflected solar radiation [nir] (W/m**2) + real(r8) :: rvis ! reflected solar radiation [vis] (W/m**2) + real(r8) :: rnirSF ! snow-free reflected solar radiation [nir] (W/m**2) + real(r8) :: rvisSF ! snow-free reflected solar radiation [vis] (W/m**2) + real(r8) :: trd(bounds%begp:bounds%endp,numrad) ! transmitted solar radiation: direct (W/m**2) + real(r8) :: tri(bounds%begp:bounds%endp,numrad) ! transmitted solar radiation: diffuse (W/m**2) + real(r8) :: cad(bounds%begp:bounds%endp,numrad) ! direct beam absorbed by canopy (W/m**2) + real(r8) :: cai(bounds%begp:bounds%endp,numrad) ! diffuse radiation absorbed by canopy (W/m**2) + real(r8) :: dtime ! land model time step (sec) + real(r8) :: sabg_snl_sum ! temporary, absorbed energy in all active snow layers [W/m2] + real(r8) :: absrad_pur ! temp: absorbed solar radiation by pure snow [W/m2] + real(r8) :: absrad_bc ! temp: absorbed solar radiation without BC [W/m2] + real(r8) :: absrad_oc ! temp: absorbed solar radiation without OC [W/m2] + real(r8) :: absrad_dst ! temp: absorbed solar radiation without dust [W/m2] + real(r8) :: sabg_pur(bounds%begp:bounds%endp) ! solar radiation absorbed by ground with pure snow [W/m2] + real(r8) :: sabg_bc(bounds%begp:bounds%endp) ! solar radiation absorbed by ground without BC [W/m2] + real(r8) :: sabg_oc(bounds%begp:bounds%endp) ! solar radiation absorbed by ground without OC [W/m2] + real(r8) :: sabg_dst(bounds%begp:bounds%endp) ! solar radiation absorbed by ground without dust [W/m2] + real(r8) :: parveg(bounds%begp:bounds%endp) ! absorbed par by vegetation (W/m**2) + ! + !------------------------------------------------------------------------------ + + associate( & + snl => col%snl , & ! Input: [integer (:) ] negative number of snow layers [nbr] + + forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (W/m**2) + forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] diffuse radiation (W/m**2) + + snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer + coszen => surfalb_inst%coszen_col , & ! Input: [real(r8) (:) ] column cosine of solar zenith angle + albgrd => surfalb_inst%albgrd_col , & ! Input: [real(r8) (:,:) ] ground albedo (direct) + albgri => surfalb_inst%albgri_col , & ! Input: [real(r8) (:,:) ] ground albedo (diffuse) + albsod => surfalb_inst%albsod_col , & ! Input: [real(r8) (:,:) ] direct-beam soil albedo (col,bnd) [frc] + albgrd_oc => surfalb_inst%albgrd_oc_col , & ! Input: [real(r8) (:,:) ] ground albedo without OC (direct) (col,bnd) + albgri_oc => surfalb_inst%albgri_oc_col , & ! Input: [real(r8) (:,:) ] ground albedo without OC (diffuse) (col,bnd) + albgrd_dst => surfalb_inst%albgrd_dst_col , & ! Input: [real(r8) (:,:) ] ground albedo without dust (direct) (col,bnd) + albgri_dst => surfalb_inst%albgri_dst_col , & ! Input: [real(r8) (:,:) ] ground albedo without dust (diffuse) (col,bnd) + albsnd_hst => surfalb_inst%albsnd_hst_col , & ! Input: [real(r8) (:,:) ] snow albedo, direct, for history files (col,bnd) [frc] + albsni_hst => surfalb_inst%albsni_hst_col , & ! Input: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd + flx_absdv => surfalb_inst%flx_absdv_col , & ! Input: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): VIS [frc] + flx_absdn => surfalb_inst%flx_absdn_col , & ! Input: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): NIR [frc] + flx_absiv => surfalb_inst%flx_absiv_col , & ! Input: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): VIS [frc] + flx_absin => surfalb_inst%flx_absin_col , & ! Input: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): NIR [frc] + albsoi => surfalb_inst%albsoi_col , & ! Input: [real(r8) (:,:) ] diffuse soil albedo (col,bnd) [frc] + albd => surfalb_inst%albd_patch , & ! Input: [real(r8) (:,:) ] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Input: [real(r8) (:,:) ] surface albedo (diffuse) + albdSF => surfalb_inst%albdSF_patch , & ! Input: [real(r8) (:,:) ] snow-free surface albedo (direct) + albiSF => surfalb_inst%albiSF_patch , & ! Input: [real(r8) (:,:) ] snow-free surface albedo (diffuse) + fabd => surfalb_inst%fabd_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Input: [real(r8) (:,:) ] down direct flux below canopy per unit direct flux + ftid => surfalb_inst%ftid_patch , & ! Input: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flux + ftii => surfalb_inst%ftii_patch , & ! Input: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flux + fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Input: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Input: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Input: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + fabi_sha_z => surfalb_inst%fabi_sha_z_patch , & ! Input: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + albgrd_pur => surfalb_inst%albgrd_pur_col , & ! Input: [real(r8) (:,:) ] pure snow ground albedo (direct) + albgri_pur => surfalb_inst%albgri_pur_col , & ! Input: [real(r8) (:,:) ] pure snow ground albedo (diffuse) + albgrd_bc => surfalb_inst%albgrd_bc_col , & ! Input: [real(r8) (:,:) ] ground albedo without BC (direct) (col,bnd) + albgri_bc => surfalb_inst%albgri_bc_col , & ! Input: [real(r8) (:,:) ] ground albedo without BC (diffuse) (col,bnd) + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + fsun => canopystate_inst%fsun_patch , & ! Output: [real(r8) (:) ] sunlit fraction of canopy + fsa => solarabs_inst%fsa_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed (total) (W/m**2) + fsr => solarabs_inst%fsr_patch , & ! Output: [real(r8) (:) ] solar radiation reflected (W/m**2) + fsrSF => solarabs_inst%fsrSF_patch , & ! Output: [real(r8) (:) ] diagnostic snow-free solar radiation reflected (W/m**2) + ssre_fsr => solarabs_inst%ssre_fsr_patch , & ! Output: [real(r8) (:) ] diagnostic snow-free solar radiation reflected (W/m**2) + sabv => solarabs_inst%sabv_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by vegetation (W/m**2) + sabg => solarabs_inst%sabg_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + sabg_pen => solarabs_inst%sabg_pen_patch , & ! Output: [real(r8) (:) ] solar (rural) radiation penetrating top soisno layer (W/m**2) + sabg_soil => solarabs_inst%sabg_soil_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_snow => solarabs_inst%sabg_snow_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) + sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Output: [real(r8) (:,:) ] absorbed radiative flux (patch,lyr) [W/m2] + fsr_nir_d => solarabs_inst%fsr_nir_d_patch , & ! Output: [real(r8) (:) ] reflected direct beam nir solar radiation (W/m**2) + fsr_nir_i => solarabs_inst%fsr_nir_i_patch , & ! Output: [real(r8) (:) ] reflected diffuse nir solar radiation (W/m**2) + fsr_nir_d_ln => solarabs_inst%fsr_nir_d_ln_patch , & ! Output: [real(r8) (:) ] reflected direct beam nir solar rad at local noon (W/m**2) + fsds_nir_d => solarabs_inst%fsds_nir_d_patch , & ! Output: [real(r8) (:) ] incident direct beam nir solar radiation (W/m**2) + fsds_nir_d_ln => solarabs_inst%fsds_nir_d_ln_patch , & ! Output: [real(r8) (:) ] incident direct beam nir solar rad at local noon (W/m**2) + fsds_nir_i => solarabs_inst%fsds_nir_i_patch , & ! Output: [real(r8) (:) ] incident diffuse nir solar radiation (W/m**2) + fsrSF_nir_d => solarabs_inst%fsrSF_nir_d_patch , & ! Output: [real(r8) (:) ] snow-free reflected direct beam nir solar radiation (W/m**2) + fsrSF_nir_i => solarabs_inst%fsrSF_nir_i_patch , & ! Output: [real(r8) (:) ] snow-free reflected diffuse nir solar radiation (W/m**2) + fsrSF_nir_d_ln => solarabs_inst%fsrSF_nir_d_ln_patch, & ! Output: [real(r8) (:) ] snow-free reflected direct beam nir solar rad at local noon (W/m**2) + ssre_fsr_nir_d => solarabs_inst%ssre_fsr_nir_d_patch, & ! Output: [real(r8) (:) ] snow-free reflected direct beam nir solar radiation (W/m**2) + ssre_fsr_nir_i => solarabs_inst%ssre_fsr_nir_i_patch, & ! Output: [real(r8) (:) ] snow-free reflected diffuse nir solar radiation (W/m**2) + ssre_fsr_nir_d_ln=> solarabs_inst%ssre_fsr_nir_d_ln_patch,&!Output: [real(r8) (:) ] snow-free reflected direct beam nir solar rad at local noon (W/m**2) + fsa_r => solarabs_inst%fsa_r_patch , & ! Output: [real(r8) (:) ] rural solar radiation absorbed (total) (W/m**2) + sub_surf_abs_SW => solarabs_inst%sub_surf_abs_SW_patch,& ! Output: [real(r8) (:) ] fraction of solar radiation absorbed below first snow layer (W/M**2) + + parveg_ln => surfrad_inst%parveg_ln_patch , & ! Output: [real(r8) (:) ] absorbed par by vegetation at local noon (W/m**2) + fsr_vis_d => surfrad_inst%fsr_vis_d_patch , & ! Output: [real(r8) (:) ] reflected direct beam vis solar radiation (W/m**2) + fsr_vis_i => surfrad_inst%fsr_vis_i_patch , & ! Output: [real(r8) (:) ] reflected diffuse vis solar radiation (W/m**2) + fsrSF_vis_d => surfrad_inst%fsrSF_vis_d_patch , & ! Output: [real(r8) (:) ] snow-free reflected direct beam vis solar radiation (W/m**2) + fsrSF_vis_i => surfrad_inst%fsrSF_vis_i_patch , & ! Output: [real(r8) (:) ] snow-free reflected diffuse vis solar radiation (W/m**2) + ssre_fsr_vis_d => surfrad_inst%ssre_fsr_vis_d_patch , & ! Output: [real(r8) (:) ] snow-free reflected direct beam vis solar radiation (W/m**2) + ssre_fsr_vis_i => surfrad_inst%ssre_fsr_vis_i_patch , & ! Output: [real(r8) (:) ] snow-free reflected diffuse vis solar radiation (W/m**2) + fsds_vis_i_ln => surfrad_inst%fsds_vis_i_ln_patch , & ! Output: [real(r8) (:) ] incident diffuse beam vis solar rad at local noon (W/m**2) + fsr_vis_d_ln => surfrad_inst%fsr_vis_d_ln_patch , & ! Output: [real(r8) (:) ] reflected direct beam vis solar rad at local noon (W/m**2) + fsrSF_vis_d_ln => surfrad_inst%fsrSF_vis_d_ln_patch , & ! Output: [real(r8) (:) ] snow-free reflected direct beam vis solar rad at local noon (W/m**2) + fsds_vis_d => surfrad_inst%fsds_vis_d_patch , & ! Output: [real(r8) (:) ] incident direct beam vis solar radiation (W/m**2) + fsds_vis_i => surfrad_inst%fsds_vis_i_patch , & ! Output: [real(r8) (:) ] incident diffuse vis solar radiation (W/m**2) + fsds_vis_d_ln => surfrad_inst%fsds_vis_d_ln_patch , & ! Output: [real(r8) (:) ] incident direct beam vis solar rad at local noon (W/m**2) + sfc_frc_aer => surfrad_inst%sfc_frc_aer_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with all aerosols (patch) [W/m2] + sfc_frc_aer_sno => surfrad_inst%sfc_frc_aer_sno_patch, & ! Output: [real(r8) (:) ] surface forcing of snow with all aerosols, averaged only when snow is present (patch) [W/m2] + sfc_frc_bc => surfrad_inst%sfc_frc_bc_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with BC (patch) [W/m2] + sfc_frc_bc_sno => surfrad_inst%sfc_frc_bc_sno_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with BC, averaged only when snow is present (patch) [W/m2] + sfc_frc_oc => surfrad_inst%sfc_frc_oc_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with OC (patch) [W/m2] + sfc_frc_oc_sno => surfrad_inst%sfc_frc_oc_sno_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with OC, averaged only when snow is present (patch) [W/m2] + sfc_frc_dst => surfrad_inst%sfc_frc_dst_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with dust (patch) [W/m2] + sfc_frc_dst_sno => surfrad_inst%sfc_frc_dst_sno_patch, & ! Output: [real(r8) (:) ] surface forcing of snow with dust, averaged only when snow is present (patch) [W/m2] + fsr_sno_vd => surfrad_inst%fsr_sno_vd_patch , & ! Output: [real(r8) (:) ] reflected visible, direct radiation from snow (for history files) (patch) [W/m2] + fsr_sno_nd => surfrad_inst%fsr_sno_nd_patch , & ! Output: [real(r8) (:) ] reflected near-IR, direct radiation from snow (for history files) (patch) [W/m2] + fsr_sno_vi => surfrad_inst%fsr_sno_vi_patch , & ! Output: [real(r8) (:) ] reflected visible, diffuse radiation from snow (for history files) (patch) [W/m2] + fsr_sno_ni => surfrad_inst%fsr_sno_ni_patch , & ! Output: [real(r8) (:) ] reflected near-IR, diffuse radiation from snow (for history files) (patch) [W/m2] + fsds_sno_vd => surfrad_inst%fsds_sno_vd_patch , & ! Output: [real(r8) (:) ] incident visible, direct radiation on snow (for history files) (patch) [W/m2] + fsds_sno_nd => surfrad_inst%fsds_sno_nd_patch , & ! Output: [real(r8) (:) ] incident near-IR, direct radiation on snow (for history files) (patch) [W/m2] + fsds_sno_vi => surfrad_inst%fsds_sno_vi_patch , & ! Output: [real(r8) (:) ] incident visible, diffuse radiation on snow (for history files) (patch) [W/m2] + fsds_sno_ni => surfrad_inst%fsds_sno_ni_patch , & ! Output: [real(r8) (:) ] incident near-IR, diffuse radiation on snow (for history files) (patch) [W/m2] + frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col & !Input: + + ) + + ! Determine seconds off current time step + dtime = get_step_size_real() + + ! Initialize fluxes + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + l = patch%landunit(p) + g = patch%gridcell(p) + + sabg_soil(p) = 0._r8 + sabg_snow(p) = 0._r8 + sabg(p) = 0._r8 + sabv(p) = 0._r8 + fsa(p) = 0._r8 + if (lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) then + fsa_r(p) = 0._r8 + end if + sabg_lyr(p,:) = 0._r8 + sabg_pur(p) = 0._r8 + sabg_bc(p) = 0._r8 + sabg_oc(p) = 0._r8 + sabg_dst(p) = 0._r8 + + end do + + ! zero-out fsun for the urban patches + ! the non-urban patches were set prior to this call + ! and split into fates and non-fates specific functions + do fp = 1,num_urbanp + p = filter_urbanp(fp) + fsun(p) = 0._r8 + end do + + ! Loop over nband wavebands + do ib = 1, nband + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + c = patch%column(p) + l = patch%landunit(p) + g = patch%gridcell(p) + + ! Absorbed by canopy + + cad(p,ib) = forc_solad(g,ib)*fabd(p,ib) + cai(p,ib) = forc_solai(g,ib)*fabi(p,ib) + sabv(p) = sabv(p) + cad(p,ib) + cai(p,ib) + fsa(p) = fsa(p) + cad(p,ib) + cai(p,ib) + if (ib == 1) then + parveg(p) = cad(p,ib) + cai(p,ib) + end if + if (lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) then + fsa_r(p) = fsa_r(p) + cad(p,ib) + cai(p,ib) + end if + + ! Transmitted = solar fluxes incident on ground + + trd(p,ib) = forc_solad(g,ib)*ftdd(p,ib) + tri(p,ib) = forc_solad(g,ib)*ftid(p,ib) + forc_solai(g,ib)*ftii(p,ib) + ! Solar radiation absorbed by ground surface + ! calculate absorbed solar by soil/snow separately + absrad = trd(p,ib)*(1._r8-albsod(c,ib)) + tri(p,ib)*(1._r8-albsoi(c,ib)) + sabg_soil(p) = sabg_soil(p) + absrad + absrad = trd(p,ib)*(1._r8-albsnd_hst(c,ib)) + tri(p,ib)*(1._r8-albsni_hst(c,ib)) + sabg_snow(p) = sabg_snow(p) + absrad + absrad = trd(p,ib)*(1._r8-albgrd(c,ib)) + tri(p,ib)*(1._r8-albgri(c,ib)) + sabg(p) = sabg(p) + absrad + fsa(p) = fsa(p) + absrad + if (lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) then + fsa_r(p) = fsa_r(p) + absrad + end if + if (snl(c) == 0) then + sabg_snow(p) = sabg(p) + sabg_soil(p) = sabg(p) + endif + ! if no subgrid fluxes, make sure to set both components equal to weighted average + if (.not. use_subgrid_fluxes .or. lun%itype(l) == istdlak) then + sabg_snow(p) = sabg(p) + sabg_soil(p) = sabg(p) + endif + + if (use_snicar_frc) then + ! Solar radiation absorbed by ground surface without BC + absrad_bc = trd(p,ib)*(1._r8-albgrd_bc(c,ib)) + tri(p,ib)*(1._r8-albgri_bc(c,ib)) + sabg_bc(p) = sabg_bc(p) + absrad_bc + + ! Solar radiation absorbed by ground surface without OC + absrad_oc = trd(p,ib)*(1._r8-albgrd_oc(c,ib)) + tri(p,ib)*(1._r8-albgri_oc(c,ib)) + sabg_oc(p) = sabg_oc(p) + absrad_oc + + ! Solar radiation absorbed by ground surface without dust + absrad_dst = trd(p,ib)*(1._r8-albgrd_dst(c,ib)) + tri(p,ib)*(1._r8-albgri_dst(c,ib)) + sabg_dst(p) = sabg_dst(p) + absrad_dst + + ! Solar radiation absorbed by ground surface without any aerosols + absrad_pur = trd(p,ib)*(1._r8-albgrd_pur(c,ib)) + tri(p,ib)*(1._r8-albgri_pur(c,ib)) + sabg_pur(p) = sabg_pur(p) + absrad_pur + end if + + end do ! end of patch loop + end do ! end nbands loop + + ! compute absorbed flux in each snow layer and top soil layer, + ! based on flux factors computed in the radiative transfer portion of SNICAR. + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + c = patch%column(p) + l = patch%landunit(p) + sabg_snl_sum = 0._r8 + + sub_surf_abs_SW(p) = 0._r8 + + ! CASE1: No snow layers: all energy is absorbed in top soil layer + if (snl(c) == 0) then + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,1) = sabg(p) + sabg_snl_sum = sabg_lyr(p,1) + + ! CASE 2: Snow layers present: absorbed radiation is scaled according to + ! flux factors computed by SNICAR + else + do i = -nlevsno+1,1,1 + sabg_lyr(p,i) = flx_absdv(c,i)*trd(p,1) + flx_absdn(c,i)*trd(p,2) + & + flx_absiv(c,i)*tri(p,1) + flx_absin(c,i)*tri(p,2) + ! summed radiation in active snow layers: + if (i >= snl(c)+1) then + sabg_snl_sum = sabg_snl_sum + sabg_lyr(p,i) + endif + if (i > snl(c)+1) then ! if snow layer is below surface snow layer + !accumulate subsurface flux as a diagnostic for history file + sub_surf_abs_SW(p) = sub_surf_abs_SW(p) + sabg_lyr(p,i) + endif + enddo + + ! Divide absorbed by total, to get fraction absorbed in subsurface + if (sabg_snl_sum /= 0._r8) then + sub_surf_abs_SW(p) = sub_surf_abs_SW(p)/sabg_snl_sum + else + sub_surf_abs_SW(p) = 0._r8 + endif + + ! Error handling: The situation below can occur when solar radiation is + ! NOT computed every timestep. + ! When the number of snow layers has changed in between computations of the + ! absorbed solar energy in each layer, we must redistribute the absorbed energy + ! to avoid physically unrealistic conditions. The assumptions made below are + ! somewhat arbitrary, but this situation does not arise very frequently. + ! This error handling is implemented to accomodate any value of the + ! radiation frequency. + ! change condition to match sabg_snow isntead of sabg + if (abs(sabg_snl_sum-sabg_snow(p)) > 0.00001_r8) then + if (snl(c) == 0) then + sabg_lyr(p,-nlevsno+1:0) = 0._r8 + sabg_lyr(p,1) = sabg(p) + elseif (snl(c) == -1) then + sabg_lyr(p,-nlevsno+1:-1) = 0._r8 + sabg_lyr(p,0) = sabg_snow(p)*0.6_r8 + sabg_lyr(p,1) = sabg_snow(p)*0.4_r8 + else + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,snl(c)+1) = sabg_snow(p)*0.75_r8 + sabg_lyr(p,snl(c)+2) = sabg_snow(p)*0.25_r8 + endif + endif + + ! If shallow snow depth, all solar radiation absorbed in top or top two snow layers + ! to prevent unrealistic timestep soil warming + if (.not. use_subgrid_fluxes .or. lun%itype(l) == istdlak) then + if (snow_depth(c) < 0.10_r8) then + if (snl(c) == 0) then + sabg_lyr(p,-nlevsno+1:0) = 0._r8 + sabg_lyr(p,1) = sabg(p) + elseif (snl(c) == -1) then + sabg_lyr(p,-nlevsno+1:-1) = 0._r8 + sabg_lyr(p,0) = sabg(p) + sabg_lyr(p,1) = 0._r8 + else + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,snl(c)+1) = sabg(p)*0.75_r8 + sabg_lyr(p,snl(c)+2) = sabg(p)*0.25_r8 + endif + endif + endif + endif + + ! This situation should not happen: + if (abs(sum(sabg_lyr(p,:))-sabg_snow(p)) > 0.00001_r8) then + write(iulog,*)"SNICAR ERROR: Absorbed ground radiation not equal to summed snow layer radiation" + write(iulog,*)"Diff = ",sum(sabg_lyr(p,:))-sabg_snow(p) + write(iulog,*)"sabg_snow(p)= ",sabg_snow(p) + write(iulog,*)"sabg_sum(p) = ",sum(sabg_lyr(p,:)) + write(iulog,*)"snl(c) = ",snl(c) + write(iulog,*)"flx_absdv1 = ",trd(p,1)*(1.-albgrd(c,1)) + write(iulog,*)"flx_absdv2 = ",sum(flx_absdv(c,:))*trd(p,1) + write(iulog,*)"flx_absiv1 = ",tri(p,1)*(1.-albgri(c,1)) + write(iulog,*)"flx_absiv2 = ",sum(flx_absiv(c,:))*tri(p,1) + write(iulog,*)"flx_absdn1 = ",trd(p,2)*(1.-albgrd(c,2)) + write(iulog,*)"flx_absdn2 = ",sum(flx_absdn(c,:))*trd(p,2) + write(iulog,*)"flx_absin1 = ",tri(p,2)*(1.-albgri(c,2)) + write(iulog,*)"flx_absin2 = ",sum(flx_absin(c,:))*tri(p,2) + write(iulog,*)"albgrd_nir = ",albgrd(c,2) + write(iulog,*)"coszen = ",coszen(c) + call endrun(decomp_index=c, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) + endif + + ! Diagnostic: shortwave penetrating ground (e.g. top layer) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + sabg_pen(p) = sabg(p) - sabg_lyr(p, snl(c)+1) + end if + + if (use_snicar_frc) then + + ! BC aerosol forcing (patch-level): + sfc_frc_bc(p) = sabg(p) - sabg_bc(p) + + ! OC aerosol forcing (patch-level): + if (DO_SNO_OC) then + sfc_frc_oc(p) = sabg(p) - sabg_oc(p) + else + sfc_frc_oc(p) = 0._r8 + endif + + ! dust aerosol forcing (patch-level): + sfc_frc_dst(p) = sabg(p) - sabg_dst(p) + + ! all-aerosol forcing (patch-level): + sfc_frc_aer(p) = sabg(p) - sabg_pur(p) + + ! forcings averaged only over snow: + if (frac_sno(c) > 0._r8) then + sfc_frc_bc_sno(p) = sfc_frc_bc(p)/frac_sno(c) + sfc_frc_oc_sno(p) = sfc_frc_oc(p)/frac_sno(c) + sfc_frc_dst_sno(p) = sfc_frc_dst(p)/frac_sno(c) + sfc_frc_aer_sno(p) = sfc_frc_aer(p)/frac_sno(c) + else + sfc_frc_bc_sno(p) = spval + sfc_frc_oc_sno(p) = spval + sfc_frc_dst_sno(p) = spval + sfc_frc_aer_sno(p) = spval + endif + end if + enddo + + ! Radiation diagnostics + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + g = patch%gridcell(p) + + ! NDVI and reflected solar radiation + + rvis = albd(p,1)*forc_solad(g,1) + albi(p,1)*forc_solai(g,1) + rnir = albd(p,2)*forc_solad(g,2) + albi(p,2)*forc_solai(g,2) + fsr(p) = rvis + rnir + if (use_SSRE) then + rvisSF = albdSF(p,1)*forc_solad(g,1) + albiSF(p,1)*forc_solai(g,1) + rnirSF = albdSF(p,2)*forc_solad(g,2) + albiSF(p,2)*forc_solai(g,2) + fsrSF(p) = rvisSF + rnirSF + ssre_fsr(p) = fsr(p)-fsrSF(p) + end if + fsds_vis_d(p) = forc_solad(g,1) + fsds_nir_d(p) = forc_solad(g,2) + fsds_vis_i(p) = forc_solai(g,1) + fsds_nir_i(p) = forc_solai(g,2) + fsr_vis_d(p) = albd(p,1)*forc_solad(g,1) + fsr_nir_d(p) = albd(p,2)*forc_solad(g,2) + fsr_vis_i(p) = albi(p,1)*forc_solai(g,1) + fsr_nir_i(p) = albi(p,2)*forc_solai(g,2) + if (use_SSRE) then + fsrSF_vis_d(p) = albdSF(p,1)*forc_solad(g,1) + fsrSF_nir_d(p) = albdSF(p,2)*forc_solad(g,2) + fsrSF_vis_i(p) = albiSF(p,1)*forc_solai(g,1) + fsrSF_nir_i(p) = albiSF(p,2)*forc_solai(g,2) + + ssre_fsr_vis_d(p) = fsrSF_vis_d(p)-fsr_vis_d(p) + ssre_fsr_nir_d(p) = fsrSF_nir_d(p)-fsr_nir_d(p) + ssre_fsr_vis_i(p) = fsrSF_vis_i(p)-fsr_vis_i(p) + ssre_fsr_nir_i(p) = fsrSF_nir_i(p)-fsr_nir_i(p) + end if + if ( is_near_local_noon( grc%londeg(g), deltasec=nint(dtime)/2 ) )then + fsds_vis_d_ln(p) = forc_solad(g,1) + fsds_nir_d_ln(p) = forc_solad(g,2) + fsr_vis_d_ln(p) = albd(p,1)*forc_solad(g,1) + fsr_nir_d_ln(p) = albd(p,2)*forc_solad(g,2) + fsds_vis_i_ln(p) = forc_solai(g,1) + parveg_ln(p) = parveg(p) + else + fsds_vis_d_ln(p) = spval + fsds_nir_d_ln(p) = spval + fsr_vis_d_ln(p) = spval + fsr_nir_d_ln(p) = spval + fsds_vis_i_ln(p) = spval + parveg_ln(p) = spval + end if + if (use_SSRE) then + if ( is_near_local_noon( grc%londeg(g), deltasec=nint(dtime)/2 ) )then + fsrSF_vis_d_ln(p) = albdSF(p,1)*forc_solad(g,1) + fsrSF_nir_d_ln(p) = albdSF(p,2)*forc_solad(g,2) + else + fsrSF_vis_d_ln(p) = spval + fsrSF_nir_d_ln(p) = spval + end if + end if + ! diagnostic variables (downwelling and absorbed radiation partitioning) for history files + ! (OPTIONAL) + c = patch%column(p) + if (snl(c) < 0) then + fsds_sno_vd(p) = forc_solad(g,1) + fsds_sno_nd(p) = forc_solad(g,2) + fsds_sno_vi(p) = forc_solai(g,1) + fsds_sno_ni(p) = forc_solai(g,2) + + fsr_sno_vd(p) = fsds_vis_d(p)*albsnd_hst(c,1) + fsr_sno_nd(p) = fsds_nir_d(p)*albsnd_hst(c,2) + fsr_sno_vi(p) = fsds_vis_i(p)*albsni_hst(c,1) + fsr_sno_ni(p) = fsds_nir_i(p)*albsni_hst(c,2) + else + fsds_sno_vd(p) = spval + fsds_sno_nd(p) = spval + fsds_sno_vi(p) = spval + fsds_sno_ni(p) = spval + + fsr_sno_vd(p) = spval + fsr_sno_nd(p) = spval + fsr_sno_vi(p) = spval + fsr_sno_ni(p) = spval + endif + end do + + ! TODO: urban snow-free albedos: + do fp = 1,num_urbanp + p = filter_urbanp(fp) + g = patch%gridcell(p) + + if(elai(p)==0.0_r8.and.fabd(p,1)>0._r8)then + if ( local_debug ) write(iulog,*) 'absorption without LAI',elai(p),tlai(p),fabd(p,1),p + endif + + ! Solar incident + + fsds_vis_d(p) = forc_solad(g,1) + fsds_nir_d(p) = forc_solad(g,2) + fsds_vis_i(p) = forc_solai(g,1) + fsds_nir_i(p) = forc_solai(g,2) + + ! Determine local noon incident solar + if ( is_near_local_noon( grc%londeg(g), deltasec=nint(dtime)/2 ) )then + fsds_vis_d_ln(p) = forc_solad(g,1) + fsds_nir_d_ln(p) = forc_solad(g,2) + fsds_vis_i_ln(p) = forc_solai(g,1) + parveg_ln(p) = 0._r8 + else + fsds_vis_d_ln(p) = spval + fsds_nir_d_ln(p) = spval + fsds_vis_i_ln(p) = spval + parveg_ln(p) = spval + endif + + ! Solar reflected + ! per unit ground area (roof, road) and per unit wall area (sunwall, shadewall) + + fsr_vis_d(p) = albd(p,1) * forc_solad(g,1) + fsr_nir_d(p) = albd(p,2) * forc_solad(g,2) + fsr_vis_i(p) = albi(p,1) * forc_solai(g,1) + fsr_nir_i(p) = albi(p,2) * forc_solai(g,2) + + ! Determine local noon reflected solar + if ( is_near_local_noon( grc%londeg(g), deltasec=nint(dtime)/2 ) )then + fsr_vis_d_ln(p) = fsr_vis_d(p) + fsr_nir_d_ln(p) = fsr_nir_d(p) + else + fsr_vis_d_ln(p) = spval + fsr_nir_d_ln(p) = spval + endif + fsr(p) = fsr_vis_d(p) + fsr_nir_d(p) + fsr_vis_i(p) + fsr_nir_i(p) + end do + + end associate + + end subroutine SurfaceRadiation + +end module SurfaceRadiationMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 new file mode 100644 index 000000000..f321c8625 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -0,0 +1,229 @@ +module clm_time_manager + + use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec + use clm_varctl , only: iulog + + implicit none + private + +! Public methods + +! gkw: this is just to get code to compile + + public ::& + get_step_size, &! return step size in seconds + get_rad_step_size, &! return radiation step size in seconds + get_nstep, &! return CN timestep number + + get_curr_date, &! return date components at end of current timestep +! get_start_date, &! return components of the start date +! get_driver_start_ymd, &! return year/month/day (as integer in YYYYMMDD format) of driver start date +! get_ref_date, &! return components of the reference date +! get_curr_time, &! return components of elapsed time since reference date at end of current timestep + get_curr_calday, &! return calendar day at end of current timestep + get_calday, &! return calendar day from input date +! get_calendar, &! return calendar + + get_days_per_year, &! return the days per year for current year + + is_end_curr_day, &! return true on last timestep in current day + is_restart ! return true if this is a restart run + +contains + +!========================================================================================= + +integer function get_step_size( dt ) + + ! Return the step size in seconds. + + integer, optional, intent(in) :: dt ! set to this time step + + integer, save :: dt_default = -999 + + if ( present(dt) ) then + dt_default = dt + end if + + if(dt_default < 0) stop 'CN: dt_default < 0' + get_step_size = dt_default + +end function get_step_size + +!========================================================================================= + +integer function get_nstep(istep) + + ! Return the timestep number. + + integer*8, optional, intent(in) :: istep + + integer, save :: istep_default = -999 + + if ( present(istep) ) then + istep_default = istep + end if + + if(istep_default < 0) stop 'CN: istep_default < 0' + get_nstep = istep_default ! for FireMod + +end function get_nstep + +!========================================================================================= + +integer function get_rad_step_size() + + ! Return the step size in seconds. + + get_rad_step_size = -999999999 ! gkw: to make sure this is not used + +end function get_rad_step_size + +!========================================================================================= + +subroutine get_curr_date(yr, mon, day, tod) + + ! Return date components valid at end of current timestep with an optional + ! offset (positive or negative) in seconds. + + implicit none + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + yr = curr_year + mon = curr_month + day = curr_day + tod = 3600*curr_hour + 60*curr_min + curr_sec + +end subroutine get_curr_date + +!========================================================================================= + +function get_curr_calday() + + ! Return calendar day at end of current timestep with optional offset. + ! Calendar day 1.0 = 0Z on Jan 1. + + real :: get_curr_calday + + get_curr_calday = curr_dofyr + +end function get_curr_calday + +!========================================================================================= + +function get_calday(ymd, tod) + +! Return calendar day corresponding to specified time instant. +! Calendar day 1.0 = 0Z on Jan 1. + +! fzeng: +! combined info from +! (1) subroutine get_dofyr_pentad in Catchment date_time_util.F90: the method +! (2) subroutine ESMF_TimeGetDayOfYearInteger in CLM4.5 ESMF_TimeMod.F90: +! output day of the year ranges from 1 to 365 +! (3) function get_calday and function TimeSetymd in CLM4.5 clm_time_manager.F90 +! (4) function days_in_month in GEOSsurface_GridComp/Shared/Raster/src/leap_year.F90 + +! Arguments + integer, intent(in) :: & + ymd, &! date in yearmmdd format + tod ! time of day (seconds past 0Z) + +! Return value + real :: get_calday + +! Local variables + integer :: yr, mon, day ! Year, month, day as integers + integer :: i + integer, dimension(12), parameter :: days_in_month_nonleap = & + (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) + + yr = ymd / 10000 + mon = (ymd - yr*10000) / 100 + day = ymd - yr*10000 - mon*100 + + get_calday = day + do i=1,mon-1 + get_calday = get_calday + days_in_month_nonleap(i) + end do + + if ( (get_calday > 366.0) .and. (get_calday <= 367.0) )then + get_calday = get_calday - 1.0 + end if + + if ( (get_calday < 1.0) .or. (get_calday > 366.0) )then + write(iulog,*) 'clm::get_calday = ', get_calday + stop 'clm::get_calday: error calday out of range' + end if + +end function get_calday + +!========================================================================================= + +integer function get_days_per_year( year ) + + integer, optional, intent(in) :: year ! current year + + integer, save :: curr_year = 1999 + logical :: is_leap_year + + if ( present(year) ) then + curr_year = year + end if + + if (mod(curr_year,4) /= 0) then + is_leap_year = .false. + else if (mod(curr_year,400) == 0) then + is_leap_year = .true. + else if (mod(curr_year,100) == 0) then + is_leap_year = .false. + else + is_leap_year = .true. + end if + +!!!is_leap_year = .false. ! gkw: 71l test 20110920 + + if(is_leap_year) then + get_days_per_year = 366 + else + get_days_per_year = 365 + endif + +end function get_days_per_year + +!========================================================================================= + +function is_end_curr_day( ) + + ! Return true if current timestep is last timestep in current day. + + ! Return value + logical :: is_end_curr_day + + ! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + call get_curr_date(yr, mon, day, tod) + is_end_curr_day = (tod == 0) + +end function is_end_curr_day + +!========================================================================================= + +logical function is_restart( ) + + ! Determine if it's a restart run + + is_restart = .false. + +end function is_restart + +end module clm_time_manager diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 new file mode 100644 index 000000000..b8faea177 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -0,0 +1,52 @@ +module clm_varcon + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varcon +! +! !DESCRIPTION: +! Module containing various model constants +! +! !USES: + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use shr_const_mod, only: SHR_CONST_G, & + SHR_CONST_RHOFW, & + SHR_CONST_TKFRZ, & + SHR_CONST_CDAY, & + SHR_CONST_RGAS, & + SHR_CONST_PI, & + SHR_CONST_PDB + use clm_varpar , only: nlevgrnd, nlevdecomp_full + +! !PUBLIC TYPES: + implicit none + save +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 27 February 2008: Keith Oleson; Add forcing height and aerodynamic parameters +! +!EOP +!----------------------------------------------------------------------- + + !------------------------------------------------------------------ + ! Initialize mathmatical constants + !------------------------------------------------------------------ + + real(r8) :: rpi = SHR_CONST_PI + + !------------------------------------------------------------------ + ! Initialize physical constants + !------------------------------------------------------------------ + + real(r8) :: grav = SHR_CONST_G !gravity constant [m/s2] + real(r8) :: denh2o = SHR_CONST_RHOFW !density of liquid water [kg/m3] + real(r8) :: rgas = SHR_CONST_RGAS !universal gas constant [J/K/kmole] + real(r8) :: tfrz = SHR_CONST_TKFRZ !freezing temperature [K] + real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day + real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data + integer , public, parameter :: ispval = -9999 ! special value for int data + + +end module clm_varcon diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon_old.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon_old.F90 new file mode 100644 index 000000000..9f66d335a --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon_old.F90 @@ -0,0 +1,317 @@ +module clm_varcon + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing various model constants. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_G,SHR_CONST_STEBOL,SHR_CONST_KARMAN, & + SHR_CONST_RWV,SHR_CONST_RDAIR,SHR_CONST_CPFW, & + SHR_CONST_CPICE,SHR_CONST_CPDAIR,SHR_CONST_LATVAP, & + SHR_CONST_LATSUB,SHR_CONST_LATICE,SHR_CONST_RHOFW, & + SHR_CONST_RHOICE,SHR_CONST_TKFRZ,SHR_CONST_REARTH, & + SHR_CONST_PDB, SHR_CONST_PI, SHR_CONST_CDAY, & + SHR_CONST_RGAS, SHR_CONST_PSTD, & + SHR_CONST_MWDAIR, SHR_CONST_MWWV, SHR_CONST_CPFW + use clm_varpar , only: numrad, nlevgrnd, nlevlak, nlevdecomp_full + use clm_varpar , only: ngases + use clm_varpar , only: nlayer + + ! + ! !PUBLIC TYPES: + implicit none + save + private + !----------------------------------------------------------------------- + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: clm_varcon_init ! initialize constants in clm_varcon + public :: clm_varcon_clean ! deallocate variables allocated by clm_varcon_init + ! + ! !REVISION HISTORY: + ! Created by Mariana Vertenstein + ! 27 February 2008: Keith Oleson; Add forcing height and aerodynamic parameters + !----------------------------------------------------------------------- + + !------------------------------------------------------------------ + ! Initialize mathmatical constants + !------------------------------------------------------------------ + + real(r8), public :: rpi = SHR_CONST_PI + + !------------------------------------------------------------------ + ! Initialize physical constants + !------------------------------------------------------------------ + + real(r8), public, parameter :: pc = 0.4 ! threshold probability + real(r8), public, parameter :: mu = 0.13889 ! connectivity exponent + real(r8), public, parameter :: secsphr = 3600._r8 ! Seconds in an hour + integer, public, parameter :: isecsphr = int(secsphr) ! Integer seconds in an hour + integer, public, parameter :: isecspmin= 60 ! Integer seconds in a minute + real(r8), public :: grav = SHR_CONST_G ! gravity constant [m/s2] + real(r8), public :: sb = SHR_CONST_STEBOL ! stefan-boltzmann constant [W/m2/K4] + real(r8), public :: vkc = SHR_CONST_KARMAN ! von Karman constant [-] + real(r8), public :: rwat = SHR_CONST_RWV ! gas constant for water vapor [J/(kg K)] + real(r8), public :: rair = SHR_CONST_RDAIR ! gas constant for dry air [J/kg/K] + real(r8), public :: roverg = SHR_CONST_RWV/SHR_CONST_G*1000._r8 ! Rw/g constant = (8.3144/0.018)/(9.80616)*1000. mm/K + real(r8), public :: cpliq = SHR_CONST_CPFW ! Specific heat of water [J/kg-K] + real(r8), public :: cpice = SHR_CONST_CPICE ! Specific heat of ice [J/kg-K] + real(r8), public :: cpair = SHR_CONST_CPDAIR ! specific heat of dry air [J/kg/K] + real(r8), public :: hvap = SHR_CONST_LATVAP ! Latent heat of evap for water [J/kg] + real(r8), public :: hsub = SHR_CONST_LATSUB ! Latent heat of sublimation [J/kg] + real(r8), public :: hfus = SHR_CONST_LATICE ! Latent heat of fusion for ice [J/kg] + real(r8), public :: denh2o = SHR_CONST_RHOFW ! density of liquid water [kg/m3] + real(r8), public :: denice = SHR_CONST_RHOICE ! density of ice [kg/m3] + real(r8), public :: rgas = SHR_CONST_RGAS ! universal gas constant [J/K/kmole] + real(r8), public :: pstd = SHR_CONST_PSTD ! standard pressure [Pa] + + ! TODO(wjs, 2016-04-08) The following should be used in place of hard-coded constants + ! of 0.622 and 0.378 (which is 1 - 0.622) in various places in the code: + real(r8), public, parameter :: wv_to_dair_weight_ratio = SHR_CONST_MWWV/SHR_CONST_MWDAIR ! ratio of molecular weight of water vapor to that of dry air [-] + + real(r8), public :: tkair = 0.023_r8 ! thermal conductivity of air [W/m/K] + real(r8), public :: tkice = 2.290_r8 ! thermal conductivity of ice [W/m/K] + real(r8), public :: tkwat = 0.57_r8 ! thermal conductivity of water [W/m/K] + real(r8), public, parameter :: tfrz = SHR_CONST_TKFRZ ! freezing temperature [K] + real(r8), public, parameter :: tcrit = 2.5_r8 ! critical temperature to determine rain or snow + real(r8), public :: o2_molar_const = 0.209_r8 ! constant atmospheric O2 molar ratio (mol/mol) + real(r8), public :: oneatm = 1.01325e5_r8 ! one standard atmospheric pressure [Pa] + real(r8), public :: bdsno = 250._r8 ! bulk density snow (kg/m**3) + real(r8), public :: alpha_aero = 1.0_r8 ! constant for aerodynamic parameter weighting + real(r8), public :: tlsai_crit = 2.0_r8 ! critical value of elai+esai for which aerodynamic parameters are maximum + real(r8), public :: watmin = 0.01_r8 ! minimum soil moisture (mm) + real(r8), public :: c_water = SHR_CONST_CPFW ! specific heat of water [J/kg/K] + real(r8), public :: c_dry_biomass = 1400_r8 ! specific heat of dry biomass + + real(r8), public :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) + + real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second + real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day + integer, public, parameter :: isecspday= secspday ! Integer seconds per day + + integer, public, parameter :: fun_period = 1 ! A FUN parameter, and probably needs to be changed for testing + real(r8),public, parameter :: smallValue = 1.e-12_r8 ! A small values used by FUN + + ! ------------------------------------------------------------------------ + ! Special value flags + ! ------------------------------------------------------------------------ + + ! NOTE(wjs, 2015-11-23) The presence / absence of spval should be static in time for + ! multi-level fields. i.e., if a given level & column has spval at initialization, it + ! should remain spval throughout the run (e.g., indicating that this level is not valid + ! for this column type); similarly, if it starts as a valid value, it should never + ! become spval. This is needed for init_interp to work correctly on multi-level fields. + ! For more details, see the note near the top of initInterpMultilevelInterp. + real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data + + ! Keep this negative to avoid conflicts with possible valid values + integer , public, parameter :: ispval = -9999 ! special value for int data + + ! ------------------------------------------------------------------------ + ! These are tunable constants from clm2_3 + ! ------------------------------------------------------------------------ + + real(r8), public :: capr = 0.34_r8 ! Tuning factor to turn first layer T into surface T + real(r8), public :: cnfac = 0.5_r8 ! Crank Nicholson factor between 0 and 1 + real(r8), public :: pondmx = 0.0_r8 ! Ponding depth (mm) + real(r8), public :: pondmx_urban = 1.0_r8 ! Ponding depth for urban roof and impervious road (mm) + + real(r8), public :: thk_bedrock = 3.0_r8 ! thermal conductivity of 'typical' saturated granitic rock + ! (Clauser and Huenges, 1995)(W/m/K) + real(r8), public :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000) + real(r8), public, parameter :: zmin_bedrock = 0.4_r8 ! minimum soil depth [m] + + real(r8), public, parameter :: aquifer_water_baseline = 5000._r8 ! baseline value for water in the unconfined aquifer [mm] + real(r8), public, parameter :: c_to_b = 2.0_r8 ! conversion between mass carbon and total biomass (g biomass /g C) + + !!! C13 + real(r8), public, parameter :: preind_atm_del13c = -6.0 ! preindustrial value for atmospheric del13C + real(r8), public, parameter :: preind_atm_ratio = SHR_CONST_PDB + (preind_atm_del13c * SHR_CONST_PDB)/1000.0 ! 13C/12C + real(r8), public :: c13ratio = preind_atm_ratio/(1.0+preind_atm_ratio) ! 13C/(12+13)C preind atmosphere + + ! typical del13C for C3 photosynthesis (permil, relative to PDB) + real(r8), public, parameter :: c3_del13c = -28._r8 + + ! typical del13C for C4 photosynthesis (permil, relative to PDB) + real(r8), public, parameter :: c4_del13c = -13._r8 + + ! isotope ratio (13c/12c) for C3 photosynthesis + real(r8), public, parameter :: c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8) + + ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis + real(r8), public, parameter :: c3_r2 = c3_r1/(1._r8 + c3_r1) + + ! isotope ratio (13c/12c) for C4 photosynthesis + real(r8), public, parameter :: c4_r1 = SHR_CONST_PDB + ((c4_del13c*SHR_CONST_PDB)/1000._r8) + + ! isotope ratio (13c/[12c+13c]) for C4 photosynthesis + real(r8), public, parameter :: c4_r2 = c4_r1/(1._r8 + c4_r1) + + !!! C14 + real(r8), public :: c14ratio = 1.e-12_r8 + ! real(r8) :: c14ratio = 1._r8 ! debug lets set to 1 to try to avoid numerical errors + + !------------------------------------------------------------------ + ! Urban building temperature constants + !------------------------------------------------------------------ + real(r8), public :: ht_wasteheat_factor = 0.2_r8 ! wasteheat factor for urban heating (-) + real(r8), public :: ac_wasteheat_factor = 0.6_r8 ! wasteheat factor for urban air conditioning (-) + real(r8), public :: em_roof_int = 0.9_r8 ! emissivity of interior surface of roof (Bueno et al. 2012, GMD) + real(r8), public :: em_sunw_int = 0.9_r8 ! emissivity of interior surface of sunwall (Bueno et al. 2012, GMD) + real(r8), public :: em_shdw_int = 0.9_r8 ! emissivity of interior surface of shadewall Bueno et al. 2012, GMD) + real(r8), public :: em_floor_int = 0.9_r8 ! emissivity of interior surface of floor (Bueno et al. 2012, GMD) + real(r8), public :: hcv_roof = 0.948_r8 ! interior convective heat transfer coefficient for roof (Bueno et al. 2012, GMD) (W m-2 K-1) + real(r8), public :: hcv_roof_enhanced = 4.040_r8 ! enhanced (t_roof_int <= t_room) interior convective heat transfer coefficient for roof (Bueno et al. 2012, GMD) !(W m-2 K-1) + real(r8), public :: hcv_floor = 0.948_r8 ! interior convective heat transfer coefficient for floor (Bueno et al. 2012, GMD) (W m-2 K-1) + real(r8), public :: hcv_floor_enhanced = 4.040_r8 ! enhanced (t_floor_int >= t_room) interior convective heat transfer coefficient for floor (Bueno et al. !2012, GMD) (W m-2 K-1) + real(r8), public :: hcv_sunw = 3.076_r8 ! interior convective heat transfer coefficient for sunwall (Bueno et al. 2012, GMD) (W m-2 K-1) + real(r8), public :: hcv_shdw = 3.076_r8 ! interior convective heat transfer coefficient for shadewall (Bueno et al. 2012, GMD) (W m-2 K-1) + real(r8), public :: dz_floor = 0.1_r8 ! floor thickness - concrete (Salmanca et al. 2010, TAC) (m) + real(r8), public, parameter :: dens_floor = 2.35e3_r8 ! density of floor - concrete (Salmanca et al. 2010, TAC) (kg m-3) + real(r8), public, parameter :: sh_floor = 880._r8 ! specific heat of floor - concrete (Salmanca et al. 2010, TAC) (J kg-1 K-1) + real(r8), public :: cp_floor = dens_floor*sh_floor ! volumetric heat capacity of floor - concrete (Salmanca et al. 2010, TAC) (J m-3 K-1) + real(r8), public :: vent_ach = 0.3 ! ventilation rate (air exchanges per hour) + + real(r8), public :: wasteheat_limit = 100._r8 ! limit on wasteheat (W/m2) + + !------------------------------------------------------------------ + + real(r8), public :: h2osno_max = -999.0_r8 ! max allowed snow thickness (mm H2O) + + integer, private :: i ! loop index + + !real(r8), parameter :: nitrif_n2o_loss_frac = 0.02_r8 ! fraction of N lost as N2O in nitrification (Parton et al., 2001) + real(r8), public, parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000) + real(r8), public, parameter :: frac_minrlztn_to_no3 = 0.2_r8 ! fraction of N mineralized that is dieverted to the nitrification stream (Parton et al., 2001) + + !------------------------------------------------------------------ + ! Set subgrid names + !------------------------------------------------------------------ + + character(len=16), public, parameter :: grlnd = 'lndgrid' ! name of lndgrid + character(len=16), public, parameter :: namea = 'gridcellatm' ! name of atmgrid + character(len=16), public, parameter :: nameg = 'gridcell' ! name of gridcells + character(len=16), public, parameter :: namel = 'landunit' ! name of landunits + character(len=16), public, parameter :: namec = 'column' ! name of columns + character(len=16), public, parameter :: namep = 'pft' ! name of patches + character(len=16), public, parameter :: nameCohort = 'cohort' ! name of cohorts (ED specific) + + !------------------------------------------------------------------ + ! Initialize miscellaneous radiation constants + !------------------------------------------------------------------ + + real(r8), public :: betads = 0.5_r8 ! two-stream parameter betad for snow + real(r8), public :: betais = 0.5_r8 ! two-stream parameter betai for snow + real(r8), public :: omegas(numrad) ! two-stream parameter omega for snow by band + data (omegas(i),i=1,numrad) /0.8_r8, 0.4_r8/ + + ! Lake Model Constants will be defined in LakeCon. + + !------------------------------------------------------------------ + ! Soil depths are constants for now; lake depths can vary by gridcell + ! zlak and dzlak correspond to the default 50 m lake depth. + ! The values for the following arrays are set in routine iniTimeConst + !------------------------------------------------------------------ + + real(r8), public, allocatable :: zlak(:) !lake z (layers) + real(r8), public, allocatable :: dzlak(:) !lake dz (thickness) + real(r8), public, allocatable :: zsoi(:) !soil z (layers) + real(r8), public, allocatable :: dzsoi(:) !soil dz (thickness) + real(r8), public, allocatable :: zisoi(:) !soil zi (interfaces) + real(r8), public, allocatable :: dzsoi_decomp(:) !soil dz (thickness) + integer , public, allocatable :: nlvic(:) !number of CLM layers in each VIC layer (#) + real(r8), public, allocatable :: dzvic(:) !soil dz (thickness) of each VIC layer + + !------------------------------------------------------------------ + ! (Non-tunable) Constants for the CH4 submodel (Tuneable constants in ch4varcon) + !------------------------------------------------------------------ + ! Note some of these constants are also used in CNNitrifDenitrifMod + + real(r8), public, parameter :: catomw = 12.011_r8 ! molar mass of C atoms (g/mol) + + real(r8), public :: s_con(ngases,4) ! Schmidt # calculation constants (spp, #) + data (s_con(1,i),i=1,4) /1898_r8, -110.1_r8, 2.834_r8, -0.02791_r8/ ! CH4 + data (s_con(2,i),i=1,4) /1801_r8, -120.1_r8, 3.7818_r8, -0.047608_r8/ ! O2 + data (s_con(3,i),i=1,4) /1911_r8, -113.7_r8, 2.967_r8, -0.02943_r8/ ! CO2 + + real(r8), public :: d_con_w(ngases,3) ! water diffusivity constants (spp, #) (mult. by 10^-4) + data (d_con_w(1,i),i=1,3) /0.9798_r8, 0.02986_r8, 0.0004381_r8/ ! CH4 + data (d_con_w(2,i),i=1,3) /1.172_r8, 0.03443_r8, 0.0005048_r8/ ! O2 + data (d_con_w(3,i),i=1,3) /0.939_r8, 0.02671_r8, 0.0004095_r8/ ! CO2 + + real(r8), public :: d_con_g(ngases,2) ! gas diffusivity constants (spp, #) (cm^2/s) (mult. by 10^-9) + data (d_con_g(1,i),i=1,2) /0.1875_r8, 0.0013_r8/ ! CH4 + data (d_con_g(2,i),i=1,2) /0.1759_r8, 0.00117_r8/ ! O2 + data (d_con_g(3,i),i=1,2) /0.1325_r8, 0.0009_r8/ ! CO2 + + real(r8), public :: c_h_inv(ngases) ! constant (K) for Henry's law (4.12, Wania) + data c_h_inv(1:3) /1600._r8, 1500._r8, 2400._r8/ ! CH4, O2, CO2 + + real(r8), public :: kh_theta(ngases) ! Henry's constant (L.atm/mol) at standard temperature (298K) + data kh_theta(1:3) /714.29_r8, 769.23_r8, 29.4_r8/ ! CH4, O2, CO2 + + real(r8), public :: kh_tbase = 298._r8 ! base temperature for calculation of Henry's constant (K) + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------------ + subroutine clm_varcon_init( is_simple_buildtemp ) + ! + ! !DESCRIPTION: + ! This subroutine initializes constant arrays in clm_varcon. + ! MUST be called after clm_varpar_init. + ! + ! !USES: + use clm_varpar, only: nlevgrnd, nlevlak, nlevdecomp_full, nlayer + ! + ! !ARGUMENTS: + implicit none + logical, intent(in) :: is_simple_buildtemp ! If simple building temp method is being used + ! + ! !REVISION HISTORY: + ! Created by E. Kluzek +!------------------------------------------------------------------------------ + + allocate( zlak(1:nlevlak )) + allocate( dzlak(1:nlevlak )) + allocate( zsoi(1:nlevgrnd )) + allocate( dzsoi(1:nlevgrnd )) + allocate( zisoi(0:nlevgrnd )) + allocate( dzsoi_decomp(1:nlevdecomp_full )) + allocate( nlvic(1:nlayer )) + allocate( dzvic(1:nlayer )) + + ! Zero out wastheat factors for simpler building temperature method (introduced in CLM4.5) + if ( is_simple_buildtemp )then + ht_wasteheat_factor = 0.0_r8 + ac_wasteheat_factor = 0.0_r8 + end if + + end subroutine clm_varcon_init + + !----------------------------------------------------------------------- + subroutine clm_varcon_clean() + ! + ! !DESCRIPTION: + ! Deallocate variables allocated by clm_varcon_init + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'clm_varcon_clean' + !----------------------------------------------------------------------- + + deallocate(zlak) + deallocate(dzlak) + deallocate(zsoi) + deallocate(dzsoi) + deallocate(zisoi) + deallocate(dzsoi_decomp) + deallocate(nlvic) + deallocate(dzvic) + + end subroutine clm_varcon_clean + + +end module clm_varcon diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 new file mode 100644 index 000000000..8ff193dc7 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -0,0 +1,60 @@ +module clm_varctl + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varctl +! +! !DESCRIPTION: +! Module containing run control variables +! +! !USES: + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 +! +! !PUBLIC MEMBER FUNCTIONS: + public init_clm_varctl ! set parameters + implicit none + + logical, public :: use_luna = .false. ! true => use LUNA + logical, public :: use_fates = .false. ! true => use fates + logical, public :: use_hydrstress = .true. ! true => use plant hydraulic stress calculation + + + ! If prognostic crops are turned on + logical, public :: use_crop = .false. + + logical, public :: use_lch4 = .false. + logical, public :: use_nitrif_denitrif = .false. + logical, public :: use_vertsoilc = .false. + logical, public :: use_century_decomp = .false. + logical, public :: use_cn = .true. + logical, public :: use_cndv = .false. + + + logical, public :: use_c13 = .false. ! true => use C-13 model + logical, public :: use_c14 = .false. ! true => use C-14 model + !---------------------------------------------------------- + ! CN matrix + !---------------------------------------------------------- + logical, public :: use_matrixcn = .false. !.false. ! true => use cn matrix + logical, public :: use_soil_matrixcn = .false.! true => use cn matrix + + real(r8), public :: nfix_timeconst = -1.2345_r8 + +contains + +!--------------------------------------- + subroutine init_clm_varctl() + + !--- + if (nfix_timeconst == -1.2345_r8) then + if (use_nitrif_denitrif) then + nfix_timeconst = 10._r8 + else + nfix_timeconst = 0._r8 + end if + end if + + end subroutine init_clm_varctl + +end module clm_varctl diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 new file mode 100644 index 000000000..1ae2269ec --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -0,0 +1,195 @@ +module clm_varpar + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varpar +! +! !DESCRIPTION: +! Module containing CLM parameters +! +! !USES: +! +! !PUBLIC TYPES: + implicit none + save + +! Define number of levels + + integer, parameter :: nlevsoi = 1 ! number of hydrologically active soil layers + integer, parameter :: nlevgrnd = 1 ! number of ground layers (includes lower layers that are hydrologically inactive) + integer, parameter :: nlevsno = 0 ! maximum number of snow layers + integer, public :: nlevurb = 5 ! number of urban layers; jk Oct 2021: using CTSM5.1 value for now + integer, public :: nlevmaxurbgrnd ! maximum of the number of ground and urban layers + integer, public, parameter :: nlayer = 3 ! number of VIC soil layer --Added by AWang + + integer, public :: nlevlak ! number of lake layers + integer, public :: nlevdecomp ! number of biogeochemically active soil layers + integer, public :: nlevdecomp_full ! number of biogeochemical layers + ! (includes lower layers that are biogeochemically inactive) + + integer, public :: ndecomp_pools + integer, public :: ndecomp_cascade_transitions + integer, public :: ndecomp_cascade_outtransitions + + ! for soil matrix + integer, public :: ndecomp_pools_vr !total number of pools ndecomp_pools*vertical levels + + integer, parameter :: numpft = 15!19 ! actual # of pfts (without bare), 16 here, since we are removing the spli types + integer, parameter :: mxpft = 15 ! + integer, public, parameter :: nvariants = 2 ! number of variants of PFT constants + + integer, public, parameter :: numrad = 2 ! number of solar radiation bands: vis, nir + integer, public, parameter :: nlevcan = 1 ! number of leaf layers in canopy layer + integer, public, parameter :: nvegwcs = 4 ! number of vegetation water conductance segments + + integer, parameter, PUBLIC :: NUM_ZON=3 ! number of CN hydrology zones per tile + integer, parameter, PUBLIC :: NUM_VEG=4 ! number of CN PFTs per zone + integer, parameter, PUBLIC :: VAR_COL=35 ! number of CN column restart variables + integer, parameter, PUBLIC :: VAR_PFT=75 ! number of CN PFT variables per column + real, parameter, PUBLIC, dimension(NUM_ZON) :: CN_zone_weight = (/0.10,0.45,0.45/) ! gkw: tunable; must sum to 1 + + ! constants for decomposition cascade + + integer, public, parameter :: i_met_lit = 1 + integer, public, parameter :: i_cel_lit = i_met_lit + 1 + integer, public, parameter :: i_lig_lit = i_cel_lit + 1 + integer, public :: i_cwd + + !Matrix index (when use_matrixcn) + integer, public, parameter :: ileaf = 1 ! leaf pool index + integer, public, parameter :: ileaf_st = 2 ! leaf storage pool index + integer, public, parameter :: ileaf_xf = 3 ! leaf transfer pool index + integer, public, parameter :: ifroot = 4 ! fine root pool index + integer, public, parameter :: ifroot_st = 5 ! fine root storage pool index + integer, public, parameter :: ifroot_xf = 6 ! fine root transfer pool index + integer, public, parameter :: ilivestem = 7 ! live stem pool index + integer, public, parameter :: ilivestem_st = 8 ! live stem storage pool index + integer, public, parameter :: ilivestem_xf = 9 ! live stem transfer pool index + integer, public, parameter :: ideadstem = 10 ! dead stem pool index + integer, public, parameter :: ideadstem_st = 11 ! dead stem storage pool index + integer, public, parameter :: ideadstem_xf = 12 ! dead stem transfer pool index + integer, public, parameter :: ilivecroot = 13 ! live coarse root pool index + integer, public, parameter :: ilivecroot_st = 14 ! live coarse root storage pool index + integer, public, parameter :: ilivecroot_xf = 15 ! live coarse root transfer pool index + integer, public, parameter :: ideadcroot = 16 ! dead coarse root pool index + integer, public, parameter :: ideadcroot_st = 17 ! dead coarse root storage pool index + integer, public, parameter :: ideadcroot_xf = 18 ! dead coarse root transfer pool index + integer, public, parameter :: igrain = 19 ! grain pool index + integer, public, parameter :: igrain_st = 20 ! grain storage pool index + integer, public, parameter :: igrain_xf = 21 ! grain transfer pool + + integer, public :: ncphtrans !maximum number of vegetation C transfers through phenology + integer, public :: ncphouttrans !maximum number of vegetation C transfers out of vegetation through phenology + integer, public :: ncgmtrans !maximum number of vegetation C transfers through gap mortality + integer, public :: ncgmouttrans !maximum number of vegetation C transfers out of vegetation through gap mortality + integer, public :: ncfitrans !maximum number of vegetation C transfers through fire + integer, public :: ncfiouttrans !maximum number of vegetation C transfers out of vegetation trhough fire + integer, public :: nnphtrans !maximum number of vegetation N transfers through phenology + integer, public :: nnphouttrans !maximum number of vegetation N transfers out of vegetation through phenology + integer, public :: nngmtrans !maximum number of vegetation N transfers through gap mortality + integer, public :: nngmouttrans !maximum number of vegetation N transfers out of vegetation through gap mortality + integer, public :: nnfitrans !maximum number of vegetation N transfers through fire + integer, public :: nnfiouttrans !maximum number of vegetation N transfers out of vegetation trhough fire + + integer, public :: iretransn ! retranslocation pool index + integer, public :: ioutc ! external C pool index + integer, public :: ioutn ! external N pool index + + + integer, public, parameter :: nvegpool_natveg = 18 ! number of vegetation matrix pool without crop + integer, public, parameter :: nvegpool_crop = 3 ! number of vegetation matrix pool with crop + integer, public, parameter :: nveg_retransn = 1 ! number of vegetation retranslocation pool + integer, public :: nvegcpool ! number of vegetation C pools + integer, public :: nvegnpool ! number of vegetation N pools + + + + nlevmaxurbgrnd = max0(nlevurb,nlevgrnd) + nlevmaxurbgrnd = nlevgrnd ! jkolassa: set this here, since we are not modelling urban tiles for now + +contains + +!------------------------------------ + subroutine clm_varpar_init() +! +! !DESCRIPTION: +! This subroutine initializes parameters in clm_varpar +! +! +! !ARGUMENTS: + implicit none + +!---------------------------- + + ! here is a switch to set the number of soil levels for the biogeochemistry calculations. + ! currently it works on either a single level or on nlevsoi and nlevgrnd levels + if (use_vertsoilc) then + nlevdecomp = nlevsoi + nlevdecomp_full = nlevgrnd + else + nlevdecomp = 1 + nlevdecomp_full = 1 + end if + + if (.not. use_extralakelayers) then + nlevlak = 10 ! number of lake layers + else + nlevlak = 25 ! number of lake layers (Yields better results for site simulations) + end if + + if ( use_fates ) then + i_cwd = 0 + if (use_century_decomp) then + ndecomp_pools = 6 + ndecomp_cascade_transitions = 8 + else + ndecomp_pools = 7 + ndecomp_cascade_transitions = 7 + end if + else + i_cwd = 4 + if (use_century_decomp) then + ndecomp_pools = 7 + ndecomp_cascade_transitions = 10 + ndecomp_cascade_outtransitions = 0 + else + ndecomp_pools = 8 + ndecomp_cascade_transitions = 9 + ndecomp_cascade_outtransitions = 1 + end if + endif + ndecomp_pools_vr = ndecomp_pools * nlevdecomp + + if (use_crop)then + nvegcpool = nvegpool_natveg + nvegpool_crop + ncphtrans = 18 + nnphtrans = 37 + ncphouttrans = 4 + nnphouttrans = 5 + else + nvegcpool = nvegpool_natveg + ncphtrans = 17 + nnphtrans = 34 + ncphouttrans = 3 + nnphouttrans = 4 + end if + ncgmtrans = 18 + ncgmouttrans = 18 + ncfitrans = 20 + ncfiouttrans = 18 + nngmtrans = 19 + nngmouttrans = 19 + nnfitrans = 21 + nnfiouttrans = 19 + nvegnpool = nvegcpool + 1 + iretransn = nvegnpool + ioutc = nvegcpool + 1 + ioutn = nvegnpool + 1 + + + end subroutine clm_varpar_init + +end module clm_varpar +! + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_const_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_const_mod.F90 new file mode 100644 index 000000000..7131aee5e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_const_mod.F90 @@ -0,0 +1,24 @@ +!=============================================================================== +! SVN $Id: shr_const_mod.F90,v 1.1.1.1 2015/11/13 19:45:25 bmauer Exp $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/ccsm4_0_rel_tags/ccsm4_0_rel_02_share3_100228/shr/shr_const_mod.F90 $ +!=============================================================================== + +MODULE shr_const_mod + + use MAPL_ConstantsMod ! use GEOS5 constants + + !---------------------------------------------------------------------------- + ! physical constants (all data public) + !---------------------------------------------------------------------------- + public + + real,parameter :: SHR_CONST_PI = MAPL_PI ! pi + real,parameter :: SHR_CONST_CDAY = 86400.0 ! sec in calendar day ~ sec + real,parameter :: SHR_CONST_G = MAPL_GRAV ! acceleration of gravity ~ m/s^2 + real,parameter :: SHR_CONST_RGAS = MAPL_RUNIV ! Universal gas constant ~ J/K/kmole + real,parameter :: SHR_CONST_TKFRZ = MAPL_TICE ! freezing T of fresh water ~ K + real,parameter :: SHR_CONST_RHOFW = MAPL_RHOWTR ! density of fresh water ~ kg/m^3 + real,parameter :: SHR_CONST_PDB = 0.0112372 ! ratio of 13C/12C in Pee Dee Belemnite (C isotope standard) + + +END MODULE shr_const_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_kind_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_kind_mod.F90 new file mode 100644 index 000000000..5536ddc73 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_kind_mod.F90 @@ -0,0 +1,21 @@ +MODULE shr_kind_mod + + use MAPL_ConstantsMod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = MAPL_R8 ! 8 byte real + integer,parameter :: SHR_KIND_R4 = MAPL_R4 ! 4 byte real + integer,parameter :: SHR_KIND_RN = MAPL_RN ! native real + integer,parameter :: SHR_KIND_I8 = MAPL_I8 ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = MAPL_I4 ! 4 byte integer + integer,parameter :: SHR_KIND_IN = MAPL_IN ! native integer + integer,parameter :: SHR_KIND_CS = 80 ! short char + integer,parameter :: SHR_KIND_CM = 160 ! mid-sized char + integer,parameter :: SHR_KIND_CL = 256 ! long char + integer,parameter :: SHR_KIND_CX = 512 ! extra-long char + integer,parameter :: SHR_KIND_CXX= 4096 ! extra-extra-long char + +END MODULE shr_kind_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 new file mode 100644 index 000000000..4c8e3074d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -0,0 +1,8374 @@ +! $Id$ + +#include "MAPL_Generic.h" +#define DEALLOC_(A) if(associated(A))then;A=0;if(MAPL_ShmInitialized)then; call MAPL_DeAllocNodeArray(A,rc=STATUS);else; deallocate(A,stat=STATUS);endif;_VERIFY(STATUS);NULLIFY(A);endif + +!============================================================================= +module GEOS_CatchCNCLM51GridCompMod + +!BOP +! !MODULE: GEOS_CatchCN --- ESMF gridded component implementing CatchmentCN LSM + +! !DESCRIPTION: +! +! {\tt Catch} is a gridded component to compute the energy and water +! fluxes due to land-surface processes, using the Catchment LSM +! of Koster et al. (2014). +! Koster, R. D., G. Walker, G. J. Collatz, and P. E. Thornton, 2014. +! Hydroclimatic controls on the means and variability of vegetation +! phenology and carbon uptake. J. Climate, 27, 5632-5652. doi: +! 10.1175/JCLI-D-13-00477.1. +! All of its calculations are done +! in a tile space defined by the inherited location stream. +! It has a two-stage run method. The first stage obtains +! drag coefficients at all the subtiles and defines +! effective tile-mean surface quantities. The second +! stage calls the Catchment-CN LSM. {\tt CatchCN} has no children. + +! +! !USES: + + use sfclayer ! using module that contains sfc layer code + use ESMF + use GEOS_Mod + use GEOS_UtilsMod + use DragCoefficientsMod + use CATCHMENT_CN_MODEL + use compute_rc_mod + use CN_DriverMod + use CN_initMod + USE STIEGLITZSNOW, ONLY : & + snow_albedo, StieglitzSnow_calc_tpsnow, N_CONSTIT, & + NUM_DUDP, NUM_DUSV, NUM_DUWT, NUM_DUSD, & + NUM_BCDP, NUM_BCSV, NUM_BCWT, NUM_BCSD, & + NUM_OCDP, NUM_OCSV, NUM_OCWT, NUM_OCSD, & + NUM_SUDP, NUM_SUSV, NUM_SUWT, NUM_SUSD, & + NUM_SSDP, NUM_SSSV, NUM_SSWT, NUM_SSSD, & + StieglitzSnow_calc_asnow + + USE CATCH_CONSTANTS, ONLY : & + N_GT => CATCH_N_GT, & + N_SNOW => CATCH_N_SNOW, & + RHOFS => CATCH_SNWALB_RHOFS, & + SNWALB_VISMAX => CATCH_SNWALB_VISMAX, & + SNWALB_NIRMAX => CATCH_SNWALB_NIRMAX, & + SLOPE => CATCH_SNWALB_SLOPE + + USE clm_varpar, ONLY : & + NUM_ZON, NUM_VEG, VAR_COL, VAR_PFT, & + CN_zone_weight, map_cat, numpft + + USE MAPL + use MAPL_ConstantsMod,only: Tzero => MAPL_TICE, pi => MAPL_PI + use clm_time_manager, only: get_days_per_year, get_step_size + use pftvarcon, only: noveg + USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & + catch_calc_zbar, catch_calc_watertabled, irrigation_rate, & + gndtmp + + use update_model_para4cn, only : upd_curr_date_time + +implicit none +private + + include "netcdf.inc" + +! !PUBLIC MEMBER FUNCTIONS: + +public SetServices + +! +!EOP + +integer,parameter :: FSAT=1 ! Saturated subtile +integer,parameter :: FTRN=2 ! Transition subtile +integer,parameter :: FWLT=3 ! Wilting subtile +integer,parameter :: FSNW=4 ! Snowcover subtile + +integer,parameter :: NUM_SUBTILES=4 + +! Vegetation type as follows: +! 1: BROADLEAF EVERGREEN TREES +! 2: BROADLEAF DECIDUOUS TREES +! 3: NEEDLELEAF TREES +! 4: GROUND COVER +! 5: BROADLEAF SHRUBS +! 6: DWARF TREES (TUNDRA) +!=================================================== +!ALT: we currently use only 6 types (see above) +! in the legacy code we used to have 8 +! (or 10 with the sea and land ice) with +! these additional entries +! 7: BARE SOIL +! 8: DESERT + +integer :: NUM_ENSEMBLE +integer,parameter :: NTYPS = MAPL_NUMVEGTYPES + +real, parameter :: HPBL = 1000. +real, parameter :: MIN_VEG_HEIGHT = 0.01 +real, parameter :: Z0_BY_ZVEG = 0.13 +real, parameter :: D0_BY_ZVEG = 0.66 + +! Emissivity values from Wilber et al (1999, NATA-TP-1999-209362) +! Fu-Liou bands have been combined to Chou bands (though these are broadband only) +! IGBP veg types have been mapped to Sib-Mosaic types +! Details in ~suarez/Emiss on cerebus + +real, parameter :: EMSVEG(NTYPS) = (/ 0.99560, 0.99000, 0.99560, 0.99320, & + 0.99280, 0.99180 /) +real, parameter :: EMSBARESOIL = 0.94120 +real, parameter :: EMSSNO = 0.99999 + +! moved SURFLAY from catchment.F90 to enable run-time changes for off-line system +! - reichle, 29 Oct 2010 + +! ROOTL import from GEOS_VegdynGridComp was disabled and brought the look up table +! in order to obtain ROOTL for primary and secondary types. + +! map catchment type into PFT +! --------------------------- +!PFT Description +! 0 bare +! 1 needleleaf evergreen temperate tree +! 2 needleleaf evergreen boreal tree +! 3 needleleaf deciduous boreal tree +! 4 broadleaf evergreen tropical tree +! 5 broadleaf evergreen temperate tree +! 6 broadleaf deciduous tropical tree +! 7 broadleaf deciduous temperate tree +! 8 broadleaf deciduous boreal tree +! 9 broadleaf evergreen temperate shrub +! 10 broadleaf deciduous temperate shrub [moisture + deciduous] +! 11 broadleaf deciduous temperate shrub [moisture stress only] +! 12 broadleaf deciduous boreal shrub +! 13 arctic c3 grass +! 14 cool c3 grass [moisture + deciduous] +! 15 cool c3 grass [moisture stress only] +! 16 warm c4 grass [moisture + deciduous] +! 17 warm c4 grass [moisture stress only] +! 18 crop [moisture + deciduous] +! 19 crop [moisture stress only] + +! Catchment types and PFT mapping: +! +! 1: BROADLEAF EVERGREEN TREES => 4,5 +! 2: BROADLEAF DECIDUOUS TREES => 6,7,8 +! 3: NEEDLELEAF TREES => 1,2,3 +! 4: GROUND COVER => 13-19 +! 5: BROADLEAF SHRUBS => 9,10,11 +! 6: DWARF TREES (TUNDRA) => 12 +! 7: BARE SOIL => 0 +! 8: DESERT => 0 +! 9: ICE => n/a + +! index map for CLM PFTs --> catchment veg types + +! pchakrab: save the logical variable OFFLINE +! Internal state and its wrapper +type T_OFFLINE_MODE + private + integer :: CATCH_OFFLINE +end type T_OFFLINE_MODE +type OFFLINE_WRAP + type(T_OFFLINE_MODE), pointer :: ptr=>null() +end type OFFLINE_WRAP + +integer :: RUN_IRRIG, USE_ASCATZ0, Z0_FORMULATION, IRRIG_METHOD, AEROSOL_DEPOSITION, N_CONST_LAND4SNWALB +integer :: ATM_CO2, CHOOSEMOSFC +real :: SURFLAY ! Default (Ganymed-3 and earlier) SURFLAY=20.0 for Old Soil Params + ! (Ganymed-4 and later ) SURFLAY=50.0 for New Soil Params +real :: CO2 +integer :: CO2_YEAR_IN ! years when atmospheric carbon dioxide concentration increases, starting from 1850 +real :: DTCN ! Time step for carbon/nitrogen routines in CatchmentCN model (default 5400) +real :: FWETC, FWETL +logical :: USE_FWET_FOR_RUNOFF + +contains + +!BOP + +! !IROUTINE: SetServices -- Sets ESMF services for component +! !INTERFACE: + +subroutine SetServices ( GC, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp),intent(INOUT) :: GC + integer, optional, intent( OUT) :: RC + +! !DESCRIPTION: +! This version uses GEOS\_GenericSetServices, overriding +! only the run method. It also relies on MAPL\_Generic to +! handle data services. + +!EOP +! +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + +! Local Variables + + type(MAPL_MetaComp), pointer :: MAPL=>null() + type(T_OFFLINE_MODE), pointer :: internal=>null() + type(OFFLINE_WRAP) :: wrap + integer :: OFFLINE_MODE + integer :: RESTART + character(len=ESMF_MAXSTR) :: SURFRC + type(ESMF_Config) :: SCF + +! Begin... +! -------- + +! Get my name and set-up traceback handle +! ------------------------------------------------------------------------------ + + Iam='SetServices' + call ESMF_GridCompGet ( GC, NAME=COMP_NAME, RC=STATUS ) + VERIFY_(STATUS) + Iam=trim(COMP_NAME)//trim(Iam) + +! pchakrab: Read CATCHMENT_OFFLINE from resource file and save +! it in the private internal state of the GridComp. It is a little +! unusual to read resource file in SetServices, but we need to know +! at this stage where we are running Catch in the offline mode or not + + allocate(internal, stat=status) + VERIFY_(status) + wrap%ptr => internal + call ESMF_UserCompSetInternalState(gc, 'OfflineMode', wrap, status) + + call MAPL_GetObjectFromGC(gc, MAPL, rc=status) + VERIFY_(status) + call MAPL_GetResource ( MAPL, OFFLINE_MODE, Label="CATCHMENT_OFFLINE:", DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + wrap%ptr%CATCH_OFFLINE = OFFLINE_MODE + + call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetResource (MAPL, SURFRC, label = 'SURFRC:', default = 'GEOS_SurfaceGridComp.rc', RC=STATUS) ; VERIFY_(STATUS) + SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) + call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) + + call MAPL_GetResource (SCF, SURFLAY, label='SURFLAY:', DEFAULT=50., __RC__ ) + call MAPL_GetResource (SCF, Z0_FORMULATION, label='Z0_FORMULATION:', DEFAULT=4, __RC__ ) + call MAPL_GetResource (SCF, USE_ASCATZ0, label='USE_ASCATZ0:', DEFAULT=0, __RC__ ) + call MAPL_GetResource (SCF, RUN_IRRIG, label='RUN_IRRIG:', DEFAULT=0, __RC__ ) + call MAPL_GetResource (SCF, IRRIG_METHOD, label='IRRIG_METHOD:', DEFAULT=0, __RC__ ) + call MAPL_GetResource (SCF, CHOOSEMOSFC, label='CHOOSEMOSFC:', DEFAULT=1, __RC__ ) + call MAPL_GetResource (SCF, USE_FWET_FOR_RUNOFF, label='USE_FWET_FOR_RUNOFF:', DEFAULT=.FALSE., __RC__ ) + + if (.NOT. USE_FWET_FOR_RUNOFF) then + call MAPL_GetResource (SCF, FWETC, label='FWETC:', DEFAULT= 0.02, __RC__ ) + call MAPL_GetResource (SCF, FWETL, label='FWETL:', DEFAULT= 0.02, __RC__ ) + else + call MAPL_GetResource (SCF, FWETC, label='FWETC:', DEFAULT=0.005, __RC__ ) + call MAPL_GetResource (SCF, FWETL, label='FWETL:', DEFAULT=0.025, __RC__ ) + endif + + ! GOSWIM ANOW_ALBEDO + ! 0 : GOSWIM snow albedo scheme is turned off + ! 9 : i.e. N_CONSTIT in Stieglitz to turn on GOSWIM snow albedo scheme + call MAPL_GetResource (SCF, N_CONST_LAND4SNWALB, label='N_CONST_LAND4SNWALB:', DEFAULT=0 , __RC__ ) + + ! Get parameters to zero the deposition rate + ! 1: Use all GOCART aerosol values, 0: turn OFF everythying, + ! 2: turn off dust ONLY,3: turn off Black Carbon ONLY,4: turn off Organic Carbon ONLY + ! __________________________________________ + call MAPL_GetResource (SCF, AEROSOL_DEPOSITION, label='AEROSOL_DEPOSITION:' , DEFAULT=0 , __RC__ ) + + ! CATCHCN + call MAPL_GetResource (SCF, DTCN, label='DTCN:', DEFAULT=5400. , __RC__ ) + ! ATM_CO2 + ! 0: uses a fix value defined by CO2 + ! 1: CT tracker monthly mean diurnal cycle + ! 2: CT tracker monthly mean diurnal cycle scaled to match EEA global average CO2 + ! 3: spatially fixed interannually varyiing CMIP from getco2.F90 look up table (AGCM only) + ! 4: import AGCM model CO2 (AGCM only) + call MAPL_GetResource (SCF, ATM_CO2, label='ATM_CO2:', DEFAULT=2 , __RC__ ) + + ! Global mean CO2 + call MAPL_GetResource (SCF, CO2, label='CO2:', DEFAULT=350.e-6, __RC__ ) + call MAPL_GetResource (SCF, CO2_YEAR_IN, label='CO2_YEAR:', DEFAULT= -9999, __RC__ ) + call ESMF_ConfigDestroy(SCF, __RC__) + +! Set the Run entry points +! ------------------------ + + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, RUN1, RC=STATUS ) + VERIFY_(STATUS) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, RUN2, RC=STATUS ) + VERIFY_(STATUS) + + +! Set the state variable specs. +! ----------------------------- + +!BOS + +! !IMPORT STATE: + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_pressure' ,& + UNITS = 'Pa' ,& + SHORT_NAME = 'PS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_air_temperature' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TA' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_air_specific_humidity',& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QA' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_wind_speed' ,& + UNITS = 'm s-1' ,& + SHORT_NAME = 'UU' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'levellm_uwind', & + UNITS = 'm s-1', & + SHORT_NAME = 'UWINDLMTILE', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'levellm_vwind', & + UNITS = 'm s-1', & + SHORT_NAME = 'VWINDLMTILE', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'liquid_water_convective_precipitation',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'PCU' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'liquid_water_large_scale_precipitation',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'PLS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'snowfall' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'SNO' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'icefall' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'ICE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'freezing_rain_fall' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FRZR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_downwelling_par_beam_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'DRPAR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_downwelling_par_diffuse_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'DFPAR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_downwelling_nir_beam_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'DRNIR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_downwelling_nir_diffuse_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'DFNIR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_downwelling_uvr_beam_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'DRUVR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_downwelling_uvr_diffuse_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'DFUVR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_downwelling_longwave_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'LWDNSRF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'linearization_of_surface_upwelling_longwave_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'ALW' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'linearization_of_surface_upwelling_longwave_flux',& + UNITS = 'W_m-2 K-1' ,& + SHORT_NAME = 'BLW' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + IF (ATM_CO2 == 4) THEN + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CO2SC', & + LONG_NAME = 'CO2 Surface Concentration Bin 001', & + UNITS = '1e-6', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + ENDIF + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'leaf_area_index' ,& + UNITS = '1' ,& + SHORT_NAME = 'LAI' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'greeness_fraction' ,& + UNITS = '1' ,& + SHORT_NAME = 'GRN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'evaporation' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'EVAP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'derivative_of_evaporation_wrt_QS',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'DEVAP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'upward_sensible_heat_flux' ,& + UNITS = 'W m-2' ,& + SHORT_NAME = 'SH' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'derivative_of_sensible_heat_wrt_Ts',& + UNITS = 'W m-2 K-1' ,& + SHORT_NAME = 'DSH' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'surface_layer_height' ,& + UNITS = 'm' ,& + SHORT_NAME = 'DZ' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'vegetation_root_length' ,& + UNITS = 'm' ,& + SHORT_NAME = 'ROOTL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'canopy_height' ,& + UNITS = 'm' ,& + SHORT_NAME = 'Z2CH' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'THATM', & + LONG_NAME = 'effective_surface_skin_temperature',& + UNITS = 'K', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'QHATM', & + LONG_NAME = 'effective_surface_specific_humidity',& + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CTATM', & + LONG_NAME = 'surface_exchange_coefficient_for_heat', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CQATM', & + LONG_NAME = 'surface_exchange_coefficient_for_moisture', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'ASCATZ0' ,& + LONG_NAME = 'ASCAT_roughness_length' ,& + UNITS = 'm' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'NDVI' ,& + LONG_NAME = 'normalized_difference_vegetation_index' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'dust_dry_depos_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'DUDP', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_DUDP/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'dust_wet_depos_conv_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'DUSV', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_DUSV/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'dust_wet_depos_ls_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'DUWT', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_DUWT/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'dust_gravity_sett_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'DUSD', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_DUSD/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'black_carbon_dry_depos_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'BCDP', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_BCDP/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'black_carbon_wet_depos_conv_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'BCSV', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_BCSV/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'black_carbon_wet_depos_ls_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'BCWT', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_BCWT/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'black_carbon_gravity_sett_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'BCSD', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_BCSD/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'organic_carbon_dry_depos_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'OCDP', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_OCDP/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'organic_carbon_wet_depos_conv_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'OCSV', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_OCSV/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'organic_carbon_wet_depos_ls_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'OCWT', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_OCWT/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'organic_carbon_gravity_sett_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'OCSD', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_OCSD/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'sulfate_dry_depos_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SUDP', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_SUDP/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'sulfate_wet_depos_conv_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SUSV', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_SUSV/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'sulfate_wet_depos_ls_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SUWT', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_SUWT/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'sulfate_gravity_sett_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SUSD', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_SUSD/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'sea_salt_dry_depos_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SSDP', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_SSDP/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'sea_salt_wet_depos_conv_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SSSV', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_SSSV/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'sea_salt_wet_depos_ls_scav_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SSWT', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_SSWT/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + LONG_NAME = 'sea_salt_gravity_sett_all_bins', & + UNITS = 'kg m-2 s-1', & + SHORT_NAME = 'SSSD', & + DIMS = MAPL_DimsTileOnly, & + UNGRIDDED_DIMS = (/NUM_SSSD/), & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + +! !INTERNAL STATE: + +! if is_offline, some variables ( in the last) are not required + if ( OFFLINE_MODE == 1 ) then + RESTART = MAPL_RestartSkip + elseif ( OFFLINE_MODE == 2 ) then + RESTART = MAPL_RestartOptional + elseif ( OFFLINE_MODE == 0 ) then + RESTART = MAPL_RestartRequired + else + ASSERT_(.FALSE.) + endif + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_1' ,& + UNITS = 'kg m-4' ,& + SHORT_NAME = 'BF1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_2' ,& + UNITS = 'm' ,& + SHORT_NAME = 'BF2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_3' ,& + UNITS = 'log(m)' ,& + SHORT_NAME = 'BF3' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'max_rootzone_water_content',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'VGWMAX' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'moisture_threshold' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CDCR1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'max_water_content' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CDCR2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'saturated_matric_potential',& + UNITS = 'm' ,& + SHORT_NAME = 'PSIS' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'clapp_hornberger_b' ,& + UNITS = '1' ,& + SHORT_NAME = 'BEE' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'soil_porosity' ,& + UNITS = '1' ,& + SHORT_NAME = 'POROS' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'wetness_at_wilting_point' ,& + UNITS = '1' ,& + SHORT_NAME = 'WPWET' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'sfc_sat_hydraulic_conduct' ,& + UNITS = 'm s-1' ,& + SHORT_NAME = 'COND' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'vertical_transmissivity' ,& + UNITS = 'm-1' ,& + SHORT_NAME = 'GNU' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'wetness_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARS1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'wetness_param_2' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARS2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'wetness_param_3' ,& + UNITS = 'm+4 kg-2' ,& + SHORT_NAME = 'ARS3' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'shape_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARA1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'shape_param_2' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARA2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'shape_param_3' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARA3' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'shape_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARA4' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'min_theta_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARW1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'min_theta_param_2' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARW2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'min_theta_param_3' ,& + UNITS = 'm+4 kg-2' ,& + SHORT_NAME = 'ARW3' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'min_theta_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARW4' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'water_transfer_param_1' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSA1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'water_transfer_param_2' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSA2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'water_transfer_param_3' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSB1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'water_transfer_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSB2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'water_transfer_param_5' ,& + UNITS = '1' ,& + SHORT_NAME = 'ATAU' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'water_transfer_param_6' ,& + UNITS = '1' ,& + SHORT_NAME = 'BTAU' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'vegetation_type' ,& + UNITS = '1' ,& + SHORT_NAME = 'ITY' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_VEG/) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'vegetation_fraction' ,& + UNITS = '1' ,& + SHORT_NAME = 'FVG' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_VEG/) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'canopy_temperature' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TC' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileTile ,& + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'canopy_specific_humidity' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QC' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileTile ,& + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'ground_temperature' ,& + UNITS = '1' ,& + SHORT_NAME = 'TG' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileTile ,& + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'interception_reservoir_capac',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CAPAC' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'catchment_deficit' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CATDEF' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'root_zone_excess' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RZEXC' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'surface_excess' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'SRFEXC' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'soil_heat_content_layer_1' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'soil_heat_content_layer_2' ,& + UNITS = 'J_m-2' ,& + SHORT_NAME = 'GHTCNT2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'soil_heat_content_layer_3' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT3' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'soil_heat_content_layer_4' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT4' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'soil_heat_content_layer_5' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT5' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'soil_heat_content_layer_6' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT6' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'mean_catchment_temp_incl_snw',& + UNITS = 'K' ,& + SHORT_NAME = 'TSURF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = RESTART ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'snow_mass_layer_1' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'snow_mass_layer_2' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'snow_mass_layer_3' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN3' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'heat_content_snow_layer_1' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'heat_content_snow_layer_2' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'heat_content_snow_layer_3' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN3' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'snow_depth_layer_1' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN1' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'snow_depth_layer_2' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN2' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'snow_depth_layer_3' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN3' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'surface_heat_exchange_coefficient',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CH' ,& + DIMS = MAPL_DimsTileTile ,& + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = RESTART ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'surface_momentum_exchange_coefficient',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CM' ,& + DIMS = MAPL_DimsTileTile ,& + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = RESTART ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'surface_moisture_exchange_coffiecient',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CQ' ,& + DIMS = MAPL_DimsTileTile ,& + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = RESTART ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'subtile_fractions' ,& + UNITS = '1' ,& + SHORT_NAME = 'FR' ,& + DIMS = MAPL_DimsTileTile ,& + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = RESTART ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'WW', & + LONG_NAME = 'vertical_velocity_scale_squared', & + UNITS = 'm+2 s-2', & + DIMS = MAPL_DimsTileTile, & + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone, & + RESTART = RESTART ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'DCH', & + LONG_NAME = 'ch difference, optional in louissurface', & + UNITS = '1', & + DIMS = MAPL_DimsTileTile, & + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'DCQ', & + LONG_NAME = 'cq difference, optional in louissurface', & + UNITS = '1', & + DIMS = MAPL_DimsTileTile, & + NUM_SUBTILES = NUM_SUBTILES ,& + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'catchment_tile_id' ,& + UNITS = '1' ,& + SHORT_NAME = 'TILE_ID' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_nitrogen_deposition' ,& + UNITS = 'g m-2 s-1' ,& + SHORT_NAME = 'NDEP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_peak_month_agricultural_fire',& + UNITS = '1' ,& + SHORT_NAME = 'ABM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_peatland_fraction' ,& + UNITS = '1' ,& + SHORT_NAME = 'PEATF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_gross_domestic_product',& + UNITS = 'K 1995US$/capita' ,& + SHORT_NAME = 'GDP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_human_density_2010' ,& + UNITS = 'individual/km2' ,& + SHORT_NAME = 'HDM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'field_capacity' ,& + UNITS = 'm3/m3' ,& + SHORT_NAME = 'FIELDCAP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'cli_2m_T_(MERRA2)' ,& + UNITS = 'K' ,& + SHORT_NAME = 'CLI_T2M' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'MODIS soil albedo vis dir' ,& + UNITS = '1' ,& + SHORT_NAME = 'BGALBVR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'MODIS soil albedo vis dif' ,& + UNITS = '1' ,& + SHORT_NAME = 'BGALBVF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'MODIS soil albedo nir dir' ,& + UNITS = '1' ,& + SHORT_NAME = 'BGALBNR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'MODIS soil albedo nir dif' ,& + UNITS = '1' ,& + SHORT_NAME = 'BGALBNF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'column_rst_vars' ,& + UNITS = '1' ,& + SHORT_NAME = 'CNCOL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_ZON*VAR_COL/) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'PFT_rst_vars' ,& + UNITS = '1' ,& + SHORT_NAME = 'CNPFT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_ZON*NUM_VEG*VAR_PFT/) ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for ground temp' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TGWM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for soil moisture' ,& + UNITS = '1' ,& + SHORT_NAME = 'RZMM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for sfc soil moist' ,& + UNITS = '1' ,& + SHORT_NAME = 'SFMM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for baseflow' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'BFLOWM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for total water' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'TOTWATM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for air temperature',& + UNITS = 'K' ,& + SHORT_NAME = 'TAIRM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for relative humidity',& + UNITS = 'K' ,& + SHORT_NAME = 'RHM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for wind speed' ,& + UNITS = 'K' ,& + SHORT_NAME = 'WINDM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for rainfall' ,& + UNITS = 'K' ,& + SHORT_NAME = 'RAINFM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for snow fall' ,& + UNITS = 'K' ,& + SHORT_NAME = 'SNOWFM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for surface runoff' ,& + UNITS = 'K' ,& + SHORT_NAME = 'RUNSRFM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for frac saturated area',& + UNITS = 'K' ,& + SHORT_NAME = 'AR1M' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for soil temp' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TPM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN summing counter' ,& + UNITS = '1' ,& + SHORT_NAME = 'CNSUM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for sunlit photosyn',& + UNITS = 'umol m-2 s-1' ,& + SHORT_NAME = 'PSNSUNM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_VEG,NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for shaded photosyn',& + UNITS = 'umol m-2 s-1' ,& + SHORT_NAME = 'PSNSHAM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_VEG,NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for snow depth' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for area snow cover',& + UNITS = '1' ,& + SHORT_NAME = 'ASNOWM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = '10-day running mean of 2-m temperature',& + UNITS = 'K' ,& + SHORT_NAME = 'T2M10D' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = '10-day running mean of total precipitation',& + UNITS = 'mm H2O/s' ,& + SHORT_NAME = 'TPREC10D' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = '60-day running mean of total precipitation',& + UNITS = 'mm H2O/s' ,& + SHORT_NAME = 'TPREC60D' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + !---------- GOSWIM snow impurity related variables ---------- + + if (N_CONST_LAND4SNWALB /= 0) then + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'dust_mass_in_snow_bin_1' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RDU001' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'dust_mass_in_snow_bin_2' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RDU002' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'dust_mass_in_snow_bin_3' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RDU003' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'dust_mass_in_snow_bin_4' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RDU004' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'dust_mass_in_snow_bin_5' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RDU005' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'hydrophobic_black_carbon_mass_in_snow_bin_1',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RBC001' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'hydrophilic_black_carbon_mass_in_snow_bin_2',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RBC002' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'hydrophobic_organic_carbon_mass_in_snow_bin_1',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'ROC001' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'hydrophilic_organic_carbon_mass_in_snow_bin_2',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'ROC002' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + UNGRIDDED_DIMS = (/N_SNOW/) ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + endif + +! IRRIGATION MODEL INTERNAL + + IF (RUN_IRRIG /= 0) THEN + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'fraction_of_irrigated_cropland',& + UNITS = '1' ,& + SHORT_NAME = 'IRRIGFRAC' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'fraction_of_paddy_cropland',& + UNITS = '1' ,& + SHORT_NAME = 'PADDYFRAC' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'Maximum_LAI' ,& + UNITS = '1' ,& + SHORT_NAME = 'LAIMAX' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'Minimum_LAI' ,& + UNITS = '1' ,& + SHORT_NAME = 'LAIMIN' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_primary_type' ,& + UNITS = '1' ,& + SHORT_NAME = 'CLMPT' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_secondary_type' ,& + UNITS = '1' ,& + SHORT_NAME = 'CLMST' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_primary_fraction' ,& + UNITS = '1' ,& + SHORT_NAME = 'CLMPF' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CLM_secondary_fraction' ,& + UNITS = '1' ,& + SHORT_NAME = 'CLMSF' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + + ENDIF + + +!EOS + + ! EXPORT STATE: + + IF (RUN_IRRIG /= 0) THEN + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'irrigation_rate' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'IRRIGRATE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + ENDIF + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'evaporation' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'EVAPOUT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'sublimation' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'SUBLIM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'upward_sensible_heat_flux' ,& + UNITS = 'W m-2' ,& + SHORT_NAME = 'SHOUT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'runoff_flux' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RUNOFF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'interception_loss_energy_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'EVPINT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'baresoil_evap_energy_flux' ,& + UNITS = 'W m-2' ,& + SHORT_NAME = 'EVPSOI' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'transpiration_energy_flux' ,& + UNITS = 'W m-2' ,& + SHORT_NAME = 'EVPVEG' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'snow_ice_evaporation_energy_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'EVPICE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'soil moisture in Upper 10cm' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WAT10CM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'totoal soil moisture' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WATSOI' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'soil frozen water content' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'ICESOI' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'snowpack_evaporation_energy_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'EVPSNO' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'baseflow_flux' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'BASEFLOW' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'overland_runoff_including_throughflow' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RUNSURF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'snowmelt_flux' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'SMELT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_outgoing_longwave_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'HLWUP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'surface_net_downward_longwave_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'LWNDSRF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'surface_net_downward_shortwave_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'SWNDSRF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'total_latent_energy_flux' ,& + UNITS = 'W m-2' ,& + SHORT_NAME = 'HLATN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'rainwater_infiltration_flux',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'QINFIL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'areal_fraction_saturated_zone',& + UNITS = '1' ,& + SHORT_NAME = 'AR1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'areal_fraction_transpiration_zone',& + UNITS = '1' ,& + SHORT_NAME = 'AR2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'root_zone_equilibrium_moisture',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RZEQ' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'ground_energy_flux' ,& + UNITS = 'W m-2' ,& + SHORT_NAME = 'GHFLX' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'ave_catchment_temp_incl_snw',& + UNITS = 'K' ,& + SHORT_NAME = 'TPSURF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'temperature_top_snow_layer',& + UNITS = 'K' ,& + SHORT_NAME = 'TPSNOW' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'temperature_unsaturated_zone',& + UNITS = 'K' ,& + SHORT_NAME = 'TPUNST' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'temperature_saturated_zone',& + UNITS = 'K' ,& + SHORT_NAME = 'TPSAT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'temperature_wilted_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TPWLT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'fractional_area_of_land_snowcover',& + UNITS = '1' ,& + SHORT_NAME = 'ASNOW' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'downward_heat_flux_into_snow',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'SHSNOW' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'averaged_snow_temperature' ,& + UNITS = 'K' ,& + SHORT_NAME = 'AVETSNOW' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'fractional_area_of_saturated_zone',& + UNITS = '1' ,& + SHORT_NAME = 'FRSAT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'fractional_area_of_unsaturated_zone',& + UNITS = '1' ,& + SHORT_NAME = 'FRUST' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'fractional_area_of_wilting_zone',& + UNITS = '1' ,& + SHORT_NAME = 'FRWLT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'snow_mass' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'SNOWMASS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'snow_depth_within_snow_covered_area_fraction' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNOWDP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_soil_wetness' ,& + UNITS = '1' ,& + SHORT_NAME = 'WET1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'root_zone_soil_wetness' ,& + UNITS = '1' ,& + SHORT_NAME = 'WET2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'ave_prof_soil__moisture' ,& + UNITS = '1' ,& + SHORT_NAME = 'WET3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'water_surface_layer' ,& + UNITS = 'm3 m-3' ,& + SHORT_NAME = 'WCSF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'water_root_zone' ,& + UNITS = 'm3 m-3' ,& + SHORT_NAME = 'WCRZ' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'water_ave_prof' ,& + UNITS = 'm3 m-3' ,& + SHORT_NAME = 'WCPR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'soil_temperatures_layer_1' ,& + UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 + SHORT_NAME = 'TP1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'soil_temperatures_layer_2' ,& + UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 + SHORT_NAME = 'TP2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'soil_temperatures_layer_3' ,& + UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 + SHORT_NAME = 'TP3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'soil_temperatures_layer_4' ,& + UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 + SHORT_NAME = 'TP4' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'soil_temperatures_layer_5' ,& + UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 + SHORT_NAME = 'TP5' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'soil_temperatures_layer_6' ,& + UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 + SHORT_NAME = 'TP6' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_emissivity' ,& + UNITS = '1' ,& + SHORT_NAME = 'EMIS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_albedo_visible_beam',& + UNITS = '1' ,& + SHORT_NAME = 'ALBVR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_albedo_visible_diffuse',& + UNITS = '1' ,& + SHORT_NAME = 'ALBVF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_albedo_near_infrared_beam',& + UNITS = '1' ,& + SHORT_NAME = 'ALBNR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_albedo_near_infrared_diffuse',& + UNITS = '1' ,& + SHORT_NAME = 'ALBNF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'change_surface_skin_temperature',& + UNITS = 'K' ,& + SHORT_NAME = 'DELTS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'change_surface_specific_humidity',& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'DELQS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'change_evaporation' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'DELEVAP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'change_upward_sensible_energy_flux',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'DELSH' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_skin_temperature' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TST' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'land_surface_skin_temperature' ,& + UNITS = 'K' ,& + SHORT_NAME = 'LST' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_specific_humidity' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QST' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'turbulence_surface_skin_temperature',& + UNITS = 'K' ,& + SHORT_NAME = 'TH' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'turbulence_surface_skin_specific_hum',& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QH' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_heat_exchange_coefficient',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CHT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_momentum_exchange_coefficient',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CMT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_moisture_exchange_coefficient',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CQT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'neutral_drag_coefficient' ,& + UNITS = '1' ,& + SHORT_NAME = 'CNT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_bulk_richardson_number',& + UNITS = '1' ,& + SHORT_NAME = 'RIT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_roughness' ,& + UNITS = 'm' ,& + SHORT_NAME = 'Z0' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOT2M', & + LONG_NAME = 'temperature 2m wind from MO sfc', & + UNITS = 'K', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOQ2M', & + LONG_NAME = 'humidity 2m wind from MO sfc', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOU2M', & + LONG_NAME = 'zonal 2m wind from MO sfc',& + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOV2M', & + LONG_NAME = 'meridional 2m wind from MO sfc', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOT10M', & + LONG_NAME = 'temperature 10m wind from MO sfc', & + UNITS = 'K', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOQ10M', & + LONG_NAME = 'humidity 10m wind from MO sfc', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOU10M', & + LONG_NAME = 'zonal 10m wind from MO sfc',& + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOV10M', & + LONG_NAME = 'meridional 10m wind from MO sfc', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOU50M', & + LONG_NAME = 'zonal 50m wind from MO sfc',& + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MOV50M', & + LONG_NAME = 'meridional 50m wind from MO sfc', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_roughness_for_heat',& + UNITS = 'm' ,& + SHORT_NAME = 'Z0H' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'zero_plane_displacement_height',& + UNITS = 'm' ,& + SHORT_NAME = 'D0' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'GUST', & + LONG_NAME = 'gustiness', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'VENT', & + LONG_NAME = 'surface_ventilation_velocity',& + UNITS = 'm s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'ACCUM', & + LONG_NAME = 'net_ice_accumulation_rate', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EVLAND', & + LONG_NAME = 'Evaporation_land', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'PRLAND', & + LONG_NAME = 'Total_precipitation_land', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SNOLAND', & + LONG_NAME = 'snowfall_land', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DRPARLAND', & + LONG_NAME = 'surface_downwelling_par_beam_flux', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DFPARLAND', & + LONG_NAME = 'surface_downwelling_par_diffuse_flux', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LHSNOW', & + LONG_NAME = 'Latent_heat_flux_snow', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SWNETSNOW', & + LONG_NAME = 'Net_shortwave_snow', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LWUPSNOW', & + LONG_NAME = 'Net_longwave_snow', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LWDNSNOW', & + LONG_NAME = 'Net_longwave_snow', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TCSORIG', & + LONG_NAME = 'Input_tc_for_snow', & + UNITS = 'K', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TPSN1IN', & + LONG_NAME = 'Input_temp_of_top_snow_lev',& + UNITS = 'K', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TPSN1OUT', & + LONG_NAME = 'Output_temp_of_top_snow_lev',& + UNITS = 'K', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'GHSNOW', & + LONG_NAME = 'Ground_heating_snow', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LHLAND', & + LONG_NAME = 'Latent_heat_flux_land', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SHLAND', & + LONG_NAME = 'Sensible_heat_flux_land', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SWLAND', & + LONG_NAME = 'Net_shortwave_land', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SWDOWNLAND', & + LONG_NAME = 'Incident_shortwave_land', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LWLAND', & + LONG_NAME = 'Net_longwave_land', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'GHLAND', & + LONG_NAME = 'Ground_heating_land', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'GHTSKIN', & + LONG_NAME = 'Ground_heating_skin_temp', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SMLAND', & + LONG_NAME = 'Snowmelt_flux_land', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TWLAND', & + LONG_NAME = 'Avail_water_storage_land', & + UNITS = 'kg m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TELAND', & + LONG_NAME = 'Total_energy_storage_land', & + UNITS = 'J m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TSLAND', & + LONG_NAME = 'Total_snow_storage_land', & + UNITS = 'kg m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DWLAND', & + LONG_NAME = 'rate_of_change_of_total_land_water',& + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DHLAND', & + LONG_NAME = 'rate_of_change_of_total_land_energy',& + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SPLAND', & + LONG_NAME = 'rate_of_spurious_land_energy_source',& + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SPWATR', & + LONG_NAME = 'rate_of_spurious_land_water_source',& + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SPSNOW', & + LONG_NAME = 'rate_of_spurious_snow_energy',& + UNITS = 'W m-2', & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'vegetation_type' ,& + UNITS = '1' ,& + SHORT_NAME = 'ITY' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_exposed_leaf-area_index',& + UNITS = '1' ,& + SHORT_NAME = 'CNLAI' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_leaf-area_index' ,& + UNITS = '1' ,& + SHORT_NAME = 'CNTLAI' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_exposed_stem-area_index',& + UNITS = '1' ,& + SHORT_NAME = 'CNSAI' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_carbon' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNTOTC' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_vegetation_carbon',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNVEGC' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_fine_root_carbon' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNFROOTC' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_net_primary_production' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNNPP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_gross_primary_production',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNGPP' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_soil_respiration' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNSR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_net_ecosystem_exchange' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNNEE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'abstract_C_pool_to_meet_excess_MR_demand' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNXSMR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_added_to_maintain_positive_C' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNADD' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_carbon_loss_to_fire' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNLOSS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_fractional_area_burn_rate' ,& + UNITS = 's-1' ,& + SHORT_NAME = 'CNBURN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_fire_count' ,& + UNITS = 'count km-2 s-1' ,& + SHORT_NAME = 'CNFIRE_CNT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_peat_C_loss_to_fire' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNSOM_CLOSS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_N_deployed_to_growth_storage',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNNDEPLOY' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_denitrification_rate ' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNDENIT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_soil_min_N_loss_to_leaching',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNSMINN_LEACHED' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_soil_mineral_N' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNSMINN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_N_loss_to_fire' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNFIRE_NLOSS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_leaf_N' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNLEAFN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_leaf_C' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNLEAFC' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_gross_N_mineralization_rate',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNGROSS_NMIN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_net_N_mineralization_rate',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNNET_NMIN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_N_fixation_to_soil_min_N',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNNFIX_TO_SMINN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_actual_N_immobilization',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNACTUAL_IMMOB' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_fraction_potential_gpp' ,& + UNITS = '1' ,& + SHORT_NAME = 'CNFPG' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_fraction_potential_immobilization',& + UNITS = '1' ,& + SHORT_NAME = 'CNFPI' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_soil_min_N_plant_uptake',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNSMINN_TO_PLANT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_deployment_soil_min_N_uptake' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNSMINN_TO_NPOOL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_atm_N_dep_to_soil_min_N',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNNDEP_TO_SMINN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_vegetation_N' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNTOTVEGN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_litter_N' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNTOTLITN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_soil_organic_N' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNTOTSOMN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_plant_retranslocated_N' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNRETRANSN' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_deployment_retranslocated_N',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNRETRANSN_TO_NPOOL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_fuel_C' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNFUELC' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_litter_C' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNTOTLITC' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_coarse_woody_debris_C' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNCWDC' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_total_root_C' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CNROOT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'fire season length' ,& + UNITS = 'days' ,& + SHORT_NAME = 'CNFSEL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'absorbed_PAR' ,& + UNITS = 'W m-2' ,& + SHORT_NAME = 'PARABS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'incident_PAR' ,& + UNITS = 'W m-2' ,& + SHORT_NAME = 'PARINC' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'saturated_stomatal_conductance' ,& + UNITS = 'm s-1' ,& + SHORT_NAME = 'SCSAT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'unstressed_stomatal_conductance' ,& + UNITS = 'm s-1' ,& + SHORT_NAME = 'SCUNS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'transpiration coefficient' ,& + UNITS = '1' ,& + SHORT_NAME = 'BTRANT' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'solar induced fluorescence',& + UNITS = 'umol m-2 sm s-1' ,& + SHORT_NAME = 'SIF' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CO2 Surface Concentration used' ,& + UNITS = '1e-6' ,& + SHORT_NAME = 'CNCO2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_dust_mass_flux_from_the_bottom_layer_bin_1',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTDU001' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_dust_mass_flux_from_the_bottom_layer_bin_2',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTDU002' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_dust_mass_flux_from_the_bottom_layer_bin_3',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTDU003' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_dust_mass_flux_from_the_bottom_layer_bin_4',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTDU004' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_dust_mass_flux_from_the_bottom_layer_bin_5',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTDU005' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_black_carbon_mass_flux_from_the_bottom_layer_bin_1',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTBC001' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_black_carbon_mass_flux_from_the_bottom_layer_bin_2',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTBC002' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_organic_carbon_mass_flux_from_the_bottom_layer_bin_1',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTOC001' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'flushed_out_organic_carbon_mass_flux_from_the_bottom_layer_bin_2',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RMELTOC002' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'depth_to_water_table_from_surface',& + UNITS = 'm' ,& + SHORT_NAME = 'WATERTABLED' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FSWCHANGE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + +!EOS + + call MAPL_TimerAdd(GC, name="RUN1" ,RC=STATUS) + VERIFY_(STATUS) + if (OFFLINE_MODE /=0) then + call MAPL_TimerAdd(GC, name="-RUN0" ,RC=STATUS) + VERIFY_(status) + end if + call MAPL_TimerAdd(GC, name="-SURF" ,RC=STATUS) + VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="RUN2" ,RC=STATUS) + VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="-CATCHCNCLM45" ,RC=STATUS) + VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="-ALBEDO" ,RC=STATUS) + VERIFY_(STATUS) + +! Set generic init and final method +! --------------------------------- + + call MAPL_GenericSetServices ( GC, RC=STATUS ) + VERIFY_(STATUS) + + RETURN_(ESMF_SUCCESS) + +end subroutine SetServices + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!BOP +! !IROUTINE: RUN1 -- First Run stage for the catchment component +! !INTERFACE: + +subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp),intent(inout) :: GC !Gridded component + type(ESMF_State), intent(inout) :: IMPORT !Import state + type(ESMF_State), intent(inout) :: EXPORT !Export state + type(ESMF_Clock), intent(inout) :: CLOCK !The clock + integer,optional, intent(out ) :: RC !Error code: + +! !DESCRIPTION: Does the cds computation and roughness length +!EOP +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Locals + + type(MAPL_MetaComp),pointer :: MAPL + type(ESMF_State) :: INTERNAL + type(ESMF_Alarm) :: ALARM + type(ESMF_Config) :: CF + type(ESMF_VM) :: VM + +! ----------------------------------------------------- +! IMPORT Pointers +! ---------------------------------------------------- - + + real, dimension(:), pointer :: PS + real, dimension(:), pointer :: TA + real, dimension(:), pointer :: QA + real, dimension(:), pointer :: UU + real, pointer, dimension(:) :: UWINDLMTILE + real, pointer, dimension(:) :: VWINDLMTILE + real, dimension(:), pointer :: DZ + real, dimension(:), pointer :: LAI + real, dimension(:), pointer :: Z2CH + real, dimension(:), pointer :: PCU + real, dimension(:), pointer :: ASCATZ0 + real, dimension(:), pointer :: NDVI + +! ----------------------------------------------------- +! INTERNAL Pointers +! ----------------------------------------------------- + + real, dimension(:,:), pointer :: ITY + real, dimension(:,:), pointer :: FVG + real, dimension(:,:), pointer :: TC + real, dimension(:,:), pointer :: QC + real, dimension(:,:), pointer :: CH + real, dimension(:,:), pointer :: CM + real, dimension(:,:), pointer :: CQ + real, dimension(:,:), pointer :: FR + real, dimension(:,:), pointer :: WW + real, dimension(:,:), pointer :: cncol + real, dimension(:,:), pointer :: cnpft + real, dimension(:,:), pointer :: DCH + real, dimension(:,:), pointer :: DCQ + +! ----------------------------------------------------- +! EXPORT Pointers +! ----------------------------------------------------- + + real, dimension(:), pointer :: TH + real, dimension(:), pointer :: QH + real, dimension(:), pointer :: CHT + real, dimension(:), pointer :: CMT + real, dimension(:), pointer :: CQT + real, dimension(:), pointer :: CNT + real, dimension(:), pointer :: RIT + real, dimension(:), pointer :: Z0 + real, dimension(:), pointer :: Z0H + real, dimension(:), pointer :: D0 + real, dimension(:), pointer :: GST + real, dimension(:), pointer :: VNT + real, pointer, dimension(: ) :: MOT2M + real, pointer, dimension(: ) :: MOQ2M + real, pointer, dimension(: ) :: MOU2M + real, pointer, dimension(: ) :: MOV2M + real, pointer, dimension(: ) :: MOT10M + real, pointer, dimension(: ) :: MOQ10M + real, pointer, dimension(: ) :: MOU10M + real, pointer, dimension(: ) :: MOV10M + real, pointer, dimension(: ) :: MOU50M + real, pointer, dimension(: ) :: MOV50M + real, dimension(:), pointer :: ITYO + + +! From old bucket version of CDS calculation +! ------------------------------------------ + + integer :: N + integer :: NT + real, allocatable :: UCN(:) + real, allocatable :: TVA(:) + real, allocatable :: TVS(:) + real, allocatable :: URA(:) + real, allocatable :: UUU(:) + real, allocatable :: ZVG(:) + real, allocatable :: DZE(:) + real, allocatable :: D0T(:) + real, allocatable :: CHX(:) + real, allocatable :: CQX(:) + real, allocatable :: CN(:) + real, allocatable :: RE(:) + real, allocatable :: ZT(:) + real, allocatable :: ZQ(:) + integer,allocatable :: VEG1(:) + integer,allocatable :: VEG2(:) + real, allocatable :: FVG1(:) + real, allocatable :: FVG2(:) + real, allocatable :: Z0T(:,:) + real, allocatable :: U50M (:) + real, allocatable :: V50M (:) + real, allocatable :: T10M (:) + real, allocatable :: Q10M (:) + real, allocatable :: U10M (:) + real, allocatable :: V10M (:) + real, allocatable :: T2M (:) + real, allocatable :: Q2M (:) + real, allocatable :: U2M (:) + real, allocatable :: V2M (:) + real, allocatable :: RHOH(:) + real, allocatable :: VKH(:) + real, allocatable :: VKM(:) + real, allocatable :: USTAR(:) + real, allocatable :: XX(:) + real, allocatable :: YY(:) + real, allocatable :: CU(:) + real, allocatable :: CT(:) + real, allocatable :: RIB(:) + real, allocatable :: ZETA(:) + real, allocatable :: WS(:) + integer, allocatable :: IWATER(:) + real, allocatable :: PSMB(:) + real, allocatable :: PSL(:) + integer :: niter + real :: SCALE4Z0 + +! gkw: for CN model +! ----------------- + integer, parameter :: nveg = num_veg ! number of vegetation types + integer, parameter :: nzone = num_zon ! number of stress zones + + integer, allocatable :: ityp(:,:,:) + real, allocatable :: fveg(:,:,:), elai(:,:,:), esai(:,:,:), tlai(:,:,:), wtzone(:,:), lai1(:), lai2(:), wght(:) + + integer :: nv, nz, ib + real :: bare + logical, save :: first = .true. + integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline + + ! Offline mode + + type(OFFLINE_WRAP) :: wrap + integer :: OFFLINE_MODE, CHOOSEZ0 + +!============================================================================= +! Begin... +! ------------------------------------------------------------------------------ + + +! ------------------------------------------------------------------------------ +! Get the target component's name and set-up traceback handle. +! ------------------------------------------------------------------------------ + + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) + VERIFY_(STATUS) + Iam=trim(COMP_NAME)//"::RUN1" + + ! Get component's offline mode from its pvt internal state + call ESMF_UserCompGetInternalState(gc, 'OfflineMode', wrap, status) + VERIFY_(status) + OFFLINE_MODE = wrap%ptr%CATCH_OFFLINE + + call ESMF_VMGetCurrent ( VM, RC=STATUS ) + ! if (MAPL_AM_I_Root(VM)) print *, trim(Iam)//'::OFFLINE mode: ', is_OFFLINE + +! Get my internal MAPL_Generic state +! ---------------------------------- + + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) + VERIFY_(STATUS) + +! Start timers +! ------------ + + call MAPL_TimerOn(MAPL,"TOTAL") + call MAPL_TimerOn(MAPL,"RUN1") + +! Get parameters from generic state +! --------------------------------- + + call MAPL_Get ( MAPL ,& + TILELATS = LATS ,& + TILELONS = LONS ,& + INTERNAL_ESMF_STATE = INTERNAL ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_GetResource ( MAPL, CHOOSEZ0, Label="CHOOSEZ0:", DEFAULT=3, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetResource ( MAPL, SCALE4Z0, Label="SCALE4Z0:", DEFAULT=0.5, RC=STATUS) + VERIFY_(STATUS) + +! Pointers to inputs +!------------------- + + call MAPL_GetPointer(IMPORT,UU , 'UU' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,UWINDLMTILE , 'UWINDLMTILE' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,VWINDLMTILE , 'VWINDLMTILE' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DZ , 'DZ' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,TA , 'TA' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,QA , 'QA' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,PS , 'PS' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,LAI , 'LAI' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,Z2CH , 'Z2CH' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,PCU , 'PCU' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,ASCATZ0, 'ASCATZ0', RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,NDVI , 'NDVI' , RC=STATUS) + VERIFY_(STATUS) + +! Pointers to internals +!---------------------- + + call MAPL_GetPointer(INTERNAL,ITY , 'ITY' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,FVG , 'FVG' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TC , 'TC' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,QC , 'QC' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,FR , 'FR' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CH , 'CH' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CM , 'CM' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CQ , 'CQ' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,WW , 'WW' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CNCOL ,'CNCOL' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CNPFT ,'CNPFT' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,DCH , 'DCH' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,DCQ , 'DCQ' , RC=STATUS) + VERIFY_(STATUS) + +! Pointers to outputs +!-------------------- + + call MAPL_GetPointer(EXPORT,QH , 'QH' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TH , 'TH' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CHT , 'CHT' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CMT , 'CMT' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CQT , 'CQT' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNT , 'CNT' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RIT , 'RIT' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,Z0 , 'Z0' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,Z0H , 'Z0H' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,D0 , 'D0' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GST , 'GUST' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,VNT , 'VENT' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOT2M, 'MOT2M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOQ2M, 'MOQ2M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOU2M, 'MOU2M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOV2M, 'MOV2M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOT10M, 'MOT10M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOQ10M, 'MOQ10M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOU10M, 'MOU10M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOV10M, 'MOV10M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOU50M, 'MOU50M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MOV50M, 'MOV50M' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ITYO , 'ITY' , RC=STATUS) + VERIFY_(STATUS) + + NT = size(TA) + + allocate(TVA(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(TVS(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(URA(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(UUU(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(VEG1(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(VEG2(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(FVG1(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(FVG2(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(DZE(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(ZVG(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(Z0T(NT,NUM_SUBTILES),STAT=STATUS) + VERIFY_(STATUS) + allocate(D0T(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(CHX(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(CQX(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(RE (NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(CN (NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(ZT (NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(ZQ (NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(UCN(NT),STAT=STATUS) + VERIFY_(STATUS) + allocate(T2M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(Q2M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(U2M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(v2M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(T10M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(Q10M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(U10M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(v10M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(U50M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(v50M (NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(RHOH(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(PSMB(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(PSL(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(VKH(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(VKM(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(USTAR(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(XX(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(YY(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(CU(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(CT(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(RIB(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(ZETA(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(WS(NT) ,STAT=STATUS) + VERIFY_(STATUS) + allocate(IWATER(NT),STAT=STATUS) + VERIFY_(STATUS) + + allocate( ityp(nt,nveg,nzone) ) + allocate( fveg(nt,nveg,nzone) ) + allocate( wtzone(nt,nzone) ) + allocate( elai(nt,nveg,nzone) ) + allocate( esai(nt,nveg,nzone) ) + allocate( tlai(nt,nveg,nzone) ) + + allocate ( lai1(nt) ) + allocate ( lai2(nt) ) + allocate ( wght(nt) ) + +! Vegetation types used to index into tables +!-------------------------------------------- + + where(ITY(:,1) > 0.) + VEG1 = map_cat(nint(ITY(:,1))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + elsewhere + VEG1 = map_cat(nint(ITY(:,2))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + endwhere + where(ITY(:,3) > 0.) + VEG2 = map_cat(nint(ITY(:,3))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + elsewhere + VEG2 = map_cat(nint(ITY(:,4))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + endwhere + _ASSERT((count(VEG1>NTYPS.or.VEG1<1)==0),'needs informative message') + _ASSERT((count(VEG2>NTYPS.or.VEG2<1)==0),'needs informative message') + + ! At this point, bare soil is not allowed in CatchCN. FVEG in BCs + ! files do not have bare soil either. However, at times, tiny bare + ! fractions appear due to truncation. We add that tiny fraction to the + ! largest of the 4 fractions and ensure bare is zero. (Sarith 3/3/16) + + DO N = 1, NT + BARE = 1. + + DO NV = 1, NVEG + BARE = BARE - FVG(N,NV)! subtract vegetated fractions + END DO + + if (BARE /= 0.) THEN + IB = MAXLOC(FVG(N,:),1) + FVG (N,IB) = FVG(N,IB) + BARE ! This also corrects cases sum gt 1. + ENDIF + + END DO + + FVG1 = fvg(:,1) + fvg(:,2) ! gkw: primary vegetation fraction + FVG2 = fvg(:,3) + fvg(:,4) ! gkw: secondary vegetation fraction + +! set CLM CN PFT & fraction, set carbon zone weights +! -------------------------------------------------- + do nz = 1,nzone + ityp(:,:,nz) = nint(ity(:,:)) + fveg(:,:,nz) = fvg(:,:) + wtzone(:,nz) = CN_zone_weight(nz) + end do + +! initialize CN model and transfer restart variables on startup +! ------------------------------------------------------------- + if(first) then + call CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start=.true.) + call get_CN_LAI(nt,nveg,nzone,ityp,fveg,elai,esai=esai) + first = .false. + endif + + ! For the OFFLINE case, first update some diagnostic vars + if (OFFLINE_MODE /=0) then + call MAPL_TimerOn(MAPL, "-RUN0") + call RUN0(gc, import, export, clock, rc) + call MAPL_TimerOff(MAPL, "-RUN0") + end if + +! obtain LAI from previous time step (from CN model) +! -------------------------------------------------- + + call get_CN_LAI(nt,nveg,nzone,ityp,fveg,elai,esai=esai,tlai=tlai) + + lai1 = 0. + wght = 0. + do nz = 1,nzone + do nv = 1,2 + lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + lai1 = lai1 / max(wght,1.e-8) ! LAI for primary vegetation type + + lai2 = 0. + wght = 0. + do nz = 1,nzone + do nv = 3,4 + lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + lai2 = lai2 / max(wght,1.e-8) ! LAI for secondary vegetation type + + lai = fvg1*lai1 + fvg2*lai2 ! gkw: this is a VEGDYN import + + deallocate ( ityp ) + deallocate ( fveg ) + deallocate ( elai ) + deallocate ( esai ) + deallocate ( wtzone ) + deallocate ( tlai ) + +! Clear the output tile accumulators +!------------------------------------ + + CHX = 0.0 + CQX = 0.0 + + if(associated(TH )) TH = 0.0 + if(associated(QH )) QH = 0.0 + if(associated(CMT)) CMT = 0.0 + if(associated(CNT)) CNT = 0.0 + if(associated(RIT)) RIT = 0.0 + if(associated(Z0H)) Z0H = 0.0 + if(associated(GST)) GST = 0.0 + if(associated(VNT)) VNT = 0.0 + if(associated(MOU50M)) MOU50M = 0.0 + if(associated(MOV50M)) MOV50M = 0.0 + if(associated(MOT10M)) MOT10M = 0.0 + if(associated(MOQ10M)) MOQ10M = 0.0 + if(associated(MOU10M)) MOU10M = 0.0 + if(associated(MOV10M)) MOV10M = 0.0 + if(associated( MOT2M)) MOT2M = 0.0 + if(associated( MOQ2M)) MOQ2M = 0.0 + if(associated( MOU2M)) MOU2M = 0.0 + if(associated( MOV2M)) MOV2M = 0.0 + + SUBTILES: do N=1,NUM_SUBTILES + +! Effective vegetation height. In catchment, LAI dependence +! includes the effect of partially vegetated areas, +! as well as the phenology of the deciduous types. These +! effects will be separated in future formulations. + + ZVG = fvg1*(Z2CH - SCALE4Z0*(Z2CH - MIN_VEG_HEIGHT)*exp(-LAI1)) + & + fvg2*(Z2CH - SCALE4Z0*(Z2CH - MIN_VEG_HEIGHT)*exp(-LAI2)) + + +! For now roughnesses and displacement heights +! are the same for all subtiles. + + Z0T(:,N) = Z0_BY_ZVEG*ZVG + IF (USE_ASCATZ0 == 1) THEN + WHERE (NDVI <= 0.2) + Z0T(:,N) = ASCATZ0 + END WHERE + ENDIF + D0T = D0_BY_ZVEG*ZVG + + DZE = max(DZ - D0T, 10.) + + if(associated(Z0 )) Z0 = Z0T(:,N) + if(associated(D0 )) D0 = D0T + +! Compute the three surface exchange coefficients +!------------------------------------------------- + + call MAPL_TimerOn(MAPL,"-SURF") + if(CHOOSEMOSFC.eq.0) then + WW(:,N) = 0. + CM(:,N) = 0. + + call louissurface(3,N,UU,WW,PS,TA,TC,QA,QC,PCU,LAI,Z0T,DZE,CM,CN,RIB,ZT,ZQ,CH,CQ,UUU,UCN,RE,DCH,DCQ) + + elseif (CHOOSEMOSFC.eq.1)then + + niter = 6 ! number of internal iterations in the helfand MO surface layer routine + IWATER = 3 + + PSMB = PS * 0.01 ! convert to MB +! Approximate pressure at top of surface layer: hydrostatic, eqn of state using avg temp and press + PSL = PSMB * (1. - (DZE*MAPL_GRAV)/(MAPL_RGAS*(TA+TC(:,N)) ) ) / & + (1. + (DZE*MAPL_GRAV)/(MAPL_RGAS*(TA+TC(:,N)) ) ) + + CALL helfsurface( UWINDLMTILE,VWINDLMTILE,TA,TC(:,N),QA,QC(:,N),PSL,PSMB,Z0T(:,N),lai, & + IWATER,DZE,niter,nt,RHOH,VKH,VKM,USTAR,XX,YY,CU,CT,RIB,ZETA,WS, & + t2m,q2m,u2m,v2m,t10m,q10m,u10m,v10m,u50m,v50m,CHOOSEZ0) + + CM(:,N) = VKM + CH(:,N) = VKH + CQ(:,N) = VKH + + CN = (MAPL_KARMAN/ALOG(DZE/Z0T(:,N) + 1.0)) * (MAPL_KARMAN/ALOG(DZE/Z0T(:,N) + 1.0)) + ZT = Z0T(:,N) + ZQ = Z0T(:,N) + RE = 0. + UUU = UU + UCN = 0. + +! Aggregate to tiles for MO only diagnostics +!-------------------------------------------- + if(associated(MOU50M))MOU50M = MOU50M + U50M(:)*FR(:,N) + if(associated(MOV50M))MOV50M = MOV50M + V50M(:)*FR(:,N) + if(associated(MOT10M))MOT10M = MOT10M + T10M(:)*FR(:,N) + if(associated(MOQ10M))MOQ10M = MOQ10M + Q10M(:)*FR(:,N) + if(associated(MOU10M))MOU10M = MOU10M + U10M(:)*FR(:,N) + if(associated(MOV10M))MOV10M = MOV10M + V10M(:)*FR(:,N) + if(associated(MOT2M))MOT2M = MOT2M + T2M(:)*FR(:,N) + if(associated(MOQ2M))MOQ2M = MOQ2M + Q2M(:)*FR(:,N) + if(associated(MOU2M))MOU2M = MOU2M + U2M(:)*FR(:,N) + if(associated(MOV2M))MOV2M = MOV2M + V2M(:)*FR(:,N) + + endif + call MAPL_TimerOff(MAPL,"-SURF") + +! Aggregate to tile +!------------------- + + CHX = CHX + CH(:,N)*FR(:,N) + CQX = CQX + CQ(:,N)*FR(:,N) + + if(associated(CMT)) CMT = CMT + CM(:,N) *FR(:,N) + if(associated(CNT)) CNT = CNT + CN(: ) *FR(:,N) + if(associated(RIT)) RIT = RIT + RIB(: ) *FR(:,N) + if(associated( TH)) TH = TH + CH(:,N)*TC(:,N)*FR(:,N) + if(associated( QH)) QH = QH + CQ(:,N)*QC(:,N)*FR(:,N) + if(associated(Z0H)) Z0H = Z0H + ZT *FR(:,N) + if(associated(VNT)) VNT = VNT + UUU *FR(:,N) + + WW(:,N) = max(CH(:,N)*(TC(:,N)-TA-(MAPL_GRAV/MAPL_CP)*DZE)/TA + MAPL_VIREPS*CQ(:,N)*(QC(:,N)-QA),0.0) + WW(:,N) = (HPBL*MAPL_GRAV*WW(:,N))**(2./3.) + if(associated(GST)) GST = GST + WW(:,N) *FR(:,N) + + end do SUBTILES + + if(associated( TH)) TH = TH /CHX + if(associated( QH)) QH = QH /CQX + if(associated(CHT)) CHT = CHX + if(associated(CQT)) CQT = CQX + if(associated(GST)) GST = sqrt(max(GST+UCN,0.0)) + if(associated(ITYO)) ITYO = real(VEG1) ! gkw: primary type exported... where it is used? + + deallocate ( lai1 ) + deallocate ( lai2 ) + deallocate ( wght ) + + deallocate(TVA) + deallocate(TVS) + deallocate(URA) + deallocate(UUU) + deallocate(ZVG) + deallocate(DZE) + deallocate(Z0T) + deallocate(D0T) + deallocate(CHX) + deallocate(CQX) + deallocate(VEG1) + deallocate(VEG2) + deallocate(FVG1) + deallocate(FVG2) + deallocate(RE ) + deallocate(CN ) + deallocate(ZT ) + deallocate(ZQ ) + deallocate(UCN) + deallocate(U50M ) + deallocate(V50M ) + deallocate(T10M ) + deallocate(Q10M ) + deallocate(U10M ) + deallocate(V10M ) + deallocate(T2M ) + deallocate(Q2M ) + deallocate(U2M ) + deallocate(V2M ) + deallocate(RHOH) + deallocate(VKH) + deallocate(VKM) + deallocate(USTAR) + deallocate(XX) + deallocate(YY) + deallocate(CU) + deallocate(CT) + deallocate(RIB) + deallocate(ZETA) + deallocate(WS) + deallocate(IWATER) + deallocate(PSMB) + deallocate(PSL) + +! All done +! ------------------------------------------------------------------------------ + + call MAPL_TimerOff ( MAPL, "RUN1" ) + call MAPL_TimerOff ( MAPL, "TOTAL" ) + + RETURN_(ESMF_SUCCESS) + +end subroutine RUN1 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ------------------------------------------------------------------------------ +! ------------------------------------------------------------------------------ + +subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) + +! ------------------------------------------------------------------------------ +! !ARGUMENTS: +! ------------------------------------------------------------------------------ + + type(ESMF_GridComp),intent(inout) :: GC + type(ESMF_State), intent(inout) :: IMPORT + type(ESMF_State), intent(inout) :: EXPORT + type(ESMF_Clock), intent(inout) :: CLOCK + integer,optional, intent(out ) :: RC + +! ------------------------------------------------------------------------------ +! ErrLog Variables +! ------------------------------------------------------------------------------ + + character(len=ESMF_MAXSTR) :: Iam="RUN2" + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! ------------------------------------------------------------------------------ +! Local derived type aliases +! ------------------------------------------------------------------------------ + + type(MAPL_MetaComp),pointer :: MAPL + type(ESMF_Alarm) :: ALARM + + integer :: IM,JM + integer :: incl_Louis_extra_derivs + + real :: SCALE4Z0 + +! ------------------------------------------------------------------------------ +! Begin: Get the target components name and +! set-up traceback handle. +! ------------------------------------------------------------------------------ + + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) + VERIFY_(STATUS) + Iam=trim(COMP_NAME)//trim(Iam) + +! Get my internal MAPL_Generic state +!----------------------------------- + + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) + VERIFY_(STATUS) + +! Get parameters from generic state. +!----------------------------------- + + call MAPL_Get(MAPL, RUNALARM=ALARM, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetResource ( MAPL, incl_Louis_extra_derivs, Label="INCL_LOUIS_EXTRA_DERIVS:", DEFAULT=1, RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetResource ( MAPL, SCALE4Z0, Label="SCALE4Z0:", DEFAULT=0.5, RC=STATUS) + VERIFY_(STATUS) + +! ------------------------------------------------------------------------------ +! If its time, recalculate the LSM tile routine +! ------------------------------------------------------------------------------ + + call MAPL_TimerOn ( MAPL,"TOTAL" ) + call MAPL_TimerOn ( MAPL,"RUN2" ) + + if(ESMF_AlarmIsRinging(ALARM, RC=STATUS))then + call ESMF_AlarmRingerOff(ALARM, RC=STATUS) + VERIFY_(STATUS) + call Driver ( RC=STATUS ) + VERIFY_(STATUS) + endif + + call MAPL_TimerOff ( MAPL, "RUN2" ) + call MAPL_TimerOff ( MAPL, "TOTAL" ) + + RETURN_(ESMF_SUCCESS) + + contains + +! ------------------------------------------------------------------------------ +! ------------------------------------------------------------------------------ + + subroutine Driver ( RC ) + integer,optional,intent(OUT) :: RC + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + + ! -------------------------------------------------------------------------- + ! Local derived type aliases + ! -------------------------------------------------------------------------- + + type(ESMF_STATE) :: INTERNAL + + ! ----------------------------------------------------- + ! IMPORT Pointers + ! ----------------------------------------------------- + + real, dimension(:), pointer :: PS + real, dimension(:), pointer :: TA + real, dimension(:), pointer :: QA + real, dimension(:), pointer :: UU + real, dimension(:), pointer :: DZ + real, dimension(:), pointer :: PCU + real, dimension(:), pointer :: PLS + real, dimension(:), pointer :: SNO + + real, dimension(:), pointer :: THATM + real, dimension(:), pointer :: QHATM + real, dimension(:), pointer :: CTATM + real, dimension(:), pointer :: CQATM + real, dimension(:), pointer :: ICE + real, dimension(:), pointer :: FRZR + real, dimension(:), pointer :: drpar + real, dimension(:), pointer :: dfpar + real, dimension(:), pointer :: drnir + real, dimension(:), pointer :: dfnir + real, dimension(:), pointer :: druvr + real, dimension(:), pointer :: dfuvr + real, dimension(:), pointer :: lwdnsrf + real, dimension(:), pointer :: alw + real, dimension(:), pointer :: blw + real, dimension(:), pointer :: CO2SC + + real, dimension(:), pointer :: evap + real, dimension(:), pointer :: devap + real, dimension(:), pointer :: sh + real, dimension(:), pointer :: dsh + + real, dimension(:), pointer :: ROOTL + real, dimension(:), pointer :: Z2CH + real, dimension(:), pointer :: LAI + real, dimension(:), pointer :: GRN + real, dimension(:), pointer :: ASCATZ0 + real, dimension(:), pointer :: NDVI + + real, dimension(:,:), pointer :: DUDP + real, dimension(:,:), pointer :: DUSV + real, dimension(:,:), pointer :: DUWT + real, dimension(:,:), pointer :: DUSD + real, dimension(:,:), pointer :: BCDP + real, dimension(:,:), pointer :: BCSV + real, dimension(:,:), pointer :: BCWT + real, dimension(:,:), pointer :: BCSD + real, dimension(:,:), pointer :: OCDP + real, dimension(:,:), pointer :: OCSV + real, dimension(:,:), pointer :: OCWT + real, dimension(:,:), pointer :: OCSD + real, dimension(:,:), pointer :: SUDP + real, dimension(:,:), pointer :: SUSV + real, dimension(:,:), pointer :: SUWT + real, dimension(:,:), pointer :: SUSD + real, dimension(:,:), pointer :: SSDP + real, dimension(:,:), pointer :: SSSV + real, dimension(:,:), pointer :: SSWT + real, dimension(:,:), pointer :: SSSD + + ! ----------------------------------------------------- + ! INTERNAL Pointers + ! ----------------------------------------------------- + + real, dimension(:), pointer :: bf1 + real, dimension(:), pointer :: bf2 + real, dimension(:), pointer :: bf3 + real, dimension(:), pointer :: vgwmax + real, dimension(:), pointer :: cdcr1 + real, dimension(:), pointer :: cdcr2 + real, dimension(:), pointer :: psis + real, dimension(:), pointer :: bee + real, dimension(:), pointer :: poros + real, dimension(:), pointer :: wpwet + real, dimension(:), pointer :: cond + real, dimension(:), pointer :: gnu + real, dimension(:), pointer :: ars1 + real, dimension(:), pointer :: ars2 + real, dimension(:), pointer :: ars3 + real, dimension(:), pointer :: ara1 + real, dimension(:), pointer :: ara2 + real, dimension(:), pointer :: ara3 + real, dimension(:), pointer :: ara4 + real, dimension(:), pointer :: arw1 + real, dimension(:), pointer :: arw2 + real, dimension(:), pointer :: arw3 + real, dimension(:), pointer :: arw4 + real, dimension(:), pointer :: tsa1 + real, dimension(:), pointer :: tsa2 + real, dimension(:), pointer :: tsb1 + real, dimension(:), pointer :: tsb2 + real, dimension(:), pointer :: atau + real, dimension(:), pointer :: btau + real, dimension(:,:), pointer :: ity + real, dimension(:,:), pointer :: fvg + real, dimension(:), pointer :: capac + real, dimension(:), pointer :: catdef + real, dimension(:), pointer :: rzexc + real, dimension(:), pointer :: srfexc + real, dimension(:), pointer :: ghtcnt1 + real, dimension(:), pointer :: ghtcnt2 + real, dimension(:), pointer :: ghtcnt3 + real, dimension(:), pointer :: ghtcnt4 + real, dimension(:), pointer :: ghtcnt5 + real, dimension(:), pointer :: ghtcnt6 + real, dimension(:), pointer :: tsurf + real, dimension(:), pointer :: wesnn1 + real, dimension(:), pointer :: wesnn2 + real, dimension(:), pointer :: wesnn3 + real, dimension(:), pointer :: htsnnn1 + real, dimension(:), pointer :: htsnnn2 + real, dimension(:), pointer :: htsnnn3 + real, dimension(:), pointer :: sndzn1 + real, dimension(:), pointer :: sndzn2 + real, dimension(:), pointer :: sndzn3 + real, dimension(:,:), pointer :: tc + real, dimension(:,:), pointer :: tg + real, dimension(:,:), pointer :: qc + real, dimension(:,:), pointer :: ch + real, dimension(:,:), pointer :: cm + real, dimension(:,:), pointer :: cq + real, dimension(:,:), pointer :: fr + real, dimension(:,:), pointer :: dcq + real, dimension(:,:), pointer :: dch + real, dimension(:), pointer :: tile_id + real, dimension(:), pointer :: ndep + real, dimension(:), pointer :: abm + real, dimension(:), pointer :: peatf + real, dimension(:), pointer :: gdp + real, dimension(:), pointer :: hdm + real, dimension(:), pointer :: fieldcap + real, dimension(:), pointer :: cli_t2m + real, dimension(:), pointer :: bgalbvr + real, dimension(:), pointer :: bgalbvf + real, dimension(:), pointer :: bgalbnr + real, dimension(:), pointer :: bgalbnf + real, dimension(:,:), pointer :: cncol + real, dimension(:,:), pointer :: cnpft + real, dimension(:,:), pointer :: tgwm + real, dimension(:,:), pointer :: rzmm + real, dimension(:,:), pointer :: sfmm + real, dimension(:), pointer :: bflowm + real, dimension(:), pointer :: totwatm + real, dimension(:), pointer :: tairm + real, dimension(:), pointer :: rhm + real, dimension(:), pointer :: windm + real, dimension(:), pointer :: rainfm + real, dimension(:), pointer :: snowfm + real, dimension(:), pointer :: runsrfm + real, dimension(:), pointer :: ar1m + real, dimension(:), pointer :: tpm + real, dimension(:), pointer :: cnsum + real, dimension(:,:,:), pointer :: psnsunm + real, dimension(:,:,:), pointer :: psnsham + real, dimension(:), pointer :: sndzm + real, dimension(:), pointer :: asnowm + real, dimension(:,:), pointer :: RDU001 + real, dimension(:,:), pointer :: RDU002 + real, dimension(:,:), pointer :: RDU003 + real, dimension(:,:), pointer :: RDU004 + real, dimension(:,:), pointer :: RDU005 + real, dimension(:,:), pointer :: RBC001 + real, dimension(:,:), pointer :: RBC002 + real, dimension(:,:), pointer :: ROC001 + real, dimension(:,:), pointer :: ROC002 + real, dimension(:), pointer :: IRRIGFRAC + real, dimension(:), pointer :: PADDYFRAC + real, dimension(:), pointer :: LAIMAX + real, dimension(:), pointer :: LAIMIN + real, dimension(:), pointer :: CLMPT + real, dimension(:), pointer :: CLMST + real, dimension(:), pointer :: CLMPF + real, dimension(:), pointer :: CLMSF + real, dimension(:), pointer :: T2M10D + real, dimension(:), pointer :: TPREC10D + real, dimension(:), pointer :: TPREC60D + + ! ----------------------------------------------------- + ! EXPORT Pointers + ! ----------------------------------------------------- + + real, dimension(:), pointer :: evapout + real, dimension(:), pointer :: sublim + real, dimension(:), pointer :: shout + real, dimension(:), pointer :: runoff + real, dimension(:), pointer :: evpint + real, dimension(:), pointer :: evpsoi + real, dimension(:), pointer :: evpveg + real, dimension(:), pointer :: evpice + real, dimension(:), pointer :: evpsno + real, dimension(:), pointer :: bflow + real, dimension(:), pointer :: runsurf + real, dimension(:), pointer :: smelt + real, dimension(:), pointer :: accum + real, dimension(:), pointer :: hlwup + real, dimension(:), pointer :: swndsrf + real, dimension(:), pointer :: lwndsrf + real, dimension(:), pointer :: hlatn + real, dimension(:), pointer :: qinfil + real, dimension(:), pointer :: ar1 + real, dimension(:), pointer :: ar2 + real, dimension(:), pointer :: rzeq + real, dimension(:), pointer :: ghflx + real, dimension(:), pointer :: tpsurf + real, dimension(:), pointer :: tpsn1 + real, dimension(:), pointer :: tpust + real, dimension(:), pointer :: tpsat + real, dimension(:), pointer :: tpwlt + real, dimension(:), pointer :: asnow + real, dimension(:), pointer :: frsat + real, dimension(:), pointer :: frust + real, dimension(:), pointer :: frwlt + real, dimension(:), pointer :: tp1 + real, dimension(:), pointer :: tp2 + real, dimension(:), pointer :: tp3 + real, dimension(:), pointer :: tp4 + real, dimension(:), pointer :: tp5 + real, dimension(:), pointer :: tp6 + real, dimension(:), pointer :: emis + real, dimension(:), pointer :: albvr + real, dimension(:), pointer :: albvf + real, dimension(:), pointer :: albnr + real, dimension(:), pointer :: albnf + real, dimension(:), pointer :: delts + real, dimension(:), pointer :: delqs + real, dimension(:), pointer :: delevap + real, dimension(:), pointer :: delsh + real, dimension(:), pointer :: tst + real, dimension(:), pointer :: lst + real, dimension(:), pointer :: qst + + real, dimension(:), pointer :: WET1 + real, dimension(:), pointer :: WET2 + real, dimension(:), pointer :: WET3 + real, dimension(:), pointer :: WCSF + real, dimension(:), pointer :: WCRZ + real, dimension(:), pointer :: WCPR + real, dimension(:), pointer :: SNOMAS + real, dimension(:), pointer :: SNOWDP + + real, dimension(:), pointer :: EVLAND + real, dimension(:), pointer :: PRLAND + real, dimension(:), pointer :: SNOLAND + real, dimension(:), pointer :: DRPARLAND + real, dimension(:), pointer :: DFPARLAND + real, dimension(:), pointer :: LHSNOW + real, dimension(:), pointer :: SWNETSNOW1 + real, dimension(:), pointer :: LWUPSNOW + real, dimension(:), pointer :: LWDNSNOW + real, dimension(:), pointer :: TCSORIG + real, dimension(:), pointer :: TPSN1IN + real, dimension(:), pointer :: TPSN1OUT + real, dimension(:), pointer :: GHSNOW + real, dimension(:), pointer :: LHLAND + real, dimension(:), pointer :: SHLAND + real, dimension(:), pointer :: SWLAND + real, dimension(:), pointer :: SWDOWNLAND + real, dimension(:), pointer :: LWLAND + real, dimension(:), pointer :: GHLAND + real, dimension(:), pointer :: GHTSKIN + real, dimension(:), pointer :: SMLAND + real, dimension(:), pointer :: TWLAND + real, dimension(:), pointer :: TELAND + real, dimension(:), pointer :: TSLAND + real, dimension(:), pointer :: DWLAND + real, dimension(:), pointer :: DHLAND + real, dimension(:), pointer :: SPLAND + real, dimension(:), pointer :: SPWATR + real, dimension(:), pointer :: SPSNOW + + real, dimension(:), pointer :: CNLAI + real, dimension(:), pointer :: CNTLAI + real, dimension(:), pointer :: CNSAI + real, dimension(:), pointer :: CNTOTC + real, dimension(:), pointer :: CNVEGC + real, dimension(:), pointer :: CNFROOTC + real, dimension(:), pointer :: CNNPP + real, dimension(:), pointer :: CNGPP + real, dimension(:), pointer :: CNSR + real, dimension(:), pointer :: CNNEE + real, dimension(:), pointer :: CNXSMR + real, dimension(:), pointer :: CNADD + real, dimension(:), pointer :: CNLOSS + real, dimension(:), pointer :: CNBURN + real, dimension(:), pointer :: PARABS + real, dimension(:), pointer :: PARINC + real, dimension(:), pointer :: SCSAT + real, dimension(:), pointer :: SCUNS + real, dimension(:), pointer :: BTRANT + real, dimension(:), pointer :: SIF + real, dimension(:), pointer :: CNCO2 + real, dimension(:), pointer :: CNFIRE_CNT + real, dimension(:), pointer :: CNSOM_CLOSS + real, dimension(:), pointer :: CNNDEPLOY + real, dimension(:), pointer :: CNDENIT + real, dimension(:), pointer :: CNSMINN_LEACHED + real, dimension(:), pointer :: CNSMINN + real, dimension(:), pointer :: CNFIRE_NLOSS + real, dimension(:), pointer :: CNLEAFN + real, dimension(:), pointer :: CNLEAFC + real, dimension(:), pointer :: CNGROSS_NMIN + real, dimension(:), pointer :: CNNET_NMIN + real, dimension(:), pointer :: CNNFIX_TO_SMINN + real, dimension(:), pointer :: CNACTUAL_IMMOB + real, dimension(:), pointer :: CNFPG + real, dimension(:), pointer :: CNFPI + real, dimension(:), pointer :: CNSMINN_TO_PLANT + real, dimension(:), pointer :: CNSMINN_TO_NPOOL + real, dimension(:), pointer :: CNNDEP_TO_SMINN + real, dimension(:), pointer :: CNTOTVEGN + real, dimension(:), pointer :: CNTOTLITN + real, dimension(:), pointer :: CNTOTSOMN + real, dimension(:), pointer :: CNRETRANSN + real, dimension(:), pointer :: CNRETRANSN_TO_NPOOL + real, dimension(:), pointer :: CNFUELC + real, dimension(:), pointer :: CNTOTLITC + real, dimension(:), pointer :: CNCWDC + real, dimension(:), pointer :: CNROOT + real, dimension(:), pointer :: CNFSEL + + real, dimension(:), pointer :: WAT10CM + real, dimension(:), pointer :: WATSOI + real, dimension(:), pointer :: ICESOI + real, dimension(:), pointer :: SHSNOW + real, dimension(:), pointer :: AVETSNOW + real, pointer, dimension(:) :: RMELTDU001 + real, pointer, dimension(:) :: RMELTDU002 + real, pointer, dimension(:) :: RMELTDU003 + real, pointer, dimension(:) :: RMELTDU004 + real, pointer, dimension(:) :: RMELTDU005 + real, pointer, dimension(:) :: RMELTBC001 + real, pointer, dimension(:) :: RMELTBC002 + real, pointer, dimension(:) :: RMELTOC001 + real, pointer, dimension(:) :: RMELTOC002 + real, pointer, dimension(:) :: IRRIGRATE + real, pointer, dimension(:) :: WATERTABLED + real, pointer, dimension(:) :: FSWCHANGE + + ! -------------------------------------------------------------------------- + ! Local pointers for tile variables + ! -------------------------------------------------------------------------- + + INTEGER,pointer,dimension(:) :: CAT_ID + real,pointer,dimension(:) :: dzsf + real,pointer,dimension(:) :: swnetfree + real,pointer,dimension(:) :: swnetsnow + real,pointer,dimension(:) :: qa1 + real,pointer,dimension(:) :: qa2 + real,pointer,dimension(:) :: qa4 + real,pointer,dimension(:) :: tilezero + real,pointer,dimension(:) :: zth + real,pointer,dimension(:) :: lats + real,pointer,dimension(:) :: lons + real,pointer,dimension(:) :: slr + real,pointer,dimension(:) :: rdc + real,pointer,dimension(:) :: PRECU + real,pointer,dimension(:) :: PRELS + real,pointer,dimension(:) :: SNOW + real,pointer,dimension(:) :: UUU, RHO + real,pointer,dimension(:) :: LAI0,GRN0,ZVG + real,pointer,dimension(:) :: Z0, D0 + real,pointer,dimension(:) :: sfmc, rzmc, prmc, entot, wtot + real,pointer,dimension(:) :: ghflxsno, ghflxtskin + real,pointer,dimension(:) :: SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 + real,pointer,dimension(:) :: LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW + real,pointer,dimension(:) :: TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE + real,pointer,dimension(:) :: WCHANGE, ECHANGE, HSNACC, EVACC, SHACC + real,pointer,dimension(:) :: SNOVR, SNOVF, SNONR, SNONF + real,pointer,dimension(:) :: VSUVR, VSUVF + real,pointer,dimension(:) :: ALWX, BLWX + real,pointer,dimension(:) :: LHACC, SUMEV + real,pointer,dimension(:) :: fveg1, fveg2 + real,pointer,dimension(:) :: FICE1 + real,pointer,dimension(:) :: SLDTOT + +! real*8,pointer,dimension(:) :: fsum + + real,pointer,dimension(:,:) :: ghtcnt + real,pointer,dimension(:,:) :: wesnn + real,pointer,dimension(:,:) :: htsnnn + real,pointer,dimension(:,:) :: sndzn + real,pointer,dimension(:,:) :: shsbt + real,pointer,dimension(:,:) :: dshsbt + real,pointer,dimension(:,:) :: evsbt + real,pointer,dimension(:,:) :: devsbt + real,pointer,dimension(:,:) :: DEDTC + real,pointer,dimension(:,:) :: DHSDQA + real,pointer,dimension(:,:) :: CFT + real,pointer,dimension(:,:) :: RA + real,pointer,dimension(:,:) :: CFQ + real,pointer,dimension(:,:) :: TCO + real,pointer,dimension(:,:) :: QCO + real,pointer,dimension(:,:) :: DQS + real,pointer,dimension(:,:) :: QSAT + + integer,dimension(:),pointer :: veg1 + integer,dimension(:),pointer :: veg2 + + real,pointer,dimension(:) :: RCSAT + real,pointer,dimension(:) :: DRCSDT + real,pointer,dimension(:) :: DRCSDQ + real,pointer,dimension(:) :: RCUNS + real,pointer,dimension(:) :: DRCUDT + real,pointer,dimension(:) :: DRCUDQ + + real,pointer,dimension(:,:,:) :: RCONSTIT + real,pointer,dimension(:,:) :: TOTDEPOS + real,pointer,dimension(:,:) :: RMELT + + ! -------------------------------------------------------------------------- + ! Locals for parameter lookup + ! -------------------------------------------------------------------------- + + ! vegetation calculations + + real,dimension(NTYPS) :: VGRF11 + real,dimension(NTYPS) :: VGRF12 + real,dimension(NTYPS) :: VGTR11 + real,dimension(NTYPS) :: VGTR12 + real,dimension(NTYPS) :: VGROCA + real,dimension(NTYPS) :: VGROTD + real,dimension(NTYPS) :: VGRDRS + real,dimension(NTYPS) :: VGDDA, VGDDB, VGDDC + real,dimension(NTYPS) :: VGRDA, VGRDB + + real,dimension(:),allocatable :: RSL1, RSL2 + real,dimension(:),allocatable :: SQSCAT + real,allocatable,dimension(:) :: rdc_tmp_1, rdc_tmp_2 + + ! albedo calculation stuff + + type(ESMF_Config) :: CF + type(MAPL_SunOrbit) :: ORBIT + type(ESMF_Time) :: CURRENT_TIME, StopTime, NextTime + type(ESMF_Time) :: BEFORE + type(ESMF_Time) :: NOW + type(ESMF_Time) :: MODELSTART + type(ESMF_Time) :: AFTER + type(ESMF_TimeInterval) :: DELT + type(ESMF_TimeInterval) :: TINT + real :: DT_SOLAR + type(ESMF_Alarm) :: SOLALARM + logical :: solalarmison + logical :: debugzth + real :: FAC + real :: DT + integer :: NTILES + integer :: I, J, K, N + + ! dummy variables for call to get snow temp + + real :: FICE + logical :: DUMFLAG1,DUMFLAG2 + integer :: nmax + type(ESMF_VM) :: VM + +#ifdef DBG_CNLSM_INPUTS + ! vars for debugging purposes + type(ESMF_Grid) :: TILEGRID + type (MAPL_LocStream) :: LOCSTREAM + integer, pointer :: mask(:) + integer :: nt + integer, save :: unit_i=0 + logical, save :: firsttime=.true. + integer :: unit + integer :: NT_GLOBAL + +#endif + + ! Offline case + + type(OFFLINE_WRAP) :: wrap + integer :: OFFLINE_MODE + real,dimension(:,:),allocatable :: ALWN, BLWN + ! un-adelterated TC's and QC's + real, pointer :: TC1_0(:), TC2_0(:), TC4_0(:) + real, pointer :: QA1_0(:), QA2_0(:), QA4_0(:) + real, pointer :: PLSIN(:) + + ! -------------------------------------------------------------------------- + ! Lookup tables + ! -------------------------------------------------------------------------- + + data VGRF11 / 0.100, 0.100, 0.070, 0.105, 0.100, 0.100 / + data VGRF12 / 0.160, 0.160, 0.160, 0.360, 0.160, 0.160 / + data VGTR11 / 0.050, 0.050, 0.050, 0.070, 0.050, 0.050 / + data VGTR12 / 0.001, 0.001, 0.001, 0.220, 0.001, 0.001 / + data VGROTD / 1.000, 1.000, 0.500, 0.500, 0.500, 0.200 / + + data VGROCA / 0.384E-6, 0.384E-6, 0.384E-6, 0.384E-6, 0.384E-6, 0.384E-6/ + data VGRDRS / 0.750E13, 0.750E13, 0.750E13, 0.400E13, 0.750E13, 0.750E13/ + +! Correction to RDC formulation -Randy Koster, 4/1/2011 +! data VGRDA / 285.9, 294.9, 652.9, 25.8, 100.7, 22.9, 23.8, 23.8/ +! data VGRDB / 5.1 , 7.2, 10.8, 4.8, 1.8, 5.1, .000, .000/ + + data VGRDA / 285.9, 355.18, 660.24, 30.06, 100.7, 24.36/ + data VGRDB / 5.1 , 7.2, 10.5, 4.8, 1.8, 5.1/ + +! gkw: following is for CN model +! ------------------------------ + integer, parameter :: nveg = num_veg ! number of vegetation types + integer, parameter :: nzone = num_zon ! number of stress zones + + real, allocatable, dimension(:) :: wgt, wpp, fwet + real, allocatable, dimension(:,:) :: sm ! soil water as frac of WHC for the 3 dydrological zones at root depth + real, allocatable, dimension(:) :: SWSRF1, SWSRF2, SWSRF4 ! soil water as frac of WHC for the 3 dydrological zones at surface soil + real, allocatable, dimension(:,:) :: tcx, qax + real, allocatable, dimension(:,:) :: tgw, rzm, sfm,rcxdt, rcxdq,rc00, rcdt,rcdq, totcolc, wtzone + real, allocatable, dimension(:,:,:) :: btran,elai,esai,fveg,tlai,psnsun,psnsha,laisun,laisha,lmrsun,lmrsha + integer, allocatable, dimension(:,:,:) :: ityp + real, allocatable, dimension(:) :: car1, car2, car4 + real, allocatable, dimension(:) :: para + real, allocatable, dimension(:) :: dayl, dayl_fac + real, allocatable, dimension(:), save :: nee, npp, gpp, sr, padd, frootc, vegc, xsmr,burn, closs + real, allocatable, dimension(:) :: nfire, som_closs, fsnow + real, allocatable, dimension(:) :: ndeploy, denit, sminn_leached, sminn, fire_nloss + real, allocatable, dimension(:) :: leafn, leafc, gross_nmin, net_nmin, nfix_to_sminn, actual_immob + real, allocatable, dimension(:) :: fpg, fpi, sminn_to_plant, sminn_to_npool, ndep_to_sminn + real, allocatable, dimension(:) :: totvegn, totlitn, totsomn, retransn, retransn_to_npool + real, allocatable, dimension(:) :: fuelc, totlitc, cwdc, rootc + real, allocatable, dimension(:) :: lats_degree, lons_degree + + ! *************************************************************************************************************************************************************** + ! Begin Carbon Tracker variables + ! + ! use EEA global average CO2 to scale 2001-2014 CarbonTracker CO2 monthly mean diurnal cycle to obtain CO2 for 1850-2000. + ! extended from the last cycle when carbon reaches equilibrium with the 2001-2014 CarbonTracker CO2 monthly mean diurnal + ! cycle * 280ppm/389.8899ppm, fzeng, Apr 2017. + ! EEA global average CO2 is from http://www.eea.europa.eu/data-and-maps/figures/atmospheric-concentration-of-co2-ppm-1 + ! -------------------------------------------------------------------------------------------------------------------- + + real :: co2g ! global average atmospheric carbon dioxide concentration, varies after 1850 + integer, parameter :: byr_co2g = 1851 ! year global average atmospheric CO2 concentration began to increase from 280.e-6 + integer, parameter :: myr_co2g = 1950 ! year global average atmospheric CO2 concentration reached 311.e-6 + integer, parameter :: eyr_co2g = 2012 ! year global average atmospheric CO2 concentration reached 391.e-6 + real, parameter :: co2g_byr = 280.e-6 ! pre-industrial global average atmospheric carbon dioxide concentration (i.e. before byr_co2g) + real, parameter :: co2g_myr = 311.e-6 ! global average atmospheric CO2 concentration in myr_co2g + real, parameter :: co2g_eyr = 391.e-6 ! global average atmospheric CO2 concentration in eyr_co2g + real, parameter :: dco2g_1 = (co2g_myr-co2g_byr)/(myr_co2g-byr_co2g) ! yearly atmospheric CO2 concentration increment for period 1 (byr_co2g to myr_co2g) + real, parameter :: dco2g_2 = (co2g_eyr-co2g_myr)/(eyr_co2g-myr_co2g) ! yearly atmospheric CO2 concentration increment for period 2 (myr_co2g to eyr_co2g) + real, parameter :: CTco2g = 389.8899e-6 ! Spatial (tile area weighted) and temporal average of 2001-2014 CarbonTracker CO2 + real, allocatable, dimension(:) :: co2v ! spatial varying atmospheric carbon dioxide concentration + + ! parameters for calculating CT indices for tiles + ! ----------------------------------------------- + integer, parameter :: CT_grid_N_lon = 120 ! lon dimension CarbonTracker CO2 data + integer, parameter :: CT_grid_N_lat = 90 ! lat dimension CarbonTracker CO2 data + real, parameter :: CT_grid_dlon = 360./real(CT_grid_N_lon), CT_grid_dlat = 180./real(CT_grid_N_lat) + INTEGER :: info, comm, CTfile, Y1, M1, This3H, ThisCO2_Year, NUNQ, CO2_YEAR + logical, allocatable, dimension (:) :: unq_mask + integer, allocatable, dimension (:,:) :: CT_index + integer, allocatable, dimension (:) :: ct2cat, ThisIndex, loc_int + integer, allocatable, dimension (:), save :: ct_tid + real, dimension (:,:,:,:), allocatable :: CTCO2_TMP + real, dimension (:,:,:), save, allocatable :: CT_CO2V + logical, save :: first_ct = .true. + integer, save :: FIRST_YY + + ! End Carbon Tracker variables + ! ************************************************************************************************************************************************************* + + ! prescribe DYNVEG parameters + ! --------------------------- + + real, parameter :: dtc = 0.03 ! canopy temperature perturbation (K) [approx 1:10000] + real, parameter :: dea = 0.10 ! vapor pressure perturbation (Pa) [approx 1:10000] + + real, allocatable, dimension(:) :: totwat ! total soil liquid water (kg/m2) + real, save :: ashift = 0. ! for baseflow. gkw: this should match value in routine "base" in catchment + real, allocatable, dimension(:), save :: runsrf ! surface runoff (kg/m2/s) + real :: Qair_sat ! saturated specific humidity (kg/kg) + real, allocatable, dimension(:) :: Qair_relative ! relative humidity (%) + + integer :: nz, iv + real :: cn1, cn2, cn3, cn12, cn23, ar, f1, f2, f3, f4, ax1, ax2, ax4 + + real, allocatable, dimension(:,:,:,:) :: albdir, albdif + integer, allocatable, dimension(:) :: ityp_tmp + + ! static summing arrays for CN + ! ---------------------------- + real, allocatable, dimension(:,:,:), save :: lmrsunm, lmrsham + real, allocatable, dimension(:) :: ht, tp, soilice + real :: zbar, frice + + real, allocatable, dimension(:,:) :: col + real, allocatable, dimension(:,:,:) :: pft + + real, allocatable, dimension(:) :: lnfm + character(len=ESMF_MAXSTR) :: LNFMFile + + integer :: ntile, nv, dpy, ierr, iok, ndt + integer, save :: year_prev = -9999 + + integer, save :: n10d ! number of land model steps in a 10-day period + integer, save :: n60d ! number of land model steps in a 60-day period + + ! For accumulated fields + ! NOTE: In CNPhenologyMod.F90, init_gdd20 is always set to .false. as well. For GEOS-5 runs, need to discard at least the first 2 years. + ! This is not a problem for offline runs because we always spin up the model whenever we change meterology. fzeng, July 2017 + ! -------------------------------------------------------------------------------------------------------------------------------------- + logical, parameter :: init_accum = .false.! Always set to .FALSE.!! Will spin up and discard at least 2 years anyways. fzeng, July 2017 + integer, save :: istep ! model time step index + integer :: accper ! number of time steps accumulated in a period of XX days, increases from 1 to nXXd in the first XX days, + ! and remains as nXXd thereafter + + integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_MI, AGCM_S, AGCM_HH, dofyr, AGCM_S_ofday + logical, save :: first = .true. + integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline + + ! solar declination related + real :: ob, declin, zs, zc, max_decl, max_dayl + integer :: year, iday, idayp1 + + ! real :: co2 + real, external :: getco2 + + ! temporaries for call to SIBALB for each type + ! -------------------------------------------- + real, allocatable, dimension(:) :: lai1, lai2, wght + real, allocatable, dimension(:) :: ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp + real, allocatable, dimension(:) :: SNOVR_tmp, SNONR_tmp, SNOVF_tmp, SNONF_tmp + + ! Variables for FPAR + real , allocatable, dimension (:,:,:) :: parzone + + IAm=trim(COMP_NAME)//"::RUN2::Driver" + + ! Begin + + IAm=trim(COMP_NAME)//"Driver" + + ! -------------------------------------------------------------------------- + ! Get time step from configuration + ! -------------------------------------------------------------------------- + + call ESMF_GridCompGet ( GC, CONFIG=CF, RC=STATUS ) + VERIFY_(STATUS) + + ! -------------------------------------------------------------------------- + ! Get my internal MAPL_Generic state + ! -------------------------------------------------------------------------- + + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_Get(MAPL, HEARTBEAT = DT, RC=STATUS) + VERIFY_(STATUS) + + call ESMF_ConfigGetAttribute ( CF, DT ,& + Label = trim(COMP_NAME)//"_DT:" ,& + Default = DT ,& + RC=STATUS ) + VERIFY_(STATUS) + + ! Get component's private internal state + call ESMF_UserCompGetInternalState(gc, 'OfflineMode', wrap, status) + VERIFY_(status) + + call ESMF_VMGetCurrent ( VM, RC=STATUS ) + ! Component's offline mode + OFFLINE_MODE = wrap%ptr%CATCH_OFFLINE + ! if (MAPL_AM_I_Root(VM)) print *, trim(Iam)//'::OFFLINE mode: ', is_OFFLINE + + ! -------------------------------------------------------------------------- + ! Get parameters from generic state. + ! -------------------------------------------------------------------------- + + call MAPL_Get ( MAPL ,& + RUNALARM = ALARM ,& + ORBIT = ORBIT ,& + TILELATS = LATS ,& + TILELONS = LONS ,& + INTERNAL_ESMF_STATE = INTERNAL ,& + RC=STATUS ) + VERIFY_(STATUS) + + ! ----------------------------------------------------- + ! IMPORT Pointers + ! ----------------------------------------------------- + + call MAPL_GetPointer(IMPORT,PS ,'PS' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,TA ,'TA' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,QA ,'QA' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,UU ,'UU' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DZ ,'DZ' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,PCU ,'PCU' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,PLS ,'PLS' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SNO ,'SNO' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,ICE ,'ICE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,FRZR ,'FRZR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRPAR ,'DRPAR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DFPAR ,'DFPAR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRNIR ,'DRNIR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DFNIR ,'DFNIR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRUVR ,'DRUVR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DFUVR ,'DFUVR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,LWDNSRF,'LWDNSRF',RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(IMPORT,ALW ,'ALW' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,BLW ,'BLW' ,RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(IMPORT,EVAP ,'EVAP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DEVAP ,'DEVAP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SH ,'SH' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DSH ,'DSH' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,THATM ,'THATM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,QHATM ,'QHATM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,CTATM ,'CTATM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,CQATM ,'CQATM' ,RC=STATUS); VERIFY_(STATUS) + IF (ATM_CO2 == 4) call MAPL_GetPointer(IMPORT,CO2SC ,'CO2SC' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,LAI ,'LAI' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,GRN ,'GRN' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,ROOTL ,'ROOTL' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,Z2CH ,'Z2CH' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,ASCATZ0,'ASCATZ0',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,NDVI ,'NDVI' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DUDP ,'DUDP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DUSV ,'DUSV' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DUWT ,'DUWT' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DUSD ,'DUSD' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,BCDP ,'BCDP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,BCSV ,'BCSV' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,BCWT ,'BCWT' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,BCSD ,'BCSD' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,OCDP ,'OCDP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,OCSV ,'OCSV' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,OCWT ,'OCWT' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,OCSD ,'OCSD' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SUDP ,'SUDP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SUSV ,'SUSV' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SUWT ,'SUWT' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SUSD ,'SUSD' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SSDP ,'SSDP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SSSV ,'SSSV' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SSWT ,'SSWT' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SSSD ,'SSSD' ,RC=STATUS); VERIFY_(STATUS) + + ! ----------------------------------------------------- + ! INTERNAL Pointers + ! ----------------------------------------------------- + + call MAPL_GetPointer(INTERNAL,BF1 ,'BF1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BF2 ,'BF2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BF3 ,'BF3' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,VGWMAX ,'VGWMAX' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CDCR1 ,'CDCR1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CDCR2 ,'CDCR2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,PSIS ,'PSIS' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BEE ,'BEE' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,POROS ,'POROS' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,WPWET ,'WPWET' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,COND ,'COND' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,GNU ,'GNU' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARS1 ,'ARS1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARS2 ,'ARS2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARS3 ,'ARS3' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARA1 ,'ARA1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARA2 ,'ARA2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARA3 ,'ARA3' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARA4 ,'ARA4' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARW1 ,'ARW1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARW2 ,'ARW2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARW3 ,'ARW3' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ARW4 ,'ARW4' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TSA1 ,'TSA1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TSA2 ,'TSA2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TSB1 ,'TSB1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TSB2 ,'TSB2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ATAU ,'ATAU' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BTAU ,'BTAU' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ITY ,'ITY' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,FVG ,'FVG' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TC ,'TC' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,QC ,'QC' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TG ,'TG' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CAPAC ,'CAPAC' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CATDEF ,'CATDEF' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RZEXC ,'RZEXC' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SRFEXC ,'SRFEXC' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,GHTCNT1 ,'GHTCNT1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,GHTCNT2 ,'GHTCNT2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,GHTCNT3 ,'GHTCNT3' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,GHTCNT4 ,'GHTCNT4' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,GHTCNT5 ,'GHTCNT5' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,GHTCNT6 ,'GHTCNT6' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TSURF ,'TSURF' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,WESNN1 ,'WESNN1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,WESNN2 ,'WESNN2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,WESNN3 ,'WESNN3' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,HTSNNN1 ,'HTSNNN1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,HTSNNN2 ,'HTSNNN2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,HTSNNN3 ,'HTSNNN3' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SNDZN1 ,'SNDZN1' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SNDZN2 ,'SNDZN2' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SNDZN3 ,'SNDZN3' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CH ,'CH' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CM ,'CM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CQ ,'CQ' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,FR ,'FR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,DCQ ,'DCQ' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,DCH ,'DCH' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TILE_ID ,'TILE_ID' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,NDEP ,'NDEP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ABM ,'ABM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,PEATF ,'PEATF' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,GDP ,'GDP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,HDM ,'HDM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,FIELDCAP ,'FIELDCAP' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CLI_T2M ,'CLI_T2M' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BGALBVR ,'BGALBVR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BGALBVF ,'BGALBVF' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BGALBNR ,'BGALBNR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BGALBNF ,'BGALBNF' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CNCOL ,'CNCOL' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CNPFT ,'CNPFT' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TGWM ,'TGWM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RZMM ,'RZMM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SFMM ,'SFMM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,BFLOWM ,'BFLOWM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TOTWATM ,'TOTWATM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TAIRM ,'TAIRM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RHM ,'RHM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,WINDM ,'WINDM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RAINFM ,'RAINFM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SNOWFM ,'SNOWFM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RUNSRFM ,'RUNSRFM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,AR1M ,'AR1M' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TPM ,'TPM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CNSUM ,'CNSUM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,PSNSUNM ,'PSNSUNM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,PSNSHAM ,'PSNSHAM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SNDZM ,'SNDZM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ASNOWM ,'ASNOWM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,T2M10D ,'T2M10D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TPREC10D ,'TPREC10D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TPREC60D ,'TPREC60D' ,RC=STATUS); VERIFY_(STATUS) + + if (N_CONST_LAND4SNWALB /= 0) then + call MAPL_GetPointer(INTERNAL,RDU001 ,'RDU001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RDU002 ,'RDU002' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RDU003 ,'RDU003' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RDU004 ,'RDU004' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RDU005 ,'RDU005' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RBC001 ,'RBC001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RBC002 ,'RBC002' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ROC001 ,'ROC001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ROC002 ,'ROC002' , RC=STATUS); VERIFY_(STATUS) + endif + + IF (RUN_IRRIG /= 0) THEN + call MAPL_GetPointer(INTERNAL,IRRIGFRAC ,'IRRIGFRAC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,PADDYFRAC ,'PADDYFRAC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,LAIMAX ,'LAIMAX' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,LAIMIN ,'LAIMIN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CLMPT ,'CLMPT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CLMST ,'CLMST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CLMPF ,'CLMPF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CLMSF ,'CLMSF' , RC=STATUS); VERIFY_(STATUS) + ENDIF + + ! ----------------------------------------------------- + ! EXPORT POINTERS + ! ----------------------------------------------------- + + call MAPL_GetPointer(EXPORT,EVAPOUT , 'EVAPOUT',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SUBLIM , 'SUBLIM' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHOUT , 'SHOUT' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RUNOFF , 'RUNOFF' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPINT , 'EVPINT' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPSOI , 'EVPSOI' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPVEG , 'EVPVEG' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPICE , 'EVPICE' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WAT10CM , 'WAT10CM',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WATSOI , 'WATSOI' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ICESOI , 'ICESOI' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPSNO , 'EVPSNO' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,BFLOW , 'BASEFLOW',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RUNSURF , 'RUNSURF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SMELT , 'SMELT' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLWUP , 'HLWUP' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWNDSRF , 'SWNDSRF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWNDSRF , 'LWNDSRF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLATN , 'HLATN' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,QINFIL , 'QINFIL' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,AR1 , 'AR1' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,AR2 , 'AR2' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RZEQ , 'RZEQ' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHFLX , 'GHFLX' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSURF , 'TPSURF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSN1 , 'TPSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPUST , 'TPUNST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSAT , 'TPSAT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPWLT , 'TPWLT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ASNOW , 'ASNOW' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHSNOW , 'SHSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,AVETSNOW , 'AVETSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRSAT , 'FRSAT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRUST , 'FRUST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRWLT , 'FRWLT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP1 , 'TP1' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP2 , 'TP2' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP3 , 'TP3' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP4 , 'TP4' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP5 , 'TP5' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP6 , 'TP6' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EMIS , 'EMIS' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBVR , 'ALBVR' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBVF , 'ALBVF' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBNR , 'ALBNR' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBNF , 'ALBNF' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DELTS , 'DELTS' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DELQS , 'DELQS' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TST , 'TST' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,QST , 'QST' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LST , 'LST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WET1 , 'WET1' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WET2 , 'WET2' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WET3 , 'WET3' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WCSF , 'WCSF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WCRZ , 'WCRZ' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WCPR , 'WCPR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ACCUM , 'ACCUM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOMAS , 'SNOWMASS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOWDP , 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVLAND , 'EVLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PRLAND , 'PRLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOLAND , 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DRPARLAND , 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DFPARLAND , 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LHSNOW , 'LHSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWNETSNOW1 , 'SWNETSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWUPSNOW , 'LWUPSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWDNSNOW , 'LWDNSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TCSORIG , 'TCSORIG' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSN1IN , 'TPSN1IN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSN1OUT , 'TPSN1OUT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LHLAND , 'LHLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHLAND , 'SHLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWLAND , 'SWLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWDOWNLAND , 'SWDOWNLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWLAND , 'LWLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHLAND , 'GHLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHSNOW , 'GHSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHTSKIN , 'GHTSKIN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SMLAND , 'SMLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TWLAND , 'TWLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TELAND , 'TELAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TSLAND , 'TSLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DWLAND , 'DWLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DHLAND , 'DHLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SPLAND , 'SPLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SPWATR , 'SPWATR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SPSNOW , 'SPSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNLAI , 'CNLAI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNTLAI , 'CNTLAI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSAI , 'CNSAI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNTOTC , 'CNTOTC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNVEGC , 'CNVEGC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFROOTC , 'CNFROOTC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNNPP , 'CNNPP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNGPP , 'CNGPP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSR , 'CNSR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNNEE , 'CNNEE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNXSMR , 'CNXSMR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNADD , 'CNADD' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNLOSS , 'CNLOSS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNBURN , 'CNBURN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PARABS , 'PARABS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PARINC , 'PARINC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SCSAT , 'SCSAT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SCUNS , 'SCUNS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,BTRANT , 'BTRANT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SIF , 'SIF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNCO2 , 'CNCO2' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFIRE_CNT , 'CNFIRE_CNT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSOM_CLOSS , 'CNSOM_CLOSS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNNDEPLOY , 'CNNDEPLOY' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNDENIT , 'CNDENIT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSMINN_LEACHED , 'CNSMINN_LEACHED' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSMINN , 'CNSMINN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFIRE_NLOSS , 'CNFIRE_NLOSS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNLEAFN , 'CNLEAFN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNLEAFC , 'CNLEAFC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNGROSS_NMIN , 'CNGROSS_NMIN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNNET_NMIN , 'CNNET_NMIN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNNFIX_TO_SMINN , 'CNNFIX_TO_SMINN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNACTUAL_IMMOB , 'CNACTUAL_IMMOB' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFPG , 'CNFPG' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFPI , 'CNFPI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSMINN_TO_PLANT , 'CNSMINN_TO_PLANT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSMINN_TO_NPOOL , 'CNSMINN_TO_NPOOL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNNDEP_TO_SMINN , 'CNNDEP_TO_SMINN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNTOTVEGN , 'CNTOTVEGN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNTOTLITN , 'CNTOTLITN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNTOTSOMN , 'CNTOTSOMN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNRETRANSN , 'CNRETRANSN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNRETRANSN_TO_NPOOL, 'CNRETRANSN_TO_NPOOL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFUELC , 'CNFUELC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNTOTLITC , 'CNTOTLITC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNCWDC , 'CNCWDC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNROOT , 'CNROOT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFSEL , 'CNFSEL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU001 ,'RMELTDU001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU002 ,'RMELTDU002' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU003 ,'RMELTDU003' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU004 ,'RMELTDU004' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU005 ,'RMELTDU005' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTBC001 ,'RMELTBC001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTBC002 ,'RMELTBC002' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTOC001 ,'RMELTOC001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTOC002 ,'RMELTOC002' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WATERTABLED ,'WATERTABLED' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWCHANGE ,'FSWCHANGE' , RC=STATUS); VERIFY_(STATUS) + + IF (RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) + + NTILES = size(PS) + + allocate( ityp(ntiles,nveg,nzone) ) + allocate( fveg(ntiles,nveg,nzone) ) + allocate( wtzone (ntiles,nzone) ) + allocate( elai(ntiles,nveg,nzone) ) + allocate( esai(ntiles,nveg,nzone) ) + allocate( tlai(ntiles,nveg,nzone) ) + +! initialize CN model and transfer restart variables on startup +! ------------------------------------------------------------- + if(first) then + + ! set number of time steps within a XX-day/hour period for 2m temperature XX-day/hour "running mean" + ! -------------------------------------------------------------------------------------------------- + n10d = 10*86400/dt + n60d = 60*86400/dt + ! fzeng: this is done in such way to exclude istep in the restart file + if(init_accum) then + istep = 0 ! set model time step index to 0 when begin to accumulate the cumulative variables, fzeng, 21 Apr 2017 + else + istep = maxval((/n10d,n60d/)) ! otherwise, set model time step index to the maximum of these nXX + end if + + ! variables used for summing CN inputs over multiple land model calls; not saved on restart + ! fzeng: run must end on a CN call step + ! ----------------------------------------------------------------------------------------- + allocate( lmrsunm(ntiles,nveg,nzone) ) + allocate( lmrsham(ntiles,nveg,nzone) ) + allocate( runsrf(ntiles) ) + + lmrsunm = 0. + lmrsham = 0. + runsrf = 0. + + first = .false. + + endif + +! set CLM CN PFT & fraction, set carbon zone weights +! -------------------------------------------------- + do nz = 1,nzone + ityp(:,:,nz) = nint(ity(:,:)) + fveg(:,:,nz) = fvg(:,:) + wtzone(:,nz) = CN_zone_weight(nz) + end do + + ! obtain LAI from previous time step (from CN model) + ! -------------------------------------------------- + call get_CN_LAI(ntiles,nveg,nzone,ityp,fveg,elai,esai=esai,tlai = tlai) + +! OPTIONAL IMPOSE MONTHLY MEAN DIURNAL CYCLE FROM NOAA CARBON TRACKER +! ------------------------------------------------------------------- + + IF ((ATM_CO2 == 1).OR.(ATM_CO2 == 2)) THEN + READ_CT_CO2: IF(first_ct) THEN + + ! Carbon Tracker grid tiles mapping + + allocate (CT_INDEX (1:CT_grid_N_lon, 1:CT_grid_N_lat)) + do j = 1, CT_grid_N_lat + do i = 1, CT_grid_N_lon + CT_INDEX (i,j) = (j - 1) * CT_grid_N_lon + i + end do + end do + + allocate (ct2cat (1: NTILES)) + allocate (ct_tid (1: NTILES)) + + ct_tid = -9999 + ct2cat = 0 + + do N = 1, NTILES + I = NINT ((CEILING (lons(n)*90./MAPL_PI)*2 + 180.) / CT_grid_dlon) + J = NINT ((CEILING (lats(n)*90./MAPL_PI)*2 + 90.) / CT_grid_dlat) + CT2CAT (N) = ct_index (i,j) + end do + + N = count(ct2cat > 0) + + allocate (unq_mask(1:N )) + allocate (loc_int (1:N )) + + loc_int = pack(ct2cat ,mask = (ct2cat > 0)) + call MAPL_Sort (loc_int) + + unq_mask = .true. + + do i = 2,N + unq_mask(i) = .not.(loc_int(i) == loc_int(i-1)) + end do + + NUNQ = count(unq_mask) + + allocate (ThisIndex (1:NUNQ)) + ThisIndex = pack(loc_int, mask = unq_mask ) + + do i = 1, NUNQ + where (ct2cat == ThisIndex(i)) ct_tid = i + end do + + ! Reading Carbon Tracker CO2_MonthlyMean_DiurnalCycle + + call ESMF_ClockGet( CLOCK, startTime=MODELSTART, RC=STATUS ); VERIFY_(STATUS) + call ESMF_TimeGet ( MODELSTART, YY = FIRST_YY, rc=status ) ; VERIFY_(STATUS) + CALL ESMF_VMGet(vm, MPICOMMUNICATOR=comm, rc=status); VERIFY_(status) + call MPI_Info_create(info, STATUS); VERIFY_(status) + call MPI_Info_set(info, "romio_cb_read", "automatic", STATUS); VERIFY_(status) + + STATUS = NF_OPEN ('CO2_MonthlyMean_DiurnalCycle.nc4', NF_NOWRITE, CTfile); VERIFY_(status) + + allocate (CT_CO2V (1: NUNQ, 1:12, 1:8)) + allocate (CTCO2_TMP (1:CT_grid_N_lon, 1:CT_grid_N_lat, 1:12, 1:8)) + + STATUS = NF_GET_VARA_REAL (CTfile, VarID(CTfile,'CO2'), (/1,1,1,1/), & + (/CT_grid_N_lon, CT_grid_N_lat, 12, 8/), CTCO2_TMP);VERIFY_(STATUS) + + do N = 1, NUNQ + I = MOD (ThisIndex(N), CT_grid_N_lon) + IF(I == 0) I = CT_grid_N_lon + J = (ThisIndex(N) -I) / CT_grid_N_lon + 1 + + CT_CO2V (N,:,:) = CTCO2_TMP (I,J,:,:) + + end do + + status = NF_CLOSE (CTFile); VERIFY_(status) + first_ct = .false. + + deallocate (CTCO2_TMP,ct2cat, unq_mask, loc_int, ct_index, ThisIndex) + + ENDIF READ_CT_CO2 + ENDIF + + + ! -------------------------------------------------------------------------- + ! ALLOCATE LOCAL POINTERS + ! -------------------------------------------------------------------------- + + allocate(GHTCNT (6,NTILES)) + allocate(WESNN (3,NTILES)) + allocate(HTSNNN (3,NTILES)) + allocate(SNDZN (3,NTILES)) + allocate(TILEZERO (NTILES)) + allocate(DZSF (NTILES)) + allocate(SWNETFREE(NTILES)) + allocate(SWNETSNOW(NTILES)) + allocate(VEG1 (NTILES)) + allocate(VEG2 (NTILES)) + allocate(RCSAT (NTILES)) + allocate(DRCSDT (NTILES)) + allocate(DRCSDQ (NTILES)) + allocate(RCUNS (NTILES)) + allocate(DRCUDT (NTILES)) + allocate(DRCUDQ (NTILES)) + allocate(ZTH (NTILES)) + allocate(SLR (NTILES)) + allocate(RSL1 (NTILES)) + allocate(RSL2 (NTILES)) + allocate(SQSCAT (NTILES)) + allocate(RDC (NTILES)) + allocate(RDC_TMP_1(NTILES)) + allocate(RDC_TMP_2(NTILES)) + allocate(UUU (NTILES)) + allocate(RHO (NTILES)) + allocate(ZVG (NTILES)) + allocate(LAI0 (NTILES)) + allocate(GRN0 (NTILES)) + allocate(Z0 (NTILES)) + allocate(D0 (NTILES)) + allocate(SFMC (NTILES)) + allocate(RZMC (NTILES)) + allocate(PRMC (NTILES)) + allocate(ENTOT (NTILES)) + allocate(ghflxsno (NTILES)) + allocate(ghflxtskin(NTILES)) + allocate(WTOT (NTILES)) + allocate(WCHANGE (NTILES)) + allocate(ECHANGE (NTILES)) + allocate(HSNACC (NTILES)) + allocate(EVACC (NTILES)) + allocate(SHACC (NTILES)) + allocate(VSUVR (NTILES)) + allocate(VSUVF (NTILES)) + allocate(SNOVR (NTILES)) + allocate(SNOVF (NTILES)) + allocate(SNONR (NTILES)) + allocate(SNONF (NTILES)) + allocate(CAT_ID (NTILES)) + allocate(ALWX (NTILES)) + allocate(BLWX (NTILES)) + allocate(SHSNOW1 (NTILES)) + allocate(AVETSNOW1 (NTILES)) + allocate(WAT10CM1 (NTILES)) + allocate(WATSOI1 (NTILES)) + allocate(ICESOI1 (NTILES)) + allocate(LHSNOW1 (NTILES)) + allocate(LWUPSNOW1 (NTILES)) + allocate(LWDNSNOW1 (NTILES)) + allocate(NETSWSNOW (NTILES)) + allocate(TCSORIG1 (NTILES)) + allocate(TPSN1IN1 (NTILES)) + allocate(TPSN1OUT1 (NTILES)) + allocate(LHACC (NTILES)) + allocate(SUMEV (NTILES)) + allocate(fveg1 (NTILES)) + allocate(fveg2 (NTILES)) + allocate(FICE1 (NTILES)) + allocate(SLDTOT (NTILES)) + allocate(FSW_CHANGE(NTILES)) + + allocate(SHSBT (NTILES,NUM_SUBTILES)) + allocate(DSHSBT (NTILES,NUM_SUBTILES)) + allocate(EVSBT (NTILES,NUM_SUBTILES)) + allocate(DEVSBT (NTILES,NUM_SUBTILES)) + allocate(DEDTC (NTILES,NUM_SUBTILES)) + allocate(DHSDQA (NTILES,NUM_SUBTILES)) + allocate(CFT (NTILES,NUM_SUBTILES)) + allocate(CFQ (NTILES,NUM_SUBTILES)) + allocate(TCO (NTILES,NUM_SUBTILES)) + allocate(QCO (NTILES,NUM_SUBTILES)) + allocate(DQS (NTILES,NUM_SUBTILES)) + allocate(QSAT (NTILES,NUM_SUBTILES)) + allocate(RA (NTILES,NUM_SUBTILES)) + allocate(RCONSTIT (NTILES,N_SNOW,N_constit)) + allocate(TOTDEPOS (NTILES,N_constit)) + allocate(RMELT (NTILES,N_constit)) + allocate(ALWN (NTILES,NUM_SUBTILES)) + allocate(BLWN (NTILES,NUM_SUBTILES)) + allocate(TC1_0 (NTILES)) + allocate(TC2_0 (NTILES)) + allocate(TC4_0 (NTILES)) + allocate(QA1_0 (NTILES)) + allocate(QA2_0 (NTILES)) + allocate(QA4_0 (NTILES)) + allocate(PLSIN (NTILES)) + + call ESMF_VMGetCurrent ( VM, RC=STATUS ) + ! -------------------------------------------------------------------------- + ! Catchment Id and vegetation types used to index into tables + ! -------------------------------------------------------------------------- + + CAT_ID = nint(tile_id) + + where(ITY(:,1) > 0.) ! gkw: account for "split" types + VEG1 = map_cat(nint(ITY(:,1))) ! map primary CN PFT to catchment type + elsewhere + VEG1 = map_cat(nint(ITY(:,2))) ! map primary CN PFT to catchment type + endwhere + where(ITY(:,3) > 0.) + VEG2 = map_cat(nint(ITY(:,3))) ! map secondary CN PFT to catchment type + elsewhere + VEG2 = map_cat(nint(ITY(:,4))) ! map secondary CN PFT to catchment type + endwhere + + fveg1(:) = fvg(:,1) + fvg(:,2) ! sum veg fractions (primary) gkw: NVEG specific + fveg2(:) = fvg(:,3) + fvg(:,4) ! sum veg fractions (secondary) gkw: fveg1+fveg2=1 + + allocate ( lai1(ntiles) ) + allocate ( lai2(ntiles) ) + allocate ( wght(ntiles) ) + + lai1 = 0. + wght = 0. + do nz = 1,nzone + do nv = 1,2 + lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + lai1 = lai1 / max(wght,1.e-8) ! LAI for primary vegetation type + + lai2 = 0. + wght = 0. + do nz = 1,nzone + do nv = 3,4 + lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + lai2 = lai2 / max(wght,1.e-8) ! LAI for secondary vegetation type + +! LAI seen by the land model +! -------------------------- + lai = fveg1*lai1 + fveg2*lai2 ! gkw: prognostic LAI on catch_internal_rst (overwrite VEGDYN import) + + ! -------------------------------------------------------------------------- + ! surface layer depth for soil moisture + ! -------------------------------------------------------------------------- + + DZSF( :) = SURFLAY + + ! -------------------------------------------------------------------------- + ! build arrays from internal state + ! -------------------------------------------------------------------------- + + GHTCNT(1,:) = GHTCNT1 + GHTCNT(2,:) = GHTCNT2 + GHTCNT(3,:) = GHTCNT3 + GHTCNT(4,:) = GHTCNT4 + GHTCNT(5,:) = GHTCNT5 + GHTCNT(6,:) = GHTCNT6 + + WESNN (1,:) = WESNN1 + WESNN (2,:) = WESNN2 + WESNN (3,:) = WESNN3 + + HTSNNN(1,:) = HTSNNN1 + HTSNNN(2,:) = HTSNNN2 + HTSNNN(3,:) = HTSNNN3 + + SNDZN (1,:) = SNDZN1 + SNDZN (2,:) = SNDZN2 + SNDZN (3,:) = SNDZN3 + + debugzth = .false. + + ! -------------------------------------------------------------------------- + ! Get the current time. + ! -------------------------------------------------------------------------- + + call ESMF_ClockGet( CLOCK, currTime=CURRENT_TIME, startTime=MODELSTART, TIMESTEP=DELT, RC=STATUS ) + VERIFY_(STATUS) + if (MAPL_AM_I_Root(VM).and.debugzth) then + print *,' start time of clock ' + CALL ESMF_TimePrint ( MODELSTART, OPTIONS="string", RC=STATUS ) + endif + + ! -------------------------------------------------------------------------- + ! retrieve the zenith angle + ! -------------------------------------------------------------------------- + +!! The next sequence is to make sure that the albedo here and in solar are in sync +!! +! Need to know when Solar was called last, so first get the solar alarm + call ESMF_ClockGetAlarm ( CLOCK, alarmname="SOLAR_Alarm", ALARM=SOLALARM, RC=STATUS ) +! VERIFY_(STATUS) + if(status==0) then +! Get the interval of the solar alarm - first get it in seconds + call ESMF_ConfigGetAttribute ( CF, DT_SOLAR, Label="SOLAR_DT:", DEFAULT=DT, RC=STATUS ) + VERIFY_(STATUS) +! Now make an ESMF interval from the increment in seconds + CALL ESMF_TimeIntervalSet ( TINT, S=NINT(DT_SOLAR), RC=STATUS ) + VERIFY_(STATUS) +! Now print out the solar alarm interval + if (MAPL_AM_I_Root(VM).and.debugzth) CALL ESMF_TimeIntervalPrint ( TINT, OPTIONS="string", RC=STATUS ) +! Now find out if it is ringing now: if so, set "BEFORE" to last time it rang before now + solalarmison = ESMF_AlarmIsRinging(SOLALARM,RC=STATUS) + VERIFY_(STATUS) + if (MAPL_AM_I_Root(VM).and.debugzth)print *,' logical for solar alarm ',solalarmison +! if so, set "BEFORE" to last time it rang before now + if(solalarmison) then + if (MAPL_AM_I_Root(VM).and.debugzth)print *,' In catch, solar alarm is ringing ' + NOW = CURRENT_TIME + BEFORE = NOW - TINT +! Now print out the last time solar alarm rang + if (MAPL_AM_I_Root(VM).and.debugzth)CALL ESMF_TimePrint ( BEFORE, OPTIONS="string", RC=STATUS ) +! If alarm is not ringing now, find out when it rang last + else + if (MAPL_AM_I_Root(VM).and.debugzth)print *,' In catch, solar alarm is not ringing ' + call ESMF_AlarmGet ( SOLALARM, prevRingTime=BEFORE, RC=STATUS ) + VERIFY_(STATUS) +! PrevRingTime can lie: if alarm never went off yet it gives next alarm time, not prev. + if(BEFORE > CURRENT_TIME) then + BEFORE = BEFORE-TINT + if (MAPL_AM_I_Root(VM).and.debugzth)print *,' In catch, solar alarm not ringing, prev time lied ' + if (MAPL_AM_I_Root(VM).and.debugzth)CALL ESMF_TimePrint ( BEFORE, OPTIONS="string", RC=STATUS ) + else + if (MAPL_AM_I_Root(VM).and.debugzth)print *,' In catch, solar alarm not ringing, prev time okay ' + if (MAPL_AM_I_Root(VM).and.debugzth)CALL ESMF_TimePrint ( BEFORE, OPTIONS="string", RC=STATUS ) + endif +! Now print out the last time solar alarm rang + endif + else + BEFORE = CURRENT_TIME + TINT = DELT + end if +! Get the zenith angle at the center of the time between the last solar call and the next one + call MAPL_SunGetInsolation(LONS, LATS, & + ORBIT, ZTH, SLR, & + INTV = TINT, & + currTime=BEFORE+DELT, & + RC=STATUS ) + VERIFY_(STATUS) + + ZTH = max(0.0,ZTH) + ZVG = fveg1*(Z2CH - SCALE4Z0*(Z2CH - MIN_VEG_HEIGHT)*exp(-LAI1)) + & + fveg2*(Z2CH - SCALE4Z0*(Z2CH - MIN_VEG_HEIGHT)*exp(-LAI2)) + + + ! For now roughnesses and displacement heights + ! are the same for all subtiles. + !--------------------------------------------------- + + Z0 = Z0_BY_ZVEG*ZVG + IF (USE_ASCATZ0 == 1) WHERE (NDVI <= 0.2) Z0 = ASCATZ0 + D0 = D0_BY_ZVEG*ZVG + + UUU = max(UU,MAPL_USMIN) * (log((ZVG-D0+Z0)/Z0) & + / log((max(DZ-D0,10.)+Z0)/Z0)) + + !--------------- GOSWIM IMPORTS FROM GOCART --------------- + ! Initialization + RCONSTIT(:,:,:) = 0.0 + TOTDEPOS(:,:) = 0.0 + RMELT(:,:) = 0.0 + !------------------------------------------------------------------ + + ! Zero the light-absorbing aerosol (LAA) deposition rates from GOCART: + + select case (AEROSOL_DEPOSITION) + case (0) + DUDP(:,:)=0. + DUSV(:,:)=0. + DUWT(:,:)=0. + DUSD(:,:)=0. + BCDP(:,:)=0. + BCSV(:,:)=0. + BCWT(:,:)=0. + BCSD(:,:)=0. + OCDP(:,:)=0. + OCSV(:,:)=0. + OCWT(:,:)=0. + OCSD(:,:)=0. + + case (2) + DUDP(:,:)=0. + DUSV(:,:)=0. + DUWT(:,:)=0. + DUSD(:,:)=0. + + case (3) + BCDP(:,:)=0. + BCSV(:,:)=0. + BCWT(:,:)=0. + BCSD(:,:)=0. + + case (4) + OCDP(:,:)=0. + OCSV(:,:)=0. + OCWT(:,:)=0. + OCSD(:,:)=0. + + end select + +! Convert the dimentions for LAAs from GEOS_SurfGridComp.F90 to GEOS_LandIceGridComp.F90 +! Note: Explanations of each variable +! TOTDEPOS(:,1): Combined dust deposition from size bin 1 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,2): Combined dust deposition from size bin 2 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,3): Combined dust deposition from size bin 3 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,4): Combined dust deposition from size bin 4 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,5): Combined dust deposition from size bin 5 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,6): Combined hydrophobic BC deposition from size bin 1 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,7): Combined hydrophilic BC deposition from size bin 2 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,8): Combined hydrophobic OC deposition from size bin 1 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,9): Combined hydrophilic OC deposition from size bin 2 (dry, conv-scav, ls-scav, sed) +!============================= Possible future applications ==================================== +! TOTDEPOS(:,10): Combined sulfate deposition from size bin 3 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,11): Combined sea salt deposition from size bin 1 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,12): Combined sea salt deposition from size bin 2 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,13): Combined sea salt deposition from size bin 3 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,14): Combined sea salt deposition from size bin 4 (dry, conv-scav, ls-scav, sed) +! TOTDEPOS(:,15): Combined sea salt deposition from size bin 5 (dry, conv-scav, ls-scav, sed) + + TOTDEPOS(:,1) = DUDP(:,1) + DUSV(:,1) + DUWT(:,1) + DUSD(:,1) + TOTDEPOS(:,2) = DUDP(:,2) + DUSV(:,2) + DUWT(:,2) + DUSD(:,2) + TOTDEPOS(:,3) = DUDP(:,3) + DUSV(:,3) + DUWT(:,3) + DUSD(:,3) + TOTDEPOS(:,4) = DUDP(:,4) + DUSV(:,4) + DUWT(:,4) + DUSD(:,4) + TOTDEPOS(:,5) = DUDP(:,5) + DUSV(:,5) + DUWT(:,5) + DUSD(:,5) + TOTDEPOS(:,6) = BCDP(:,1) + BCSV(:,1) + BCWT(:,1) + BCSD(:,1) + TOTDEPOS(:,7) = BCDP(:,2) + BCSV(:,2) + BCWT(:,2) + BCSD(:,2) + TOTDEPOS(:,8) = OCDP(:,1) + OCSV(:,1) + OCWT(:,1) + OCSD(:,1) + TOTDEPOS(:,9) = OCDP(:,2) + OCSV(:,2) + OCWT(:,2) + OCSD(:,2) +!============================= Possible future applications ==================================== +! TOTDEPOS(:,10) = SUDP(:,1) + SUSV(:,1) + SUWT(:,1) + SUSD(:,1) +! TOTDEPOS(:,11) = SSDP(:,1) + SSSV(:,1) + SSWT(:,1) + SSSD(:,1) +! TOTDEPOS(:,12) = SSDP(:,2) + SSSV(:,2) + SSWT(:,2) + SSSD(:,2) +! TOTDEPOS(:,13) = SSDP(:,3) + SSSV(:,3) + SSWT(:,3) + SSSD(:,3) +! TOTDEPOS(:,14) = SSDP(:,4) + SSSV(:,4) + SSWT(:,4) + SSSD(:,4) +! TOTDEPOS(:,15) = SSDP(:,5) + SSSV(:,5) + SSWT(:,5) + SSSD(:,5) + +! --------------- GOSWIM PROGRNOSTICS --------------------------- + + if (N_CONST_LAND4SNWALB /= 0) then + + ! Conversion of the masses of the snow impurities + ! Note: Explanations of each variable + ! Number of snow layer is 15: N = 1-15 + ! RCONSTIT(NTILES,N,1): Dust mass from bin 1 in layer N + ! RCONSTIT(NTILES,N,2): Dust mass from bin 2 in layer N + ! RCONSTIT(NTILES,N,3): Dust mass from bin 3 in layer N + ! RCONSTIT(NTILES,N,4): Dust mass from bin 4 in layer N + ! RCONSTIT(NTILES,N,5): Dust mass from bin 5 in layer N + ! RCONSTIT(NTILES,N,6): Hydrophobic BC mass from bin 1 in layer N + ! RCONSTIT(NTILES,N,7): Hydrophilic BC mass from bin 2 in layer N + ! RCONSTIT(NTILES,N,8): Hydrophobic OC mass from bin 1 in layer N + ! RCONSTIT(NTILES,N,9): Hydrophilic OC mass from bin 2 in layer N + !============================= Possible future applications ==================================== + ! RCONSTIT(NTILES,N,10): Sulfate mass from size bin 3 in layer N + ! RCONSTIT(NTILES,N,11): Sea salt mass from size bin 1 in layer N + ! RCONSTIT(NTILES,N,12): Sea salt mass from size bin 2 in layer N + ! RCONSTIT(NTILES,N,13): Sea salt mass from size bin 3 in layer N + ! RCONSTIT(NTILES,N,14): Sea salt mass from size bin 4 in layer N + ! RCONSTIT(NTILES,N,15): Sea salt mass from size bin 5 in layer N + + RCONSTIT(:,:,1) = RDU001(:,:) + RCONSTIT(:,:,2) = RDU002(:,:) + RCONSTIT(:,:,3) = RDU003(:,:) + RCONSTIT(:,:,4) = RDU004(:,:) + RCONSTIT(:,:,5) = RDU005(:,:) + RCONSTIT(:,:,6) = RBC001(:,:) + RCONSTIT(:,:,7) = RBC002(:,:) + RCONSTIT(:,:,8) = ROC001(:,:) + RCONSTIT(:,:,9) = ROC002(:,:) + +!============================= Possible future applications ==================================== +! RCONSTIT(:,:,10) = RSU003(:,:) +! RCONSTIT(:,:,11) = RSS001(:,:) +! RCONSTIT(:,:,12) = RSS002(:,:) +! RCONSTIT(:,:,13) = RSS003(:,:) +! RCONSTIT(:,:,14) = RSS004(:,:) +! RCONSTIT(:,:,15) = RSS005(:,:) + endif + + ! -------------------------------------------------------------------------- + ! Parameters that depend on vegetation type only gkw: these are not used in unified + ! -------------------------------------------------------------------------- + + RSL1 = VGRDRS(VEG1)/(ROOTL*VGROTD(VEG1)) + + RSL2 = ROOTL*VGROCA(VEG1) + RSL2 = (RSL2 - 3.0 - 2.*alog(RSL2/(1.-RSL2)))/(8.*MAPL_PI*ROOTL*VGROTD(VEG1)) + + ! -------------------------------------------------------------------------- + ! Greenness and type dependent parameters + ! -------------------------------------------------------------------------- + + SQSCAT = fveg1*((VGTR11(VEG1)+VGRF11(VEG1)) * GRN + (VGTR12(VEG1)+VGRF12(VEG1)) * (1.-GRN)) + & + fveg2*((VGTR11(VEG2)+VGRF11(VEG2)) * GRN + (VGTR12(VEG2)+VGRF12(VEG2)) * (1.-GRN)) + SQSCAT = sqrt(1.0 - SQSCAT) + + ! -------------------------------------------------------------------------- + ! LAI and type dependent parameters; RDC formulation now uses veg fractions gkw: 2013-11-25, see note from Randy + ! -------------------------------------------------------------------------- + + ! old RDC formulation implemented in orginial GEOScatchCN_GridCom + ! RDC = max(VGRDA(VEG1),VGRDA(VEG2))*min(1.,lai/2.) + + ! new RDC formulation used to reproduce Fanwei Zeng's LDASsa Catchment-CN.4.0 and Eunjee Lee's Catchment-CN.4.5 simulations + rdc_tmp_1 = max( VGRDA(VEG1)*min( 1., LAI1/VGRDB(VEG1) ), 0.001) + rdc_tmp_2 = max( VGRDA(VEG2)*min( 1., LAI2/VGRDB(VEG2) ), 0.001) + RDC = max(rdc_tmp_1,rdc_tmp_2)*min(1.,lai/2.) + RDC = max(RDC,0.001) + + RHO = PS/(MAPL_RGAS*(TA*(1+MAPL_VIREPS*QA))) + + DEDTC=0.0 + DHSDQA=0.0 + + if(OFFLINE_MODE /=0) then + do N=1,NUM_SUBTILES + CFT (:,N) = 1.0 + CFQ (:,N) = 1.0 + SHSBT (:,N) = MAPL_CP*CH(:,N)*(TC(:,N)-TA) + EVSBT (:,N) = CQ(:,N)*(QC(:,N)-QA) + DSHSBT(:,N) = MAPL_CP*CH(:,N) + DEVSBT(:,N) = CQ(:,N) + BLWN(:,N) = EMIS*MAPL_STFBOL*TC(:,N)*TC(:,N)*TC(:,N) + ALWN(:,N) = -3.0*BLWN(:,N)*TC(:,N) + BLWN(:,N) = 4.0*BLWN(:,N) + end do + if(CHOOSEMOSFC==0 .and. incl_Louis_extra_derivs ==1) then + do N=1,NUM_SUBTILES + DEVSBT(:,N)=CQ(:,N)+max(0.0,-DCQ(:,N)*MAPL_VIREPS*TC(:,N)*(QC(:,N)-QA)) + DEDTC(:,N) =max(0.0,-DCQ(:,N)*(1.+MAPL_VIREPS*QC(:,N))*(QC(:,N)-QA)) + DSHSBT(:,N)=MAPL_CP*(CH(:,N)+max(0.0,-DCH(:,N)*(1.+MAPL_VIREPS*QC(:,N))*(TC(:,N)-TA))) + DHSDQA(:,N)=max(0.0,-MAPL_CP*DCH(:,N)*MAPL_VIREPS*TC(:,N)*(TC(:,N)-TA)) + enddo + endif + else + do N=1,NUM_SUBTILES + CFT (:,N) = (CH(:,N)/CTATM) + CFQ (:,N) = (CQ(:,N)/CQATM) + SHSBT (:,N) = (SH + DSH *(TC(:,N)-THATM))*CFT(:,N) + EVSBT (:,N) = (EVAP+ DEVAP*(QC(:,N)-QHATM))*CFQ(:,N) + DSHSBT(:,N) = DSH *CFT(:,N) + DEVSBT(:,N) = DEVAP*CFQ(:,N) + ALWN(:,N)=ALW + BLWN(:,N)=BLW + end do + end if + + ! Compute DQS; make sure QC is between QA and QSAT; compute RA. + ! + ! Some 1,000 lines below, duplicate code was present and removed in Jan 2022. + ! - reichle, 14 Jan 2022. + + do N=1,NUM_SUBTILES + DQS(:,N) = GEOS_DQSAT ( TC(:,N), PS, QSAT=QSAT(:,N), PASCALS=.true., RAMP=0.0 ) + QC (:,N) = min(max(QA(:),QSAT(:,N)),QC(:,N)) + QC (:,N) = max(min(QA(:),QSAT(:,N)),QC(:,N)) + RA (:,N) = RHO/CH(:,N) + end do + + + QC(:,FSNW) = QSAT(:,FSNW) + + ! -------------------------------------------------------------------------- + ! get total solid precip + ! -------------------------------------------------------------------------- + + SLDTOT = SNO+ICE+FRZR + + ! -------------------------------------------------------------------------- + ! protect the forcing from unsavory values, as per practice in offline + ! driver + ! -------------------------------------------------------------------------- + + ASSERT_(count(PLS<0.)==0) + ASSERT_(count(PCU<0.)==0) + ASSERT_(count(SLDTOT<0.)==0) + + LAI0 = max(0.0001 , LAI) + GRN0 = max(0.0001 , GRN) + ZTH = max(0.0001 , ZTH) + + TCO = TC + QCO = QC + + ! -------------------------------------------------------------------------- + ! actual CATCHMENT call + ! -------------------------------------------------------------------------- + + TILEZERO = 0.0 + + call MAPL_TimerOn ( MAPL, "-CATCHCNCLM51" ) + + +! ---------------------------------------------------------------------------------------- + +! gkw: start on main CN block + + allocate( btran(ntiles,nveg,nzone) ) + allocate( wgt(ntiles) ) + allocate( wpp(ntiles) ) + allocate( fwet(ntiles) ) + allocate( sm(ntiles,fsat:fwlt)) + allocate( SWSRF1(ntiles) ) + allocate( SWSRF2(ntiles) ) + allocate( SWSRF4(ntiles) ) + allocate( tcx(ntiles,nzone) ) + allocate( qax(ntiles,nzone) ) + allocate( rcxdt(ntiles) ) + allocate( rcxdq(ntiles) ) + allocate( car1(ntiles) ) + allocate( car2(ntiles) ) + allocate( car4(ntiles) ) + allocate( parzone(ntiles,nveg,nzone) ) + allocate( para(ntiles) ) + allocate ( totwat(ntiles) ) + if(.not. allocated(npp )) allocate( npp(ntiles) ) + if(.not. allocated(gpp )) allocate( gpp(ntiles) ) + if(.not. allocated(sr )) allocate( sr(ntiles) ) + if(.not. allocated(nee )) allocate( nee(ntiles) ) + if(.not. allocated(padd)) allocate( padd(ntiles) ) + if(.not. allocated(frootc)) allocate(frootc(ntiles) ) + if(.not. allocated(vegc)) allocate( vegc(ntiles) ) + if(.not. allocated(xsmr)) allocate( xsmr(ntiles) ) + if(.not. allocated(burn)) allocate( burn(ntiles) ) + if(.not. allocated(closs))allocate( closs(ntiles) ) + + allocate( nfire(ntiles) ) + allocate( som_closs(ntiles) ) + allocate( dayl(ntiles) ) + allocate(dayl_fac(ntiles) ) + allocate(CO2V (ntiles) ) + allocate( fsnow(ntiles) ) + allocate( ityp_tmp(ntiles) ) + allocate( Qair_relative(ntiles) ) + allocate( ndeploy(ntiles) ) + allocate( denit(ntiles) ) + allocate( sminn_leached(ntiles) ) + allocate( sminn(ntiles) ) + allocate( fire_nloss(ntiles) ) + allocate( leafn(ntiles) ) + allocate( leafc(ntiles) ) + allocate( gross_nmin(ntiles) ) + allocate( net_nmin(ntiles) ) + allocate( nfix_to_sminn(ntiles) ) + allocate( actual_immob(ntiles) ) + allocate( fpg(ntiles) ) + allocate( fpi(ntiles) ) + allocate( sminn_to_plant(ntiles) ) + allocate( sminn_to_npool(ntiles) ) + allocate( ndep_to_sminn(ntiles) ) + allocate( totvegn(ntiles) ) + allocate( totlitn(ntiles) ) + allocate( totsomn(ntiles) ) + allocate( retransn(ntiles) ) + allocate( retransn_to_npool(ntiles) ) + allocate( fuelc(ntiles) ) + allocate( totlitc(ntiles) ) + allocate( cwdc(ntiles) ) + allocate( rootc(ntiles) ) + allocate( lats_degree(ntiles) ) + allocate( lons_degree(ntiles) ) + allocate( lnfm(ntiles) ) + + allocate( tgw(ntiles,nzone) ) + allocate( rzm(ntiles,nzone) ) + allocate( rc00(ntiles,nzone) ) + allocate( rcdt(ntiles,nzone) ) + allocate( rcdq(ntiles,nzone) ) + allocate( totcolc(ntiles,nzone) ) + allocate( sfm(ntiles,nzone) ) + + allocate( albdir(ntiles,nveg,nzone,2) ) + allocate( albdif(ntiles,nveg,nzone,2) ) + + allocate( psnsun(ntiles,nveg,nzone) ) + allocate( psnsha(ntiles,nveg,nzone) ) + allocate( laisun(ntiles,nveg,nzone) ) + allocate( laisha(ntiles,nveg,nzone) ) + allocate( lmrsun(ntiles,nveg,nzone) ) + allocate( lmrsha(ntiles,nveg,nzone) ) + allocate( parzone(ntiles,nveg,nzone)) + allocate( ht(N_gt) ) + allocate( tp(N_gt) ) + allocate( soilice(N_gt) ) + +! get current date & time gkw: this is used to transfer CN restart vars & set declination +! ----------------------- + call ESMF_TimeGet ( CURRENT_TIME, YY = AGCM_YY, & + MM = AGCM_MM, & + DD = AGCM_DD, & + H = AGCM_HH, & + M = AGCM_MI, & + S = AGCM_S , & + dayOfYear = dofyr , & + rc=status ) + VERIFY_(STATUS) + + AGCM_S_ofday = AGCM_S + 60 * AGCM_MI + 3600 * AGCM_HH + +! get ending time; determine if this is last call before ending time +! ------------------------------------------------------------------ + call ESMF_ClockGet ( clock, StopTime=StopTime ,rc=STATUS ) + VERIFY_(STATUS) + + NextTime = CURRENT_TIME + DELT + + ! 0-land tiles processors hang in MAPL_ReadForcing + ! Thus moved reading lnfm here + ! ------------------------------------------------ + + if(mod(AGCM_S_ofday,nint(dtcn)) == 0) then + ! Get lightening frequency clim file name from configuration + call MAPL_GetResource ( MAPL, LNFMFILE, label = 'LNFM_FILE:', default = 'lnfm.dat', RC=STATUS ) + VERIFY_(STATUS) + call MAPL_ReadForcing(MAPL,'LNFM',LNFMFILE,CURRENT_TIME,lnfm,ON_TILES=.true.,RC=STATUS) + VERIFY_(STATUS) + endif + + if(ntiles > 0) then ! gkw: skip threads with no land tiles + +! gkw: assign new vegetation types and fractions +! ---------------------------------------------- + cat_id = nint(tile_id) ! gkw: temporary for debugging + +! compute daylength (and daylength factor) +! ---------------------------------------- + + ! current daylight duration + call MAPL_SunGetDaylightDuration(ORBIT,lats,dayl,currTime=CURRENT_TIME,RC=STATUS) + VERIFY_(STATUS) + ! maximum daylight duration (at solstice) + call MAPL_SunGetDaylightDurationMax(ORBIT,lats,dayl_fac,currTime=CURRENT_TIME,RC=STATUS) + VERIFY_(STATUS) + ! dayl_fac is ratio current:maximum dayl squared (min 0.01 [gkw: from CLM4]) + dayl_fac = min(1.,max(0.01,(dayl/dayl_fac)**2)) + +! gkw: obtain catchment area fractions and soil moisture +! ------------------------------------------------------ + call catch_calc_soil_moist( ntiles, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & + srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc, & + SWSRF1OUT=SWSRF1, SWSRF2OUT=SWSRF2, SWSRF4OUT=SWSRF4 ) + + + +! obtain saturated canopy resistance following Farquhar, CLM4 implementation + +! compute RC & PSN in each of the CN zones +! ---------------------------------------- + +! "btran" in the catchment zones; map into CN zones +! ------------------------------------------------- + sm(n,fsat) = 1.0 + +! gkw: bt2 is unstressed region only (subtract saturated and wilting areas) + do n = 1,ntiles + if(car2(n) > 0.) then + sm(n,ftrn)=(rzmc(n)/poros(n) - car1(n) - car4(n)*wpwet(n))/car2(n) + else + sm(n,ftrn)= rzmc(n)/poros(n) + endif + sm(n,ftrn) = max(sm(n,ftrn),wpwet(n)) + sm(n,ftrn) = min(sm(n,ftrn),1.) + + if(car4(n) > 0.) then + sm(n,fwlt)=(rzmc(n)/poros(n) - car1(n) - car2(n)*sm(n,ftrn))/car4(n) + else + sm(n,fwlt)= wpwet(n) + endif + sm(n,fwlt) = max(sm(n,fwlt),1.e-3) + sm(n,fwlt) = min(sm(n,fwlt),wpwet(n)-1.e-7) + end do + + do n = 1,ntiles + + ax1 = car1(n) + ax2 = car2(n) + ax4 = 1. - ax1 - ax2 + + cn1 = wtzone(n,1) + cn2 = wtzone(n,2) + cn3 = wtzone(n,3) + +! CN zone 1 + if(ax1 .gt. cn1) then + f1(1) = cn1 ; f2(1) = 0. ; f4(1) = 0. + else + if((ax1+ax2) .gt. cn1) then + f1(1) = ax1 ; f2(1) = cn1-ax1 ; f4(1) = 0. + else + f1(1) = ax1 ; f2(1) = ax2 ; f4(1) = cn1-ax1-ax2 + endif + endif + +! CN zone 2 + if(ax1 .gt. cn1) then + cn12 = cn1 + cn2 + if(car1(n) .gt. cn12) then + f1(2) = cn2 ; f2(2) = 0. ; f4(2) = 0. + else + if((ax1+ax2) .lt. cn12) then + f1(2) = ax1-cn1 ; f2(2) = ax2 ; f4(2) = cn12-ax1-ax2 + else + f1(2) = ax1-cn1 ; f2(2) = cn12-ax1 ; f4(2) = 0. + endif + endif + else + cn23 = cn2 + cn3 + if(ax4 .gt. cn23) then + f1(2) = 0. ; f2(2) = 0. ; f4(2) = cn2 + else + if(ax4 .lt. cn3) then + f1(2) = 0. ; f2(2) = cn2 ; f4(2) = 0. + else + f1(2) = 0. ; f2(2) = cn23-ax4 ; f4(2) = ax4-cn3 + endif + endif + endif + +! CN zone 3 + if(ax4 .gt. cn3) then + f1(3) = 0. ; f2(3) = 0. ; f4(3) = cn3 + else + if((ax4+ax2) .gt. cn3) then + f1(3) = 0. ; f2(3) = cn3-ax4 ; f4(3) = ax4 + else + f1(3) = cn3-ax4-ax2 ; f2(3) = ax2 ; f4(3) = ax4 + endif + endif + + do nz = 1,nzone + tgw(n,nz) = (f1(nz)*tg(n,fsat) + f2(nz)*tg(n,ftrn) + f4(nz)*tg(n,fwlt))/wtzone(n,nz) + tcx(n,nz) = (f1(nz)*tc(n,fsat) + f2(nz)*tc(n,ftrn) + f4(nz)*tc(n,fwlt))/wtzone(n,nz) + qcx(n,nz) = (f1(nz)*qc(n,fsat) + f2(nz)*qc(n,ftrn) + f4(nz)*qc(n,fwlt))/wtzone(n,nz) + rzm(n,nz) = (f1(nz)*sm(n,fsat) + f2(nz)*sm(n,ftrn) + f4(nz)*sm(n,fwlt))/wtzone(n,nz) + sfm(n,nz) = (f1(nz)*SWSRF1(n) + f2(nz)*SWSRF2(n) + f4(nz)*SWSRF4(n) )/wtzone(n,nz) + end do + + end do !n + +! soil temperature and hydrologic state +! ------------------------------------- + DO N=1,ntiles + +! soil temperatures +! ----------------- + + ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTMP) + ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) + HT(:)=GHTCNT(:,N) + CALL GNDTMP(poros(n),-1.*zbar,ht,frice,tp,soilice) ! note minus sign for zbar + + ! At the CatchCNGridComp level, tp1, tp2, .., tp6 are export variables in units of Kelvin, + ! - rreichle & borescan, 6 Nov 2020 + + tp1(n) = tp(1) + Tzero + tp2(n) = tp(2) + Tzero + tp3(n) = tp(3) + Tzero + tp4(n) = tp(4) + Tzero + tp5(n) = tp(5) + Tzero + tp6(n) = tp(6) + Tzero + +! total soil liquid water +! ----------------------- + totwat(n) = cdcr2(n) - catdef(n) + rzexc(n) + srfexc(n) + totwat(n) = totwat(n)*(1. - frice) + +! baseflow +! -------- + bflow(n) = (1.-frice)*1000.* & + cond(n)*exp(-(bf3(n)-ashift)-gnu(n)*zbar)/gnu(n) + IF(catdef(n) >= cdcr1(n)) bflow(n) = 0. + bflow(n) = min(cond(n),bflow(n)) + end do + +! compute accumulated fields, fzeng +! following the methods in accFldsMod.F90 and accumulMod.F90 in CLM4.5 +! -------------------------------------------------------------------- + + istep = istep + 1 + + ! running mean - reset accumulation period until greater than nstep + ! fzeng & gkw: may not be exactly 2m, but it is consistent with t_ref2m in CN model + ! T2M10D (T10 in CLM4.5): 10-day running mean of 2-m temperature (K) + ! TPREC10D (PREC10 in CLM4.5): 10-day running mean of total precipitation (mm H2O/s) + ! TPREC60D (PREC60 in CLM4.5): 60-day running mean of total precipitation (mm H2O/s) + ! --------------------------------------------------------------------------------- + if(init_accum) then + + ! (1) 10-day running mean of 2-m temperature (K) and total precipitation (mm H2O/s) + accper = min(istep,n10d) + T2M10D = ((accper-1)*T2M10D + TA) / accper + TPREC10D = ((accper-1)*TPREC10D + PCU + PLS + SNO) / accper + + ! (2) 60-day running mean of total precipitation (mm H2O/s) + accper = min(istep,n60d) + TPREC60D = ((accper-1)*TPREC60D + PCU + PLS + SNO) / accper + + else + + T2M10D = ((n10d-1)*T2M10D + TA) / n10d + TPREC10D = ((n10d-1)*TPREC10D + PCU + PLS + SNO) / n10d + TPREC60D = ((n60d-1)*TPREC60D + PCU + PLS + SNO) / n60d + + endif + +! get CO2 +! ------- + + if(ATM_CO2 == 3) CO2 = GETCO2(AGCM_YY,dofyr) + + CO2V (:) = CO2 + +! use CO2SC from GOCART/CO2 +! ------------------------- + + IF (ATM_CO2 == 4) THEN + + where ((CO2SC >= 0.) .and. (CO2SC <= 1000.)) + CO2V = CO2SC * 1e-6 + end where + + endif + + IF(ATM_CO2 == 1) co2g = 1. ! DO NOT SCALE USE CT CLIMATOLOGY + + CALC_CTCO2_SF: IF(ATM_CO2 == 2) THEN + + ! Compute scale factor to scale CarbonTracker CO2 monthly mean diurnal cycle (3-hourly) + CO2_YEAR = AGCM_YY + IF(CO2_YEAR_IN > 0) CO2_YEAR = CO2_YEAR_IN + + ! update EEA global average CO2 and co2 scalar at the beginning of each year, fz, 26 Sep 2016 + ! ------------------------------------------------------------------------------------------- + + IF (AGCM_YY /= CO2_YEAR) CO2_YEAR = CO2_YEAR + AGCM_YY - FIRST_YY + + if (CO2_YEAR < byr_co2g) then + co2g = co2g_byr + elseif ((CO2_YEAR >= byr_co2g).AND.(CO2_YEAR <= myr_co2g)) then + co2g = co2g_byr + dco2g_1 * (CO2_YEAR - byr_co2g) + else + co2g = co2g_myr + dco2g_2 * (CO2_YEAR - myr_co2g) + endif + + co2g = co2g / CTco2g ! = co2g/CTco2g, is used to scale CarbonTracker CO2 monthly mean diurnal cycle (3-hourly) + + ENDIF CALC_CTCO2_SF + + USE_CT_CO2: IF((ATM_CO2 == 1).OR.(ATM_CO2 == 2)) THEN + + IF(AGCM_DD < 16) THEN + + ! interpolate between AGCM_MM - 1 and AGCM_MM + + M1 = AGCM_MM -1 + Y1 = AGCM_YY + if(M1 == 0) then ; M1 = 12 ; Y1 = AGCM_YY -1 ; endif + + call ESMF_TimeSet(BEFORE, YY = Y1, MM = M1, DD = 16, & + H = 0, M = 0, S = 0, rc = STATUS) ; VERIFY_(STATUS) + call ESMF_TimeSet(AFTER , YY = AGCM_YY, MM = AGCM_MM, DD = 15, & + H = 23, M = 59, S = 59, rc = STATUS); VERIFY_(STATUS) + + call MAPL_Interp_Fac (CURRENT_TIME,BEFORE,AFTER,FAC,RC=STATUS ) ; VERIFY_(STATUS) + ASSERT_(FAC >= 0.0) + ASSERT_(FAC <= 1.0) + + DO N = 1,NTILES + CO2V (N) = (FAC * CT_CO2V (CT_TID (N),M1, AGCM_HH/3+1) + (1.0-FAC) * CT_CO2V (CT_TID (N),AGCM_MM, AGCM_HH/3+1)) * & + CO2G * 1.e-6 ! scale by EEA global average CO2 * convert from ppm + END DO + ELSE + + ! interpolate between AGCM_MM and AGCM_MM + 1 + + M1 = AGCM_MM +1 + Y1 = AGCM_YY + if(M1 == 13) then ; M1 = 1 ; Y1 = AGCM_YY +1 ; endif + + call ESMF_TimeSet(BEFORE , YY = AGCM_YY, MM = AGCM_MM, DD = 16, & + H = 0, M = 0, S = 0, rc = STATUS) ; VERIFY_(STATUS) + call ESMF_TimeSet(AFTER, YY = Y1, MM = M1, DD = 15, & + H = 23, M = 59, S = 59, rc = STATUS) ; VERIFY_(STATUS) + + call MAPL_Interp_Fac (CURRENT_TIME,BEFORE,AFTER,FAC,RC=STATUS ) ; VERIFY_(STATUS) + ASSERT_(FAC >= 0.0) + ASSERT_(FAC <= 1.0) + DO N = 1,NTILES + CO2V (N) = (FAC * CT_CO2V (CT_TID (N),AGCM_MM, AGCM_HH/3+1) + (1.0-FAC) * CT_CO2V (CT_TID (N),M1 , AGCM_HH/3+1)) * & + CO2G * 1.e-6 ! scale by EEA global average CO2 * convert from ppm + END DO + ENDIF + + ENDIF USE_CT_CO2 + + if(associated(BTRANT)) btrant = 0. + +! fraction of foliage that is wet gkw 20140327 +! ------------------------------- + do n = 1,ntiles + if(lai(n) > 1.e-4) then + fwet(n) = min(1.,max(0.,capac(n)/(0.2*lai(n)))) + else + fwet(n) = 0. + endif + end do + +! compute snow-free albedo for each PFT in each zone gkw: assume the snow albedo is not very important +! -------------------------------------------------- + do nz = 1,nzone + do nv = 1,nveg + ityp_tmp(:) = map_cat(ityp(:,nv,nz)) + +! fzeng: note that this is not exactly the same as calling sibalb_vis in the unified model because the +! "if(fveg(i)>1.e-4 .and. zth(i)>0.01)" branch in subroutine sibalb_vis is absent in the current subroutine sibalb. +! ----------------------------------------------------------------------------------------------------------------- + + call SIBALB(ntiles, ityp_tmp, elai(:,nv,nz), GRN, ZTH, & + BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo + ALBVR, ALBNR, ALBVF, ALBNF, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles + + call SNOW_ALBEDO(ntiles, N_snow, N_CONST_LAND4SNWALB, ityp_tmp, & + elai(:,nv,nz), ZTH, & + RHOFS, & + SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & + WESNN, HTSNNN, SNDZN, & + ALBVR, ALBNR, ALBVF, ALBNF, & ! instantaneous snow-free albedos on tiles + SNOVR, SNONR, SNOVF, SNONF, & ! instantaneous snow albedos on tiles + RCONSTIT, UUU, TPSN1OUT1, DRPAR, DFPAR) + +! fsnow: pft-level; asnow: grid-level +! ----------------------------------- + where(tlai(:,nv,z) > 0.) + fsnow(:) = 1. - elai(:,nv,nz)/tlai(:,nv,nz) + fsnow(:) = min(max(fsnow(:),0.),1.) + elsewhere + fsnow(:) = 0. + endwhere + + ! visible + albdir(:,nv,nz,1) = albvr(:)*(1.-fsnow(:)) + snovr(:)*fsnow(:) + albdif(:,nv,nz,1) = albvf(:)*(1.-fsnow(:)) + snovf(:)*fsnow(:) + + ! NIR + albdir(:,nv,nz,2) = albnr(:)*(1.-fsnow(:)) + snonr(:)*fsnow(:) + albdif(:,nv,nz,2) = albnf(:)*(1.-fsnow(:)) + snonf(:)*fsnow(:) + + end do ! nv + end do ! nz + + call catchcn_calc_rc(ntiles,fveg,TCx,QAx,PS,co2v,dayl_fac, & + T2M10D,TA,cond,psis,wet3,bee,capac,fwet,ZTH,ityp,& + DRPAR,DFPAR,albdir,albdif,dtc,dea,rc00,rcdq,rcdt,& + laisun,laisha,psnsun,psnsha,lmrsun,lmrsha,parzone,& + btran) + + para(:) = 0. ! zero out absorbed PAR summing array + do nz = 1,nzone + do nv = 1,nveg + para(:) = para(:) + parzone(:,nv,nz)*wtzone(:,nz)*fveg(:,nv,nz) + if(associated(BTRANT)) then + btrant(:) = btrant(:) + btran(:,nv,nz)*fveg(:,nv,nz)*wtzone(:,nz) + end if + end do + end do + + NTCurrent = CEILING (real (dofyr) / 8.) + + if(associated(CNCO2)) CNCO2 = CO2V * 1e6 + deallocate (co2v) + + if(associated(PARABS)) parabs = para + if(associated(PARINC)) parinc = drpar + dfpar + + ! -------------------------------------------------------------------------- + ! Update raditation exports + ! -------------------------------------------------------------------------- + + allocate ( ALBVR_tmp(ntiles) ) + allocate ( ALBNR_tmp(ntiles) ) + allocate ( ALBVF_tmp(ntiles) ) + allocate ( ALBNF_tmp(ntiles) ) + allocate ( SNOVR_tmp(ntiles) ) + allocate ( SNONR_tmp(ntiles) ) + allocate ( SNOVF_tmp(ntiles) ) + allocate ( SNONF_tmp(ntiles) ) + + call SIBALB(NTILES, VEG1,LAI1,GRN, ZTH, & + BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo + ALBVR, ALBNR, ALBVF, ALBNF, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles + + + call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSNNN(1,:), WESNN(1,:), TPSN1OUT1, FICE1) + TPSN1OUT1 = TPSN1OUT1 + Tzero + + call SNOW_ALBEDO(NTILES,N_snow, N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & + RHOFS, & + SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & + WESNN, HTSNNN, SNDZN, & + ALBVR, ALBNR, ALBVF, ALBNF, & ! instantaneous snow-free albedos on tiles + SNOVR, SNONR, SNOVF, SNONF, & ! instantaneous snow albedos on tiles + RCONSTIT, UUU, TPSN1OUT1, DRPAR, DFPAR) + + call SIBALB(NTILES, VEG2,LAI2,GRN, ZTH, & + BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo + ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles + + call SNOW_ALBEDO(NTILES,N_snow, N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & + RHOFS, & + SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & + WESNN, HTSNNN, SNDZN, & + ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp, & ! instantaneous snow-free albedos on tiles + SNOVR_tmp, SNONR_tmp, SNOVF_tmp, SNONF_tmp, & ! instantaneous snow albedos on tiles + RCONSTIT, UUU, TPSN1OUT1, DRPAR, DFPAR ) + + ALBVR(:) = ALBVR(:)*fveg1(:) + ALBVR_tmp(:)*fveg2(:) + ALBNR(:) = ALBNR(:)*fveg1(:) + ALBNR_tmp(:)*fveg2(:) + ALBVF(:) = ALBVF(:)*fveg1(:) + ALBVF_tmp(:)*fveg2(:) + ALBNF(:) = ALBNF(:)*fveg1(:) + ALBNF_tmp(:)*fveg2(:) + + SNOVR(:) = SNOVR(:)*fveg1(:) + SNOVR_tmp(:)*fveg2(:) + SNONR(:) = SNONR(:)*fveg1(:) + SNONR_tmp(:)*fveg2(:) + SNOVF(:) = SNOVF(:)*fveg1(:) + SNOVF_tmp(:)*fveg2(:) + SNONF(:) = SNONF(:)*fveg1(:) + SNONF_tmp(:)*fveg2(:) + + ! -------------------------------------------------------------------------- + ! albedo/swnet partitioning + ! -------------------------------------------------------------------------- + + VSUVR = DRPAR + DRUVR + VSUVF = DFPAR + DFUVR + + if(associated(SWDOWNLAND)) SWDOWNLAND = DRPAR + DFPAR + DRUVR + DFUVR + DRNIR + DFNIR + + SWNETFREE = (1.-ALBVR)*VSUVR + (1.-ALBVF)*VSUVF + (1.-ALBNR)*DRNIR + (1.-ALBNF)*DFNIR + SWNETSNOW = (1.-SNOVR)*VSUVR + (1.-SNOVF)*VSUVF + (1.-SNONR)*DRNIR + (1.-SNONF)*DFNIR + +! set the number of days per year when crossing year boundary or on restart gkw: use GEOS5/MAPL value +! ------------------------------------------------------------------------- + if(AGCM_YY .ne. year_prev) then + dpy = get_days_per_year(AGCM_YY) ! set the number of days for current year + year_prev = AGCM_YY + endif + +! compute relative humidity (%) used in CNFireMod +! ----------------------------------------------- + do n = 1,ntiles + Qair_sat = MAPL_EQsat(TA(n), PS(n) ) + Qair_relative(n) = QA(n) / Qair_sat * 100. + end do + + Qair_relative(:) = min(max(0., Qair_relative(:)), 100.) + + ! CN time step over 4 hours may fail; limit to 4 hours; verify that DTCN is a multiple of DT + ! ------------------------------------------------------------------------------------------ + dtcn = min(dtcn,14400.) + if(mod(dtcn,dt) /= 0) stop 'dtcn' + + ndt = get_step_size( nint(dtcn) ) ! gkw: get_step_size must be called here to set CN model time step + + ! sum over interval for CN + ! ------------------------ + + tgwm = tgwm + tgw + tpm = tpm + tp1 + sfmm = sfmm + sfm + rzmm = rzmm + rzm + bflowm = bflowm + bflow + totwatm = totwatm + totwat + + tairm = tairm + TA + rhm = rhm + Qair_relative + windm = windm + UU + rainfm = rainfm + (PCU + PLS) + snowfm = snowfm + SNO + runsrfm = runsrfm + runsrf + ar1m = ar1m + car1 + psnsunm = psnsunm + psnsun*laisun + psnsham = psnsham + psnsha*laisha + lmrsunm = lmrsunm + lmrsun*laisun + lmrsham = lmrsham + lmrsha*laisha + do n = 1,N_snow + sndzm(:) = sndzm(:) + sndzn(n,:) + end do + asnowm = asnowm + asnow + cnsum = cnsum + 1. + + ! call CN model every DTCN seconds + ! -------------------------------- + + if(mod(AGCM_S_ofday,nint(dtcn)) == 0) then + + ! fzeng: pass current date_time to the CN routines. + call upd_curr_date_time( AGCM_YY, AGCM_MM, AGCM_DD, dofyr, & + AGCM_HH, AGCM_MI, AGCM_S ) + + ! compute mean state over interval + ! -------------------------------- + do nz = 1,nzone + tgwm(:,nz) = tgwm(:,nz) / cnsum(:) + rzmm(:,nz) = rzmm(:,nz) / cnsum(:) + sfmm(:,nz) = sfmm(:,nz) / cnsum(:) + do nv = 1,nveg + psnsunm(:,nv,nz) = psnsunm(:,nv,nz) / cnsum(:) + psnsham(:,nv,nz) = psnsham(:,nv,nz) / cnsum(:) + lmrsunm(:,nv,nz) = lmrsunm(:,nv,nz) / cnsum(:) + lmrsham(:,nv,nz) = lmrsham(:,nv,nz) / cnsum(:) + end do + end do + tpm = tpm / cnsum + bflowm = bflowm / cnsum + totwatm = totwatm / cnsum + tairm = tairm / cnsum + rhm = rhm / cnsum + windm = windm / cnsum + rainfm = rainfm / cnsum + snowfm = snowfm / cnsum + runsrfm = runsrfm / cnsum + ar1m = ar1m / cnsum + sndzm = sndzm / cnsum + asnowm = asnowm / cnsum + + laisun = 1. + laisha = 1. + + lats_degree = lats / MAPL_PI * 180. + lons_degree = lons / MAPL_PI * 180. + + call CN_Driver(istep_cn,ntiles,nveg,nzone,dayl, & + tgwm,tpm,tp2,tp3,tp4,tp5,tp6,sfmm,rzmm,wpwet, & + psis,bee,poros,vgwmax,bflowm,totwatm,runsrfm, & + tairm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,T2M10D, & + psnsunm,psnsham,lmrsunm,lmrsham,laisun,laisha, & + ar1m,btran_fire_rz,btran_fire_sf,lats_degree,lons_degree, & + ityp,fveg,wtzone,sndzm,asnowm,ndep,abm,peatf,gdp,hdm,fieldcap,lnfm, & + elai,esai,tlai,totcolc,cat_id,cli_t2m, & + npp,gpp,sr,nee,frootc,padd,vegc,xsmr,burn,closs, & + nfire,som_closs,ndeploy,denit,sminn_leached,sminn,fire_nloss, & + leafn,leafc,gross_nmin,net_nmin,nfix_to_sminn,actual_immob, & + fpg,fpi,sminn_to_plant,sminn_to_npool,ndep_to_sminn,totvegn,totlitn,totsomn, & + retransn,retransn_to_npool,fuelc,totlitc,cwdc,rootc) + + + ! save scaled CN diagnostics + ! -------------------------- + if(associated(CNLAI)) then + cnlai(:) = 0. + do nz = 1,nzone + do nv = 1,nveg + cnlai(:) = cnlai(:) + elai(:,nv,nz)*fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + cnlai(:) = cnlai(:) * cnsum + endif + + if(associated(CNTLAI)) then + cntlai(:) = 0. + do nz = 1,nzone + do nv = 1,nveg + cntlai(:) = cntlai(:) + tlai(:,nv,nz)*fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + cntlai(:) = cntlai(:) * cnsum + endif + + if(associated(CNSAI)) then + cnsai(:) = 0. + do nz = 1,nzone + do nv = 1,nveg + cnsai(:) = cnsai(:) + esai(:,nv,nz)*fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + cnsai(:) = cnsai(:) * cnsum + endif + + if(associated(CNTOTC)) then + cntotc(:) = 0. + do nz = 1,nzone + cntotc(:) = cntotc(:) + 1.e-3*totcolc(:,nz)*wtzone(:,nz) + end do + cntotc(:) = cntotc(:) * cnsum + endif + + if(associated(CNFIRE_CNT )) cnfire_cnt = nfire * cnsum ! fire count (s-1) + if(associated(CNSOM_CLOSS )) cnsom_closs = 1.e-3*som_closs * cnsum ! peat fire C loss (kg/m2/s) + if(associated(CNNDEPLOY )) cnndeploy = 1.e-3*ndeploy * cnsum + if(associated(CNDENIT )) cndenit = 1.e-3*denit * cnsum + if(associated(CNSMINN_LEACHED )) cnsminn_leached = 1.e-3*sminn_leached * cnsum + if(associated(CNSMINN )) cnsminn = 1.e-3*sminn * cnsum + if(associated(CNFIRE_NLOSS )) cnfire_nloss = 1.e-3*fire_nloss * cnsum + if(associated(CNLEAFN )) cnleafn = 1.e-3*leafn * cnsum + if(associated(CNLEAFC )) cnleafc = 1.e-3*leafc * cnsum + if(associated(CNGROSS_NMIN )) cngross_nmin = 1.e-3*gross_nmin * cnsum + if(associated(CNNET_NMIN )) cnnet_nmin = 1.e-3*net_nmin * cnsum + if(associated(CNNFIX_TO_SMINN )) cnnfix_to_sminn = 1.e-3*nfix_to_sminn * cnsum + if(associated(CNACTUAL_IMMOB )) cnactual_immob = 1.e-3*actual_immob * cnsum + if(associated(CNFPG )) cnfpg = fpg * cnsum + if(associated(CNFPI )) cnfpi = fpi * cnsum + if(associated(CNSMINN_TO_PLANT )) cnsminn_to_plant = 1.e-3*sminn_to_plant * cnsum + if(associated(CNSMINN_TO_NPOOL )) cnsminn_to_npool = 1.e-3*sminn_to_npool * cnsum + if(associated(CNNDEP_TO_SMINN )) cnndep_to_sminn = 1.e-3*ndep_to_sminn * cnsum + if(associated(CNTOTVEGN )) cntotvegn = 1.e-3*totvegn * cnsum + if(associated(CNTOTLITN )) cntotlitn = 1.e-3*totlitn * cnsum + if(associated(CNTOTSOMN )) cntotsomn = 1.e-3*totsomn * cnsum + if(associated(CNRETRANSN )) cnretransn = 1.e-3*retransn * cnsum + if(associated(CNRETRANSN_TO_NPOOL)) cnretransn_to_npool = 1.e-3*retransn_to_npool * cnsum + if(associated(CNFUELC )) cnfuelc = 1.e-3*fuelc * cnsum + if(associated(CNTOTLITC )) cntotlitc = 1.e-3*totlitc * cnsum + if(associated(CNCWDC )) cncwdc = 1.e-3*cwdc * cnsum + if(associated(CNROOT )) cnroot = 1.e-3*rootc * cnsum + if(associated(CNFSEL )) cnfsel = 0. + ! reset summing arrays + ! -------------------- + tgwm = 0. + tpm = 0. + sfmm = 0. + rzmm = 0. + bflowm = 0. + totwatm = 0. + tairm = 0. + rhm = 0. + windm = 0. + rainfm = 0. + snowfm = 0. + runsrfm = 0. + ar1m = 0. + psnsunm = 0. + psnsham = 0. + lmrsunm = 0. + lmrsham = 0. + sndzm = 0. + asnowm = 0. + cnsum = 0. + + else ! CN diags set to zero + + if(associated(CNLAI )) cnlai = 0. + if(associated(CNTLAI)) cntlai = 0. + if(associated(CNSAI )) cnsai = 0. + if(associated(CNTOTC)) cntotc = 0. + if(associated(CNFIRE_CNT )) cnfire_cnt = 0. + if(associated(CNSOM_CLOSS )) cnsom_closs = 0. + if(associated(CNNDEPLOY )) cnndeploy = 0. + if(associated(CNDENIT )) cndenit = 0. + if(associated(CNSMINN_LEACHED )) cnsminn_leached = 0. + if(associated(CNSMINN )) cnsminn = 0. + if(associated(CNFIRE_NLOSS )) cnfire_nloss = 0. + if(associated(CNLEAFN )) cnleafn = 0. + if(associated(CNLEAFC )) cnleafc = 0. + if(associated(CNGROSS_NMIN )) cngross_nmin = 0. + if(associated(CNNET_NMIN )) cnnet_nmin = 0. + if(associated(CNNFIX_TO_SMINN )) cnnfix_to_sminn = 0. + if(associated(CNACTUAL_IMMOB )) cnactual_immob = 0. + if(associated(CNFPG )) cnfpg = 0. + if(associated(CNFPI )) cnfpi = 0. + if(associated(CNSMINN_TO_PLANT )) cnsminn_to_plant = 0. + if(associated(CNSMINN_TO_NPOOL )) cnsminn_to_npool = 0. + if(associated(CNNDEP_TO_SMINN )) cnndep_to_sminn = 0. + if(associated(CNTOTVEGN )) cntotvegn = 0. + if(associated(CNTOTLITN )) cntotlitn = 0. + if(associated(CNTOTSOMN )) cntotsomn = 0. + if(associated(CNRETRANSN )) cnretransn = 0. + if(associated(CNRETRANSN_TO_NPOOL)) cnretransn_to_npool = 0. + if(associated(CNFUELC )) cnfuelc = 0. + if(associated(CNTOTLITC )) cntotlitc = 0. + if(associated(CNCWDC )) cncwdc = 0. + if(associated(CNROOT )) cnroot = 0. + + endif + + ! CN_Driver outputs at DTCN are saved and used to populate below exports + ! uniformly outside DTCN. + ! ----------------------------------------------------------------------- + + if(associated(CNVEGC)) cnvegc = 1.e-3*vegc ! * cnsum + if(associated(CNFROOTC)) cnfrootc = 1.e-3*frootc ! * cnsum + if(associated(CNNPP )) cnnpp = 1.e-3*npp ! * cnsum + if(associated(CNGPP )) cngpp = 1.e-3*gpp ! * cnsum + if(associated(CNSR )) cnsr = 1.e-3*sr ! * cnsum + if(associated(CNNEE )) cnnee = 1.e-3*nee ! * cnsum + if(associated(CNXSMR)) cnxsmr = 1.e-3*xsmr ! * cnsum + if(associated(CNADD )) cnadd = 1.e-3*padd ! * cnsum + if(associated(CNLOSS)) cnloss = 1.e-3*closs ! * cnsum ! total fire C loss (kg/m2/s) + if(associated(CNBURN)) cnburn = burn ! * cnsum ! area fractional fire burn rate (s-1) + + ! copy CN_restart vars to catch_internal_rst gkw: only do if stopping + ! ------------------------------------------ + if(NextTime == StopTime) then + + call CN_exit(ntiles,nveg,nzone,ityp,fveg,cncol,var_col,cnpft,var_pft) + i = 1 + do iv = 1,VAR_PFT + do nv = 1,NUM_VEG + do nz = 1, NUM_ZON + do n = 1,ntiles + ! to ensure unused array elements don't have crazy numbers in restart files. + if(fveg (n,nv,nz) == 0.) cnpft (n,i) = 0. + end do + i = i + 1 + end do + end do + end do + endif + +! update LAI for primary & secondary vegetation types +! --------------------------------------------------- + lai1 = 0. + wght = 0. + do nz = 1,nzone + do nv = 1,2 + lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + lai1 = lai1 / max(wght,1.e-8) ! LAI for primary vegetation type + + lai2 = 0. + wght = 0. + do nz = 1,nzone + do nv = 3,4 + lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + lai2 = lai2 / max(wght,1.e-8) ! LAI for secondary vegetation type + + lai = fveg1*lai1 + fveg2*lai2 ! gkw: prognostic LAI on catch_internal_rst (overwrite VEGDYN import) + LAI0 = max(0.0001 , LAI) + +! have stomatal resistance in the CN zones; map as conductance into catchment zones +! --------------------------------------------------------------------------------- + do n = 1,ntiles + + ax1 = car1(n) + ax2 = car2(n) + ax4 = 1. - ax1 - ax2 + + cn1 = wtzone(n,1) + cn2 = wtzone(n,2) + cn3 = wtzone(n,3) + +! catchment: saturated area + + if(ax1 .lt. cn1) then + f1 = ax1 ; f2 = 0. ; f3 = 0. + else + if(ax1 .lt. (cn1+cn2)) then + f1 = cn1 ; f2 = ax1-cn1 ; f3 = 0. + else + f1 = cn1 ; f2 = cn2 ; f3 = ax1-cn1-cn2 + endif + endif + + if(ax1 .gt. 0.) then + rcsat(n) = ax1/(f1/rc00(n,1)+f2/rc00(n,2)+f3/rc00(n,3)) + rcxdt(n) = ax1/(f1/rcdt(n,1)+f2/rcdt(n,2)+f3/rcdt(n,3)) + rcxdq(n) = ax1/(f1/rcdq(n,1)+f2/rcdq(n,2)+f3/rcdq(n,3)) + else + rcsat(n) = 1.e3 + rcxdt(n) = 1.e3 + rcxdq(n) = 1.e3 + endif + +! compute deriviatives + drcsdt(n) = (rcxdt(n) - rcsat(n)) / dtc + drcsdq(n) = (rcxdq(n) - rcsat(n)) / (0.622*dea/PS(n)) + +! catchment: unstressed area + + if(ax1 .lt. cn1) then + ar = ax1 + ax2 + if(ar .lt. cn1) then + f1 = ax2 ; f2 = 0. ; f3 = 0. + else + if(ar .lt. (cn1+cn2)) then + f1 = cn1-ax1 ; f2 = ar-cn1 ; f3 = 0. + else + f1 = cn1-ax1 ; f2 = cn2 ; f3 = ar-cn1-cn2 + endif + endif + else + ar = ax2 + ax4 + if(ar .lt. cn3) then + f1 = 0. ; f2 = 0. ; f3 = ax2 + else + if(ax4 .gt. cn3) then + f1 = 0. ; f2 = ax2 ; f3 = 0. + else + f1 = 0. ; f2 = ar-cn3 ; f3 = cn3-ax4 + endif + endif + endif + + if(ax2 .gt. 0.) then + rcuns(n) = ax2/(f1/rc00(n,1)+f2/rc00(n,2)+f3/rc00(n,3)) + rcxdt(n) = ax2/(f1/rcdt(n,1)+f2/rcdt(n,2)+f3/rcdt(n,3)) + rcxdq(n) = ax2/(f1/rcdq(n,1)+f2/rcdq(n,2)+f3/rcdq(n,3)) + else + rcuns(n) = 1.e3 + rcxdt(n) = 1.e3 + rcxdq(n) = 1.e3 + endif + +! compute deriviatives + drcudt(n) = (rcxdt(n) - rcuns(n)) / dtc + drcudq(n) = (rcxdq(n) - rcuns(n)) / (0.622*dea/PS(n)) + + end do + + if(associated(SCSAT )) scsat = 1. / rcsat + if(associated(SCUNS )) scuns = 1. / rcuns + + endif ! end of check for zero tiles + +! gkw: end of main CN block + + PLSIN = PLS + + ! -------------------------------------------------------------------------- + ! Call Irrigation Model + ! -------------------------------------------------------------------------- + + IF ((RUN_IRRIG /= 0).AND.(ntiles >0)) THEN + + CALL CATCH_CALC_SOIL_MOIST ( & + NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & + srfexc,rzexc,catdef, CAR1, CAR2, CAR4, sfmc, rzmc, prmc) + + call irrigation_rate (IRRIG_METHOD, & + NTILES, AGCM_HH, AGCM_MI, AGCM_S, lons, IRRIGFRAC, PADDYFRAC, & + CLMPT,CLMST, CLMPF, CLMSF, LAIMAX, LAIMIN, LAI0, & + POROS, WPWET, VGWMAX, RZMC, IRRIGRATE) + + PLSIN = PLS + IRRIGRATE + + ENDIF + +#ifdef DBG_CNLSM_INPUTS + call MAPL_Get(MAPL, LocStream=LOCSTREAM, RC=STATUS) + VERIFY_(STATUS) + call MAPL_LocStreamGet(LOCSTREAM, NT_GLOBAL=NT_GLOBAL, TILEGRID=TILEGRID, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_TileMaskGet(tilegrid, mask, rc=status) + VERIFY_(STATUS) + + if (UNIT_i == 0) then + unit_i = GETFILE( "catchcnclm45_inputs.data", form="unformatted", RC=STATUS ) + VERIFY_(STATUS) + endif + unit = unit_i + +! Inputs + + call MAPL_VarWrite(unit, tilegrid, PCU, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PLS, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SNO, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ICE, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, FRZR, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, UUU, mask=mask, rc=status); VERIFY_(STATUS) + + call MAPL_VarWrite(unit, tilegrid, EVSBT (:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DEVSBT(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DEDTC (:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SHSBT (:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DHSDQA(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DSHSBT(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, EVSBT (:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DEVSBT(:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DEDTC (:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SHSBT (:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DHSDQA(:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DSHSBT(:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, EVSBT (:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DEVSBT(:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DEDTC (:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SHSBT (:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DHSDQA(:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DSHSBT(:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, EVSBT (:,FSNW), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DEVSBT(:,FSNW), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DEDTC (:,FSNW), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SHSBT (:,FSNW), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DHSDQA(:,FSNW), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DSHSBT(:,FSNW), mask=mask, rc=status); VERIFY_(STATUS) + + call MAPL_VarWrite(unit, tilegrid, TA, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, QA, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RA(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RA(:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RA(:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RA(:,FSNW), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ZTH, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SWNETFREE, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SWNETSNOW, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, LWDNSRF, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PS*.01, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, LAI0, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, GRN0, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SQSCAT, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RSL1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RSL2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RDC, mask=mask, rc=status); VERIFY_(STATUS) + + call MAPL_VarWrite(unit, tilegrid, QSAT(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DQS(:,FSAT) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ALWN(:,1) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BLWN(:,1) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, QSAT(:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DQS(:,FTRN) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ALWN(:,2) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BLWN(:,2) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, QSAT(:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DQS(:,FWLT) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ALWN(:,3) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BLWN(:,3) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, QSAT(:,FSNW), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DQS(:,FSNW) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ALWN(:,4) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BLWN(:,4) , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RCSAT , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DRCSDT , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DRCSDQ , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RCUNS , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DRCUDT , mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DRCUDQ , mask=mask, rc=status); VERIFY_(STATUS) + +! params + if (firsttime) then + firsttime = .false. + unit = GETFILE( "catchcnclm45_params.data", form="unformatted", RC=STATUS ) + VERIFY_(STATUS) + + call WRITE_PARALLEL(NT_GLOBAL, UNIT) + call WRITE_PARALLEL(DT, UNIT) + call WRITE_PARALLEL(USE_FWET_FOR_RUNOFF, UNIT) + call MAPL_VarWrite(unit, tilegrid, LONS, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, LATS, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, VEG1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, VEG2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, FVEG1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, FVEG2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, DZSF, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BF1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BF2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BF3, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, VGWMAX,mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, CDCR1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, CDCR2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, PSIS, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BEE, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, POROS, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, WPWET, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, COND, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, GNU, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARS1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARS2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARS3, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARA1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARA2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARA3, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARA4, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARW1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARW2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARW3, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ARW4, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TSA1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TSA2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TSB1, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TSB2, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, ATAU, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, BTAU, mask=mask, rc=status); VERIFY_(STATUS) + + call FREE_FILE(unit, RC=STATUS) + VERIFY_(STATUS) + +! Updates + unit = GETFILE( "catchcnclm45_updates.data", form="unformatted", RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_VarWrite(unit, tilegrid, TG(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TG(:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TG(:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TC(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TC(:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, TC(:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, QC(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, QC(:,FTRN), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, QC(:,FWLT), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, CAPAC, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, CATDEF, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, RZEXC, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SRFEXC, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, GHTCNT(1,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, GHTCNT(2,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, GHTCNT(3,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, GHTCNT(4,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, GHTCNT(5,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, GHTCNT(6,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, WESNN(1,:), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, WESNN(2,:), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, WESNN(3,:), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, HTSNNN(1,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, HTSNNN(2,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, HTSNNN(3,:),mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SNDZN(1,:), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SNDZN(2,:), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, SNDZN(3,:), mask=mask, rc=status); VERIFY_(STATUS) + + call FREE_FILE(unit, RC=STATUS) + VERIFY_(STATUS) + + end if + DEALLOC_(mask) +#endif + +! call unified land model +! ----------------------- + if (ntiles > 0) then + + call CATCHCN ( NTILES, LONS, LATS, DT,USE_FWET_FOR_RUNOFF, & + FWETC, FWETL, cat_id, VEG1,VEG2,FVEG1,FVEG2,DZSF ,& + PCU , PLSIN , SNO, ICE, FRZR ,& + UUU ,& + + EVSBT(:,FSAT), DEVSBT(:,FSAT), DEDTC(:,FSAT) ,& + SHSBT(:,FSAT), DHSDQA(:,FSAT), DSHSBT(:,FSAT),& + EVSBT(:,FTRN), DEVSBT(:,FTRN), DEDTC(:,FTRN) ,& + SHSBT(:,FTRN), DHSDQA(:,FTRN), DSHSBT(:,FTRN),& + EVSBT(:,FWLT), DEVSBT(:,FWLT), DEDTC(:,FWLT) ,& + SHSBT(:,FWLT), DHSDQA(:,FWLT), DSHSBT(:,FWLT),& + EVSBT(:,FSNW), DEVSBT(:,FSNW), DEDTC(:,FSNW) ,& + SHSBT(:,FSNW), DHSDQA(:,FSNW), DSHSBT(:,FSNW),& + + TA , QA ,& + + RA(:,FSAT), RA(:,FTRN), RA(:,FWLT), RA(:,FSNW) ,& + + ZTH, SWNETFREE, SWNETSNOW, LWDNSRF ,& + + PS*.01 ,& + + LAI0, GRN0, SQSCAT, RSL1, RSL2, RDC ,& + + QSAT(:,FSAT) , DQS(:,FSAT) , ALWN(:,1), BLWN(:,1) ,& + QSAT(:,FTRN) , DQS(:,FTRN) , ALWN(:,2), BLWN(:,2) ,& + QSAT(:,FWLT) , DQS(:,FWLT) , ALWN(:,3), BLWN(:,3) ,& + QSAT(:,FSNW) , DQS(:,FSNW) , ALWN(:,4), BLWN(:,4) ,& + + RCSAT,DRCSDT,DRCSDQ, RCUNS,DRCUDT,DRCUDQ, & + BF1, BF2, BF3, VGWMAX, CDCR1, CDCR2, PSIS ,& + BEE, POROS, WPWET, COND, GNU ,& + ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4 ,& + ARW1, ARW2, ARW3, ARW4, TSA1, TSA2, TSB1, TSB2 ,& + ATAU, BTAU, .false. ,& + + TG(:,FSAT), TG(:,FTRN), TG(:,FWLT) ,& + TC(:,FSAT), TC(:,FTRN), TC(:,FWLT) ,& + QC(:,FSAT), QC(:,FTRN), QC(:,FWLT) ,& + + CAPAC, CATDEF, RZEXC, SRFEXC, GHTCNT ,& + WESNN, HTSNNN, SNDZN ,& + + EVAPOUT, SHOUT, RUNOFF, EVPINT, EVPSOI, EVPVEG ,& + EVPICE ,& + BFLOW ,& + RUNSURF ,& + SMELT ,& + HLWUP ,& + SWNDSRF ,& + HLATN ,& + QINFIL ,& + AR1 ,& + AR2 ,& + RZEQ ,& + GHFLX ,& + GHFLXSNO ,& + GHFLXTSKIN ,& + TC(:,FSNW) ,& + ASNOW ,& + TP1, TP2, TP3, TP4, TP5, TP6, SFMC, RZMC, PRMC ,& + ENTOT,WTOT, WCHANGE, ECHANGE, HSNACC, EVACC, SHACC ,& + TSURF ,& + SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 ,& + LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW ,& + TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE ,& + TC1_0=TC1_0, TC2_0=TC2_0, TC4_0=TC4_0 ,& + QA1_0=QA1_0, QA2_0=QA2_0, QA4_0=QA4_0 ,& + RCONSTIT=RCONSTIT, RMELT=RMELT, TOTDEPOS=TOTDEPOS, LHACC=LHACC) + + ! Change units of TP1, TP2, .., TP6 export variables from Celsius to Kelvin. + ! This used to be done at the level the Surface GridComp. + ! With this change, gridded TSOIL[n] exports from Surface and tile-space TP[n] exports + ! from Catch are now consistently in units of Kelvin. + ! - rreichle, borescan, 6 Nov 2020 + + TP1 = TP1 + MAPL_TICE + TP2 = TP2 + MAPL_TICE + TP3 = TP3 + MAPL_TICE + TP4 = TP4 + MAPL_TICE + TP5 = TP5 + MAPL_TICE + TP6 = TP6 + MAPL_TICE + + + runsrf = RUNSURF ! for N leaching, fzeng + + end if + + if (OFFLINE_MODE /=0) then + TC(:,FSAT) = TC1_0 + TC(:,FTRN) = TC2_0 + TC(:,FWLT) = TC4_0 + QC(:,FSAT) = QA1_0 + QC(:,FTRN) = QA2_0 + QC(:,FWLT) = QA4_0 + EVACC = 0.0 + SHACC = 0.0 + endif + + QC(:,FSNW) = GEOS_QSAT ( TC(:,FSNW), PS, PASCALS=.true., RAMP=0.0 ) + + ! -------------------------------------------------------------------------- + ! update subtile fractions + ! -------------------------------------------------------------------------- + + EMIS = fveg1*(EMSVEG(VEG1) + (EMSBARESOIL - EMSVEG(VEG1))*exp(-LAI1)) + & + fveg2*(EMSVEG(VEG2) + (EMSBARESOIL - EMSVEG(VEG2))*exp(-LAI2)) + + EMIS = EMIS *(1.-ASNOW) + EMSSNO *ASNOW + + call MAPL_SunGetInsolation(LONS, LATS, & + ORBIT, ZTH, SLR, & + INTV = TINT, & + currTime=CURRENT_TIME+DELT, & + RC=STATUS ) + VERIFY_(STATUS) + + ZTH = max(0.0,ZTH) + + ! -------------------------------------------------------------------------- + ! Update raditation exports + ! -------------------------------------------------------------------------- + + call MAPL_TimerOn(MAPL,"-ALBEDO") + if(ntiles > 0) then + call SIBALB(NTILES, VEG1,LAI1,GRN, ZTH, & + BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo + ALBVR, ALBNR, ALBVF, ALBNF, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles + + call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSNNN(1,:), WESNN(1,:), TPSN1OUT1, FICE1) + TPSN1OUT1 = TPSN1OUT1 + Tzero + + call SNOW_ALBEDO(NTILES,N_snow, N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & + RHOFS, & + SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & + WESNN, HTSNNN, SNDZN, & + ALBVR, ALBNR, ALBVF, ALBNF, & ! instantaneous snow-free albedos on tiles + SNOVR, SNONR, SNOVF, SNONF, & ! instantaneous snow albedos on tiles + RCONSTIT, UUU, TPSN1OUT1,DRPAR, DFPAR) + + call SIBALB(NTILES, VEG2,LAI2,GRN, ZTH, & + BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo + ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles + + + call SNOW_ALBEDO(NTILES,N_snow, N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & + RHOFS, & + SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & + WESNN, HTSNNN, SNDZN, & + ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp, & ! instantaneous snow-free albedos on tiles + SNOVR_tmp, SNONR_tmp, SNOVF_tmp, SNONF_tmp, & ! instantaneous snow albedos on tiles + RCONSTIT, UUU, TPSN1OUT1,DRPAR, DFPAR ) + + ALBVR(:) = ALBVR(:)*fveg1(:) + ALBVR_tmp(:)*fveg2(:) + ALBNR(:) = ALBNR(:)*fveg1(:) + ALBNR_tmp(:)*fveg2(:) + ALBVF(:) = ALBVF(:)*fveg1(:) + ALBVF_tmp(:)*fveg2(:) + ALBNF(:) = ALBNF(:)*fveg1(:) + ALBNF_tmp(:)*fveg2(:) + + SNOVR(:) = SNOVR(:)*fveg1(:) + SNOVR_tmp(:)*fveg2(:) + SNONR(:) = SNONR(:)*fveg1(:) + SNONR_tmp(:)*fveg2(:) + SNOVF(:) = SNOVF(:)*fveg1(:) + SNOVF_tmp(:)*fveg2(:) + SNONF(:) = SNONF(:)*fveg1(:) + SNONF_tmp(:)*fveg2(:) + + ALBVR = ALBVR *(1.-ASNOW) + SNOVR *ASNOW + ALBVF = ALBVF *(1.-ASNOW) + SNOVF *ASNOW + ALBNR = ALBNR *(1.-ASNOW) + SNONR *ASNOW + ALBNF = ALBNF *(1.-ASNOW) + SNONF *ASNOW + endif + call MAPL_TimerOff(MAPL,"-ALBEDO") + + LWNDSRF = LWDNSRF - HLWUP + + ! -------------------------------------------------------------------------- + ! update outputs + ! -------------------------------------------------------------------------- + + DELTS = 0.0 + DELQS = 0.0 + + do N=1,NUM_SUBTILES + DELTS = DELTS + CFT(:,N)*(TC(:,N)-TCO(:,N))*FR(:,N) + DELQS = DELQS + CFQ(:,N)*(QC(:,N)-QCO(:,N))*FR(:,N) + end do + + FR(:,FSAT) = AR1 * (1-ASNOW) + FR(:,FTRN) = AR2 * (1-ASNOW) + FR(:,FWLT) = (1.0-(AR1+AR2))* (1-ASNOW) + FR(:,FSNW) = ASNOW + + FR = min( max( fr,0.0 ), 1.0 ) + + TST = 0.0 + QST = 0.0 + do N=1,NUM_SUBTILES + TST = TST + TC(:,N) *FR(:,N) + QST = QST + QC(:,N) *FR(:,N) + end do + + if ( OFFLINE_MODE ==0 ) then +!amm add correction term to latent heat diagnostics (HLATN is always allocated) +! this will impact the export LHLAND + HLATN = HLATN - LHACC +! also add some portion of the correction term to evap from soil, int, veg and snow + SUMEV = EVPICE+EVPSOI+EVPVEG+EVPINT + where(SUMEV>0.) + EVPICE = EVPICE - EVACC*EVPICE/SUMEV + EVPSOI = EVPSOI - EVACC*EVPSOI/SUMEV + EVPINT = EVPINT - EVACC*EVPINT/SUMEV + EVPVEG = EVPVEG - EVACC*EVPVEG/SUMEV + endwhere + endif + + if(associated( LST )) LST = TST + if(associated( TPSURF))TPSURF = TSURF + if(associated( WET1 )) WET1 = max(min(SFMC / POROS,1.0),0.0) + if(associated( WET2 )) WET2 = max(min(RZMC / POROS,1.0),0.0) + if(associated( WET3 )) WET3 = max(min(PRMC / POROS,1.0),0.0) + if(associated( WCSF )) WCSF = SFMC + if(associated( WCRZ )) WCRZ = RZMC + if(associated( WCPR )) WCPR = PRMC + + if(associated( ACCUM)) ACCUM = SLDTOT - EVPICE*(1./MAPL_ALHS) - SMELT + + if(associated(EVPSNO)) EVPSNO = EVPICE + if(associated(SUBLIM)) SUBLIM = EVPICE*(1./MAPL_ALHS)*FR(:,FSNW) + if(associated(EVLAND)) EVLAND = EVAPOUT-EVACC + if(associated(PRLAND)) PRLAND = PCU+PLS+SLDTOT + if(associated(SNOLAND)) SNOLAND = SLDTOT + if(associated(DRPARLAND)) DRPARLAND = DRPAR + if(associated(DFPARLAND)) DFPARLAND = DFPAR + if(associated(LHLAND)) LHLAND = HLATN + if(associated(SHLAND)) SHLAND = SHOUT-SHACC + if(associated(SWLAND)) SWLAND = SWNDSRF + if(associated(LWLAND)) LWLAND = LWNDSRF + if(associated(GHLAND)) GHLAND = GHFLX + if(associated(GHSNOW)) GHSNOW = GHFLXSNO + if(associated(SHSNOW)) SHSNOW = SHSNOW1 + if(associated(AVETSNOW)) AVETSNOW = AVETSNOW1 + if(associated(WAT10CM)) WAT10CM = WAT10CM1 + if(associated(WATSOI)) WATSOI = WATSOI1 + if(associated(ICESOI)) ICESOI = ICESOI1 + if(associated(LHSNOW)) LHSNOW = LHSNOW1 + if(associated(LWUPSNOW)) LWUPSNOW = LWUPSNOW1 + if(associated(LWDNSNOW)) LWDNSNOW = LWDNSNOW1 + if(associated(SWNETSNOW1)) SWNETSNOW1 = NETSWSNOW + if(associated(TCSORIG)) TCSORIG = TCSORIG1 + if(associated(TPSN1IN)) TPSN1IN = TPSN1IN1 + if(associated(TPSN1OUT)) TPSN1OUT = TPSN1OUT1 + if(associated(GHTSKIN))GHTSKIN = GHFLXTSKIN + if(associated(SMLAND)) SMLAND = SMELT + if(associated(TWLAND)) TWLAND = WTOT + if(associated(TELAND)) TELAND = ENTOT + if(associated(TSLAND)) TSLAND = WESNN (1,:) + WESNN (2,:) + WESNN (3,:) + if(associated(DWLAND)) DWLAND = WCHANGE + if(associated(DHLAND)) DHLAND = ECHANGE + if(associated(SPLAND)) SPLAND = SHACC + if(associated(SPWATR)) SPWATR = EVACC + if(associated(SPSNOW)) SPSNOW = HSNACC + + if(associated(FRSAT )) FRSAT = max( min( FR(:,FSAT),1.0 ), 0.0 ) + if(associated(FRUST )) FRUST = max( min( FR(:,FTRN),1.0 ), 0.0 ) + if(associated(FRWLT )) FRWLT = max( min( FR(:,FWLT),1.0 ), 0.0 ) + + if(associated(SNOMAS)) SNOMAS = WESNN (1,:) + WESNN (2,:) + WESNN (3,:) + if(associated(SNOWDP)) SNOWDP = SNDZN (1,:) + SNDZN (2,:) + SNDZN (3,:) + + if(associated(RMELTDU001)) RMELTDU001 = RMELT(:,1) + if(associated(RMELTDU002)) RMELTDU002 = RMELT(:,2) + if(associated(RMELTDU003)) RMELTDU003 = RMELT(:,3) + if(associated(RMELTDU004)) RMELTDU004 = RMELT(:,4) + if(associated(RMELTDU005)) RMELTDU005 = RMELT(:,5) + if(associated(RMELTBC001)) RMELTBC001 = RMELT(:,6) + if(associated(RMELTBC002)) RMELTBC002 = RMELT(:,7) + if(associated(RMELTOC001)) RMELTOC001 = RMELT(:,8) + if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) + if(associated(FSWCHANGE)) FSWCHANGE = FSW_CHANGE + if(associated(WATERTABLED)) then + WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) + endif + + if(associated(TPSN1OUT)) then + where(WESNN(1,:)>0.) + TPSN1OUT = TPSN1OUT1 + elsewhere + TPSN1OUT = MAPL_UNDEF + end where + end if + + if(associated(TPSN1)) then + where(WESNN(1,:)>0.) + TPSN1 = TC(:,FSNW) + elsewhere + TPSN1 = MAPL_UNDEF + end where + end if + + if(associated(TPSAT)) then + where(FR(:,FSAT)>0.) + TPSAT = TC(:,FSAT) + elsewhere + TPSAT = MAPL_UNDEF + end where + end if + + if(associated(TPWLT)) then + where(FR(:,FWLT)>0.) + TPWLT = TC(:,FWLT) + elsewhere + TPWLT = MAPL_UNDEF + end where + end if + + if(associated(TPUST)) then + where(FR(:,FTRN)>0.) + TPUST = TC(:,FTRN) + elsewhere + TPUST = MAPL_UNDEF + end where + end if + + + ! -------------------------------------------------------------------------- + ! update internal state arrays + ! -------------------------------------------------------------------------- + + GHTCNT1 = GHTCNT(1,:) + GHTCNT2 = GHTCNT(2,:) + GHTCNT3 = GHTCNT(3,:) + GHTCNT4 = GHTCNT(4,:) + GHTCNT5 = GHTCNT(5,:) + GHTCNT6 = GHTCNT(6,:) + + WESNN1 = WESNN (1,:) + WESNN2 = WESNN (2,:) + WESNN3 = WESNN (3,:) + + HTSNNN1 = HTSNNN(1,:) + HTSNNN2 = HTSNNN(2,:) + HTSNNN3 = HTSNNN(3,:) + + SNDZN1 = SNDZN (1,:) + SNDZN2 = SNDZN (2,:) + SNDZN3 = SNDZN (3,:) + + if (N_CONST_LAND4SNWALB /= 0) then + RDU001(:,:) = RCONSTIT(:,:,1) + RDU002(:,:) = RCONSTIT(:,:,2) + RDU003(:,:) = RCONSTIT(:,:,3) + RDU004(:,:) = RCONSTIT(:,:,4) + RDU005(:,:) = RCONSTIT(:,:,5) + RBC001(:,:) = RCONSTIT(:,:,6) + RBC002(:,:) = RCONSTIT(:,:,7) + ROC001(:,:) = RCONSTIT(:,:,8) + ROC002(:,:) = RCONSTIT(:,:,9) + end if + + ! -------------------------------------------------------------------------- + + deallocate ( wght ) + deallocate ( lai1 ) + deallocate ( lai2 ) + if (allocated (ALBVR_tmp)) deallocate ( ALBVR_tmp ) + if (allocated (ALBNR_tmp)) deallocate ( ALBNR_tmp ) + if (allocated (ALBVF_tmp)) deallocate ( ALBVF_tmp ) + if (allocated (ALBNF_tmp)) deallocate ( ALBNF_tmp ) + if (allocated (SNOVR_tmp)) deallocate ( SNOVR_tmp ) + if (allocated (SNONR_tmp)) deallocate ( SNONR_tmp ) + if (allocated (SNOVF_tmp)) deallocate ( SNOVF_tmp ) + if (allocated (SNONF_tmp)) deallocate ( SNONF_tmp ) + + deallocate(GHTCNT ) + deallocate(WESNN ) + deallocate(HTSNNN ) + deallocate(SNDZN ) + deallocate(TILEZERO ) + deallocate(DZSF ) + deallocate(SWNETFREE) + deallocate(SWNETSNOW) + deallocate(VEG1 ) + deallocate(VEG2 ) + deallocate(RCSAT ) + deallocate(DRCSDT ) + deallocate(DRCSDQ ) + deallocate(RCUNS ) + deallocate(DRCUDT ) + deallocate(DRCUDQ ) + deallocate(ZTH ) + deallocate(SLR ) + deallocate(RSL1 ) + deallocate(RSL2 ) + deallocate(SQSCAT ) + deallocate(RDC ) + deallocate(RDC_TMP_1) + deallocate(RDC_TMP_2) + deallocate(UUU ) + deallocate(RHO ) + deallocate(ZVG ) + deallocate(LAI0 ) + deallocate(GRN0 ) + deallocate(Z0 ) + deallocate(D0 ) + deallocate(SFMC ) + deallocate(RZMC ) + deallocate(PRMC ) + deallocate(ENTOT ) + deallocate(WTOT ) + deallocate(GHFLXSNO ) + deallocate(SHSNOW1 ) + deallocate(AVETSNOW1) + deallocate(WAT10CM1 ) + deallocate(WATSOI1 ) + deallocate(ICESOI1 ) + deallocate(LHSNOW1 ) + deallocate(LWUPSNOW1) + deallocate(LWDNSNOW1) + deallocate(NETSWSNOW) + deallocate(TCSORIG1 ) + deallocate(LHACC ) + deallocate(SUMEV ) + deallocate(TPSN1IN1 ) + deallocate(TPSN1OUT1) + deallocate(GHFLXTSKIN) + deallocate(WCHANGE ) + deallocate(ECHANGE ) + deallocate(HSNACC ) + deallocate(EVACC ) + deallocate(SHACC ) + deallocate(VSUVR ) + deallocate(VSUVF ) + deallocate(SNOVR ) + deallocate(SNOVF ) + deallocate(SNONR ) + deallocate(SNONF ) + deallocate(SHSBT ) + deallocate(DSHSBT ) + deallocate(EVSBT ) + deallocate(DEVSBT ) + deallocate(DEDTC ) + deallocate(DHSDQA ) + deallocate(CFT ) + deallocate(CFQ ) + deallocate(TCO ) + deallocate(QCO ) + deallocate(DQS ) + deallocate(QSAT ) + deallocate(RA ) + deallocate(CAT_ID ) + deallocate(ALWX ) + deallocate(BLWX ) + deallocate(ALWN ) + deallocate(BLWN ) + deallocate(TC1_0 ) + deallocate(TC2_0 ) + deallocate(TC4_0 ) + deallocate(QA1_0 ) + deallocate(QA2_0 ) + deallocate(QA4_0 ) + deallocate(fveg1 ) + deallocate(fveg2 ) + deallocate(RCONSTIT ) + deallocate(TOTDEPOS ) + deallocate(RMELT ) + deallocate(FICE1 ) + deallocate(SLDTOT ) + deallocate(FSW_CHANGE) + deallocate( btran ) + deallocate( wgt ) + deallocate( wpp ) + deallocate( fwet ) + deallocate( sm ) + deallocate( SWSRF1 ) + deallocate( SWSRF2 ) + deallocate( SWSRF4 ) + deallocate( tcx ) + deallocate( qax ) + deallocate( rcx ) + deallocate( rcxdt ) + deallocate( rcxdq ) + deallocate( car1 ) + deallocate( car2 ) + deallocate( car4 ) + deallocate( parzone ) + deallocate( para ) + deallocate( totwat ) + deallocate( nfire ) + deallocate(som_closs) + deallocate( dayl ) + deallocate(dayl_fac ) + deallocate( fsnow ) + deallocate( ityp_tmp ) + deallocate( Qair_relative ) + deallocate( ndeploy ) + deallocate( denit ) + deallocate( sminn_leached ) + deallocate( sminn ) + deallocate( fire_nloss ) + deallocate( leafn ) + deallocate( leafc ) + deallocate( gross_nmin ) + deallocate( net_nmin ) + deallocate( nfix_to_sminn ) + deallocate( actual_immob ) + deallocate( fpg ) + deallocate( fpi ) + deallocate( sminn_to_plant ) + deallocate( sminn_to_npool ) + deallocate( ndep_to_sminn ) + deallocate( totvegn ) + deallocate( totlitn ) + deallocate( totsomn ) + deallocate( retransn ) + deallocate( retransn_to_npool ) + deallocate( fuelc ) + deallocate( totlitc ) + deallocate( cwdc ) + deallocate( rootc ) + deallocate( lats_degree ) + deallocate( lons_degree ) + deallocate( lnfm ) + + deallocate( tgw ) + deallocate( rzm ) + deallocate( rc00 ) + deallocate( rcdt ) + deallocate( rcdq ) + deallocate( totcolc ) + deallocate( wtzone ) + deallocate( sfm ) + deallocate( bt1_sf ) + deallocate( bt2_sf ) + deallocate( bt4_sf ) + deallocate( btran1_sf ) + deallocate( btran2_sf ) + deallocate( btran3_sf ) + deallocate( btran_fire_rz ) + deallocate( btran_fire_sf ) + deallocate( psnsunx ) + deallocate( psnshax ) + deallocate( sifsunx ) + deallocate( sifshax ) + deallocate( laisunx ) + deallocate( laishax ) + deallocate( elaz ) + deallocate( esaz ) + deallocate( fvez ) + deallocate( ityz ) + deallocate( lmrsunx ) + deallocate( lmrshax ) + deallocate( tlaz ) + deallocate( albdir ) + deallocate( albdif ) + deallocate( elai ) + deallocate( esai ) + deallocate( fveg ) + deallocate( tlai ) + deallocate( psnsun ) + deallocate( psnsha ) + deallocate( laisun ) + deallocate( laisha ) + deallocate( ityp ) + deallocate( lmrsun ) + deallocate( lmrsha ) + deallocate( ht ) + deallocate( tp ) + deallocate( soilice ) + deallocate (PLSIN) + call MAPL_TimerOff ( MAPL, "-CATCHCNCLM45" ) + RETURN_(ESMF_SUCCESS) + + end subroutine Driver + +! ! ----------------- routines for CDF scaling ------------------- +! +! REAL FUNCTION cdf2fpar (cdf, k,l, m, m1, m2) +! +! REAL, intent (in) :: cdf, k,l,m, m1, m2 +! REAL :: x, ThisCDF, ThisFPAR +! integer, parameter :: nBINS = 40 +! +! x = real (nBINS) +! ThisCDF = 1. +! +! do while (ThisCDF >= cdf) +! ThisFPAR = 1. - (real(nbins)-x)/real(nbins) - 1./2./real(nbins) +! ThisCDF = K * betai (L, M, ThisFPAR) +! x = x - 1. +! if(x == 0) exit +! end do +! +! cdf2fpar = ThisFPAR * m2 + m1 +! if(cdf2fpar > m2) cdf2fpar = m2 +! if(cdf2fpar < m1) cdf2fpar = m1 +! return +! +! END FUNCTION cdf2fpar +! +! ! --------------------------------------------------------- +! +! FUNCTION betai(a,b,x) +! REAL betai,a,b,x +! REAL bt +! !external gammln +! +! if (x < 0.0125) x = 0.0125 +! if (x > 0.9875) x = 0.9875 +! +! if(x.lt.0..or.x.gt.1.)print *, 'bad argument x in betai',x +! if(x.lt.0..or.x.gt.1.)stop +! if(x.eq.0..or.x.eq.1.)then +! bt=0. +! else +! bt=exp(gammln(a+b)-gammln(a)-gammln(b) & +! +a*log(x)+b*log(1.-x)) +! endif +! +! if(x.lt.(a+1.)/(a+b+2.))then +! betai=bt*betacf(a,b,x)/a +! return +! else +! betai=1.-bt*betacf(b,a,1.-x)/b +! return +! endif +! +! END FUNCTION betai +! +! ! ------------------------------------------------------- +! +! FUNCTION betacf(a,b,x) +! +! INTEGER MAXIT +! REAL betacf,a,b,x,EPS,FPMIN +! PARAMETER (MAXIT=100,EPS=3.e-7,FPMIN=1.e-30) +! INTEGER m,m2 +! REAL aa,c,d,del,h,qab,qam,qap +! +! qab=a+b +! qap=a+1. +! qam=a-1. +! c=1. +! d=1.-qab*x/qap +! +! if(abs(d).lt.FPMIN)d=FPMIN +! d=1./d +! h=d +! do m=1,MAXIT +! m2=2*m +! aa=m*(b-m)*x/((qam+m2)*(a+m2)) +! d=1.+aa*d +! if(abs(d).lt.FPMIN)d=FPMIN +! c=1.+aa/c +! if(abs(c).lt.FPMIN)c=FPMIN +! d=1./d +! h=h*d*c +! aa=-(a+m)*(qab+m)*x/((a+m2)*(qap+m2)) +! d=1.+aa*d +! if(abs(d).lt.FPMIN)d=FPMIN +! c=1.+aa/c +! if(abs(c).lt.FPMIN)c=FPMIN +! d=1./d +! del=d*c +! h=h*del +! if(abs(del-1.).lt.EPS)exit +! enddo +! betacf=h +! return +! +! END FUNCTION betacf +! +! ! -------------------------------------------------------------- +! +! FUNCTION gammln(xx) +! +! REAL gammln,xx +! INTEGER j +! DOUBLE PRECISION ser,stp,tmp,x,y,cof(6) +! +! SAVE cof,stp +! DATA cof,stp/76.18009172947146d0,-86.50532032941677d0, & +! 24.01409824083091d0,-1.231739572450155d0,.1208650973866179d-2, & +! -.5395239384953d-5,2.5066282746310005d0/ +! x=xx +! y=x +! tmp=x+5.5d0 +! tmp=(x+0.5d0)*log(tmp)-tmp +! ser=1.000000000190015d0 +! do j=1,6 +! y=y+1.d0 +! ser=ser+cof(j)/y +! enddo +! gammln=tmp+log(stp*ser/x) +! return +! +! END FUNCTION gammln + + ! -------------------------------------------------------------- + + integer function VarID (NCFID, VNAME) + + integer, intent (in) :: NCFID + character(*), intent (in) :: VNAME + integer :: status + + STATUS = NF_INQ_VARID (NCFID, trim(VNAME) ,VarID); VERIFY_(STATUS) + + end function VarID + +end subroutine RUN2 + +!BOP +! !IROUTINE: RUN0 -- Extra run method for the OFFLINE case, called by RUN1 +! !INTERFACE: + +subroutine RUN0(gc, import, export, clock, rc) + + ! !ARGUMENTS: + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: import ! Import state + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + + ! !DESCRIPTION: In the OFFLINE case, some diagnostic vars (INTERNAL states + ! asnow and emis) are updated here. + !EOP + + ! ErrLog variables + integer :: status + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: comp_name + + ! Local variables + + !! ESMF/MAPL variables + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_State) :: INTERNAL + + !! IMPORT pointers + real, pointer :: ps (:)=>null() + + !! INTERNAL pointers + !! -asnow-emis-ww-fr- + real, pointer :: ity(:,:)=>null() + real, pointer :: fvg(:,:)=>null() + real, pointer :: asnow(:)=>null() + real, pointer :: emis(:)=>null() + real, pointer :: ww(:,:)=>null() + real, pointer :: fr(:,:)=>null() + real, pointer :: DCQ(:,:)=>null() + real, pointer :: DCH(:,:)=>null() + !! -prognostic-variables- + real, pointer :: tc(:,:)=>null() + real, pointer :: qc(:,:)=>null() + real, pointer :: htsnnn1(:)=>null() + real, pointer :: wesnn1(:)=>null() + real, pointer :: wesnn2(:)=>null() + real, pointer :: wesnn3(:)=>null() + real, pointer :: srfexc(:)=>null() + real, pointer :: rzexc(:)=>null() + real, pointer :: catdef(:)=>null() + !! -parameters- + real, pointer :: vgwmax(:)=>null() + real, pointer :: cdcr1(:)=>null() + real, pointer :: cdcr2(:)=>null() + real, pointer :: psis(:)=>null() + real, pointer :: bee(:)=>null() + real, pointer :: poros(:)=>null() + real, pointer :: wpwet(:)=>null() + real, pointer :: ars1(:)=>null() + real, pointer :: ars2(:)=>null() + real, pointer :: ars3(:)=>null() + real, pointer :: ara1(:)=>null() + real, pointer :: ara2(:)=>null() + real, pointer :: ara3(:)=>null() + real, pointer :: ara4(:)=>null() + real, pointer :: arw1(:)=>null() + real, pointer :: arw2(:)=>null() + real, pointer :: arw3(:)=>null() + real, pointer :: arw4(:)=>null() + real, pointer :: bf1(:)=>null() + real, pointer :: bf2(:)=>null() + + !! Miscellaneous + integer :: ntiles, nv, nz + real, allocatable :: dummy(:) + real, allocatable :: dzsf(:), ar1(:), ar2(:), wesnn(:,:) + real, allocatable :: catdefcp(:), srfexccp(:), rzexccp(:) + real, allocatable :: VEG1(:), VEG2(:) + integer, allocatable :: ityp(:,:,:) + real, allocatable :: fveg(:,:,:), elai(:,:,:), esai(:,:,:), wtzone(:,:), lai1(:), lai2(:), wght(:) + real, allocatable,dimension(:) :: fveg1, fveg2 + + ! Begin... + + ! Get component name and setup traceback handle + call ESMF_GridCompGet(gc, name=comp_name, rc=status) + VERIFY_(status) + Iam = trim(comp_name)//"::RUN0" + + ! Get MAPL object + call MAPL_GetObjectFromGC(gc, MAPL, rc=status) + VERIFY_(status) + + ! Get component's internal ESMF state + call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) + VERIFY_(status) + + ! Pointers to IMPORTs + call MAPL_GetPointer(import, ps, 'PS', rc=status) + VERIFY_(status) + + ! Pointers to EXPORTs + call MAPL_GetPointer(export, asnow, 'ASNOW', rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, emis, 'EMIS', rc=status) + VERIFY_(status) + + ! Pointers to INTERNALs + call MAPL_GetPointer(INTERNAL, ITY, 'ITY', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, FVG, 'FVG', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, fr, 'FR', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, ww, 'WW', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, DCQ, 'DCQ', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, DCH, 'DCH', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, tc, 'TC', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, qc, 'QC', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, htsnnn1, 'HTSNNN1', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, wesnn1, 'WESNN1', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, wesnn2, 'WESNN2', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, wesnn3, 'WESNN3', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, vgwmax, 'VGWMAX', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, cdcr1, 'CDCR1', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, cdcr2, 'CDCR2', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, psis, 'PSIS', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, bee, 'BEE', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, poros, 'POROS', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, wpwet, 'WPWET', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, ars1, 'ARS1', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, ars2, 'ARS2', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, ars3, 'ARS3', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, ara1, 'ARA1', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, ara2, 'ARA2', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, ara3, 'ARA3', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, ara4, 'ARA4', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, arw1, 'ARW1', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, arw2, 'ARW2', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, arw3, 'ARW3', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, arw4, 'ARW4', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, bf1, 'BF1', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, bf2, 'BF2', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, srfexc, 'SRFEXC', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, rzexc, 'RZEXC', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, catdef, 'CATDEF', rc=status) + VERIFY_(status) + + ! Number of tiles and a dummy real array + ntiles = size(HTSNNN1) + + allocate(dummy(ntiles), stat=status) + VERIFY_(status) + ! Reset WW + WW = 0. + + ! get CNLAI to compute emmissivity + allocate(fveg1 (NTILES)) + allocate(fveg2 (NTILES)) + allocate(veg1(ntiles), stat=status) + VERIFY_(status) + allocate(veg2(ntiles), stat=status) + VERIFY_(status) + allocate( ityp(ntiles,num_veg,num_zon) ) + allocate( fveg(ntiles,num_veg,num_zon) ) + allocate( wtzone(ntiles,num_zon) ) + allocate( elai(ntiles,num_veg,num_zon) ) + allocate( esai(ntiles,num_veg,num_zon) ) + + allocate ( lai1(ntiles) ) + allocate ( lai2(ntiles) ) + allocate ( wght(ntiles) ) + +! set CLM CN PFT & fraction, set carbon zone weights +! -------------------------------------------------- + do nz = 1,num_zon + ityp(:,:,nz) = nint(ity(:,:)) + fveg(:,:,nz) = fvg(:,:) + wtzone(:,nz) = CN_zone_weight(nz) + end do + + call get_CN_LAI(ntiles,num_veg,num_zon,ityp,fveg,elai,esai=esai) + + lai1 = 0. + wght = 0. + do nz = 1,num_zon + do nv = 1,2 + lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + lai1 = lai1 / max(wght,1.e-8) ! LAI for primary vegetation type + + lai2 = 0. + wght = 0. + do nz = 1,num_zon + do nv = 3,4 + lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) + end do + end do + lai2 = lai2 / max(wght,1.e-8) ! LAI for secondary vegetation type + + deallocate ( ityp ) + deallocate ( fveg ) + deallocate ( elai ) + deallocate ( esai ) + deallocate ( wtzone ) + +! Vegetation types used to index into tables +!-------------------------------------------- + + where(ITY(:,1) > 0.) + VEG1 = map_cat(nint(ITY(:,1))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + elsewhere + VEG1 = map_cat(nint(ITY(:,2))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + endwhere + where(ITY(:,3) > 0.) + VEG2 = map_cat(nint(ITY(:,3))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + elsewhere + VEG2 = map_cat(nint(ITY(:,4))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + endwhere + _ASSERT((count(VEG1>NTYPS.or.VEG1<1)==0),'needs informative message') + _ASSERT((count(VEG2>NTYPS.or.VEG2<1)==0),'needs informative message') + fveg1(:) = fvg(:,1) + fvg(:,2) ! sum veg fractions (primary) gkw: NUM_VEG specific + fveg2(:) = fvg(:,3) + fvg(:,4) ! sum veg fractions (secondary) gkw: fveg1+fveg2=1 + + ! Compute ASNOW and EMIS + allocate(wesnn(3,ntiles), stat=status) + VERIFY_(status) + wesnn(1,:) = wesnn1 + wesnn(2,:) = wesnn2 + wesnn(3,:) = wesnn3 + call StieglitzSnow_calc_asnow(3, ntiles, wesnn, asnow) + + EMIS = fveg1*(EMSVEG(NINT(VEG1)) + (EMSBARESOIL - EMSVEG(NINT(VEG1)))*exp(-LAI1)) + & + fveg2*(EMSVEG(NINT(VEG2)) + (EMSBARESOIL - EMSVEG(NINT(VEG2)))*exp(-LAI2)) + + emis = emis*(1.-asnow) + EMSSNO*asnow + + ! Compute FR + ! Step 1: set dzsf + ! Step 2: compute ar1, ar2 via call to catch_calc_soil_moist() + ! Step 3: compute fr + + ! -step-1- + allocate(dzsf(ntiles), stat=status) + VERIFY_(status) + dzsf = SURFLAY + + ! -step-2- + allocate(ar1(ntiles), stat=status) + VERIFY_(status) + allocate(ar2(ntiles), stat=status) + VERIFY_(status) + ! -we-don't-want-to-modify-srfexc-rzexc-and-catdef- + ! -so-we-create-local-copies- + allocate(catdefcp(ntiles), stat=status) + VERIFY_(status) + allocate(srfexccp(ntiles), stat=status) + VERIFY_(status) + allocate(rzexccp(ntiles), stat=status) + VERIFY_(status) + catdefcp = catdef + srfexccp = srfexc + rzexccp = rzexc + call catch_calc_soil_moist( & + ! intent(in) + ntiles, dzsf, vgwmax, cdcr1, cdcr2, & + psis, bee, poros, wpwet, & + ars1, ars2, ars3, & + ara1, ara2, ara3, ara4, & + arw1, arw2, arw3, arw4, bf1, bf2, & + ! intent(inout) + ! from process_cat + srfexccp, rzexccp, catdefcp, & + ! use this one can match process_cat + ! srfexc, rzexc, catdef, & + ! intent(out) + ar1, ar2, dummy & + ) + + fr(:,FSAT) = ar1 * (1-asnow) + fr(:,FTRN) = ar2 * (1-asnow) + fr(:,FWLT) = (1.0-(ar1+ar2))* (1-asnow) + fr(:,FSNW) = asnow + fr = min(max(fr,0.0),1.0) + + ! Overwrite the top layer snow temperature tc(4) with its diagnosed value + call StieglitzSnow_calc_tpsnow(ntiles, htsnnn1, wesnn1, tc(:,4), dummy) + tc(:,FSNW) = tc(:,FSNW) + MAPL_TICE ! Convert to K + + ! Overwrite qc(4) + !qc(:,FSNW) = GEOS_QSAT(tc(:,FSNW), PS, PASCALS=.true., RAMP=0.0) + qc(:,FSNW) = MAPL_EQsat(tc(:,FSNW),PS,OverIce=.true.) + + ! Clean up + if (allocated(catdefcp)) deallocate(catdefcp) + if (allocated(srfexccp)) deallocate(srfexccp) + if (allocated(rzexccp)) deallocate(rzexccp) + if (allocated(dummy)) deallocate(dummy) + if (allocated(dzsf)) deallocate(dzsf) + if (allocated(ar1)) deallocate(ar1) + if (allocated(ar2)) deallocate(ar2) + if (allocated(wesnn)) deallocate(wesnn) + if (allocated(fveg1)) deallocate (fveg1) + if (allocated(fveg2)) deallocate (fveg2) + if (allocated(veg1)) deallocate (veg1) + if (allocated(veg2)) deallocate (veg2) + if (allocated(lai1)) deallocate (lai1) + if (allocated(lai2)) deallocate (lai2) + if (allocated(wght)) deallocate (wght) + + ! All done + RETURN_(ESMF_SUCCESS) + +end subroutine RUN0 + +end module GEOS_CatchCNCLM45GridCompMod + +subroutine SetServices(gc, rc) + use ESMF + use GEOS_CatchCNCLM45GridCompMod, only : mySetservices=>SetServices + type(ESMF_GridComp) :: gc + integer, intent(out) :: rc + call mySetServices(gc, rc=rc) +end subroutine From 0c4e8a96e6f3d89131b056e309397d1586e7591c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 3 Aug 2022 15:45:32 -0400 Subject: [PATCH 002/589] initial development intermediate push --- .../CLM45/.CN_DriverMod.F90.swp | Bin 0 -> 16384 bytes .../CLM51/.CN_init_mod.F90.swp | Bin 0 -> 24576 bytes .../CLM51/CNCLM51_Photosynthesis.F90 | 5 - .../CLM51/CNCLM_ActiveLayerMod.F90 | 201 + .../CLM51/CNCLM_CNDVType.F90 | 78 + .../CLM51/CNCLM_CanopyStateType.F90 | 2 +- .../CLM51/CNCLM_ColumnType.F90 | 145 + .../CLM51/CNCLM_CropType.F90 | 70 + .../CLM51/CNCLM_GridcellType.F90 | 2 + .../CLM51/CNCLM_LandunitType.F90 | 108 + .../CLM51/CNCLM_NamelistParameters.F90 | 5 + .../CLM51/CNCLM_PatchType.F90 | 132 + .../CLM51/CNCLM_PhotoParamsType.F90 | 233 - .../CLM51/CNCLM_PhotosynsType.F90 | 263 ++ .../CNCLM_SoilBiogeochemCarbonStateType.F90 | 2 +- ...CLM_SoilBiogeochemDecompCascadeConType.F90 | 147 + .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 4 +- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 31 +- .../CLM51/CNCLM_ch4Mod.F90 | 222 + .../CLM51/CNCLM_decompMod.F90 | 5 +- .../CLM51/CNCLM_pftconMod.F90 | 687 ++- .../CLM51/CNMRespMod.F90 | 305 ++ .../CLM51/CNPhenologyMod.F90 | 3780 +++++++++++++++++ .../CLM51/CNSharedParamsMod.F90 | 168 +- .../CLM51/CN_DriverMod.F90 | 54 +- .../CLM51/CN_init_mod.F90 | 119 +- .../NutrientCompetitionCLM45defaultMod.F90 | 1171 +++++ .../CLM51/NutrientCompetitionFactoryMod.F90 | 87 + .../NutrientCompetitionFlexibleCNMod.F90 | 1987 +++++++++ .../CLM51/NutrientCompetitionMethodMod.F90 | 202 + .../CLM51/RootBiophysMod.F90 | 328 ++ .../SoilBiogeochemDecompCascadeBGCMod.F90 | 1132 +++++ .../SoilBiogeochemDecompCascadeCNMod.F90 | 996 +++++ .../CLM51/abortutils.F90 | 95 + .../CLM51/clm_time_manager.F90 | 9 +- .../CLM51/clm_varcon.F90 | 11 + .../CLM51/clm_varctl.F90 | 14 +- .../CLM51/clm_varpar.F90 | 9 +- .../CLM51/column_varcon.F90 | 170 + .../CLM51/fileutils.F90 | 179 + .../CLM51/initSubgridMod.F90 | 477 +++ .../CLM51/landunit_varcon.F90 | 133 + .../CLM51/ncdio_pio.F90.in | 324 ++ .../CLM51/paramUtilMod.F90 | 291 ++ .../CLM51/shr_abort_mod.F90 | 163 + .../CLM51/shr_file_mod.F90 | 1010 +++++ .../CLM51/shr_log_mod.F90 | 105 + .../CLM51/shr_sys_mod.F90 | 332 ++ .../CLM51/spmdMod.F90 | 142 + .../CLM51/subgridAveMod.F90 | 1363 ++++++ 50 files changed, 16743 insertions(+), 755 deletions(-) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/.CN_DriverMod.F90.swp create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/.CN_init_mod.F90.swp create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_NamelistParameters.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 delete mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotoParamsType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionMethodMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/fileutils.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/initSubgridMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/landunit_varcon.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_file_mod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_log_mod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_sys_mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/.CN_DriverMod.F90.swp b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/.CN_DriverMod.F90.swp new file mode 100644 index 0000000000000000000000000000000000000000..09e6c4e7d0ba9cd0b27b64061e778949e0f3147b GIT binary patch literal 16384 zcmeHOTZ|<|8E(J}C@8Fo5`okKS!dRo>+XUK*(I|*mmPQK!kn1}HqlO0 z_t`TuJP;FtCTcV>zDP_I6BUgyMt#s1jfp1kf-md~L?1{%VG#wy3o3qpclEjSTo&Ud z^3a`pr>pC$`s=U1s;la+>eCoMwXn!;8$D#;y4o<#z4H0SgZm!2?DCHq#(if(UnGej zYOl-j5<5IA-$U17_?NM9&tFvb?C-7=SUj5JR!9y;7(vd1x`oryhEYcX_2=WZY0yKWU* zS>Ua2fvb#zlM`7_zWJsad*8nGx4z1ihLr^>3se@UEKpgXvOr~l$^w-IDhpgR3#8G9 zjRzp@QZ2FY2rkjj#r+L^P3rhlCH~(f{<9_iUz(rN@jol^|J3~LI{wuX|GMT2H+)1Z zR_ON+&9CTupDgiz*Sx3s@0a+$Y5pF~U#ksL$p5S6*EFw6{A-$TX#STa{x6zuYW^da z<$*%}tD3KC{&OY%70n;i{BKMA%bLGl^Vhs>Q2w7a{~^tfl=wes{sWqyE%7gD{yNQ{ zF7bcVe4$@b;$PJKn9l#L5`SLvw`u;#690nc7c_t6+w(wSzvnf7hvwHy{2w%bLi1lL z@xRynwC0~G@y}`A)cp1D$OA?Bx;cyknzu^4j;?N%1u6?v7N{&xS)j5&Wr4~9l?5sb zR2KNZSwJ|3@j;aS8FFN_!{sq@DT7IkOCYy0Mvke!0YcZjAwvz zz;}WBff?Zaz_V8w#3M%f$MEpm-z)yikf$snwFa^8@C-5gg09*_F0DAzR0A7Y| z$-WO2&f@mgW-OM%KX8aM#|xxNyig4(yEV+2r&6iXAx{mnsVUZpIx^)^;w8KxC6B^5 zO!(PmClDLF;rd~Rr(xO=DXXz0^n8Y(jM;t`iC6>@;ly~eMWxXMPoqiTAaDpc4BT2s zPGu0uSfuS(CT!@$@NROs+6tB2R*}RFAgLq0W-FBr(;soLAoLOv$?PzzHxmhSV_~z< zWp^Jp|I0$+t${+~Fib~Cn~Pjb+UyioDeB>iP1wE9MthlPn{gbm=}Xm2TM*j|4iB1L~>>1L#5 zkhDEy*raz)1uBuco!0rl$IDuy$z?Q<#ax1(frR!lN?6=hc&V8eM80QxDN}jzHCCHm zonK#^U0SPSTaoR2*&WAja%y_JNtWC3!b_8cfkHZ&#zG~1AuA0n6@{VS3P zj(%)%JM=Bri>0M}6u6iD8tqtdn^JK_IXGI!%AdQH+aa*uxZ(;OEy(_p0asCk3ery! zQ|)Bl7kDHbhocc}zL5lYkMy-`4VzBHTTZ}TPx_8!i-`Nm4fvKXJie9CPl_MZ(B{h6Ns+o;<)GuP@@x@L1iV4LcXGpu zx4OZ^&7OVk1QkJIc(_{1XIg`yVPA?-% zZFTn4LVaO*i5*|4uPv|MI|WIMMePO#a9YM-PO(t$lhX?W(TI{8URsXxFs78_@=r6V ztd;d+Cl^e%IJCC>-cPSg;r%rw_!;ja=ych4s}>qKNioD{iSu+b zr`PK1t8+(=n$v6MaZ5jPHgkG@trt1JX51{5^v1j_z9VZ6yHI@v3YaP+@6aO&1JeEYi8D5UR=@QA~!|*pnhF5WQLt$ zDzf7+!lcBR!XifE)`%V7wHzBZjxnDiQVU61ac&}Nqg+sKr26qy%S3Njv(`?`t)Awr z7h%p!->b9Ret=dB(85BAY+0pspnghg5G(Pvpa4Ch9WXd&LAxEt7WIq^Rs~;2Q@ihZ zna2bsaa)=#X`kV2ss9mqbJO=nqV004PqAYXJ*yDF^T$F!zD&upPb-CW#Cq19`?8x$ z{Y1C0x=c?AzfGN_-=^l$X&HxeetSbEmeZkElcbXo(UN#Qx-FTvL65MgYoQ(60a|@9 zTYm=_$Oa6Li*)X-7)M=yUeN44^YHJV27U~D9XJcL zfxCba;2iw?uL7R}ZUUZ#Pk#=068I7DWuOhL0Ly@a4}Ss}0?4Po0Wg3!w9e0x-qlrE zpt3+^fyx4v1u6?v7N{&xwg6l}?e7jQ|FGI6s&6}@=bAHejfwSKS{38!v?R9Xha~p9 z*imc@j1IFbe1yV-Nw6>0O+w)!31khiQ5B}6T}PJS1~6P4jR~LY^i69^4Ye! zPa-uyYjkqsaKw_W+I& z=p&tn{g>QgPDtj$Rb!d|PQtRCckD=nkwFX@Rwt{WO|l*O9^1#)*vi}*HqRZo(a(2N z;D|uF*hq3v?`EDND}V~g5@o)B{zSi?JA_TRgbtNbG~_U>j~h;#ulFgHrBo-^^*KT z2T*5W@QG~454~kuQx+*zgk<>n7@IJLOZa1oupv3Dt$L<@th^m`JotX zFk;gPn>6Uqs0pwIM5G&?vX;(R`!-v92XWY&#X}g;!54NAA(7q(6kNkApCX3#5k>^W f1N$C;UP@3yrX ze$1rL-g{@>uk+41XWsWcXWAOyb=fpKf88bx$GbIc@8f@N-EiN{tDZPV)2_PObM!FO z>C&LXv_r#NvVx5p22p9+SjTUN-7(W`ZCpQ=2p@B;J!4as&dhg=ZgVQI&AQk1`3b#r z#$Q|xZ6nN+g}tDy8&>|Lqq}DQjG;%yV!fd}S>G{z?)vNs|2YO)+qI)+*E82mUN}Cu zY1P%r18;2)^rH6K3r^NHZdlK|@`uhEV(&S1=Udz6%DTz}l?N&hR34~2PLr6@Tt4T#tWN zAC(6x4^$qgJWzR{@<8Q*$^(@LDi2g1s60@4pz^@~zyrFeX^nSi+Nmc(IM)A@{Qs4A zY1&_a2Z1jFJ}?7p1U>*9e5a=U`!>%WR9|QLQw*xx?29V8X0#CvITYHfi_?PR{)m-X8{L}*R*GVUjh#S_W<*N27LcGP1^!Ifg*@ag%H3& z!DBV>Itm;A0v-jv0qDRu@Fof>`+)$s0C*h*l}CVU;=&4J(Xwxi?9n4DFm1i#dSPT6 zt)6prlP-+1^w_+asijI>xv=-EyfK~#}96~Z7Tqmp?etLs~V9`%C0+~Ad|WNtm` zZg8;GqF{5Tmyza#O6D}&C9Bgk^q}RTB}&`DS*9w>z$T5r>sV?jsf;{TPKwj(`fc06 zo#@vNND%~y$7z2_k9LRjZ#a0Io|`Zj9<;av$ho6Hl`#0UUu7UYd6rWpEG@6+n&Chm zum~!QAU3pPrarL)U;aM_6gghUHgu=PJU_BMm%a@?Y&WvpXvB6$skMfCZWAsto9Hk> zga$DB#l)|+7qDp2V%WXImh`~ZTaFdtj2l#@k zJH#XJ6LdfD4Kb*0SpoCfyi0`;Jak!OcIU#_%+3XT;J4lN9ow)Y=6bG0*C*ztc1~Z~ zSeVE74tuS@>qWMUF(LM{QOB;4!8P(l&2Zs+{KY-4Ip|$A>dW{o53*5hXzdXlFu?HK zNXJZzuYO=JVUA~7-eiVLD;zF*Ung+Q8l!J`hJm9OTFh{|O>{0_4`KnBR9t77Z6>!- zi|CVgc>aajOVa{%dGUqX&d$cuT*#|8W*05j!wj`N?U_oWQVp0g%!Gbc5A-eursBBd zqcpjgf{`*HXAZEvu7`$hTJ?r#L@JaTuCl%E=B!uQu4L<@hVRfc zxfcyV(llsLQx6#+XWLYr+nbsz$q~$<-!(xJi>f!~7x55@Z)Khp9f5a&IchPdN|~nT ztT18W{{!n>h&hsL47TWfj*|H-JJr)oqrke23Yt|dvca={Do?kjSfw^zV z+MzF7K_<7}ARz;sR`=YJBx7+?Q9_+ZIwi_kdhnLc=G8UgNN&>UU9$pdod=FeLJ_GI z&H5zzctG^q5M!5w)5c@Na-7nIdSjQ>8E6-$7+?;+K2H&DNqD~XY8rH}z%zSBL|p*$ zC-2&-dzBce7L!*c%vDpSjw+dpsS{Ir(Xq3OUgU+#Zdjt9LAYUU(?hGsGB37lPdF{h z^h#{=*mWLEv_dby<lpcdD<=Hhc*R0R%s4@D2pa)O7E_xDz(>NR; z&6NMoBagj>@>=BoQ~03cd&u$c2DSrr;5p>-2Y}sx4}1hT2Y4EJ{8PZ^fa`z>U@Nd1 z(13@K!~Y1l9{4=44VVB<0!{>;M*jY7zya#O`+?Je_W`dVpZ^)q1ug)7k6iwDz@5My zz;56rvt;pt}8jlH-Qyk_e&tSZ=6h^}o zii)sugt>-ovQbV-a_lxS;oy8y*qepVBcei7;|0T3nyXOJ1!)2)7}X%aazctf59J8c z`Xq6~8o|`hgjUB`*#^qpAjWR9k@CZFlqx}P<{uGmiv%xr4Eco{!mS{Je264cGbQnW zOlg<|DVh3dND?CC<}ip+o47^gv?8WJVIW$xLxz7uXqi-*@kJKe>P5Vsg*+ISlZqI* zpJg{v5L*a`siYvZ2?t5}h)|Y!kgOZ_e9Ij{V%Z(x`VeSaqcwl>vYF=Gr4!q0tl6Ba zH=Clfr4;NEwq`7OMR3gZTDoy{&(GffL)J0IiOHfS$qdI3?RN1-o@muN1Me(dxMAZu z*I2_18bZwmDXs3<*NSpq%8oV%UN>tXRc$TKgNEV=ycz6QCVRsd;5n4+4EzE^B%yZ^jmp zHDrVx#Ip!hUgRS`4u_2Z`DGg=5lYSC77w?qj=x#V0K=Ft{M!1>NeO1Ow#MLT*BUW` zv+;}Sijb9#+qhUGsy3p2!^dl8PQjSNw}r2Y{5PiL`Vr|*%Ytwm_Z*$H-A>aFJnBhQ zaN;$-c-;bBdjlIx$cQlpZt1vimTVT8D<94#yk9 z_Sn%PGp)AXb0U<*oSqf;6_nJ`ozTHN<^^`gMvb1;7v`t4j*fb>=d!r67;|Mk!R#!F z6^QIc$KTSf!AZnpgtsnZMu+tIDCy74NtDb~&|R{c4plYsLQ>5+lH@^Fut8*3xFNi* zg<=@3E4fs9S3PG$H<4PfxGAqYZAoebN+$6`w4j*=L^ew|F~#v^tu|^FTxKF+5S`L9 z1qLyOR}w2xDTVURM?%sy%cQA^onqNCB~eNd>wBf9LR2b+YSxSwtr@RcV-<*(ZbjWX zULnj$i0^E{z4B6G+IVjB;i+25F+z_BmLk;X61N;~ljLx#(3HXrm2~Bs5_@V;AV>NC z`Izk&20VjYpVs+ljsFbbSIF(Z2FwE|0goe>zXhPR`_q6I zkiYK*rhrp`1IXX+0=@&>09+1i0Zs)@0p6fo9(WP>HSjpF54az=9rz~j8K4Pl1-1bH zMt=V$@N?i%;H$t_fUUq5AgKZT6?y+Fz>~mlfW5$Nz;3_?{(;>8@4$7yXMu}>i-6aV z=f4W<2Oa>f0%-mJRn$xV3G4?R01Ti73a=|F{K5dQdNurXiOeS-fgkn2wYkWKClYmOCY$K4bOpgw{!@k?|;n7P@jW zju81Tv{sSY|IN^r)=cY@x1OG&8+df<)Os{@-;tts*NmFv&Z)x%pW>;ZlpFg0bFG z#2u-~FdkKrQ#E}YE!G*GfLvkYT28xY8k{eVcO7m$9sf?FoWh6=o^7fv5 zFG?LClPF~*n|$*8cdl9o`g!OnHape z(3~q2$s~m(Ng$q0=Eyvftx0jOOg{4V3A%W==2VC)a;#3v27VNTe6iQ`_PB{i@fizF zWr>8DYET_4lwre7fCVY+7%R?2bd{FT%A-4PY8<=qO$W49CakeeV3cN>+%Bt}g{e4f zu`014JWTdl<(QiSy`GyCCf67V3T8RG^-r}{TR53!TFg~ZZ%5|Fes>UmP)g@QiRwkS)?k9 z$Yyed?WrAtO6D%y9+jA~+sk4MDV|R6SKLX4Lf|GWY#mQ81!?N%<;mx}QzaT85l6j@rSaC9i%U#lJ$uwwl5zk zguX1+O>`!~>Hto17;S<;AS`Q4!_@w)#3=`}iBdTN?ZXXLnTji>{QqX;w4X-4OZorW zH~~F~oPR&y0>=aQBj^7(@FH^kKLURMZUb6?4txTb0w#frfr|jz13+v44+1{`?f`BD zHUU&0xCNkn{P!dO{}}MX38*&!w4VPgZ~(X)2!UY`Ze9@{GoWu)Vxi@K~_iIJ9j1t(0h W^m0$5dco;PUvNscwqTp3ru_#33q;%i literal 0 HcmV?d00001 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index fd116e84a..f4d4d97cc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -258,11 +258,6 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & if (ityp(nc,nv,nz).eq.np) then elai_pft = elai(nc,nv,nz) esai_pft = esai(nc,nv,nz) - - if (fveg(nc,nv,nz).gt.1.e-4) then - soilstate_inst%rootfr_patch(p,1) = 1.0 ! jkolassa: since we only use one soil layer, we are setting rootfr to 1 for all vegetated areas; ! if we ever introduce more soil layers, CTSM5.1 offers different options for the root distribution - - end if end if end do ! nv diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 new file mode 100644 index 000000000..2e36fbb69 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 @@ -0,0 +1,201 @@ +module CNCLM_ActiveLayerMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines for calculation of active layer dynamics + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varctl , only : iulog, use_cn + use clm_varcon , only : spval + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_active_layer_type + public:: alt_calc + + ! !PUBLIC TYPES: + type, public :: active_layer_type + private + ! Public data members: + real(r8) , pointer, public :: altmax_col (:) ! col maximum annual depth of thaw + real(r8) , pointer, public :: altmax_lastyear_col (:) ! col prior year maximum annual depth of thaw + integer , pointer, public :: altmax_indx_col (:) ! col maximum annual depth of thaw + integer , pointer, public :: altmax_lastyear_indx_col (:) ! col prior year maximum annual depth of thaw + + ! Private data members: + real(r8) , pointer :: alt_col (:) ! col current depth of thaw + integer , pointer :: alt_indx_col (:) ! col current depth of thaw + + contains + procedure, public :: alt_calc + + end type active_layer_type + type(active_layer_type), public, target, save :: active_layer_inst + +!--------------------------------------- + +contains + +!--------------------------------------- + subroutine init_active_layer_type(bounds, this) + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(active_layer_type), intent(inout) :: this + ! + !----------------------------------------------------------------------- + + associate( & + begc => bounds%begc, & + endc => bounds%endc & + ) + + allocate(this%alt_col (begc:endc)) ; this%alt_col (:) = spval + allocate(this%altmax_col (begc:endc)) ; this%altmax_col (:) = spval + allocate(this%altmax_lastyear_col (begc:endc)) ; this%altmax_lastyear_col (:) = spval + allocate(this%alt_indx_col (begc:endc)) ; this%alt_indx_col (:) = huge(1) + allocate(this%altmax_indx_col (begc:endc)) ; this%altmax_indx_col (:) = huge(1) + allocate(this%altmax_lastyear_indx_col (begc:endc)) ; this%altmax_lastyear_indx_col (:) = huge(1) + + end associate + + end subroutine init_active_layer_type + +!----------------------------------------- + subroutine alt_calc(this, num_soilc, filter_soilc, & + temperature_inst) + ! + ! !DESCRIPTION: + ! define active layer thickness similarly to frost_table, except set as deepest thawed layer and define on nlevgrnd + ! also update annual maxima, and keep track of prior year for rooting memory + ! + ! BUG(wjs, 2014-12-15, bugz 2107) Because of this routine's placement in the driver + ! sequence (it is called very early in each timestep, before weights are adjusted and + ! filters are updated), it may be necessary for this routine to compute values over + ! inactive as well as active points (since some inactive points may soon become + ! active) - so that's what is done now. Currently, it seems to be okay to do this, + ! because the variables computed here seem to only depend on quantities that are valid + ! over inactive as well as active points. + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varpar , only : nlevgrnd + use clm_time_manager , only : get_curr_date, get_step_size + use clm_varctl , only : iulog + use clm_varcon , only : zsoi + ! + ! !ARGUMENTS: + class(active_layer_type), intent(inout) :: this + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(temperature_type) , intent(in) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: c, j, fc, g ! counters + integer :: alt_ind ! index of base of activel layer + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: dtime ! time step length in seconds + integer :: k_frz ! index of first nonfrozen soil layer + logical :: found_thawlayer ! used to break loop when first unfrozen layer reached + real(r8) :: t1, t2, z1, z2 ! temporary variables + !----------------------------------------------------------------------- + + + associate( & + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + alt => this%alt_col , & ! Output: [real(r8) (:) ] current depth of thaw + altmax => this%altmax_col , & ! Output: [real(r8) (:) ] maximum annual depth of thaw + altmax_lastyear => this%altmax_lastyear_col , & ! Output: [real(r8) (:) ] prior year maximum annual depth of thaw + alt_indx => this%alt_indx_col , & ! Output: [integer (:) ] current depth of thaw + altmax_indx => this%altmax_indx_col , & ! Output: [integer (:) ] maximum annual depth of thaw + altmax_lastyear_indx => this%altmax_lastyear_indx_col & ! Output: [integer (:) ] prior year maximum annual depth of thaw + ) + + ! on a set annual timestep, update annual maxima + ! make this 1 January for NH columns, 1 July for SH columns + call get_curr_date(year, mon, day, sec) + dtime = get_step_size() + if ( (mon .eq. 1) .and. (day .eq. 1) .and. ( sec / dtime .eq. 1) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if ( grc%lat(g) > 0. ) then + altmax_lastyear(c) = altmax(c) + altmax_lastyear_indx(c) = altmax_indx(c) + altmax(c) = 0. + altmax_indx(c) = 0 + endif + end do + endif + if ( (mon .eq. 7) .and. (day .eq. 1) .and. ( sec / dtime .eq. 1) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if ( grc%lat(g) <= 0. ) then + altmax_lastyear(c) = altmax(c) + altmax_lastyear_indx(c) = altmax_indx(c) + altmax(c) = 0. + altmax_indx(c) = 0 + endif + end do + endif + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate alt for a given timestep + ! start from base of soil and search upwards for first thawed layer. + ! note that this will put talik in with active layer + ! a different way of doing this could be to keep track of how long a given layer has ben frozen for, and define ALT as the first layer that has been frozen for less than 2 years. + if (t_soisno(c,nlevgrnd) > SHR_CONST_TKFRZ ) then + alt(c) = zsoi(nlevgrnd) + alt_indx(c) = nlevgrnd + else + k_frz=0 + found_thawlayer = .false. + do j=nlevgrnd-1,1,-1 + if ( ( t_soisno(c,j) > SHR_CONST_TKFRZ ) .and. .not. found_thawlayer ) then + k_frz=j + found_thawlayer = .true. + endif + end do + + if ( k_frz > 0 ) then + ! define active layer as the depth at which the linearly interpolated temperature line intersects with zero + z1 = zsoi(k_frz) + z2 = zsoi(k_frz+1) + t1 = t_soisno(c,k_frz) + t2 = t_soisno(c,k_frz+1) + alt(c) = z1 + (t1-SHR_CONST_TKFRZ)*(z2-z1)/(t1-t2) + alt_indx(c) = k_frz + else + alt(c)=0._r8 + alt_indx(c) = 0 + endif + endif + + + ! if appropriate, update maximum annual active layer thickness + if (alt(c) > altmax(c)) then + altmax(c) = alt(c) + altmax_indx(c) = alt_indx(c) + endif + + end do + + end associate + + end subroutine alt_calc + +end module CNCLM_ActiveLayerMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 new file mode 100644 index 000000000..46bd13bc5 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -0,0 +1,78 @@ +module CNCLM_CNDVType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing routines to drive the annual dynamic vegetation + ! that works with CN, reset related variables, + ! and initialize/reset time invariant variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use clm_varctl , only : use_cndv, iulog + + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_dgvs_type + + ! DGVM state variables structure + type, public :: dgvs_type + real(r8), pointer, public :: agdd_patch (:) ! patch accumulated growing degree days above 5 + real(r8), pointer, public :: agddtw_patch (:) ! patch accumulated growing degree days above twmax + real(r8), pointer, public :: agdd20_patch (:) ! patch 20-yr running mean of agdd + real(r8), pointer, public :: tmomin20_patch (:) ! patch 20-yr running mean of tmomin + logical , pointer, public :: present_patch (:) ! patch whether PATCH present in patch + logical , pointer, public :: pftmayexist_patch (:) ! patch if .false. then exclude seasonal decid patches from tropics + real(r8), pointer, public :: nind_patch (:) ! patch number of individuals (#/m**2) + real(r8), pointer, public :: lm_ind_patch (:) ! patch individual leaf mass + real(r8), pointer, public :: lai_ind_patch (:) ! patch LAI per individual + real(r8), pointer, public :: fpcinc_patch (:) ! patch foliar projective cover increment (fraction) + real(r8), pointer, public :: fpcgrid_patch (:) ! patch foliar projective cover on gridcell (fraction) + real(r8), pointer, public :: fpcgridold_patch (:) ! patch last yr's fpcgrid + real(r8), pointer, public :: crownarea_patch (:) ! patch area that each individual tree takes up (m^2) + real(r8), pointer, public :: greffic_patch (:) + real(r8), pointer, public :: heatstress_patch (:) + + end type dgvs_type + type(dgvs_type), public, target, save :: dgvs_inst + +contains + +!------------------------------------------------------ + subroutine init_dgvs_type(bounds, this) + + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(solarabs_type), intent(inout):: this + + !LOCAL + integer, intent(in) :: begp, endp + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + allocate(this%agdd_patch (begp:endp)) ; this%agdd_patch (:) = nan + allocate(this%agddtw_patch (begp:endp)) ; this%agddtw_patch (:) = nan + allocate(this%agdd20_patch (begp:endp)) ; this%agdd20_patch (:) = nan + allocate(this%tmomin20_patch (begp:endp)) ; this%tmomin20_patch (:) = nan + allocate(this%present_patch (begp:endp)) ; this%present_patch (:) = .false. + allocate(this%pftmayexist_patch (begp:endp)) ; this%pftmayexist_patch (:) = .true. + allocate(this%nind_patch (begp:endp)) ; this%nind_patch (:) = nan + allocate(this%lm_ind_patch (begp:endp)) ; this%lm_ind_patch (:) = nan + allocate(this%lai_ind_patch (begp:endp)) ; this%lai_ind_patch (:) = nan + allocate(this%fpcinc_patch (begp:endp)) ; this%fpcinc_patch (:) = nan + allocate(this%fpcgrid_patch (begp:endp)) ; this%fpcgrid_patch (:) = nan + allocate(this%fpcgridold_patch (begp:endp)) ; this%fpcgridold_patch (:) = nan + allocate(this%crownarea_patch (begp:endp)) ; this%crownarea_patch (:) = nan + allocate(this%greffic_patch (begp:endp)) ; this%greffic_patch (:) = nan + allocate(this%heatstress_patch (begp:endp)) ; this%heatstress_patch (:) = nan + + end subroutine init_dgvs_type + +end module CNCLM_CNDVType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 7fe00375f..95d699374 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -1,6 +1,6 @@ module CNCLM_CanopyStateType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varpar , only : nlevcan, nvegwcs, numpft, num_zon, num_veg, & var_col, var_pft use clm_varcon , only : spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 new file mode 100644 index 000000000..f8b790c00 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -0,0 +1,145 @@ +module CNCLM_ColumnType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Column data type allocation and initialization + ! -------------------------------------------------------- + ! column types can have values of + ! -------------------------------------------------------- + ! 1 => (istsoil) soil (vegetated or bare soil) + ! 2 => (istcrop) crop (only for crop configuration) + ! 3 => (UNUSED) (formerly non-multiple elevation class land ice; currently unused) + ! 4 => (istice_mec) land ice (multiple elevation classes) + ! 5 => (istdlak) deep lake + ! 6 => (istwet) wetland + ! 71 => (icol_roof) urban roof + ! 72 => (icol_sunwall) urban sunwall + ! 73 => (icol_shadewall) urban shadewall + ! 74 => (icol_road_imperv) urban impervious road + ! 75 => (icol_road_perv) urban pervious road + + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + use clm_varcon , only : ispval + use clm_varctl , only : use_fates + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevmaxurbgrnd + + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_column_type + + type, public :: column_type + ! g/l/c/p hierarchy, local g/l/c/p cells only + integer , pointer :: landunit (:) ! index into landunit level quantities + real(r8), pointer :: wtlunit (:) ! weight (relative to landunit) + integer , pointer :: gridcell (:) ! index into gridcell level quantities + real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell) + integer , pointer :: patchi (:) ! beginning patch index for each column + integer , pointer :: patchf (:) ! ending patch index for each column + integer , pointer :: npatches (:) ! number of patches for each column + + ! topological mapping functionality + integer , pointer :: itype (:) ! column type (after init, should only be modified via update_itype routine) + integer , pointer :: lun_itype (:) ! landunit type (col%lun_itype(ci) is the same as lun%itype(col%landunit(ci)), but is often a more convenient way to access this type + logical , pointer :: active (:) ! true=>do computations on this column + logical , pointer :: type_is_dynamic (:) ! true=>itype can change throughout the run + + ! topography + ! TODO(wjs, 2016-04-05) Probably move these things into topoMod + real(r8), pointer :: micro_sigma (:) ! microtopography pdf sigma (m) + real(r8), pointer :: topo_slope (:) ! gridcell topographic slope + real(r8), pointer :: topo_std (:) ! gridcell elevation standard deviation + + ! vertical levels + integer , pointer :: snl (:) ! number of snow layers + real(r8), pointer :: dz (:,:) ! layer thickness (m) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: z (:,:) ! layer depth (m) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: zi (:,:) ! interface level below a "z" level (m) (-nlevsno+0:nlevgrnd) + real(r8), pointer :: zii (:) ! convective boundary height [m] + real(r8), pointer :: dz_lake (:,:) ! lake layer thickness (m) (1:nlevlak) + real(r8), pointer :: z_lake (:,:) ! layer depth for lake (m) + real(r8), pointer :: lakedepth (:) ! variable lake depth (m) + integer , pointer :: nbedrock (:) ! variable depth to bedrock index + + ! other column characteristics + logical , pointer :: hydrologically_active(:) ! true if this column is a hydrologically active type + logical , pointer :: urbpoi (:) ! true=>urban point + + + ! levgrnd_class gives the class in which each layer falls. This is relevant for + ! columns where there are 2 or more fundamentally different layer types. For + ! example, this distinguishes between soil and bedrock layers. The particular value + ! assigned to each class is irrelevant; the important thing is that different + ! classes (e.g., soil vs. bedrock) have different values of levgrnd_class. + ! + ! levgrnd_class = ispval indicates that the given layer is completely unused for + ! this column (i.e., this column doesn't use the full nlevgrnd layers). + integer , pointer :: levgrnd_class (:,:) ! class in which each layer falls (1:nlevgrnd) + + end type column_type + type(column_type), public, target, save :: col + + contains + +!----------------------------------------------------- + subroutine init_column_type(bounds, this) + + ! !ARGUMENTS: + implicit none + + ! INPUT: + type(bounds_type), intent(in) :: bounds + type(column_type), intent(inout) :: this + + ! LOCAL: + + integer :: begc, endc + + !---------------------------- + + begc = bounds%begc ; endc = bounds%endc + + ! The following is set in initGridCellsMod + allocate(this%gridcell (begc:endc)) ; this%gridcell (:) = ispval + allocate(this%wtgcell (begc:endc)) ; this%wtgcell (:) = nan + allocate(this%landunit (begc:endc)) ; this%landunit (:) = ispval + allocate(this%wtlunit (begc:endc)) ; this%wtlunit (:) = nan + allocate(this%patchi (begc:endc)) ; this%patchi (:) = ispval + allocate(this%patchf (begc:endc)) ; this%patchf (:) = ispval + allocate(this%npatches (begc:endc)) ; this%npatches (:) = ispval + allocate(this%itype (begc:endc)) ; this%itype (:) = ispval + allocate(this%lun_itype (begc:endc)) ; this%lun_itype (:) = ispval + allocate(this%active (begc:endc)) ; this%active (:) = .false. + allocate(this%type_is_dynamic(begc:endc)) ; this%type_is_dynamic(:) = .false. + + ! The following is set in initVerticalMod + allocate(this%snl (begc:endc)) ; this%snl (:) = ispval !* cannot be averaged up + allocate(this%dz (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%dz (:,:) = nan + allocate(this%z (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%z (:,:) = nan + allocate(this%zi (begc:endc,-nlevsno+0:nlevmaxurbgrnd)) ; this%zi (:,:) = nan + allocate(this%zii (begc:endc)) ; this%zii (:) = nan + allocate(this%lakedepth (begc:endc)) ; this%lakedepth (:) = spval + allocate(this%dz_lake (begc:endc,nlevlak)) ; this%dz_lake (:,:) = nan + allocate(this%z_lake (begc:endc,nlevlak)) ; this%z_lake (:,:) = nan + + allocate(this%nbedrock (begc:endc)) ; this%nbedrock (:) = ispval + allocate(this%levgrnd_class(begc:endc,nlevmaxurbgrnd)) ; this%levgrnd_class(:,:) = ispval + allocate(this%micro_sigma (begc:endc)) ; this%micro_sigma (:) = nan + allocate(this%topo_slope (begc:endc)) ; this%topo_slope (:) = nan + allocate(this%topo_std (begc:endc)) ; this%topo_std (:) = nan + + allocate(this%hydrologically_active(begc:endc)) ; this%hydrologically_active(:) = .false. + allocate(this%urbpoi (begc:endc)) ; this%urbpoi (:) = .false. + + + this%nbedrock(:) = 1 !jkolassa: set this to 1, since we only have one soil layer + this%dz(:) = 1. ! jkolassa: setting this to 1, since we only have 1 soil layer for now; consistent with previous versions of CNCLM + + end subroutine init_column_type +end module CNCLM_ColumnType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 new file mode 100644 index 000000000..53bed1dc3 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 @@ -0,0 +1,70 @@ +module CNCLM_CropType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 + use clm_varcon , only : spval + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_crop_type + + type, public :: crop_type + + ! Note that cropplant and harvdate could be 2D to facilitate rotation + integer , pointer :: nyrs_crop_active_patch (:) ! number of years this crop patch has been active (0 for non-crop patches) + logical , pointer :: croplive_patch (:) ! patch Flag, true if planted, not harvested + logical , pointer :: cropplant_patch (:) ! patch Flag, true if planted + integer , pointer :: harvdate_patch (:) ! patch harvest date + real(r8), pointer :: fertnitro_patch (:) ! patch fertilizer nitrogen + real(r8), pointer :: gddplant_patch (:) ! patch accum gdd past planting date for crop (ddays) + real(r8), pointer :: gddtsoi_patch (:) ! patch growing degree-days from planting (top two soil layers) (ddays) + real(r8), pointer :: vf_patch (:) ! patch vernalization factor for cereal + real(r8), pointer :: cphase_patch (:) ! phenology phase + real(r8), pointer :: latbaset_patch (:) ! Latitude vary baset for gddplant (degree C) + character(len=20) :: baset_mapping + real(r8) :: baset_latvary_intercept + real(r8) :: baset_latvary_slope + + end type crop_type + type(crop_type), public, target, save :: crop_inst + +contains + +!------------------------------------------------------ + subroutine init_crop_type(bounds, this) + + ! !DESCRIPTION: + ! Initialize CTSM crop type needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(crop_type), intent(inout):: this + + !LOCAL + integer, intent(in) :: begp, endp + + !--------------------------------- + + begp = bounds%begp ; endp = bounds%endp + + allocate(this%nyrs_crop_active_patch(begp:endp)) ; this%nyrs_crop_active_patch(:) = 0 + allocate(this%croplive_patch (begp:endp)) ; this%croplive_patch (:) = .false. + allocate(this%cropplant_patch(begp:endp)) ; this%cropplant_patch(:) = .false. + allocate(this%harvdate_patch (begp:endp)) ; this%harvdate_patch (:) = huge(1) + allocate(this%fertnitro_patch (begp:endp)) ; this%fertnitro_patch (:) = spval + allocate(this%gddplant_patch (begp:endp)) ; this%gddplant_patch (:) = spval + allocate(this%gddtsoi_patch (begp:endp)) ; this%gddtsoi_patch (:) = spval + allocate(this%vf_patch (begp:endp)) ; this%vf_patch (:) = 0.0_r8 + allocate(this%cphase_patch (begp:endp)) ; this%cphase_patch (:) = 0.0_r8 + allocate(this%latbaset_patch (begp:endp)) ; this%latbaset_patch (:) = spval + + end subroutine init_crop_type + +end module CNCLM_CropType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index 3688058b3..b6e25f369 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -95,6 +95,8 @@ subroutine init_gridcell_type(bounds, nch, cnpft, lats, lons, this) this%latdeg (nc) = lats(nc) / MAPL_PI * 180. this%londeg (nc) = lons(nc) / MAPL_PI * 180. this%dayl (nc) = cnpft (nc,1,1, 28) ! variable used to be patch level and is now gridcell level; assume all patches in gridcell have same day length + + this%prev_dayl(nc) = this%dayl(nc) ! following previous Catchment-CN versions, daylength of previous day is initialized as daylength of current day; changed for subsequent time steps in CN_DriverMod end do ! nc end subroutine init_gridcell_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 new file mode 100644 index 000000000..46e7ccf61 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -0,0 +1,108 @@ +module LandunitType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Landunit data type allocation + ! -------------------------------------------------------- + ! landunits types can have values of (see landunit_varcon.F90) + ! -------------------------------------------------------- + ! 1 => (istsoil) soil (vegetated or bare soil landunit) + ! 2 => (istcrop) crop (only for crop configuration) + ! 3 => (UNUSED) (formerly non-multiple elevation class land ice; currently unused) + ! 4 => (istice_mec) land ice (multiple elevation classes) + ! 5 => (istdlak) deep lake + ! 6 => (istwet) wetland + ! 7 => (isturb_tbd) urban tbd + ! 8 => (isturb_hd) urban hd + ! 9 => (isturb_md) urban md + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varcon , only : ispval + + ! !PUBLIC TYPES: + implicit none + save + private + ! + type, public :: landunit_type + ! g/l/c/p hierarchy, local g/l/c/p cells only + integer , pointer :: gridcell (:) ! index into gridcell level quantities + real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell) + integer , pointer :: coli (:) ! beginning column index per landunit + integer , pointer :: colf (:) ! ending column index for each landunit + integer , pointer :: ncolumns (:) ! number of columns for each landunit + integer , pointer :: patchi (:) ! beginning patch index for each landunit + integer , pointer :: patchf (:) ! ending patch index for each landunit + integer , pointer :: npatches (:) ! number of patches for each landunit + + ! topological mapping functionality + integer , pointer :: itype (:) ! landunit type + logical , pointer :: ifspecial (:) ! true=>landunit is not vegetated + logical , pointer :: lakpoi (:) ! true=>lake point + logical , pointer :: urbpoi (:) ! true=>urban point + logical , pointer :: glcmecpoi (:) ! true=>glacier_mec point + logical , pointer :: active (:) ! true=>do computations on this landunit + + ! urban properties + real(r8), pointer :: canyon_hwr (:) ! urban landunit canyon height to width ratio (-) + real(r8), pointer :: wtroad_perv (:) ! urban landunit weight of pervious road column to total road (-) + real(r8), pointer :: wtlunit_roof (:) ! weight of roof with respect to urban landunit (-) + real(r8), pointer :: ht_roof (:) ! height of urban roof (m) + real(r8), pointer :: z_0_town (:) ! urban landunit momentum roughness length (m) + real(r8), pointer :: z_d_town (:) ! urban landunit displacement height (m) + + end type landunit_type + ! Singleton instance of the landunitType + type(landunit_type), public, target :: lun !geomorphological landunits + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine init_landunit_type(bounds, this) + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Allocate memory and initialize to signalling NaN to require + ! data be properly initialized somewhere else. + ! + ! !ARGUMENTS: + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(landunit_type), intent(inout) :: this + + !LOCAL + integer :: begl,endl + !------------------------------------------------------------------------ + + begl = bounds%begl ; endl = bounds%endl + + ! The following is set in InitGridCellsMod + allocate(this%gridcell (begl:endl)); this%gridcell (:) = ispval + allocate(this%wtgcell (begl:endl)); this%wtgcell (:) = nan + allocate(this%coli (begl:endl)); this%coli (:) = ispval + allocate(this%colf (begl:endl)); this%colf (:) = ispval + allocate(this%ncolumns (begl:endl)); this%ncolumns (:) = ispval + allocate(this%patchi (begl:endl)); this%patchi (:) = ispval + allocate(this%patchf (begl:endl)); this%patchf (:) = ispval + allocate(this%npatches (begl:endl)); this%npatches (:) = ispval + allocate(this%itype (begl:endl)); this%itype (:) = ispval + allocate(this%ifspecial (begl:endl)); this%ifspecial (:) = .false. + allocate(this%lakpoi (begl:endl)); this%lakpoi (:) = .false. + allocate(this%urbpoi (begl:endl)); this%urbpoi (:) = .false. + allocate(this%glcmecpoi (begl:endl)); this%glcmecpoi (:) = .false. + + ! The following is initialized in routine setActive in module reweightMod + allocate(this%active (begl:endl)) + + ! The following is set in routine urbanparams_inst%Init in module UrbanParamsType + allocate(this%canyon_hwr (begl:endl)); this%canyon_hwr (:) = nan + allocate(this%wtroad_perv (begl:endl)); this%wtroad_perv (:) = nan + allocate(this%ht_roof (begl:endl)); this%ht_roof (:) = nan + allocate(this%wtlunit_roof (begl:endl)); this%wtlunit_roof (:) = nan + allocate(this%z_0_town (begl:endl)); this%z_0_town (:) = nan + allocate(this%z_d_town (begl:endl)); this%z_d_town (:) = nan + + end subroutine init_landunit_type + +end module LandunitType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_NamelistParameters.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_NamelistParameters.F90 new file mode 100644 index 000000000..0aff1f827 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_NamelistParameters.F90 @@ -0,0 +1,5 @@ +module CNCLM_NamelistParameters + + + +end module CNCLM_NamelistParameters diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 new file mode 100644 index 000000000..64224ba45 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -0,0 +1,132 @@ +module CNCLM_PatchType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + use clm_varcon , only : ispval + use clm_varctl , only : use_fates + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Patch data type allocation + ! -------------------------------------------------------- + ! patch types can have values of + ! -------------------------------------------------------- + ! 0 => not_vegetated + ! 1 => needleleaf_evergreen_temperate_tree + ! 2 => needleleaf_evergreen_boreal_tree + ! 3 => needleleaf_deciduous_boreal_tree + ! 4 => broadleaf_evergreen_tropical_tree + ! 5 => broadleaf_evergreen_temperate_tree + ! 6 => broadleaf_deciduous_tropical_tree + ! 7 => broadleaf_deciduous_temperate_tree + ! 8 => broadleaf_deciduous_boreal_tree + ! 9 => broadleaf_evergreen_shrub + ! 10 => broadleaf_deciduous_temperate_shrub + ! 11 => broadleaf_deciduous_boreal_shrub + ! 12 => c3_arctic_grass + ! 13 => c3_non-arctic_grass + ! 14 => c4_grass + ! 15 => c3_crop + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_patch_type + + type, public :: patch_type + + ! g/l/c/p hierarchy, local g/l/c/p cells only + integer , pointer :: column (:) ! index into column level quantities + real(r8), pointer :: wtcol (:) ! weight (relative to column) + integer , pointer :: landunit (:) ! index into landunit level quantities + real(r8), pointer :: wtlunit (:) ! weight (relative to landunit) + integer , pointer :: gridcell (:) ! index into gridcell level quantities + real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell) + + ! Non-ED only + integer , pointer :: itype (:) ! patch vegetation + integer , pointer :: mxy (:) ! m index for laixy(i,j,m),etc. (undefined for special landunits) + logical , pointer :: active (:) ! true=>do computations on this patch + + ! fates only + logical , pointer :: is_veg (:) ! This is an ACTIVE fates patch + logical , pointer :: is_bareground (:) + real(r8), pointer :: wt_ed (:) !TODO mv ? can this be removed + + + logical, pointer :: is_fates (:) ! true for patch vector space reserved + ! for FATES. + ! this is static and is true for all + ! patches within fates jurisdiction + ! including patches which are not currently + ! associated with a FATES linked-list patch + end type patch_type + type(patch_type), public, target, save :: patch + + contains + +!---------------------------------------------------- + subroutine init_patch_type(bounds, nch, ityp, this) + + ! !ARGUMENTS: + implicit none + + ! INPUT: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + type(patch_type), intent(inout) :: this + + ! LOCAL: + integer :: begp,endp + integer :: np, nc, nz, p, nv, n + !------------------------------- + + allocate(this%gridcell (begp:endp)); this%gridcell (:) = ispval + allocate(this%wtgcell (begp:endp)); this%wtgcell (:) = nan + + allocate(this%landunit (begp:endp)); this%landunit (:) = ispval + allocate(this%wtlunit (begp:endp)); this%wtlunit (:) = nan + + allocate(this%column (begp:endp)); this%column (:) = ispval + allocate(this%wtcol (begp:endp)); this%wtcol (:) = nan + + allocate(this%mxy (begp:endp)); this%mxy (:) = ispval + allocate(this%active (begp:endp)); this%active (:) = .false. + + ! TODO (MV, 10-17-14): The following must be commented out because + ! currently the logic checking if patch%itype(p) is not equal to noveg + ! is used in RootBiogeophysMod in zeng2001_rootfr- a filter is not used + ! in that routine - which would elimate this problem + + allocate(this%itype (begp:endp)); this%itype (:) = ispval + + allocate(this%is_fates (begp:endp)); this%is_fates (:) = .false. + + if (use_fates) then + allocate(this%is_veg (begp:endp)); this%is_veg (:) = .false. + allocate(this%is_bareground (begp:endp)); this%is_bareground (:) = .false. + allocate(this%wt_ed (begp:endp)); this%wt_ed (:) = nan + end if + + ! initialize values from restart files + + np = 0 + n = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + n = n + 1 + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + this%itype(np) = ityp(nc,nz,nz) + this%column(np) = n + end do ! nv + end do ! p + end do ! nz + end do ! nc + end subroutine init_patch_type +end module CNCLM_PatchType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotoParamsType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotoParamsType.F90 deleted file mode 100644 index c39da9bf8..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotoParamsType.F90 +++ /dev/null @@ -1,233 +0,0 @@ -module CNCLM_PhotoParamsType - - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use MAPL_ExceptionHandling - use clm_varctl , only : use_hydrstress - use clm_varpar , only : mxpft, nvegwcs - use nanMod , only : nan - - ! !PUBLIC TYPES: - implicit none - save - -! -! !PUBLIC MEMBER FUNCTIONS: - public :: init_photo_params_type - - type :: photo_params_type - real(r8) :: act25 ! Rubisco activity at 25 C (umol CO2/gRubisco/s) - real(r8) :: fnr ! Mass ratio of total Rubisco molecular mass to nitrogen in Rubisco (gRubisco/gN in Rubisco) - real(r8) :: cp25_yr2000 ! CO2 compensation point at 25°C at present day O2 (mol/mol) - real(r8) :: kc25_coef ! Michaelis-Menten const. at 25°C for CO2 (unitless) - real(r8) :: ko25_coef ! Michaelis-Menten const. at 25°C for O2 (unitless) - real(r8) :: fnps ! Fraction of light absorbed by non-photosynthetic pigment (unitless) - real(r8) :: theta_psii ! Empirical curvature parameter for electron transport rate (unitless) - real(r8) :: theta_ip ! Empirical curvature parameter for ap photosynthesis co-limitation (unitless) - real(r8) :: vcmaxha ! Activation energy for vcmax (J/mol) - real(r8) :: jmaxha ! Activation energy for jmax (J/mol) - real(r8) :: tpuha ! Activation energy for tpu (J/mol) - real(r8) :: lmrha ! Activation energy for lmr (J/mol) - real(r8) :: kcha ! Activation energy for kc (J/mol) - real(r8) :: koha ! Activation energy for ko (J/mol) - real(r8) :: cpha ! Activation energy for cp (J/mol) - real(r8) :: vcmaxhd ! Deactivation energy for vcmax (J/mol) - real(r8) :: jmaxhd ! Deactivation energy for jmax (J/mol) - real(r8) :: tpuhd ! Deactivation energy for tpu (J/mol) - real(r8) :: lmrhd ! Deactivation energy for lmr (J/mol) - real(r8) :: lmrse ! Entropy term for lmr (J/mol/K) - real(r8) :: tpu25ratio ! Ratio of tpu25top to vcmax25top (unitless) - real(r8) :: kp25ratio ! Ratio of kp25top to vcmax25top (unitless) - real(r8) :: vcmaxse_sf ! Scale factor for vcmaxse (unitless) - real(r8) :: jmaxse_sf ! Scale factor for jmaxse (unitless) - real(r8) :: tpuse_sf ! Scale factor for tpuse (unitless) - real(r8) :: jmax25top_sf ! Scale factor for jmax25top (unitless) - real(r8), allocatable, public :: krmax (:) - real(r8), allocatable, private :: kmax (:,:) - real(r8), allocatable, private :: psi50 (:,:) - real(r8), allocatable, private :: ck (:,:) - real(r8), allocatable, private :: lmr_intercept_atkin(:) - real(r8), allocatable, private :: theta_cj (:) ! Empirical curvature parameter for ac, aj photosynthesis co-limitation (unitless) - - end type photo_params_type - type(photo_params_type), public, target, save :: params_inst - -contains - -!-------------------------------------- - subroutine init_photo_params_type(this) - - ! !DESCRIPTION: - ! Initialize CTSM photosynthesis parameters needed for calling CTSM routines - ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made - ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect - ! - ! !ARGUMENTS: - implicit none - - type(photo_params_type), intent(inout):: this - - character(300) :: paramfile - integer :: ierr, clm_varid - - real(r8), allocatable, dimension(:) :: read_tmp_1 - real(r8), allocatable, dimension(:,:) :: read_tmp_2 - real(r8) :: read_tmp_3 - !--------------------------------------------------- - - allocate( read_tmp_1 (0:mxpft)) - allocate( read_tmp_2 (0:mxpft,nvegwcs)) - - - - allocate( this%krmax (0:mxpft) ) ; this%krmax(:) = nan - allocate( this%theta_cj (0:mxpft) ) ; this%theta_cj(:) = nan - allocate( this%kmax (0:mxpft,nvegwcs) ) ; this%kmax(:,:) = nan - allocate( this%psi50 (0:mxpft,nvegwcs) ) ; this%psi50(:,:) = nan - allocate( this%ck (0:mxpft,nvegwcs) ) ; this%ck(:,:) = nan - - if ( use_hydrstress .and. nvegwcs /= 4 )then - _ASSERT(.FALSE.,'Error:: the Plant Hydraulics Stress methodology is for the spacA function is hardcoded for nvegwcs==4') - end if - - ! jkolassa, Dec 2021: read in parameters from CLM parameter file - ! TO DO: pass parameter file through rc files rather than hardcoding name here - - paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' - ierr = NF90_OPEN(trim(paramfile),NF90_NOWRITE,ncid) - if (ierr/=0) then - _ASSERT(.FALSE.,'Error:: the Plant Hydraulics Stress methodology is for the spacA function is hardcoded for nvegwcs==4') - end if - - ierr = NF90_INQ_VARID(ncid,'krmax',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%krmax(:) = read_tmp_1(0:mxpft) - - ierr = NF90_INQ_VARID(ncid,'lmr_intercept_atkin',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%lmr_intercept_atkin(:) = read_tmp_1(0:mxpft) - - ierr = NF90_INQ_VARID(ncid,'theta_cj',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%theta_cj(:) = read_tmp_1(0:mxpft) - - ierr = NF90_INQ_VARID(ncid,'kmax',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_2) - this%theta_cj(:,:) = read_tmp_2(0:mxpft,:) - - ierr = NF90_INQ_VARID(ncid,'psi50',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_2) - this%psi50(:,:) = read_tmp_2(0:mxpft,:) - - ierr = NF90_INQ_VARID(ncid,'ck',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_2) - this%theta_ck(:,:) = read_tmp_2(0:mxpft,:) - - ierr = NF90_INQ_VARID(ncid,'ko25_coef',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%ko25_coef = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'kc25_coef',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%kc25_coef = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'cp25_yr2000',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%cp25_yr2000 = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'act25',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%act25 = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'fnr',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%fnr = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'fnps',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%fnps = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'theta_psii',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%theta_psii = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'theta_ip',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%theta_ip = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'vcmaxha',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%vcmaxha = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'jmaxha',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%jmaxha = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'tpuha',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%tpuha = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'lmrha',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%lmrha = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'kcha',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%kcha = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'koha',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%koha = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'cpha',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%cpha = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'vcmaxhd',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%vcmaxhd = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'jmaxhd',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%jmaxhd = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'tpuhd',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%tpuhd = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'lmrhd',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%lmrhd = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'lmrse',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%lmrse = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'tpu25ratio',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%tpu25ratio = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'kp25ratio',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%kp25ratio = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'vcmaxse_sf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%vcmaxse_sf = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'jmaxse_sf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%jmaxse_sf = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'tpuse_sf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%tpuse_sf = read_tmp_3 - - ierr = NF90_INQ_VARID(ncid,'jmax25top_sf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%jmax25top_sf = read_tmp_3 - - ierr = NF90_CLOSE(ncid) - - end subroutine init_photo_params_type - -end module CNCLM_PhotoParamsType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 index 512f9ad86..f1ae2bd26 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 @@ -12,6 +12,48 @@ module CNCLM_PhotosynsType implicit none save + ! !PUBLIC VARIABLES: + + type :: photo_params_type + real(r8) :: act25 ! Rubisco activity at 25 C (umol CO2/gRubisco/s) + real(r8) :: fnr ! Mass ratio of total Rubisco molecular mass to nitrogen in Rubisco (gRubisco/gN in Rubisco) + real(r8) :: cp25_yr2000 ! CO2 compensation point at 25°C at present day O2 (mol/mol) + real(r8) :: kc25_coef ! Michaelis-Menten const. at 25°C for CO2 (unitless) + real(r8) :: ko25_coef ! Michaelis-Menten const. at 25°C for O2 (unitless) + real(r8) :: fnps ! Fraction of light absorbed by non-photosynthetic pigment (unitless) + real(r8) :: theta_psii ! Empirical curvature parameter for electron transport rate (unitless) + real(r8) :: theta_ip ! Empirical curvature parameter for ap photosynthesis co-limitation (unitless) + real(r8) :: vcmaxha ! Activation energy for vcmax (J/mol) + real(r8) :: jmaxha ! Activation energy for jmax (J/mol) + real(r8) :: tpuha ! Activation energy for tpu (J/mol) + real(r8) :: lmrha ! Activation energy for lmr (J/mol) + real(r8) :: kcha ! Activation energy for kc (J/mol) + real(r8) :: koha ! Activation energy for ko (J/mol) + real(r8) :: cpha ! Activation energy for cp (J/mol) + real(r8) :: vcmaxhd ! Deactivation energy for vcmax (J/mol) + real(r8) :: jmaxhd ! Deactivation energy for jmax (J/mol) + real(r8) :: tpuhd ! Deactivation energy for tpu (J/mol) + real(r8) :: lmrhd ! Deactivation energy for lmr (J/mol) + real(r8) :: lmrse ! Entropy term for lmr (J/mol/K) + real(r8) :: tpu25ratio ! Ratio of tpu25top to vcmax25top (unitless) + real(r8) :: kp25ratio ! Ratio of kp25top to vcmax25top (unitless) + real(r8) :: vcmaxse_sf ! Scale factor for vcmaxse (unitless) + real(r8) :: jmaxse_sf ! Scale factor for jmaxse (unitless) + real(r8) :: tpuse_sf ! Scale factor for tpuse (unitless) + real(r8) :: jmax25top_sf ! Scale factor for jmax25top (unitless) + real(r8), allocatable, public :: krmax (:) + real(r8), allocatable, private :: kmax (:,:) + real(r8), allocatable, private :: psi50 (:,:) + real(r8), allocatable, private :: ck (:,:) + real(r8), allocatable, private :: lmr_intercept_atkin(:) + real(r8), allocatable, private :: theta_cj (:) ! Empirical curvature parameter for ac, aj photosynthesis co-limitation (unitless) + contains + procedure, private :: allocParams + end type photo_params_type + ! + type(photo_params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod + + ! ! !PUBLIC MEMBER FUNCTIONS: public :: init_photosyns_type @@ -253,6 +295,7 @@ subroutine init_photosyns_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_ allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 endif + this%rootstem_acc = .false. ! jkolassa, Jun 2022: Default for CTSM5.1 this%light_inhibit = .true. ! jkolassa, Feb 2022: This is the default value for CTSM5.1; we could in the future control this through resource files @@ -287,4 +330,224 @@ subroutine init_photosyns_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_ end subroutine init_photosyns_type + !----------------------------------------------------------------------- + subroutine allocParams ( this ) + ! + implicit none + + ! !ARGUMENTS: + class(photo_params_type) :: this + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'allocParams' + !----------------------------------------------------------------------- + + ! allocate parameters + + allocate( this%krmax (0:mxpft) ) ; this%krmax(:) = nan + allocate( this%theta_cj (0:mxpft) ) ; this%theta_cj(:) = nan + allocate( this%kmax (0:mxpft,nvegwcs) ) ; this%kmax(:,:) = nan + allocate( this%psi50 (0:mxpft,nvegwcs) ) ; this%psi50(:,:) = nan + allocate( this%ck (0:mxpft,nvegwcs) ) ; this%ck(:,:) = nan + + if ( use_hydrstress .and. nvegwcs /= 4 )then + call endrun(msg='Error:: the Plant Hydraulics Stress methodology is for the spacA function is hardcoded for nvegwcs==4' & + //errMsg(__FILE__, __LINE__)) + end if + + end subroutine allocParams + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine readParams ( this, ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + use paramUtilMod, only: readNcdioScalar + implicit none + + ! !ARGUMENTS: + class(photosyns_type) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'readParams' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: temp1d(0:mxpft) ! temporary to read in parameter + real(r8) :: temp2d(0:mxpft,nvegwcs) ! temporary to read in parameter + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + + call params_inst%allocParams() + + tString = "krmax" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%krmax=temp1d + tString = "lmr_intercept_atkin" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%lmr_intercept_atkin=temp1d + tString = "theta_cj" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%theta_cj=temp1d + tString = "kmax" + call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%kmax=temp2d + tString = "psi50" + call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%psi50=temp2d + tString = "ck" + call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%ck=temp2d + + ! read in the scalar parameters + + ! Michaelis-Menten constant at 25°C for O2 (unitless) + tString = "ko25_coef" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%ko25_coef=tempr + ! Michaelis-Menten constant at 25°C for CO2 (unitless) + tString = "kc25_coef" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%kc25_coef=tempr + ! CO2 compensation point at 25°C at present day O2 levels + tString = "cp25_yr2000" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cp25_yr2000=tempr + ! Rubisco activity at 25 C (umol CO2/gRubisco/s) + tString = "act25" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%act25=tempr + ! Mass ratio of total Rubisco molecular mass to nitrogen in Rubisco (gRubisco/gN(Rubisco)) + tString = "fnr" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%fnr=tempr + ! Fraction of light absorbed by non-photosynthetic pigment (unitless) + tString = "fnps" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%fnps=tempr + ! Empirical curvature parameter for electron transport rate (unitless) + tString = "theta_psii" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%theta_psii=tempr + ! Empirical curvature parameter for ap photosynthesis co-limitation (unitless) + tString = "theta_ip" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%theta_ip=tempr + ! Activation energy for vcmax (J/mol) + tString = "vcmaxha" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%vcmaxha=tempr + ! Activation energy for jmax (J/mol) + tString = "jmaxha" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%jmaxha=tempr + ! Activation energy for tpu (J/mol) + tString = "tpuha" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tpuha=tempr + ! Activation energy for lmr (J/mol) + tString = "lmrha" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%lmrha=tempr + ! Activation energy for kc (J/mol) + tString = "kcha" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%kcha=tempr + ! Activation energy for ko (J/mol) + tString = "koha" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%koha=tempr + ! Activation energy for cp (J/mol) + tString = "cpha" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cpha=tempr + ! Deactivation energy for vcmax (J/mol) + tString = "vcmaxhd" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%vcmaxhd=tempr + ! Deactivation energy for jmax (J/mol) + tString = "jmaxhd" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%jmaxhd=tempr + ! Deactivation energy for tpu (J/mol) + tString = "tpuhd" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tpuhd=tempr + ! Deactivation energy for lmr (J/mol) + tString = "lmrhd" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%lmrhd=tempr + ! Entropy term for lmr (J/mol/K) + tString = "lmrse" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%lmrse=tempr + ! Ratio of tpu25top to vcmax25top (unitless) + tString = "tpu25ratio" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tpu25ratio=tempr + ! Ratio of kp25top to vcmax25top (unitless) + tString = "kp25ratio" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%kp25ratio=tempr + ! Scale factor for vcmaxse (unitless) + tString = "vcmaxse_sf" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%vcmaxse_sf=tempr + ! Scale factor for jmaxse (unitless) + tString = "jmaxse_sf" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%jmaxse_sf=tempr + ! Scale factor for tpuse (unitless) + tString = "tpuse_sf" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tpuse_sf=tempr + ! Scale factor for jmax25top (unitless) + tString = "jmax25top_sf" + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%jmax25top_sf=tempr + + end subroutine readParams + + + !------------------------------------------------------------------------ + + + end module CNCLM_PhotosynsType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index b7d02810a..16c137b45 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -140,7 +140,7 @@ subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) ! jkolassa May 2022: accounting for fact that pool order in CNCOL is different from CTSM this%decomp_cpools_col (n,np) = cncol(nc,nz,decomp_cpool_cncol_index(np)) this%decomp_cpools_col_1m (n,np) = cncol(nc,nz,decomp_cpool_cncol_index(np)) - ! jkolassa May 2022: loop has to be added below of we add more biogeochemical (or soil) layers + ! jkolassa May 2022: loop has to be added below if we add more biogeochemical (or soil) layers this%decomp_cpools_vr_col (n,1,np) cncol(nc,nz,decomp_cpool_cncol_index(np)) end do !np diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 new file mode 100644 index 000000000..950a6f875 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 @@ -0,0 +1,147 @@ +module CNCLM_SoilBiogeochemDecompCascadeConType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 + use nanMod , only : nan + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevdecomp, & + ndecomp_cascade_outtransitions + use clm_varctl , only : use_soil_matrixcn, iulog + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_decomp_cascade_constants + + type, public :: decomp_cascade_type + + character(len=8) , pointer :: cascade_step_name(:) ! name of transition + integer , pointer :: cascade_donor_pool(:) ! which pool is C taken from for a given decomposition step + integer , pointer :: cascade_receiver_pool(:) ! which pool is C added to for a given decomposition step + + !-- properties of each decomposing pool + logical , pointer :: floating_cn_ratio_decomp_pools(:) ! TRUE => pool has fixed C:N ratio + character(len=8) , pointer :: decomp_pool_name_restart(:) ! name of pool for restart files + character(len=8) , pointer :: decomp_pool_name_history(:) ! name of pool for history files + character(len=20) , pointer :: decomp_pool_name_long(:) ! name of pool for netcdf long names + character(len=8) , pointer :: decomp_pool_name_short(:) ! name of pool for netcdf short names + logical , pointer :: is_litter(:) ! TRUE => pool is a litter pool + logical , pointer :: is_soil(:) ! TRUE => pool is a soil pool + logical , pointer :: is_cwd(:) ! TRUE => pool is a cwd pool + real(r8) , pointer :: initial_cn_ratio(:) ! c:n ratio for initialization of pools + real(r8) , pointer :: initial_stock(:) ! initial concentration for seeding at spinup + real(r8) :: initial_stock_soildepth ! soil depth for initial concentration for seeding at spinup + logical , pointer :: is_metabolic(:) ! TRUE => pool is metabolic material + logical , pointer :: is_cellulose(:) ! TRUE => pool is cellulose + logical , pointer :: is_lignin(:) ! TRUE => pool is lignin + real(r8) , pointer :: spinup_factor(:) ! factor by which to scale AD and relevant processes by + + integer,pointer :: spm_tranlist_a(:,:) ! Prescribed subscripts to map 2D variables (transitions,soil layer) to 1D sparse matrix format in a_ma_vr and na_ma_vr + integer,pointer :: A_i(:) ! Prescribed row number of all elements in a_ma_vr + integer,pointer :: A_j(:) ! Prescribed column number of all elements in na_ma_vr + integer,pointer :: tri_i(:) ! Prescribed row index of all entries in AVsoil + integer,pointer :: tri_j(:) ! Prescribed column index of all entries in AVsoil + integer,pointer :: all_i(:) ! Prescribed row index of all entries in AKallsoilc, AKallsoiln, AKXcacc, and AKXnacc + integer,pointer :: all_j(:) ! Prescribed column index of all entries in AKallsoilc, AKallsoiln, AKXcacc, and AKXnacc + + integer,pointer :: list_V_AKVfire (:) ! Saves mapping indices from V to (A*K+V-Kfire) in the addition subroutine SPMP_ABC + integer,pointer :: list_AK_AKVfire(:) ! Saves mapping indices from A*K to (A*K+V-Kfire) in the addition subroutine SPMP_ABC + integer,pointer :: list_fire_AKVfire(:) ! Saves mapping indices from Kfire to (A*K+V-Kfire) in the addition subroutine SPMP_ABC + integer,pointer :: list_AK_AKV (:) ! Saves mapping indices from A*K to (A*K+V) in the addition subroutine SPMP_AB + integer,pointer :: list_V_AKV (:) ! Saves mapping indices from V to (A*K+V) in the addition subroutine SPMP_AB + integer,pointer :: list_Asoilc (:) ! Saves mapping indices from a_ma_vr to AKsoilc + integer,pointer :: list_Asoiln (:) ! Saves mapping indices from na_ma_vr to AKsoiln + + integer, public :: n_all_entries ! Number of all entries in AKallsoilc, AKallsoiln, AKXcacc, and AKXnacc + integer, public :: Ntrans_setup ! Number of horizontal transfers between soil and litter pools + integer, public :: Ntri_setup ! Number of non-zero entries in AVsoil + + end type decomp_cascade_type + + integer, public, parameter :: i_atm = 0 ! for terminal pools (i.e. 100% respiration) (only used for CN not for BGC) + type(decomp_cascade_type), public :: decomp_cascade_con + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine init_decomp_cascade_constants( use_century_decomp ) + ! + ! !DESCRIPTION: + ! Initialize decomposition cascade state + !------------------------------------------------------------------------ + ! !ARGUMENTS: + logical, intent(IN) :: use_century_decomp + ! !LOGAL VARIABLES: + integer :: ibeg ! Beginning index for allocated arrays + !------------------------------------- + + if ( use_century_decomp ) then + ibeg = 1 + else + ibeg = i_atm + end if + !-- properties of each pathway along decomposition cascade + allocate(decomp_cascade_con%cascade_step_name(1:ndecomp_cascade_transitions)) + allocate(decomp_cascade_con%cascade_donor_pool(1:ndecomp_cascade_transitions)) + allocate(decomp_cascade_con%cascade_receiver_pool(1:ndecomp_cascade_transitions)) + + + !-- properties of each decomposing pool + allocate(decomp_cascade_con%floating_cn_ratio_decomp_pools(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%decomp_pool_name_restart(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%decomp_pool_name_history(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%decomp_pool_name_long(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%decomp_pool_name_short(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%is_litter(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%is_soil(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%is_cwd(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%initial_cn_ratio(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%initial_stock(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%is_metabolic(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%is_cellulose(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%is_lignin(ibeg:ndecomp_pools)) + allocate(decomp_cascade_con%spinup_factor(1:ndecomp_pools)) + + if(use_soil_matrixcn)then + allocate(decomp_cascade_con%spm_tranlist_a(1:nlevdecomp,1:ndecomp_cascade_transitions)); decomp_cascade_con%spm_tranlist_a(:,:) = -9999 + allocate(decomp_cascade_con%A_i(1:(ndecomp_cascade_transitions-ndecomp_cascade_outtransitions)*nlevdecomp));decomp_cascade_con%A_i(:) = -9999 + allocate(decomp_cascade_con%A_j(1:(ndecomp_cascade_transitions-ndecomp_cascade_outtransitions)*nlevdecomp));decomp_cascade_con%A_j(:) = -9999 + allocate(decomp_cascade_con%tri_i(1:(3*nlevdecomp-2)*(ndecomp_pools-1))); decomp_cascade_con%tri_i(:) = -9999 + allocate(decomp_cascade_con%tri_j(1:(3*nlevdecomp-2)*(ndecomp_pools-1))); decomp_cascade_con%tri_j(:) = -9999 + end if + + !-- properties of each pathway along decomposition cascade + decomp_cascade_con%cascade_step_name(1:ndecomp_cascade_transitions) = '' + decomp_cascade_con%cascade_donor_pool(1:ndecomp_cascade_transitions) = 0 + decomp_cascade_con%cascade_receiver_pool(1:ndecomp_cascade_transitions) = 0 + + + !-- first initialization of properties of each decomposing pool + decomp_cascade_con%floating_cn_ratio_decomp_pools(ibeg:ndecomp_pools) = .false. + decomp_cascade_con%decomp_pool_name_history(ibeg:ndecomp_pools) = '' + decomp_cascade_con%decomp_pool_name_restart(ibeg:ndecomp_pools) = '' + decomp_cascade_con%decomp_pool_name_long(ibeg:ndecomp_pools) = '' + decomp_cascade_con%decomp_pool_name_short(ibeg:ndecomp_pools) = '' + decomp_cascade_con%is_litter(ibeg:ndecomp_pools) = .false. + decomp_cascade_con%is_soil(ibeg:ndecomp_pools) = .false. + decomp_cascade_con%is_cwd(ibeg:ndecomp_pools) = .false. + decomp_cascade_con%initial_cn_ratio(ibeg:ndecomp_pools) = nan + decomp_cascade_con%initial_stock(ibeg:ndecomp_pools) = nan + decomp_cascade_con%initial_stock_soildepth = 0.3 + decomp_cascade_con%is_metabolic(ibeg:ndecomp_pools) = .false. + decomp_cascade_con%is_cellulose(ibeg:ndecomp_pools) = .false. + decomp_cascade_con%is_lignin(ibeg:ndecomp_pools) = .false. + decomp_cascade_con%spinup_factor(1:ndecomp_pools) = nan + + if(use_soil_matrixcn)then + decomp_cascade_con%Ntrans_setup = (ndecomp_cascade_transitions-ndecomp_cascade_outtransitions)*nlevdecomp + decomp_cascade_con%Ntri_setup = (3*nlevdecomp-2)*(ndecomp_pools - 1) !exclude one cwd + else + decomp_cascade_con%Ntrans_setup = -9999 + decomp_cascade_con%Ntri_setup = -9999 + end if + end subroutine init_decomp_cascade_constants + +end module CNCLM_SoilBiogeochemDecompCascadeConType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index 7d8fae6af..5dcc091f6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SoilBiogeochemNitrogenStateType + module CNCLM_SoilBiogeochemNitrogenStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -155,7 +155,7 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) ! jkolassa May 2022: accounting for fact that pool order in CNCOL is different from CTSM this%decomp_npools_col (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) this%decomp_npools_col_1m (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) - ! jkolassa May 2022: loop has to be added below of we add more biogeochemical (or soil) layers + ! jkolassa May 2022: loop has to be added below if we add more biogeochemical (or soil) layers this%decomp_npools_vr_col (n,1,np) cncol(nc,nz,decomp_npool_cncol_index(np)) end do !np end do !nz diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 8a2d00763..e09a7c7ab 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -41,7 +41,7 @@ module CNCLM_SoilBiogeochemStateType contains !--------------------------------------- - subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this) + subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, this) ! ! !ARGUMENTS: @@ -49,17 +49,30 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this) type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of tiles real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + logical, optional, intent(in) :: cn5_cold_start type(soilbiogeochem_state_type), intent(inout) :: this ! ! !LOCAL VARIABLES: integer :: begp, endp integer :: begc,endc integer :: n, nc, nz, n, np + logical :: cold_start = .false. !----------------------------------- begp = bounds%begp; endp= bounds%endp begc = bounds%begc; endc= bounds%endc + ! check whether a cn5_cold_start option was set and change cold_start accordingly + if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + cold_start = .true. + end if + + ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + (size(cnpft,3).ne.var_pft))) + _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') + end if + allocate(this%leaf_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%leaf_prof_patch (:,:) = spval allocate(this%froot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%froot_prof_patch (:,:) = spval allocate(this%croot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%croot_prof_patch (:,:) = spval @@ -87,6 +100,22 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this) this%fpg_col(n) = cncol(nc,nz, 30) this%fpi_col(n) = cncol(nc,nz, 35) + + + ! "new" variables: introduced in CNCLM50 + if (cold_start==.false.) then + do nw = 1,nlevdecomp_full + this%nfixation_prof_col(n,nw) = cnpft(nc,nz,nv, XXX+(nw-1)) + this%ndep_prof_col(n,nw) = cnpft(nc,nz,nv, XXX+(nw-1)) + end do + elseif (cold_start) then + this%nfixation_prof_col(n,1:nlevdecomp_full) = 0._r8 + this%ndep_prof_col(n,1:nlevdecomp_full) = 0._r8 + else + _ASSERT(.FALSE.,'missing CNCLM50_cold_start setting') + end if + + do np = 1,nlevdecomp_full this%fpi_vr_col(n,np) = cncol(nc,nz, 35) end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 new file mode 100644 index 000000000..df026e5ae --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 @@ -0,0 +1,222 @@ +module CNCLM_ch4Mod + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use CNCLM_decompMod , only : bounds_type + use clm_varcon , only : spval + use clm_varpar , only : nlevgrnd, ngases + + ! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_ch4_type + + type, public :: ch4_type + real(r8), pointer, private :: ch4_prod_depth_sat_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_prod_depth_unsat_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_prod_depth_lake_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_oxid_depth_sat_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_oxid_depth_unsat_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_oxid_depth_lake_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_aere_depth_sat_col (:,:) ! col CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_aere_depth_unsat_col (:,:) ! col CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_tran_depth_sat_col (:,:) ! col CH4 loss rate via transpiration in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_tran_depth_unsat_col (:,:) ! col CH4 loss rate via transpiration in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_ebul_depth_sat_col (:,:) ! col CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_ebul_depth_unsat_col (:,:) ! col CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_ebul_total_sat_col (:) ! col Total col CH4 ebullition (mol/m2/s) + real(r8), pointer, private :: ch4_ebul_total_unsat_col (:) ! col Total col CH4 ebullition (mol/m2/s) + real(r8), pointer, private :: ch4_surf_aere_sat_col (:) ! col CH4 aerenchyma flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: ch4_surf_aere_unsat_col (:) ! col CH4 aerenchyma flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: ch4_surf_ebul_sat_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: ch4_surf_ebul_unsat_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: ch4_surf_ebul_lake_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: co2_aere_depth_sat_col (:,:) ! col CO2 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: co2_aere_depth_unsat_col (:,:) ! col CO2 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: o2_oxid_depth_sat_col (:,:) ! col O2 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: o2_oxid_depth_unsat_col (:,:) ! col O2 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: o2_aere_depth_sat_col (:,:) ! col O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: o2_aere_depth_unsat_col (:,:) ! col O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: co2_decomp_depth_sat_col (:,:) ! col CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s) + real(r8), pointer, private :: co2_decomp_depth_unsat_col (:,:) ! col CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s) + real(r8), pointer, private :: co2_oxid_depth_sat_col (:,:) ! col CO2 production rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: co2_oxid_depth_unsat_col (:,:) ! col CO2 production rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: conc_o2_lake_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, private :: conc_ch4_sat_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, private :: conc_ch4_unsat_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, private :: conc_ch4_lake_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, private :: ch4_surf_diff_sat_col (:) ! col CH4 surface flux (mol/m2/s) + real(r8), pointer, private :: ch4_surf_diff_unsat_col (:) ! col CH4 surface flux (mol/m2/s) + real(r8), pointer, private :: ch4_surf_diff_lake_col (:) ! col CH4 surface flux (mol/m2/s) + real(r8), pointer, private :: ch4_dfsat_flux_col (:) ! col CH4 flux to atm due to decreasing fsat (kg C/m^2/s) [+] + + real(r8), pointer, private :: zwt_ch4_unsat_col (:) ! col depth of water table for unsaturated fraction (m) + real(r8), pointer, private :: lake_soilc_col (:,:) ! col total soil organic matter found in level (g C / m^3) (nlevsoi) + real(r8), pointer, private :: totcolch4_col (:) ! col total methane found in soil col (g C / m^2) + real(r8), pointer, private :: totcolch4_grc (:) ! grc total methane found in soil col (g C / m^2) + real(r8), pointer, private :: totcolch4_bef_col (:) ! col total methane found in soil col, start of timestep (g C / m^2) + real(r8), pointer, private :: totcolch4_bef_grc (:) ! grc total methane found in soil col, start of timestep (g C / m^2) + real(r8), pointer, private :: annsum_counter_col (:) ! col seconds since last annual accumulator turnover + real(r8), pointer, private :: tempavg_somhr_col (:) ! col temporary average SOM heterotrophic resp. (gC/m2/s) + real(r8), pointer, private :: annavg_somhr_col (:) ! col annual average SOM heterotrophic resp. (gC/m2/s) + real(r8), pointer, private :: tempavg_finrw_col (:) ! col respiration-weighted annual average of finundated + real(r8), pointer, private :: annavg_finrw_col (:) ! col respiration-weighted annual average of finundated + real(r8), pointer, private :: sif_col (:) ! col (unitless) ratio applied to sat. prod. to account for seasonal inundation + real(r8), pointer, private :: ch4stress_unsat_col (:,:) ! col Ratio of methane available to the total per-timestep methane sinks (nlevsoi) + real(r8), pointer, private :: ch4stress_sat_col (:,:) ! col Ratio of methane available to the total per-timestep methane sinks (nlevsoi) + real(r8), pointer, private :: qflx_surf_lag_col (:) ! col time-lagged surface runoff (mm H2O /s) + real(r8), pointer, private :: finundated_lag_col (:) ! col time-lagged fractional inundated area + real(r8), pointer, private :: layer_sat_lag_col (:,:) ! col Lagged saturation status of soil layer in the unsaturated zone (1 = sat) + real(r8), pointer, private :: pH_col (:) ! col pH values for methane production + ! + real(r8), pointer, private :: dyn_ch4bal_adjustments_col (:) ! adjustments to each column made in this timestep via dynamic column area adjustments (only makes sense at the column-level: meaningless if averaged to the gridcell-level) (g C / m^2) + ! + real(r8), pointer, private :: c_atm_grc (:,:) ! grc atmospheric conc of CH4, O2, CO2 (mol/m3) + real(r8), pointer, private :: ch4co2f_grc (:) ! grc CO2 production from CH4 oxidation (g C/m**2/s) + real(r8), pointer, private :: ch4prodg_grc (:) ! grc average CH4 production (g C/m^2/s) + ! + ! for aerenchyma calculations + real(r8), pointer, private :: annavg_agnpp_patch (:) ! patch (gC/m2/s) annual average aboveground NPP + real(r8), pointer, private :: annavg_bgnpp_patch (:) ! patch (gC/m2/s) annual average belowground NPP + real(r8), pointer, private :: tempavg_agnpp_patch (:) ! patch (gC/m2/s) temp. average aboveground NPP + real(r8), pointer, private :: tempavg_bgnpp_patch (:) ! patch (gC/m2/s) temp. average belowground NPP + ! + ! The following variable reports whether this is the first timestep that includes + ! ch4. It is true in the first timestep of the run, and remains true until the + ! methane code is first run - at which point it becomes false, and remains + ! false. This could be a scalar, but scalars cause problems with threading, so we use + ! a column-level array (column-level for convenience, because it is referenced in + ! column-level loops). + logical , pointer, private :: ch4_first_time_grc (:) ! grc whether this is the first time step that includes ch4 + ! + real(r8), pointer, public :: finundated_col (:) ! col fractional inundated area (excluding dedicated wetland cols) + real(r8), pointer, public :: finundated_pre_snow_col (:) ! col fractional inundated area (excluding dedicated wetland cols) before snow + real(r8), pointer, public :: o2stress_unsat_col (:,:) ! col Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + real(r8), pointer, public :: o2stress_sat_col (:,:) ! col Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + real(r8), pointer, public :: conc_o2_sat_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, public :: conc_o2_unsat_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, public :: o2_decomp_depth_sat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + real(r8), pointer, public :: o2_decomp_depth_unsat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + real(r8), pointer, public :: ch4_surf_flux_tot_col (:) ! col CH4 surface flux (to atm) (kg C/m**2/s) + + real(r8), pointer, public :: grnd_ch4_cond_patch (:) ! patch tracer conductance for boundary layer [m/s] + real(r8), pointer, public :: grnd_ch4_cond_col (:) ! col tracer conductance for boundary layer [m/s] +! type(ch4finundatedstream_type), private :: ch4findstream ! ch4 finundated stream data + + end type ch4_type + +type(ch4_type), public, target, save :: ch4_inst + +contains + +!----------------------------------------------------- + subroutine init_ch4_type(bounds, this) + +! !DESCRIPTION: +! Initialize CTSM CH4 type; dummy for now, since we have use_lch4 set to .false. +! +! !ARGUMENTS: + implicit none + + ! INPUT + type(bounds_type), intent(in) :: bounds + type(ch4_type), intent(inout):: this + + ! LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !--------------------------------------------- + + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + + allocate(this%ch4_prod_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_prod_depth_sat_col (:,:) = nan + allocate(this%ch4_prod_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_prod_depth_unsat_col (:,:) = nan + allocate(this%ch4_prod_depth_lake_col (begc:endc,1:nlevgrnd)) ; this%ch4_prod_depth_lake_col (:,:) = nan + allocate(this%ch4_oxid_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_oxid_depth_sat_col (:,:) = nan + allocate(this%ch4_oxid_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_oxid_depth_unsat_col (:,:) = nan + allocate(this%ch4_oxid_depth_lake_col (begc:endc,1:nlevgrnd)) ; this%ch4_oxid_depth_lake_col (:,:) = nan + allocate(this%o2_oxid_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%o2_oxid_depth_sat_col (:,:) = nan + allocate(this%o2_oxid_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2_oxid_depth_unsat_col (:,:) = nan + allocate(this%o2_aere_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%o2_aere_depth_sat_col (:,:) = nan + allocate(this%o2_aere_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2_aere_depth_unsat_col (:,:) = nan + allocate(this%co2_decomp_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%co2_decomp_depth_sat_col (:,:) = nan + allocate(this%co2_decomp_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%co2_decomp_depth_unsat_col (:,:) = nan + allocate(this%co2_oxid_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%co2_oxid_depth_sat_col (:,:) = nan + allocate(this%co2_oxid_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%co2_oxid_depth_unsat_col (:,:) = nan + allocate(this%ch4_aere_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_aere_depth_sat_col (:,:) = nan + allocate(this%ch4_aere_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_aere_depth_unsat_col (:,:) = nan + allocate(this%ch4_tran_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_tran_depth_sat_col (:,:) = nan + allocate(this%ch4_tran_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_tran_depth_unsat_col (:,:) = nan + allocate(this%co2_aere_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%co2_aere_depth_sat_col (:,:) = nan + allocate(this%co2_aere_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%co2_aere_depth_unsat_col (:,:) = nan + allocate(this%ch4_surf_aere_sat_col (begc:endc)) ; this%ch4_surf_aere_sat_col (:) = nan + allocate(this%ch4_surf_aere_unsat_col (begc:endc)) ; this%ch4_surf_aere_unsat_col (:) = nan + allocate(this%ch4_ebul_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_ebul_depth_sat_col (:,:) = nan + allocate(this%ch4_ebul_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_ebul_depth_unsat_col (:,:) = nan + allocate(this%ch4_ebul_total_sat_col (begc:endc)) ; this%ch4_ebul_total_sat_col (:) = nan + allocate(this%ch4_ebul_total_unsat_col (begc:endc)) ; this%ch4_ebul_total_unsat_col (:) = nan + allocate(this%ch4_surf_ebul_sat_col (begc:endc)) ; this%ch4_surf_ebul_sat_col (:) = nan + allocate(this%ch4_surf_ebul_unsat_col (begc:endc)) ; this%ch4_surf_ebul_unsat_col (:) = nan + allocate(this%ch4_surf_ebul_lake_col (begc:endc)) ; this%ch4_surf_ebul_lake_col (:) = nan + allocate(this%conc_ch4_sat_col (begc:endc,1:nlevgrnd)) ; this%conc_ch4_sat_col (:,:) = spval ! detect file input + allocate(this%conc_ch4_unsat_col (begc:endc,1:nlevgrnd)) ; this%conc_ch4_unsat_col (:,:) = spval ! detect file input + allocate(this%conc_ch4_lake_col (begc:endc,1:nlevgrnd)) ; this%conc_ch4_lake_col (:,:) = nan + allocate(this%ch4_surf_diff_sat_col (begc:endc)) ; this%ch4_surf_diff_sat_col (:) = nan + allocate(this%ch4_surf_diff_unsat_col (begc:endc)) ; this%ch4_surf_diff_unsat_col (:) = nan + allocate(this%ch4_surf_diff_lake_col (begc:endc)) ; this%ch4_surf_diff_lake_col (:) = nan + allocate(this%conc_o2_lake_col (begc:endc,1:nlevgrnd)) ; this%conc_o2_lake_col (:,:) = nan + allocate(this%ch4_dfsat_flux_col (begc:endc)) ; this%ch4_dfsat_flux_col (:) = nan + allocate(this%zwt_ch4_unsat_col (begc:endc)) ; this%zwt_ch4_unsat_col (:) = nan + allocate(this%lake_soilc_col (begc:endc,1:nlevgrnd)) ; this%lake_soilc_col (:,:) = spval !first time-step + allocate(this%totcolch4_col (begc:endc)) ; this%totcolch4_col (:) = nan + allocate(this%totcolch4_grc (begg:endg)) ; this%totcolch4_grc (:) = nan + allocate(this%totcolch4_bef_col (begc:endc)) ; this%totcolch4_bef_col (:) = nan + allocate(this%totcolch4_bef_grc (begg:endg)) ; this%totcolch4_bef_grc (:) = nan + allocate(this%annsum_counter_col (begc:endc)) ; this%annsum_counter_col (:) = nan + allocate(this%tempavg_somhr_col (begc:endc)) ; this%tempavg_somhr_col (:) = nan + allocate(this%annavg_somhr_col (begc:endc)) ; this%annavg_somhr_col (:) = nan + allocate(this%tempavg_finrw_col (begc:endc)) ; this%tempavg_finrw_col (:) = nan + allocate(this%annavg_finrw_col (begc:endc)) ; this%annavg_finrw_col (:) = nan + allocate(this%sif_col (begc:endc)) ; this%sif_col (:) = nan + allocate(this%ch4stress_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4stress_unsat_col (:,:) = nan + allocate(this%ch4stress_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4stress_sat_col (:,:) = nan + allocate(this%qflx_surf_lag_col (begc:endc)) ; this%qflx_surf_lag_col (:) = nan + allocate(this%finundated_lag_col (begc:endc)) ; this%finundated_lag_col (:) = nan + allocate(this%layer_sat_lag_col (begc:endc,1:nlevgrnd)) ; this%layer_sat_lag_col (:,:) = nan + allocate(this%pH_col (begc:endc)) ; this%pH_col (:) = nan + allocate(this%ch4_surf_flux_tot_col (begc:endc)) ; this%ch4_surf_flux_tot_col (:) = nan + allocate(this%dyn_ch4bal_adjustments_col (begc:endc)) ; this%dyn_ch4bal_adjustments_col (:) = nan + + allocate(this%c_atm_grc (begg:endg,1:ngases)) ; this%c_atm_grc (:,:) = nan + allocate(this%ch4co2f_grc (begg:endg)) ; this%ch4co2f_grc (:) = nan + allocate(this%ch4prodg_grc (begg:endg)) ; this%ch4prodg_grc (:) = nan + + allocate(this%tempavg_agnpp_patch (begp:endp)) ; this%tempavg_agnpp_patch (:) = nan + allocate(this%tempavg_bgnpp_patch (begp:endp)) ; this%tempavg_bgnpp_patch (:) = nan + allocate(this%annavg_agnpp_patch (begp:endp)) ; this%annavg_agnpp_patch (:) = spval ! To detect first year + allocate(this%annavg_bgnpp_patch (begp:endp)) ; this%annavg_bgnpp_patch (:) = spval ! To detect first year + + allocate(this%ch4_first_time_grc (begg:endg)) ; this%ch4_first_time_grc (:) = .true. + + allocate(this%finundated_col (begc:endc)) ; this%finundated_col (:) = nan + allocate(this%finundated_pre_snow_col (begc:endc)) ; this%finundated_pre_snow_col (:) = nan + allocate(this%o2stress_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2stress_unsat_col (:,:) = nan + allocate(this%o2stress_sat_col (begc:endc,1:nlevgrnd)) ; this%o2stress_sat_col (:,:) = nan + allocate(this%conc_o2_sat_col (begc:endc,1:nlevgrnd)) ; this%conc_o2_sat_col (:,:) = nan + allocate(this%conc_o2_unsat_col (begc:endc,1:nlevgrnd)) ; this%conc_o2_unsat_col (:,:) = nan + allocate(this%o2_decomp_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%o2_decomp_depth_sat_col (:,:) = nan + allocate(this%o2_decomp_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2_decomp_depth_unsat_col (:,:) = nan + + allocate(this%grnd_ch4_cond_patch (begp:endp)) ; this%grnd_ch4_cond_patch (:) = nan + allocate(this%grnd_ch4_cond_col (begc:endc)) ; this%grnd_ch4_cond_col (:) = nan + + + end subroutine init_ch4_type + +end module CNCLM_ch4Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 index cd69e9698..7b4d174ab 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 @@ -34,13 +34,12 @@ subroutine init_bounds(nch, this) ! INPUT: integer, intent(in) :: nch ! number of Catchment tiles type(bounds_type), intent(inout) :: this + !---------------------------------- this%begg = 1 ; this%endg = nch this%begl = 1 ; this%endl = nch this%begc = 1 ; this%endc = nch*NUM_ZON this%begp = 1 ; this%endp = nch*NUM_ZON*(numpft+1) - - - + end subroutine init_bounds end module CNCLM_decompMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index acd6dce42..822b185bb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -3,6 +3,7 @@ module CNCLM_pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan use clm_varpar , only : mxpft, numrad + use clm_varctl , only : use_flexibleCN use netcdf use MAPL_ExceptionHandling @@ -209,6 +210,21 @@ module CNCLM_pftconMod type(pftcon_type), public, target, save :: pftcon + integer, public, parameter :: pftname_len = 40 ! max length of pftname + character(len=pftname_len), public :: pftname(0:mxpft) ! PFT description + + real(r8), public, parameter :: reinickerp = 1.6_r8 ! parameter in allometric equation + real(r8), public, parameter :: dwood = 2.5e5_r8 ! cn wood density (gC/m3); lpj:2.0e5 + real(r8), public, parameter :: allom1 = 100.0_r8 ! parameters in + real(r8), public, parameter :: allom2 = 40.0_r8 ! ...allometric + real(r8), public, parameter :: allom3 = 0.5_r8 ! ...equations + real(r8), public, parameter :: allom1s = 250.0_r8 ! modified for shrubs by + real(r8), public, parameter :: allom2s = 8.0_r8 ! X.D.Z +! root radius, density from Bonan, GMD, 2014 + real(r8), public, parameter :: root_density = 0.31e06_r8 !(g biomass / m3 root) + real(r8), public, parameter :: root_radius = 0.29e-03_r8 !(m) + + contains !-------------------------------- @@ -224,7 +240,7 @@ subroutine init_pftcon_type(this) !LOCAL character(300) :: paramfile - integer :: ierr, clm_varid + integer :: ierr, clm_varid, ncid real(r8), allocatable, dimension(:) :: read_tmp_1 real(r8), allocatable, dimension(:,:) :: read_tmp_2 @@ -382,502 +398,383 @@ subroutine init_pftcon_type(this) ! TO DO: pass parameter file through rc files rather than hardcoding name here paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' - ierr = NF90_OPEN(trim(paramfile),NF90_NOWRITE,ncid) - if (ierr/=0) then - _ASSERT(.FALSE.,'error opening netcdf file') - end if + call ncid%open(trim(paramfile),pFIO_READ, __RC__) + + call ncd_io('pftname',pftname, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'z0mr',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%z0mr(:) = read_tmp_1(0:mxpft) + call ncd_io('z0mr', this%z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'displar',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%displar(:) = read_tmp_1(0:mxpft) + call ncd_io('displar', this%displar, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'dleaf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%dleaf(:) = read_tmp_1(0:mxpft) + call ncd_io('dleaf', this%dleaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'c3psn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%c3psn(:) = read_tmp_1(0:mxpft) + call ncd_io('c3psn', this%c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'rholvis',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%rhol(:,1) = read_tmp_1(0:mxpft) + call ncd_io('rholvis', this%rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'rholnir',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%rhol(:,2) = read_tmp_1(0:mxpft) + call ncd_io('rholnir', this%rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'rhosvis',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%rhos(:,1) = read_tmp_1(0:mxpft) + call ncd_io('rhosvis', this%rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'rhosnir',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%rhos(:,2) = read_tmp_1(0:mxpft) + call ncd_io('rhosnir', this% rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'taulvis',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%taul(:,1) = read_tmp_1(0:mxpft) + call ncd_io('taulvis', this%taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'taulnir',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%taul(:,2) = read_tmp_1(0:mxpft) + call ncd_io('taulnir', this%taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'tausvis',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%taus(:,1) = read_tmp_1(0:mxpft) + call ncd_io('tausvis', this%taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'tausnir',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%taus(:,2) = read_tmp_1(0:mxpft) + call ncd_io('tausnir', this%taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'xl',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%xl(:) = read_tmp_1(0:mxpft) + call ncd_io('xl', this%xl, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'roota_par',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%roota_par(:) = read_tmp_1(0:mxpft) + call ncd_io('roota_par', this%roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'rootb_par',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%rootb_par(:) = read_tmp_1(0:mxpft) + call ncd_io('rootb_par', this%rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'slatop',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%slatop(:) = read_tmp_1(0:mxpft) + call ncd_io('slatop', this%slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'dsladlai',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%dsladlai(:) = read_tmp_1(0:mxpft) + call ncd_io('dsladlai', this%dsladlai, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'leafcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%leafcn(:) = read_tmp_1(0:mxpft) + call ncd_io('leafcn', this%leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'biofuel_harvfrac',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%biofuel_harvfrac(:) = read_tmp_1(0:mxpft) + call ncd_io('biofuel_harvfrac', this%biofuel_harvfrac, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'flnr',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%flnr(:) = read_tmp_1(0:mxpft) + call ncd_io('flnr', this%flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'smpso',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%smpso(:) = read_tmp_1(0:mxpft) + call ncd_io('smpso', this%smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'smpsc',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%smpsc(:) = read_tmp_1(0:mxpft) + call ncd_io('smpsc', this%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fnitr',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fnitr(:) = read_tmp_1(0:mxpft) + call ncd_io('fnitr', this%fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'woody',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%woody(:) = read_tmp_1(0:mxpft) + call ncd_io('woody', this%woody, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'lflitcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%lflitcn(:) = read_tmp_1(0:mxpft) + call ncd_io('lflitcn', this%lflitcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'frootcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%frootcn(:) = read_tmp_1(0:mxpft) + call ncd_io('frootcn', this%frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'livewdcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%livewdcn(:) = read_tmp_1(0:mxpft) + call ncd_io('livewdcn', this%livewdcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'deadwdcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%deadwdcn(:) = read_tmp_1(0:mxpft) + call ncd_io('deadwdcn', this%deadwdcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'grperc',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%grperc(:) = read_tmp_1(0:mxpft) + call ncd_io('grperc', this%grperc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'grpnow',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%grpnow(:) = read_tmp_1(0:mxpft) + call ncd_io('grpnow', this%grpnow, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'froot_leaf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%froot_leaf(:) = read_tmp_1(0:mxpft) + call ncd_io('froot_leaf', this%froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'stem_leaf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%stem_leaf(:) = read_tmp_1(0:mxpft) + call ncd_io('stem_leaf', this%stem_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'croot_stem',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%croot_stem(:) = read_tmp_1(0:mxpft) + call ncd_io('croot_stem', this%croot_stem, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'flivewd',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%flivewd(:) = read_tmp_1(0:mxpft) + call ncd_io('flivewd', this%flivewd, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fcur',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fcur(:) = read_tmp_1(0:mxpft) + call ncd_io('fcur', this%fcur, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fcurdv',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fcurdv(:) = read_tmp_1(0:mxpft) + call ncd_io('fcurdv', this%fcurdv, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'lf_flab',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%lf_flab(:) = read_tmp_1(0:mxpft) + call ncd_io('lf_flab', this%lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'lf_fcel',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%lf_fcel(:) = read_tmp_1(0:mxpft) + call ncd_io('lf_fcel', this%lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'lf_flig',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%lf_flig(:) = read_tmp_1(0:mxpft) + call ncd_io('lf_flig', this%lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fr_flab',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fr_flab(:) = read_tmp_1(0:mxpft) + call ncd_io('fr_flab', this%fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fr_fcel',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fr_fcel(:) = read_tmp_1(0:mxpft) + call ncd_io('fr_fcel', this%fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fr_flig',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fr_flig(:) = read_tmp_1(0:mxpft) + call ncd_io('fr_flig', this%fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'leaf_long',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%leaf_long(:) = read_tmp_1(0:mxpft) + call ncd_io('leaf_long', this%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'evergreen',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%evergreen(:) = read_tmp_1(0:mxpft) + call ncd_io('evergreen', this%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'stress_decid',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%stress_decid(:) = read_tmp_1(0:mxpft) + call ncd_io('stress_decid', this%stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'season_decid',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%season_decid(:) = read_tmp_1(0:mxpft) + call ncd_io('season_decid', this%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'season_decid_temperate',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%z0mr(:) = read_tmp_1(0:mxpft) +!KO + call ncd_io('season_decid_temperate', this%season_decid_temperate, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) +!KO - ierr = NF90_INQ_VARID(ncid,'pftpar20',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pftpar20(:) = read_tmp_1(0:mxpft) + call ncd_io('pftpar20', this%pftpar20, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'pftpar28',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pftpar28(:) = read_tmp_1(0:mxpft) + call ncd_io('pftpar28', this%pftpar28, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'pftpar29',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pftpar29(:) = read_tmp_1(0:mxpft) + call ncd_io('pftpar29', this%pftpar29, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'pftpar30',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pftpar30(:) = read_tmp_1(0:mxpft) + call ncd_io('pftpar30', this%pftpar30, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'pftpar31',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pftpar31(:) = read_tmp_1(0:mxpft) + call ncd_io('pftpar31', this%pftpar31, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'a_fix',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%a_fix(:) = read_tmp_1(0:mxpft) + call ncd_io('a_fix', this%a_fix, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'b_fix',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%b_fix(:) = read_tmp_1(0:mxpft) + call ncd_io('b_fix', this%b_fix, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'c_fix',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%c_fix(:) = read_tmp_1(0:mxpft) + call ncd_io('c_fix', this%c_fix, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'s_fix',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%s_fix(:) = read_tmp_1(0:mxpft) + call ncd_io('s_fix', this%s_fix, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'akc_active',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%akc_active(:) = read_tmp_1(0:mxpft) + call ncd_io('akc_active', this%akc_active, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'akn_active',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%akn_active(:) = read_tmp_1(0:mxpft) + call ncd_io('akn_active', this%akn_active, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'ekc_active',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%ekc_active(:) = read_tmp_1(0:mxpft) + call ncd_io('ekc_active', this%ekc_active, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'ekn_active',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%ekn_active(:) = read_tmp_1(0:mxpft) + call ncd_io('ekn_active', this%ekn_active, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'kc_nonmyc',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%kc_nonmyc(:) = read_tmp_1(0:mxpft) + call ncd_io('kc_nonmyc', this%kc_nonmyc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'kn_nonmyc',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%kn_nonmyc(:) = read_tmp_1(0:mxpft) + call ncd_io('kn_nonmyc', this%kn_nonmyc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'kr_resorb',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%kr_resorb(:) = read_tmp_1(0:mxpft) + call ncd_io('kr_resorb', this%kr_resorb, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'perecm',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%perecm(:) = read_tmp_1(0:mxpft) + call ncd_io('perecm', this%perecm, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fun_cn_flex_a',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fun_cn_flex_a(:) = read_tmp_1(0:mxpft) + call ncd_io('fun_cn_flex_a', this%fun_cn_flex_a, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fun_cn_flex_b',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fun_cn_flex_b(:) = read_tmp_1(0:mxpft) + call ncd_io('fun_cn_flex_b', this%fun_cn_flex_b, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fun_cn_flex_c',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fun_cn_flex_c(:) = read_tmp_1(0:mxpft) + call ncd_io('fun_cn_flex_c', this%fun_cn_flex_c, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'FUN_fracfixers',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%FUN_fracfixers(:) = read_tmp_1(0:mxpft) + call ncd_io('FUN_fracfixers', this%FUN_fracfixers, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'manunitro',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%manunitro(:) = read_tmp_1(0:mxpft) + call ncd_io('manunitro', this%manunitro, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fleafcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fleafcn(:) = read_tmp_1(0:mxpft) + call ncd_io('fleafcn', this%fleafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'ffrootcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%ffrootcn(:) = read_tmp_1(0:mxpft) + call ncd_io('ffrootcn', this%ffrootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fstemcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fstemcn(:) = read_tmp_1(0:mxpft) + call ncd_io('fstemcn', this%fstemcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'rootprof_beta',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_2) - this%rootprof_beta(:,:) = read_tmp_2(0:mxpft,:) + call ncd_io('rootprof_beta', this%rootprof_beta, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'pconv',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pconv(:) = read_tmp_1(0:mxpft) + call ncd_io('pconv', this%pconv, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'pprod10',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pprod10(:) = read_tmp_1(0:mxpft) + call ncd_io('pprod10', this%pprod10, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'pprodharv10',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pprodharv10(:) = read_tmp_1(0:mxpft) + call ncd_io('pprodharv10', this%pprodharv10, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'pprod100',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%pprod100(:) = read_tmp_1(0:mxpft) + call ncd_io('pprod100', this%pprod100, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'graincn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%graincn(:) = read_tmp_1(0:mxpft) + call ncd_io('graincn', this%graincn, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'mxtmp',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%mxtmp(:) = read_tmp_1(0:mxpft) + call ncd_io('mxtmp', this%mxtmp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'baset',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%baset(:) = read_tmp_1(0:mxpft) + call ncd_io('baset', this%baset, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'declfact',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%declfact(:) = read_tmp_1(0:mxpft) + call ncd_io('declfact', this%declfact, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'bfact',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%bfact(:) = read_tmp_1(0:mxpft) + call ncd_io('bfact', this%bfact, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'aleaff',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%aleaff(:) = read_tmp_1(0:mxpft) + call ncd_io('aleaff', this%aleaff, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'arootf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%arootf(:) = read_tmp_1(0:mxpft) + call ncd_io('arootf', this%arootf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'astemf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%astemf(:) = read_tmp_1(0:mxpft) + call ncd_io('astemf', this%astemf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'arooti',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%arooti(:) = read_tmp_1(0:mxpft) + call ncd_io('arooti', this%arooti, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fleafi',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fleafi(:) = read_tmp_1(0:mxpft) + call ncd_io('fleafi', this%fleafi, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'allconsl',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%allconsl(:) = read_tmp_1(0:mxpft) + call ncd_io('allconsl', this%allconsl, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'allconss',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%allconss(:) = read_tmp_1(0:mxpft) + call ncd_io('allconss', this%allconss, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'crop',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%crop(:) = read_tmp_1(0:mxpft) + call ncd_io('crop', this%crop, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'mergetoclmpft',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%mergetoclmpft(:) = read_tmp_3(0:mxpft) + call ncd_io('mergetoclmpft', this%mergetoclmpft, 'read', ncid, readvar=readv) + if ( .not. readv ) then + call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + end if - ierr = NF90_INQ_VARID(ncid,'irrigated',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%irrigated(:) = read_tmp_1(0:mxpft) + call ncd_io('irrigated', this%irrigated, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'ztopmx',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%ztopmx(:) = read_tmp_1(0:mxpft) + call ncd_io('ztopmx', this%ztopmx, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'laimx',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%laimx(:) = read_tmp_1(0:mxpft) + call ncd_io('laimx', this%laimx, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'gddmin',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%gddmin(:) = read_tmp_1(0:mxpft) + call ncd_io('gddmin', this%gddmin, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'hybgdd',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%hybgdd(:) = read_tmp_1(0:mxpft) + call ncd_io('hybgdd', this%hybgdd, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'lfemerg',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%lfemerg(:) = read_tmp_1(0:mxpft) + call ncd_io('lfemerg', this%lfemerg, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'grnfill',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%grnfill(:) = read_tmp_1(0:mxpft) + call ncd_io('grnfill', this%grnfill, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'mbbopt',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%mbbopt(:) = read_tmp_1(0:mxpft) + call ncd_io('mbbopt', this%mbbopt, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'medlynslope',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%medlynslope(:) = read_tmp_1(0:mxpft) + call ncd_io('medlynslope', this%medlynslope, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'medlynintercept',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%medlynintercept(:) = read_tmp_1(0:mxpft) + call ncd_io('medlynintercept', this%medlynintercept, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'mxmat',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%mxmat(:) = read_tmp_3(0:mxpft) + call ncd_io('mxmat', this%mxmat, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'cc_leaf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%cc_leaf(:) = read_tmp_1(0:mxpft) + call ncd_io('cc_leaf', this% cc_leaf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'cc_lstem',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%cc_lstem(:) = read_tmp_1(0:mxpft) + call ncd_io('cc_lstem', this%cc_lstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'cc_dstem',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%cc_dstem(:) = read_tmp_1(0:mxpft) + call ncd_io('cc_dstem', this%cc_dstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'cc_other',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%cc_other(:) = read_tmp_1(0:mxpft) + call ncd_io('cc_other', this%cc_other, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fstemcn',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fstemcn(:) = read_tmp_1(0:mxpft) + call ncd_io('fm_leaf', this% fm_leaf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fm_leaf',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fm_leaf(:) = read_tmp_1(0:mxpft) + call ncd_io('fm_lstem', this%fm_lstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fm_lstem',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fm_lstem(:) = read_tmp_1(0:mxpft) + call ncd_io('fm_dstem', this%fm_dstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fm_dstem',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fm_dstem(:) = read_tmp_1(0:mxpft) + call ncd_io('fm_other', this%fm_other, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fm_other',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fm_other(:) = read_tmp_1(0:mxpft) + call ncd_io('fm_root', this% fm_root, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fm_root',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fm_root(:) = read_tmp_1(0:mxpft) + call ncd_io('fm_lroot', this%fm_lroot, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fm_lroot',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fm_lroot(:) = read_tmp_1(0:mxpft) + call ncd_io('fm_droot', this%fm_droot, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fm_droot',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fm_droot(:) = read_tmp_1(0:mxpft) + call ncd_io('fsr_pft', this% fsr_pft, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fsr_pft',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fsr_pft(:) = read_tmp_1(0:mxpft) + call ncd_io('fd_pft', this% fd_pft, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'fd_pft',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%fd_pft(:) = read_tmp_1(0:mxpft) + call ncd_io('rswf_min', this% rswf_min, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'rswf_min',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%rswf_min(:) = read_tmp_1(0:mxpft) + call ncd_io('rswf_max', this% rswf_max, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('planting_temp', this%planttemp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'rswf_max',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%rswf_max(:) = read_tmp_1(0:mxpft) + call ncd_io('min_planting_temp', this%minplanttemp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'min_planting_temp',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%min_planting_temp(:) = read_tmp_1(0:mxpft) + call ncd_io('min_NH_planting_date', this%mnNHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'min_NH_planting_date',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%min_NH_planting_date(:) = read_tmp_3(0:mxpft) + call ncd_io('min_SH_planting_date', this%mnSHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'min_SH_planting_date',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%min_SH_planting_date(:) = read_tmp_3(0:mxpft) + call ncd_io('max_NH_planting_date', this%mxNHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'max_NH_planting_date',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%max_NH_planting_date(:) = read_tmp_3(0:mxpft) + call ncd_io('max_SH_planting_date', this%mxSHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'max_SH_planting_date',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_3) - this%max_SH_planting_date(:) = read_tmp_3(0:mxpft) do m = 0,mxpft this%dwood(m) = dwood @@ -885,40 +782,28 @@ subroutine init_pftcon_type(this) this%root_density(m) = root_density end do + ! + ! clm 5 nitrogen variables + ! if (use_flexibleCN) then - ierr = NF90_INQ_VARID(ncid,'i_vcad',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%i_vcad(:) = read_tmp_1(0:mxpft) - - ierr = NF90_INQ_VARID(ncid,'s_vcad',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%s_vcad(:) = read_tmp_1(0:mxpft) + call ncd_io('i_vcad', this%i_vcad, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'i_flnr',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%i_flnr(:) = read_tmp_1(0:mxpft) + call ncd_io('s_vcad', this%s_vcad, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_INQ_VARID(ncid,'s_flnr',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%s_flnr(:) = read_tmp_1(0:mxpft) + call ncd_io('i_flnr', this%i_flnr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('s_flnr', this%s_flnr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) end if - if ( use_crop .and. use_dynroot )then - ierr = NF90_INQ_VARID(ncid,'root_dmx',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%root_dmx(:) = read_tmp_1(0:mxpft) - end if - - ierr = NF90_INQ_VARID(ncid,'nstem',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%nstem(:) = read_tmp_1(0:mxpft) - - ierr = NF90_INQ_VARID(ncid,'taper',clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, read_tmp_1) - this%taper(:) = read_tmp_1(0:mxpft) + call ncd_io('nstem',this%nstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('taper',this%taper, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ierr = NF90_CLOSE(ncid) ! jkolassa, Dec 2021: not using biomass heat storage module, so set the following 4 parameters to 0 this%dbh = 0.0_r8 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 new file mode 100644 index 000000000..964e2b05c --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 @@ -0,0 +1,305 @@ +module CNMRespMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding maintenance respiration routines for coupled carbon + ! nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varpar , only : nlevgrnd + use clm_varcon , only : spval + use decompMod , only : bounds_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use pftconMod , only : npcropmin, pftcon + use SoilStateType , only : soilstate_type + use CanopyStateType , only : canopystate_type + use TemperatureType , only : temperature_type + use PhotosynthesisMod , only : photosyns_type + use CNVegcarbonfluxType , only : cnveg_carbonflux_type + use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type + use CNSharedParamsMod , only : CNParamsShareInst + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNMRespReadNML ! Read in namelist (CALL FIRST!) + public :: readParams ! Read in parameters from file + public :: CNMResp ! Apply maintenance respiration + + type, private :: params_type + real(r8) :: br = spval ! base rate for maintenance respiration (gC/gN/s) + real(r8) :: br_root = spval ! base rate for maintenance respiration for roots (gC/gN/s) + end type params_type + + type(params_type), private :: params_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNMRespReadNML( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for CNMResp (MUST BE CALLED BEFORE readParams!!!) + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'CNMRespReadNML' + character(len=*), parameter :: nmlname = 'cnmresp_inparm' + real(r8) :: br_root = spval ! base rate for maintenance respiration for roots (gC/gN/s) + !----------------------------------------------------------------------- + + namelist /cnmresp_inparm/ br_root + + ! Initialize options to default values, in case they are not specified in + ! the namelist + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=cnmresp_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR finding "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (br_root, mpicom) + + params_inst%br_root = br_root + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=cnmresp_inparm) + write(iulog,*) ' ' + end if + + end subroutine CNMRespReadNML + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read parameters (call AFTER CNMRespReadNML!) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + use netcdf + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNMRespParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + integer :: ierr, clm_varid + !----------------------------------------------------------------------- + + tString='br_mr' + ierr = NF90_INQ_VARID(ncid,trim(tString),clm_varid) + ierr = NF90_GET_VAR(ncid, clm_varid, tempr) + + ! call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + ! if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + if ( ierr/=0 ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + + params_inst%br=tempr + + if ( params_inst%br_root == spval ) then + params_inst%br_root = params_inst%br + end if + + end subroutine readParams + + !----------------------------------------------------------------------- + ! FIX(SPM,032414) this shouldn't even be called with fates on. + ! + subroutine CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + canopystate_inst, soilstate_inst, temperature_inst, photosyns_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! + ! !ARGUMENTS: + use clm_varcon , only : tfrz + + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil points in column filter + integer , intent(in) :: filter_soilc(:) ! column filter for soil points + integer , intent(in) :: num_soilp ! number of soil points in patch filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(photosyns_type) , intent(in) :: photosyns_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j ! indices + integer :: fp ! soil filter patch index + integer :: fc ! soil filter column index + real(r8):: br ! base rate (gC/gN/s) + real(r8):: br_root ! root base rate (gC/gN/s) + real(r8):: q10 ! temperature dependence + + real(r8):: tc ! temperature correction, 2m air temp (unitless) + real(r8):: tcsoi(bounds%begc:bounds%endc,nlevgrnd) ! temperature correction by soil layer (unitless) + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + crootfr => soilstate_inst%crootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots for carbon in each soil layer (nlevgrnd) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2 m height surface air temperature (Kelvin) + + t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) + + lmrsun => photosyns_inst%lmrsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf maintenance respiration rate (umol CO2/m**2/s) + lmrsha => photosyns_inst%lmrsha_patch , & ! Input: [real(r8) (:) ] shaded leaf maintenance respiration rate (umol CO2/m**2/s) + rootstem_acc => photosyns_inst%rootstem_acc , & ! Input: [logical ] root and stem acclimation switch + + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + grainn => cnveg_nitrogenstate_inst%grainn_patch , & ! Input: [real(r8) (:) ] (kgN/m2) grain N + + leaf_mr => cnveg_carbonflux_inst%leaf_mr_patch , & ! Output: [real(r8) (:) ] + froot_mr => cnveg_carbonflux_inst%froot_mr_patch , & ! Output: [real(r8) (:) ] + livestem_mr => cnveg_carbonflux_inst%livestem_mr_patch , & ! Output: [real(r8) (:) ] + livecroot_mr => cnveg_carbonflux_inst%livecroot_mr_patch , & ! Output: [real(r8) (:) ] + grain_mr => cnveg_carbonflux_inst%grain_mr_patch & ! Output: [real(r8) (:) ] + + ) + + ! base rate for maintenance respiration is from: + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + ! set constants + br = params_inst%br + br_root = params_inst%br_root + + ! Peter Thornton: 3/13/09 + ! Q10 was originally set to 2.0, an arbitrary choice, but reduced to 1.5 as part of the tuning + ! to improve seasonal cycle of atmospheric CO2 concentration in global + ! simulatoins + Q10 = CNParamsShareInst%Q10 + + ! column loop to calculate temperature factors in each soil layer + do j=1,nlevgrnd + do fc = 1, num_soilc + c = filter_soilc(fc) + + ! calculate temperature corrections for each soil layer, for use in + ! estimating fine root maintenance respiration with depth + tcsoi(c,j) = Q10**((t_soisno(c,j)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8) + end do + end do + + ! patch loop for leaves and live wood + do fp = 1, num_soilp + p = filter_soilp(fp) + + ! calculate maintenance respiration fluxes in + ! gC/m2/s for each of the live plant tissues. + ! Leaf and live wood MR + + tc = Q10**((t_ref2m(p)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8) + + !RF: acclimation of root and stem respiration fluxes + ! n.b. we do not yet know if this is defensible scientifically (awaiting data analysis) + ! turning this on will increase R and decrease productivity in boreal forests, A LOT. :) + + if(rootstem_acc)then + br = br * 10._r8**(-0.00794_r8*((t10(p)-tfrz)-25._r8)) + br_root = br_root * 10._r8**(-0.00794_r8*((t10(p)-tfrz)-25._r8)) + end if + + if (frac_veg_nosno(p) == 1) then + + leaf_mr(p) = lmrsun(p) * laisun(p) * 12.011e-6_r8 + & + lmrsha(p) * laisha(p) * 12.011e-6_r8 + + else !nosno + + leaf_mr(p) = 0._r8 + + end if + + if (woody(ivt(p)) == 1) then + livestem_mr(p) = livestemn(p)*br*tc + livecroot_mr(p) = livecrootn(p)*br_root*tc + else if (ivt(p) >= npcropmin) then + livestem_mr(p) = livestemn(p)*br*tc + grain_mr(p) = grainn(p)*br*tc + end if + end do + + ! soil and patch loop for fine root + + do j = 1,nlevgrnd + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! Fine root MR + ! crootfr(j) sums to 1.0 over all soil layers, and + ! describes the fraction of root mass for carbon that is in each + ! layer. This is used with the layer temperature correction + ! to estimate the total fine root maintenance respiration as a + ! function of temperature and N content. + if(rootstem_acc)then + br_root = br_root * 10._r8**(-0.00794_r8*((t10(p)-tfrz)-25._r8)) + end if + froot_mr(p) = froot_mr(p) + frootn(p)*br_root*tcsoi(c,j)*crootfr(p,j) + + end do + end do + + end associate + + end subroutine CNMResp + +end module CNMRespMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 new file mode 100755 index 000000000..e5a170c95 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 @@ -0,0 +1,3780 @@ +module CNPhenologyMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !MODULE: CNPhenologyMod + ! + ! !DESCRIPTION: + ! Module holding routines used in phenology model for coupled carbon + ! nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_flush + use decompMod , only : bounds_type + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn + use clm_varpar , only : maxveg, nlevdecomp_full + use clm_varctl , only : iulog, use_cndv, use_matrixcn + use clm_varcon , only : tfrz + use abortutils , only : endrun + use CanopyStateType , only : canopystate_type + use CNDVType , only : dgvs_type + use CNVegstateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type + use CNVegnitrogenfluxType , only : cnveg_nitrogenflux_type + use CropType , only : crop_type + use pftconMod , only : pftcon + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use initVerticalMod , only : find_soil_layer_containing_depth + use ColumnType , only : col + use GridcellType , only : grc + use PatchType , only : patch + use atm2lndType , only : atm2lnd_type + use CNVegMatrixMod , only : matrix_update_phc, matrix_update_phn + use CNVegMatrixMod , only : matrix_update_gmc, matrix_update_gmn + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams ! Read parameters + public :: CNPhenologyreadNML ! Read namelist + public :: CNPhenologyInit ! Initialization + public :: CNPhenology ! Update + ! + ! !PRIVATE DATA MEMBERS: + type, private :: params_type + real(r8) :: crit_dayl ! critical day length for senescence + real(r8) :: ndays_on ! number of days to complete leaf onset + real(r8) :: ndays_off ! number of days to complete leaf offset + real(r8) :: fstor2tran ! fraction of storage to move to transfer for each onset + real(r8) :: crit_onset_fdd ! critical number of freezing days to set gdd counter + real(r8) :: crit_onset_swi ! critical number of days > soilpsi_on for onset + real(r8) :: soilpsi_on ! critical soil water potential for leaf onset + real(r8) :: crit_offset_fdd ! critical number of freezing days to initiate offset + real(r8) :: crit_offset_swi ! critical number of water stress days to initiate offset + real(r8) :: soilpsi_off ! critical soil water potential for leaf offset + real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + real(r8) :: phenology_soil_depth ! soil depth used for measuring states for phenology triggers + end type params_type + + type(params_type) :: params_inst + + real(r8) :: dt ! radiation time step delta t (seconds) + real(r8) :: fracday ! dtime as a fraction of day + real(r8) :: crit_dayl ! critical daylength for offset (seconds) + real(r8) :: ndays_on ! number of days to complete onset + real(r8) :: ndays_off ! number of days to complete offset + real(r8) :: fstor2tran ! fraction of storage to move to transfer on each onset + real(r8) :: crit_onset_fdd ! critical number of freezing days + real(r8) :: crit_onset_swi ! water stress days for offset trigger + real(r8) :: soilpsi_on ! water potential for onset trigger (MPa) + real(r8) :: crit_offset_fdd ! critical number of freezing degree days to trigger offset + real(r8) :: crit_offset_swi ! water stress days for offset trigger + real(r8) :: soilpsi_off ! water potential for offset trigger (MPa) + real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + integer :: phenology_soil_layer ! soil layer used for measuring states for phenology triggers + + ! CropPhenology variables and constants + real(r8) :: p1d, p1v ! photoperiod factor constants for crop vernalization + real(r8) :: hti ! cold hardening index threshold for vernalization + real(r8) :: tbase ! base temperature for vernalization + + integer, parameter :: NOT_Planted = 999 ! If not planted yet in year + integer, parameter :: NOT_Harvested = 999 ! If not harvested yet in year + integer, parameter :: inNH = 1 ! Northern Hemisphere + integer, parameter :: inSH = 2 ! Southern Hemisphere + integer, pointer :: inhemi(:) ! Hemisphere that patch is in + + integer, allocatable :: minplantjday(:,:) ! minimum planting julian day + integer, allocatable :: maxplantjday(:,:) ! maximum planting julian day + integer :: jdayyrstart(inSH) ! julian day of start of year + + logical,parameter :: matrixcheck_ph = .True. ! Matrix check + logical,parameter :: acc_ph = .False. ! Another matrix check + + real(r8), private :: initial_seed_at_planting = 3._r8 ! Initial seed at planting + logical, private :: min_crtical_dayl_depends_on_lat = .false. ! If critical day-length for onset depends on latitude + logical, private :: onset_thresh_depends_on_veg = .false. ! If onset threshold depends on vegetation type + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNPhenologyReadNML( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for CNPhenology + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'CNPhenologyReadNML' + character(len=*), parameter :: nmlname = 'cnphenology' + !----------------------------------------------------------------------- + namelist /cnphenology/ initial_seed_at_planting, onset_thresh_depends_on_veg, & + min_crtical_dayl_depends_on_lat + + ! Initialize options to default values, in case they are not specified in + ! the namelist + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=cnphenology, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (initial_seed_at_planting, mpicom) + call shr_mpi_bcast (onset_thresh_depends_on_veg, mpicom) + call shr_mpi_bcast (min_crtical_dayl_depends_on_lat, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=cnphenology) + write(iulog,*) ' ' + end if + + + !----------------------------------------------------------------------- + + end subroutine CNPhenologyReadNML + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! + ! !USES: + use ncdio_pio , only: file_desc_t + use paramUtilMod , only : readNcdioScalar + + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'readParams_CNPhenology' + !----------------------------------------------------------------------- + + call readNcdioScalar(ncid, 'crit_dayl', subname, params_inst%crit_dayl) + call readNcdioScalar(ncid, 'ndays_on', subname, params_inst%ndays_on) + call readNcdioScalar(ncid, 'ndays_off', subname, params_inst%ndays_off) + call readNcdioScalar(ncid, 'fstor2tran', subname, params_inst%fstor2tran) + call readNcdioScalar(ncid, 'crit_onset_fdd', subname, params_inst%crit_onset_fdd) + call readNcdioScalar(ncid, 'crit_onset_swi', subname, params_inst%crit_onset_swi) + call readNcdioScalar(ncid, 'soilpsi_on', subname, params_inst%soilpsi_on) + call readNcdioScalar(ncid, 'crit_offset_fdd', subname, params_inst%crit_offset_fdd) + call readNcdioScalar(ncid, 'crit_offset_swi', subname, params_inst%crit_offset_swi) + call readNcdioScalar(ncid, 'soilpsi_off', subname, params_inst%soilpsi_off) + call readNcdioScalar(ncid, 'lwtop_ann', subname, params_inst%lwtop) + call readNcdioScalar(ncid, 'phenology_soil_depth', subname, params_inst%phenology_soil_depth) + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, num_pcropp, filter_pcropp, & + doalb, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, crop_inst, & + canopystate_inst, soilstate_inst, dgvs_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + leaf_prof_patch, froot_prof_patch, phase) + ! !USES: + use CNSharedParamsMod, only: use_fun + ! + ! !DESCRIPTION: + ! Dynamic phenology routine for coupled carbon-nitrogen code (CN) + ! 1. grass phenology + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter + integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches + logical , intent(in) :: doalb ! true if time for sfc albedo calc + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(crop_type) , intent(inout) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + integer , intent(in) :: phase + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + + ! each of the following phenology type routines includes a filter + ! to operate only on the relevant patches + + + if ( phase == 1 ) then + call CNPhenologyClimate(num_soilp, filter_soilp, num_pcropp, filter_pcropp, & + temperature_inst, cnveg_state_inst, crop_inst) + + call CNEvergreenPhenology(num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNSeasonDecidPhenology(num_soilp, filter_soilp, & + temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, dgvs_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNStressDecidPhenology(num_soilp, filter_soilp, & + soilstate_inst, temperature_inst, atm2lnd_inst, wateratm2lndbulk_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + if (doalb .and. num_pcropp > 0 ) then + call CropPhenology(num_pcropp, filter_pcropp, & + waterdiagnosticbulk_inst, temperature_inst, crop_inst, canopystate_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst) + end if + else if ( phase == 2 ) then + ! the same onset and offset routines are called regardless of + ! phenology type - they depend only on onset_flag, offset_flag, bglfr, and bgtr + + call CNOnsetGrowth(num_soilp, filter_soilp, & + cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNOffsetLitterfall(num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNBackgroundLitterfall(num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNLivewoodTurnover(num_soilp, filter_soilp, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNCropHarvestToProductPools(bounds, num_soilp, filter_soilp, num_soilc, filter_soilc, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + ! gather all patch-level litterfall fluxes to the column for litter C and N inputs + + call CNLitterToColumn(bounds, num_soilc, filter_soilc, & + cnveg_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full), & + froot_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full)) + else + call endrun( 'bad phase' ) + end if + + end subroutine CNPhenology + + !----------------------------------------------------------------------- + subroutine CNPhenologyInit(bounds) + ! + ! !DESCRIPTION: + ! Initialization of CNPhenology. Must be called after time-manager is + ! initialized, and after pftcon file is read in. + ! + ! !USES: + use clm_time_manager, only: get_step_size_real + use clm_varctl , only: use_crop + use clm_varcon , only: secspday + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + !------------------------------------------------------------------------ + + ! + ! Get time-step and what fraction of a day it is + ! + dt = get_step_size_real() + fracday = dt/secspday + + ! set constants for CNSeasonDecidPhenology + ! (critical daylength from Biome-BGC, v4.1.2) + crit_dayl=params_inst%crit_dayl + + ! Set constants for CNSeasonDecidPhenology and CNStressDecidPhenology + ndays_on=params_inst%ndays_on + ndays_off=params_inst%ndays_off + + ! set transfer parameters + fstor2tran=params_inst%fstor2tran + + call find_soil_layer_containing_depth( & + depth = params_inst%phenology_soil_depth, & + layer = phenology_soil_layer) + + ! ----------------------------------------- + ! Constants for CNStressDecidPhenology + ! ----------------------------------------- + + ! onset parameters + crit_onset_fdd=params_inst%crit_onset_fdd + ! critical onset gdd now being calculated as a function of annual + ! average 2m temp. + ! crit_onset_gdd = 150.0 ! c3 grass value + ! crit_onset_gdd = 1000.0 ! c4 grass value + crit_onset_swi=params_inst%crit_onset_swi + soilpsi_on=params_inst%soilpsi_on + + ! offset parameters + crit_offset_fdd=params_inst%crit_offset_fdd + crit_offset_swi=params_inst%crit_offset_swi + soilpsi_off=params_inst%soilpsi_off + + ! ----------------------------------------- + ! Constants for CNLivewoodTurnover + ! ----------------------------------------- + + ! set the global parameter for livewood turnover rate + ! define as an annual fraction (0.7), and convert to fraction per second + lwtop=params_inst%lwtop/31536000.0_r8 !annual fraction converted to per second + + ! ----------------------------------------- + ! Call any subroutine specific initialization routines + ! ----------------------------------------- + + if ( use_crop ) call CropPhenologyInit(bounds) + + end subroutine CNPhenologyInit + + !----------------------------------------------------------------------- + subroutine CNPhenologyClimate (num_soilp, filter_soilp, num_pcropp, filter_pcropp, & + temperature_inst, cnveg_state_inst, crop_inst) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! + ! !USES: + use clm_time_manager , only : get_days_per_year + use clm_time_manager , only : get_curr_date, is_first_step + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prognostic crops in filter + integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches + type(temperature_type) , intent(inout) :: temperature_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(inout) :: crop_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8) :: dayspyr ! days per year (days) + integer :: kyr ! current year + integer :: kmo ! month of year (1, ..., 12) + integer :: kda ! day of month (1, ..., 31) + integer :: mcsec ! seconds of day (0, ..., seconds/day) + real(r8), parameter :: yravg = 20.0_r8 ! length of years to average for gdd + real(r8), parameter :: yravgm1 = yravg-1.0_r8 ! minus 1 of above + !----------------------------------------------------------------------- + + associate( & + nyrs_crop_active => crop_inst%nyrs_crop_active_patch, & ! InOut: [integer (:) ] number of years this crop patch has been active + + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2m air temperature (K) + gdd0 => temperature_inst%gdd0_patch , & ! Output: [real(r8) (:) ] growing deg. days base 0 deg C (ddays) + gdd8 => temperature_inst%gdd8_patch , & ! Output: [real(r8) (:) ] " " " " 8 " " " + gdd10 => temperature_inst%gdd10_patch , & ! Output: [real(r8) (:) ] " " " " 10 " " " + gdd020 => temperature_inst%gdd020_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd0 (ddays) + gdd820 => temperature_inst%gdd820_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd8 (ddays) + gdd1020 => temperature_inst%gdd1020_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd10 (ddays) + + tempavg_t2m => cnveg_state_inst%tempavg_t2m_patch & ! Output: [real(r8) (:) ] temp. avg 2m air temperature (K) + ) + + ! set time steps + + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + tempavg_t2m(p) = tempavg_t2m(p) + t_ref2m(p) * (fracday/dayspyr) + end do + + ! + ! The following crop related steps are done here rather than CropPhenology + ! so that they will be completed each time-step rather than with doalb. + ! + ! The following lines come from ibis's climate.f + stats.f + ! gdd SUMMATIONS ARE RELATIVE TO THE PLANTING DATE (see subr. updateAccFlds) + + if (num_pcropp > 0) then + ! get time-related info + call get_curr_date(kyr, kmo, kda, mcsec) + end if + + do fp = 1,num_pcropp + p = filter_pcropp(fp) + if (kmo == 1 .and. kda == 1 .and. nyrs_crop_active(p) == 0) then ! YR 1: + gdd020(p) = 0._r8 ! set gdd..20 variables to 0 + gdd820(p) = 0._r8 ! and crops will not be planted + gdd1020(p) = 0._r8 + end if + if (kmo == 1 .and. kda == 1 .and. mcsec == 0) then ! <-- END of EVERY YR: + if (nyrs_crop_active(p) == 1) then ! <-- END of YR 1 + gdd020(p) = gdd0(p) ! <-- END of YR 1 + gdd820(p) = gdd8(p) ! <-- END of YR 1 + gdd1020(p) = gdd10(p) ! <-- END of YR 1 + end if ! <-- END of YR 1 + gdd020(p) = (yravgm1* gdd020(p) + gdd0(p)) / yravg ! gdd..20 must be long term avgs + gdd820(p) = (yravgm1* gdd820(p) + gdd8(p)) / yravg ! so ignore results for yrs 1 & 2 + gdd1020(p) = (yravgm1* gdd1020(p) + gdd10(p)) / yravg + end if + end do + + end associate + + end subroutine CNPhenologyClimate + + !----------------------------------------------------------------------- + subroutine CNEvergreenPhenology (num_soilp, filter_soilp , & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! cnveg_state_inst) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! + ! !USES: + use clm_varcon , only : secspday + use clm_time_manager , only : get_days_per_year + use clm_varctl , only : CN_evergreen_phenology_opt + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type), intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + real(r8):: dayspyr ! Days per year + integer :: p ! indices + integer :: fp ! lake filter patch index + + real(r8):: tranr + real(r8):: t1 ! temporary variable + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + evergreen => pftcon%evergreen , & ! Input: binary flag for evergreen leaf habit (0 or 1) + leaf_long => pftcon%leaf_long , & ! Input: leaf longevity (yrs) + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live stem C storage + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) dead stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live coarse root C storage + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) dead coarse root C storage + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) growth respiration storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) dead coarse root C transfer + + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N storage + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) dead stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N storage + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) dead coarse root N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) dead coarse root N transfer + + leafc_storage_to_xfer => cnveg_carbonflux_inst%leafc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + frootc_storage_to_xfer => cnveg_carbonflux_inst%frootc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + livestemc_storage_to_xfer => cnveg_carbonflux_inst%livestemc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + deadstemc_storage_to_xfer => cnveg_carbonflux_inst%deadstemc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + livecrootc_storage_to_xfer => cnveg_carbonflux_inst%livecrootc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + deadcrootc_storage_to_xfer => cnveg_carbonflux_inst%deadcrootc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + gresp_storage_to_xfer => cnveg_carbonflux_inst%gresp_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! InOut: [real(r8) (:)] + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! InOut: [real(r8) (:)] + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! InOut: [real(r8) (:)] + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! InOut: [real(r8) (:)] + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! InOut: [real(r8) (:)] + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! InOut: [real(r8) (:)] + + leafn_storage_to_xfer => cnveg_nitrogenflux_inst%leafn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + frootn_storage_to_xfer => cnveg_nitrogenflux_inst%frootn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + livestemn_storage_to_xfer => cnveg_nitrogenflux_inst%livestemn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + deadstemn_storage_to_xfer => cnveg_nitrogenflux_inst%deadstemn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + leafn_xfer_to_leafn => cnveg_nitrogenflux_inst%leafn_xfer_to_leafn_patch , & ! InOut: [real(r8) (:)] + frootn_xfer_to_frootn => cnveg_nitrogenflux_inst%frootn_xfer_to_frootn_patch , & ! InOut: [real(r8) (:)] + livestemn_xfer_to_livestemn => cnveg_nitrogenflux_inst%livestemn_xfer_to_livestemn_patch , & ! InOut: [real(r8) (:)] + deadstemn_xfer_to_deadstemn => cnveg_nitrogenflux_inst%deadstemn_xfer_to_deadstemn_patch , & ! InOut: [real(r8) (:)] + livecrootn_xfer_to_livecrootn => cnveg_nitrogenflux_inst%livecrootn_xfer_to_livecrootn_patch , & ! InOut: [real(r8) (:)] + deadcrootn_xfer_to_deadcrootn => cnveg_nitrogenflux_inst%deadcrootn_xfer_to_deadcrootn_patch , & ! InOut: [real(r8) (:)] + + bglfr => cnveg_state_inst%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnveg_state_inst%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnveg_state_inst%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + + ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to retranslocation pool + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to retranslocation pool + ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to retranslocation pool + igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ) + + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + if (evergreen(ivt(p)) == 1._r8) then + bglfr(p) = 1._r8/(leaf_long(ivt(p)) * dayspyr * secspday) + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + end if + end do + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (CN_evergreen_phenology_opt == 1) then + do fp = 1,num_soilp + p = filter_soilp(fp) + if (evergreen(ivt(p)) == 1._r8) then + + tranr=0.0002_r8 + ! set carbon fluxes for shifting storage pools to transfer pools + if (use_matrixcn) then + leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc,tranr/dt ,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc,tranr/dt ,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + leafc_storage_to_xfer(p) = tranr * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = tranr * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = tranr * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = tranr * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = tranr * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = tranr * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = tranr * gresp_storage(p)/dt + end if + end if !use_matrixcn + + ! set nitrogen fluxes for shifting storage pools to transfer pools + if (use_matrixcn) then + leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,tranr/dt ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,tranr/dt ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + leafn_storage_to_xfer(p) = tranr * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = tranr * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = tranr * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = tranr * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = tranr * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = tranr * deadcrootn_storage(p)/dt + end if + end if !use_matrixcn + + t1 = 1.0_r8 / dt + + if (use_matrixcn) then + leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + + leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + + livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + leafc_xfer_to_leafc(p) = t1 * leafc_xfer(p) + frootc_xfer_to_frootc(p) = t1 * frootc_xfer(p) + + leafn_xfer_to_leafn(p) = t1 * leafn_xfer(p) + frootn_xfer_to_frootn(p) = t1 * frootn_xfer(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = t1 * livestemc_xfer(p) + deadstemc_xfer_to_deadstemc(p) = t1 * deadstemc_xfer(p) + livecrootc_xfer_to_livecrootc(p) = t1 * livecrootc_xfer(p) + deadcrootc_xfer_to_deadcrootc(p) = t1 * deadcrootc_xfer(p) + + livestemn_xfer_to_livestemn(p) = t1 * livestemn_xfer(p) + deadstemn_xfer_to_deadstemn(p) = t1 * deadstemn_xfer(p) + livecrootn_xfer_to_livecrootn(p) = t1 * livecrootn_xfer(p) + deadcrootn_xfer_to_deadcrootn(p) = t1 * deadcrootn_xfer(p) + end if + end if !use_matrixcn + + end if ! end of if (evergreen(ivt(p)) == 1._r8) then + + end do ! end of pft loop + + end if ! end of if (CN_evergreen_phenology_opt == 1) then + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + end associate + + end subroutine CNEvergreenPhenology + + !----------------------------------------------------------------------- + subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & + temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, dgvs_inst , & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! This routine handles the seasonal deciduous phenology code (temperate + ! deciduous vegetation that has only one growing season per year). + ! + ! !USES: + use shr_const_mod , only: SHR_CONST_TKFRZ, SHR_CONST_PI + use clm_varcon , only: secspday + use clm_varctl , only: use_cndv + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(temperature_type) , intent(in) :: temperature_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: g,c,p !indices + integer :: fp !lake filter patch index + real(r8):: ws_flag !winter-summer solstice flag (0 or 1) + real(r8):: crit_onset_gdd !critical onset growing degree-day sum + real(r8):: crit_daylat !latitudinal light gradient in arctic-boreal + real(r8):: onset_thresh !flag onset threshold + real(r8):: soilt + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) + prev_dayl => grc%prev_dayl , & ! Input: [real(r8) (:) ] daylength from previous time step (s) + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal-deciduous leaf habit (0 or 1) +!KO + season_decid_temperate => pftcon%season_decid_temperate , & ! Input: binary flag for seasonal-deciduous temperate leaf habit (0 or 1) +!KO + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + soila10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] + t_a5min => temperature_inst%t_a5min_patch , & ! input: [real(r8) (:) ] + snow_5day => waterdiagnosticbulk_inst%snow_5day_col , & ! input: [real(r8) (:) ] + + pftmayexist => dgvs_inst%pftmayexist_patch , & ! Output: [logical (:) ] exclude seasonal decid patches from tropics + + annavg_t2m => cnveg_state_inst%annavg_t2m_patch , & ! Input: [real(r8) (:) ] annual average 2m air temperature (K) + dormant_flag => cnveg_state_inst%dormant_flag_patch , & ! Output: [real(r8) (:) ] dormancy flag + days_active => cnveg_state_inst%days_active_patch , & ! Output: [real(r8) (:) ] number of days since last dormancy + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + onset_counter => cnveg_state_inst%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter (seconds) + onset_gddflag => cnveg_state_inst%onset_gddflag_patch , & ! Output: [real(r8) (:) ] onset freeze flag + onset_gdd => cnveg_state_inst%onset_gdd_patch , & ! Output: [real(r8) (:) ] onset growing degree days + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + offset_counter => cnveg_state_inst%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter (seconds) + bglfr => cnveg_state_inst%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnveg_state_inst%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnveg_state_inst%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + + prev_leafc_to_litter => cnveg_carbonflux_inst%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => cnveg_carbonflux_inst%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + leafc_storage_to_xfer => cnveg_carbonflux_inst%leafc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootc_storage_to_xfer => cnveg_carbonflux_inst%frootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemc_storage_to_xfer => cnveg_carbonflux_inst%livestemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemc_storage_to_xfer => cnveg_carbonflux_inst%deadstemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootc_storage_to_xfer => cnveg_carbonflux_inst%livecrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootc_storage_to_xfer => cnveg_carbonflux_inst%deadcrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + gresp_storage_to_xfer => cnveg_carbonflux_inst%gresp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => cnveg_nitrogenflux_inst%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => cnveg_nitrogenflux_inst%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => cnveg_nitrogenflux_inst%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => cnveg_nitrogenflux_inst%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => cnveg_nitrogenflux_inst%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => cnveg_nitrogenflux_inst%deadcrootn_xfer_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + leafn_storage_to_xfer => cnveg_nitrogenflux_inst%leafn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootn_storage_to_xfer => cnveg_nitrogenflux_inst%frootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemn_storage_to_xfer => cnveg_nitrogenflux_inst%livestemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemn_storage_to_xfer => cnveg_nitrogenflux_inst%deadstemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to retranslocation pool + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to retranslocation pool + ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to retranslocation pool + igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ) + + ! start patch loop + + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = patch%gridcell(p) + + if (season_decid(ivt(p)) == 1._r8) then + + ! set background litterfall rate, background transfer rate, and + ! long growing season factor to 0 for seasonal deciduous types + bglfr(p) = 0._r8 + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + + ! onset gdd sum from Biome-BGC, v4.1.2 + crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) + + ! set flag for solstice period (winter->summer = 1, summer->winter = 0) + if (dayl(g) >= prev_dayl(g)) then + ws_flag = 1._r8 + else + ws_flag = 0._r8 + end if + + ! update offset_counter and test for the end of the offset period + if (offset_flag(p) == 1.0_r8) then + ! decrement counter for offset period + offset_counter(p) = offset_counter(p) - dt + + ! if this is the end of the offset_period, reset phenology + ! flags and indices + if (offset_counter(p) < dt/2._r8) then + ! this code block was originally handled by call cn_offset_cleanup(p) + ! inlined during vectorization + + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + if (use_cndv) then + pftmayexist(p) = .true. + end if + + ! reset the previous timestep litterfall flux memory + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! update onset_counter and test for the end of the onset period + if (onset_flag(p) == 1.0_r8) then + ! decrement counter for onset period + onset_counter(p) = onset_counter(p) - dt + + ! if this is the end of the onset period, reset phenology + ! flags and indices + if (onset_counter(p) < dt/2._r8) then + ! this code block was originally handled by call cn_onset_cleanup(p) + ! inlined during vectorization + + onset_flag(p) = 0.0_r8 + onset_counter(p) = 0.0_r8 + ! set all transfer growth rates to 0.0 + leafc_xfer_to_leafc(p) = 0.0_r8 + frootc_xfer_to_frootc(p) = 0.0_r8 + leafn_xfer_to_leafn(p) = 0.0_r8 + frootn_xfer_to_frootn(p) = 0.0_r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = 0.0_r8 + deadstemc_xfer_to_deadstemc(p) = 0.0_r8 + livecrootc_xfer_to_livecrootc(p) = 0.0_r8 + deadcrootc_xfer_to_deadcrootc(p) = 0.0_r8 + livestemn_xfer_to_livestemn(p) = 0.0_r8 + deadstemn_xfer_to_deadstemn(p) = 0.0_r8 + livecrootn_xfer_to_livecrootn(p) = 0.0_r8 + deadcrootn_xfer_to_deadcrootn(p) = 0.0_r8 + end if + ! set transfer pools to 0.0 + leafc_xfer(p) = 0.0_r8 + leafn_xfer(p) = 0.0_r8 + frootc_xfer(p) = 0.0_r8 + frootn_xfer(p) = 0.0_r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer(p) = 0.0_r8 + livestemn_xfer(p) = 0.0_r8 + deadstemc_xfer(p) = 0.0_r8 + deadstemn_xfer(p) = 0.0_r8 + livecrootc_xfer(p) = 0.0_r8 + livecrootn_xfer(p) = 0.0_r8 + deadcrootc_xfer(p) = 0.0_r8 + deadcrootn_xfer(p) = 0.0_r8 + end if + end if + end if + + ! test for switching from dormant period to growth period + if (dormant_flag(p) == 1.0_r8) then + onset_thresh = 0.0_r8 + ! Test to turn on growing degree-day sum, if off. + ! switch on the growing degree day sum on the winter solstice + + if (onset_gddflag(p) == 0._r8 .and. ws_flag == 1._r8) then + onset_gddflag(p) = 1._r8 + onset_gdd(p) = 0._r8 + end if + + ! Test to turn off growing degree-day sum, if on. + ! This test resets the growing degree day sum if it gets past + ! the summer solstice without reaching the threshold value. + ! In that case, it will take until the next winter solstice + ! before the growing degree-day summation starts again. + + if (onset_gddflag(p) == 1._r8 .and. ws_flag == 0._r8) then + onset_gddflag(p) = 0._r8 + onset_gdd(p) = 0._r8 + end if + + ! if the gdd flag is set, and if the soil is above freezing + ! then accumulate growing degree days for onset trigger + + soilt = t_soisno(c, phenology_soil_layer) + if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then + onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday + end if +!KO !separate into Arctic boreal and lower latitudes +!KO if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then +!KO onset_thresh=1.0_r8 +!KO else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ .and. & +!KO t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & +!KO dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then +!KO onset_thresh=1.0_r8 +!KO end if +!KO + if ( onset_thresh_depends_on_veg ) then + ! separate into non-arctic seasonally deciduous pfts (temperate broadleaf deciduous + ! tree) and arctic/boreal seasonally deciduous pfts (boreal needleleaf deciduous tree, + ! boreal broadleaf deciduous tree, boreal broadleaf deciduous shrub, C3 arctic grass) + if (onset_gdd(p) > crit_onset_gdd .and. season_decid_temperate(ivt(p)) == 1) then + onset_thresh=1.0_r8 + else if (season_decid_temperate(ivt(p)) == 0 .and. onset_gddflag(p) == 1.0_r8 .and. & + soila10(p) > SHR_CONST_TKFRZ .and. & + t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & + dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then + onset_thresh=1.0_r8 + end if + else + ! set onset_flag if critical growing degree-day sum is exceeded + if (onset_gdd(p) > crit_onset_gdd) onset_thresh = 1.0_r8 + end if +!KO + ! If onset is being triggered + if (onset_thresh == 1.0_r8) then + onset_flag(p) = 1.0_r8 + dormant_flag(p) = 0.0_r8 + onset_gddflag(p) = 0.0_r8 + onset_gdd(p) = 0.0_r8 + onset_thresh = 0.0_r8 + onset_counter(p) = ndays_on * secspday + + ! move all the storage pools into transfer pools, + ! where they will be transfered to displayed growth over the onset period. + ! this code was originally handled with call cn_storage_to_xfer(p) + ! inlined during vectorization + + ! set carbon fluxes for shifting storage pools to transfer pools + if(use_matrixcn)then + leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc ,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc ,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn ,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn ,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + leafc_storage_to_xfer(p) = fstor2tran * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = fstor2tran * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = fstor2tran * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = fstor2tran * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = fstor2tran * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = fstor2tran * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt + end if + end if ! use_matrixcn + end if + + ! test for switching from growth period to offset period + else if (offset_flag(p) == 0.0_r8) then + if (use_cndv) then + ! If days_active > 355, then remove patch in + ! CNDVEstablishment at the end of the year. + ! days_active > 355 is a symptom of seasonal decid. patches occurring in + ! gridcells where dayl never drops below crit_dayl. + ! This results in TLAI>1e4 in a few gridcells. + days_active(p) = days_active(p) + fracday + if (days_active(p) > 355._r8) pftmayexist(p) = .false. + end if + + if ( min_crtical_dayl_depends_on_lat )then + ! use 15 hr (54000 min) at ~65N from eitel 2019, to ~11hours in temperate regions + ! 15hr-11hr/(65N-45N)=linear slope = 720 min/latitude + crit_daylat=54000-720*(65-abs(grc%latdeg(g))) + if (crit_daylat < crit_dayl) then + crit_daylat = crit_dayl !maintain previous offset from White 2001 as minimum + end if + else + crit_daylat = crit_dayl + end if + + ! only begin to test for offset daylength once past the summer sol + if (ws_flag == 0._r8 .and. dayl(g) < crit_daylat) then + offset_flag(p) = 1._r8 + offset_counter(p) = ndays_off * secspday + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + end if ! end if seasonal deciduous + + end do ! end of patch loop + + end associate + + end subroutine CNSeasonDecidPhenology + + !----------------------------------------------------------------------- + subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & + soilstate_inst, temperature_inst, atm2lnd_inst, wateratm2lndbulk_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! This routine handles phenology for vegetation types, such as grasses and + ! tropical drought deciduous trees, that respond to cold and drought stress + ! signals and that can have multiple growing seasons in a given year. + ! This routine allows for the possibility that leaves might persist year-round + ! in the absence of a suitable stress trigger, by switching to an essentially + ! evergreen habit, but maintaining a deciduous leaf longevity, while waiting + ! for the next stress trigger. This is in contrast to the seasonal deciduous + ! algorithm (for temperate deciduous trees) that forces a single growing season + ! per year. + ! + ! !USES: + use clm_time_manager , only : get_days_per_year + use CNSharedParamsMod, only : use_fun + use clm_varcon , only : secspday + use shr_const_mod , only : SHR_CONST_TKFRZ, SHR_CONST_PI + use CNSharedParamsMod, only : CNParamsShareInst + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + real(r8),parameter :: secspqtrday = secspday / 4 ! seconds per quarter day + integer :: g,c,p ! indices + integer :: fp ! lake filter patch index + real(r8):: dayspyr ! days per year + real(r8):: crit_onset_gdd ! degree days for onset trigger + real(r8):: soilt ! temperature of top soil layer + real(r8):: psi ! water stress of top soil layer + real(r8):: rain_threshold ! rain threshold for leaf on [mm] + logical :: additional_onset_condition ! additional condition for leaf onset + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) + + prec10 => wateratm2lndbulk_inst%prec10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of tot. precipitation + leaf_long => pftcon%leaf_long , & ! Input: leaf longevity (yrs) + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + stress_decid => pftcon%stress_decid , & ! Input: binary flag for stress-deciduous leaf habit (0 or 1) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + + soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + dormant_flag => cnveg_state_inst%dormant_flag_patch , & ! Output: [real(r8) (:) ] dormancy flag + days_active => cnveg_state_inst%days_active_patch , & ! Output: [real(r8) (:) ] number of days since last dormancy + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + onset_counter => cnveg_state_inst%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter (seconds) + onset_gddflag => cnveg_state_inst%onset_gddflag_patch , & ! Output: [real(r8) (:) ] onset freeze flag + onset_fdd => cnveg_state_inst%onset_fdd_patch , & ! Output: [real(r8) (:) ] onset freezing degree days counter + onset_gdd => cnveg_state_inst%onset_gdd_patch , & ! Output: [real(r8) (:) ] onset growing degree days + onset_swi => cnveg_state_inst%onset_swi_patch , & ! Output: [real(r8) (:) ] onset soil water index + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + offset_counter => cnveg_state_inst%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter (seconds) + offset_fdd => cnveg_state_inst%offset_fdd_patch , & ! Output: [real(r8) (:) ] offset freezing degree days counter + offset_swi => cnveg_state_inst%offset_swi_patch , & ! Output: [real(r8) (:) ] offset soil water index + lgsf => cnveg_state_inst%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + bglfr => cnveg_state_inst%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnveg_state_inst%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + annavg_t2m => cnveg_state_inst%annavg_t2m_patch , & ! Output: [real(r8) (:) ] annual average 2m air temperature (K) + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + + prev_leafc_to_litter => cnveg_carbonflux_inst%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => cnveg_carbonflux_inst%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + leafc_storage_to_xfer => cnveg_carbonflux_inst%leafc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootc_storage_to_xfer => cnveg_carbonflux_inst%frootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemc_storage_to_xfer => cnveg_carbonflux_inst%livestemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemc_storage_to_xfer => cnveg_carbonflux_inst%deadstemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootc_storage_to_xfer => cnveg_carbonflux_inst%livecrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootc_storage_to_xfer => cnveg_carbonflux_inst%deadcrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + gresp_storage_to_xfer => cnveg_carbonflux_inst%gresp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => cnveg_nitrogenflux_inst%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => cnveg_nitrogenflux_inst%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => cnveg_nitrogenflux_inst%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => cnveg_nitrogenflux_inst%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => cnveg_nitrogenflux_inst%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => cnveg_nitrogenflux_inst%deadcrootn_xfer_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + leafn_storage_to_xfer => cnveg_nitrogenflux_inst%leafn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootn_storage_to_xfer => cnveg_nitrogenflux_inst%frootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemn_storage_to_xfer => cnveg_nitrogenflux_inst%livestemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemn_storage_to_xfer => cnveg_nitrogenflux_inst%deadstemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to retranslocation pool + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to retranslocation pool + ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to retranslocation pool + igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ) + + ! set time steps + dayspyr = get_days_per_year() + + ! specify rain threshold for leaf onset + rain_threshold = 20._r8 + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = patch%gridcell(p) + + if (stress_decid(ivt(p)) == 1._r8) then + soilt = t_soisno(c, phenology_soil_layer) + psi = soilpsi(c, phenology_soil_layer) + + ! onset gdd sum from Biome-BGC, v4.1.2 + crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) + + + ! update offset_counter and test for the end of the offset period + if (offset_flag(p) == 1._r8) then + ! decrement counter for offset period + offset_counter(p) = offset_counter(p) - dt + + ! if this is the end of the offset_period, reset phenology + ! flags and indices + if (offset_counter(p) < dt/2._r8) then + ! this code block was originally handled by call cn_offset_cleanup(p) + ! inlined during vectorization + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + + ! reset the previous timestep litterfall flux memory + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! update onset_counter and test for the end of the onset period + if (onset_flag(p) == 1.0_r8) then + ! decrement counter for onset period + onset_counter(p) = onset_counter(p) - dt + + ! if this is the end of the onset period, reset phenology + ! flags and indices + if (onset_counter(p) < dt/2._r8) then + ! this code block was originally handled by call cn_onset_cleanup(p) + ! inlined during vectorization + onset_flag(p) = 0._r8 + onset_counter(p) = 0._r8 + ! set all transfer growth rates to 0.0 + leafc_xfer_to_leafc(p) = 0._r8 + frootc_xfer_to_frootc(p) = 0._r8 + leafn_xfer_to_leafn(p) = 0._r8 + frootn_xfer_to_frootn(p) = 0._r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = 0._r8 + deadstemc_xfer_to_deadstemc(p) = 0._r8 + livecrootc_xfer_to_livecrootc(p) = 0._r8 + deadcrootc_xfer_to_deadcrootc(p) = 0._r8 + livestemn_xfer_to_livestemn(p) = 0._r8 + deadstemn_xfer_to_deadstemn(p) = 0._r8 + livecrootn_xfer_to_livecrootn(p) = 0._r8 + deadcrootn_xfer_to_deadcrootn(p) = 0._r8 + end if + ! set transfer pools to 0.0 + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = 0._r8 + frootc_xfer(p) = 0._r8 + frootn_xfer(p) = 0._r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer(p) = 0._r8 + livestemn_xfer(p) = 0._r8 + deadstemc_xfer(p) = 0._r8 + deadstemn_xfer(p) = 0._r8 + livecrootc_xfer(p) = 0._r8 + livecrootn_xfer(p) = 0._r8 + deadcrootc_xfer(p) = 0._r8 + deadcrootn_xfer(p) = 0._r8 + end if + end if + end if + + ! test for switching from dormant period to growth period + if (dormant_flag(p) == 1._r8) then + + ! keep track of the number of freezing degree days in this + ! dormancy period (only if the freeze flag has not previously been set + ! for this dormancy period + + if (onset_gddflag(p) == 0._r8 .and. soilt < SHR_CONST_TKFRZ) onset_fdd(p) = onset_fdd(p) + fracday + + ! if the number of freezing degree days exceeds a critical value, + ! then onset will require both wet soils and a critical soil + ! temperature sum. If this case is triggered, reset any previously + ! accumulated value in onset_swi, so that onset now depends on + ! the accumulated soil water index following the freeze trigger + + if (onset_fdd(p) > crit_onset_fdd) then + onset_gddflag(p) = 1._r8 + onset_fdd(p) = 0._r8 + onset_swi(p) = 0._r8 + end if + + ! if the freeze flag is set, and if the soil is above freezing + ! then accumulate growing degree days for onset trigger + + if (onset_gddflag(p) == 1._r8 .and. soilt > SHR_CONST_TKFRZ) then + onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday + end if + + ! if soils are wet, accumulate soil water index for onset trigger + additional_onset_condition = .true. + if(CNParamsShareInst%constrain_stress_deciduous_onset) then + ! if additional constraint condition not met, set to false + if ((prec10(p) * (3600.0_r8*10.0_r8*24.0_r8)) < rain_threshold) then + additional_onset_condition = .false. + endif + endif + + if (psi >= soilpsi_on) then + onset_swi(p) = onset_swi(p) + fracday + endif + + ! if critical soil water index is exceeded, set onset_flag, and + ! then test for soil temperature criteria + + ! Adding in Kyla's rainfall trigger when fun on. RF. prec10 (mm/s) needs to be higher than 8mm over 10 days. + + if (onset_swi(p) > crit_onset_swi.and. additional_onset_condition) then + onset_flag(p) = 1._r8 + + ! only check soil temperature criteria if freeze flag set since + ! beginning of last dormancy. If freeze flag set and growing + ! degree day sum (since freeze trigger) is lower than critical + ! value, then override the onset_flag set from soil water. + + if (onset_gddflag(p) == 1._r8 .and. onset_gdd(p) < crit_onset_gdd) onset_flag(p) = 0._r8 + end if + + ! only allow onset if dayl > 6hrs + if (onset_flag(p) == 1._r8 .and. dayl(g) <= secspqtrday) then + onset_flag(p) = 0._r8 + end if + + ! if this is the beginning of the onset period + ! then reset the phenology flags and indices + + if (onset_flag(p) == 1._r8) then + dormant_flag(p) = 0._r8 + days_active(p) = 0._r8 + onset_gddflag(p) = 0._r8 + onset_fdd(p) = 0._r8 + onset_gdd(p) = 0._r8 + onset_swi(p) = 0._r8 + onset_counter(p) = ndays_on * secspday + + ! call subroutine to move all the storage pools into transfer pools, + ! where they will be transfered to displayed growth over the onset period. + ! this code was originally handled with call cn_storage_to_xfer(p) + ! inlined during vectorization + + ! set carbon fluxes for shifting storage pools to transfer pools + if (use_matrixcn) then + leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + end if + + leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + leafc_storage_to_xfer(p) = fstor2tran * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = fstor2tran * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = fstor2tran * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = fstor2tran * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = fstor2tran * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = fstor2tran * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt + end if + end if + end if + + ! test for switching from growth period to offset period + else if (offset_flag(p) == 0._r8) then + + ! if soil water potential lower than critical value, accumulate + ! as stress in offset soil water index + + if (psi <= soilpsi_off) then + offset_swi(p) = offset_swi(p) + fracday + + ! if the offset soil water index exceeds critical value, and + ! if this is not the middle of a previously initiated onset period, + ! then set flag to start the offset period and reset index variables + + if (offset_swi(p) >= crit_offset_swi .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8 + + ! if soil water potential higher than critical value, reduce the + ! offset water stress index. By this mechanism, there must be a + ! sustained period of water stress to initiate offset. + + else if (psi >= soilpsi_on) then + offset_swi(p) = offset_swi(p) - fracday + offset_swi(p) = max(offset_swi(p),0._r8) + end if + + ! decrease freezing day accumulator for warm soil + if (offset_fdd(p) > 0._r8 .and. soilt > SHR_CONST_TKFRZ) then + offset_fdd(p) = offset_fdd(p) - fracday + offset_fdd(p) = max(0._r8, offset_fdd(p)) + end if + + ! increase freezing day accumulator for cold soil + if (soilt <= SHR_CONST_TKFRZ) then + offset_fdd(p) = offset_fdd(p) + fracday + + ! if freezing degree day sum is greater than critical value, initiate offset + if (offset_fdd(p) > crit_offset_fdd .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8 + end if + + ! force offset if daylength is < 6 hrs + if (dayl(g) <= secspqtrday) then + offset_flag(p) = 1._r8 + end if + + ! if this is the beginning of the offset period + ! then reset flags and indices + if (offset_flag(p) == 1._r8) then + offset_fdd(p) = 0._r8 + offset_swi(p) = 0._r8 + offset_counter(p) = ndays_off * secspday + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! keep track of number of days since last dormancy for control on + ! fraction of new growth to send to storage for next growing season + + if (dormant_flag(p) == 0.0_r8) then + days_active(p) = days_active(p) + fracday + end if + + ! calculate long growing season factor (lgsf) + ! only begin to calculate a lgsf greater than 0.0 once the number + ! of days active exceeds days/year. + lgsf(p) = max(min(3.0_r8*(days_active(p)-leaf_long(ivt(p))*dayspyr )/dayspyr, 1._r8),0._r8) + ! RosieF. 5 Nov 2015. Changed this such that the increase in leaf turnover is faster after + ! trees enter the 'fake evergreen' state. Otherwise, they have a whole year of + ! cheating, with less litterfall than they should have, resulting in very high LAI. + ! Further, the 'fake evergreen' state (where lgsf>0) is entered at the end of a single leaf lifespan + ! and not a whole year. The '3' is arbitrary, given that this entire system is quite abstract. + + + ! set background litterfall rate, when not in the phenological offset period + if (offset_flag(p) == 1._r8) then + bglfr(p) = 0._r8 + else + ! calculate the background litterfall rate (bglfr) + ! in units 1/s, based on leaf longevity (yrs) and correction for long growing season + + bglfr(p) = (1._r8/(leaf_long(ivt(p))*dayspyr*secspday))*lgsf(p) + end if + + ! set background transfer rate when active but not in the phenological onset period + if (onset_flag(p) == 1._r8) then + bgtr(p) = 0._r8 + else + ! the background transfer rate is calculated as the rate that would result + ! in complete turnover of the storage pools in one year at steady state, + ! once lgsf has reached 1.0 (after 730 days active). + + bgtr(p) = (1._r8/(dayspyr*secspday))*lgsf(p) + + ! set carbon fluxes for shifting storage pools to transfer pools + + ! reduced the amount of stored carbon flowing to display pool by only counting the delta + ! between leafc and leafc_store in the flux. RosieF, Nov5 2015. + leafc_storage_to_xfer(p) = max(0.0_r8,(leafc_storage(p)-leafc(p))) * bgtr(p) + frootc_storage_to_xfer(p) = max(0.0_r8,(frootc_storage(p)-frootc(p))) * bgtr(p) + if (use_matrixcn) then + if(leafc_storage(p) .gt. 0)then + leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,& + leafc_storage_to_xfer(p) / leafc_storage(p), dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + leafc_storage_to_xfer(p) = 0 + end if + if(frootc_storage(p) .gt. 0)then + frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,& + frootc_storage_to_xfer(p) / frootc_storage(p), dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + frootc_storage_to_xfer(p) = 0 + end if + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc ,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc ,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = livestemc_storage(p) * bgtr(p) + deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * bgtr(p) + livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * bgtr(p) + deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * bgtr(p) + gresp_storage_to_xfer(p) = gresp_storage(p) * bgtr(p) + end if + end if !use_matrixcn + + ! set nitrogen fluxes for shifting storage pools to transfer pools + if (use_matrixcn) then + leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,bgtr(p) ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,bgtr(p) ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + leafn_storage_to_xfer(p) = leafn_storage(p) * bgtr(p) + frootn_storage_to_xfer(p) = frootn_storage(p) * bgtr(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = livestemn_storage(p) * bgtr(p) + deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * bgtr(p) + livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * bgtr(p) + deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * bgtr(p) + end if + end if !use_matrixcn + end if + + end if ! end if stress deciduous + + end do ! end of patch loop + + end associate + + end subroutine CNStressDecidPhenology + + !----------------------------------------------------------------------- + subroutine CropPhenology(num_pcropp, filter_pcropp , & + waterdiagnosticbulk_inst, temperature_inst, crop_inst, canopystate_inst, cnveg_state_inst , & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst,& + c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst) + + ! !DESCRIPTION: + ! Code from AgroIBIS to determine crop phenology and code from CN to + ! handle CN fluxes during the phenological onset & offset periods. + + ! !USES: + use clm_time_manager , only : get_curr_date, get_curr_calday, get_days_per_year, get_rad_step_size + use pftconMod , only : ntmp_corn, nswheat, nwwheat, ntmp_soybean + use pftconMod , only : nirrig_tmp_corn, nirrig_swheat, nirrig_wwheat, nirrig_tmp_soybean + use pftconMod , only : ntrp_corn, nsugarcane, ntrp_soybean, ncotton, nrice + use pftconMod , only : nirrig_trp_corn, nirrig_sugarcane, nirrig_trp_soybean + use pftconMod , only : nirrig_cotton, nirrig_rice + use pftconMod , only : nmiscanthus, nirrig_miscanthus, nswitchgrass, nirrig_switchgrass + + use clm_varcon , only : spval, secspday + use clm_varctl , only : use_fertilizer + use clm_varctl , only : use_c13, use_c14 + use clm_varcon , only : c13ratio, c14ratio + ! + ! !ARGUMENTS: + integer , intent(in) :: num_pcropp ! number of prog crop patches in filter + integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(temperature_type) , intent(in) :: temperature_inst + type(crop_type) , intent(inout) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + ! + ! LOCAL VARAIBLES: + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) + integer jday ! julian day of the year + integer fp,p ! patch indices + integer c ! column indices + integer g ! gridcell indices + integer h ! hemisphere indices + integer idpp ! number of days past planting + real(r8) :: dtrad ! radiation time step delta t (seconds) + real(r8) dayspyr ! days per year + real(r8) crmcorn ! comparitive relative maturity for corn + real(r8) ndays_on ! number of days to fertilize + !------------------------------------------------------------------------ + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + leaf_long => pftcon%leaf_long , & ! Input: leaf longevity (yrs) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + manunitro => pftcon%manunitro , & ! Input: max manure to be applied in total (kgN/m2) + mxmat => pftcon%mxmat , & ! Input: + minplanttemp => pftcon%minplanttemp , & ! Input: + planttemp => pftcon%planttemp , & ! Input: + gddmin => pftcon%gddmin , & ! Input: + hybgdd => pftcon%hybgdd , & ! Input: + lfemerg => pftcon%lfemerg , & ! Input: + grnfill => pftcon%grnfill , & ! Input: + + t_ref2m_min => temperature_inst%t_ref2m_min_patch , & ! Input: [real(r8) (:) ] daily minimum of average 2 m height surface air temperature (K) + t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) + a5tmin => temperature_inst%t_a5min_patch , & ! Input: [real(r8) (:) ] 5-day running mean of min 2-m temperature + a10tmin => temperature_inst%t_a10min_patch , & ! Input: [real(r8) (:) ] 10-day running mean of min 2-m temperature + gdd020 => temperature_inst%gdd020_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd0 + gdd820 => temperature_inst%gdd820_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd8 + gdd1020 => temperature_inst%gdd1020_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd10 + + fertnitro => crop_inst%fertnitro_patch , & ! Input: [real(r8) (:) ] fertilizer nitrogen + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] gdd since planting (gddplant) + leafout => crop_inst%gddtsoi_patch , & ! Input: [real(r8) (:) ] gdd from top soil layer temperature + harvdate => crop_inst%harvdate_patch , & ! Output: [integer (:) ] harvest date + croplive => crop_inst%croplive_patch , & ! Output: [logical (:) ] Flag, true if planted, not harvested + cropplant => crop_inst%cropplant_patch , & ! Output: [logical (:) ] Flag, true if crop may be planted + vf => crop_inst%vf_patch , & ! Output: [real(r8) (:) ] vernalization factor + peaklai => cnveg_state_inst%peaklai_patch , & ! Output: [integer (:) ] 1: max allowed lai; 0: not at max + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + + idop => cnveg_state_inst%idop_patch , & ! Output: [integer (:) ] date of planting + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Output: [real(r8) (:) ] gdd needed to harvest + huileaf => cnveg_state_inst%huileaf_patch , & ! Output: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnveg_state_inst%huigrain_patch , & ! Output: [real(r8) (:) ] same to reach vegetative maturity + cumvd => cnveg_state_inst%cumvd_patch , & ! Output: [real(r8) (:) ] cumulative vernalization d?ependence? + hdidx => cnveg_state_inst%hdidx_patch , & ! Output: [real(r8) (:) ] cold hardening index? + bglfr => cnveg_state_inst%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnveg_state_inst%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnveg_state_inst%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + onset_counter => cnveg_state_inst%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter + offset_counter => cnveg_state_inst%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter + + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + + crop_seedc_to_leaf => cnveg_carbonflux_inst%crop_seedc_to_leaf_patch, & ! Output: [real(r8) (:) ] (gC/m2/s) seed source to leaf + + fert_counter => cnveg_nitrogenflux_inst%fert_counter_patch , & ! Output: [real(r8) (:) ] >0 fertilize; <=0 not (seconds) + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + crop_seedn_to_leaf => cnveg_nitrogenflux_inst%crop_seedn_to_leaf_patch, & ! Output: [real(r8) (:) ] (gN/m2/s) seed source to leaf + cphase => crop_inst%cphase_patch , & ! Output: [real(r8) (:)] phenology phase + fert => cnveg_nitrogenflux_inst%fert_patch & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep + ) + + ! get time info + dayspyr = get_days_per_year() + jday = get_curr_calday() + call get_curr_date(kyr, kmo, kda, mcsec) + dtrad = real( get_rad_step_size(), r8 ) + + if (use_fertilizer) then + ndays_on = 20._r8 ! number of days to fertilize + else + ndays_on = 0._r8 ! number of days to fertilize + end if + + do fp = 1, num_pcropp + p = filter_pcropp(fp) + c = patch%column(p) + g = patch%gridcell(p) + h = inhemi(p) + + ! background litterfall and transfer rates; long growing season factor + + bglfr(p) = 0._r8 ! this value changes later in a crop's life cycle + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + + ! --------------------------------- + ! from AgroIBIS subroutine planting + ! --------------------------------- + + ! in order to allow a crop to be planted only once each year + ! initialize cropplant = .false., but hold it = .true. through the end of the year + + ! initialize other variables that are calculated for crops + ! on an annual basis in cropresidue subroutine + + if ( jday == jdayyrstart(h) .and. mcsec == 0 )then + + ! make sure variables aren't changed at beginning of the year + ! for a crop that is currently planted, such as + ! WINTER TEMPERATE CEREAL = winter (wheat + barley + rye) + ! represented here by the winter wheat pft + + if (.not. croplive(p)) then + cropplant(p) = .false. + idop(p) = NOT_Planted + + ! keep next for continuous, annual winter temperate cereal crop; + ! if we removed elseif, + ! winter cereal grown continuously would amount to a cereal/fallow + ! rotation because cereal would only be planted every other year + + else if (croplive(p) .and. (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat)) then + cropplant(p) = .false. + ! else ! not possible to have croplive and ivt==cornORsoy? (slevis) + end if + + end if + + if ( (.not. croplive(p)) .and. (.not. cropplant(p)) ) then + + ! gdd needed for * chosen crop and a likely hybrid (for that region) * + ! to reach full physiological maturity + + ! based on accumulated seasonal average growing degree days from + ! April 1 - Sept 30 (inclusive) + ! for corn and soybeans in the United States - + ! decided upon by what the typical average growing season length is + ! and the gdd needed to reach maturity in those regions + + ! first choice is used for spring temperate cereal and/or soybeans and maize + + ! slevis: ibis reads xinpdate in io.f from control.crops.nc variable name 'plantdate' + ! According to Chris Kucharik, the dataset of + ! xinpdate was generated from a previous model run at 0.5 deg resolution + + ! winter temperate cereal : use gdd0 as a limit to plant winter cereal + + if (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat) then + + ! add check to only plant winter cereal after other crops (soybean, maize) + ! have been harvested + + ! *** remember order of planting is crucial - in terms of which crops you want + ! to be grown in what order *** + + ! in this case, corn or soybeans are assumed to be planted before + ! cereal would be in any particular year that both patches are allowed + ! to grow in the same grid cell (e.g., double-cropping) + + ! slevis: harvdate below needs cropplant(p) above to be cropplant(p,ivt(p)) + ! where ivt(p) has rotated to winter cereal because + ! cropplant through the end of the year for a harvested crop. + ! Also harvdate(p) should be harvdate(p,ivt(p)) and should be + ! updated on Jan 1st instead of at harvest (slevis) + if (a5tmin(p) /= spval .and. & + a5tmin(p) <= minplanttemp(ivt(p)) .and. & + jday >= minplantjday(ivt(p),h) .and. & + (gdd020(p) /= spval .and. & + gdd020(p) >= gddmin(ivt(p)))) then + + cumvd(p) = 0._r8 + hdidx(p) = 0._r8 + vf(p) = 0._r8 + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + gddmaturity(p) = hybgdd(ivt(p)) + leafc_xfer(p) = initial_seed_at_planting + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + crop_seedc_to_leaf(p) = leafc_xfer(p)/dt + crop_seedn_to_leaf(p) = leafn_xfer(p)/dt + + ! because leafc_xfer is set above rather than incremneted through the normal process, must also set its isotope + ! pools here. use totvegc_patch as the closest analogue if nonzero, and use initial value otherwise + if (use_c13) then + if ( cnveg_carbonstate_inst%totvegc_patch(p) .gt. 0._r8) then + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * & + c13_cnveg_carbonstate_inst%totvegc_patch(p) / cnveg_carbonstate_inst%totvegc_patch(p) + else + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * c13ratio + endif + endif + if (use_c14) then + if ( cnveg_carbonstate_inst%totvegc_patch(p) .gt. 0._r8) then + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * & + c14_cnveg_carbonstate_inst%totvegc_patch(p) / cnveg_carbonstate_inst%totvegc_patch(p) + else + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * c14ratio + endif + endif + + ! latest possible date to plant winter cereal and after all other + ! crops were harvested for that year + + else if (jday >= maxplantjday(ivt(p),h) .and. & + gdd020(p) /= spval .and. & + gdd020(p) >= gddmin(ivt(p))) then + + cumvd(p) = 0._r8 + hdidx(p) = 0._r8 + vf(p) = 0._r8 + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + gddmaturity(p) = hybgdd(ivt(p)) + leafc_xfer(p) = initial_seed_at_planting + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + crop_seedc_to_leaf(p) = leafc_xfer(p)/dt + crop_seedn_to_leaf(p) = leafn_xfer(p)/dt + + ! because leafc_xfer is set above rather than incremneted through the normal process, must also set its isotope + ! pools here. use totvegc_patch as the closest analogue if nonzero, and use initial value otherwise + if (use_c13) then + if ( cnveg_carbonstate_inst%totvegc_patch(p) .gt. 0._r8) then + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * & + c13_cnveg_carbonstate_inst%totvegc_patch(p) / cnveg_carbonstate_inst%totvegc_patch(p) + else + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * c13ratio + endif + endif + if (use_c14) then + if ( cnveg_carbonstate_inst%totvegc_patch(p) .gt. 0._r8) then + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * & + c14_cnveg_carbonstate_inst%totvegc_patch(p) / cnveg_carbonstate_inst%totvegc_patch(p) + else + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * c14ratio + endif + endif + else + gddmaturity(p) = 0._r8 + end if + + else ! not winter cereal... slevis: added distinction between NH and SH + ! slevis: The idea is that jday will equal idop sooner or later in the year + ! while the gdd part is either true or false for the year. + if (t10(p) /= spval.and. a10tmin(p) /= spval .and. & + t10(p) > planttemp(ivt(p)) .and. & + a10tmin(p) > minplanttemp(ivt(p)) .and. & + jday >= minplantjday(ivt(p),h) .and. & + jday <= maxplantjday(ivt(p),h) .and. & + t10(p) /= spval .and. a10tmin(p) /= spval .and. & + gdd820(p) /= spval .and. & + gdd820(p) >= gddmin(ivt(p))) then + + ! impose limit on growing season length needed + ! for crop maturity - for cold weather constraints + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + + ! go a specified amount of time before/after + ! climatological date + if (ivt(p) == ntmp_soybean .or. ivt(p) == nirrig_tmp_soybean .or. & + ivt(p) == ntrp_soybean .or. ivt(p) == nirrig_trp_soybean) then + gddmaturity(p) = min(gdd1020(p), hybgdd(ivt(p))) + end if + + if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & + ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & + ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane .or. & + ivt(p) == nmiscanthus .or. ivt(p) == nirrig_miscanthus .or. & + ivt(p) == nswitchgrass .or. ivt(p) == nirrig_switchgrass) then + gddmaturity(p) = max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) + gddmaturity(p) = max(950._r8, min(gddmaturity(p)+150._r8, 1850._r8)) + end if + if (ivt(p) == nswheat .or. ivt(p) == nirrig_swheat .or. & + ivt(p) == ncotton .or. ivt(p) == nirrig_cotton .or. & + ivt(p) == nrice .or. ivt(p) == nirrig_rice) then + gddmaturity(p) = min(gdd020(p), hybgdd(ivt(p))) + end if + + leafc_xfer(p) = initial_seed_at_planting + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + crop_seedc_to_leaf(p) = leafc_xfer(p)/dt + crop_seedn_to_leaf(p) = leafn_xfer(p)/dt + + ! because leafc_xfer is set above rather than incremneted through the normal process, must also set its isotope + ! pools here. use totvegc_patch as the closest analogue if nonzero, and use initial value otherwise + if (use_c13) then + if ( cnveg_carbonstate_inst%totvegc_patch(p) .gt. 0._r8) then + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * & + c13_cnveg_carbonstate_inst%totvegc_patch(p) / cnveg_carbonstate_inst%totvegc_patch(p) + else + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * c13ratio + endif + endif + if (use_c14) then + if ( cnveg_carbonstate_inst%totvegc_patch(p) .gt. 0._r8) then + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * & + c14_cnveg_carbonstate_inst%totvegc_patch(p) / cnveg_carbonstate_inst%totvegc_patch(p) + else + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * c14ratio + endif + endif + + + ! If hit the max planting julian day -- go ahead and plant + else if (jday == maxplantjday(ivt(p),h) .and. gdd820(p) > 0._r8 .and. & + gdd820(p) /= spval ) then + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + + if (ivt(p) == ntmp_soybean .or. ivt(p) == nirrig_tmp_soybean .or. & + ivt(p) == ntrp_soybean .or. ivt(p) == nirrig_trp_soybean) then + gddmaturity(p) = min(gdd1020(p), hybgdd(ivt(p))) + end if + + if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & + ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & + ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane .or. & + ivt(p) == nmiscanthus .or. ivt(p) == nirrig_miscanthus .or. & + ivt(p) == nswitchgrass .or. ivt(p) == nirrig_switchgrass) then + gddmaturity(p) = max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) + end if + if (ivt(p) == nswheat .or. ivt(p) == nirrig_swheat .or. & + ivt(p) == ncotton .or. ivt(p) == nirrig_cotton .or. & + ivt(p) == nrice .or. ivt(p) == nirrig_rice) then + gddmaturity(p) = min(gdd020(p), hybgdd(ivt(p))) + end if + + leafc_xfer(p) = initial_seed_at_planting + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + crop_seedc_to_leaf(p) = leafc_xfer(p)/dt + crop_seedn_to_leaf(p) = leafn_xfer(p)/dt + + ! because leafc_xfer is set above rather than incremneted through the normal process, must also set its isotope + ! pools here. use totvegc_patch as the closest analogue if nonzero, and use initial value otherwise + if (use_c13) then + if ( cnveg_carbonstate_inst%totvegc_patch(p) .gt. 0._r8) then + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * & + c13_cnveg_carbonstate_inst%totvegc_patch(p) / cnveg_carbonstate_inst%totvegc_patch(p) + else + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * c13ratio + endif + endif + if (use_c14) then + if ( cnveg_carbonstate_inst%totvegc_patch(p) .gt. 0._r8) then + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * & + c14_cnveg_carbonstate_inst%totvegc_patch(p) / cnveg_carbonstate_inst%totvegc_patch(p) + else + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = leafc_xfer(p) * c14ratio + endif + endif + + else + gddmaturity(p) = 0._r8 + end if + end if ! crop patch distinction + + ! crop phenology (gdd thresholds) controlled by gdd needed for + ! maturity (physiological) which is based on the average gdd + ! accumulation and hybrids in United States from April 1 - Sept 30 + + ! calculate threshold from phase 1 to phase 2: + ! threshold for attaining leaf emergence (based on fraction of + ! gdd(i) -- climatological average) + ! Hayhoe and Dwyer, 1990, Can. J. Soil Sci 70:493-497 + ! Carlson and Gage, 1989, Agric. For. Met., 45: 313-324 + ! J.T. Ritchie, 1991: Modeling Plant and Soil systems + + huileaf(p) = lfemerg(ivt(p)) * gddmaturity(p) ! 3-7% in cereal + + ! calculate threshhold from phase 2 to phase 3: + ! from leaf emergence to beginning of grain-fill period + ! this hypothetically occurs at the end of tassling, not the beginning + ! tassel initiation typically begins at 0.5-0.55 * gddmaturity + + ! calculate linear relationship between huigrain fraction and relative + ! maturity rating for maize + + if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & + ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & + ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane .or. & + ivt(p) == nmiscanthus .or. ivt(p) == nirrig_miscanthus .or. & + ivt(p) == nswitchgrass .or. ivt(p) == nirrig_switchgrass) then + ! the following estimation of crmcorn from gddmaturity is based on a linear + ! regression using data from Pioneer-brand corn hybrids (Kucharik, 2003, + ! Earth Interactions 7:1-33: fig. 2) + crmcorn = max(73._r8, min(135._r8, (gddmaturity(p)+ 53.683_r8)/13.882_r8)) + + ! the following adjustment of grnfill based on crmcorn is based on a tuning + ! of Agro-IBIS to give reasonable results for max LAI and the seasonal + ! progression of LAI growth (pers. comm. C. Kucharik June 10, 2010) + huigrain(p) = -0.002_r8 * (crmcorn - 73._r8) + grnfill(ivt(p)) + + huigrain(p) = min(max(huigrain(p), grnfill(ivt(p))-0.1_r8), grnfill(ivt(p))) + huigrain(p) = huigrain(p) * gddmaturity(p) ! Cabelguenne et + else + huigrain(p) = grnfill(ivt(p)) * gddmaturity(p) ! al. 1999 + end if + + end if ! crop not live nor planted + + ! ---------------------------------- + ! from AgroIBIS subroutine phenocrop + ! ---------------------------------- + + ! all of the phenology changes are based on the total number of gdd needed + ! to change to the next phase - based on fractions of the total gdd typical + ! for that region based on the April 1 - Sept 30 window of development + + ! crop phenology (gdd thresholds) controlled by gdd needed for + ! maturity (physiological) which is based on the average gdd + ! accumulation and hybrids in United States from April 1 - Sept 30 + + ! Phase 1: Planting to leaf emergence (now in CNAllocation) + ! Phase 2: Leaf emergence to beginning of grain fill (general LAI accumulation) + ! Phase 3: Grain fill to physiological maturity and harvest (LAI decline) + ! Harvest: if gdd past grain fill initiation exceeds limit + ! or number of days past planting reaches a maximum, the crop has + ! reached physiological maturity and plant is harvested; + ! crop could be live or dead at this stage - these limits + ! could lead to reaching physiological maturity or determining + ! a harvest date for a crop killed by an early frost (see next comments) + ! --- --- --- + ! keeping comments without the code (slevis): + ! if minimum temperature, t_ref2m_min <= freeze kill threshold, tkill + ! for 3 consecutive days and lai is above a minimum, + ! plant will be damaged/killed. This function is more for spring freeze events + ! or for early fall freeze events + + ! spring temperate cereal is affected by this, winter cereal kill function + ! is determined in crops.f - is a more elaborate function of + ! cold hardening of the plant + + ! currently simulates too many grid cells killed by freezing temperatures + + ! removed on March 12 2002 - C. Kucharik + ! until it can be a bit more refined, or used at a smaller scale. + ! we really have no way of validating this routine + ! too difficult to implement on 0.5 degree scale grid cells + ! --- --- --- + + onset_flag(p) = 0._r8 ! CN terminology to trigger certain + offset_flag(p) = 0._r8 ! carbon and nitrogen transfers + + if (croplive(p)) then + cphase(p) = 1._r8 + + ! call vernalization if winter temperate cereal planted, living, and the + ! vernalization factor is not 1; + ! vf affects the calculation of gddtsoi & gddplant + + if (t_ref2m_min(p) < 1.e30_r8 .and. vf(p) /= 1._r8 .and. & + (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat)) then + call vernalization(p, & + canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, & + crop_inst) + end if + + ! days past planting may determine harvest + + if (jday >= idop(p)) then + idpp = jday - idop(p) + else + idpp = int(dayspyr) + jday - idop(p) + end if + + ! onset_counter initialized to zero when .not. croplive + ! offset_counter relevant only at time step of harvest + + onset_counter(p) = onset_counter(p) - dt + + ! enter phase 2 onset for one time step: + ! transfer seed carbon to leaf emergence + + if (peaklai(p) >= 1) then + hui(p) = max(hui(p),huigrain(p)) + endif + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p) .and. idpp < mxmat(ivt(p))) then + cphase(p) = 2._r8 + if (abs(onset_counter(p)) > 1.e-6_r8) then + onset_flag(p) = 1._r8 + onset_counter(p) = dt + fert_counter(p) = ndays_on * secspday + if (ndays_on .gt. 0) then + fert(p) = (manunitro(ivt(p)) * 1000._r8 + fertnitro(p))/ fert_counter(p) + else + fert(p) = 0._r8 + end if + else + ! this ensures no re-entry to onset of phase2 + ! b/c onset_counter(p) = onset_counter(p) - dt + ! at every time step + + onset_counter(p) = dt + end if + + ! enter harvest for one time step: + ! - transfer live biomass to litter and to crop yield + ! - send xsmrpool to the atmosphere + ! if onset and harvest needed to last longer than one timestep + ! the onset_counter would change from dt and you'd need to make + ! changes to the offset subroutine below + + else if (hui(p) >= gddmaturity(p) .or. idpp >= mxmat(ivt(p))) then + if (harvdate(p) >= NOT_Harvested) harvdate(p) = jday + croplive(p) = .false. ! no re-entry in greater if-block + cphase(p) = 4._r8 + if (tlai(p) > 0._r8) then ! plant had emerged before harvest + offset_flag(p) = 1._r8 + offset_counter(p) = dt + else ! plant never emerged from the ground + ! Revert planting transfers; this will replenish the crop seed deficit. + ! We subtract from any existing value in crop_seedc_to_leaf / + ! crop_seedn_to_leaf in the unlikely event that we enter this block of + ! code in the same time step where the planting transfer originally + ! occurred. + crop_seedc_to_leaf(p) = crop_seedc_to_leaf(p) - leafc_xfer(p)/dt + crop_seedn_to_leaf(p) = crop_seedn_to_leaf(p) - leafn_xfer(p)/dt + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + if (use_c13) then + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 + endif + if (use_c14) then + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 + endif + + end if + + ! enter phase 3 while previous criteria fail and next is true; + ! in terms of order, phase 3 occurs before harvest, but when + ! harvest *can* occur, we want it to have first priority. + ! AgroIBIS uses a complex formula for lai decline. + ! Use CN's simple formula at least as a place holder (slevis) + + else if (hui(p) >= huigrain(p)) then + cphase(p) = 3._r8 + bglfr(p) = 1._r8/(leaf_long(ivt(p))*dayspyr*secspday) + end if + + ! continue fertilizer application while in phase 2; + ! assumes that onset of phase 2 took one time step only + + if (fert_counter(p) <= 0._r8) then + fert(p) = 0._r8 + else ! continue same fert application every timestep + fert_counter(p) = fert_counter(p) - dtrad + end if + + else ! crop not live + ! next 2 lines conserve mass if leaf*_xfer > 0 due to interpinic. + ! We subtract from any existing value in crop_seedc_to_leaf / + ! crop_seedn_to_leaf in the unlikely event that we enter this block of + ! code in the same time step where the planting transfer originally + ! occurred. + crop_seedc_to_leaf(p) = crop_seedc_to_leaf(p) - leafc_xfer(p)/dt + crop_seedn_to_leaf(p) = crop_seedn_to_leaf(p) - leafn_xfer(p)/dt + onset_counter(p) = 0._r8 + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + if (use_c13) then + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 + endif + if (use_c14) then + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 + endif + end if ! croplive + + end do ! prognostic crops loop + + end associate + + end subroutine CropPhenology + + !----------------------------------------------------------------------- + subroutine CropPhenologyInit(bounds) + ! + ! !DESCRIPTION: + ! Initialization of CropPhenology. Must be called after time-manager is + ! initialized, and after pftcon file is read in. + ! + ! !USES: + use pftconMod , only: npcropmin, npcropmax + use clm_time_manager, only: get_calday + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! LOCAL VARAIBLES: + integer :: p,g,n,i ! indices + !------------------------------------------------------------------------ + + allocate( inhemi(bounds%begp:bounds%endp) ) + + allocate( minplantjday(0:maxveg,inSH)) ! minimum planting julian day + allocate( maxplantjday(0:maxveg,inSH)) ! minimum planting julian day + + ! Julian day for the start of the year (mid-winter) + jdayyrstart(inNH) = 1 + jdayyrstart(inSH) = 182 + + ! Convert planting dates into julian day + minplantjday(:,:) = huge(1) + maxplantjday(:,:) = huge(1) + do n = npcropmin, npcropmax + if (pftcon%is_pft_known_to_model(n)) then + minplantjday(n, inNH) = int( get_calday( pftcon%mnNHplantdate(n), 0 ) ) + maxplantjday(n, inNH) = int( get_calday( pftcon%mxNHplantdate(n), 0 ) ) + + minplantjday(n, inSH) = int( get_calday( pftcon%mnSHplantdate(n), 0 ) ) + maxplantjday(n, inSH) = int( get_calday( pftcon%mxSHplantdate(n), 0 ) ) + end if + end do + + ! Figure out what hemisphere each PATCH is in + do p = bounds%begp, bounds%endp + g = patch%gridcell(p) + ! Northern hemisphere + if ( grc%latdeg(g) > 0.0_r8 )then + inhemi(p) = inNH + else + inhemi(p) = inSH + end if + end do + + ! + ! Constants for Crop vernalization + ! + ! photoperiod factor calculation + ! genetic constant - can be modified + + p1d = 0.004_r8 ! average for genotypes from Ritchey, 1991. + ! Modeling plant & soil systems: Wheat phasic developmt + p1v = 0.003_r8 ! average for genotypes from Ritchey, 1991. + + hti = 1._r8 + tbase = 0._r8 + + end subroutine CropPhenologyInit + + !----------------------------------------------------------------------- + subroutine vernalization(p, & + canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, crop_inst) + ! + ! !DESCRIPTION: + ! + ! * * * only call for winter temperate cereal * * * + ! + ! subroutine calculates vernalization and photoperiod effects on + ! gdd accumulation in winter temperate cereal varieties. Thermal time accumulation + ! is reduced in 1st period until plant is fully vernalized. During this + ! time of emergence to spikelet formation, photoperiod can also have a + ! drastic effect on plant development. + ! + ! !ARGUMENTS: + integer , intent(in) :: p ! PATCH index running over + type(canopystate_type) , intent(in) :: canopystate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(inout) :: crop_inst + ! + ! LOCAL VARAIBLES: + real(r8) tcrown ! ? + real(r8) vd, vd1, vd2 ! vernalization dependence + real(r8) tkil ! Freeze kill threshold + integer c,g ! indices + !------------------------------------------------------------------------ + + associate( & + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2 m height surface air temperature (K) + t_ref2m_min => temperature_inst%t_ref2m_min_patch , & ! Input: [real(r8) (:) ] daily minimum of average 2 m height surface air temperature (K) + t_ref2m_max => temperature_inst%t_ref2m_max_patch , & ! Input: [real(r8) (:) ] daily maximum of average 2 m height surface air temperature (K) + + snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + + hdidx => cnveg_state_inst%hdidx_patch , & ! Output: [real(r8) (:) ] cold hardening index? + cumvd => cnveg_state_inst%cumvd_patch , & ! Output: [real(r8) (:) ] cumulative vernalization d?ependence? + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Output: [real(r8) (:) ] gdd needed to harvest + huigrain => cnveg_state_inst%huigrain_patch , & ! Output: [real(r8) (:) ] heat unit index needed to reach vegetative maturity + + vf => crop_inst%vf_patch & ! Output: [real(r8) (:) ] vernalization factor for cereal + ) + + c = patch%column(p) + + ! for all equations - temperatures must be in degrees (C) + ! calculate temperature of crown of crop (e.g., 3 cm soil temperature) + ! snow depth in centimeters + + if (t_ref2m(p) < tfrz) then !slevis: t_ref2m inst of td=daily avg (K) + tcrown = 2._r8 + (t_ref2m(p) - tfrz) * (0.4_r8 + 0.0018_r8 * & + (min(snow_depth(c)*100._r8, 15._r8) - 15._r8)**2) + else !slevis: snow_depth inst of adsnod=daily average (m) + tcrown = t_ref2m(p) - tfrz + end if + + ! vernalization factor calculation + ! if vf(p) = 1. then plant is fully vernalized - and thermal time + ! accumulation in phase 1 will be unaffected + ! refers to gddtsoi & gddplant, defined in the accumulation routines (slevis) + ! reset vf, cumvd, and hdidx to 0 at planting of crop (slevis) + + if (t_ref2m_max(p) > tfrz) then + if (t_ref2m_min(p) <= tfrz+15._r8) then + vd1 = 1.4_r8 - 0.0778_r8 * tcrown + vd2 = 0.5_r8 + 13.44_r8 / ((t_ref2m_max(p)-t_ref2m_min(p)+3._r8)**2) * tcrown + vd = max(0._r8, min(1._r8, vd1, vd2)) + cumvd(p) = cumvd(p) + vd + end if + + if (cumvd(p) < 10._r8 .and. t_ref2m_max(p) > tfrz+30._r8) then + cumvd(p) = cumvd(p) - 0.5_r8 * (t_ref2m_max(p) - tfrz - 30._r8) + end if + cumvd(p) = max(0._r8, cumvd(p)) ! must be > 0 + + vf(p) = 1._r8 - p1v * (50._r8 - cumvd(p)) + vf(p) = max(0._r8, min(vf(p), 1._r8)) ! must be between 0 - 1 + end if + + ! calculate cold hardening of plant + ! determines for winter cereal varieties whether the plant has completed + ! a period of cold hardening to protect it from freezing temperatures. If + ! not, then exposure could result in death or killing of plants. + + ! there are two distinct phases of hardening + + if (t_ref2m_min(p) <= tfrz-3._r8 .or. hdidx(p) /= 0._r8) then + if (hdidx(p) >= hti) then ! done with phase 1 + hdidx(p) = hdidx(p) + 0.083_r8 + hdidx(p) = min(hdidx(p), hti*2._r8) + end if + + if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then + hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + hdidx(p) = max(0._r8, hdidx(p)) + end if + + else if (tcrown >= tbase-1._r8) then + if (tcrown <= tbase+8._r8) then + hdidx(p) = hdidx(p) + 0.1_r8 - (tcrown-tbase+3.5_r8)**2 / 506._r8 + if (hdidx(p) >= hti .and. tcrown <= tbase + 0._r8) then + hdidx(p) = hdidx(p) + 0.083_r8 + hdidx(p) = min(hdidx(p), hti*2._r8) + end if + end if + + if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then + hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + hdidx(p) = max(0._r8, hdidx(p)) + end if + end if + + ! calculate what the cereal killing temperature + ! there is a linear inverse relationship between + ! hardening of the plant and the killing temperature or + ! threshold that the plant can withstand + ! when plant is fully-hardened (hdidx = 2), the killing threshold is -18 C + + ! will have to develop some type of relationship that reduces LAI and + ! biomass pools in response to cold damaged crop + + if (t_ref2m_min(p) <= tfrz - 6._r8) then + tkil = (tbase - 6._r8) - 6._r8 * hdidx(p) + if (tkil >= tcrown) then + if ((0.95_r8 - 0.02_r8 * (tcrown - tkil)**2) >= 0.02_r8) then + write (iulog,*) 'crop damaged by cold temperatures at p,c =', p,c + else if (tlai(p) > 0._r8) then ! slevis: kill if past phase1 + gddmaturity(p) = 0._r8 ! by forcing through + huigrain(p) = 0._r8 ! harvest + write (iulog,*) '95% of crop killed by cold temperatures at p,c =', p,c + end if + end if + end if + + end associate + + end subroutine vernalization + + !----------------------------------------------------------------------- + subroutine CNOnsetGrowth (num_soilp, filter_soilp, & + cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Determines the flux of stored C and N from transfer pools to display + ! pools during the phenological onset period. + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8):: t1 ! temporary variable + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Input: [real(r8) (:) ] onset flag + onset_counter => cnveg_state_inst%onset_counter_patch , & ! Input: [real(r8) (:) ] onset days counter + bgtr => cnveg_state_inst%bgtr_patch , & ! Input: [real(r8) (:) ] background transfer growth rate (1/s) + + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => cnveg_nitrogenflux_inst%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => cnveg_nitrogenflux_inst%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => cnveg_nitrogenflux_inst%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => cnveg_nitrogenflux_inst%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => cnveg_nitrogenflux_inst%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => cnveg_nitrogenflux_inst%deadcrootn_xfer_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to retranslocation pool + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to retranslocation pool + ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to retranslocation pool + igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes during onset period + if (onset_flag(p) == 1._r8) then + + ! The transfer rate is a linearly decreasing function of time, + ! going to zero on the last timestep of the onset period + + if (abs(onset_counter(p) - dt) <= dt/2._r8) then + t1 = 1.0_r8 / dt + else + t1 = 2.0_r8 / (onset_counter(p)) + end if + if (use_matrixcn)then + leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + if (woody(ivt(p)) == 1.0_r8) then + + livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + + livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + leafc_xfer_to_leafc(p) = t1 * leafc_xfer(p) + frootc_xfer_to_frootc(p) = t1 * frootc_xfer(p) + leafn_xfer_to_leafn(p) = t1 * leafn_xfer(p) + frootn_xfer_to_frootn(p) = t1 * frootn_xfer(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = t1 * livestemc_xfer(p) + deadstemc_xfer_to_deadstemc(p) = t1 * deadstemc_xfer(p) + livecrootc_xfer_to_livecrootc(p) = t1 * livecrootc_xfer(p) + deadcrootc_xfer_to_deadcrootc(p) = t1 * deadcrootc_xfer(p) + livestemn_xfer_to_livestemn(p) = t1 * livestemn_xfer(p) + deadstemn_xfer_to_deadstemn(p) = t1 * deadstemn_xfer(p) + livecrootn_xfer_to_livecrootn(p) = t1 * livecrootn_xfer(p) + deadcrootn_xfer_to_deadcrootn(p) = t1 * deadcrootn_xfer(p) + end if + end if !use_matrixcn + + end if ! end if onset period + + ! calculate the background rate of transfer growth (used for stress + ! deciduous algorithm). In this case, all of the mass in the transfer + ! pools should be moved to displayed growth in each timestep. + + if (bgtr(p) > 0._r8) then + if(use_matrixcn)then + leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + if (woody(ivt(p)) == 1.0_r8) then + + livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + + livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + leafc_xfer_to_leafc(p) = leafc_xfer(p) / dt + frootc_xfer_to_frootc(p) = frootc_xfer(p) / dt + leafn_xfer_to_leafn(p) = leafn_xfer(p) / dt + frootn_xfer_to_frootn(p) = frootn_xfer(p) / dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) / dt + deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) / dt + livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) / dt + deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) / dt + livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) / dt + deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) / dt + livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) / dt + deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) / dt + end if + end if !use_matrixcn + end if ! end if bgtr + + end do ! end patch loop + + end associate + + end subroutine CNOnsetGrowth + + !----------------------------------------------------------------------- + subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from displayed pools to litter + ! pools during the phenological offset period. + ! + ! !USES: + use pftconMod , only : npcropmin + use pftconMod , only : nmiscanthus, nirrig_miscanthus, nswitchgrass, nirrig_switchgrass + + use CNSharedParamsMod, only : use_fun + use clm_varctl , only : CNratio_floating + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type), intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p, c ! indices + integer :: fp ! lake filter patch index + real(r8):: t1 ! temporary variable + real(r8):: denom ! temporary variable for divisor + real(r8) :: ntovr_leaf + real(r8) :: fr_leafn_to_litter ! fraction of the nitrogen turnover that goes to litter; remaining fraction is retranslocated + real(r8) :: grainc_to_out, grainn_to_out ! Temporary for grain Carbon and grain Nitrogen output + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + + biofuel_harvfrac => pftcon%biofuel_harvfrac , & ! Input: cut a fraction of leaf & stem for biofuel (-) + + lflitcn => pftcon%lflitcn , & ! Input: leaf litter C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Input: [real(r8) (:) ] offset flag + offset_counter => cnveg_state_inst%offset_counter_patch , & ! Input: [real(r8) (:) ] offset days counter + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + grainc => cnveg_carbonstate_inst%grainc_patch , & ! Input: [real(r8) (:) ] (gC/m2) grain C + cropseedc_deficit => cnveg_carbonstate_inst%cropseedc_deficit_patch , & ! Input: [real(r8) (:) ] (gC/m2) crop seed C deficit + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) livestem C + cropseedn_deficit => cnveg_nitrogenstate_inst%cropseedn_deficit_patch , & ! Input: [real(r8) (:) ] (gC/m2) crop seed N deficit + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N + + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch , & ! Input: [real(r8) (:) ] allocation to grain C (gC/m2/s) + npool_to_grainn => cnveg_nitrogenflux_inst%npool_to_grainn_patch , & ! Input: [real(r8) (:) ] allocation to grain N (gN/m2/s) + grainn => cnveg_nitrogenstate_inst%grainn_patch , & ! Input: [real(r8) (:) ] (kgN/m2) grain N + cpool_to_livestemc => cnveg_carbonflux_inst%cpool_to_livestemc_patch , & ! Input: [real(r8) (:) ] allocation to live stem C (gC/m2/s) + cpool_to_leafc => cnveg_carbonflux_inst%cpool_to_leafc_patch , & ! Input: [real(r8) (:) ] allocation to leaf C (gC/m2/s) + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Input: [real(r8) (:) ] allocation to fine root C (gC/m2/s) + prev_leafc_to_litter => cnveg_carbonflux_inst%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => cnveg_carbonflux_inst%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_to_litter => cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Output: [real(r8) (:) ] leaf C litterfall (gC/m2/s) + frootc_to_litter => cnveg_carbonflux_inst%frootc_to_litter_patch , & ! Output: [real(r8) (:) ] fine root C litterfall (gC/m2/s) + livestemc_to_litter => cnveg_carbonflux_inst%livestemc_to_litter_patch , & ! Output: [real(r8) (:) ] live stem C litterfall (gC/m2/s) + grainc_to_food => cnveg_carbonflux_inst%grainc_to_food_patch , & ! Output: [real(r8) (:) ] grain C to food (gC/m2/s) + grainc_to_seed => cnveg_carbonflux_inst%grainc_to_seed_patch , & ! Output: [real(r8) (:) ] grain C to seed (gC/m2/s) + leafc_to_biofuelc => cnveg_carbonflux_inst%leafc_to_biofuelc_patch , & ! Output: [real(r8) (:) ] leaf C to biofuel C (gC/m2/s) + livestemc_to_biofuelc => cnveg_carbonflux_inst%livestemc_to_biofuelc_patch , & ! Output: [real(r8) (:) ] livestem C to biofuel C (gC/m2/s) + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + + livestemn_to_litter => cnveg_nitrogenflux_inst%livestemn_to_litter_patch , & ! Output: [real(r8) (:) ] livestem N to litter (gN/m2/s) + grainn_to_food => cnveg_nitrogenflux_inst%grainn_to_food_patch , & ! Output: [real(r8) (:) ] grain N to food (gN/m2/s) + grainn_to_seed => cnveg_nitrogenflux_inst%grainn_to_seed_patch , & ! Output: [real(r8) (:) ] grain N to seed (gN/m2/s) + leafn_to_biofueln => cnveg_nitrogenflux_inst%leafn_to_biofueln_patch , & ! Output: [real(r8) (:) ] leaf N to biofuel N (gN/m2/s) + livestemn_to_biofueln => cnveg_nitrogenflux_inst%livestemn_to_biofueln_patch, & ! Output: [real(r8) (:) ] livestem N to biofuel N (gN/m2/s) + leafn_to_litter => cnveg_nitrogenflux_inst%leafn_to_litter_patch , & ! Output: [real(r8) (:) ] leaf N litterfall (gN/m2/s) + leafn_to_retransn => cnveg_nitrogenflux_inst%leafn_to_retransn_patch , & ! Input: [real(r8) (:) ] leaf N to retranslocated N pool (gN/m2/s) + free_retransn_to_npool=> cnveg_nitrogenflux_inst%free_retransn_to_npool_patch , & ! Input: [real(r8) (:) ] free leaf N to retranslocated N pool (gN/m2/s) + paid_retransn_to_npool=> cnveg_nitrogenflux_inst%retransn_to_npool_patch, & ! Input: [real(r8) (:) ] free leaf N to retranslocated N pool (gN/m2/s) + frootn_to_litter => cnveg_nitrogenflux_inst%frootn_to_litter_patch , & ! Output: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + leafc_to_litter_fun => cnveg_carbonflux_inst%leafc_to_litter_fun_patch , & ! Output: [real(r8) (:) ] leaf C litterfall used by FUN (gC/m2/s) + leafcn_offset => cnveg_state_inst%leafcn_offset_patch , & ! Output: [real(r8) (:) ] Leaf C:N used by FUN + + ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ileaf_to_iout_gmc => cnveg_carbonflux_inst%ileaf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from leaf pool to outside of vegetation pools + ileaf_to_iout_gmn => cnveg_nitrogenflux_inst%ileaf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + ilivestem_to_iout_gmc => cnveg_carbonflux_inst%ilivestem_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from live stem pool to outside of vegetation pools + ilivestem_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestem_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from live stem pool to outside of vegetation pools + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to retranslocation pool + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to retranslocation pool + ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to retranslocation pool + igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ) + + ! The litterfall transfer rate starts at 0.0 and increases linearly + ! over time, with displayed growth going to 0.0 on the last day of litterfall + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate fluxes during offset period + if (offset_flag(p) == 1._r8) then + + if (abs(offset_counter(p) - dt) <= dt/2._r8) then + t1 = 1.0_r8 / dt + frootc_to_litter(p) = t1 * frootc(p) + cpool_to_frootc(p) + + ! biofuel_harvfrac is only non-zero for prognostic crops. + leafc_to_litter(p) = t1 * leafc(p)*(1._r8-biofuel_harvfrac(ivt(p))) + cpool_to_leafc(p) + + if (use_matrixcn) then + if(leafc(p) .gt. 0)then + leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + leafc_to_litter(p) = 0 + end if + if(frootc(p) .gt. 0)then + frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + frootc_to_litter(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + end if ! use_matrixcn + ! this assumes that offset_counter == dt for crops + ! if this were ever changed, we'd need to add code to the "else" + if (ivt(p) >= npcropmin) then + ! Replenish the seed deficits from grain, if there is enough + ! available grain. (If there is not enough available grain, the seed + ! deficits will accumulate until there is eventually enough grain to + ! replenish them.) + grainc_to_seed(p) = t1 * min(-cropseedc_deficit(p), grainc(p)) + grainn_to_seed(p) = t1 * min(-cropseedn_deficit(p), grainn(p)) + ! Send the remaining grain to the food product pool + grainc_to_food(p) = t1 * grainc(p) + cpool_to_grainc(p) - grainc_to_seed(p) + grainn_to_food(p) = t1 * grainn(p) + npool_to_grainn(p) - grainn_to_seed(p) + + ! Cut a certain fraction (i.e., biofuel_harvfrac(ivt(p))) (e.g., biofuel_harvfrac(ivt(p)=70% for bioenergy crops) of leaf C + ! and move this fration of leaf C to biofuel C, rather than move it to litter + leafc_to_biofuelc(p) = t1 * leafc(p) * biofuel_harvfrac(ivt(p)) + leafn_to_biofueln(p) = t1 * leafn(p) * biofuel_harvfrac(ivt(p)) + + ! Cut a certain fraction (i.e., biofuel_harvfrac(ivt(p))) (e.g., biofuel_harvfrac(ivt(p)=70% for bioenergy crops) of livestem C + ! and move this fration of leaf C to biofuel C, rather than move it to litter + livestemc_to_litter(p) = t1 * livestemc(p)*(1._r8-biofuel_harvfrac(ivt(p))) + cpool_to_livestemc(p) + livestemc_to_biofuelc(p) = t1 * livestemc(p) * biofuel_harvfrac(ivt(p)) + livestemn_to_biofueln(p) = t1 * livestemn(p) * biofuel_harvfrac(ivt(p)) + + if(use_matrixcn)then + if(grainc(p) .gt. 0)then + grainc_to_out = grainc(p) * matrix_update_phc(p,igrain_to_iout_phc,(grainc_to_seed(p) + grainc_to_food(p)) / grainc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + grainc_to_seed(p) = 0 + grainc_to_food(p) = 0 + end if + if(grainn(p) .gt. 0)then + grainn_to_out = grainn(p) * matrix_update_phn(p,igrain_to_iout_phn,(grainn_to_seed(p) + grainn_to_food(p)) / grainn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + grainn_to_seed(p) = 0 + grainn_to_food(p) = 0 + end if + if(livestemc(p) .gt. 0)then + livestemc_to_litter(p) = livestemc(p) * matrix_update_phc(p,ilivestem_to_iout_phc,livestemc_to_litter(p) / livestemc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + livestemc_to_litter(p) = 0 + end if + if(livestemn(p) .gt. 0)then + livestemn_to_biofueln(p) = livestemn(p) * matrix_update_gmn(p,ilivestem_to_iout_gmn,livestemn_to_biofueln(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + else + livestemn_to_biofueln(p) = 0 + end if + if(leafn(p) > 0)then + leafn_to_biofueln(p) = leafn(p) * matrix_update_gmn(p,ileaf_to_iout_gmn,leafn_to_biofueln(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + else + leafn_to_biofueln(p) = 0 + end if + if (leafc(p) > 0)then + leafc_to_biofuelc(p) = leafc(p) * matrix_update_gmc(p,ileaf_to_iout_gmc,leafc_to_biofuelc(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,.True.) + else + leafc_to_biofuelc(p) = 0 + end if + if(livestemc(p) .gt. 0)then + livestemc_to_biofuelc(p) = livestemc(p) * matrix_update_gmc(p,ilivestem_to_iout_gmc,livestemc_to_biofuelc(p) / livestemc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,.True.) + else + livestemc_to_biofuelc(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + end if ! use_matrixcn + end if + else + t1 = dt * 2.0_r8 / (offset_counter(p) * offset_counter(p)) + leafc_to_litter(p) = prev_leafc_to_litter(p) + t1*(leafc(p) - prev_leafc_to_litter(p)*offset_counter(p)) + frootc_to_litter(p) = prev_frootc_to_litter(p) + t1*(frootc(p) - prev_frootc_to_litter(p)*offset_counter(p)) + + if (use_matrixcn) then + if(leafc(p) .gt. 0)then + leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + leafc_to_litter(p) = 0 + end if + if(frootc(p) .gt. 0)then + frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + frootc_to_litter(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + end if !use_matrixcn + end if + + if ( use_fun ) then + if(leafc_to_litter(p)*dt.gt.leafc(p))then + leafc_to_litter(p) = leafc(p)/dt + cpool_to_leafc(p) + if (use_matrixcn) then + if(leafc(p) .gt. 0)then + leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + leafc_to_litter(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + endif + if(frootc_to_litter(p)*dt.gt.frootc(p))then + frootc_to_litter(p) = frootc(p)/dt + cpool_to_frootc(p) + if (use_matrixcn) then + if(frootc(p) .gt. 0)then + frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + else + frootc_to_litter(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + endif + end if + + + if ( use_fun ) then + leafc_to_litter_fun(p) = leafc_to_litter(p) + leafn_to_retransn(p) = paid_retransn_to_npool(p) + free_retransn_to_npool(p) + if (leafn(p).gt.0._r8) then + if (leafn(p)-leafn_to_retransn(p)*dt.gt.0._r8) then + leafcn_offset(p) = leafc(p)/(leafn(p)-leafn_to_retransn(p)*dt) + else + leafcn_offset(p) = leafc(p)/leafn(p) + end if + else + leafcn_offset(p) = leafcn(ivt(p)) + end if + leafn_to_litter(p) = leafc_to_litter(p)/leafcn_offset(p) - leafn_to_retransn(p) + leafn_to_litter(p) = max(leafn_to_litter(p),0._r8) + if (use_matrixcn) then + if(leafn(p) .gt. 0)then + leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + leafn_to_litter(p) = 0 + leafn_to_retransn(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + end if !use_matrixcn + + denom = ( leafn_to_retransn(p) + leafn_to_litter(p) ) + if ( denom /= 0.0_r8 ) then + fr_leafn_to_litter = leafn_to_litter(p) / ( leafn_to_retransn(p) + leafn_to_litter(p) ) + else if ( leafn_to_litter(p) == 0.0_r8 ) then + fr_leafn_to_litter = 0.0_r8 + else + fr_leafn_to_litter = 1.0_r8 + end if + + else + if (CNratio_floating .eqv. .true.) then + fr_leafn_to_litter = 0.5_r8 ! assuming 50% of nitrogen turnover goes to litter + end if + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = leafc_to_litter(p) / lflitcn(ivt(p)) + leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) + + if (use_matrixcn) then + if(leafn(p) .gt. 0)then + leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + leafn_to_litter(p) = 0 + leafn_to_retransn(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + end if + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) + if (use_matrixcn) then + if(frootn(p) .gt. 0)then + frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + frootn_to_litter(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + + if (CNratio_floating .eqv. .true.) then + if (leafc(p) == 0.0_r8) then + ntovr_leaf = 0.0_r8 + else + ntovr_leaf = leafc_to_litter(p) * (leafn(p) / leafc(p)) + end if + + leafn_to_litter(p) = fr_leafn_to_litter * ntovr_leaf + leafn_to_retransn(p) = ntovr_leaf - leafn_to_litter(p) + if (use_matrixcn) then + if(leafn(p) .gt. 0)then + leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + leafn_to_litter(p) = 0 + leafn_to_retransn(p) = 0 + end if + end if !use_matrixcn + if (frootc(p) == 0.0_r8) then + frootn_to_litter(p) = 0.0_r8 + else + frootn_to_litter(p) = frootc_to_litter(p) * (frootn(p) / frootc(p)) + end if + if (use_matrixcn) then + if(frootn(p) .gt. 0)then + frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + frootn_to_litter(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + end if + + if ( use_fun ) then + if(frootn_to_litter(p)*dt.gt.frootn(p))then + if (.not. use_matrixcn) then + frootn_to_litter(p) = frootn(p)/dt + else + frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,1._r8/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + endif + end if + + if (ivt(p) >= npcropmin) then + ! NOTE(slevis, 2014-12) results in -ve livestemn and -ve totpftn + !X! livestemn_to_litter(p) = livestemc_to_litter(p) / livewdcn(ivt(p)) + ! NOTE(slevis, 2014-12) Beth Drewniak suggested this instead + livestemn_to_litter(p) = livestemn(p) / dt * (1._r8 - biofuel_harvfrac(ivt(p))) + if(use_matrixcn)then + livestemn_to_litter(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iout_phn, (1._r8- biofuel_harvfrac(ivt(p)))/dt, dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + end if + + ! save the current litterfall fluxes + prev_leafc_to_litter(p) = leafc_to_litter(p) + prev_frootc_to_litter(p) = frootc_to_litter(p) + + end if ! end if offset period + + end do ! end patch loop + !matrix for leafn_to_retran will be added in allocation subroutine + + end associate + + end subroutine CNOffsetLitterfall + + !----------------------------------------------------------------------- + subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from displayed pools to litter + ! pools as the result of background litter fall. + ! + ! !USES: + use CNSharedParamsMod , only : use_fun + use clm_varctl , only : CNratio_floating + ! !ARGUMENTS: + implicit none + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type), intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8) :: fr_leafn_to_litter ! fraction of the nitrogen turnover that goes to litter; remaining fraction is retranslocated + real(r8) :: ntovr_leaf + real(r8) :: denom + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + lflitcn => pftcon%lflitcn , & ! Input: leaf litter C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + + bglfr => cnveg_state_inst%bglfr_patch , & ! Input: [real(r8) (:) ] background litterfall rate (1/s) + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + + leafc_to_litter => cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Output: [real(r8) (:) ] + frootc_to_litter => cnveg_carbonflux_inst%frootc_to_litter_patch , & ! Output: [real(r8) (:) ] + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + leafn_to_litter => cnveg_nitrogenflux_inst%leafn_to_litter_patch , & ! Output: [real(r8) (:) ] + leafn_to_retransn => cnveg_nitrogenflux_inst%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_litter => cnveg_nitrogenflux_inst%frootn_to_litter_patch , & ! Output: [real(r8) (:) ] + leafc_to_litter_fun => cnveg_carbonflux_inst%leafc_to_litter_fun_patch, & ! Output: [real(r8) (:) ] leaf C litterfall used by FUN (gC/m2/s) + leafcn_offset => cnveg_state_inst%leafcn_offset_patch , & ! Output: [real(r8) (:) ] Leaf C:N used by FUN + free_retransn_to_npool=> cnveg_nitrogenflux_inst%free_retransn_to_npool_patch , & ! Input: [real(r8) (:) ] free leaf N to retranslocated N pool (gN/m2/s) + paid_retransn_to_npool=> cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Input: [real(r8) (:) ] free leaf N to retranslocated N pool (gN/m2/s) + + ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to retranslocation pool + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to retranslocation pool + ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to retranslocation pool + igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes if the background litterfall rate is non-zero + if (bglfr(p) > 0._r8) then + ! units for bglfr are already 1/s + leafc_to_litter(p) = bglfr(p) * leafc(p) + frootc_to_litter(p) = bglfr(p) * frootc(p) + if (use_matrixcn) then + leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,bglfr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,bglfr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + end if + if ( use_fun ) then + leafc_to_litter_fun(p) = leafc_to_litter(p) + leafn_to_retransn(p) = paid_retransn_to_npool(p) + free_retransn_to_npool(p) + if (leafn(p).gt.0._r8) then + if (leafn(p)-leafn_to_retransn(p)*dt.gt.0._r8) then + leafcn_offset(p) = leafc(p)/(leafn(p)-leafn_to_retransn(p)*dt) + else + leafcn_offset(p) = leafc(p)/leafn(p) + end if + else + leafcn_offset(p) = leafcn(ivt(p)) + end if + leafn_to_litter(p) = leafc_to_litter(p)/leafcn_offset(p) - leafn_to_retransn(p) + leafn_to_litter(p) = max(leafn_to_litter(p),0._r8) + if(use_matrixcn)then + if(leafn(p) .ne. 0._r8)then + leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + + denom = ( leafn_to_retransn(p) + leafn_to_litter(p) ) + if ( denom /= 0.0_r8 ) then + fr_leafn_to_litter = leafn_to_litter(p) / ( leafn_to_retransn(p) + leafn_to_litter(p) ) + else if ( leafn_to_litter(p) == 0.0_r8 ) then + fr_leafn_to_litter = 0.0_r8 + else + fr_leafn_to_litter = 1.0_r8 + end if + + + else + if (CNratio_floating .eqv. .true.) then + fr_leafn_to_litter = 0.5_r8 ! assuming 50% of nitrogen turnover goes to litter + end if + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = leafc_to_litter(p) / lflitcn(ivt(p)) + leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) + + if (use_matrixcn) then + if(leafn(p) .ne. 0)then + leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + end if + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) + + if (CNratio_floating .eqv. .true.) then + if (leafc(p) == 0.0_r8) then + ntovr_leaf = 0.0_r8 + else + ntovr_leaf = leafc_to_litter(p) * (leafn(p) / leafc(p)) + end if + + leafn_to_litter(p) = fr_leafn_to_litter * ntovr_leaf + leafn_to_retransn(p) = ntovr_leaf - leafn_to_litter(p) + if (use_matrixcn) then + if(leafn(p) .gt. 0)then + leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + leafn_to_litter(p) = 0 + leafn_to_retransn(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + if (frootc(p) == 0.0_r8) then + frootn_to_litter(p) = 0.0_r8 + else + frootn_to_litter(p) = frootc_to_litter(p) * (frootn(p) / frootc(p)) + end if + end if + + if ( use_fun ) then + if(frootn_to_litter(p)*dt.gt.frootn(p))then + frootn_to_litter(p) = frootn(p)/dt + endif + end if + + if (use_matrixcn) then + if(frootn(p) .ne. 0)then + frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + end if + + end do + !matrix for retransn_to_leafn will be added in allocation subroutine + end associate + + end subroutine CNBackgroundLitterfall + + !----------------------------------------------------------------------- + subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from live wood to + ! dead wood pools, for stem and coarse root. + ! + use CNSharedParamsMod, only: use_fun + use clm_varctl , only : CNratio_floating + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8):: ctovr ! temporary variable for carbon turnover + real(r8):: ntovr ! temporary variable for nitrogen turnover + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Output: [real(r8) (:)] + + livestemc_to_deadstemc => cnveg_carbonflux_inst%livestemc_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_to_deadcrootc => cnveg_carbonflux_inst%livecrootc_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + + livestemn_to_deadstemn => cnveg_nitrogenflux_inst%livestemn_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livecrootn_to_deadcrootn => cnveg_nitrogenflux_inst%livecrootn_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + livecrootn_to_retransn => cnveg_nitrogenflux_inst%livecrootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + free_retransn_to_npool => cnveg_nitrogenflux_inst%free_retransn_to_npool_patch , & ! Input: [real(r8) (:) ] free leaf N to retranslocated N pool (gN/m2/s) + ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root to dead coarse root pool + ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to retranslocation pool + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to retranslocation pool + ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to retranslocation pool + iretransn_to_iout => cnveg_nitrogenflux_inst%iretransn_to_iout_ph , & ! Input: [integer ] + igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph & ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ) + + + + ! patch loop +ptch: do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes for woody types + if (woody(ivt(p)) > 0._r8) then + + ! live stem to dead stem turnover + + ctovr = livestemc(p) * lwtop + ntovr = ctovr / livewdcn(ivt(p)) + livestemc_to_deadstemc(p) = ctovr + livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p)) + if( use_matrixcn)then + livestemc_to_deadstemc(p) = livestemc(p) * matrix_update_phc(p,ilivestem_to_ideadstem_phc,lwtop,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + if (livestemn(p) .gt. 0.0_r8) then + livestemn_to_deadstemn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_ideadstem_phn,livestemn_to_deadstemn(p)/livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + livestemn_to_deadstemn(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + end if + if (CNratio_floating .eqv. .true.) then + if (livestemc(p) == 0.0_r8) then + ntovr = 0.0_r8 + livestemn_to_deadstemn(p) = 0.0_r8 + else + ntovr = ctovr * (livestemn(p) / livestemc(p)) + livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p)) + end if + + if (use_matrixcn)then + if (livestemn(p) .gt. 0.0_r8) then + livestemn_to_deadstemn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_ideadstem_phn,& + livestemn_to_deadstemn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + else + livestemn_to_deadstemn(p) = 0 + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if + end if + + livestemn_to_retransn(p) = ntovr - livestemn_to_deadstemn(p) + !matrix for livestemn_to_retransn will be added in allocation subroutine + + ! live coarse root to dead coarse root turnover + + ctovr = livecrootc(p) * lwtop + ntovr = ctovr / livewdcn(ivt(p)) + if(.not. use_matrixcn)then + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + livecrootc_to_deadcrootc(p) = ctovr + livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p)) + else + livecrootc_to_deadcrootc(p) = livecrootc(p) * matrix_update_phc(p,ilivecroot_to_ideadcroot_phc,lwtop,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + livecrootn_to_deadcrootn(p) = livecrootn(p) * matrix_update_phn(p,ilivecroot_to_ideadcroot_phn,lwtop/deadwdcn(ivt(p)),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if !use_matrixcn + + if (CNratio_floating .eqv. .true.) then + if (livecrootc(p) == 0.0_r8) then + ntovr = 0.0_r8 + livecrootn_to_deadcrootn(p) = 0.0_r8 + else + ntovr = ctovr * (livecrootn(p) / livecrootc(p)) + livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p)) + end if + + if (use_matrixcn)then + if (livecrootn(p) .ne.0.0_r8 )then + livecrootn_to_deadcrootn(p) = matrix_update_phn(p,ilivecroot_to_ideadcroot_phn,& + livecrootn_to_deadcrootn(p) / livecrootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livecrootn(p) + end if + else + ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) + end if !use_matrixcn + end if + + livecrootn_to_retransn(p) = ntovr - livecrootn_to_deadcrootn(p) + if(use_matrixcn)then + if(livecrootn(p) .gt. 0.0_r8) then + livecrootn_to_retransn(p) = matrix_update_phn(p,ilivecroot_to_iretransn_phn,& + livecrootn_to_retransn(p) / livecrootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livecrootn(p) + else + livecrootn_to_retransn(p) = 0 + end if + if(livestemn(p) .gt. 0.0_r8) then + livestemn_to_retransn(p) = matrix_update_phn(p,ilivestem_to_iretransn_phn,& + livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livestemn(p) + else + livestemn_to_retransn(p) = 0 + end if + ! WW change logic so livestem_retrans goes to npool (via + ! free_retrans flux) + ! this should likely be done more cleanly if it works, i.e. not + ! update fluxes w/ states + ! additional considerations for crop? + ! The non-matrix version of this is in NStateUpdate1 + if (use_fun) then + if (retransn(p) .gt. 0._r8) then + ! The acc matrix check MUST be turned on, or this will + ! fail with Nitrogen balance error EBK 03/11/2021 + free_retransn_to_npool(p) = free_retransn_to_npool(p) + retransn(p) * matrix_update_phn(p,iretransn_to_iout, & + (livestemn_to_retransn(p) + livecrootn_to_retransn(p)) / retransn(p),dt, & + cnveg_nitrogenflux_inst, matrixcheck_ph, acc=.true.) + else + free_retransn_to_npool(p) = 0._r8 + end if + end if + end if !use_matrixcn + + end if + + end do ptch + + end associate + + end subroutine CNLivewoodTurnover + + !----------------------------------------------------------------------- + subroutine CNCropHarvestToProductPools(bounds, num_soilp, filter_soilp, num_soilc, filter_soilc, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! If using prognostic crop, then move any necessary harvested amounts into fluxes + ! destined for the product pools. + ! + ! !USES: + use clm_varctl , only : use_crop + use clm_varctl , only : use_grainproduct + use subgridAveMod , only : p2c + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fp, p + + character(len=*), parameter :: subname = 'CNCropHarvestToProductPools' + !----------------------------------------------------------------------- + + if (use_crop) then + do fp = 1, num_soilp + p = filter_soilp(fp) + cnveg_carbonflux_inst%grainc_to_cropprodc_patch(p) = cnveg_carbonflux_inst%leafc_to_biofuelc_patch(p) + & + cnveg_carbonflux_inst%livestemc_to_biofuelc_patch(p) + cnveg_nitrogenflux_inst%grainn_to_cropprodn_patch(p) = cnveg_nitrogenflux_inst%leafn_to_biofueln_patch(p) + & + cnveg_nitrogenflux_inst%livestemn_to_biofueln_patch(p) + end do + + if (use_grainproduct) then + do fp = 1, num_soilp + p = filter_soilp(fp) + cnveg_carbonflux_inst%grainc_to_cropprodc_patch(p) = cnveg_carbonflux_inst%grainc_to_cropprodc_patch(p) + & + cnveg_carbonflux_inst%grainc_to_food_patch(p) + cnveg_nitrogenflux_inst%grainn_to_cropprodn_patch(p) = cnveg_nitrogenflux_inst%grainn_to_cropprodn_patch(p) + & + cnveg_nitrogenflux_inst%grainn_to_food_patch(p) + end do + end if + + call p2c (bounds, num_soilc, filter_soilc, & + cnveg_carbonflux_inst%grainc_to_cropprodc_patch(bounds%begp:bounds%endp), & + cnveg_carbonflux_inst%grainc_to_cropprodc_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_soilc, filter_soilc, & + cnveg_nitrogenflux_inst%grainn_to_cropprodn_patch(bounds%begp:bounds%endp), & + cnveg_nitrogenflux_inst%grainn_to_cropprodn_col(bounds%begc:bounds%endc)) + + end if + + end subroutine CNCropHarvestToProductPools + + !----------------------------------------------------------------------- + subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & + cnveg_state_inst,cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch, froot_prof_patch) + ! + ! !DESCRIPTION: + ! called at the end of cn_phenology to gather all patch-level litterfall fluxes + ! to the column level and assign them to the three litter pools + ! + ! !USES: + use clm_varpar , only : max_patch_per_col, nlevdecomp + use pftconMod , only : npcropmin + use clm_varctl , only : use_grainproduct + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + + associate( & + leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] weight (relative to column) for this patch (0-1) + + lf_flab => pftcon%lf_flab , & ! Input: leaf litter labile fraction + lf_fcel => pftcon%lf_fcel , & ! Input: leaf litter cellulose fraction + lf_flig => pftcon%lf_flig , & ! Input: leaf litter lignin fraction + fr_flab => pftcon%fr_flab , & ! Input: fine root litter labile fraction + fr_fcel => pftcon%fr_fcel , & ! Input: fine root litter cellulose fraction + fr_flig => pftcon%fr_flig , & ! Input: fine root litter lignin fraction + + leafc_to_litter => cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Input: [real(r8) (:) ] leaf C litterfall (gC/m2/s) + frootc_to_litter => cnveg_carbonflux_inst%frootc_to_litter_patch , & ! Input: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + livestemc_to_litter => cnveg_carbonflux_inst%livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] live stem C litterfall (gC/m2/s) + grainc_to_food => cnveg_carbonflux_inst%grainc_to_food_patch , & ! Input: [real(r8) (:) ] grain C to food (gC/m2/s) + phenology_c_to_litr_met_c => cnveg_carbonflux_inst%phenology_c_to_litr_met_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gC/m3/s) + phenology_c_to_litr_cel_c => cnveg_carbonflux_inst%phenology_c_to_litr_cel_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gC/m3/s) + phenology_c_to_litr_lig_c => cnveg_carbonflux_inst%phenology_c_to_litr_lig_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter lignin pool (gC/m3/s) + + livestemn_to_litter => cnveg_nitrogenflux_inst%livestemn_to_litter_patch , & ! Input: [real(r8) (:) ] livestem N to litter (gN/m2/s) + grainn_to_food => cnveg_nitrogenflux_inst%grainn_to_food_patch , & ! Input: [real(r8) (:) ] grain N to food (gN/m2/s) + leafn_to_litter => cnveg_nitrogenflux_inst%leafn_to_litter_patch , & ! Input: [real(r8) (:) ] leaf N litterfall (gN/m2/s) + frootn_to_litter => cnveg_nitrogenflux_inst%frootn_to_litter_patch , & ! Input: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + phenology_n_to_litr_met_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_met_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gN/m3/s) + phenology_n_to_litr_cel_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_cel_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gN/m3/s) + phenology_n_to_litr_lig_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_lig_n_col & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter lignin pool (gN/m3/s) + ) + + do j = 1, nlevdecomp + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + if (patch%active(p)) then + ! leaf litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! leaf litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! fine root litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! agroibis puts crop stem litter together with leaf litter + ! so I've used the leaf lf_f* parameters instead of making + ! new ones for now (slevis) + ! also for simplicity I've put "food" into the litter pools + + if (ivt(p) >= npcropmin) then ! add livestemc to litter + ! stem litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + livestemc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + livestemc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + livestemc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! stem litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + livestemn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + livestemn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + livestemn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + if (.not. use_grainproduct) then + ! grain litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + grainc_to_food(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + grainc_to_food(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + grainc_to_food(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! grain litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + grainn_to_food(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + grainn_to_food(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + grainn_to_food(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + end if + + + end if + end if + end if + + end do + + end do + end do + + end associate + + end subroutine CNLitterToColumn + +end module CNPhenologyMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 index 8a4eafc99..d0f623435 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -42,7 +42,7 @@ subroutine CNParamsReadShared(ncid, namelist_file) character(len=*), intent(in) :: namelist_file call CNParamsReadShared_netcdf(ncid) - call CNParamsReadShared_namelist(namelist_file) + ! call CNParamsReadShared_namelist(namelist_file) end subroutine CNParamsReadShared @@ -104,88 +104,88 @@ subroutine CNParamsReadShared_netcdf(ncid) end subroutine CNParamsReadShared_netcdf !----------------------------------------------------------------------- - subroutine CNParamsReadShared_namelist(namelist_file) - ! - ! !DESCRIPTION: - ! Read and initialize CN Shared parameteres from the namelist. - ! - ! !USES: - use fileutils , only : relavu, getavu - use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_LOGICAL - use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : iulog - use abortutils , only : endrun - use shr_mpi_mod , only : shr_mpi_bcast - - ! - implicit none - ! - - character(len=*), intent(in) :: namelist_file - - integer :: i,j,n ! loop indices - integer :: ierr ! error code - integer :: unitn ! unit for namelist file - - real(r8) :: decomp_depth_efolding = 0.0_r8 - logical :: constrain_stress_deciduous_onset = .false. - - character(len=32) :: subroutine_name = 'CNParamsReadNamelist' - character(len=10) :: namelist_group = 'bgc_shared' - - !----------------------------------------------------------------------- - - ! ---------------------------------------------------------------------- - ! Namelist Variables - ! ---------------------------------------------------------------------- - - namelist /bgc_shared/ & - decomp_depth_efolding, & - constrain_stress_deciduous_onset - - - ! Read namelist from standard input. - if (masterproc) then - - write(iulog,*) 'Attempting to read CN/BGC shared namelist parameters .....' - unitn = getavu() - write(iulog,*) 'Read in ' // namelist_group // ' namelist from: ', trim(namelist_file) - open( unitn, file=trim(namelist_file), status='old' ) - call shr_nl_find_group_name(unitn, namelist_group, status=ierr) - if (ierr == 0) then - read(unitn, bgc_shared, iostat=ierr) - if (ierr /= 0) then - call endrun(msg='error in reading in ' // namelist_group // ' namelist' // & - errMsg(sourcefile, __LINE__)) - end if - else - call endrun(msg='error in finding ' // namelist_group // ' namelist' // & - errMsg(sourcefile, __LINE__)) - end if - call relavu( unitn ) - - end if ! masterproc - - ! Broadcast the parameters from master - call shr_mpi_bcast ( decomp_depth_efolding, mpicom ) - call shr_mpi_bcast ( constrain_stress_deciduous_onset, mpicom ) - - ! Save the parameter to the instance - CNParamsShareInst%decomp_depth_efolding = decomp_depth_efolding - CNParamsShareInst%constrain_stress_deciduous_onset = constrain_stress_deciduous_onset - - ! Output read parameters to the lnd.log - if (masterproc) then - write(iulog,*) 'CN/BGC shared namelist parameters:' - write(iulog,*)' ' - write(iulog,*)' decomp_depth_efolding = ', decomp_depth_efolding - write(iulog,*)' constrain_stress_deciduous_onset = ',constrain_stress_deciduous_onset - - write(iulog,*) - - end if - - end subroutine CNParamsReadShared_namelist +! subroutine CNParamsReadShared_namelist(namelist_file) +! ! +! ! !DESCRIPTION: +! ! Read and initialize CN Shared parameteres from the namelist. +! ! +! ! !USES: +! use fileutils , only : relavu, getavu +! use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_LOGICAL +! use shr_nl_mod , only : shr_nl_find_group_name +! use shr_log_mod , only : errMsg => shr_log_errMsg +! use clm_varctl , only : iulog +! use abortutils , only : endrun +! use shr_mpi_mod , only : shr_mpi_bcast +! +! ! +! implicit none +! ! +! +! character(len=*), intent(in) :: namelist_file +! +! integer :: i,j,n ! loop indices +! integer :: ierr ! error code +! integer :: unitn ! unit for namelist file +! +! real(r8) :: decomp_depth_efolding = 0.0_r8 +! logical :: constrain_stress_deciduous_onset = .false. +! +! character(len=32) :: subroutine_name = 'CNParamsReadNamelist' +! character(len=10) :: namelist_group = 'bgc_shared' +! +! !----------------------------------------------------------------------- +! +! ! ---------------------------------------------------------------------- +! ! Namelist Variables +! ! ---------------------------------------------------------------------- +! +! namelist /bgc_shared/ & +! decomp_depth_efolding, & +! constrain_stress_deciduous_onset +! +! +! ! Read namelist from standard input. +! if (masterproc) then +! +! write(iulog,*) 'Attempting to read CN/BGC shared namelist parameters .....' +! unitn = getavu() +! write(iulog,*) 'Read in ' // namelist_group // ' namelist from: ', trim(namelist_file) +! open( unitn, file=trim(namelist_file), status='old' ) +! call shr_nl_find_group_name(unitn, namelist_group, status=ierr) +! if (ierr == 0) then +! read(unitn, bgc_shared, iostat=ierr) +! if (ierr /= 0) then +! call endrun(msg='error in reading in ' // namelist_group // ' namelist' // & +! errMsg(sourcefile, __LINE__)) +! end if +! else +! call endrun(msg='error in finding ' // namelist_group // ' namelist' // & +! errMsg(sourcefile, __LINE__)) +! end if +! call relavu( unitn ) +! +! end if ! masterproc +! +! ! Broadcast the parameters from master +! call shr_mpi_bcast ( decomp_depth_efolding, mpicom ) +! call shr_mpi_bcast ( constrain_stress_deciduous_onset, mpicom ) +! +! ! Save the parameter to the instance +! CNParamsShareInst%decomp_depth_efolding = decomp_depth_efolding +! CNParamsShareInst%constrain_stress_deciduous_onset = constrain_stress_deciduous_onset +! +! ! Output read parameters to the lnd.log +! if (masterproc) then +! write(iulog,*) 'CN/BGC shared namelist parameters:' +! write(iulog,*)' ' +! write(iulog,*)' decomp_depth_efolding = ', decomp_depth_efolding +! write(iulog,*)' constrain_stress_deciduous_onset = ',constrain_stress_deciduous_onset +! +! write(iulog,*) +! +! end if +! +! end subroutine CNParamsReadShared_namelist end module CNSharedParamsMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 index 4c132d286..68c46747e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 @@ -3,38 +3,77 @@ module CN_DriverMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan use CNVegetationFacade + use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_zon + use clm_varcon , only : grav, denh2o + contains !--------------------------------- - subroutine CN_Driver(nch,ndep) + subroutine CN_Driver(nch,ndep,tp1,tairm,rzm,psis,bee,dayl) use CNCLM_decompMod, only : bounds use CNCLM_filterMod, only : filter use CNCLM_SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type use CNCLM_SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type + use CNCLM_ActiveLayerMod + use CNCLM_GridcellType !ARGUMENTS implicit none !INPUT integer, intent(in) :: nch ! number of tiles - real, dimension(nch), intent(in) :: ndep ! nitrogen deposition - + real, dimension(nch), intent(in) :: ndep ! nitrogen deposition [g m^-2 s^-1] + real, dimension(nch), intent(in) :: tp1 ! soil temperatures [K] + real, dimension(nch), intent(in) :: tairm ! surface air temperature [K] averaged over CN interval + real, dimension(nch,nzone), intent(in) :: rzm ! weighted root-zone moisture content as frac of WHC + real, dimension(nch), intent(in) :: bee ! Clapp-Hornberger 'b' [-] + real, dimension(nch), intent(in) :: psis ! saturated matric potential [m] + real, dimension(nch), intent(in) :: dayl ! daylength [seconds] !LOCAL ! jkolassa: not sure the below type declarations are necessary or whether use statements ! above are enough - type(bounds_type) :: bounds - type(clumpfilter_type) :: filter - type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst + type(bounds_type) :: bounds + type(clumpfilter_type) :: filter + type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst + type(gridcell_type) :: grc logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions + integer :: n, p, nc, nz, np + + !------------------------------- + + ! update CLM types with current states + + n = 0 + p = 0 + do nc = 1,nch ! catchment tile loop + + grc%dayl(nc) = dayl(nc) + do nz = 1,num_zon ! CN zone loop + n = n + 1 + temperature_inst%t_soisno_col(n,-nlevsno+1:nlevmaxurbgrnd) = tp1(nc) ! jkolassa: only one soil and no snow column at this point (may change in future) + soilstate_inst%soilpsi_col(n,nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point + do np = 0,numpft ! PFT index loop + p = p + 1 + temperature_inst%t_ref2m_patch(p) = tairm(nc) + end do ! np + end do ! nz + end do ! nc + ! call CLM routines that are needed prior to Ecosystem Dynamics call + + call active_layer_inst%alt_calc(num_soilc, filter_soilc, & + temperature_inst) + + + ! Ecosystem Dynamics calculations call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds, & filter%num_soilc, filter%soilc, & filter%num_soilp, filter%soilp, & @@ -57,6 +96,9 @@ subroutine CN_Driver(nch,ndep) photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & nutrient_competition_method, fireemis_inst) + + + grc%prev_dayl = grc%dayl ! set previous day length for following time steps (dayl itself is computed in GridComp) end subroutine CN_Driver end module CN_DriverMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 8ce0fdeb7..4361b2ca4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -15,7 +15,6 @@ module CN_initMod use CNCLM_OzoneBaseMod use CNCLM_PhotosynsType use CNCLM_pftconMod - use CNCLM_PhotoParamsType use CNCLM_WaterFluxType use CNCLM_SoilBiogeochemCarbonStateType use CNCLM_SoilBiogeochemNitrogenStateType @@ -29,11 +28,29 @@ module CN_initMod use CNCLM_filterMod use CNCLM_SoilBiogeochemCarbonFluxType use CNCLM_SoilBiogeochemNitrogenFluxType + use CNCLM_PatchType + use CNCLM_ColumnType + use CNCLM_ch4Mod + use CNCLM_SoilBiogeochemDecompCascadeConType + use CNCLM_ActiveLayerMod + use CNCLM_CropType + use CNCLM_CNDVType + use LandunitType + use RootBiophysMod + use CNMRespMod , only : readCNMRespParams => readParams + use CNSharedParamsMod , only : CNParamsReadShared + use spmdMod use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn + use SoilBiogeochemDecompCascadeCNMod , only : readSoilBiogeochemDecompCnParams => readParams + use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method + use SoilBiogeochemDecompMod , only : readSoilBiogeochemDecompParams => readParams + use CNPhenologyMod , only : readCNPhenolParams => readParams - use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col + + use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & + nlevgrnd, nlevsoi implicit none private @@ -58,6 +75,10 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) !LOCAL type(bounds_type) :: bounds + type(patch_type) :: patch + type(column_type) :: col + type(landunit_type) :: lun + type(clumpfilter_type) :: filter type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(atm2lnd_type) :: atm2lnd_inst @@ -70,7 +91,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(ozone_type) :: ozone_inst type(photosyns_type) :: photosyns_inst type(pftcon_type) :: pftcon - type(photo_params_type) :: params_inst type(waterflux_type) :: waterflux_inst type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst @@ -84,18 +104,46 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(clumpfilter_type) :: filter type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst + type(ch4_type) :: ch4_inst + type(crop_type) :: crop_inst + type(dgvs_type) :: dgvs_inst + + character(300) :: paramfile + type(Netcdf4_fileformatter) :: ncid + integer :: rc + !----------------------------------------- ! initialize CN model ! ------------------- + call spmd_init() + call clm_varpar_init() call init_clm_varctl() call init_bounds (nch, bounds) + ! initialize subrgid types + + call init_patch_type (bound, nch, ityp, patch) + + call init_column_type (bounds, col) + + call init_landunit_type (bounds, lun) + + call init_gridcell_type (bounds, nch, cnpft, lats, lons, grc) + + ! create subgrid structure + + call clm_ptrs_compdown (bounds) + + ! initialize filters + call init_filter_type (bounds, nch, filter) + ! initialize states and fluxes + call init_cnveg_nitrogenstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenstate_inst, cn5_cold_start) call init_cnveg_carbonstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonstate_inst, cn5_cold_start) @@ -120,8 +168,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_pftcon_type (pftcon) - call init_photo_params_type (params_inst) - call init_waterflux_type (bounds, waterflux_inst) call init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, soilbiogeochem_carbonstate_inst) @@ -134,29 +180,72 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_soilbiogeochem_state_type (bounds, nch, cncol, soilbiogeochem_state_inst) - if (use_century_decomp) then - call init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, & - soilstate_inst ) - else - call init_decompcascade_cn(bounds, soilbiogeochem_state_inst) - end if - call init_cnveg_state_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_state_inst) call init_cnveg_carbonflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonflux_inst) call init_cnveg_nitrogenflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenflux_inst) - call init_gridcell_type (bounds, nch, cnpft, lats, lons, grc) - call init_waterfluxbulk_type (bounds, waterfluxbulk_inst) call init_soilbiogeochem_carbonflux_type(bounds,soilbiogeochem_carbonflux_inst) call init_soilbiogeochem_nitrogenflux_type(bounds,soilbiogeochem_nitrogenflux_inst) - end subroutine CN_init + call init_ch4_type (bounds, ch4_inst) + + call init_decomp_cascade_constants (use_century_decomp) + + call init_active_layer_type (bounds, active_layer_inst) + + call init_crop_type (bounds, crop_inst) + + call init_dgvs_type (bounds, dgvs_inst) + + ! calls to original CTSM initialization routines + + ! initialize rooting profile with default values + rooting_profile_method_water = zeng_2001_root + rooting_profile_method_carbon = zeng_2001_root + rooting_profile_varindex_water = 1 + rooting_profile_varindex_carbon = 2 + + + ! initialize root fractions + call init_vegrootfr(bounds, nlevsoi, nlevgrnd, & + soilstate_inst%rootfr_patch(bounds%begp:bounds%endp,1:nlevgrnd),'water') + call init_vegrootfr(bounds, nlevsoi, nlevgrnd, & + soilstate_inst%crootfr_patch(bounds%begp:bounds%endp,1:nlevgrnd),'carbon') + + ! allocate CLM arrays that are not allocated in their modules + + allocate(nutrient_competition_method, & + source=create_nutrient_competition_method(bounds)) ! jkolassa: this allocates and initializes the nutrient_competition_method_type + + ! initialize CLM parameters from parameter file + + paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' + + call ncid%open(trim(paramfile),pFIO_READ, __RC__) + + call readCNMRespParams(ncid) + call CNParamsReadShared(ncid) ! this is called CN params but really is for the soil biogeochem parameters + call readSoilBiogeochemDecompCnParams(ncid) + call nutrient_competition_method%readParams(ncid) + call readSoilBiogeochemDecompParams(ncid) + call readCNPhenolParams(ncid) + + if (use_century_decomp) then + call init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, & + soilstate_inst ) + else + call init_decompcascade_cn(bounds, soilbiogeochem_state_inst) + end if + + call photosyns_inst%ReadParams( ncid ) + + end subroutine CN_init end module CN_initMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 new file mode 100755 index 000000000..bb40bb47d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 @@ -0,0 +1,1171 @@ +module NutrientCompetitionCLM45defaultMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! DESCRIPTION + ! module contains different subroutines to do soil nutrient competition dynamics + ! + ! created by Jinyun Tang, Sep 8, 2014 + ! modified by Mariana Vertenstein, Nov 15, 2014 + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use NutrientCompetitionMethodMod, only : nutrient_competition_method_type + use NutrientCompetitionMethodMod, only : params_inst + use CNVegMatrixMod , only : matrix_update_phn + !use clm_varctl , only : iulog + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: nutrient_competition_clm45default_type + ! + type, extends(nutrient_competition_method_type) :: nutrient_competition_clm45default_type + private + contains + ! public methocs + procedure, public :: init ! Initialize the class + procedure, public :: calc_plant_nutrient_competition ! calculate nutrient yield rate from competition + procedure, public :: calc_plant_nutrient_demand ! calculate plant nutrient demand + ! + ! private methods + procedure, private:: calc_plant_cn_alloc + procedure, private:: calc_plant_nitrogen_demand + end type nutrient_competition_clm45default_type + ! + interface nutrient_competition_clm45default_type + ! initialize a new nutrient_competition_clm45default_type object + module procedure constructor + end interface nutrient_competition_clm45default_type + ! + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + type(nutrient_competition_clm45default_type) function constructor() + ! + ! !DESCRIPTION: + ! Creates an object of type nutrient_competition_clm45default_type. + ! For now, this is simply a place-holder. + + end function constructor + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize the class (currently empty for this version) + ! + class(nutrient_competition_clm45default_type) :: this + type(bounds_type), intent(in) :: bounds + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine calc_plant_nutrient_competition (this, & + bounds, num_soilp, filter_soilp, & + cnveg_state_inst, crop_inst, canopystate_inst, cnveg_carbonstate_inst, & + cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use CNVegStateType , only : cnveg_state_type + use CropType , only : crop_type + use CanopyStateType , only : canopystate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use CNSharedParamsMod , only : use_fun + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + real(r8) , intent(in) :: aroot(bounds%begp:) + real(r8) , intent(in) :: arepr(bounds%begp:) + real(r8) , intent(in) :: fpg_col(bounds%begc:) + + call this%calc_plant_cn_alloc (bounds, num_soilp, filter_soilp, & + cnveg_state_inst, crop_inst, canopystate_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, & + c14_cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + aroot=aroot(bounds%begp:bounds%endp), & + arepr=arepr(bounds%begp:bounds%endp), & + fpg_col=fpg_col(bounds%begc:bounds%endc)) + + end subroutine calc_plant_nutrient_competition + + !----------------------------------------------------------------------- + subroutine calc_plant_cn_alloc (this, bounds, num_soilp, filter_soilp, & + cnveg_state_inst, crop_inst, canopystate_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, & + c14_cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use pftconMod , only : pftcon, npcropmin + use clm_varctl , only : use_c13, use_c14, use_matrixcn + use CNVegStateType , only : cnveg_state_type + use CropType , only : crop_type + use CanopyStateType , only : canopystate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type + use CNSharedParamsMod , only : use_fun + use shr_infnan_mod , only : shr_infnan_isnan +!index for matrixcn + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn + + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + real(r8) , intent(in) :: aroot(bounds%begp:) + real(r8) , intent(in) :: arepr(bounds%begp:) + real(r8) , intent(in) :: fpg_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + integer :: c,p,l,j ! indices + integer :: fp ! lake filter patch index + real(r8):: f1,f2,f3,f4,g1,g2 ! allocation parameters + real(r8):: cnl,cnfr,cnlw,cndw ! C:N ratios for leaf, fine root, and wood + real(r8):: fcur ! fraction of current psn displayed as growth + real(r8):: gresp_storage ! temporary variable for growth resp to storage + real(r8):: nlc ! temporary variable for total new leaf carbon allocation + real(r8):: f5 ! grain allocation parameter + real(r8):: cng ! C:N ratio for grain (= cnlw for now; slevis) + real(r8):: fsmn(bounds%begp:bounds%endp) ! A emperate variable for adjusting FUN uptakes + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(aroot) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(arepr) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(fpg_col) == (/bounds%endc/)), sourcefile, __LINE__) + + associate( & + fpg => fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units) + + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => pftcon%froot_leaf , & ! Input: allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => pftcon%croot_stem , & ! Input: allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => pftcon%stem_leaf , & ! Input: allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => pftcon%flivewd , & ! Input: allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + fcur2 => pftcon%fcur , & ! Input: allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + grperc => pftcon%grperc , & ! Input: growth respiration parameter + grpnow => pftcon%grpnow , & ! Input: growth respiration parameter + + croplive => crop_inst%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + + peaklai => cnveg_state_inst%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleaf => cnveg_state_inst%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnveg_state_inst%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + downreg => cnveg_state_inst%downreg_patch , & ! Output: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + gpp => cnveg_carbonflux_inst%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => cnveg_carbonflux_inst%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + excess_cflux => cnveg_carbonflux_inst%excess_cflux_patch , & ! Output: [real(r8) (:) ] C flux not allocated due to downregulation (gC/m2/s) + plant_calloc => cnveg_carbonflux_inst%plant_calloc_patch , & ! Output: [real(r8) (:) ] total allocated C flux (gC/m2/s) + psnsun_to_cpool => cnveg_carbonflux_inst%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => cnveg_carbonflux_inst%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc => cnveg_carbonflux_inst%cpool_to_leafc_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc_storage => cnveg_carbonflux_inst%cpool_to_leafc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_storage => cnveg_carbonflux_inst%cpool_to_frootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc => cnveg_carbonflux_inst%cpool_to_livestemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_storage => cnveg_carbonflux_inst%cpool_to_livestemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc => cnveg_carbonflux_inst%cpool_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc_storage => cnveg_carbonflux_inst%cpool_to_deadstemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc => cnveg_carbonflux_inst%cpool_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_storage => cnveg_carbonflux_inst%cpool_to_livecrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc => cnveg_carbonflux_inst%cpool_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc_storage => cnveg_carbonflux_inst%cpool_to_deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_gresp_storage => cnveg_carbonflux_inst%cpool_to_gresp_storage_patch , & ! Output: [real(r8) (:) ] allocation to growth respiration storage (gC/m2/s) + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch , & ! Output: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => cnveg_carbonflux_inst%cpool_to_grainc_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain C storage (gC/m2/s) + + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + plant_nalloc => cnveg_nitrogenflux_inst%plant_nalloc_patch , & ! Output: [real(r8) (:) ] total allocated N flux (gN/m2/s) + npool_to_grainn => cnveg_nitrogenflux_inst%npool_to_grainn_patch , & ! Output: [real(r8) (:) ] allocation to grain N (gN/m2/s) + npool_to_grainn_storage => cnveg_nitrogenflux_inst%npool_to_grainn_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain N storage (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => cnveg_nitrogenflux_inst%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + npool_to_leafn => cnveg_nitrogenflux_inst%npool_to_leafn_patch , & ! Output: [real(r8) (:) ] allocation to leaf N (gN/m2/s) + npool_to_leafn_storage => cnveg_nitrogenflux_inst%npool_to_leafn_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf N storage (gN/m2/s) + npool_to_frootn => cnveg_nitrogenflux_inst%npool_to_frootn_patch , & ! Output: [real(r8) (:) ] allocation to fine root N (gN/m2/s) + npool_to_frootn_storage => cnveg_nitrogenflux_inst%npool_to_frootn_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root N storage (gN/m2/s) + npool_to_livestemn => cnveg_nitrogenflux_inst%npool_to_livestemn_patch , & ! Output: [real(r8) (:) ] + npool_to_livestemn_storage => cnveg_nitrogenflux_inst%npool_to_livestemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn => cnveg_nitrogenflux_inst%npool_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn_storage => cnveg_nitrogenflux_inst%npool_to_deadstemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn => cnveg_nitrogenflux_inst%npool_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn_storage => cnveg_nitrogenflux_inst%npool_to_livecrootn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn => cnveg_nitrogenflux_inst%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn_storage => cnveg_nitrogenflux_inst%npool_to_deadcrootn_storage_patch , & ! Output: [real(r8) (:) ] + Npassive => cnveg_nitrogenflux_inst%Npassive_patch , & ! Output: [real(r8) (:) ] Passive N uptake (gN/m2/s) + Nfix => cnveg_nitrogenflux_inst%Nfix_patch , & ! Output: [real(r8) (:) ] Symbiotic BNF (gN/m2/s) + Nactive => cnveg_nitrogenflux_inst%Nactive_patch , & ! Output: [real(r8) (:) ] Mycorrhizal N uptake (gN/m2/s) + Nnonmyc => cnveg_nitrogenflux_inst%Nnonmyc_patch , & ! Output: [real(r8) (:) ] Non-mycorrhizal N uptake (gN/m2/s) + Nam => cnveg_nitrogenflux_inst%Nam_patch , & ! Output: [real(r8) (:) ] AM uptake (gN/m2/s) + Necm => cnveg_nitrogenflux_inst%Necm_patch , & ! Output: [real(r8) (:) ] ECM uptake (gN/m2/s) + sminn_to_plant_fun => cnveg_nitrogenflux_inst%sminn_to_plant_fun_patch , & ! Output: [real(r8) (:) ] Total N uptake of FUN (gN/m2/s) + iretransn_to_ileaf => cnveg_nitrogenflux_inst%iretransn_to_ileaf_ph , & ! Input: [integer] Transfer index (from retranslocation pool to leaf pool) + iretransn_to_ileafst => cnveg_nitrogenflux_inst%iretransn_to_ileafst_ph , & ! Input: [integer] Transfer index (from retranslocation pool to leaf storage pool) + iretransn_to_ifroot => cnveg_nitrogenflux_inst%iretransn_to_ifroot_ph , & ! Input: [integer] Transfer index (from retranslocation pool to fine root pool) + iretransn_to_ifrootst => cnveg_nitrogenflux_inst%iretransn_to_ifrootst_ph , & ! Input: [integer] Transfer index (from retranslocation pool to fine root storage pool) + iretransn_to_ilivestem => cnveg_nitrogenflux_inst%iretransn_to_ilivestem_ph , & ! Input: [integer] Transfer index (from retranslocation pool to live stem pool) + iretransn_to_ilivestemst => cnveg_nitrogenflux_inst%iretransn_to_ilivestemst_ph , & ! Input: [integer] Transfer index (from retranslocation pool to live stem storage pool) + iretransn_to_ideadstem => cnveg_nitrogenflux_inst%iretransn_to_ideadstem_ph , & ! Input: [integer] Transfer index (from retranslocation pool to dead stem pool) + iretransn_to_ideadstemst => cnveg_nitrogenflux_inst%iretransn_to_ideadstemst_ph , & ! Input: [integer] Transfer index (from retranslocation pool to dead stem storage pool) + iretransn_to_ilivecroot => cnveg_nitrogenflux_inst%iretransn_to_ilivecroot_ph , & ! Input: [integer] Transfer index (from retranslocation pool to live coarse root pool) + iretransn_to_ilivecrootst => cnveg_nitrogenflux_inst%iretransn_to_ilivecrootst_ph , & ! Input: [integer] Transfer index (from retranslocation pool to live coarse root storage pool) + iretransn_to_ideadcroot => cnveg_nitrogenflux_inst%iretransn_to_ideadcroot_ph , & ! Input: [integer] Transfer index (from retranslocation pool to dead coarse root pool) + iretransn_to_ideadcrootst => cnveg_nitrogenflux_inst%iretransn_to_ideadcrootst_ph , & ! Input: [integer] Transfer index (from retranslocation pool to dead coarse root storage pool) + iretransn_to_igrain => cnveg_nitrogenflux_inst%iretransn_to_igrain_ph , & ! Input: [integer] Transfer index (from retranslocation pool to grain pool) + iretransn_to_igrainst => cnveg_nitrogenflux_inst%iretransn_to_igrainst_ph , & ! Input: [integer] Transfer index (from retranslocation pool to grain storage pool) + ileaf_to_iretransn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer] Transfer index (from leaf pool to retranslocation pools) + ifroot_to_iretransn => cnveg_nitrogenflux_inst%ifroot_to_iretransn_ph , & ! Input: [integer] Transfer index (from fine root pool to retranslocation pools) + ilivestem_to_iretransn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph & ! Input: [integer] Transfer index (from live stem pool to retranslocation pools) + ) + + ! patch loop to distribute the available N between the competing patches + ! on the basis of relative demand, and allocate C and N to new growth and storage + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + + ! set some local allocation variables + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! There was an error in this formula in previous version, where the coefficient + ! was 0.004 instead of 0.0025. + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + fcur = fcur2(ivt(p)) + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if (croplive(p).and.(.not.shr_infnan_isnan(aleaf(p)))) then + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + else + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + if(use_fun)then ! if we are using FUN, we get the N available from there. + sminn_to_npool(p) = sminn_to_plant_fun(p) + else ! no FUN. :( we get N available from the FPG calculation in soilbiogeochemistry competition. + sminn_to_npool(p) = plant_ndemand(p) * fpg(c) + end if + + plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) + plant_calloc(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) + if (use_matrixcn)then + associate( & + matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch , & ! Output: [real(r8) (:) ] C input of matrix (gC/m2/s) + matrix_Ninput => cnveg_nitrogenflux_inst%matrix_Ninput_patch & ! Output: [real(r8) (:) ] N input of matrix (gN/m2/s) + ) + matrix_Ninput(p) = sminn_to_npool(p)! + retransn_to_npool(p) + matrix_Cinput(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) + end associate + end if + + + if(.not.use_fun)then !ORIGINAL CLM(CN) downregulation code. + excess_cflux(p) = availc(p) - plant_calloc(p) + ! reduce gpp fluxes due to N limitation + if (gpp(p) > 0.0_r8) then + downreg(p) = excess_cflux(p)/gpp(p) + + psnsun_to_cpool(p) = psnsun_to_cpool(p) *(1._r8 - downreg(p)) + psnshade_to_cpool(p) = psnshade_to_cpool(p)*(1._r8 - downreg(p)) + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = & + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = & + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + end if + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = & + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = & + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + end if + end if + + end if !use_fun + + ! calculate the amount of new leaf C dictated by these allocation + ! decisions, and calculate the daily fluxes of C and N to current + ! growth and storage pools + + ! fcur is the proportion of this day's growth that is displayed now, + ! the remainder going into storage for display next year through the + ! transfer pools + + nlc = plant_calloc(p) / c_allometry(p) + + cpool_to_leafc(p) = nlc * fcur + cpool_to_leafc_storage(p) = nlc * (1._r8 - fcur) + cpool_to_frootc(p) = nlc * f1 * fcur + cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_grainc(p) = nlc * f5 * fcur + cpool_to_grainc_storage(p) = nlc * f5 * (1._r8 -fcur) + end if + + ! corresponding N fluxes + npool_to_leafn(p) = (nlc / cnl) * fcur + npool_to_leafn_storage(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + if (use_matrixcn) then + associate( & + matrix_alloc => cnveg_carbonflux_inst%matrix_alloc_patch , & ! Output: [real(r8) (:,:) ] B-matrix for carbon allocation + matrix_nalloc => cnveg_nitrogenflux_inst%matrix_nalloc_patch & ! Output: [real(r8) (:,:) ] B-matrix for nitrogen allocation + ) + matrix_alloc(p,ileaf) = (1.0_r8) / c_allometry(p) * fcur + matrix_alloc(p,ileaf_st) = (1.0_r8) / c_allometry(p) * (1._r8 - fcur) + matrix_alloc(p,ifroot) = (1.0_r8) / c_allometry(p) * f1 * fcur + matrix_alloc(p,ifroot_st) = (1.0_r8) / c_allometry(p) * f1 * (1._r8 - fcur) + + matrix_nalloc(p,ileaf) = ((1.0_r8/cnl) / n_allometry(p)) * fcur + matrix_nalloc(p,ileaf_st) = ((1.0_r8/cnl) / n_allometry(p))* (1._r8 - fcur) + matrix_nalloc(p,ifroot) = ((f1/cnfr) / n_allometry(p)) * fcur + matrix_nalloc(p,ifroot_st) = ((f1/cnfr) / n_allometry(p)) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + matrix_alloc(p,ilivestem) = (1.0_r8) / c_allometry(p) * f3 * f4 * fcur + matrix_alloc(p,ilivestem_st) = (1.0_r8) / c_allometry(p) * f3 * f4 * (1._r8 - fcur) + matrix_alloc(p,ideadstem) = (1.0_r8) / c_allometry(p) * f3 * (1._r8 - f4) * fcur + matrix_alloc(p,ideadstem_st) = (1.0_r8) / c_allometry(p) * f3 * (1._r8 - f4) * (1._r8 - fcur) + matrix_alloc(p,ilivecroot) = (1.0_r8) / c_allometry(p) * f2 * f3 * f4 * fcur + matrix_alloc(p,ilivecroot_st) = (1.0_r8) / c_allometry(p) * f2 * f3 * f4 * (1._r8 - fcur) + matrix_alloc(p,ideadcroot) = (1.0_r8) / c_allometry(p) * f2 * f3 * (1._r8 - f4) * fcur + matrix_alloc(p,ideadcroot_st) = (1.0_r8) / c_allometry(p) * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + + matrix_nalloc(p,ilivestem) = (f3*f4/cnlw) / n_allometry(p) * fcur + matrix_nalloc(p,ilivestem_st) = (f3*f4/cnlw) / n_allometry(p) * (1._r8 - fcur) + matrix_nalloc(p,ideadstem) = (f3 * (1._r8 - f4)/cndw) / n_allometry(p) * fcur + matrix_nalloc(p,ideadstem_st) = (f3 * (1._r8 - f4)/cndw) / n_allometry(p) * (1._r8 - fcur) + matrix_nalloc(p,ilivecroot) = (f2 * f3 * f4/cnlw) / n_allometry(p) * fcur + matrix_nalloc(p,ilivecroot_st) = (f2 * f3 * f4 /cnlw) / n_allometry(p) * (1._r8 - fcur) + matrix_nalloc(p,ideadcroot) = (f2 * f3 * (1._r8 - f4)/cndw) / n_allometry(p) * fcur + matrix_nalloc(p,ideadcroot_st) = (f2 * f3 * (1._r8 - f4)/cndw) / n_allometry(p) *(1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + matrix_alloc(p,ilivestem) = (1.0_r8) / c_allometry(p) * f3 * f4 * fcur + matrix_alloc(p,ilivestem_st) = (1.0_r8) / c_allometry(p) * f3 * f4 * (1._r8 - fcur) + matrix_alloc(p,ideadstem) = (1.0_r8) / c_allometry(p) * f3 * (1._r8 - f4) * fcur + matrix_alloc(p,ideadstem_st) = (1.0_r8) / c_allometry(p) * f3 * (1._r8 - f4) * (1._r8 - fcur) + matrix_alloc(p,ilivecroot) = (1.0_r8) / c_allometry(p) * f2 * f3 * f4 * fcur + matrix_alloc(p,ilivecroot_st) = (1.0_r8) / c_allometry(p) * f2 * f3 * f4 * (1._r8 - fcur) + matrix_alloc(p,ideadcroot) = (1.0_r8) / c_allometry(p) * f2 * f3 * (1._r8 - f4) * fcur + matrix_alloc(p,ideadcroot_st) = (1.0_r8) / c_allometry(p) * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + matrix_alloc(p,igrain) = (1.0_r8) / c_allometry(p) * f5 * fcur + matrix_alloc(p,igrain_st) = (1.0_r8) / c_allometry(p) * f5 * (1._r8 - fcur) + + matrix_nalloc(p,ilivestem) = (f3*f4/cnlw) / n_allometry(p) * fcur + matrix_nalloc(p,ilivestem_st) = (f3*f4/cnlw) / n_allometry(p) * (1._r8 - fcur) + matrix_nalloc(p,ideadstem) = (f3 * (1._r8 - f4)/cndw) / n_allometry(p) * fcur + matrix_nalloc(p,ideadstem_st) = (f3 * (1._r8 - f4)/cndw) / n_allometry(p) * (1._r8 - fcur) + matrix_nalloc(p,ilivecroot) = (f2 * f3 * f4/cnlw) / n_allometry(p) * fcur + matrix_nalloc(p,ilivecroot_st) = (f2 * f3 * f4 /cnlw) / n_allometry(p) * (1._r8 - fcur) + matrix_nalloc(p,ideadcroot) = (f2 * f3 * (1._r8 - f4)/cndw) / n_allometry(p) * fcur + matrix_nalloc(p,ideadcroot_st) = (f2 * f3 * (1._r8 - f4)/cndw) / n_allometry(p) * (1._r8 - fcur) + matrix_nalloc(p,igrain) = (f5 / cng) / n_allometry(p) * fcur + matrix_nalloc(p,igrain_st) = (f5 / cng) / n_allometry(p) *(1._r8 - fcur) + end if + end associate + end if !end use_matrixcn + + ! Calculate the amount of carbon that needs to go into growth + ! respiration storage to satisfy all of the storage growth demands. + ! Allows for the fraction of growth respiration that is released at the + ! time of fixation, versus the remaining fraction that is stored for + ! release at the time of display. Note that all the growth respiration + ! fluxes that get released on a given timestep are calculated in growth_resp(), + ! but that the storage of C for growth resp during display of transferred + ! growth is assigned here. + + gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p) + if (woody(ivt(p)) == 1._r8) then + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p) + + gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_grainc_storage(p) + end if + cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2) + + if(use_matrixcn)then + associate( & + matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch & ! Output: [real(r8) (:) ] C input of matrix (gC/m2/s) + ) + matrix_Cinput(p) = plant_calloc(p) + if(use_c13 .and. psnsun_to_cpool(p)+psnshade_to_cpool(p).ne. 0.)then + associate( & + matrix_C13input => cnveg_carbonflux_inst%matrix_C13input_patch & ! C13 input of matrix + ) + matrix_C13input(p) = plant_calloc(p) * & + ((c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p)+ c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p))/ & + (psnsun_to_cpool(p)+psnshade_to_cpool(p))) + end associate + end if + if(use_c14 .and. psnsun_to_cpool(p)+psnshade_to_cpool(p).ne. 0.)then + associate( & + matrix_C14input => cnveg_carbonflux_inst%matrix_C14input_patch & ! C14 input of matrix + ) + matrix_C14input(p) = plant_calloc(p) * & + ((c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p)+ c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p))/ & + (psnsun_to_cpool(p)+psnshade_to_cpool(p))) + end associate + end if + if(retransn(p) .ne. 0)then + associate( & + matrix_nphtransfer => cnveg_nitrogenflux_inst%matrix_nphtransfer_patch, & ! Output: [real(r8) (:,:,:) ] A-matrix_phenology for nitrogen + matrix_nalloc => cnveg_nitrogenflux_inst%matrix_nalloc_patch & ! Output: [real(r8) (:,:) ] B-matrix for nitrogen allocation + ) + matrix_nphtransfer(p,iretransn_to_ileaf) = matrix_nphtransfer(p,iretransn_to_ileaf) & + + matrix_nalloc(p,ileaf ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ileafst) = matrix_nphtransfer(p,iretransn_to_ileafst) & + + matrix_nalloc(p,ileaf_st ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ifroot) = matrix_nphtransfer(p,iretransn_to_ifroot) & + + matrix_nalloc(p,ifroot ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ifrootst) = matrix_nphtransfer(p,iretransn_to_ifrootst) & + + matrix_nalloc(p,ifroot_st) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ilivestem) = matrix_nphtransfer(p,iretransn_to_ilivestem) & + + matrix_nalloc(p,ilivestem ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ilivestemst) = matrix_nphtransfer(p,iretransn_to_ilivestemst) & + + matrix_nalloc(p,ilivestem_st ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ideadstem) = matrix_nphtransfer(p,iretransn_to_ideadstem) & + + matrix_nalloc(p,ideadstem ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ideadstemst) = matrix_nphtransfer(p,iretransn_to_ideadstemst) & + + matrix_nalloc(p,ideadstem_st ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ilivecroot) = matrix_nphtransfer(p,iretransn_to_ilivecroot) & + + matrix_nalloc(p,ilivecroot ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ilivecrootst) = matrix_nphtransfer(p,iretransn_to_ilivecrootst) & + + matrix_nalloc(p,ilivecroot_st) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ideadcroot) = matrix_nphtransfer(p,iretransn_to_ideadcrootst) & + + matrix_nalloc(p,ideadcroot ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_ideadcrootst) = matrix_nphtransfer(p,iretransn_to_ideadcrootst) & + + matrix_nalloc(p,ideadcroot_st) * retransn_to_npool(p) / retransn(p) + if(ivt(p) >= npcropmin)then + matrix_nphtransfer(p,iretransn_to_igrain) = matrix_nphtransfer(p,iretransn_to_igrain) & + + matrix_nalloc(p,igrain ) * retransn_to_npool(p) / retransn(p) + matrix_nphtransfer(p,iretransn_to_igrainst) = matrix_nphtransfer(p,iretransn_to_igrainst) & + + matrix_nalloc(p,igrain_st ) * retransn_to_npool(p) / retransn(p) + end if + end associate + end if + end associate + end if !end use_matrixcn + end do ! end patch loop + + end associate + + end subroutine calc_plant_cn_alloc + + !----------------------------------------------------------------------- + subroutine calc_plant_nutrient_demand(this, bounds, num_soilp, filter_soilp,& + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot, arepr) + ! + ! !USES: + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use EnergyFluxType , only : energyflux_type + use CNSharedParamsMod , only : use_fun + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + !----------------------------------------------------------------------- + + call this%calc_plant_nitrogen_demand(bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + aroot=aroot(bounds%begp:bounds%endp), & + arepr=arepr(bounds%begp:bounds%endp)) + + end subroutine calc_plant_nutrient_demand + + !----------------------------------------------------------------------- + subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + aroot, arepr) + ! + ! !USES: + use pftconMod , only : npcropmin, pftcon + use pftconMod , only : ntmp_soybean, nirrig_tmp_soybean + use pftconMod , only : ntrp_soybean, nirrig_trp_soybean + use clm_varcon , only : secspday + use clm_varctl , only : use_c13, use_c14, use_matrixcn + use clm_time_manager , only : get_step_size_real + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNSharedParamsMod , only : use_fun + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + ! + ! !LOCAL VARIABLES: + integer :: c,p,l,j ! indices + integer :: fp ! lake filter patch index + real(r8):: mr ! maintenance respiration (gC/m2/s) + real(r8):: f1,f2,f3,f4,g1,g2 ! allocation parameters + real(r8):: cnl,cnfr,cnlw,cndw ! C:N ratios for leaf, fine root, and wood + real(r8):: curmr, curmr_ratio ! xsmrpool temporary variables + real(r8):: f5 ! grain allocation parameter + real(r8):: cng ! C:N ratio for grain (= cnlw for now; slevis) + real(r8):: fleaf ! fraction allocated to leaf + real(r8):: t1 ! temporary variable + real(r8):: dt ! model time step + real(r8):: dayscrecover ! number of days to recover negative cpool + + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(aroot) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(arepr) == (/bounds%endp/)), sourcefile, __LINE__) + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => pftcon%froot_leaf , & ! Input: allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => pftcon%croot_stem , & ! Input: allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => pftcon%stem_leaf , & ! Input: allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => pftcon%flivewd , & ! Input: allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + fleafcn => pftcon%fleafcn , & ! Input: leaf c:n during organ fill + ffrootcn => pftcon%ffrootcn , & ! Input: froot c:n during organ fill + fstemcn => pftcon%fstemcn , & ! Input: stem c:n during organ fill + bfact => pftcon%bfact , & ! Input: parameter used below + aleaff => pftcon%aleaff , & ! Input: parameter used below + arootf => pftcon%arootf , & ! Input: parameter used below + astemf => pftcon%astemf , & ! Input: parameter used below + arooti => pftcon%arooti , & ! Input: parameter used below + fleafi => pftcon%fleafi , & ! Input: parameter used below + allconsl => pftcon%allconsl , & ! Input: parameter used below + allconss => pftcon%allconss , & ! Input: parameter used below + grperc => pftcon%grperc , & ! Input: parameter used below + grpnow => pftcon%grpnow , & ! Input: parameter used below + declfact => pftcon%declfact , & ! Input: + season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal-deciduous leaf habit (0 or 1) + stress_decid => pftcon%stress_decid , & ! Input: binary flag for stress-deciduous leaf habit (0 or 1) + psnsun => photosyns_inst%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_inst%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_inst%c13_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsha => photosyns_inst%c13_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsun => photosyns_inst%c14_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsha => photosyns_inst%c14_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] =gdd since planting (gddplant) + leafout => crop_inst%gddtsoi_patch , & ! Input: [real(r8) (:) ] =gdd from top soil layer temperature + croplive => crop_inst%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest + huileaf => cnveg_state_inst%huileaf_patch , & ! Input: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnveg_state_inst%huigrain_patch , & ! Input: [real(r8) (:) ] same to reach vegetative maturity + peaklai => cnveg_state_inst%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleafi => cnveg_state_inst%aleafi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + astemi => cnveg_state_inst%astemi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + aleaf => cnveg_state_inst%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnveg_state_inst%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + grain_flag => cnveg_state_inst%grain_flag_patch , & ! Output: [real(r8) (:) ] 1: grain fill stage; 0: not + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + tempsum_potential_gpp => cnveg_state_inst%tempsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] temporary annual sum of potential GPP + tempmax_retransn => cnveg_state_inst%tempmax_retransn_patch , & ! Output: [real(r8) (:) ] temporary annual max of retranslocated N pool (gN/m2) + annsum_potential_gpp => cnveg_state_inst%annsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] annual sum of potential GPP + annmax_retransn => cnveg_state_inst%annmax_retransn_patch , & ! Output: [real(r8) (:) ] annual max of retranslocated N pool + + xsmrpool => cnveg_carbonstate_inst%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] + + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + leaf_mr => cnveg_carbonflux_inst%leaf_mr_patch , & ! Input: [real(r8) (:) ] + froot_mr => cnveg_carbonflux_inst%froot_mr_patch , & ! Input: [real(r8) (:) ] + livestem_mr => cnveg_carbonflux_inst%livestem_mr_patch , & ! Input: [real(r8) (:) ] + livecroot_mr => cnveg_carbonflux_inst%livecroot_mr_patch , & ! Input: [real(r8) (:) ] + grain_mr => cnveg_carbonflux_inst%grain_mr_patch , & ! Input: [real(r8) (:) ] + gpp => cnveg_carbonflux_inst%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => cnveg_carbonflux_inst%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + xsmrpool_recover => cnveg_carbonflux_inst%xsmrpool_recover_patch , & ! Output: [real(r8) (:) ] C flux assigned to recovery of negative cpool (gC/m2/s) + psnsun_to_cpool => cnveg_carbonflux_inst%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => cnveg_carbonflux_inst%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + leaf_curmr => cnveg_carbonflux_inst%leaf_curmr_patch , & ! Output: [real(r8) (:) ] + froot_curmr => cnveg_carbonflux_inst%froot_curmr_patch , & ! Output: [real(r8) (:) ] + livestem_curmr => cnveg_carbonflux_inst%livestem_curmr_patch , & ! Output: [real(r8) (:) ] + livecroot_curmr => cnveg_carbonflux_inst%livecroot_curmr_patch , & ! Output: [real(r8) (:) ] + grain_curmr => cnveg_carbonflux_inst%grain_curmr_patch , & ! Output: [real(r8) (:) ] + leaf_xsmr => cnveg_carbonflux_inst%leaf_xsmr_patch , & ! Output: [real(r8) (:) ] + froot_xsmr => cnveg_carbonflux_inst%froot_xsmr_patch , & ! Output: [real(r8) (:) ] + livestem_xsmr => cnveg_carbonflux_inst%livestem_xsmr_patch , & ! Output: [real(r8) (:) ] + livecroot_xsmr => cnveg_carbonflux_inst%livecroot_xsmr_patch , & ! Output: [real(r8) (:) ] + grain_xsmr => cnveg_carbonflux_inst%grain_xsmr_patch , & ! Output: [real(r8) (:) ] + cpool_to_xsmrpool => cnveg_carbonflux_inst%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] + + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + avail_retransn => cnveg_nitrogenflux_inst%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => cnveg_nitrogenflux_inst%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + leafn_to_retransn => cnveg_nitrogenflux_inst%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_retransn => cnveg_nitrogenflux_inst%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch,& ! Output: [real(r8) (:) ] + ileaf_to_iretransn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Input: [integer] Index of phenology related N transfer from leaf pool to retranslocation pools + ifroot_to_iretransn => cnveg_nitrogenflux_inst%ifroot_to_iretransn_ph , & ! Input: [integer] Index of phenology related N transfer from fine root pool to retranslocation pools + ilivestem_to_iretransn=> cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph & ! Input: [integer] Index of phenology related N transfer from live stem pool to retranslocation pools + ) + + ! set time steps + dt = get_step_size_real() + + ! set number of days to recover negative cpool + dayscrecover = params_inst%dayscrecover + + ! loop over patches to assess the total plant N demand + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! get the time step total gross photosynthesis + ! this is coming from the canopy fluxes code, and is the + ! gpp that is used to control stomatal conductance. + ! For the nitrogen downregulation code, this is assumed + ! to be the potential gpp, and the actual gpp will be + ! reduced due to N limitation. + + ! Convert psn from umol/m2/s -> gC/m2/s + + ! The input psn (psnsun and psnsha) are expressed per unit LAI + ! in the sunlit and shaded canopy, respectively. These need to be + ! scaled by laisun and laisha to get the total gpp for allocation + + ! Note that no associate statement is used for the isotope carbon fluxes below + ! since they are not always allocated AND nag compiler will complain if you try to + ! to have an associate statement with unallocated memory + + psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8 + psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8 + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8 + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = c14_psnsun(p) * laisun(p) * 12.011e-6_r8 + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = c14_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p) + + ! get the time step total maintenance respiration + ! These fluxes should already be in gC/m2/s + + mr = leaf_mr(p) + froot_mr(p) + if (woody(ivt(p)) == 1.0_r8) then + mr = mr + livestem_mr(p) + livecroot_mr(p) + else if (ivt(p) >= npcropmin) then + if (croplive(p)) mr = mr + livestem_mr(p) + grain_mr(p) + end if + + ! carbon flux available for allocation + availc(p) = gpp(p) - mr + + ! new code added for isotope calculations, 7/1/05, PET + ! If mr > gpp, then some mr comes from gpp, the rest comes from + ! cpool (xsmr) + if (mr > 0._r8 .and. availc(p) < 0._r8) then + curmr = gpp(p) + curmr_ratio = curmr / mr + else + curmr_ratio = 1._r8 + end if + leaf_curmr(p) = leaf_mr(p) * curmr_ratio + leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p) + froot_curmr(p) = froot_mr(p) * curmr_ratio + froot_xsmr(p) = froot_mr(p) - froot_curmr(p) + livestem_curmr(p) = livestem_mr(p) * curmr_ratio + livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p) + livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio + livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p) + grain_curmr(p) = grain_mr(p) * curmr_ratio + grain_xsmr(p) = grain_mr(p) - grain_curmr(p) + + ! no allocation when available c is negative + availc(p) = max(availc(p),0.0_r8) + + ! test for an xsmrpool deficit + if (xsmrpool(p) < 0.0_r8) then + ! Running a deficit in the xsmrpool, so the first priority is to let + ! some availc from this timestep accumulate in xsmrpool. + ! Determine rate of recovery for xsmrpool deficit + + xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) + if (xsmrpool_recover(p) < availc(p)) then + ! available carbon reduced by amount for xsmrpool recovery + availc(p) = availc(p) - xsmrpool_recover(p) + else + ! all of the available carbon goes to xsmrpool recovery + xsmrpool_recover(p) = availc(p) + availc(p) = 0.0_r8 + end if + cpool_to_xsmrpool(p) = xsmrpool_recover(p) + end if + + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiologfy file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + + ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop + + f5 = 0._r8 ! continued intializations from above + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (croplive(p)) then + ! same phases appear in subroutine CropPhenology + + ! Phase 1 completed: + ! ================== + ! if hui is less than the number of gdd needed for filling of grain + ! leaf emergence also has to have taken place for lai changes to occur + ! and carbon assimilation + ! Next phase: leaf emergence to start of leaf decline + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then + + ! allocation rules for crops based on maturity and linear decrease + ! of amount allocated to roots over course of the growing season + + if (peaklai(p) == 1) then ! lai at maximum allowed + arepr(p) = 0._r8 + aleaf(p) = 1.e-5_r8 + astem(p) = 0._r8 + aroot(p) = 1._r8 - arepr(p) - aleaf(p) - astem(p) + else + arepr(p) = 0._r8 + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * & + min(1._r8, hui(p)/gddmaturity(p)))) + fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) - & + exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / & + (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve) + aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf) + astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + end if + + ! AgroIBIS included here an immediate adjustment to aleaf & astem if the + ! predicted lai from the above allocation coefficients exceeded laimx. + ! We have decided to live with lais slightly higher than laimx by + ! enforcing the cap in the following tstep through the peaklai logic above. + + astemi(p) = astem(p) ! save for use by equations after shift + aleafi(p) = aleaf(p) ! to reproductive phenology stage begins + grain_flag(p) = 0._r8 ! setting to 0 while in phase 2 + + ! Phase 2 completed: + ! ================== + ! shift allocation either when enough gdd are accumulated or maximum number + ! of days has elapsed since planting + + else if (hui(p) >= huigrain(p)) then + + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p)))) + if (astemi(p) > astemf(ivt(p))) then + astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconss(ivt(p)) ))) + end if + if (aleafi(p) > aleaff(ivt(p))) then + aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconsl(ivt(p)) ))) + end if + + !Beth's retranslocation of leafn, stemn, rootn to organ + !Filter excess plant N to retransn pool for organ N + !Only do one time then hold grain_flag till onset next season + + ! slevis: Will astem ever = astemf exactly? + ! Beth's response: ...looks like astem can equal astemf under the right circumstances. + !It might be worth a rewrite to capture what I was trying to do, but the retranslocation for + !corn and wheat begins at the beginning of the grain fill stage, but for soybean I was holding it + !until after the leaf and stem decline were complete. Looking at how astem is calculated, once the + !stem decline is near complete, astem should (usually) be set to astemf. The reason for holding off + !on soybean is that the retranslocation scheme begins at the beginning of the grain phase, when the + !leaf and stem are still growing, but declining. Since carbon is still getting allocated and now + !there is more nitrogen available, the nitrogen can be diverted from grain. For corn and wheat + !the impact was probably enough to boost productivity, but for soybean the nitrogen was better off + !fulfilling the grain fill. It seems that if the peak lai is reached for soybean though that this + !would be bypassed altogether, not the intended outcome. I checked several of my output files and + !they all seemed to be going through the retranslocation loop for soybean - good news. + + if (astem(p) == astemf(ivt(p)) .or. & + (ivt(p) /= ntmp_soybean .and. ivt(p) /= nirrig_tmp_soybean .and.& + ivt(p) /= ntrp_soybean .and. ivt(p) /= nirrig_trp_soybean)) then + if (grain_flag(p) == 0._r8)then + if(.not.use_fun) then + t1 = 1 / dt + leafn_to_retransn(p) = t1 * ((leafc(p) / leafcn(ivt(p))) - (leafc(p) / & + fleafcn(ivt(p)))) + livestemn_to_retransn(p) = t1 * ((livestemc(p) / livewdcn(ivt(p))) - (livestemc(p) / & + fstemcn(ivt(p)))) + frootn_to_retransn(p) = 0._r8 + if (ffrootcn(ivt(p)) > 0._r8) then + frootn_to_retransn(p) = t1 * ((frootc(p) / frootcn(ivt(p))) - (frootc(p) / & + ffrootcn(ivt(p)))) + end if + else !leafn retrans flux is handled in phenology + frootn_to_retransn(p) = 0._r8 + livestemn_to_retransn(p)=0.0_r8 + end if !fun + grain_flag(p) = 1._r8 + if(use_matrixcn)then + if(leafn(p) .ne. 0._r8)then + leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) + end if + if(frootn(p) .ne. 0._r8)then + frootn_to_retransn(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iretransn,frootn_to_retransn(p) / frootn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) + end if + if(livestemn(p) .ne. 0._r8)then + livestemn_to_retransn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iretransn,livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) + end if + end if + end if + end if + + arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p) + + else ! pre emergence + aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant + astem(p) = 0._r8 ! because crops have no live carbon pools; + aroot(p) = 0._r8 ! this applies to this "else" and to the "else" + arepr(p) = 0._r8 ! a few lines down + end if + + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + + else ! .not croplive + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! based on available C, use constant allometric relationships to + ! determine N requirements + + !RF. I removed the growth respiration from this, because it is used to calculate + !plantCN for N uptake AND c_allometry for allocation. If we add gresp to the + !allometry calculation then we allocate too much carbon since gresp is not allocated here. + if(.not.use_fun)then + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else + c_allometry(p) = 1._r8+g1+f1+f1*g1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + end if + else !no FUN. + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + c_allometry(p) = (1._r8)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else + c_allometry(p) = 1._r8+f1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + end if + end if !use_fun + + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) + + ! retranslocated N deployment depends on seasonal cycle of potential GPP + ! (requires one year run to accumulate demand) + + tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p) + + ! Adding the following line to carry max retransn info to CN Annual Update + tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p)) + + ! Beth's code: crops pull from retransn pool only during grain fill; + ! retransn pool has N from leaves, stems, and roots for + ! retranslocation + + if(.not.use_fun)then + + if (ivt(p) >= npcropmin .and. grain_flag(p) == 1._r8) then + avail_retransn(p) = plant_ndemand(p) + else if (ivt(p) < npcropmin .and. annsum_potential_gpp(p) > 0._r8) then + avail_retransn(p) = (annmax_retransn(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + else + avail_retransn(p) = 0.0_r8 + end if + + ! make sure available retrans N doesn't exceed storage + avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt) + + ! modify plant N demand according to the availability of + ! retranslocated N + ! take from retransn pool at most the flux required to meet + ! plant ndemand + + if (plant_ndemand(p) > avail_retransn(p)) then + retransn_to_npool(p) = avail_retransn(p) + else + retransn_to_npool(p) = plant_ndemand(p) + end if + + if ( .not. use_fun ) then + plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p) + else + if (season_decid(ivt(p)) == 1._r8.or.stress_decid(ivt(p))==1._r8) then + plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p) + end if + end if + + end if !use_fun + + end do ! end patch loop + + end associate + + end subroutine calc_plant_nitrogen_demand + +end module NutrientCompetitionCLM45defaultMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 new file mode 100755 index 000000000..99daa738f --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 @@ -0,0 +1,87 @@ +module NutrientCompetitionFactoryMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Factory to create an instance of nutrient_competition_method_type. This module figures + ! out the particular type to return. + ! + ! !USES: + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + + implicit none + save + private + ! + ! !PUBLIC ROUTINES: + public :: create_nutrient_competition_method ! create an object of class nutrient_competition_method_type + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + function create_nutrient_competition_method(bounds) result(nutrient_competition_method) + ! + ! !DESCRIPTION: + ! Create and return an object of nutrient_competition_method_type. The particular type + ! is determined based on a namelist parameter. + ! + ! !USES: + use shr_kind_mod , only : SHR_KIND_CL + use NutrientCompetitionMethodMod , only : nutrient_competition_method_type + use NutrientCompetitionCLM45defaultMod, only : nutrient_competition_clm45default_type + use NutrientCompetitionFlexibleCNMod , only : nutrient_competition_FlexibleCN_type + use decompMod , only : bounds_type + + ! FIXME(bja, 2015-06) need to pass method control in as a parameter + ! instead of relying on a global! + use clm_varctl, only : use_flexibleCN + + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type), allocatable :: nutrient_competition_method ! function result + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + ! For now, hard-code the method. Eventually this will be set from namelist, either by + ! this routine (appropriate if the 'method' is in its own namelist group), or do the + ! namelist read outside this module and pass the method in as a parameter (appropriate + ! if the 'method' is part of a larger namelist group). + character(len=SHR_KIND_CL) :: method + + character(len=*), parameter :: subname = 'create_nutrient_competition_method' + !----------------------------------------------------------------------- + + ! FIXME(bja, 2015-06) flexible_cn may need to be + ! merged with other nitrogen code, so a more robust method of + ! selecting the competition method will depend on how the science + ! is merged. + method = "clm45default" + if (use_flexibleCN) then + method = "flexible_cn" + end if + + select case (trim(method)) + + case ("clm45default") + allocate(nutrient_competition_method, & + source=nutrient_competition_clm45default_type()) + + case ("flexible_cn") + allocate(nutrient_competition_method, & + source=nutrient_competition_FlexibleCN_type()) + + case default + write(iulog,*) subname//' ERROR: unknown method: ', method + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + call nutrient_competition_method%Init(bounds) + + end function create_nutrient_competition_method + +end module NutrientCompetitionFactoryMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 new file mode 100755 index 000000000..bd6608bcb --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 @@ -0,0 +1,1987 @@ +module NutrientCompetitionFlexibleCNMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! DESCRIPTION + ! module contains different subroutines to do soil nutrient competition dynamics + ! + ! FIXME(bja, 2015-08) This module was copied from + ! NutrientCompetitionCLM45default then flexible cn modifications + ! were added for the clm50 nitrogen science changes (r120). There is + ! a significant amount of duplicate code between the two + ! modules. They need to be reexamined and the common code pulled out + ! into a common base class. + ! + ! created by Jinyun Tang, Sep 8, 2014 + ! modified by Mariana Vertenstein, Nov 15, 2014 + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use NutrientCompetitionMethodMod, only : nutrient_competition_method_type + use NutrientCompetitionMethodMod, only : params_inst + use clm_varctl , only : iulog, use_matrixcn + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: nutrient_competition_FlexibleCN_type + ! + type, extends(nutrient_competition_method_type) :: nutrient_competition_FlexibleCN_type + private + real(r8), pointer :: actual_leafcn(:) ! leaf CN ratio used by flexible CN + real(r8), pointer :: actual_storage_leafcn(:) ! storage leaf CN ratio used by flexible CN + contains + ! public methocs + procedure, public :: Init ! Initialization + procedure, public :: calc_plant_nutrient_competition ! calculate nutrient yield rate from competition + procedure, public :: calc_plant_nutrient_demand ! calculate plant nutrient demand + ! + ! private methods + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: calc_plant_cn_alloc + procedure, private :: calc_plant_nitrogen_demand + end type nutrient_competition_FlexibleCN_type + ! + interface nutrient_competition_FlexibleCN_type + ! initialize a new nutrient_competition_FlexibleCN_type object + module procedure constructor + end interface nutrient_competition_FlexibleCN_type + ! + + logical,parameter :: matrixcheck_ph = .True. + logical,parameter :: acc_ph = .False. + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + type(nutrient_competition_FlexibleCN_type) function constructor() + ! + ! !DESCRIPTION: + ! Creates an object of type nutrient_competition_FlexibleCN_type. + ! For now, this is simply a place-holder. + end function constructor + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize the class + ! + class(nutrient_competition_FlexibleCN_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Allocate memory for the class data + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type) :: this + type(bounds_type), intent(in) :: bounds + + allocate(this%actual_leafcn(bounds%begp:bounds%endp)) ; this%actual_leafcn(:) = nan + allocate(this%actual_storage_leafcn(bounds%begp:bounds%endp)) ; this%actual_storage_leafcn(:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Send data to history file + ! + ! !USES: + use histFileMod , only : hist_addfld1d + use clm_varcon , only : spval + ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + + this%actual_leafcn(begp:endp) = spval + call hist_addfld1d (fname='LEAFCN', units='gC/gN', & + avgflag='A', long_name='Leaf CN ratio used for flexible CN', & + ptr_patch=this%actual_leafcn ) + this%actual_storage_leafcn(begp:endp) = spval + call hist_addfld1d (fname='LEAFCN_STORAGE', units='gC/gN', & + avgflag='A', long_name='Storage Leaf CN ratio used for flexible CN', & + ptr_patch=this%actual_storage_leafcn, default='inactive') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine calc_plant_nutrient_competition (this, & + bounds, num_soilp, filter_soilp, & + cnveg_state_inst, crop_inst, canopystate_inst, cnveg_carbonstate_inst, & + cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use CNVegStateType , only : cnveg_state_type + use CropType , only : crop_type + use CanopyStateType , only : canopystate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + real(r8), intent(in) :: aroot (bounds%begp:) + real(r8), intent(in) :: arepr (bounds%begp:) + real(r8), intent(in) :: fpg_col (bounds%begc:) + + call this%calc_plant_cn_alloc(bounds, num_soilp, filter_soilp, & + cnveg_state_inst, crop_inst, canopystate_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, & + c14_cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot=aroot(bounds%begp:bounds%endp), & + arepr=arepr(bounds%begp:bounds%endp), & + fpg_col=fpg_col(bounds%begc:bounds%endc)) + + end subroutine calc_plant_nutrient_competition + +!----------------------------------------------------------------------- + subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & + cnveg_state_inst, crop_inst, canopystate_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, & + c14_cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use pftconMod , only : pftcon, npcropmin + use clm_varctl , only : use_c13, use_c14, carbon_resp_opt,use_matrixcn + use clm_varctl , only : downreg_opt + use clm_varctl , only : CN_residual_opt + use clm_varctl , only : CN_partition_opt + use clm_time_manager , only : get_step_size_real + use CNVegStateType , only : cnveg_state_type + use CropType , only : crop_type + use CanopyStateType , only : canopystate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use CNSharedParamsMod , only : use_fun + use CNPrecisionControlMod , only : n_min + use clm_varcon , only : spval + !index for matrixcn + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn,nvegnpool + use CNVegMatrixMod , only : matrix_update_phn + + ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + real(r8) , intent(in) :: aroot(bounds%begp:) + real(r8) , intent(in) :: arepr(bounds%begp:) + real(r8) , intent(in) :: fpg_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp ! lake filter patch index + real(r8) :: f1,f2,f3,f4,g1,g2 ! allocation parameters + real(r8) :: cnl,cnfr,cnlw,cndw ! C:N ratios for leaf, fine root, and wood + real(r8) :: fcur ! fraction of current psn displayed as growth + real(r8) :: gresp_storage ! temporary variable for growth resp to storage + real(r8) :: matrix_nalloc_total ! temporary variable + real(r8) :: nlc ! temporary variable for total new leaf carbon allocation + real(r8) :: f5 ! grain allocation parameter + real(r8) :: cng ! C:N ratio for grain (= cnlw for now; slevis) + real(r8) :: dt ! model time step + real(r8):: fsmn(bounds%begp:bounds%endp) ! A emperate variable for adjusting FUN uptakes + + real(r8):: frootcn_storage_actual + real(r8):: frootcn_actual + real(r8):: livestemcn_storage_actual + real(r8):: livestemcn_actual + real(r8):: livecrootcn_storage_actual + real(r8):: livecrootcn_actual + real(r8):: leafcn_max + real(r8):: frootcn_max + real(r8):: livewdcn_max + real(r8):: frac_resp + real(r8):: npool_to_veg + real(r8):: cpool_to_veg + real(r8) :: npool_to_leafn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_leafn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_leafn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_leafn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_frootn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_frootn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_frootn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_frootn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_livestemn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_livestemn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_livestemn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_livestemn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_livecrootn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_livecrootn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_livecrootn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_livecrootn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadstemn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadstemn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadstemn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadstemn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadcrootn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadcrootn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadcrootn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadcrootn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_grainn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_grainn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_grainn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_grainn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: total_plant_Ndemand (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_leafn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_leafn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_frootn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_frootn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_livestemn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_livestemn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_deadstemn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_deadstemn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_livecrootn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_livecrootn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_deadcrootn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_deadcrootn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_grainn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_grainn_storage (bounds%begp:bounds%endp) + real(r8) :: tmp + + ! ----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(aroot) == (/bounds%endp/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(arepr) == (/bounds%endp/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(fpg_col) == (/bounds%endc/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(this%actual_storage_leafcn) >= (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((lbound(this%actual_storage_leafcn) <= (/bounds%begp/)), sourcefile, __LINE__) + + associate( & + fpg => fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units) + + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => pftcon%froot_leaf , & ! Input: allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => pftcon%croot_stem , & ! Input: allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => pftcon%stem_leaf , & ! Input: allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => pftcon%flivewd , & ! Input: allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + fcur2 => pftcon%fcur , & ! Input: allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + grperc => pftcon%grperc , & ! Input: growth respiration parameter + grpnow => pftcon%grpnow , & ! Input: growth respiration parameter + evergreen => pftcon%evergreen , & ! Input: binary flag for evergreen leaf habit (0 or 1) + + croplive => crop_inst%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + + peaklai => cnveg_state_inst%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleaf => cnveg_state_inst%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnveg_state_inst%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + downreg => cnveg_state_inst%downreg_patch , & ! Output: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + gpp => cnveg_carbonflux_inst%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => cnveg_carbonflux_inst%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + excess_cflux => cnveg_carbonflux_inst%excess_cflux_patch , & ! Output: [real(r8) (:) ] C flux not allocated due to downregulation (gC/m2/s) + plant_calloc => cnveg_carbonflux_inst%plant_calloc_patch , & ! Output: [real(r8) (:) ] total allocated C flux (gC/m2/s) + npp_growth => cnveg_carbonflux_inst%npp_growth_patch , & ! output: [real(r8) (:) ] c for growth in fun. g/m2/s + cpool_to_resp => cnveg_carbonflux_inst%cpool_to_resp_patch , & ! output: [real(r8) (:) ] + cpool_to_leafc_resp => cnveg_carbonflux_inst%cpool_to_leafc_resp_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc_storage_resp => cnveg_carbonflux_inst%cpool_to_leafc_storage_resp_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_resp => cnveg_carbonflux_inst%cpool_to_frootc_resp_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_storage_resp => cnveg_carbonflux_inst%cpool_to_frootc_storage_resp_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_resp => cnveg_carbonflux_inst%cpool_to_livecrootc_resp_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_storage_resp => cnveg_carbonflux_inst%cpool_to_livecrootc_storage_resp_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_resp => cnveg_carbonflux_inst%cpool_to_livestemc_resp_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_storage_resp => cnveg_carbonflux_inst%cpool_to_livestemc_storage_resp_patch , & ! Output: [real(r8) (:) ] + psnsun_to_cpool => cnveg_carbonflux_inst%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => cnveg_carbonflux_inst%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc => cnveg_carbonflux_inst%cpool_to_leafc_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc_storage => cnveg_carbonflux_inst%cpool_to_leafc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_storage => cnveg_carbonflux_inst%cpool_to_frootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc => cnveg_carbonflux_inst%cpool_to_livestemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_storage => cnveg_carbonflux_inst%cpool_to_livestemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc => cnveg_carbonflux_inst%cpool_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc_storage => cnveg_carbonflux_inst%cpool_to_deadstemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc => cnveg_carbonflux_inst%cpool_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_storage => cnveg_carbonflux_inst%cpool_to_livecrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc => cnveg_carbonflux_inst%cpool_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc_storage => cnveg_carbonflux_inst%cpool_to_deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_gresp_storage => cnveg_carbonflux_inst%cpool_to_gresp_storage_patch , & ! Output: [real(r8) (:) ] allocation to growth respiration storage (gC/m2/s) + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch , & ! Output: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => cnveg_carbonflux_inst%cpool_to_grainc_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain C storage (gC/m2/s) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + npool => cnveg_nitrogenstate_inst%npool_patch , & ! Input: [real(r8) (:) ] (gN/m2) temporary plant N pool + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + plant_nalloc => cnveg_nitrogenflux_inst%plant_nalloc_patch , & ! Output: [real(r8) (:) ] total allocated N flux (gN/m2/s) + npool_to_grainn => cnveg_nitrogenflux_inst%npool_to_grainn_patch , & ! Output: [real(r8) (:) ] allocation to grain N (gN/m2/s) + npool_to_grainn_storage => cnveg_nitrogenflux_inst%npool_to_grainn_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain N storage (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + sminn_to_npool => cnveg_nitrogenflux_inst%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + npool_to_leafn => cnveg_nitrogenflux_inst%npool_to_leafn_patch , & ! Output: [real(r8) (:) ] allocation to leaf N (gN/m2/s) + npool_to_leafn_storage => cnveg_nitrogenflux_inst%npool_to_leafn_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf N storage (gN/m2/s) + npool_to_frootn => cnveg_nitrogenflux_inst%npool_to_frootn_patch , & ! Output: [real(r8) (:) ] allocation to fine root N (gN/m2/s) + npool_to_frootn_storage => cnveg_nitrogenflux_inst%npool_to_frootn_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root N storage (gN/m2/s) + npool_to_livestemn => cnveg_nitrogenflux_inst%npool_to_livestemn_patch , & ! Output: [real(r8) (:) ] + npool_to_livestemn_storage => cnveg_nitrogenflux_inst%npool_to_livestemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn => cnveg_nitrogenflux_inst%npool_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn_storage => cnveg_nitrogenflux_inst%npool_to_deadstemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn => cnveg_nitrogenflux_inst%npool_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn_storage => cnveg_nitrogenflux_inst%npool_to_livecrootn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn => cnveg_nitrogenflux_inst%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn_storage => cnveg_nitrogenflux_inst%npool_to_deadcrootn_storage_patch , & ! Output: [real(r8) (:) ] + Npassive => cnveg_nitrogenflux_inst%Npassive_patch , & ! Output: [real(r8) (:) ] Passive N uptake (gN/m2/s) + Nfix => cnveg_nitrogenflux_inst%Nfix_patch , & ! Output: [real(r8) (:) ] Symbiotic BNF (gN/m2/s) + Nactive => cnveg_nitrogenflux_inst%Nactive_patch , & ! Output: [real(r8) (:) ] Mycorrhizal N uptake (gN/m2/s) + Nnonmyc => cnveg_nitrogenflux_inst%Nnonmyc_patch , & ! Output: [real(r8) (:) ] Non-mycorrhizal N uptake (gN/m2/s) + Nam => cnveg_nitrogenflux_inst%Nam_patch , & ! Output: [real(r8) (:) ] AM uptake (gN/m2/s) + Necm => cnveg_nitrogenflux_inst%Necm_patch , & ! Output: [real(r8) (:) ] ECM uptake (gN/m2/s) + sminn_to_plant_fun => cnveg_nitrogenflux_inst%sminn_to_plant_fun_patch , & ! Output: [real(r8) (:) ] Total soil N uptake of FUN (gN/m2/s) + + iretransn_to_ileaf => cnveg_nitrogenflux_inst%iretransn_to_ileaf_ph , & ! Transfer index (from retranslocation pool to leaf pool) + iretransn_to_ileafst => cnveg_nitrogenflux_inst%iretransn_to_ileafst_ph , & ! Transfer index (from retranslocation pool to leaf storage pool) + iretransn_to_ifroot => cnveg_nitrogenflux_inst%iretransn_to_ifroot_ph , & ! Transfer index (from retranslocation pool to fine root pool) + iretransn_to_ifrootst => cnveg_nitrogenflux_inst%iretransn_to_ifrootst_ph , & ! Transfer index (from retranslocation pool to fine root storage pool) + iretransn_to_ilivestem => cnveg_nitrogenflux_inst%iretransn_to_ilivestem_ph , & ! Transfer index (from retranslocation pool to live stem pool) + iretransn_to_ilivestemst => cnveg_nitrogenflux_inst%iretransn_to_ilivestemst_ph , & ! Transfer index (from retranslocation pool to live stem storage pool) + iretransn_to_ideadstem => cnveg_nitrogenflux_inst%iretransn_to_ideadstem_ph , & ! Transfer index (from retranslocation pool to dead stem pool) + iretransn_to_ideadstemst => cnveg_nitrogenflux_inst%iretransn_to_ideadstemst_ph , & ! Transfer index (from retranslocation pool to dead stem storage pool) + iretransn_to_ilivecroot => cnveg_nitrogenflux_inst%iretransn_to_ilivecroot_ph , & ! Transfer index (from retranslocation pool to live coarse root pool) + iretransn_to_ilivecrootst => cnveg_nitrogenflux_inst%iretransn_to_ilivecrootst_ph , & ! Transfer index (from retranslocation pool to live coarse root storage pool) + iretransn_to_ideadcroot => cnveg_nitrogenflux_inst%iretransn_to_ideadcroot_ph , & ! Transfer index (from retranslocation pool to dead coarse root pool) + iretransn_to_ideadcrootst => cnveg_nitrogenflux_inst%iretransn_to_ideadcrootst_ph , & ! Transfer index (from retranslocation pool to dead coarse root storage pool) + iretransn_to_igrain => cnveg_nitrogenflux_inst%iretransn_to_igrain_ph , & ! Transfer index (from retranslocation pool to grain pool) + iretransn_to_igrainst => cnveg_nitrogenflux_inst%iretransn_to_igrainst_ph , & ! Transfer index (from retranslocation pool to grain storage pool) + iretransn_to_iout => cnveg_nitrogenflux_inst%iretransn_to_iout_ph , & ! Transfer index (from retranslocation pool to external) + ileaf_to_iretransn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & ! Transfer index (from leaf pool to retranslocation pools) + ifroot_to_iretransn => cnveg_nitrogenflux_inst%ifroot_to_iretransn_ph , & ! Transfer index (from fine root pool to retranslocation pools) + ilivestem_to_iretransn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph & ! Transfer index (from live stem pool to retranslocation pools) + ) + + ! set time steps + dt = get_step_size_real() + + ! patch loop to distribute the available N between the competing patches + ! on the basis of relative demand, and allocate C and N to new growth and storage + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! set some local allocation variables + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! There was an error in this formula in previous version, where the coefficient + ! was 0.004 instead of 0.0025. + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + fcur = fcur2(ivt(p)) + + if (.not. downreg_opt) then + if (evergreen(ivt(p)) == 1._r8) then + fcur = 0.0_r8 + end if + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if (croplive(p)) then + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + else + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! increase fcur linearly with ndays_active, until fcur reaches 1.0 at + ! ndays_active = days/year. This prevents the continued storage of C and N. + ! turning off this correction (PET, 12/11/03), instead using bgtr in + ! phenology algorithm. + + if(use_fun)then ! if we are using FUN, we get the N available from there. + sminn_to_npool(p) = sminn_to_plant_fun(p) + else ! no FUN. :( we get N available from the FPG calculation in soilbiogeochemistry competition. + sminn_to_npool(p) = plant_ndemand(p) * fpg(c) + end if + + plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) + if(use_matrixcn)then + associate( & + matrix_Ninput => cnveg_nitrogenflux_inst%matrix_Ninput_patch & ! N input of matrix + ) + matrix_Ninput(p) = sminn_to_npool(p)! + retransn_to_npool(p) + end associate + end if + + if(.not.use_fun)then + if (downreg_opt) then + ! calculate the associated carbon allocation, and the excess + ! carbon flux that must be accounted for through downregulation + plant_calloc(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) + excess_cflux(p) = availc(p) - plant_calloc(p) + + if(use_matrixcn)then + associate( & + matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch & ! C input of matrix + ) + matrix_Cinput(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) + end associate + end if + + ! reduce gpp fluxes due to N limitation + if (gpp(p) > 0.0_r8) then + downreg(p) = excess_cflux(p)/gpp(p) + + psnsun_to_cpool(p) = psnsun_to_cpool(p) *(1._r8 - downreg(p)) + psnshade_to_cpool(p) = psnshade_to_cpool(p)*(1._r8 - downreg(p)) + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = & + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = & + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + endif + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = & + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = & + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + endif + end if + end if + end if + + + if(use_fun)then + plant_calloc(p) = npp_growth(p) + if(use_matrixcn)then + cnveg_carbonflux_inst%matrix_Cinput_patch(p) = npp_growth(p) + end if + else + if (.not. downreg_opt) then + plant_calloc(p) = availc(p) + if(use_matrixcn)then + cnveg_carbonflux_inst%matrix_Cinput_patch(p) = availc(p) + end if + end if + end if + + ! calculate the amount of new leaf C dictated by these allocation + ! decisions, and calculate the daily fluxes of C and N to current + ! growth and storage pools + + ! fcur is the proportion of this day's growth that is displayed now, + ! the remainder going into storage for display next year through the + ! transfer pools + + nlc = plant_calloc(p) / c_allometry(p) + cpool_to_leafc(p) = nlc * fcur + cpool_to_leafc_storage(p) = nlc * (1._r8 - fcur) + cpool_to_frootc(p) = nlc * f1 * fcur + cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur) + if(use_matrixcn)then + cpool_to_veg = cpool_to_leafc(p) + cpool_to_leafc_storage(p) & + + cpool_to_frootc(p) + cpool_to_frootc_storage(p) + end if + if (woody(ivt(p)) == 1._r8) then + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + if(use_matrixcn)then + cpool_to_veg = cpool_to_veg & + + cpool_to_livestemc(p) + cpool_to_livestemc_storage(p) & + + cpool_to_deadstemc(p) + cpool_to_deadstemc_storage(p) & + + cpool_to_livecrootc(p) + cpool_to_livecrootc_storage(p) & + + cpool_to_deadcrootc(p) + cpool_to_deadcrootc_storage(p) + end if + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_grainc(p) = nlc * f5 * fcur + cpool_to_grainc_storage(p) = nlc * f5 * (1._r8 -fcur) + if(use_matrixcn)then + cpool_to_veg = cpool_to_veg & + + cpool_to_livestemc(p) + cpool_to_livestemc_storage(p) & + + cpool_to_deadstemc(p) + cpool_to_deadstemc_storage(p) & + + cpool_to_livecrootc(p) + cpool_to_livecrootc_storage(p) & + + cpool_to_deadcrootc(p) + cpool_to_deadcrootc_storage(p) & + + cpool_to_grainc(p) + cpool_to_grainc_storage(p) + end if + end if + + if (use_matrixcn) then + associate( & + matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch, & ! C input of matrix + matrix_alloc => cnveg_carbonflux_inst%matrix_alloc_patch & ! B-matrix for carbon allocation + ) + matrix_Cinput(p) = cpool_to_veg + if(cpool_to_veg .ne. 0)then + matrix_alloc(p,ileaf) = cpool_to_leafc(p) / cpool_to_veg + matrix_alloc(p,ileaf_st) = cpool_to_leafc_storage(p) / cpool_to_veg + matrix_alloc(p,ifroot) = cpool_to_frootc(p) / cpool_to_veg + matrix_alloc(p,ifroot_st) = cpool_to_frootc_storage(p) / cpool_to_veg + end if + + if (woody(ivt(p)) == 1._r8) then + if(cpool_to_veg .ne. 0)then + matrix_alloc(p,ilivestem) = cpool_to_livestemc(p) / cpool_to_veg + matrix_alloc(p,ilivestem_st) = cpool_to_livestemc_storage(p) / cpool_to_veg + matrix_alloc(p,ideadstem) = cpool_to_deadstemc(p) / cpool_to_veg + matrix_alloc(p,ideadstem_st) = cpool_to_deadstemc_storage(p) / cpool_to_veg + matrix_alloc(p,ilivecroot) = cpool_to_livecrootc(p) / cpool_to_veg + matrix_alloc(p,ilivecroot_st) = cpool_to_livecrootc_storage(p) / cpool_to_veg + matrix_alloc(p,ideadcroot) = cpool_to_deadcrootc(p) / cpool_to_veg + matrix_alloc(p,ideadcroot_st) = cpool_to_deadcrootc_storage(p) / cpool_to_veg + end if + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if(cpool_to_veg .ne. 0)then + matrix_alloc(p,ilivestem) = cpool_to_livestemc(p) / cpool_to_veg + matrix_alloc(p,ilivestem_st) = cpool_to_livestemc_storage(p) / cpool_to_veg + matrix_alloc(p,ideadstem) = cpool_to_deadstemc(p) / cpool_to_veg + matrix_alloc(p,ideadstem_st) = cpool_to_deadstemc_storage(p) / cpool_to_veg + matrix_alloc(p,ilivecroot) = cpool_to_livecrootc(p) / cpool_to_veg + matrix_alloc(p,ilivecroot_st) = cpool_to_livecrootc_storage(p) / cpool_to_veg + matrix_alloc(p,ideadcroot) = cpool_to_deadcrootc(p) / cpool_to_veg + matrix_alloc(p,ideadcroot_st) = cpool_to_deadcrootc_storage(p) / cpool_to_veg + matrix_alloc(p,igrain) = cpool_to_grainc(p) / cpool_to_veg + matrix_alloc(p,igrain_st) = cpool_to_grainc_storage(p) / cpool_to_veg + end if + end if + end associate + end if !use_matrixcn + + if (downreg_opt) then + ! corresponding N fluxes + npool_to_leafn(p) = (nlc / cnl) * fcur + npool_to_leafn_storage(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + end if + + if (downreg_opt .eqv. .false. .AND. CN_partition_opt == 0) then + + ! N transfer depends on supply and demand + npool_to_frootn_demand(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_supply(p) = npool(p)/dt * fcur + npool_to_frootn(p) = max(min(npool_to_frootn_supply(p),npool_to_frootn_demand(p)),0.0_r8) + + npool_to_frootn_storage_demand(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + npool_to_frootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) + npool_to_frootn_storage(p) = max(min(npool_to_frootn_storage_supply(p),npool_to_frootn_storage_demand(p)),0.0_r8) + + npool_to_leafn_demand(p) = (nlc / cnl) * fcur + npool_to_leafn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) + npool_to_leafn(p) = max(min(npool_to_leafn_supply(p),npool_to_leafn_demand(p)),0.0_r8) + + npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_leafn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) + npool_to_leafn_storage(p) = max(min(npool_to_leafn_storage_supply(p),npool_to_leafn_storage_demand(p)),0.0_r8) + if (CN_residual_opt == 1) then + npool_to_leafn(p) = max(npool_to_leafn_supply(p),0.0_r8) + npool_to_leafn_storage(p) = max(npool_to_leafn_storage_supply(p),0.0_r8) + end if + + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn_demand(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) + npool_to_livestemn(p) = max(min(npool_to_livestemn_supply(p),npool_to_livestemn_demand(p)),0.0_r8) + + npool_to_livestemn_storage_demand(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_livestemn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) + npool_to_livestemn_storage(p) = max(min(npool_to_livestemn_storage_supply(p), & + npool_to_livestemn_storage_demand(p)),0.0_r8) + + npool_to_livecrootn_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) + npool_to_livecrootn(p) = max(min(npool_to_livecrootn_supply(p),npool_to_livecrootn_demand(p)),0.0_r8) + + npool_to_livecrootn_storage_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_livecrootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) + npool_to_livecrootn_storage(p) = max(min(npool_to_livecrootn_storage_supply(p), & + npool_to_livecrootn_storage_demand(p)),0.0_r8) + + npool_to_deadstemn_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) + npool_to_deadstemn(p) = max(min(npool_to_deadstemn_supply(p),npool_to_deadstemn_demand(p)),0.0_r8) + + npool_to_deadstemn_storage_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_deadstemn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) + npool_to_deadstemn_storage(p) = max(min(npool_to_deadstemn_storage_supply(p), & + npool_to_deadstemn_storage_demand(p)),0.0_r8) + + npool_to_deadcrootn_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) + npool_to_deadcrootn(p) = max(min(npool_to_deadcrootn_supply(p),npool_to_deadcrootn_demand(p)),0.0_r8) + + npool_to_deadcrootn_storage_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_deadcrootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) - npool_to_deadstemn_storage(p) + npool_to_deadcrootn_storage(p) = max(min(npool_to_deadcrootn_storage_supply(p), & + npool_to_deadcrootn_storage_demand(p)),0.0_r8) + + npool_to_leafn_demand(p) = (nlc / cnl) * fcur + npool_to_leafn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) - npool_to_deadcrootn(p) + npool_to_leafn(p) = max(min(npool_to_leafn_supply(p),npool_to_leafn_demand(p)),0.0_r8) + + npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_leafn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) - npool_to_deadstemn_storage(p) - & + npool_to_deadcrootn_storage(p) + npool_to_leafn_storage(p) = max(min(npool_to_leafn_storage_supply(p),& + npool_to_leafn_storage_demand(p)),0.0_r8) + + if (CN_residual_opt == 1) then + npool_to_leafn(p) = max(npool_to_leafn_supply(p),0.0_r8) + npool_to_leafn_storage(p) = max(npool_to_leafn_storage_supply(p),0.0_r8) + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn_demand(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) + npool_to_livestemn(p) = max(min(npool_to_livestemn_supply(p),npool_to_livestemn_demand(p)),0.0_r8) + + npool_to_livestemn_storage_demand(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_livestemn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) + npool_to_livestemn_storage(p) = max(min(npool_to_livestemn_storage_supply(p), & + npool_to_livestemn_storage_demand(p)),0.0_r8) + + npool_to_livecrootn_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) + npool_to_livecrootn(p) = max(min(npool_to_livecrootn_supply(p),npool_to_livecrootn_demand(p)),0.0_r8) + + npool_to_livecrootn_storage_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_livecrootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) + npool_to_livecrootn_storage(p) = max(min(npool_to_livecrootn_storage_supply(p), & + npool_to_livecrootn_storage_demand(p)),0.0_r8) + + npool_to_deadstemn_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) + npool_to_deadstemn(p) = max(min(npool_to_deadstemn_supply(p), npool_to_deadstemn_demand(p)), 0.0_r8) + + npool_to_deadstemn_storage_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_deadstemn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) + npool_to_deadstemn_storage(p) = max(min(npool_to_deadstemn_storage_supply(p), & + npool_to_deadstemn_storage_demand(p)),0.0_r8) + + npool_to_deadcrootn_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) + npool_to_deadcrootn(p) = max(min(npool_to_deadcrootn_supply(p), npool_to_deadcrootn_demand(p)), 0.0_r8) + + npool_to_deadcrootn_storage_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_deadcrootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) - npool_to_deadstemn_storage(p) + npool_to_deadcrootn_storage(p) = max(min(npool_to_deadcrootn_storage_supply(p), & + npool_to_deadcrootn_storage_demand(p)),0.0_r8) + + npool_to_grainn_demand(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) - npool_to_deadcrootn(p) + npool_to_grainn(p) = max(min(npool_to_grainn_supply(p), npool_to_grainn_demand(p)), 0.0_r8) + + npool_to_grainn_storage_demand(p) = (nlc * f5 / cng) * (1._r8 -fcur) + npool_to_grainn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) - npool_to_deadstemn_storage(p) - & + npool_to_deadcrootn_storage(p) + npool_to_grainn_storage(p) = max(min(npool_to_grainn_storage_supply(p), npool_to_grainn_storage_demand(p)), & + 0.0_r8) + + npool_to_leafn_demand(p) = (nlc / cnl) * fcur + npool_to_leafn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) - npool_to_deadcrootn(p) - npool_to_grainn(p) + npool_to_leafn(p) = max(min(npool_to_leafn_supply(p), npool_to_leafn_demand(p)), 0.0_r8) + + npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_leafn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) & + - npool_to_deadstemn_storage(p) - npool_to_deadcrootn_storage(p) - npool_to_grainn_storage(p) + npool_to_leafn_storage(p) = max(min(npool_to_leafn_storage_supply(p), npool_to_leafn_storage_demand(p)), & + 0.0_r8) + + if (CN_residual_opt == 1) then + npool_to_leafn(p) = max(npool_to_leafn_supply(p),0.0_r8) + npool_to_leafn_storage(p) = max(npool_to_leafn_storage_supply(p),0.0_r8) + end if + + end if + + end if + + + ! Calculate the amount of carbon that needs to go into growth + ! respiration storage to satisfy all of the storage growth demands. + ! Allows for the fraction of growth respiration that is released at the + ! time of fixation, versus the remaining fraction that is stored for + ! release at the time of display. Note that all the growth respiration + ! fluxes that get released on a given timestep are calculated in growth_resp(), + ! but that the storage of C for growth resp during display of transferred + ! growth is assigned here. + + gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p) + if (woody(ivt(p)) == 1._r8) then + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p) + + gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_grainc_storage(p) + end if + cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2) + + ! computing 1.) fractional N demand and 2.) N allocation after uptake for different plant parts + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (downreg_opt .eqv. .false. .AND. CN_partition_opt == 1) then + + ! computing nitrogen demand for different pools based on carbon allocated and CN ratio + npool_to_leafn_demand(p) = (nlc / cnl) * fcur + npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn_demand(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage_demand(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + + npool_to_livestemn_demand(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage_demand(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + cng = graincn(ivt(p)) + npool_to_livestemn_demand(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage_demand(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn_demand(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage_demand(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + + + ! computing 1.) fractional N demand for different plant parts + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + total_plant_Ndemand(p) = npool_to_leafn_demand(p) + npool_to_leafn_storage_demand(p) + & + npool_to_frootn_demand(p) + npool_to_frootn_storage_demand(p) + + if (woody(ivt(p)) == 1._r8) then + + total_plant_Ndemand(p) = npool_to_leafn_demand(p) + npool_to_leafn_storage_demand(p) + & + npool_to_frootn_demand(p) + npool_to_frootn_storage_demand(p) + & + npool_to_livestemn_demand(p) + npool_to_livestemn_storage_demand(p) + npool_to_deadstemn_demand(p) + & + npool_to_deadstemn_storage_demand(p) + & + npool_to_livecrootn_demand(p) + npool_to_livecrootn_storage_demand(p) + npool_to_deadcrootn_demand(p) + & + npool_to_deadcrootn_storage_demand(p) + + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + total_plant_Ndemand(p) = npool_to_leafn_demand(p) + npool_to_leafn_storage_demand(p) + & + npool_to_frootn_demand(p) + npool_to_frootn_storage_demand(p) + & + npool_to_livestemn_demand(p) + npool_to_livestemn_storage_demand(p) + npool_to_deadstemn_demand(p) + & + npool_to_deadstemn_storage_demand(p) + & + npool_to_livecrootn_demand(p) + npool_to_livecrootn_storage_demand(p) + npool_to_deadcrootn_demand(p) + & + npool_to_deadcrootn_storage_demand(p) + & + npool_to_grainn_demand(p) + npool_to_grainn_storage_demand(p) + + end if + + if (total_plant_Ndemand(p) == 0.0_r8) then ! removing division by zero + + frNdemand_npool_to_leafn(p) = 0.0_r8 + frNdemand_npool_to_leafn_storage(p) = 0.0_r8 + frNdemand_npool_to_frootn(p) = 0.0_r8 + frNdemand_npool_to_frootn_storage(p) = 0.0_r8 + if (woody(ivt(p)) == 1._r8) then + + frNdemand_npool_to_livestemn(p) = 0.0_r8 + frNdemand_npool_to_livestemn_storage(p) = 0.0_r8 + frNdemand_npool_to_deadstemn(p) = 0.0_r8 + frNdemand_npool_to_deadstemn_storage(p) = 0.0_r8 + frNdemand_npool_to_livecrootn(p) = 0.0_r8 + frNdemand_npool_to_livecrootn_storage(p) = 0.0_r8 + frNdemand_npool_to_deadcrootn(p) = 0.0_r8 + frNdemand_npool_to_deadcrootn_storage(p) = 0.0_r8 + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + frNdemand_npool_to_livestemn(p) = 0.0_r8 + frNdemand_npool_to_livestemn_storage(p) = 0.0_r8 + frNdemand_npool_to_deadstemn(p) = 0.0_r8 + frNdemand_npool_to_deadstemn_storage(p) = 0.0_r8 + frNdemand_npool_to_livecrootn(p) = 0.0_r8 + frNdemand_npool_to_livecrootn_storage(p) = 0.0_r8 + frNdemand_npool_to_deadcrootn(p) = 0.0_r8 + frNdemand_npool_to_deadcrootn_storage(p) = 0.0_r8 + frNdemand_npool_to_grainn(p) = 0.0_r8 + frNdemand_npool_to_grainn_storage(p) = 0.0_r8 + end if + + else + + frNdemand_npool_to_leafn(p) = npool_to_leafn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_leafn_storage(p) = npool_to_leafn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_frootn(p) = npool_to_frootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_frootn_storage(p) = npool_to_frootn_storage_demand(p) / total_plant_Ndemand(p) + if (woody(ivt(p)) == 1._r8) then + + frNdemand_npool_to_livestemn(p) = npool_to_livestemn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livestemn_storage(p) = npool_to_livestemn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadstemn(p) = npool_to_deadstemn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadstemn_storage(p) = npool_to_deadstemn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livecrootn(p) = npool_to_livecrootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livecrootn_storage(p) = npool_to_livecrootn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadcrootn(p) = npool_to_deadcrootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadcrootn_storage(p) = npool_to_deadcrootn_storage_demand(p) / total_plant_Ndemand(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + frNdemand_npool_to_livestemn(p) = npool_to_livestemn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livestemn_storage(p) = npool_to_livestemn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadstemn(p) = npool_to_deadstemn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadstemn_storage(p) = npool_to_deadstemn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livecrootn(p) = npool_to_livecrootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livecrootn_storage(p) = npool_to_livecrootn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadcrootn(p) = npool_to_deadcrootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadcrootn_storage(p) = npool_to_deadcrootn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_grainn(p) = npool_to_grainn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_grainn_storage(p) = npool_to_grainn_storage_demand(p) / total_plant_Ndemand(p) + end if + + end if + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + ! computing N allocation for different plant parts + ! allocating allocation to different plant parts in proportion to the fractional demand + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + npool_to_leafn(p) = frNdemand_npool_to_leafn(p) * npool(p) / dt + npool_to_leafn_storage(p) = frNdemand_npool_to_leafn_storage(p) * npool(p) / dt + npool_to_frootn(p) = frNdemand_npool_to_frootn(p) * npool(p) / dt + npool_to_frootn_storage(p) = frNdemand_npool_to_frootn_storage(p) * npool(p) / dt + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = frNdemand_npool_to_livestemn(p) * npool(p) / dt + npool_to_livestemn_storage(p) = frNdemand_npool_to_livestemn_storage(p) * npool(p) / dt + npool_to_deadstemn(p) = frNdemand_npool_to_deadstemn(p) * npool(p) / dt + npool_to_deadstemn_storage(p) = frNdemand_npool_to_deadstemn_storage(p) * npool(p) / dt + npool_to_livecrootn(p) = frNdemand_npool_to_livecrootn(p) * npool(p) / dt + npool_to_livecrootn_storage(p) = frNdemand_npool_to_livecrootn_storage(p) * npool(p) / dt + npool_to_deadcrootn(p) = frNdemand_npool_to_deadcrootn(p) * npool(p) / dt + npool_to_deadcrootn_storage(p) = frNdemand_npool_to_deadcrootn_storage(p) * npool(p) / dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + npool_to_livestemn(p) = frNdemand_npool_to_livestemn(p) * npool(p) / dt + npool_to_livestemn_storage(p) = frNdemand_npool_to_livestemn_storage(p) * npool(p) / dt + npool_to_deadstemn(p) = frNdemand_npool_to_deadstemn(p) * npool(p) / dt + npool_to_deadstemn_storage(p) = frNdemand_npool_to_deadstemn_storage(p) * npool(p) / dt + npool_to_livecrootn(p) = frNdemand_npool_to_livecrootn(p) * npool(p) / dt + npool_to_livecrootn_storage(p) = frNdemand_npool_to_livecrootn_storage(p) * npool(p) / dt + npool_to_deadcrootn(p) = frNdemand_npool_to_deadcrootn(p) * npool(p) / dt + npool_to_deadcrootn_storage(p) = frNdemand_npool_to_deadcrootn_storage(p) * npool(p) / dt + npool_to_grainn(p) = frNdemand_npool_to_grainn(p) * npool(p) / dt + npool_to_grainn_storage(p) = frNdemand_npool_to_grainn_storage(p) * npool(p) / dt + end if + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + cpool_to_resp(p) = 0.0_r8 + cpool_to_leafc_resp(p) = 0.0_r8 + cpool_to_leafc_storage_resp(p) = 0.0_r8 + cpool_to_frootc_resp(p) = 0.0_r8 + cpool_to_frootc_storage_resp(p) = 0.0_r8 + cpool_to_livecrootc_resp(p) = 0.0_r8 + cpool_to_livecrootc_storage_resp(p) = 0.0_r8 + cpool_to_livestemc_resp(p) = 0.0_r8 + cpool_to_livestemc_storage_resp(p) = 0.0_r8 + + if ( laisun(p)+laisha(p) > 0.0_r8 ) then + if (cnveg_nitrogenstate_inst%leafn_storage_patch(p) == 0.0_r8 ) then + ! to avoid division by zero, and also to make actual_leafncn(p) a very large number if leafn(p) is zero + this%actual_storage_leafcn(p) = spval + else + ! leaf CN ratio + this%actual_storage_leafcn(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) & + / cnveg_nitrogenstate_inst%leafn_storage_patch(p) + end if + end if + + if (carbon_resp_opt == 1 .AND. laisun(p)+laisha(p) > 0.0_r8) then + ! computing carbon to nitrogen ratio of different plant parts + + + if (cnveg_nitrogenstate_inst%frootn_storage_patch(p) == 0.0_r8) then + ! to avoid division by zero, and also to make frootcn_actual(p) a very large number if frootc(p) is zero + frootcn_actual = cnveg_carbonstate_inst%frootc_storage_patch(p) / n_min + else + ! fine root CN ratio + frootcn_actual = cnveg_carbonstate_inst%frootc_storage_patch(p) / cnveg_nitrogenstate_inst%frootn_storage_patch(p) + end if + + if (woody(ivt(p)) == 1._r8) then + + if (cnveg_nitrogenstate_inst%livestemn_storage_patch(p) == 0.0_r8) then + ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_actual = cnveg_carbonstate_inst%livestemc_storage_patch(p) / n_min + else + ! live stem CN ratio + livestemcn_actual = cnveg_carbonstate_inst%livestemc_storage_patch(p) / & + cnveg_nitrogenstate_inst%livestemn_storage_patch(p) + end if + + if (cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) == 0.0_r8) then + ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_actual = cnveg_carbonstate_inst%livecrootc_storage_patch(p) / n_min + else + ! live coarse root CN ratio + livecrootcn_actual = cnveg_carbonstate_inst%livecrootc_storage_patch(p) / & + cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) + end if + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (cnveg_nitrogenstate_inst%livestemn_storage_patch(p) == 0.0_r8) then + ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_actual = cnveg_carbonstate_inst%livestemc_storage_patch(p) / n_min + else + ! live stem CN ratio + livestemcn_actual = cnveg_carbonstate_inst%livestemc_storage_patch(p) / & + cnveg_nitrogenstate_inst%livestemn_storage_patch(p) + end if + + if (cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) == 0.0_r8) then + ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_actual = cnveg_carbonstate_inst%livecrootc_storage_patch(p) / n_min + else + ! live coarse root CN ratio + livecrootcn_actual = cnveg_carbonstate_inst%livecrootc_storage_patch(p) / & + cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) + end if + end if + + leafcn_max = leafcn(ivt(p)) + 15.0_r8 + frootcn_max = frootcn(ivt(p)) + 15.0_r8 + + ! Note that for high CN ratio stress the plant part does not retranslocate nitrogen as the plant part will need the N + ! if high leaf CN ratio (i.e., high leaf C compared to N) then turnover extra C + if (this%actual_storage_leafcn(p) > leafcn_max) then + + frac_resp = (this%actual_storage_leafcn(p) - leafcn_max) / 10.0_r8 + frac_resp = min(1.0_r8, max(0.0_r8, frac_resp)) + + cpool_to_leafc_resp(p) = frac_resp * cpool_to_leafc(p) + cpool_to_leafc_storage_resp(p) = frac_resp * cpool_to_leafc_storage(p) + !cpool_to_leafc(p) = cpool_to_leafc(p) - cpool_to_leafc_resp(p) + !cpool_to_leafc_storage(p) = cpool_to_leafc_storage(p) - cpool_to_leafc_storage_resp(p) + + end if + + ! if high fine root CN ratio (i.e., high fine root C compared to N) then turnover extra C + if (frootcn_actual > frootcn_max) then + + frac_resp = (frootcn_actual - frootcn_max) / 10.0_r8 + frac_resp = min(1.0_r8, max(0.0_r8, frac_resp)) + + cpool_to_frootc_resp(p) = frac_resp * cpool_to_frootc(p) + cpool_to_frootc_storage_resp(p) = frac_resp * cpool_to_frootc_storage(p) + + !cpool_to_frootc(p) = cpool_to_frootc(p) - cpool_to_frootc_resp(p) + !cpool_to_frootc_storage(p) = cpool_to_frootc_storage(p) - cpool_to_frootc_storage_resp(p) + + end if + + if (woody(ivt(p)) == 1._r8) then + + livewdcn_max = livewdcn(ivt(p)) + 15.0_r8 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_actual > livewdcn_max) then + + frac_resp = (livecrootcn_actual - livewdcn_max) / 10.0_r8 + frac_resp = min(1.0_r8, max(0.0_r8, frac_resp)) + + cpool_to_livecrootc_resp(p) = frac_resp * cpool_to_livecrootc(p) + cpool_to_livecrootc_storage_resp(p) = frac_resp * cpool_to_livecrootc_storage(p) + + !cpool_to_livecrootc(p) = cpool_to_livecrootc(p) - cpool_to_livecrootc_resp(p) + !cpool_to_livecrootc_storage(p) = cpool_to_livecrootc_storage(p) - cpool_to_livecrootc_storage_resp(p) + + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_actual > livewdcn_max) then + + frac_resp = (livestemcn_actual - livewdcn_max) / 10.0_r8 + frac_resp = min(1.0_r8, max(0.0_r8, frac_resp)) + + cpool_to_livestemc_resp(p) = frac_resp * cpool_to_livestemc(p) + cpool_to_livestemc_storage_resp(p) = frac_resp * cpool_to_livestemc_storage(p) + + !cpool_to_livestemc(p) = cpool_to_livestemc(p) - cpool_to_livestemc_resp(p) + !cpool_to_livestemc_storage(p) = cpool_to_livestemc_storage(p) - cpool_to_livestemc_storage_resp(p) + + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + livewdcn_max = livewdcn(ivt(p)) + 15.0_r8 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_actual > livewdcn_max) then + + frac_resp = (livecrootcn_actual - livewdcn_max) / 10.0_r8 + frac_resp = min(1.0_r8, max(0.0_r8, frac_resp)) + + cpool_to_livecrootc_resp(p) = frac_resp * cpool_to_livecrootc(p) + cpool_to_livecrootc_storage_resp(p) = frac_resp * cpool_to_livecrootc_storage(p) + + !cpool_to_livecrootc(p) = cpool_to_livecrootc(p) - cpool_to_livecrootc_resp(p) + !cpool_to_livecrootc_storage(p) = cpool_to_livecrootc_storage(p) - cpool_to_livecrootc_storage_resp(p) + + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_actual > livewdcn_max) then + + frac_resp = (livestemcn_actual - livewdcn_max) / 10.0_r8 + frac_resp = min(1.0_r8, max(0.0_r8, frac_resp)) + + cpool_to_livestemc_resp(p) = frac_resp * cpool_to_livestemc(p) + cpool_to_livestemc_storage_resp(p) = frac_resp * cpool_to_livestemc_storage(p) + + !cpool_to_livestemc(p) = cpool_to_livestemc(p) - cpool_to_livestemc_resp(p) + !cpool_to_livestemc_storage(p) = cpool_to_livestemc_storage(p) - cpool_to_livestemc_storage_resp(p) + + end if + + end if + + cpool_to_resp(p) = cpool_to_leafc_resp(p) + cpool_to_leafc_storage_resp(p) + cpool_to_frootc_resp(p) + & + cpool_to_frootc_storage_resp(p) + cpool_to_livecrootc_resp(p) + cpool_to_livecrootc_storage_resp(p) + & + cpool_to_livestemc_resp(p) + cpool_to_livestemc_storage_resp(p) + + if(use_matrixcn)then + cnveg_carbonflux_inst%matrix_Cinput_patch(p) = cnveg_carbonflux_inst%matrix_Cinput_patch(p) - cpool_to_resp(p) + end if + + end if ! end of if (carbon_resp_opt == 1 .AND. laisun(p)+laisha(p) > 0.0_r8) then + + !if (cnveg_nitrogenstate_inst%leafn_storage_patch(p) < n_min .or. laisun(p)+laisha(p) <= 0.0_r8) then + !! to make output on history missing value + !this%actual_storage_leafcn(p) = spval + !end if + + end if ! end of if (downreg_opt .eqv. .false. .AND. CN_partition_opt == 1) then + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if(use_matrixcn)then + associate( & + matrix_Ninput => cnveg_nitrogenflux_inst%matrix_Ninput_patch, & ! N input of matrix + matrix_nalloc => cnveg_nitrogenflux_inst%matrix_nalloc_patch & ! B-matrix for nitrogen allocation + ) + if(use_c13 .and. psnsun_to_cpool(p)+psnshade_to_cpool(p).ne. 0.)then + associate( & + matrix_C13input => cnveg_carbonflux_inst%matrix_C13input_patch & ! C13 input of matrix + ) + matrix_C13input(p) = plant_calloc(p) * & + ((c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p)+ c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p))/ & + (psnsun_to_cpool(p)+psnshade_to_cpool(p))) + end associate + end if + if(use_c14 .and. psnsun_to_cpool(p)+psnshade_to_cpool(p).ne. 0.)then + associate( & + matrix_C14input => cnveg_carbonflux_inst%matrix_C14input_patch & ! C14 input of matrix + ) + matrix_C14input(p) = plant_calloc(p) * & + ((c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p)+ c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p))/ & + (psnsun_to_cpool(p)+psnshade_to_cpool(p))) + end associate + end if + npool_to_veg = npool_to_leafn(p) + npool_to_leafn_storage(p) & + + npool_to_frootn(p) + npool_to_frootn_storage(p) & + + npool_to_livestemn(p) + npool_to_livestemn_storage(p) & + + npool_to_deadstemn(p) + npool_to_deadstemn_storage(p) & + + npool_to_livecrootn(p) + npool_to_livecrootn_storage(p) & + + npool_to_deadcrootn(p) + npool_to_deadcrootn_storage(p) + if (ivt(p) >= npcropmin)then + npool_to_veg = npool_to_veg + npool_to_grainn(p) + npool_to_grainn_storage(p) + end if + if(npool_to_veg .ne. 0)then + matrix_nalloc(p,ileaf ) = npool_to_leafn(p) / npool_to_veg + matrix_nalloc(p,ileaf_st ) = npool_to_leafn_storage(p) / npool_to_veg + matrix_nalloc(p,ifroot ) = npool_to_frootn(p) / npool_to_veg + matrix_nalloc(p,ifroot_st ) = npool_to_frootn_storage(p) / npool_to_veg + matrix_nalloc(p,ilivestem ) = npool_to_livestemn(p) / npool_to_veg + matrix_nalloc(p,ilivestem_st ) = npool_to_livestemn_storage(p) / npool_to_veg + matrix_nalloc(p,ideadstem ) = npool_to_deadstemn(p) / npool_to_veg + matrix_nalloc(p,ideadstem_st ) = npool_to_deadstemn_storage(p) / npool_to_veg + matrix_nalloc(p,ilivecroot ) = npool_to_livecrootn(p) / npool_to_veg + matrix_nalloc(p,ilivecroot_st ) = npool_to_livecrootn_storage(p) / npool_to_veg + matrix_nalloc(p,ideadcroot ) = npool_to_deadcrootn(p) / npool_to_veg + matrix_nalloc(p,ideadcroot_st ) = npool_to_deadcrootn_storage(p) / npool_to_veg + if (ivt(p) >= npcropmin)then + matrix_nalloc(p,igrain ) = npool_to_grainn(p) / npool_to_veg + matrix_nalloc(p,igrain_st ) = npool_to_grainn_storage(p) / npool_to_veg + end if + matrix_Ninput(p) = npool_to_veg - retransn_to_npool(p) + else + if(retransn(p) .ne. 0)then + retransn_to_npool(p) = retransn(p) * matrix_update_phn(p,iretransn_to_iout,retransn_to_npool(p)/retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + end if + end if + + if(retransn(p) .ne. 0)then + tmp = matrix_update_phn(p,iretransn_to_ileaf ,matrix_nalloc(p,ileaf ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ileafst ,matrix_nalloc(p,ileaf_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ifroot ,matrix_nalloc(p,ifroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ifrootst ,matrix_nalloc(p,ifroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ilivestem ,matrix_nalloc(p,ilivestem ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ilivestemst ,matrix_nalloc(p,ilivestem_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ideadstem ,matrix_nalloc(p,ideadstem ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ideadstemst ,matrix_nalloc(p,ideadstem_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ilivecroot ,matrix_nalloc(p,ilivecroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ilivecrootst ,matrix_nalloc(p,ilivecroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ideadcroot ,matrix_nalloc(p,ideadcroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_ideadcrootst ,matrix_nalloc(p,ideadcroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + if(ivt(p) >= npcropmin)then + tmp = matrix_update_phn(p,iretransn_to_igrain ,matrix_nalloc(p,igrain ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + tmp = matrix_update_phn(p,iretransn_to_igrainst ,matrix_nalloc(p,igrain_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + end if + end if + end associate + end if !end use_matrixcn + end do ! end patch loop + + end associate + + end subroutine calc_plant_cn_alloc + +! ----------------------------------------------------------------------- + subroutine calc_plant_nutrient_demand(this, bounds, num_soilp, filter_soilp,& + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot, arepr) + ! + ! !USES: + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use EnergyFluxType , only : energyflux_type ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + !----------------------------------------------------------------------- + + call this%calc_plant_nitrogen_demand(bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot=aroot(bounds%begp:bounds%endp), & + arepr=arepr(bounds%begp:bounds%endp)) + + end subroutine calc_plant_nutrient_demand + + !----------------------------------------------------------------------- + subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot, arepr) + ! + ! !USES: + use pftconMod , only : npcropmin, pftcon + use pftconMod , only : ntmp_soybean, nirrig_tmp_soybean + use pftconMod , only : ntrp_soybean, nirrig_trp_soybean + use clm_varcon , only : secspday, dzsoi_decomp + use clm_varctl , only : use_c13, use_c14, use_matrixcn + use clm_varctl , only : nscalar_opt, plant_ndemand_opt, substrate_term_opt, temp_scalar_opt + use clm_varpar , only : nlevdecomp + use clm_time_manager , only : get_step_size_real + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use EnergyFluxType , only : energyflux_type ! + use CNSharedParamsMod , only : use_fun + use CNPrecisionControlMod , only : n_min + use clm_varcon , only : spval + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn + use CNVegMatrixMod , only : matrix_update_phn + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + ! + ! !LOCAL VARIABLES: + integer :: c, p, j ! indices + integer :: fp ! lake filter patch index + real(r8) :: mr ! maintenance respiration (gC/m2/s) + real(r8) :: f1, f2, f3, f4, g1, g2 ! allocation parameters + real(r8) :: cnl, cnfr, cnlw, cndw ! C:N ratios for leaf, fine root, and wood + real(r8) :: curmr, curmr_ratio ! xsmrpool temporary variables + real(r8) :: f5 ! grain allocation parameter + real(r8) :: cng ! C:N ratio for grain (= cnlw for now; slevis) + real(r8) :: fleaf ! fraction allocated to leaf + real(r8) :: t1 ! temporary variable + real(r8) :: dt ! model time step + real(r8) :: dayscrecover ! number of days to recover negative cpool + real(r8) :: f_N (bounds%begp:bounds%endp) + real(r8) :: Kmin + real(r8) :: leafcn_max + real(r8) :: leafcn_min + real(r8) :: nscalar + real(r8) :: sminn_total + real(r8) :: substrate_term + real(r8) :: temp_scalar + real(r8) :: Vmax_N + real(r8) :: allocation_leaf (bounds%begp:bounds%endp) + real(r8) :: allocation_stem (bounds%begp:bounds%endp) + real(r8) :: allocation_froot (bounds%begp:bounds%endp) + real(r8) :: tmp + + ! ----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(aroot) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(arepr) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(this%actual_leafcn) >= (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((lbound(this%actual_leafcn) <= (/bounds%begp/)), sourcefile, __LINE__) + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => pftcon%froot_leaf , & ! Input: allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => pftcon%croot_stem , & ! Input: allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => pftcon%stem_leaf , & ! Input: allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => pftcon%flivewd , & ! Input: allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + fleafcn => pftcon%fleafcn , & ! Input: leaf c:n during organ fill + ffrootcn => pftcon%ffrootcn , & ! Input: froot c:n during organ fill + fstemcn => pftcon%fstemcn , & ! Input: stem c:n during organ fill + bfact => pftcon%bfact , & ! Input: parameter used below + aleaff => pftcon%aleaff , & ! Input: parameter used below + arootf => pftcon%arootf , & ! Input: parameter used below + astemf => pftcon%astemf , & ! Input: parameter used below + arooti => pftcon%arooti , & ! Input: parameter used below + fleafi => pftcon%fleafi , & ! Input: parameter used below + allconsl => pftcon%allconsl , & ! Input: parameter used below + allconss => pftcon%allconss , & ! Input: parameter used below + grperc => pftcon%grperc , & ! Input: parameter used below + grpnow => pftcon%grpnow , & ! Input: parameter used below + declfact => pftcon%declfact , & ! Input: + season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal-deciduous leaf habit (0 or 1) + stress_decid => pftcon%stress_decid , & ! Input: binary flag for stress-deciduous leaf habit (0 or 1) + psnsun => photosyns_inst%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_inst%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_inst%c13_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsha => photosyns_inst%c13_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsun => photosyns_inst%c14_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsha => photosyns_inst%c14_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] =gdd since planting (gddplant) + leafout => crop_inst%gddtsoi_patch , & ! Input: [real(r8) (:) ] =gdd from top soil layer temperature + croplive => crop_inst%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest + huileaf => cnveg_state_inst%huileaf_patch , & ! Input: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnveg_state_inst%huigrain_patch , & ! Input: [real(r8) (:) ] same to reach vegetative maturity + peaklai => cnveg_state_inst%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleafi => cnveg_state_inst%aleafi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + astemi => cnveg_state_inst%astemi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + aleaf => cnveg_state_inst%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnveg_state_inst%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + grain_flag => cnveg_state_inst%grain_flag_patch , & ! Output: [real(r8) (:) ] 1: grain fill stage; 0: not + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + tempsum_potential_gpp => cnveg_state_inst%tempsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] temporary annual sum of potential GPP + tempmax_retransn => cnveg_state_inst%tempmax_retransn_patch , & ! Output: [real(r8) (:) ] temporary annual max of retranslocated N pool (gN/m2) + annsum_potential_gpp => cnveg_state_inst%annsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] annual sum of potential GPP + annmax_retransn => cnveg_state_inst%annmax_retransn_patch , & ! Output: [real(r8) (:) ] annual max of retranslocated N pool + + xsmrpool => cnveg_carbonstate_inst%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + leaf_mr => cnveg_carbonflux_inst%leaf_mr_patch , & ! Input: [real(r8) (:) ] + froot_mr => cnveg_carbonflux_inst%froot_mr_patch , & ! Input: [real(r8) (:) ] + livestem_mr => cnveg_carbonflux_inst%livestem_mr_patch , & ! Input: [real(r8) (:) ] + livecroot_mr => cnveg_carbonflux_inst%livecroot_mr_patch , & ! Input: [real(r8) (:) ] + grain_mr => cnveg_carbonflux_inst%grain_mr_patch , & ! Input: [real(r8) (:) ] + gpp => cnveg_carbonflux_inst%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => cnveg_carbonflux_inst%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + xsmrpool_recover => cnveg_carbonflux_inst%xsmrpool_recover_patch , & ! Output: [real(r8) (:) ] C flux assigned to recovery of negative cpool (gC/m2/s) + psnsun_to_cpool => cnveg_carbonflux_inst%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => cnveg_carbonflux_inst%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + leaf_curmr => cnveg_carbonflux_inst%leaf_curmr_patch , & ! Output: [real(r8) (:) ] + froot_curmr => cnveg_carbonflux_inst%froot_curmr_patch , & ! Output: [real(r8) (:) ] + livestem_curmr => cnveg_carbonflux_inst%livestem_curmr_patch , & ! Output: [real(r8) (:) ] + livecroot_curmr => cnveg_carbonflux_inst%livecroot_curmr_patch , & ! Output: [real(r8) (:) ] + grain_curmr => cnveg_carbonflux_inst%grain_curmr_patch , & ! Output: [real(r8) (:) ] + leaf_xsmr => cnveg_carbonflux_inst%leaf_xsmr_patch , & ! Output: [real(r8) (:) ] + froot_xsmr => cnveg_carbonflux_inst%froot_xsmr_patch , & ! Output: [real(r8) (:) ] + livestem_xsmr => cnveg_carbonflux_inst%livestem_xsmr_patch , & ! Output: [real(r8) (:) ] + livecroot_xsmr => cnveg_carbonflux_inst%livecroot_xsmr_patch , & ! Output: [real(r8) (:) ] + grain_xsmr => cnveg_carbonflux_inst%grain_xsmr_patch , & ! Output: [real(r8) (:) ] + cpool_to_xsmrpool => cnveg_carbonflux_inst%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + avail_retransn => cnveg_nitrogenflux_inst%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + leafn_to_litter => cnveg_nitrogenflux_inst%leafn_to_litter_patch , & ! Output: [real(r8) (:) ] leaf N litterfall (gN/m2/s) + frootn_to_litter => cnveg_nitrogenflux_inst%frootn_to_litter_patch , & ! Output: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + livestemn_to_litter => cnveg_nitrogenflux_inst%livestemn_to_litter_patch , & ! Input: [real(r8) (:) ] livestem N to litter (gN/m2/s) + sminn_to_npool => cnveg_nitrogenflux_inst%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + leafn_to_retransn => cnveg_nitrogenflux_inst%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_retransn => cnveg_nitrogenflux_inst%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch,& ! Output: [real(r8) (:) ] + sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N + btran => energyflux_inst%btran_patch , & ! Input: [real(r8) (:) ] transpiration wetness factor (0 to 1) + t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Input: [real(r8) (:,:) ] soil temperature scalar for decomp + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & + ifroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ifroot_to_iretransn_ph , & + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph & + + ) + + ! set time steps + dt = get_step_size_real() + + ! set number of days to recover negative cpool + dayscrecover = params_inst%dayscrecover ! loop over patches to assess the total plant N demand + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! get the time step total gross photosynthesis + ! this is coming from the canopy fluxes code, and is the + ! gpp that is used to control stomatal conductance. + ! For the nitrogen downregulation code, this is assumed + ! to be the potential gpp, and the actual gpp will be + ! reduced due to N limitation. + + ! Convert psn from umol/m2/s -> gC/m2/s + + ! The input psn (psnsun and psnsha) are expressed per unit LAI + ! in the sunlit and shaded canopy, respectively. These need to be + ! scaled by laisun and laisha to get the total gpp for allocation + + ! Note that no associate statement is used for the isotope carbon fluxes below + ! since they are not always allocated AND nag compiler will complain if you try to + ! to have an associate statement with unallocated memory + + psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8 + psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8 + + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8 + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = c14_psnsun(p) * laisun(p) * 12.011e-6_r8 + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = c14_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p) + + ! get the time step total maintenance respiration + ! These fluxes should already be in gC/m2/s + + mr = leaf_mr(p) + froot_mr(p) + if (woody(ivt(p)) == 1.0_r8) then + mr = mr + livestem_mr(p) + livecroot_mr(p) + else if (ivt(p) >= npcropmin) then + if (croplive(p)) mr = mr + livestem_mr(p) + grain_mr(p) + end if ! carbon flux available for allocation + if(mr <-1.e-15 .and. use_matrixcn)mr = 0 + availc(p) = gpp(p) - mr + + ! new code added for isotope calculations, 7/1/05, PET + ! If mr > gpp, then some mr comes from gpp, the rest comes from + ! cpool (xsmr) + if (mr > 0._r8 .and. availc(p) < 0._r8) then + curmr = gpp(p) + curmr_ratio = curmr / mr + else + curmr_ratio = 1._r8 + end if + leaf_curmr(p) = leaf_mr(p) * curmr_ratio + leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p) + froot_curmr(p) = froot_mr(p) * curmr_ratio + froot_xsmr(p) = froot_mr(p) - froot_curmr(p) + livestem_curmr(p) = livestem_mr(p) * curmr_ratio + livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p) + livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio + livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p) + grain_curmr(p) = grain_mr(p) * curmr_ratio + grain_xsmr(p) = grain_mr(p) - grain_curmr(p) + + ! no allocation when available c is negative + availc(p) = max(availc(p),0.0_r8) + + ! test for an xsmrpool deficit + if (xsmrpool(p) < 0.0_r8) then + ! Running a deficit in the xsmrpool, so the first priority is to let + ! some availc from this timestep accumulate in xsmrpool. + ! Determine rate of recovery for xsmrpool deficit + + xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) + if (xsmrpool_recover(p) < availc(p)) then + ! available carbon reduced by amount for xsmrpool recovery + availc(p) = availc(p) - xsmrpool_recover(p) + else + ! all of the available carbon goes to xsmrpool recovery + xsmrpool_recover(p) = availc(p) + availc(p) = 0.0_r8 + end if + cpool_to_xsmrpool(p) = xsmrpool_recover(p) + end if + + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + + + ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop + + f5 = 0._r8 ! continued intializations from above + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (croplive(p)) then + ! same phases appear in subroutine CropPhenology + + ! Phase 1 completed: + ! ================== + ! if hui is less than the number of gdd needed for filling of grain + ! leaf emergence also has to have taken place for lai changes to occur + ! and carbon assimilation + ! Next phase: leaf emergence to start of leaf decline + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then + + ! allocation rules for crops based on maturity and linear decrease + ! of amount allocated to roots over course of the growing season + + if (peaklai(p) == 1) then ! lai at maximum allowed + arepr(p) = 0._r8 + aleaf(p) = 1.e-5_r8 + astem(p) = 0._r8 + aroot(p) = 1._r8 - arepr(p) - aleaf(p) - astem(p) + else + arepr(p) = 0._r8 + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * & + min(1._r8, hui(p)/gddmaturity(p)))) + fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) - & + exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / & + (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve) + aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf) + astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + end if + + ! AgroIBIS included here an immediate adjustment to aleaf & astem if the + ! predicted lai from the above allocation coefficients exceeded laimx. + ! We have decided to live with lais slightly higher than laimx by + ! enforcing the cap in the following tstep through the peaklai logic above. + + astemi(p) = astem(p) ! save for use by equations after shift + aleafi(p) = aleaf(p) ! to reproductive phenology stage begins + grain_flag(p) = 0._r8 ! setting to 0 while in phase 2 + + ! Phase 2 completed: + ! ================== + ! shift allocation either when enough gdd are accumulated or maximum number + ! of days has elapsed since planting + + else if (hui(p) >= huigrain(p)) then + + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p)))) + if (astemi(p) > astemf(ivt(p))) then + astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconss(ivt(p)) ))) + end if + if (peaklai(p) == 1) then + aleaf(p) = 1.e-5_r8 + else if (aleafi(p) > aleaff(ivt(p))) then + aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconsl(ivt(p)) ))) + end if + + !Beth's retranslocation of leafn, stemn, rootn to organ + !Filter excess plant N to retransn pool for organ N + !Only do one time then hold grain_flag till onset next season + + ! slevis: Will astem ever = astemf exactly? + ! Beth's response: ...looks like astem can equal astemf under the right circumstances. + !It might be worth a rewrite to capture what I was trying to do, but the retranslocation for + !corn and wheat begins at the beginning of the grain fill stage, but for soybean I was holding it + !until after the leaf and stem decline were complete. Looking at how astem is calculated, once the + !stem decline is near complete, astem should (usually) be set to astemf. The reason for holding off + !on soybean is that the retranslocation scheme begins at the beginning of the grain phase, when the + !leaf and stem are still growing, but declining. Since carbon is still getting allocated and now + !there is more nitrogen available, the nitrogen can be diverted from grain. For corn and wheat + !the impact was probably enough to boost productivity, but for soybean the nitrogen was better off + !fulfilling the grain fill. It seems that if the peak lai is reached for soybean though that this + !would be bypassed altogether, not the intended outcome. I checked several of my output files and + !they all seemed to be going through the retranslocation loop for soybean - good news. + + if (astem(p) == astemf(ivt(p)) .or. & + (ivt(p) /= ntmp_soybean .and. ivt(p) /= nirrig_tmp_soybean .and.& + ivt(p) /= ntrp_soybean .and. ivt(p) /= nirrig_trp_soybean)) then + if (grain_flag(p) == 0._r8) then + t1 = 1 / dt + leafn_to_retransn(p) = t1 * max(leafn(p)- (leafc(p) / fleafcn(ivt(p))),0._r8) + livestemn_to_retransn(p) = t1 * max(livestemn(p) - (livestemc(p) / fstemcn(ivt(p))),0._r8) + frootn_to_retransn(p) = 0._r8 + if (ffrootcn(ivt(p)) > 0._r8) then + frootn_to_retransn(p) = t1 * max(frootn(p) - (frootc(p) / ffrootcn(ivt(p))),0._r8) + end if + grain_flag(p) = 1._r8 + if(use_matrixcn)then + if(leafn(p) .ne. 0._r8)then + leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + if(frootn(p) .ne. 0._r8)then + frootn_to_retransn(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iretransn_phn,frootn_to_retransn(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + if(livestemn(p) .ne. 0._r8)then + livestemn_to_retransn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iretransn_phn,livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + end if + end if + + end if + end if + + arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p) + + else ! pre emergence + aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant + astem(p) = 0._r8 ! because crops have no live carbon pools; + aroot(p) = 0._r8 ! this applies to this "else" and to the "else" + arepr(p) = 0._r8 ! a few lines down + end if + + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + + else ! .not croplive + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! based on available C, use constant allometric relationships to + ! determine N requirements + if(use_fun)then ! In FUN, growth respiration is not part of the allometry calculation. + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + c_allometry(p) = (1._r8)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else + c_allometry(p) = 1._r8+f1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + end if + else !no FUN. + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else + c_allometry(p) = 1._r8+g1+f1+f1*g1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + end if + end if !FUN + + ! when we have "if (leafn(p) == 0.0_r8)" below then we + ! have floating overflow (out of floating point range) + ! error in "actual_leafcn(p) = leafc(p) / leafn(p)" + if (leafn(p) < n_min ) then + ! to avoid division by zero, and to set leafcn to missing value for history files + this%actual_leafcn(p) = spval + else + ! leaf CN ratio + this%actual_leafcn(p) = leafc(p) / leafn(p) + end if + + + if (nscalar_opt) then + + leafcn_min = leafcn(ivt(p)) - 10.0_r8 + leafcn_max = leafcn(ivt(p)) + 10.0_r8 + + this%actual_leafcn(p) = max( this%actual_leafcn(p), leafcn_min-0.0001_r8 ) + this%actual_leafcn(p) = min( this%actual_leafcn(p), leafcn_max ) + + nscalar = (this%actual_leafcn(p) - leafcn_min ) / (leafcn_max - leafcn_min) ! Nitrogen scaler factor + nscalar = min( max(0.0_r8, nscalar), 1.0_r8 ) + else ! if (nscalar_opt == .false.) then + nscalar = 1.0_r8 + end if + + + if (substrate_term_opt) then + c = patch%column(p) + sminn_total = 0.0_r8 + do j = 1, nlevdecomp + sminn_total = sminn_total + sminn_vr(c,j) * dzsoi_decomp(j) + end do + Kmin = 1.0_r8 + substrate_term = sminn_total / (sminn_total + Kmin) + else ! if (substrate_term_opt == .false) then + substrate_term = 1.0_r8 + end if + + if (.not. temp_scalar_opt) then + temp_scalar = 1.0_r8 + else !(temp_scalar_opt == .true.) then + c = patch%column(p) + temp_scalar=t_scalar(c,1) + temp_scalar = min( max(0.0_r8, temp_scalar), 1.0_r8 ) + end if + + if(use_fun)then ! in FUN, plant_ndemand is just used as a maximum draw on soil N pools. + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) + else !FUN + if (plant_ndemand_opt == 0) then + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) + else if (plant_ndemand_opt == 1) then + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) * substrate_term + else if (plant_ndemand_opt == 2) then ! N uptake happens at day time only + + if (gpp(p) > 0.0_r8) then + Vmax_N = 2.7E-8_r8 + plant_ndemand(p) = Vmax_N * frootc(p) * substrate_term * temp_scalar * nscalar + else + plant_ndemand(p) = 0.0_r8 + end if + else if (plant_ndemand_opt == 3) then ! N uptake happens at day and night time + + if (laisun(p)+laisha(p) > 0.0_r8) then + Vmax_N = 2.7E-8_r8 + plant_ndemand(p) = Vmax_N * frootc(p) * substrate_term * temp_scalar * nscalar + else + plant_ndemand(p) = 0.0_r8 + end if + + if (this%actual_leafcn(p) < leafcn_min )then + plant_ndemand(p) = 0.0_r8 + end if + + end if + end if !FUN + !if (leafn(p) < n_min ) then + !! to set leafcn to missing value for history files + !this%actual_leafcn(p) = spval + !end if + + ! retranslocated N deployment depends on seasonal cycle of potential GPP + ! (requires one year run to accumulate demand) + + tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p) + + ! Adding the following line to carry max retransn info to CN Annual Update + tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p)) + + ! Beth's code: crops pull from retransn pool only during grain fill; + ! retransn pool has N from leaves, stems, and roots for + ! retranslocation + + if (ivt(p) >= npcropmin .and. grain_flag(p) == 1._r8) then + avail_retransn(p) = plant_ndemand(p) + else if (ivt(p) < npcropmin .and. annsum_potential_gpp(p) > 0._r8) then + avail_retransn(p) = (annmax_retransn(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + else + avail_retransn(p) = 0.0_r8 + end if + + ! make sure available retrans N doesn't exceed storage + avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt) + + ! modify plant N demand according to the availability of + ! retranslocated N + ! take from retransn pool at most the flux required to meet + ! plant ndemand + + if (plant_ndemand(p) > avail_retransn(p)) then + retransn_to_npool(p) = avail_retransn(p) + else + retransn_to_npool(p) = plant_ndemand(p) + end if + + if ( .not. use_fun ) then + plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p) + end if + + end do ! end patch loop + + end associate + + end subroutine calc_plant_nitrogen_demand + +end module NutrientCompetitionFlexibleCNMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionMethodMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionMethodMod.F90 new file mode 100755 index 000000000..56ebcc4f6 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionMethodMod.F90 @@ -0,0 +1,202 @@ +module NutrientCompetitionMethodMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abstract base class for functions to calculate nutrient competition + ! + ! Created by Jinyun Tang, following Bill Sack's implementation of polymorphism + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + private + ! + ! !PUBLIC TYPES: + public :: nutrient_competition_method_type + + type, abstract :: nutrient_competition_method_type + private + contains + + ! initialization + procedure(init_interface), public, deferred :: init + + ! Read in parameters + procedure, public :: readParams + + ! compute plant nutrient demand + procedure(calc_plant_nutrient_demand_interface), public, deferred :: calc_plant_nutrient_demand + + ! compute the nutrient yield for different components + procedure(calc_plant_nutrient_competition_interface), public, deferred :: calc_plant_nutrient_competition + + end type nutrient_competition_method_type + + type, public :: params_type + real(r8) :: dayscrecover ! number of days to recover negative cpool + end type params_type + ! + type(params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod + + abstract interface + + ! Note: The following code is adapted based on what Bill Scaks has done for soil water retention curve + ! polymorphism. Therefore, I also keep some suggestions he gave there. + ! + ! - Make the interfaces contain all possible inputs that are needed by any + ! implementation; each implementation will then ignore the inputs it doesn't need. + ! + ! - For inputs that are needed only by particular implementations - and particularly + ! for inputs that are constant in time + ! pass these into the constructor, and save pointers to these inputs as components + ! of the child type that needs them. Then they aren't needed as inputs to the + ! individual routines, allowing the interfaces for these routines to remain more + ! consistent between different implementations. + ! + !--------------------------------------------------------------------------- + subroutine init_interface(this, bounds) + ! !DESCRIPTION: + ! read in kinetic parameters that are needed for doing nutrient competition + ! + ! !USES: + use decompMod , only : bounds_type + import :: nutrient_competition_method_type + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type) :: this + type(bounds_type) , intent(in) :: bounds + + end subroutine init_interface + + !--------------------------------------------------------------------------- + subroutine calc_plant_nutrient_demand_interface (this, bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot, arepr) + ! + ! DESCRIPTION + ! calculate nutrient yield after considering competition between different components + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CanopyStateType , only : canopystate_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use EnergyFluxType , only : energyflux_type + import :: nutrient_competition_method_type + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type), intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + + end subroutine calc_plant_nutrient_demand_interface + + !----------------------------------------------------------------------- + subroutine calc_plant_nutrient_competition_interface (this, & + bounds, num_soilp, filter_soilp, & + cnveg_state_inst, crop_inst, canopystate_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use CNVegStateType , only : cnveg_state_type + use CropType , only : crop_type + use CanopyStateType , only : canopystate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + import :: nutrient_competition_method_type + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + real(r8) , intent(in) :: aroot(bounds%begp:) + real(r8) , intent(in) :: arepr(bounds%begp:) + real(r8) , intent(in) :: fpg_col(bounds%begc:) + + end subroutine calc_plant_nutrient_competition_interface + + end interface + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine readParams (this, ncid ) + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use ncdio_pio , only : file_desc_t,ncd_io + use abortutils , only : endrun + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type), intent(in) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNAllocParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + tString='dayscrecover' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%dayscrecover=tempr + + end subroutine readParams + +end module NutrientCompetitionMethodMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 new file mode 100644 index 000000000..379d25d1e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 @@ -0,0 +1,328 @@ +module RootBiophysMod + +#include "shr_assert.h" + + !-------------------------------------------------------------------------------------- + ! DESCRIPTION: + ! module contains subroutine for root biophysics + ! + ! HISTORY + ! created by Jinyun Tang, Mar 1st, 2014 + implicit none + private + ! + public :: init_vegrootfr + public :: init_rootprof + + integer, private, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function + integer, private, parameter :: jackson_1996_root = 1 !the jackson 1996 root profile function + integer, private, parameter :: koven_exp_root = 2 !the koven exponential root profile function + + integer, public :: rooting_profile_method_water !select the type of rooting profile parameterization for water + integer, public :: rooting_profile_method_carbon !select the type of rooting profile parameterization for carbon + integer, public :: rooting_profile_varindex_water !select the variant number of rooting profile parameterization for water + integer, public :: rooting_profile_varindex_carbon !select the variant number of rooting profile parameterization for carbon + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + !-------------------------------------------------------------------------------------- + +contains + + !-------------------------------------------------------------------------------------- + subroutine init_rootprof(NLFilename) + ! + !DESCRIPTION + ! initialize methods for root profile calculation + + ! !USES: + use abortutils , only : endrun + use fileutils , only : getavu, relavu + use spmdMod , only : mpicom, masterproc + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + use clm_nlUtilsMod , only : find_nlgroup_name + + ! !ARGUMENTS: + !------------------------------------------------------------------------------ + implicit none + character(len=*), intent(in) :: NLFilename + + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + character(*), parameter :: subName = "('init_rootprof')" + + !----------------------------------------------------------------------- + +! MUST agree with name in namelist and read statement + namelist /rooting_profile_inparm/ rooting_profile_method_water, rooting_profile_method_carbon, & + rooting_profile_varindex_water, rooting_profile_varindex_carbon + + ! Default values for namelist + + rooting_profile_method_water = zeng_2001_root + rooting_profile_method_carbon = zeng_2001_root + rooting_profile_varindex_water = 1 + rooting_profile_varindex_carbon = 2 + + ! Read rooting_profile namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'rooting_profile_inparm', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=rooting_profile_inparm,iostat=nml_error) + if (nml_error /= 0) then + call endrun(subname // ':: ERROR reading rooting_profile namelist') + end if + else + call endrun(subname // ':: ERROR finding rooting_profile namelist') + end if + close(nu_nml) + call relavu( nu_nml ) + + endif + + call shr_mpi_bcast(rooting_profile_method_water, mpicom) + call shr_mpi_bcast(rooting_profile_method_carbon, mpicom) + call shr_mpi_bcast(rooting_profile_varindex_water, mpicom) + call shr_mpi_bcast(rooting_profile_varindex_carbon, mpicom) + + if (masterproc) then + + write(iulog,*) ' ' + write(iulog,*) 'rooting_profile settings:' + write(iulog,*) ' rooting_profile_method_water = ',rooting_profile_method_water + if ( rooting_profile_method_water == jackson_1996_root )then + write(iulog,*) ' (rooting_profile_varindex_water = ',rooting_profile_varindex_water, ')' + end if + write(iulog,*) ' rooting_profile_method_carbon = ',rooting_profile_method_carbon + if ( rooting_profile_method_carbon == jackson_1996_root )then + write(iulog,*) ' (rooting_profile_varindex_carbon = ',rooting_profile_varindex_carbon, ')' + end if + + endif + + end subroutine init_rootprof + + !-------------------------------------------------------------------------------------- + subroutine init_vegrootfr(bounds, nlevsoi, nlevgrnd, rootfr, water_carbon) + ! + !DESCRIPTION + !initialize plant root profiles + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use CNCLM_ColumnType , only : col + use CNCLM_PatchType , only : patch + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: nlevsoi ! number of hydactive layers + integer, intent(in) :: nlevgrnd ! number of soil layers + real(r8), intent(out):: rootfr(bounds%begp: , 1: ) ! root fraction by layer + character(len=*), intent(in) :: water_carbon ! roots for water or carbon + + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'init_vegrootfr' ! subroutine name + integer :: c,p + integer :: rooting_profile_method ! Rooting profile method to use + integer :: rooting_profile_varidx ! Rooting profile variant index to use + !------------------------------------------------------------------------ + + SHR_ASSERT_ALL_FL((ubound(rootfr) == (/bounds%endp, nlevgrnd/)), sourcefile, __LINE__) + + if ( water_carbon == 'water' ) then + rooting_profile_method = rooting_profile_method_water + rooting_profile_varidx = rooting_profile_varindex_water + else if (water_carbon == 'carbon') then + rooting_profile_method = rooting_profile_method_carbon + rooting_profile_varidx = rooting_profile_varindex_carbon + else + call endrun(subname // ':: input type can only be water or carbon = '//water_carbon ) + end if + + select case( rooting_profile_method ) + + case (zeng_2001_root) + rootfr(bounds%begp:bounds%endp, 1 : nlevsoi) = zeng2001_rootfr(bounds, nlevsoi) + case (jackson_1996_root) + rootfr(bounds%begp:bounds%endp, 1 : nlevsoi) = jackson1996_rootfr(bounds, nlevsoi, rooting_profile_varidx, water_carbon) + case (koven_exp_root) + rootfr(bounds%begp:bounds%endp, 1 : nlevsoi) = exponential_rootfr(bounds, nlevsoi) + case default + call endrun(subname // ':: a root fraction function must be specified!') + end select + rootfr(bounds%begp:bounds%endp,nlevsoi+1:nlevgrnd)=0._r8 + + ! shift roots up above bedrock boundary (distribute equally to each layer) + ! may not matter if normalized later + do p = bounds%begp,bounds%endp + c = patch%column(p) + rootfr(p,1:col%nbedrock(c)) = rootfr(p,1:col%nbedrock(c)) & + + sum(rootfr(p,col%nbedrock(c)+1:nlevsoi))/real(col%nbedrock(c)) + rootfr(p,col%nbedrock(c)+1:nlevsoi) = 0._r8 + enddo + end subroutine init_vegrootfr + + !------------------------------------------------------------------------- + function zeng2001_rootfr(bounds, ubj) result(rootfr) + ! + ! DESCRIPTION + ! compute root profile for soil water uptake + ! using equation from Zeng 2001, J. Hydrometeorology + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use pftconMod , only : pftcon + use PatchType , only : patch + use ColumnType , only : col + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: ubj ! ubnd + ! + ! !RESULT + real(r8) :: rootfr(bounds%begp:bounds%endp , 1:ubj ) ! + ! + ! !LOCAL VARIABLES: + integer :: p, lev, c + !------------------------------------------------------------------------ + + !(computing from surface, d is depth in meter): + ! Y = 1 -1/2 (exp(-ad)+exp(-bd) under the constraint that + ! Y(d =0.1m) = 1-beta^(10 cm) and Y(d=d_obs)=0.99 with + ! beta & d_obs given in Zeng et al. (1998). + + do p = bounds%begp,bounds%endp + + if (.not. patch%is_fates(p)) then + c = patch%column(p) + do lev = 1, ubj-1 + rootfr(p,lev) = .5_r8*( & + exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,lev-1)) & + + exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,lev-1)) & + - exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,lev )) & + - exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,lev )) ) + end do + rootfr(p,ubj) = .5_r8*( & + exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,ubj-1)) & + + exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,ubj-1)) ) + + else + rootfr(p,1:ubj) = 0._r8 + endif + + enddo + return + + end function zeng2001_rootfr + + !------------------------------------------------------------------------- + function jackson1996_rootfr(bounds, ubj, varindx, water_carbon) result(rootfr) + ! + ! DESCRIPTION + ! compute root profile for soil water uptake + ! using equation from Jackson et al. 1996, Oec. + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use pftconMod , only : pftcon + use PatchType , only : patch + use ColumnType , only : col + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: ubj ! ubnd + integer , intent(in) :: varindx ! variant index + character(len=*) , intent(in) :: water_carbon ! roots for water or carbon + ! + ! !RESULT + real(r8) :: rootfr(bounds%begp:bounds%endp , 1:ubj ) ! + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: m_to_cm = 1.e2_r8 + real(r8) :: beta !patch specific shape parameter + integer :: p, lev, c + !------------------------------------------------------------------------ + + !(computing from surface, d is depth in centimeters): + ! Y = (1 - beta^d); beta given in Jackson et al. (1996). + + rootfr(bounds%begp:bounds%endp, :) = 0._r8 + do p = bounds%begp,bounds%endp + c = patch%column(p) + if (.not.patch%is_fates(p)) then + beta = pftcon%rootprof_beta(patch%itype(p),varindx) + do lev = 1, ubj + rootfr(p,lev) = ( & + beta ** (col%zi(c,lev-1)*m_to_cm) - & + beta ** (col%zi(c,lev)*m_to_cm) ) + end do + else + rootfr(p,:) = 0. + endif + + enddo + return + + end function jackson1996_rootfr + + !------------------------------------------------------------------------- + function exponential_rootfr(bounds, ubj) result(rootfr) + ! + ! DESCRIPTION + ! compute root profile for soil water uptake + ! using equation from Koven + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use pftconMod , only : pftcon + use PatchType , only : patch + use ColumnType , only : col + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: ubj ! ubnd + ! + ! !RESULT + real(r8) :: rootfr(bounds%begp:bounds%endp , 1:ubj ) ! + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: rootprof_exp = 3. ! how steep profile is for root C inputs (1/ e-folding depth) (1/m) + real(r8) :: norm + integer :: p, lev, c + + !------------------------------------------------------------------------ + + rootfr(bounds%begp:bounds%endp, :) = 0._r8 + do p = bounds%begp,bounds%endp + c = patch%column(p) + if (.not.patch%is_fates(p)) then + do lev = 1, ubj + rootfr(p,lev) = exp(-rootprof_exp * col%z(c,lev)) * col%dz(c,lev) + end do + else + rootfr(p,1) = 0. + endif + norm = -1./rootprof_exp * (exp(-rootprof_exp * col%z(c,ubj)) - 1._r8) + rootfr(p,:) = rootfr(p,:) / norm + + enddo + + return + + end function exponential_rootfr + +end module RootBiophysMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 new file mode 100755 index 000000000..bed9493f7 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 @@ -0,0 +1,1132 @@ +module SoilBiogeochemDecompCascadeBGCMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Sets the coeffiecients used in the decomposition cascade submodel. + ! This uses the CENTURY/BGC parameters + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : nlevsoi, nlevgrnd, nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, spinup_state, anoxia, use_lch4, use_vertsoilc, use_fates, use_soil_matrixcn + use clm_varcon , only : zsoi + use decompMod , only : bounds_type + use spmdMod , only : masterproc + use abortutils , only : endrun + use CNSharedParamsMod , only : CNParamsShareInst, nlev_soildecomp_standard + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con, InitSoilTransfer + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use ch4Mod , only : ch4_type + use ColumnType , only : col + use GridcellType , only : grc + use SoilBiogeochemStateType , only : get_spinup_latitude_term + + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: DecompCascadeBGCreadNML ! Read in namelist + public :: readParams ! Read in parameters from params file + public :: init_decompcascade_bgc ! Initialization + public :: decomp_rate_constants_bgc ! Figure out decomposition rates + ! + ! !PUBLIC DATA MEMBERS + logical , public :: normalize_q10_to_century_tfunc = .true.! do we normalize the century decomp. rates so that they match the CLM Q10 at a given tep? + logical , public :: use_century_tfunc = .false. + real(r8), public :: normalization_tref = 15._r8 ! reference temperature for normalizaion (degrees C) + ! + ! !PRIVATE DATA MEMBERS + + integer, private :: i_soil1 = -9 ! Soil Organic Matter (SOM) first pool + integer, private :: i_soil2 = -9 ! SOM second pool + integer, private :: i_soil3 = -9 ! SOM third pool + integer, private, parameter :: nsompools = 3 ! Number of SOM pools + integer, private, parameter :: i_litr1 = i_met_lit ! First litter pool, metobolic + integer, private, parameter :: i_litr2 = i_cel_lit ! Second litter pool, cellulose + integer, private, parameter :: i_litr3 = i_lig_lit ! Third litter pool, lignin + + type, private :: params_type + real(r8):: cn_s1_bgc !C:N for SOM 1 + real(r8):: cn_s2_bgc !C:N for SOM 2 + real(r8):: cn_s3_bgc !C:N for SOM 3 + + real(r8):: rf_l1s1_bgc !respiration fraction litter 1 -> SOM 1 + real(r8):: rf_l2s1_bgc + real(r8):: rf_l3s2_bgc + + real(r8):: rf_s2s1_bgc + real(r8):: rf_s2s3_bgc + real(r8):: rf_s3s1_bgc + + real(r8):: rf_cwdl2_bgc + real(r8):: rf_cwdl3_bgc + + real(r8):: tau_l1_bgc ! 1/turnover time of litter 1 from Century (l/18.5) (1/yr) + real(r8):: tau_l2_l3_bgc ! 1/turnover time of litter 2 and litter 3 from Century (1/4.9) (1/yr) + real(r8):: tau_s1_bgc ! 1/turnover time of SOM 1 from Century (1/7.3) (1/yr) + real(r8):: tau_s2_bgc ! 1/turnover time of SOM 2 from Century (1/0.2) (1/yr) + real(r8):: tau_s3_bgc ! 1/turnover time of SOM 3 from Century (1/0.0045) (1/yr) + real(r8):: tau_cwd_bgc ! corrected fragmentation rate constant CWD, century leaves wood decomposition rates open, within range of 0 - 0.5 yr^-1 (1/0.3) (1/yr) + + real(r8) :: cwd_fcel_bgc !cellulose fraction for CWD + real(r8) :: cwd_flig_bgc ! + + real(r8) :: k_frag_bgc !fragmentation rate for CWD + real(r8) :: minpsi_bgc !minimum soil water potential for heterotrophic resp + real(r8) :: maxpsi_bgc !maximum soil water potential for heterotrophic resp + + real(r8) :: initial_Cstocks(nsompools) ! Initial Carbon stocks for a cold-start + real(r8) :: initial_Cstocks_depth ! Soil depth for initial Carbon stocks for a cold-start + + end type params_type + ! + type(params_type), private :: params_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine DecompCascadeBGCreadNML( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for soil BGC Decomposition Cascade + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'DecompCascadeBGCreadNML' + character(len=*), parameter :: nmlname = 'CENTURY_soilBGCDecompCascade' + !----------------------------------------------------------------------- + real(r8) :: initial_Cstocks(nsompools), initial_Cstocks_depth + namelist /CENTURY_soilBGCDecompCascade/ initial_Cstocks, initial_Cstocks_depth + + ! Initialize options to default values, in case they are not specified in + ! the namelist + + initial_Cstocks(:) = 200._r8 + initial_Cstocks_depth = 0.3 + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=CENTURY_soilBGCDecompCascade, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(__FILE__, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(__FILE__, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (initial_Cstocks , mpicom) + call shr_mpi_bcast (initial_Cstocks_depth, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=CENTURY_soilBGCDecompCascade) + write(iulog,*) ' ' + end if + + params_inst%initial_Cstocks(:) = initial_Cstocks(:) + params_inst%initial_Cstocks_depth = initial_Cstocks_depth + + end subroutine DecompCascadeBGCreadNML + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNDecompBgcParamsType' + character(len=100) :: errCode = 'Error reading in CN const file ' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! Read off of netcdf file + tString='tau_l1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tau_l1_bgc=tempr + + tString='tau_l2_l3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tau_l2_l3_bgc=tempr + + tString='tau_s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tau_s1_bgc=tempr + + tString='tau_s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tau_s2_bgc=tempr + + tString='tau_s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tau_s3_bgc=tempr + + tString='tau_cwd' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%tau_cwd_bgc=tempr + + tString='cn_s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cn_s1_bgc=tempr + + tString='cn_s2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cn_s2_bgc=tempr + + tString='cn_s3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cn_s3_bgc=tempr + + tString='rf_l1s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_l1s1_bgc=tempr + + tString='rf_l2s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_l2s1_bgc=tempr + + tString='rf_l3s2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_l3s2_bgc=tempr + + tString='rf_s2s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_s2s1_bgc=tempr + + tString='rf_s2s3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_s2s3_bgc=tempr + + tString='rf_s3s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_s3s1_bgc=tempr + + tString='rf_cwdl2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_cwdl2_bgc=tempr + + tString='rf_cwdl3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_cwdl3_bgc=tempr + + tString='cwd_fcel' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cwd_fcel_bgc=tempr + + tString='k_frag' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_frag_bgc=tempr + + tString='minpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%minpsi_bgc=tempr + + tString='maxpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%maxpsi_bgc=tempr + + tString='cwd_flig' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cwd_flig_bgc=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_inst ) + ! + ! !DESCRIPTION: + ! initialize rate constants and decomposition pathways following the decomposition cascade of the BGC model. + ! written by C. Koven + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilstate_type) , intent(in) :: soilstate_inst + ! + ! !LOCAL VARIABLES + !-- properties of each decomposing pool + real(r8) :: rf_l1s1 + real(r8) :: rf_l2s1 + real(r8) :: rf_l3s2 + !real(r8) :: rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp) + !real(r8) :: rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8), allocatable :: rf_s1s2(:,:) + real(r8), allocatable :: rf_s1s3(:,:) + real(r8) :: rf_s2s1 + real(r8) :: rf_s2s3 + real(r8) :: rf_s3s1 + real(r8) :: rf_cwdl2 + real(r8) :: rf_cwdl3 + real(r8) :: cwd_fcel + real(r8) :: cwd_flig + real(r8) :: cn_s1 + real(r8) :: cn_s2 + real(r8) :: cn_s3 + !real(r8) :: f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp) + !real(r8) :: f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8), allocatable :: f_s1s2(:,:) + real(r8), allocatable :: f_s1s3(:,:) + real(r8) :: f_s2s1 + real(r8) :: f_s2s3 + + integer :: i_l1s1 + integer :: i_l2s1 + integer :: i_l3s2 + integer :: i_s1s2 + integer :: i_s1s3 + integer :: i_s2s1 + integer :: i_s2s3 + integer :: i_s3s1 + integer :: i_cwdl2 + integer :: i_cwdl3 + real(r8):: speedup_fac ! acceleration factor, higher when vertsoilc = .true. + + integer :: c, j ! indices + real(r8) :: t ! temporary variable + !----------------------------------------------------------------------- + + associate( & + rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac) + pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac) + + cellsand => soilstate_inst%cellsand_col , & ! Input: [real(r8) (:,:) ] column 3D sand + + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Output: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Output: [integer (:) ] which pool is C added to for a given decomposition step + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Output: [logical (:) ] TRUE => pool has fixed C:N ratio + is_litter => decomp_cascade_con%is_litter , & ! Output: [logical (:) ] TRUE => pool is a litter pool + is_soil => decomp_cascade_con%is_soil , & ! Output: [logical (:) ] TRUE => pool is a soil pool + is_cwd => decomp_cascade_con%is_cwd , & ! Output: [logical (:) ] TRUE => pool is a cwd pool + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Output: [real(r8) (:) ] c:n ratio for initialization of pools + initial_stock => decomp_cascade_con%initial_stock , & ! Output: [real(r8) (:) ] initial concentration for seeding at spinup + initial_stock_soildepth => decomp_cascade_con%initial_stock_soildepth , & ! Output: [real(r8) (:) ] soil depth for initial concentration for seeding at spinup + is_metabolic => decomp_cascade_con%is_metabolic , & ! Output: [logical (:) ] TRUE => pool is metabolic material + is_cellulose => decomp_cascade_con%is_cellulose , & ! Output: [logical (:) ] TRUE => pool is cellulose + is_lignin => decomp_cascade_con%is_lignin , & ! Output: [logical (:) ] TRUE => pool is lignin + spinup_factor => decomp_cascade_con%spinup_factor & ! Output: [real(r8) (:) ] factor for AD spinup associated with each pool + + ) + + allocate(rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp)) + allocate(rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp)) + allocate(f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp)) + allocate(f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp)) + + !------- time-constant coefficients ---------- ! + ! set soil organic matter compartment C:N ratios + cn_s1 = params_inst%cn_s1_bgc + cn_s2 = params_inst%cn_s2_bgc + cn_s3 = params_inst%cn_s3_bgc + + ! set respiration fractions for fluxes between compartments + rf_l1s1 = params_inst%rf_l1s1_bgc + rf_l2s1 = params_inst%rf_l2s1_bgc + rf_l3s2 = params_inst%rf_l3s2_bgc + rf_s2s1 = params_inst%rf_s2s1_bgc + rf_s2s3 = params_inst%rf_s2s3_bgc + rf_s3s1 = params_inst%rf_s3s1_bgc + + rf_cwdl2 = params_inst%rf_cwdl2_bgc + rf_cwdl3 = params_inst%rf_cwdl3_bgc + + ! set the cellulose and lignin fractions for coarse woody debris + cwd_fcel = params_inst%cwd_fcel_bgc + cwd_flig = params_inst%cwd_flig_bgc + + ! set path fractions + f_s2s1 = 0.42_r8/(0.45_r8) + f_s2s3 = 0.03_r8/(0.45_r8) + + ! some of these are dependent on the soil texture properties + do c = bounds%begc, bounds%endc + do j = 1, nlevdecomp + t = 0.85_r8 - 0.68_r8 * 0.01_r8 * (100._r8 - cellsand(c,j)) + f_s1s2(c,j) = 1._r8 - .004_r8 / (1._r8 - t) + f_s1s3(c,j) = .004_r8 / (1._r8 - t) + rf_s1s2(c,j) = t + rf_s1s3(c,j) = t + end do + end do + initial_stock_soildepth = params_inst%initial_Cstocks_depth + + !------------------- list of pools and their attributes ------------ + floating_cn_ratio_decomp_pools(i_litr1) = .true. + decomp_cascade_con%decomp_pool_name_restart(i_litr1) = 'litr1' + decomp_cascade_con%decomp_pool_name_history(i_litr1) = 'LITR1' + decomp_cascade_con%decomp_pool_name_long(i_litr1) = 'litter 1' + decomp_cascade_con%decomp_pool_name_short(i_litr1) = 'L1' + is_litter(i_litr1) = .true. + is_soil(i_litr1) = .false. + is_cwd(i_litr1) = .false. + initial_cn_ratio(i_litr1) = 90._r8 + initial_stock(i_litr1) = 0._r8 + is_metabolic(i_litr1) = .true. + is_cellulose(i_litr1) = .false. + is_lignin(i_litr1) = .false. + + floating_cn_ratio_decomp_pools(i_litr2) = .true. + decomp_cascade_con%decomp_pool_name_restart(i_litr2) = 'litr2' + decomp_cascade_con%decomp_pool_name_history(i_litr2) = 'LITR2' + decomp_cascade_con%decomp_pool_name_long(i_litr2) = 'litter 2' + decomp_cascade_con%decomp_pool_name_short(i_litr2) = 'L2' + is_litter(i_litr2) = .true. + is_soil(i_litr2) = .false. + is_cwd(i_litr2) = .false. + initial_cn_ratio(i_litr2) = 90._r8 + initial_stock(i_litr2) = 0._r8 + is_metabolic(i_litr2) = .false. + is_cellulose(i_litr2) = .true. + is_lignin(i_litr2) = .false. + + floating_cn_ratio_decomp_pools(i_litr3) = .true. + decomp_cascade_con%decomp_pool_name_restart(i_litr3) = 'litr3' + decomp_cascade_con%decomp_pool_name_history(i_litr3) = 'LITR3' + decomp_cascade_con%decomp_pool_name_long(i_litr3) = 'litter 3' + decomp_cascade_con%decomp_pool_name_short(i_litr3) = 'L3' + is_litter(i_litr3) = .true. + is_soil(i_litr3) = .false. + is_cwd(i_litr3) = .false. + initial_cn_ratio(i_litr3) = 90._r8 + initial_stock(i_litr3) = 0._r8 + is_metabolic(i_litr3) = .false. + is_cellulose(i_litr3) = .false. + is_lignin(i_litr3) = .true. + + if (.not. use_fates) then + ! CWD + floating_cn_ratio_decomp_pools(i_cwd) = .true. + decomp_cascade_con%decomp_pool_name_restart(i_cwd) = 'cwd' + decomp_cascade_con%decomp_pool_name_history(i_cwd) = 'CWD' + decomp_cascade_con%decomp_pool_name_long(i_cwd) = 'coarse woody debris' + decomp_cascade_con%decomp_pool_name_short(i_cwd) = 'CWD' + is_litter(i_cwd) = .false. + is_soil(i_cwd) = .false. + is_cwd(i_cwd) = .true. + initial_cn_ratio(i_cwd) = 90._r8 + initial_stock(i_cwd) = 0._r8 + is_metabolic(i_cwd) = .false. + is_cellulose(i_cwd) = .false. + is_lignin(i_cwd) = .false. + endif + + if (.not. use_fates) then + i_soil1 = 5 + else + i_soil1 = 4 + endif + floating_cn_ratio_decomp_pools(i_soil1) = .false. + decomp_cascade_con%decomp_pool_name_restart(i_soil1) = 'soil1' + decomp_cascade_con%decomp_pool_name_history(i_soil1) = 'SOIL1' + decomp_cascade_con%decomp_pool_name_long(i_soil1) = 'soil 1' + decomp_cascade_con%decomp_pool_name_short(i_soil1) = 'S1' + is_litter(i_soil1) = .false. + is_soil(i_soil1) = .true. + is_cwd(i_soil1) = .false. + initial_cn_ratio(i_soil1) = cn_s1 + initial_stock(i_soil1) = params_inst%initial_Cstocks(1) + is_metabolic(i_soil1) = .false. + is_cellulose(i_soil1) = .false. + is_lignin(i_soil1) = .false. + + if (.not. use_fates) then + i_soil2 = 6 + else + i_soil2 = 5 + endif + floating_cn_ratio_decomp_pools(i_soil2) = .false. + decomp_cascade_con%decomp_pool_name_restart(i_soil2) = 'soil2' + decomp_cascade_con%decomp_pool_name_history(i_soil2) = 'SOIL2' + decomp_cascade_con%decomp_pool_name_long(i_soil2) = 'soil 2' + decomp_cascade_con%decomp_pool_name_short(i_soil2) = 'S2' + is_litter(i_soil2) = .false. + is_soil(i_soil2) = .true. + is_cwd(i_soil2) = .false. + initial_cn_ratio(i_soil2) = cn_s2 + initial_stock(i_soil2) = params_inst%initial_Cstocks(2) + is_metabolic(i_soil2) = .false. + is_cellulose(i_soil2) = .false. + is_lignin(i_soil2) = .false. + + if (.not. use_fates) then + i_soil3 = 7 + else + i_soil3 = 6 + endif + floating_cn_ratio_decomp_pools(i_soil3) = .false. + decomp_cascade_con%decomp_pool_name_restart(i_soil3) = 'soil3' + decomp_cascade_con%decomp_pool_name_history(i_soil3) = 'SOIL3' + decomp_cascade_con%decomp_pool_name_long(i_soil3) = 'soil 3' + decomp_cascade_con%decomp_pool_name_short(i_soil3) = 'S3' + is_litter(i_soil3) = .false. + is_soil(i_soil3) = .true. + is_cwd(i_soil3) = .false. + initial_cn_ratio(i_soil3) = cn_s3 + initial_stock(i_soil3) = params_inst%initial_Cstocks(3) + is_metabolic(i_soil3) = .false. + is_cellulose(i_soil3) = .false. + is_lignin(i_soil3) = .false. + + + speedup_fac = 1._r8 + + !lit1 + spinup_factor(i_litr1) = 1._r8 + !lit2,3 + spinup_factor(i_litr2) = 1._r8 + spinup_factor(i_litr3) = 1._r8 + !CWD + if (.not. use_fates) then + spinup_factor(i_cwd) = max(1._r8, (speedup_fac * params_inst%tau_cwd_bgc / 2._r8 )) + end if + !som1 + spinup_factor(i_soil1) = 1._r8 + !som2,3 + spinup_factor(i_soil2) = max(1._r8, (speedup_fac * params_inst%tau_s2_bgc)) + spinup_factor(i_soil3) = max(1._r8, (speedup_fac * params_inst%tau_s3_bgc)) + + if ( masterproc ) then + write(iulog,*) 'Spinup_state ',spinup_state + write(iulog,*) 'Spinup factors ',spinup_factor + end if + + !---------------- list of transitions and their time-independent coefficients ---------------! + i_l1s1 = 1 + decomp_cascade_con%cascade_step_name(i_l1s1) = 'L1S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = rf_l1s1 + cascade_donor_pool(i_l1s1) = i_litr1 + cascade_receiver_pool(i_l1s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = 1.0_r8 + + i_l2s1 = 2 + decomp_cascade_con%cascade_step_name(i_l2s1) = 'L2S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s1) = rf_l2s1 + cascade_donor_pool(i_l2s1) = i_litr2 + cascade_receiver_pool(i_l2s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s1)= 1.0_r8 + + i_l3s2 = 3 + decomp_cascade_con%cascade_step_name(i_l3s2) = 'L3S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s2) = rf_l3s2 + cascade_donor_pool(i_l3s2) = i_litr3 + cascade_receiver_pool(i_l3s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s2) = 1.0_r8 + + i_s1s2 = 4 + decomp_cascade_con%cascade_step_name(i_s1s2) = 'S1S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp) + cascade_donor_pool(i_s1s2) = i_soil1 + cascade_receiver_pool(i_s1s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp) + + if (use_soil_matrixcn)then !use fates will automatically turn off use_soil_matrixcn + i_cwdl2 = 5 + decomp_cascade_con%cascade_step_name(i_cwdl2) = 'CWDL2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = rf_cwdl2 + cascade_donor_pool(i_cwdl2) = i_cwd + cascade_receiver_pool(i_cwdl2) = i_litr2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = cwd_fcel + + i_cwdl3 = 6 + decomp_cascade_con%cascade_step_name(i_cwdl3) = 'CWDL3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = rf_cwdl3 + cascade_donor_pool(i_cwdl3) = i_cwd + cascade_receiver_pool(i_cwdl3) = i_litr3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig + + i_s1s3 = 7 + decomp_cascade_con%cascade_step_name(i_s1s3) = 'S1S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s3) = rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + cascade_donor_pool(i_s1s3) = i_soil1 + cascade_receiver_pool(i_s1s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s3) = f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + + i_s2s1 = 8 + decomp_cascade_con%cascade_step_name(i_s2s1) = 'S2S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s1) = rf_s2s1 + cascade_donor_pool(i_s2s1) = i_soil2 + cascade_receiver_pool(i_s2s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s1) = f_s2s1 + + i_s2s3 = 9 + decomp_cascade_con%cascade_step_name(i_s2s3) = 'S2S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = rf_s2s3 + cascade_donor_pool(i_s2s3) = i_soil2 + cascade_receiver_pool(i_s2s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = f_s2s3 + + i_s3s1 = 10 + decomp_cascade_con%cascade_step_name(i_s3s1) = 'S3S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s1) = rf_s3s1 + cascade_donor_pool(i_s3s1) = i_soil3 + cascade_receiver_pool(i_s3s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s1) = 1.0_r8 + else + i_s1s3 = 5 + decomp_cascade_con%cascade_step_name(i_s1s3) = 'S1S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s3) = rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + cascade_donor_pool(i_s1s3) = i_soil1 + cascade_receiver_pool(i_s1s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s3) = f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + + i_s2s1 = 6 + decomp_cascade_con%cascade_step_name(i_s2s1) = 'S2S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s1) = rf_s2s1 + cascade_donor_pool(i_s2s1) = i_soil2 + cascade_receiver_pool(i_s2s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s1) = f_s2s1 + + i_s2s3 = 7 + decomp_cascade_con%cascade_step_name(i_s2s3) = 'S2S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = rf_s2s3 + cascade_donor_pool(i_s2s3) = i_soil2 + cascade_receiver_pool(i_s2s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = f_s2s3 + + i_s3s1 = 8 + decomp_cascade_con%cascade_step_name(i_s3s1) = 'S3S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s1) = rf_s3s1 + cascade_donor_pool(i_s3s1) = i_soil3 + cascade_receiver_pool(i_s3s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s1) = 1.0_r8 + + if (.not. use_fates) then + i_cwdl2 = 9 + decomp_cascade_con%cascade_step_name(i_cwdl2) = 'CWDL2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = rf_cwdl2 + cascade_donor_pool(i_cwdl2) = i_cwd + cascade_receiver_pool(i_cwdl2) = i_litr2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = cwd_fcel + + i_cwdl3 = 10 + decomp_cascade_con%cascade_step_name(i_cwdl3) = 'CWDL3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = rf_cwdl3 + cascade_donor_pool(i_cwdl3) = i_cwd + cascade_receiver_pool(i_cwdl3) = i_litr3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig + end if + end if + + if(use_soil_matrixcn) call InitSoilTransfer() + + deallocate(rf_s1s2) + deallocate(rf_s1s3) + deallocate(f_s1s2) + deallocate(f_s1s3) + + end associate + + end subroutine init_decompcascade_bgc + + !----------------------------------------------------------------------- + subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & + soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! calculate rate constants and decomposition pathways for the CENTURY decomposition cascade model + ! written by C. Koven based on original CLM4 decomposition cascade + ! + ! !USES: + use clm_time_manager , only : get_days_per_year, get_step_size + use shr_const_mod , only : SHR_CONST_PI + use clm_varcon , only : secspday + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(ch4_type) , intent(in) :: ch4_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + ! + ! !LOCAL VARIABLES: + real(r8):: frw(bounds%begc:bounds%endc) ! rooting fraction weight + real(r8), allocatable:: fr(:,:) ! column-level rooting fraction by soil depth + real(r8):: psi ! temporary soilpsi for water scalar + real(r8):: rate_scalar ! combined rate scalar for decomp + real(r8):: k_l1 ! decomposition rate constant litter 1 (1/sec) + real(r8):: k_l2_l3 ! decomposition rate constant litter 2 and litter 3 (1/sec) + real(r8):: k_s1 ! decomposition rate constant SOM 1 (1/sec) + real(r8):: k_s2 ! decomposition rate constant SOM 2 (1/sec) + real(r8):: k_s3 ! decomposition rate constant SOM 3 (1/sec) + real(r8):: k_frag ! fragmentation rate constant CWD (1/sec) + real(r8):: cwdc_loss ! fragmentation rate for CWD carbon (gC/m2/s) + real(r8):: cwdn_loss ! fragmentation rate for CWD nitrogen (gN/m2/s) + real(r8):: Q10 ! temperature dependence + real(r8):: froz_q10 ! separate q10 for frozen soil respiration rates. default to same as above zero rates + real(r8):: decomp_depth_efolding ! (meters) e-folding depth for reduction in decomposition [ + integer :: c, fc, j, k, l + real(r8):: dt ! decomposition time step + real(r8):: catanf ! hyperbolic temperature function from CENTURY + real(r8):: catanf_30 ! reference rate at 30C + real(r8):: t1 ! temperature argument + real(r8):: normalization_factor ! factor by which to offset the decomposition rates frm century to a q10 formulation + real(r8):: days_per_year ! days per year + real(r8):: depth_scalar(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8):: mino2lim !minimum anaerobic decomposition rate + real(r8):: spinup_geogterm_l1(bounds%begc:bounds%endc) ! geographically-varying spinup term for l1 + real(r8):: spinup_geogterm_l23(bounds%begc:bounds%endc) ! geographically-varying spinup term for l2 and l3 + real(r8):: spinup_geogterm_cwd(bounds%begc:bounds%endc) ! geographically-varying spinup term for cwd + real(r8):: spinup_geogterm_s1(bounds%begc:bounds%endc) ! geographically-varying spinup term for s1 + real(r8):: spinup_geogterm_s2(bounds%begc:bounds%endc) ! geographically-varying spinup term for s2 + real(r8):: spinup_geogterm_s3(bounds%begc:bounds%endc) ! geographically-varying spinup term for s3 + + !----------------------------------------------------------------------- + + !----- CENTURY T response function + catanf(t1) = 11.75_r8 +(29.7_r8 / SHR_CONST_PI) * atan( SHR_CONST_PI * 0.031_r8 * ( t1 - 15.4_r8 )) + + associate( & + minpsi => params_inst%minpsi_bgc , & ! Input: [real(r8) ] minimum soil suction (mm) + maxpsi => params_inst%maxpsi_bgc , & ! Input: [real(r8) ] maximum soil suction (mm) + soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + o2stress_sat => ch4_inst%o2stress_sat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + o2stress_unsat => ch4_inst%o2stress_unsat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area + + t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Output: [real(r8) (:,:) ] soil temperature scalar for decomp + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp + o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + Ksoil => soilbiogeochem_carbonflux_inst%Ksoil , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + spinup_factor => decomp_cascade_con%spinup_factor & ! Input: [real(r8) (:) ] factor for AD spinup associated with each pool +! matrix_decomp_k => soilbiogeochem_carbonflux_inst%matrix_decomp_k_col & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ) + + mino2lim = CNParamsShareInst%mino2lim + + if ( use_century_tfunc .and. normalize_q10_to_century_tfunc ) then + call endrun(msg='ERROR: cannot have both use_century_tfunc and normalize_q10_to_century_tfunc set as true'//& + errMsg(sourcefile, __LINE__)) + endif + + days_per_year = get_days_per_year() + dt = real( get_step_size(), r8 ) + + ! set "Q10" parameter + Q10 = CNParamsShareInst%Q10 + + ! set "froz_q10" parameter + froz_q10 = CNParamsShareInst%froz_q10 + + ! Set "decomp_depth_efolding" parameter + decomp_depth_efolding = CNParamsShareInst%decomp_depth_efolding + + ! translate to per-second time constant + k_l1 = 1._r8 / (secspday * days_per_year * params_inst%tau_l1_bgc) + k_l2_l3 = 1._r8 / (secspday * days_per_year * params_inst%tau_l2_l3_bgc) + k_s1 = 1._r8 / (secspday * days_per_year * params_inst%tau_s1_bgc) + k_s2 = 1._r8 / (secspday * days_per_year * params_inst%tau_s2_bgc) + k_s3 = 1._r8 / (secspday * days_per_year * params_inst%tau_s3_bgc) + k_frag = 1._r8 / (secspday * days_per_year * params_inst%tau_cwd_bgc) + + ! calc ref rate + catanf_30 = catanf(30._r8) + + if ( spinup_state >= 1 ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + ! + if ( abs(spinup_factor(i_litr1) - 1._r8) .gt. .000001_r8) then + spinup_geogterm_l1(c) = spinup_factor(i_litr1) * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + else + spinup_geogterm_l1(c) = 1._r8 + endif + ! + if ( abs(spinup_factor(i_litr2) - 1._r8) .gt. .000001_r8) then + spinup_geogterm_l23(c) = spinup_factor(i_litr2) * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + else + spinup_geogterm_l23(c) = 1._r8 + endif + ! + if ( .not. use_fates ) then + if ( abs(spinup_factor(i_cwd) - 1._r8) .gt. .000001_r8) then + spinup_geogterm_cwd(c) = spinup_factor(i_cwd) * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + else + spinup_geogterm_cwd(c) = 1._r8 + endif + endif + ! + if ( abs(spinup_factor(i_soil1) - 1._r8) .gt. .000001_r8) then + spinup_geogterm_s1(c) = spinup_factor(i_soil1) * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + else + spinup_geogterm_s1(c) = 1._r8 + endif + ! + if ( abs(spinup_factor(i_soil2) - 1._r8) .gt. .000001_r8) then + spinup_geogterm_s2(c) = spinup_factor(i_soil2) * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + else + spinup_geogterm_s2(c) = 1._r8 + endif + ! + if ( abs(spinup_factor(i_soil3) - 1._r8) .gt. .000001_r8) then + spinup_geogterm_s3(c) = spinup_factor(i_soil3) * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + else + spinup_geogterm_s3(c) = 1._r8 + endif + ! + end do + else + do fc = 1,num_soilc + c = filter_soilc(fc) + spinup_geogterm_l1(c) = 1._r8 + spinup_geogterm_l23(c) = 1._r8 + spinup_geogterm_cwd(c) = 1._r8 + spinup_geogterm_s1(c) = 1._r8 + spinup_geogterm_s2(c) = 1._r8 + spinup_geogterm_s3(c) = 1._r8 + end do + endif + + !--- time dependent coefficients-----! + if ( nlevdecomp .eq. 1 ) then + + ! calculate function to weight the temperature and water potential scalars + ! for decomposition control. + + + ! the following normalizes values in fr so that they + ! sum to 1.0 across top nlevdecomp levels on a column + frw(bounds%begc:bounds%endc) = 0._r8 + nlev_soildecomp_standard=5 + allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard)) + do j=1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + frw(c) = frw(c) + col%dz(c,j) + end do + end do + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (frw(c) /= 0._r8) then + fr(c,j) = col%dz(c,j) / frw(c) + else + fr(c,j) = 0._r8 + end if + end do + end do + + if ( .not. use_century_tfunc ) then + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) t_scalar(c,:) = 0._r8 + if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then + t_scalar(c,1)=t_scalar(c,1) + & + (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j) + else + t_scalar(c,1)=t_scalar(c,1) + & + (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8))*fr(c,j) + endif + end do + end do + + else + ! original century uses an arctangent function to calculate the temperature dependence of decomposition + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) t_scalar(c,:) = 0._r8 + + t_scalar(c,1)=t_scalar(c,1) +max(catanf(t_soisno(c,j)-SHR_CONST_TKFRZ)/catanf_30*fr(c,j),0.01_r8) + end do + end do + + endif + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) w_scalar(c,:) = 0._r8 + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,1) = w_scalar(c,1) + (log(minpsi/psi)/log(minpsi/maxpsi))*fr(c,j) + end if + end do + end do + + if (use_lch4) then + ! Calculate ANOXIA + if (anoxia) then + ! Check for anoxia w/o LCH4 now done in controlMod. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (j==1) o_scalar(c,:) = 0._r8 + + o_scalar(c,1) = o_scalar(c,1) + fr(c,j) * max(o2stress_unsat(c,j), mino2lim) + end do + end do + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + + deallocate(fr) + + else + + if ( .not. use_century_tfunc ) then + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + ! Peter Thornton: 3/13/09 + ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5 + ! as part of the modifications made to improve the seasonal cycle of + ! atmospheric CO2 concentration in global simulations. This does not impact + ! the base rates at 25 C, which are calibrated from microcosm studies. + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then + t_scalar(c,j)= (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8)) + else + t_scalar(c,j)= (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8)) + endif + end do + end do + + else + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + t_scalar(c,j)= max(catanf(t_soisno(c,j)-SHR_CONST_TKFRZ)/catanf_30, 0.01_r8) + end do + end do + + endif + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,j) = (log(minpsi/psi)/log(minpsi/maxpsi)) + else + w_scalar(c,j) = 0._r8 + end if + end do + end do + + if (use_lch4) then + ! Calculate ANOXIA + ! Check for anoxia w/o LCH4 now done in controlMod. + + if (anoxia) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + o_scalar(c,j) = max(o2stress_unsat(c,j), mino2lim) + end do + end do + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + + end if + + if ( normalize_q10_to_century_tfunc ) then + ! scale all decomposition rates by a constant to compensate for offset between original CENTURY temp func and Q10 + normalization_factor = (catanf(normalization_tref)/catanf_30) / (q10**((normalization_tref-25._r8)/10._r8)) + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + t_scalar(c,j) = t_scalar(c,j) * normalization_factor + end do + end do + endif + + if (use_vertsoilc) then + ! add a term to reduce decomposition rate at depth + ! for now used a fixed e-folding depth + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + depth_scalar(c,j) = exp(-zsoi(j)/decomp_depth_efolding) + end do + end do + end if + + ! calculate rate constants for all litter and som pools + if (use_vertsoilc) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) & + * spinup_geogterm_l1(c) + decomp_k(c,j,i_litr2) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) & + * spinup_geogterm_l23(c) + decomp_k(c,j,i_litr3) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) & + * spinup_geogterm_l23(c) + decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) & + * spinup_geogterm_s1(c) + decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) & + * spinup_geogterm_s2(c) + decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) & + * spinup_geogterm_s3(c) + if(use_soil_matrixcn)then + Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l1(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s1(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s2(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s3(c) * dt + end if !use_soil_matrixcn + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l1(c) + decomp_k(c,j,i_litr2) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) + decomp_k(c,j,i_litr3) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) + decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s1(c) + decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s2(c) + decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s3(c) + if(use_soil_matrixcn)then + Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l1(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s1(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s2(c) * dt + Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s3(c) * dt + end if !use_soil_matrixcn + end do + end do + end if + + ! do the same for cwd, but only if fates is not enabled, because fates handles CWD on its own structure + if (.not. use_fates) then + if (use_vertsoilc) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * & + o_scalar(c,j) * spinup_geogterm_cwd(c) + if(use_soil_matrixcn)then + Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * & + o_scalar(c,j) * spinup_geogterm_cwd(c) * dt + end if !use_soil_matrixcn + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * & + o_scalar(c,j) * spinup_geogterm_cwd(c) + if(use_soil_matrixcn)then + Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * & + o_scalar(c,j) * spinup_geogterm_cwd(c) * dt + end if !use_soil_matrixcn + end do + end do + end if + end if + + end associate + + end subroutine decomp_rate_constants_bgc + +end module SoilBiogeochemDecompCascadeBGCMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 new file mode 100755 index 000000000..6e8ef1074 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 @@ -0,0 +1,996 @@ +module SoilBiogeochemDecompCascadeCNMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Sets the coeffiecients used in the decomposition cascade submodel. + ! This uses the CN parameters as in CLMCN 4.0 + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : nlevsoi, nlevgrnd, nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, spinup_state, anoxia, use_lch4, use_vertsoilc, use_fates, use_soil_matrixcn + use clm_varcon , only : zsoi + use decompMod , only : bounds_type + use abortutils , only : endrun + use CNSharedParamsMod , only : CNParamsShareInst, nlev_soildecomp_standard + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con, InitSoilTransfer + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use ch4Mod , only : ch4_type + use ColumnType , only : col + + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: init_decompcascade_cn + public :: decomp_rate_constants_cn + + type, private :: params_type + real(r8):: cn_s1_cn !C:N for SOM 1 + real(r8):: cn_s2_cn !C:N for SOM 2 + real(r8):: cn_s3_cn !C:N for SOM 3 + real(r8):: cn_s4_cn !C:N for SOM 4 + + real(r8):: rf_l1s1_cn !respiration fraction litter 1 -> SOM 1 + real(r8):: rf_l2s2_cn !respiration fraction litter 2 -> SOM 2 + real(r8):: rf_l3s3_cn !respiration fraction litter 3 -> SOM 3 + real(r8):: rf_s1s2_cn !respiration fraction SOM 1 -> SOM 2 + real(r8):: rf_s2s3_cn !respiration fraction SOM 2 -> SOM 3 + real(r8):: rf_s3s4_cn !respiration fraction SOM 3 -> SOM 4 + + real(r8) :: cwd_fcel_cn !cellulose fraction for CWD + real(r8) :: cwd_flig_cn ! + + real(r8) :: k_l1_cn !decomposition rate for litter 1 + real(r8) :: k_l2_cn !decomposition rate for litter 2 + real(r8) :: k_l3_cn !decomposition rate for litter 3 + real(r8) :: k_s1_cn !decomposition rate for SOM 1 + real(r8) :: k_s2_cn !decomposition rate for SOM 2 + real(r8) :: k_s3_cn !decomposition rate for SOM 3 + real(r8) :: k_s4_cn !decomposition rate for SOM 4 + + real(r8) :: k_frag_cn !fragmentation rate for CWD + real(r8) :: minpsi_cn !minimum soil water potential for heterotrophic resp + real(r8) :: maxpsi_cn !maximum soil water potential for heterotrophic resp + + integer :: nsompools = 4 + real(r8), allocatable :: spinup_vector(:) ! multipliers for soil decomp during accelerated spinup + + end type params_type + ! + type(params_type), private :: params_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !CALLED FROM: readParamsMod.F90::CNParamsReadFile + ! + ! !REVISION HISTORY: + ! Dec 3 2012 : Created by S. Muszala + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'SoilBiogeochemDecompCnParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + + !EOP + !----------------------------------------------------------------------- + + ! These are not read off of netcdf file + allocate(params_inst%spinup_vector(params_inst%nsompools)) + params_inst%spinup_vector(:) = (/ 1.0_r8, 1.0_r8, 5.0_r8, 70.0_r8 /) + + ! Read off of netcdf file + tString='cn_s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cn_s1_cn=tempr + + tString='cn_s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cn_s2_cn=tempr + + tString='cn_s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cn_s3_cn=tempr + + tString='cn_s4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cn_s4_cn=tempr + + tString='rf_l1s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_l1s1_cn=tempr + + tString='rf_l2s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_l2s2_cn=tempr + + tString='rf_l3s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_l3s3_cn=tempr + + tString='rf_s1s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_s1s2_cn=tempr + + tString='rf_s2s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_s2s3_cn=tempr + + tString='rf_s3s4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rf_s3s4_cn=tempr + + tString='cwd_fcel' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cwd_fcel_cn=tempr + + tString='k_l1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_l1_cn=tempr + + tString='k_l2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_l2_cn=tempr + + tString='k_l3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_l3_cn=tempr + + tString='k_s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_s1_cn=tempr + + tString='k_s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_s2_cn=tempr + + tString='k_s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_s3_cn=tempr + + tString='k_s4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_s4_cn=tempr + + tString='k_frag' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_frag_cn=tempr + + tString='minpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%minpsi_cn=tempr + + tString='maxpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%maxpsi_cn=tempr + + tString='cwd_flig' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cwd_flig_cn=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine init_decompcascade_cn(bounds, soilbiogeochem_state_inst) + ! + ! !DESCRIPTION: + ! initialize rate constants and decomposition pathways for the BGC model originally implemented in CLM-CN + ! written by C. Koven based on original CLM4 decomposition cascade by P. Thornton + ! + ! !USES: + use SoilBiogeochemDecompCascadeConType, only : i_atm + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + ! + !-- properties of each pathway along decomposition cascade + !-- properties of each decomposing pool + real(r8) :: rf_l1s1 !respiration fraction litter 1 -> SOM 1 + real(r8) :: rf_l2s2 !respiration fraction litter 2 -> SOM 2 + real(r8) :: rf_l3s3 !respiration fraction litter 3 -> SOM 3 + real(r8) :: rf_s1s2 !respiration fraction SOM 1 -> SOM 2 + real(r8) :: rf_s2s3 !respiration fraction SOM 2 -> SOM 3 + real(r8) :: rf_s3s4 !respiration fraction SOM 3 -> SOM 4 + real(r8) :: cwd_fcel + real(r8) :: cwd_flig + real(r8) :: cn_s1 + real(r8) :: cn_s2 + real(r8) :: cn_s3 + real(r8) :: cn_s4 + + integer :: i_litr1 + integer :: i_litr2 + integer :: i_litr3 + integer :: i_soil1 + integer :: i_soil2 + integer :: i_soil3 + integer :: i_soil4 + integer :: i_l1s1 + integer :: i_l2s2 + integer :: i_l3s3 + integer :: i_s1s2 + integer :: i_s2s3 + integer :: i_s3s4 + integer :: i_s4atm + integer :: i_cwdl2 + integer :: i_cwdl3 + !----------------------------------------------------------------------- + + associate( & + rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Output: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac) + pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Output: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac) + + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Output: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Output: [integer (:) ] which pool is C added to for a given decomposition step + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Output: [logical (:) ] TRUE => pool has fixed C:N ratio + is_litter => decomp_cascade_con%is_litter , & ! Output: [logical (:) ] TRUE => pool is a litter pool + is_soil => decomp_cascade_con%is_soil , & ! Output: [logical (:) ] TRUE => pool is a soil pool + is_cwd => decomp_cascade_con%is_cwd , & ! Output: [logical (:) ] TRUE => pool is a cwd pool + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Output: [real(r8) (:) ] c:n ratio for initialization of pools + initial_stock => decomp_cascade_con%initial_stock , & ! Output: [real(r8) (:) ] initial concentration for seeding at spinup + is_metabolic => decomp_cascade_con%is_metabolic , & ! Output: [logical (:) ] TRUE => pool is metabolic material + is_cellulose => decomp_cascade_con%is_cellulose , & ! Output: [logical (:) ] TRUE => pool is cellulose + is_lignin => decomp_cascade_con%is_lignin , & ! Output: [logical (:) ] TRUE => pool is lignin + spinup_factor => decomp_cascade_con%spinup_factor & ! Output: [real(r8) (:) ] factor for AD spinup associated with each pool + ) + + !------- time-constant coefficients ---------- ! + ! set soil organic matter compartment C:N ratios (from Biome-BGC v4.2.0) + cn_s1=params_inst%cn_s1_cn + cn_s2=params_inst%cn_s2_cn + cn_s3=params_inst%cn_s3_cn + cn_s4=params_inst%cn_s4_cn + + ! set respiration fractions for fluxes between compartments + ! (from Biome-BGC v4.2.0) + rf_l1s1=params_inst%rf_l1s1_cn + rf_l2s2=params_inst%rf_l2s2_cn + rf_l3s3=params_inst%rf_l3s3_cn + rf_s1s2=params_inst%rf_s1s2_cn + rf_s2s3=params_inst%rf_s2s3_cn + rf_s3s4=params_inst%rf_s3s4_cn + + ! set the cellulose and lignin fractions for coarse woody debris + cwd_fcel=params_inst%cwd_fcel_cn + cwd_flig=params_inst%cwd_flig_cn + + !------------------- list of pools and their attributes ------------ + + i_litr1 = i_met_lit + floating_cn_ratio_decomp_pools(i_litr1) = .true. + decomp_cascade_con%decomp_pool_name_restart(i_litr1) = 'litr1' + decomp_cascade_con%decomp_pool_name_history(i_litr1) = 'LITR1' + decomp_cascade_con%decomp_pool_name_long(i_litr1) = 'litter 1' + decomp_cascade_con%decomp_pool_name_short(i_litr1) = 'L1' + is_litter(i_litr1) = .true. + is_soil(i_litr1) = .false. + is_cwd(i_litr1) = .false. + initial_cn_ratio(i_litr1) = 90._r8 + initial_stock(i_litr1) = 0._r8 + is_metabolic(i_litr1) = .true. + is_cellulose(i_litr1) = .false. + is_lignin(i_litr1) = .false. + + i_litr2 = i_cel_lit + floating_cn_ratio_decomp_pools(i_litr2) = .true. + decomp_cascade_con%decomp_pool_name_restart(i_litr2) = 'litr2' + decomp_cascade_con%decomp_pool_name_history(i_litr2) = 'LITR2' + decomp_cascade_con%decomp_pool_name_long(i_litr2) = 'litter 2' + decomp_cascade_con%decomp_pool_name_short(i_litr2) = 'L2' + is_litter(i_litr2) = .true. + is_soil(i_litr2) = .false. + is_cwd(i_litr2) = .false. + initial_cn_ratio(i_litr2) = 90._r8 + initial_stock(i_litr2) = 0._r8 + is_metabolic(i_litr2) = .false. + is_cellulose(i_litr2) = .true. + is_lignin(i_litr2) = .false. + + i_litr3 = i_lig_lit + floating_cn_ratio_decomp_pools(i_litr3) = .true. + decomp_cascade_con%decomp_pool_name_restart(i_litr3) = 'litr3' + decomp_cascade_con%decomp_pool_name_history(i_litr3) = 'LITR3' + decomp_cascade_con%decomp_pool_name_long(i_litr3) = 'litter 3' + decomp_cascade_con%decomp_pool_name_short(i_litr3) = 'L3' + is_litter(i_litr3) = .true. + is_soil(i_litr3) = .false. + is_cwd(i_litr3) = .false. + initial_cn_ratio(i_litr3) = 90._r8 + initial_stock(i_litr3) = 0._r8 + is_metabolic(i_litr3) = .false. + is_cellulose(i_litr3) = .false. + is_lignin(i_litr3) = .true. + + if (.not. use_fates) then + floating_cn_ratio_decomp_pools(i_cwd) = .true. + decomp_cascade_con%decomp_pool_name_restart(i_cwd) = 'cwd' + decomp_cascade_con%decomp_pool_name_history(i_cwd) = 'CWD' + decomp_cascade_con%decomp_pool_name_long(i_cwd) = 'coarse woody debris' + decomp_cascade_con%decomp_pool_name_short(i_cwd) = 'CWD' + is_litter(i_cwd) = .false. + is_soil(i_cwd) = .false. + is_cwd(i_cwd) = .true. + initial_cn_ratio(i_cwd) = 500._r8 + initial_stock(i_cwd) = 0._r8 + is_metabolic(i_cwd) = .false. + is_cellulose(i_cwd) = .false. + is_lignin(i_cwd) = .false. + end if + + if ( .not. use_fates ) then + i_soil1 = 5 + else + i_soil1 = 4 + endif + floating_cn_ratio_decomp_pools(i_soil1) = .false. + decomp_cascade_con%decomp_pool_name_restart(i_soil1) = 'soil1' + decomp_cascade_con%decomp_pool_name_history(i_soil1) = 'SOIL1' + decomp_cascade_con%decomp_pool_name_long(i_soil1) = 'soil 1' + decomp_cascade_con%decomp_pool_name_short(i_soil1) = 'S1' + is_litter(i_soil1) = .false. + is_soil(i_soil1) = .true. + is_cwd(i_soil1) = .false. + initial_cn_ratio(i_soil1) = cn_s1 + initial_stock(i_soil1) = 0._r8 + is_metabolic(i_soil1) = .false. + is_cellulose(i_soil1) = .false. + is_lignin(i_soil1) = .false. + + if ( .not. use_fates ) then + i_soil2 = 6 + else + i_soil2 = 5 + endif + floating_cn_ratio_decomp_pools(i_soil2) = .false. + decomp_cascade_con%decomp_pool_name_restart(i_soil2) = 'soil2' + decomp_cascade_con%decomp_pool_name_history(i_soil2) = 'SOIL2' + decomp_cascade_con%decomp_pool_name_long(i_soil2) = 'soil 2' + decomp_cascade_con%decomp_pool_name_short(i_soil2) = 'S2' + is_litter(i_soil2) = .false. + is_soil(i_soil2) = .true. + is_cwd(i_soil2) = .false. + initial_cn_ratio(i_soil2) = cn_s2 + initial_stock(i_soil2) = 0._r8 + is_metabolic(i_soil2) = .false. + is_cellulose(i_soil2) = .false. + is_lignin(i_soil2) = .false. + + if ( .not. use_fates ) then + i_soil3 = 7 + else + i_soil3 = 6 + endif + floating_cn_ratio_decomp_pools(i_soil3) = .false. + decomp_cascade_con%decomp_pool_name_restart(i_soil3) = 'soil3' + decomp_cascade_con%decomp_pool_name_history(i_soil3) = 'SOIL3' + decomp_cascade_con%decomp_pool_name_long(i_soil3) = 'soil 3' + decomp_cascade_con%decomp_pool_name_short(i_soil3) = 'S3' + is_litter(i_soil3) = .false. + is_soil(i_soil3) = .true. + is_cwd(i_soil3) = .false. + initial_cn_ratio(i_soil3) = cn_s3 + initial_stock(i_soil3) = 0._r8 + is_metabolic(i_soil3) = .false. + is_cellulose(i_soil3) = .false. + is_lignin(i_soil3) = .false. + + if ( .not. use_fates ) then + i_soil4 = 8 + else + i_soil4 = 7 + endif + floating_cn_ratio_decomp_pools(i_soil4) = .false. + decomp_cascade_con%decomp_pool_name_restart(i_soil4) = 'soil4' + decomp_cascade_con%decomp_pool_name_history(i_soil4) = 'SOIL4' + decomp_cascade_con%decomp_pool_name_long(i_soil4) = 'soil 4' + decomp_cascade_con%decomp_pool_name_short(i_soil4) = 'S4' + is_litter(i_soil4) = .false. + is_soil(i_soil4) = .true. + is_cwd(i_soil4) = .false. + initial_cn_ratio(i_soil4) = cn_s4 + initial_stock(i_soil4) = 10._r8 + is_metabolic(i_soil4) = .false. + is_cellulose(i_soil4) = .false. + is_lignin(i_soil4) = .false. + + floating_cn_ratio_decomp_pools(i_atm) = .false. + decomp_cascade_con%decomp_pool_name_restart(i_atm) = 'atmosphere' + decomp_cascade_con%decomp_pool_name_history(i_atm) = 'atmosphere' + decomp_cascade_con%decomp_pool_name_long(i_atm) = 'atmosphere' + decomp_cascade_con%decomp_pool_name_short(i_atm) = '' + is_litter(i_atm) = .true. + is_soil(i_atm) = .false. + is_cwd(i_atm) = .false. + initial_cn_ratio(i_atm) = 0._r8 + initial_stock(i_atm) = 0._r8 + is_metabolic(i_atm) = .false. + is_cellulose(i_atm) = .false. + is_lignin(i_atm) = .false. + + + spinup_factor(i_litr1) = 1._r8 + spinup_factor(i_litr2) = 1._r8 + spinup_factor(i_litr3) = 1._r8 + if (.not. use_fates) then + spinup_factor(i_cwd) = 1._r8 + end if + spinup_factor(i_soil1) = params_inst%spinup_vector(1) + spinup_factor(i_soil2) = params_inst%spinup_vector(2) + spinup_factor(i_soil3) = params_inst%spinup_vector(3) + spinup_factor(i_soil4) = params_inst%spinup_vector(4) + + + !---------------- list of transitions and their time-independent coefficients ---------------! + i_l1s1 = 1 + decomp_cascade_con%cascade_step_name(i_l1s1) = 'L1S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = rf_l1s1 + cascade_donor_pool(i_l1s1) = i_litr1 + cascade_receiver_pool(i_l1s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = 1.0_r8 + + i_l2s2 = 2 + decomp_cascade_con%cascade_step_name(i_l2s2) = 'L2S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s2) = rf_l2s2 + cascade_donor_pool(i_l2s2) = i_litr2 + cascade_receiver_pool(i_l2s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s2) = 1.0_r8 + + i_l3s3 = 3 + decomp_cascade_con%cascade_step_name(i_l3s3) = 'L3S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s3) = rf_l3s3 + cascade_donor_pool(i_l3s3) = i_litr3 + cascade_receiver_pool(i_l3s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s3) = 1.0_r8 + + if (use_soil_matrixcn)then !use fates will automatically turn off use_soil_matrixcn + i_cwdl2 = 4 + decomp_cascade_con%cascade_step_name(i_cwdl2) = 'CWDL2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = 0._r8 + cascade_donor_pool(i_cwdl2) = i_cwd + cascade_receiver_pool(i_cwdl2) = i_litr2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = cwd_fcel + + i_cwdl3 = 5 + decomp_cascade_con%cascade_step_name(i_cwdl3) = 'CWDL3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = 0._r8 + cascade_donor_pool(i_cwdl3) = i_cwd + cascade_receiver_pool(i_cwdl3) = i_litr3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig + + i_s1s2 = 6 + decomp_cascade_con%cascade_step_name(i_s1s2) = 'S1S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = rf_s1s2 + cascade_donor_pool(i_s1s2) = i_soil1 + cascade_receiver_pool(i_s1s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = 1.0_r8 + + i_s2s3 = 7 + decomp_cascade_con%cascade_step_name(i_s2s3) = 'S2S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = rf_s2s3 + cascade_donor_pool(i_s2s3) = i_soil2 + cascade_receiver_pool(i_s2s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = 1.0_r8 + + i_s3s4 = 8 + decomp_cascade_con%cascade_step_name(i_s3s4) = 'S3S4' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s4) = rf_s3s4 + cascade_donor_pool(i_s3s4) = i_soil3 + cascade_receiver_pool(i_s3s4) = i_soil4 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s4) = 1.0_r8 + + i_s4atm = 9 + decomp_cascade_con%cascade_step_name(i_s4atm) = 'S4' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s4atm) = 1. + cascade_donor_pool(i_s4atm) = i_soil4 + cascade_receiver_pool(i_s4atm) = i_atm + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s4atm) = 1.0_r8 + else + i_s1s2 = 4 + decomp_cascade_con%cascade_step_name(i_s1s2) = 'S1S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = rf_s1s2 + cascade_donor_pool(i_s1s2) = i_soil1 + cascade_receiver_pool(i_s1s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = 1.0_r8 + + i_s2s3 = 5 + decomp_cascade_con%cascade_step_name(i_s2s3) = 'S2S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = rf_s2s3 + cascade_donor_pool(i_s2s3) = i_soil2 + cascade_receiver_pool(i_s2s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = 1.0_r8 + + i_s3s4 = 6 + decomp_cascade_con%cascade_step_name(i_s3s4) = 'S3S4' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s4) = rf_s3s4 + cascade_donor_pool(i_s3s4) = i_soil3 + cascade_receiver_pool(i_s3s4) = i_soil4 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s4) = 1.0_r8 + + i_s4atm = 7 + decomp_cascade_con%cascade_step_name(i_s4atm) = 'S4' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s4atm) = 1. + cascade_donor_pool(i_s4atm) = i_soil4 + cascade_receiver_pool(i_s4atm) = i_atm + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s4atm) = 1.0_r8 + + if (.not. use_fates) then + i_cwdl2 = 8 + decomp_cascade_con%cascade_step_name(i_cwdl2) = 'CWDL2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = 0._r8 + cascade_donor_pool(i_cwdl2) = i_cwd + cascade_receiver_pool(i_cwdl2) = i_litr2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = cwd_fcel + + i_cwdl3 = 9 + decomp_cascade_con%cascade_step_name(i_cwdl3) = 'CWDL3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = 0._r8 + cascade_donor_pool(i_cwdl3) = i_cwd + cascade_receiver_pool(i_cwdl3) = i_litr3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig + end if + end if + + if(use_soil_matrixcn)call InitSoilTransfer() + + end associate + + end subroutine init_decompcascade_cn + + !----------------------------------------------------------------------- + subroutine decomp_rate_constants_cn(bounds, & + num_soilc, filter_soilc, & + soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! calculate rate constants and decomposition pathways for the BGC model + ! originally implemented in CLM-CN + ! written by C. Koven based on original CLM4 decomposition cascade by P. Thornton + ! + ! !USES: + use clm_time_manager, only : get_step_size_real + use clm_varcon , only : secspday + use clm_varpar , only : i_cwd + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(ch4_type) , intent(in) :: ch4_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + ! + ! !LOCAL VARIABLES: + real(r8):: dt ! decomp timestep (seconds) + real(r8):: dtd ! decomp timestep (days) + real(r8):: frw(bounds%begc:bounds%endc) ! rooting fraction weight + real(r8), allocatable:: fr(:,:) ! column-level rooting fraction by soil depth + real(r8):: minpsi, maxpsi ! limits for soil water scalar for decomp + real(r8):: psi ! temporary soilpsi for water scalar + real(r8):: rate_scalar ! combined rate scalar for decomp + real(r8):: k_l1 ! decomposition rate constant litter 1 + real(r8):: k_l2 ! decomposition rate constant litter 2 + real(r8):: k_l3 ! decomposition rate constant litter 3 + real(r8):: k_s1 ! decomposition rate constant SOM 1 + real(r8):: k_s2 ! decomposition rate constant SOM 2 + real(r8):: k_s3 ! decomposition rate constant SOM 3 + real(r8):: k_s4 ! decomposition rate constant SOM 4 + real(r8):: k_frag ! fragmentation rate constant CWD + real(r8):: ck_l1 ! corrected decomposition rate constant litter 1 + real(r8):: ck_l2 ! corrected decomposition rate constant litter 2 + real(r8):: ck_l3 ! corrected decomposition rate constant litter 3 + real(r8):: ck_s1 ! corrected decomposition rate constant SOM 1 + real(r8):: ck_s2 ! corrected decomposition rate constant SOM 2 + real(r8):: ck_s3 ! corrected decomposition rate constant SOM 3 + real(r8):: ck_s4 ! corrected decomposition rate constant SOM 4 + real(r8):: ck_frag ! corrected fragmentation rate constant CWD + real(r8):: cwdc_loss ! fragmentation rate for CWD carbon (gC/m2/s) + real(r8):: cwdn_loss ! fragmentation rate for CWD nitrogen (gN/m2/s) + integer :: i_litr1 + integer :: i_litr2 + integer :: i_litr3 + integer :: i_soil1 + integer :: i_soil2 + integer :: i_soil3 + integer :: i_soil4 + integer :: c, fc, j, k, l + real(r8):: Q10 ! temperature dependence + real(r8):: froz_q10 ! separate q10 for frozen soil respiration rates. default to same as above zero rates + real(r8):: decomp_depth_efolding ! (meters) e-folding depth for reduction in decomposition [ + real(r8):: depth_scalar(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: mino2lim ! minimum anaerobic decomposition rate as a + ! fraction of potential aerobic rate + !----------------------------------------------------------------------- + + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] soil layer thickness (m) + + soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + o2stress_sat => ch4_inst%o2stress_sat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + o2stress_unsat => ch4_inst%o2stress_unsat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area (excluding dedicated wetland columns) + + t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Output: [real(r8) (:,:) ] soil temperature scalar for decomp + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp + o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ) + + mino2lim = CNParamsShareInst%mino2lim + + ! set time steps + dt = get_step_size_real() + dtd = dt/secspday + + ! set initial base rates for decomposition mass loss (1/day) + ! (from Biome-BGC v4.2.0, using three SOM pools) + ! Value inside log function is the discrete-time values for a + ! daily time step model, and the result of the log function is + ! the corresponding continuous-time decay rate (1/day), following + ! Olson, 1963. + k_l1=params_inst%k_l1_cn + k_l2=params_inst%k_l2_cn + k_l3=params_inst%k_l3_cn + + k_s1=params_inst%k_s1_cn + k_s2=params_inst%k_s2_cn + k_s3=params_inst%k_s3_cn + k_s4=params_inst%k_s4_cn + + k_frag=params_inst%k_frag_cn + + ! calculate the new discrete-time decay rate for model timestep + k_l1 = 1.0_r8-exp(-k_l1*dtd) + k_l2 = 1.0_r8-exp(-k_l2*dtd) + k_l3 = 1.0_r8-exp(-k_l3*dtd) + + k_s1 = 1.0_r8-exp(-k_s1*dtd) + k_s2 = 1.0_r8-exp(-k_s2*dtd) + k_s3 = 1.0_r8-exp(-k_s3*dtd) + k_s4 = 1.0_r8-exp(-k_s4*dtd) + + k_frag = 1.0_r8-exp(-k_frag*dtd) + + minpsi = params_inst%minpsi_cn + maxpsi = params_inst%maxpsi_cn + + Q10 = CNParamsShareInst%Q10 + + ! set "froz_q10" parameter + froz_q10 = CNParamsShareInst%froz_q10 + + if (use_vertsoilc) then + ! Set "decomp_depth_efolding" parameter + decomp_depth_efolding = CNParamsShareInst%decomp_depth_efolding + end if + + ! The following code implements the acceleration part of the AD spinup + ! algorithm, by multiplying all of the SOM decomposition base rates by + ! spinup_vector, scalar between 1 and 70X, defined as a constant for each + ! pool here + + if ( spinup_state .eq. 1 ) then + k_s1 = k_s1 * params_inst%spinup_vector(1) + k_s2 = k_s2 * params_inst%spinup_vector(2) + k_s3 = k_s3 * params_inst%spinup_vector(3) + k_s4 = k_s4 * params_inst%spinup_vector(4) + endif + + i_litr1 = 1 + i_litr2 = 2 + i_litr3 = 3 + if (use_fates) then + i_soil1 = 4 + i_soil2 = 5 + i_soil3 = 6 + i_soil4 = 7 + else + i_soil1 = 5 + i_soil2 = 6 + i_soil3 = 7 + i_soil4 = 8 + endif + + !--- time dependent coefficients-----! + if ( nlevdecomp .eq. 1 ) then + + ! calculate function to weight the temperature and water potential scalars + ! for decomposition control. + + + ! the following normalizes values in fr so that they + ! sum to 1.0 across top nlevdecomp levels on a column + frw(bounds%begc:bounds%endc) = 0._r8 + nlev_soildecomp_standard=5 + allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard)) + do j=1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + frw(c) = frw(c) + dz(c,j) + end do + end do + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (frw(c) /= 0._r8) then + fr(c,j) = dz(c,j) / frw(c) + else + fr(c,j) = 0._r8 + end if + end do + end do + + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + ! Peter Thornton: 3/13/09 + ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5 + ! as part of the modifications made to improve the seasonal cycle of + ! atmospheric CO2 concentration in global simulations. This does not impact + ! the base rates at 25 C, which are calibrated from microcosm studies. + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) t_scalar(c,:) = 0._r8 + !! use separate (possibly equal) t funcs above and below freezing point + !! t_scalar(c,1)=t_scalar(c,1) + (1.5**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j) + if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then + t_scalar(c,1)=t_scalar(c,1) + & + (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j) + else + t_scalar(c,1)=t_scalar(c,1) + & + (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8))*fr(c,j) + endif + end do + end do + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) w_scalar(c,:) = 0._r8 + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,1) = w_scalar(c,1) + (log(minpsi/psi)/log(minpsi/maxpsi))*fr(c,j) + end if + end do + end do + + if (use_lch4) then + ! Calculate ANOXIA + if (anoxia) then + ! Check for anoxia w/o LCH4 now done in controlMod. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (j==1) o_scalar(c,:) = 0._r8 + + o_scalar(c,1) = o_scalar(c,1) + fr(c,j) * max(o2stress_unsat(c,j), mino2lim) + end do + end do + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + + deallocate(fr) + + else + + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + ! Peter Thornton: 3/13/09 + ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5 + ! as part of the modifications made to improve the seasonal cycle of + ! atmospheric CO2 concentration in global simulations. This does not impact + ! the base rates at 25 C, which are calibrated from microcosm studies. + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + !! use separate (possibly equal) t funcs above and below freezing point + !! t_scalar(c,j)= (1.5**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8)) + if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then + t_scalar(c,j)= (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8)) + else + t_scalar(c,j)= (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8)) + endif + end do + end do + + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,j) = (log(minpsi/psi)/log(minpsi/maxpsi)) + else + w_scalar(c,j) = 0._r8 + end if + end do + end do + + end if + + if (use_lch4) then + ! Calculate ANOXIA + ! Check for anoxia w/o LCH4 now done in controlMod. + + if (anoxia) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + o_scalar(c,j) = max(o2stress_unsat(c,j), mino2lim) + end do + end do + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + + if (use_vertsoilc) then + ! add a term to reduce decomposition rate at depth + ! for now used a fixed e-folding depth + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + depth_scalar(c,j) = exp(-zsoi(j)/decomp_depth_efolding) + end do + end do + end if + + ! calculate rate constants for all litter and som pools + if (use_vertsoilc) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_litr2) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_litr3) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil4) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + if(use_soil_matrixcn)then + Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_soil4-1)) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + end if + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_litr2) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_litr3) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil4) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + if(use_soil_matrixcn)then + Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + Ksoil%DM(c,j+nlevdecomp*(i_soil4-1)) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + end if + end do + end do + end if + + ! do the same for cwd, but only if fates is not enabled (because fates handles CWD on its own structure + if (.not. use_fates) then + if (use_vertsoilc) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + if(use_soil_matrixcn)then + Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * & + o_scalar(c,j) + end if + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + if(use_soil_matrixcn)then + Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * & + o_scalar(c,j) + end if + end do + end do + end if + end if + + end associate + + end subroutine decomp_rate_constants_cn + + end module SoilBiogeochemDecompCascadeCNMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 new file mode 100644 index 000000000..eb276ca04 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 @@ -0,0 +1,95 @@ +module abortutils + + !----------------------------------------------------------------------- + ! !MODULE: abortutils + ! + ! !DESCRIPTION: + ! Abort the model for abnormal termination + !----------------------------------------------------------------------- + + private + save + + public :: endrun + + interface endrun + module procedure endrun_vanilla + module procedure endrun_globalindex + end interface + +CONTAINS + + !----------------------------------------------------------------------- + subroutine endrun_vanilla(msg, additional_msg) + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abort the model for abnormal termination + ! + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + ! + ! !ARGUMENTS: + implicit none + + ! Generally you want to at least provide msg. The main reason to separate msg from + ! additional_msg is to supported expected-exception unit testing: you can put + ! volatile stuff in additional_msg, as in: + ! call endrun(msg='Informative message', additional_msg=errmsg(__FILE__, __LINE__)) + ! and then just assert against msg. + character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort + character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort + !----------------------------------------------------------------------- + + if (present (additional_msg)) then + write(iulog,*)'ENDRUN: ', trim(additional_msg) + else + write(iulog,*)'ENDRUN:' + end if + + call shr_sys_abort(msg) + + end subroutine endrun_vanilla + + !----------------------------------------------------------------------- + subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) + + !----------------------------------------------------------------------- + ! Description: + ! Abort the model for abnormal termination + ! + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + use GetGlobalValuesMod, only: GetGlobalWrite + ! + ! Arguments: + implicit none + integer , intent(in) :: decomp_index + character(len=*) , intent(in) :: clmlevel + + ! Generally you want to at least provide msg. The main reason to separate msg from + ! additional_msg is to supported expected-exception unit testing: you can put + ! volatile stuff in additional_msg, as in: + ! call endrun(msg='Informative message', additional_msg=errmsg(__FILE__, __LINE__)) + ! and then just assert against msg. + character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort + character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort + ! + ! Local Variables: + integer :: igrc, ilun, icol + !----------------------------------------------------------------------- + + write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) + call GetGlobalWrite(decomp_index, clmlevel) + + if (present (additional_msg)) then + write(iulog,*)'ENDRUN: ', additional_msg + else + write(iulog,*)'ENDRUN:' + end if + + call shr_sys_abort(msg) + + end subroutine endrun_globalindex + +end module abortutils diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index f321c8625..b092e945d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -28,7 +28,7 @@ module clm_time_manager is_end_curr_day, &! return true on last timestep in current day is_restart ! return true if this is a restart run - + is_first_step ! dummy function here, because it is loaded, but not used contains !========================================================================================= @@ -218,6 +218,13 @@ end function is_end_curr_day !========================================================================================= +function is_first_step( ) + + +end function is_first_step + +!========================================================================================= + logical function is_restart( ) ! Determine if it's a restart run diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index b8faea177..931408286 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -48,5 +48,16 @@ module clm_varcon real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data integer , public, parameter :: ispval = -9999 ! special value for int data + !------------------------------------------------------------------ + ! Set subgrid names + !------------------------------------------------------------------ + + character(len=16), public, parameter :: grlnd = 'lndgrid' ! name of lndgrid + character(len=16), public, parameter :: namea = 'gridcellatm' ! name of atmgrid + character(len=16), public, parameter :: nameg = 'gridcell' ! name of gridcells + character(len=16), public, parameter :: namel = 'landunit' ! name of landunits + character(len=16), public, parameter :: namec = 'column' ! name of columns + character(len=16), public, parameter :: namep = 'pft' ! name of patches + character(len=16), public, parameter :: nameCohort = 'cohort' ! name of cohorts (ED specific) end module clm_varcon diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 8ff193dc7..79c85730b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -29,7 +29,7 @@ module clm_varctl logical, public :: use_century_decomp = .false. logical, public :: use_cn = .true. logical, public :: use_cndv = .false. - + logical, public :: use_grainproduct = .false. logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model @@ -41,6 +41,18 @@ module clm_varctl real(r8), public :: nfix_timeconst = -1.2345_r8 + !---------------------------------------------------------- + ! Unit Numbers + !---------------------------------------------------------- + ! + integer, public :: iulog = 6 ! "stdout" log file unit number, default is 6; jkolassa: This is following CTSM, iulog is not set to output_unit + + !---------------------------------------------------------- + ! flexibleCN + !---------------------------------------------------------- + logical, public :: use_flexibleCN = .false. + logical, public :: CNratio_floating = .false. + integer, public :: CN_evergreen_phenology_opt = 0 contains !--------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index 1ae2269ec..d34726cae 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -35,8 +35,10 @@ module clm_varpar ! for soil matrix integer, public :: ndecomp_pools_vr !total number of pools ndecomp_pools*vertical levels - integer, parameter :: numpft = 15!19 ! actual # of pfts (without bare), 16 here, since we are removing the spli types + integer, parameter :: numpft = 15!19 ! actual # of pfts (without bare), 16 here, since we are removing the split types integer, parameter :: mxpft = 15 ! + integer, public :: maxsoil_patches = numpft + 1 ! # of pfts + cfts + bare ground; replaces maxpatch_pft, which is obsolete + integer, public, parameter :: nvariants = 2 ! number of variants of PFT constants integer, public, parameter :: numrad = 2 ! number of solar radiation bands: vis, nir @@ -104,10 +106,15 @@ module clm_varpar integer, public :: nvegnpool ! number of vegetation N pools + ! For CH4 code + integer, parameter :: ngases = 3 ! CH4, O2, & CO2 nlevmaxurbgrnd = max0(nlevurb,nlevgrnd) nlevmaxurbgrnd = nlevgrnd ! jkolassa: set this here, since we are not modelling urban tiles for now + + integer, public :: max_patch_per_col = maxsoil_patches ! since we don't have CFTs or urban patches + contains !------------------------------------ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 new file mode 100755 index 000000000..d57006859 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 @@ -0,0 +1,170 @@ +module column_varcon + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing column indices and associated variables and routines. + ! + ! !USES: +#include "shr_assert.h" + use landunit_varcon, only : isturb_MIN + ! + ! !PUBLIC TYPES: + implicit none + save + private + + !------------------------------------------------------------------ + ! Initialize column type constants + !------------------------------------------------------------------ + + ! urban column types + + integer, parameter, public :: icol_roof = isturb_MIN*10 + 1 + integer, parameter, public :: icol_sunwall = isturb_MIN*10 + 2 + integer, parameter, public :: icol_shadewall = isturb_MIN*10 + 3 + integer, parameter, public :: icol_road_imperv = isturb_MIN*10 + 4 + integer, parameter, public :: icol_road_perv = isturb_MIN*10 + 5 + + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: is_hydrologically_active ! returns true if the given column type is hydrologically active + public :: icemec_class_to_col_itype ! convert an icemec class (1..maxpatch_glcmec) into col%itype + public :: col_itype_to_icemec_class ! convert col%itype into an icemec class (1..maxpatch_glcmec) + public :: write_coltype_metadata ! write column type metadata to a netcdf file + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + function is_hydrologically_active(col_itype, lun_itype) & + result(hydrologically_active) + ! + ! !DESCRIPTION: + ! Returns a logical value saying whether the given column type is hydrologically + ! active + ! + ! Note that calling this can be bad for performance, because it operates on a single + ! point rather than a loop. So in performance-critical parts of the code (or just + ! about anywhere, really), you should use the pre-set col%hydrologically_active(c). + ! + ! !USES: + use landunit_varcon, only : istsoil, istcrop + ! + ! !ARGUMENTS: + logical :: hydrologically_active ! function result + integer, intent(in) :: col_itype ! col%itype value + integer, intent(in) :: lun_itype ! lun%itype value for the landunit on which this column sits + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'is_hydrologically_active' + !----------------------------------------------------------------------- + + ! If we had an easy way to figure out which landunit a column was on based on + ! col_itype (which would be very helpful!), then we wouldn't need lun_itype. + + if (lun_itype == istsoil .or. lun_itype == istcrop) then + hydrologically_active = .true. + else if (col_itype == icol_road_perv) then + hydrologically_active = .true. + else + hydrologically_active = .false. + end if + + end function is_hydrologically_active + + + !----------------------------------------------------------------------- + function icemec_class_to_col_itype(icemec_class) result(col_itype) + ! + ! !DESCRIPTION: + ! Convert an icemec class (1..maxpatch_glcmec) into col%itype + ! + ! !USES: + use clm_varpar, only : maxpatch_glcmec + use landunit_varcon, only : istice_mec + ! + ! !ARGUMENTS: + integer :: col_itype ! function result + integer, intent(in) :: icemec_class ! icemec class, between 1 and maxpatch_glcmec + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'icemec_class_to_col_itype' + !----------------------------------------------------------------------- + + SHR_ASSERT_FL((1 <= icemec_class .and. icemec_class <= maxpatch_glcmec), sourcefile, __LINE__) + + col_itype = istice_mec*100 + icemec_class + + end function icemec_class_to_col_itype + + !----------------------------------------------------------------------- + function col_itype_to_icemec_class(col_itype) result(icemec_class) + ! + ! !DESCRIPTION: + ! Convert a col%itype value (for an icemec landunit) into an icemec class (1..maxpatch_glcmec) + ! + ! !USES: + use clm_varpar, only : maxpatch_glcmec + use landunit_varcon, only : istice_mec + ! + ! !ARGUMENTS: + integer :: icemec_class ! function result + integer, intent(in) :: col_itype ! col%itype value for an icemec landunit + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'col_itype_to_icemec_class' + !----------------------------------------------------------------------- + + icemec_class = col_itype - istice_mec*100 + + ! The following assertion is here to ensure that col_itype is really from an + ! istice_mec landunit + SHR_ASSERT_FL((1 <= icemec_class .and. icemec_class <= maxpatch_glcmec), sourcefile, __LINE__) + + end function col_itype_to_icemec_class + + !----------------------------------------------------------------------- + subroutine write_coltype_metadata(att_prefix, ncid) + ! + ! !DESCRIPTION: + ! Writes column type metadata to a netcdf file. + ! + ! Note that, unlike pft and landunit metadata, this column type metadata is NOT + ! stored in an array. This is because of the trickiness of encoding column values for + ! crop & icemec. So instead, other code must call this routine to do the work of + ! adding the appropriate metadata directly to a netcdf file. + ! + ! !USES: + use ncdio_pio, only : file_desc_t, ncd_global, ncd_putatt + ! + ! !ARGUMENTS: + character(len=*) , intent(in) :: att_prefix ! prefix for attributes (e.g., 'icol_') + type(file_desc_t) , intent(inout) :: ncid ! local file id + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'write_coltype_metadata' + !----------------------------------------------------------------------- + + call ncd_putatt(ncid, ncd_global, att_prefix // 'vegetated_or_bare_soil', 1) + call ncd_putatt(ncid, ncd_global, att_prefix // 'crop' , 2) + call ncd_putatt(ncid, ncd_global, att_prefix // 'crop_noncompete' , '2*100+m, m=cft_lb,cft_ub') + call ncd_putatt(ncid, ncd_global, att_prefix // 'landice' , 3) + call ncd_putatt(ncid, ncd_global, att_prefix // 'landice_multiple_elevation_classes', '4*100+m, m=1,glcnec') + call ncd_putatt(ncid, ncd_global, att_prefix // 'deep_lake' , 5) + call ncd_putatt(ncid, ncd_global, att_prefix // 'wetland' , 6) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_roof' , icol_roof) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_sunwall' , icol_sunwall) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_shadewall' , icol_shadewall) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_impervious_road' , icol_road_imperv) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_pervious_road' , icol_road_perv) + + end subroutine write_coltype_metadata + + +end module column_varcon diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/fileutils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/fileutils.F90 new file mode 100755 index 000000000..b74af4242 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/fileutils.F90 @@ -0,0 +1,179 @@ +module fileutils + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing file I/O utilities + ! + ! !USES: + use shr_sys_mod , only : shr_sys_abort + use clm_varctl , only : iulog + use spmdMod , only : masterproc + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: get_filename !Returns filename given full pathname + public :: opnfil !Open local unformatted or formatted file + public :: getfil !Obtain local copy of file + public :: relavu !Close and release Fortran unit no longer in use + public :: getavu !Get next available Fortran unit number + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + character(len=256) function get_filename (fulpath) + ! + ! !DESCRIPTION: + ! Returns filename given full pathname + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fulpath !full pathname + ! + ! !LOCAL VARIABLES: + integer i !loop index + integer klen !length of fulpath character string + !------------------------------------------------------------------------ + + klen = len_trim(fulpath) + do i = klen, 1, -1 + if (fulpath(i:i) == '/') go to 10 + end do + i = 0 +10 get_filename = fulpath(i+1:klen) + + return + end function get_filename + + !------------------------------------------------------------------------ + subroutine getfil (fulpath, locfn, iflag) + ! + ! !DESCRIPTION: + ! Obtain local copy of file + ! First check current working directory + ! Next check full pathname[fulpath] on disk + ! + ! !USES: + use shr_file_mod, only: shr_file_get + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fulpath !Archival or permanent disk full pathname + character(len=*), intent(out) :: locfn !output local file name + integer, intent(in) :: iflag !0=>abort if file not found 1=>do not abort + ! + ! !LOCAL VARIABLES: + integer i !loop index + integer klen !length of fulpath character string + logical lexist !true if local file exists + !------------------------------------------------------------------------ + + ! get local file name from full name + + locfn = get_filename( fulpath ) + if (len_trim(locfn) == 0) then + if (masterproc) write(iulog,*)'(GETFIL): local filename has zero length' + call shr_sys_abort + else + if (masterproc) write(iulog,*)'(GETFIL): attempting to find local file ', & + trim(locfn) + endif + + ! first check if file is in current working directory. + + inquire (file=locfn,exist=lexist) + if (lexist) then + if (masterproc) write(iulog,*) '(GETFIL): using ',trim(locfn), & + ' in current working directory' + RETURN + endif + + ! second check for full pathname on disk + locfn = fulpath + + inquire (file=fulpath,exist=lexist) + if (lexist) then + if (masterproc) write(iulog,*) '(GETFIL): using ',trim(fulpath) + RETURN + else + if (masterproc) write(iulog,*)'(GETFIL): failed getting file from full path: ', fulpath + if (iflag==0) then + call shr_sys_abort ('GETFIL: FAILED to get '//trim(fulpath)) + else + RETURN + endif + endif + + end subroutine getfil + + !------------------------------------------------------------------------ + subroutine opnfil (locfn, iun, form) + ! + ! !DESCRIPTION: + ! Open file locfn in unformatted or formatted form on unit iun + ! + ! !ARGUMENTS: + character(len=*), intent(in):: locfn !file name + integer, intent(in):: iun !fortran unit number + character(len=1), intent(in):: form !file format: u = unformatted, f = formatted + ! + ! !LOCAL VARIABLES: + integer ioe !error return from fortran open + character(len=11) ft !format type: formatted. unformatted + !------------------------------------------------------------------------ + + if (len_trim(locfn) == 0) then + write(iulog,*)'(OPNFIL): local filename has zero length' + call shr_sys_abort + endif + if (form=='u' .or. form=='U') then + ft = 'unformatted' + else + ft = 'formatted ' + end if + open (unit=iun,file=locfn,status='unknown',form=ft,iostat=ioe) + if (ioe /= 0) then + write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), & + & ' on unit ',iun,' ierr=',ioe + call shr_sys_abort + else if ( masterproc )then + write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), & + & ' on unit= ',iun + end if + + end subroutine opnfil + + !------------------------------------------------------------------------ + integer function getavu() + ! + ! !DESCRIPTION: + ! Get next available Fortran unit number. + ! + ! !USES: + use shr_file_mod, only : shr_file_getUnit + !------------------------------------------------------------------------ + + getavu = shr_file_getunit() + + end function getavu + + !------------------------------------------------------------------------ + subroutine relavu (iunit) + ! + ! !DESCRIPTION: + ! Close and release Fortran unit no longer in use! + ! + ! !USES: + use shr_file_mod, only : shr_file_freeUnit + ! + ! !ARGUMENTS: + integer, intent(in) :: iunit !Fortran unit number + !------------------------------------------------------------------------ + + close(iunit) + call shr_file_freeUnit(iunit) + + end subroutine relavu + +end module fileutils diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/initSubgridMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/initSubgridMod.F90 new file mode 100755 index 000000000..43851c337 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/initSubgridMod.F90 @@ -0,0 +1,477 @@ +module initSubgridMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Lower-level routines for initializing the subgrid structure. This module is shared + ! between both the production code (via initGridCellsMod) and unit testing code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use abortutils , only : endrun + use clm_varctl , only : iulog, use_fates + use clm_varcon , only : namep, namec, namel + use decompMod , only : bounds_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use column_varcon , only : is_hydrologically_active + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: clm_ptrs_compdown ! fill in data pointing down + public :: clm_ptrs_check ! checks and writes out a summary of subgrid data + public :: add_landunit ! add an entry in the landunit-level arrays + public :: add_column ! add an entry in the column-level arrays + public :: add_patch ! add an entry in the patch-level arrays + ! + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------------ + subroutine clm_ptrs_compdown(bounds) + ! + ! !DESCRIPTION: + ! Assumes the part of the subgrid pointing up has been set. Fills + ! in the data pointing down. Up is p_c, p_l, p_g, c_l, c_g, and l_g. + ! + ! This algorithm assumes all indices besides grid cell are monotonically + ! increasing. (Note that grid cell index is NOT monotonically increasing, + ! hence we cannot set initial & final indices at the grid cell level - + ! grc%luni, grc%lunf, etc.) + ! + ! Algorithm works as follows. The p, c, and l loops march through + ! the full arrays (nump, numc, and numl) checking the "up" indexes. + ! As soon as the "up" index of the current (p,c,l) cell changes relative + ! to the previous (p,c,l) cell, the *i array will be set to point down + ! to that cell. The *f array follows the same logic, so it's always the + ! last "up" index from the previous cell when an "up" index changes. + ! + ! For example, a case where p_c(1:4) = 1 and p_c(5:12) = 2. This + ! subroutine will set c_pi(1) = 1, c_pf(1) = 4, c_pi(2) = 5, c_pf(2) = 12. + ! + ! !USES + use clm_varcon, only : ispval + ! + ! !ARGUMENTS + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: l,c,p ! loop counters + integer :: curg,curl,curc,curp ! tracks g,l,c,p indexes in arrays + integer :: ltype ! landunit type + !------------------------------------------------------------------------------ + + !--- Set the current c,l (curc, curl) to zero for initialization, + !--- these indices track the current "up" index. + !--- Take advantage of locality of l/c/p cells + !--- Loop p through full local begp:endp length + !--- Separately check the p_c, p_l, and p_g indexes for a change in + !--- the "up" index. + !--- If there is a change, verify that the current c,l,g is within the + !--- valid range, and set c_pi, l_pi, or g_pi to that current c,l,g + !--- Constantly update the c_pf, l_pf, and g_pf array. When the + !--- g, l, c index changes, the *_pf array will be set correctly + !--- Do the same for cols setting c_li, c_gi, c_lf, c_gf and + !--- lunits setting l_gi, l_gf. + + curc = 0 + curl = 0 + do p = bounds%begp,bounds%endp + if (patch%column(p) /= curc) then + curc = patch%column(p) + if (curc < bounds%begc .or. curc > bounds%endc) then + write(iulog,*) 'clm_ptrs_compdown ERROR: pcolumn ',p,curc,bounds%begc,bounds%endc + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + endif + col%patchi(curc) = p + endif + col%patchf(curc) = p + col%npatches(curc) = col%patchf(curc) - col%patchi(curc) + 1 + if (patch%landunit(p) /= curl) then + curl = patch%landunit(p) + if (curl < bounds%begl .or. curl > bounds%endl) then + write(iulog,*) 'clm_ptrs_compdown ERROR: plandunit ',p,curl,bounds%begl,bounds%endl + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + endif + lun%patchi(curl) = p + endif + lun%patchf(curl) = p + lun%npatches(curl) = lun%patchf(curl) - lun%patchi(curl) + 1 + enddo + + curl = 0 + do c = bounds%begc,bounds%endc + if (col%landunit(c) /= curl) then + curl = col%landunit(c) + if (curl < bounds%begl .or. curl > bounds%endl) then + write(iulog,*) 'clm_ptrs_compdown ERROR: clandunit ',c,curl,bounds%begl,bounds%endl + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + endif + lun%coli(curl) = c + endif + lun%colf(curl) = c + lun%ncolumns(curl) = lun%colf(curl) - lun%coli(curl) + 1 + enddo + + ! Determine landunit_indices: indices into landunit-level arrays for each grid cell. + ! Note that landunits not present in a given grid cell are set to ispval. + grc%landunit_indices(:,bounds%begg:bounds%endg) = ispval + do l = bounds%begl,bounds%endl + ltype = lun%itype(l) + curg = lun%gridcell(l) + if (curg < bounds%begg .or. curg > bounds%endg) then + write(iulog,*) 'clm_ptrs_compdown ERROR: landunit_indices ', l,curg,bounds%begg,bounds%endg + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) + end if + + if (grc%landunit_indices(ltype, curg) == ispval) then + grc%landunit_indices(ltype, curg) = l + else + write(iulog,*) 'clm_ptrs_compdown ERROR: This landunit type has already been set for this gridcell' + write(iulog,*) 'l, ltype, curg = ', l, ltype, curg + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) + end if + end do + + end subroutine clm_ptrs_compdown + + !------------------------------------------------------------------------------ + subroutine clm_ptrs_check(bounds) + ! + ! !DESCRIPTION: + ! Checks and writes out a summary of subgrid data + ! + ! !USES + use clm_varcon, only : ispval + use landunit_varcon, only : max_lunit + ! + ! !ARGUMENTS + implicit none + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,p ! loop counters + integer :: l_prev ! l value of previous point + integer :: ltype ! landunit type + logical :: error ! error flag + !------------------------------------------------------------------------------ + + associate( & + begg => bounds%begg, & + endg => bounds%endg, & + begl => bounds%begl, & + endl => bounds%endl, & + begc => bounds%begc, & + endc => bounds%endc, & + begp => bounds%begp, & + endp => bounds%endp & + ) + + if (masterproc) write(iulog,*) ' ' + if (masterproc) write(iulog,*) '---clm_ptrs_check:' + + !--- check index ranges --- + error = .false. + do g = begg, endg + do ltype = 1, max_lunit + l = grc%landunit_indices(ltype, g) + if (l /= ispval) then + if (l < begl .or. l > endl) error = .true. + end if + end do + end do + if (error) then + write(iulog,*) ' clm_ptrs_check: g index ranges - ERROR' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (masterproc) write(iulog,*) ' clm_ptrs_check: g index ranges - OK' + + error = .false. + if (minval(lun%gridcell(begl:endl)) < begg .or. maxval(lun%gridcell(begl:endl)) > endg) error=.true. + if (minval(lun%coli(begl:endl)) < begc .or. maxval(lun%coli(begl:endl)) > endc) error=.true. + if (minval(lun%colf(begl:endl)) < begc .or. maxval(lun%colf(begl:endl)) > endc) error=.true. + if (minval(lun%patchi(begl:endl)) < begp .or. maxval(lun%patchi(begl:endl)) > endp) error=.true. + if (minval(lun%patchf(begl:endl)) < begp .or. maxval(lun%patchf(begl:endl)) > endp) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: l index ranges - ERROR' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: l index ranges - OK' + + error = .false. + if (minval(col%gridcell(begc:endc)) < begg .or. maxval(col%gridcell(begc:endc)) > endg) error=.true. + if (minval(col%landunit(begc:endc)) < begl .or. maxval(col%landunit(begc:endc)) > endl) error=.true. + if (minval(col%patchi(begc:endc)) < begp .or. maxval(col%patchi(begc:endc)) > endp) error=.true. + if (minval(col%patchf(begc:endc)) < begp .or. maxval(col%patchf(begc:endc)) > endp) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: c index ranges - ERROR' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: c index ranges - OK' + + error = .false. + if (minval(patch%gridcell(begp:endp)) < begg .or. maxval(patch%gridcell(begp:endp)) > endg) error=.true. + if (minval(patch%landunit(begp:endp)) < begl .or. maxval(patch%landunit(begp:endp)) > endl) error=.true. + if (minval(patch%column(begp:endp)) < begc .or. maxval(patch%column(begp:endp)) > endc) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: p index ranges - ERROR' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: p index ranges - OK' + + !--- check that indices in arrays are monotonically increasing --- + error = .false. + do l=begl+1,endl + if ((lun%itype(l) == lun%itype(l-1)) .and. & + lun%gridcell(l) < lun%gridcell(l-1)) then + ! grid cell indices should be monotonically increasing for a given landunit type + error = .true. + end if + if (lun%coli(l) < lun%coli(l-1)) error = .true. + if (lun%colf(l) < lun%colf(l-1)) error = .true. + if (lun%patchi(l) < lun%patchi(l-1)) error = .true. + if (lun%patchf(l) < lun%patchf(l-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: l mono increasing - ERROR' + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: l mono increasing - OK' + + error = .false. + do c=begc+1,endc + l = col%landunit(c) + l_prev = col%landunit(c-1) + if ((lun%itype(l) == lun%itype(l_prev)) .and. & + col%gridcell(c) < col%gridcell(c-1)) then + ! grid cell indices should be monotonically increasing for a given landunit type + error = .true. + end if + if (col%landunit(c) < col%landunit(c-1)) error = .true. + if (col%patchi(c) < col%patchi(c-1)) error = .true. + if (col%patchf(c) < col%patchf(c-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: c mono increasing - ERROR' + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: c mono increasing - OK' + + error = .false. + do p=begp+1,endp + l = patch%landunit(p) + l_prev = patch%landunit(p-1) + if ((lun%itype(l) == lun%itype(l_prev)) .and. & + patch%gridcell(p) < patch%gridcell(p-1)) then + ! grid cell indices should be monotonically increasing for a given landunit type + error = .true. + end if + if (patch%landunit(p) < patch%landunit(p-1)) error = .true. + if (patch%column (p) < patch%column (p-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: p mono increasing - ERROR' + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: p mono increasing - OK' + + !--- check that the tree is internally consistent --- + error = .false. + do g = begg, endg + do ltype = 1, max_lunit + l = grc%landunit_indices(ltype, g) + + ! skip l == ispval, which implies that this landunit type doesn't exist on this grid cell + if (l /= ispval) then + if (lun%itype(l) /= ltype) error = .true. + if (lun%gridcell(l) /= g) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) + endif + do c = lun%coli(l),lun%colf(l) + if (col%gridcell(c) /= g) error = .true. + if (col%landunit(c) /= l) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + endif + do p = col%patchi(c),col%patchf(c) + if (patch%gridcell(p) /= g) error = .true. + if (patch%landunit(p) /= l) error = .true. + if (patch%column(p) /= c) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + endif + enddo ! p + enddo ! c + end if ! l /= ispval + enddo ! ltype + enddo ! g + if (masterproc) write(iulog,*) ' clm_ptrs_check: tree consistent - OK' + if (masterproc) write(iulog,*) ' ' + + end associate + + end subroutine clm_ptrs_check + + !----------------------------------------------------------------------- + subroutine add_landunit(li, gi, ltype, wtgcell) + ! + ! !DESCRIPTION: + ! Add an entry in the landunit-level arrays. li gives the index of the last landunit + ! added; the new landunit is added at li+1, and the li argument is incremented + ! accordingly. + ! + ! !USES: + use landunit_varcon , only : istice_mec, istdlak, isturb_MIN, isturb_MAX, landunit_is_special + ! + ! !ARGUMENTS: + integer , intent(inout) :: li ! input value is index of last landunit added; output value is index of this newly-added landunit + integer , intent(in) :: gi ! grid cell index on which this landunit should be placed + integer , intent(in) :: ltype ! landunit type + real(r8) , intent(in) :: wtgcell ! weight of the landunit relative to the grid cell + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'add_landunit' + !----------------------------------------------------------------------- + + li = li + 1 + + lun%gridcell(li) = gi + lun%wtgcell(li) = wtgcell + lun%itype(li) = ltype + + lun%ifspecial(li) = landunit_is_special(ltype) + + if (ltype == istice_mec) then + lun%glcmecpoi(li) = .true. + else + lun%glcmecpoi(li) = .false. + end if + + if (ltype == istdlak) then + lun%lakpoi(li) = .true. + else + lun%lakpoi(li) = .false. + end if + + if (ltype >= isturb_MIN .and. ltype <= isturb_MAX) then + lun%urbpoi(li) = .true. + else + lun%urbpoi(li) = .false. + end if + + end subroutine add_landunit + + !----------------------------------------------------------------------- + subroutine add_column(ci, li, ctype, wtlunit, type_is_dynamic) + ! + ! !DESCRIPTION: + ! Add an entry in the column-level arrays. ci gives the index of the last column + ! added; the new column is added at ci+1, and the ci argument is incremented + ! accordingly. + ! + ! !ARGUMENTS: + integer , intent(inout) :: ci ! input value is index of last column added; output value is index of this newly-added column + integer , intent(in) :: li ! landunit index on which this column should be placed (assumes this landunit has already been created) + integer , intent(in) :: ctype ! column type + real(r8) , intent(in) :: wtlunit ! weight of the column relative to the landunit + + ! whether this column's type can change at runtime; if not provided, assumed to be false + logical , intent(in), optional :: type_is_dynamic + ! + ! !LOCAL VARIABLES: + logical :: l_type_is_dynamic ! local version of type_is_dynamic + + character(len=*), parameter :: subname = 'add_column' + !----------------------------------------------------------------------- + + l_type_is_dynamic = .false. + if (present(type_is_dynamic)) then + l_type_is_dynamic = type_is_dynamic + end if + + ci = ci + 1 + + col%landunit(ci) = li + col%gridcell(ci) = lun%gridcell(li) + col%wtlunit(ci) = wtlunit + col%itype(ci) = ctype + col%lun_itype(ci) = lun%itype(li) + col%type_is_dynamic(ci) = l_type_is_dynamic + col%hydrologically_active(ci) = is_hydrologically_active( & + col_itype = ctype, & + lun_itype = lun%itype(li)) + col%urbpoi(ci) = lun%urbpoi(li) + + end subroutine add_column + + !----------------------------------------------------------------------- + subroutine add_patch(pi, ci, ptype, wtcol) + ! + ! !DESCRIPTION: + ! Add an entry in the patch-level arrays. pi gives the index of the last patch added; the + ! new patch is added at pi+1, and the pi argument is incremented accordingly. + ! + ! !USES: + use clm_varcon , only : ispval + use landunit_varcon , only : istsoil, istcrop + use clm_varpar , only : natpft_lb + ! + ! !ARGUMENTS: + integer , intent(inout) :: pi ! input value is index of last patch added; output value is index of this newly-added patch + integer , intent(in) :: ci ! column index on which this patch should be placed (assumes this column has already been created) + integer , intent(in) :: ptype ! patch type + real(r8) , intent(in) :: wtcol ! weight of the patch relative to the column + ! + ! !LOCAL VARIABLES: + integer :: li ! landunit index + integer :: lb_offset ! offset between natpft_lb and 1 + + character(len=*), parameter :: subname = 'add_patch' + !----------------------------------------------------------------------- + + pi = pi + 1 + + patch%column(pi) = ci + li = col%landunit(ci) + patch%landunit(pi) = li + patch%gridcell(pi) = col%gridcell(ci) + + patch%wtcol(pi) = wtcol + + ! TODO (MV, 10-17-14): The following must be commented out because + ! currently patch%itype is used in CanopyTemperatureMod to calculate + ! z0m(p) and displa(p) - and is still called even when fates is on + + !if (.not. use_fates) then + patch%itype(pi) = ptype + !end if + + if (lun%itype(li) == istsoil .or. lun%itype(li) == istcrop) then + lb_offset = 1 - natpft_lb + patch%mxy(pi) = ptype + lb_offset + else + patch%mxy(pi) = ispval + end if + + + end subroutine add_patch + + +end module initSubgridMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/landunit_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/landunit_varcon.F90 new file mode 100755 index 000000000..b6ddc7cf5 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/landunit_varcon.F90 @@ -0,0 +1,133 @@ +module landunit_varcon + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing landunit indices and associated variables and routines. + ! + ! !USES: +#include "shr_assert.h" + ! + ! + ! !PUBLIC TYPES: + implicit none + private + + !------------------------------------------------------------------ + ! Initialize landunit type constants + !------------------------------------------------------------------ + + integer, parameter, public :: istsoil = 1 !soil landunit type (natural vegetation) + integer, parameter, public :: istcrop = 2 !crop landunit type + ! Landunit 3 currently unused (used to be non-multiple elevation class glacier type: istice) + integer, parameter, public :: istice_mec = 4 !land ice (multiple elevation classes) landunit type + integer, parameter, public :: istdlak = 5 !deep lake landunit type (now used for all lakes) + integer, parameter, public :: istwet = 6 !wetland landunit type (swamp, marsh, etc.) + + integer, parameter, public :: isturb_MIN = 7 !minimum urban type index + integer, parameter, public :: isturb_tbd = 7 !urban tbd landunit type + integer, parameter, public :: isturb_hd = 8 !urban hd landunit type + integer, parameter, public :: isturb_md = 9 !urban md landunit type + integer, parameter, public :: isturb_MAX = 9 !maximum urban type index + + integer, parameter, public :: max_lunit = 9 !maximum value that lun%itype can have + !(i.e., largest value in the above list) + + integer, parameter, public :: landunit_name_length = 40 ! max length of landunit names + character(len=landunit_name_length), public :: landunit_names(max_lunit) ! name of each landunit type + + ! parameters that depend on the above constants + + integer, parameter, public :: numurbl = isturb_MAX - isturb_MIN + 1 ! number of urban landunits + + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: landunit_varcon_init ! initialize constants in this module + public :: landunit_is_special ! returns true if this is a special landunit + + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: set_landunit_names ! set the landunit_names vector +!----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine landunit_varcon_init() + ! + ! !DESCRIPTION: + ! Initialize constants in landunit_varcon + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'landunit_varcon_init' + !----------------------------------------------------------------------- + + call set_landunit_names() + + end subroutine landunit_varcon_init + + !----------------------------------------------------------------------- + function landunit_is_special(ltype) result(is_special) + ! + ! !DESCRIPTION: + ! Returns true if the landunit type ltype is a special landunit; returns false otherwise + ! + ! !USES: + ! + ! !ARGUMENTS: + logical :: is_special ! function result + integer :: ltype ! landunit type of interest + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'landunit_is_special' + !----------------------------------------------------------------------- + + SHR_ASSERT((ltype >= 1 .and. ltype <= max_lunit), subname//': ltype out of bounds') + + if (ltype == istsoil .or. ltype == istcrop) then + is_special = .false. + else + is_special = .true. + end if + + end function landunit_is_special + + + !----------------------------------------------------------------------- + subroutine set_landunit_names + ! + ! !DESCRIPTION: + ! Set the landunit_names vector + ! + ! !USES: + use shr_sys_mod, only : shr_sys_abort + ! + character(len=*), parameter :: not_set = 'NOT_SET' + character(len=*), parameter :: unused = 'UNUSED' + character(len=*), parameter :: subname = 'set_landunit_names' + !----------------------------------------------------------------------- + + landunit_names(:) = not_set + + landunit_names(istsoil) = 'vegetated_or_bare_soil' + landunit_names(istcrop) = 'crop' + landunit_names(istcrop+1) = unused + landunit_names(istice_mec) = 'landice_multiple_elevation_classes' + landunit_names(istdlak) = 'deep_lake' + landunit_names(istwet) = 'wetland' + landunit_names(isturb_tbd) = 'urban_tbd' + landunit_names(isturb_hd) = 'urban_hd' + landunit_names(isturb_md) = 'urban_md' + + if (any(landunit_names == not_set)) then + call shr_sys_abort(trim(subname)//': Not all landunit names set') + end if + + end subroutine set_landunit_names + +end module landunit_varcon diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in new file mode 100644 index 000000000..203ef73ca --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in @@ -0,0 +1,324 @@ +module ncdio_pio + + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: ncdio_pioMod + ! + ! !DESCRIPTION: + ! Generic interfaces to write fields to netcdf files for CLM + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, i4=>shr_kind_i4, shr_kind_cl, r4 => shr_kind_r4 + use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan, assignment(=) + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : errMsg => shr_log_errMsg + use MAPL , only : file_desc_t => NetCDF4_FileFormatter + use MAPL_ExceptionHandling + + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + ! + public :: ncd_pio_openfile ! open a file + public :: ncd_pio_closefile ! close a file + public :: ncd_io ! write local data + + ! + contains + + interface ncd_io + + module procedure ncd_io_r4_1d + module procedure ncd_io_r4_2d + module procedure ncd_io_r4_3d + module procedure ncd_io_r4_4d + module procedure ncd_io_r8_1d + module procedure ncd_io_r8_2d + module procedure ncd_io_r8_3d + module procedure ncd_io_r8_4d + module procedure ncd_io_i4_1d + module procedure ncd_io_i4_2d + module procedure ncd_io_i4_3d + module procedure ncd_io_i4_4d + + end interface ncd_io +!---------------------------------------------------- + subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r4), intent(inout) :: data(:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_r4_1d + + !----------------------------------------------------------------------- + + subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r4), intent(inout) :: data(:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_r4_2d + + !----------------------------------------------------------------------- + + subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r4), intent(inout) :: data(:,:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_r4_3d + + !----------------------------------------------------------------------- + + subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r4), intent(inout) :: data(:,:,:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_r4_4d + + !----------------------------------------------------------------------- + + subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r8), intent(inout) :: data(:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_r8_1d + + !----------------------------------------------------------------------- + + + subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r8), intent(inout) :: data(:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_r8_2d + + !----------------------------------------------------------------------- + + + subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r8), intent(inout) :: data(:,:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_r8_3d + + !----------------------------------------------------------------------- + + + subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r8), intent(inout) :: data(:,:,:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_r8_4d + + !----------------------------------------------------------------------- + subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(i4), intent(inout) :: data(:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_i4_1d + + !----------------------------------------------------------------------- + subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(i4), intent(inout) :: data(:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_i4_2d + + !----------------------------------------------------------------------- + subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(i4), intent(inout) :: data(:,:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_i4_3d + + !----------------------------------------------------------------------- + subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(i4), intent(inout) :: data(:,:,:,:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readv + !------------------------------------- + + if flag == 'read' + readv = .false. + call ncid%get_var(varname, data, rc=status) + if (status ==0) readv = .true. + endif + + end subroutine ncd_io_i4_4d + + !----------------------------------------------------------------------- + + subroutine ncd_pio_openfile(file, fname, mode) + ! + ! !DESCRIPTION: + ! Open a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: file ! Output PIO file handle + character(len=*) , intent(in) :: fname ! Input filename to open + integer , intent(in) :: mode ! file mode + ! + ! !LOCAL VARIABLES: + integer :: rc + !----------------------------------------------------------------------- + + + if (mode==0) then + call file%open(trim(fname),pFIO_READ, __RC__) + else + _ASSERT(status==0, "Unrecognized netcdf opening mode") + end if + + end subroutine ncd_pio_openfile +end module ncdio_pio diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 new file mode 100755 index 000000000..ac6845fc0 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 @@ -0,0 +1,291 @@ +module paramUtilMod + ! + ! module that deals with reading parameter files + ! + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + save + private + + interface readNcdio + module procedure readNcdioScalar + module procedure readNcdioArray1d + module procedure readNcdioArray2d + module procedure readNcdioScalarCheckDimensions + module procedure readNcdioArray1dCheckDimensions + module procedure readNcdioArray2dCheckDimensions + end interface + + public :: readNcdioScalar + public :: readNcdioArray1d + public :: readNcdioArray2d + public :: readNcdioScalarCheckDimensions + public :: readNcdioArray1dCheckDimensions + public :: readNcdioArray2dCheckDimensions + + public :: readNcdio + + private :: checkDimensions + +contains + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioScalar(ncid, varName, callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t,ncd_io + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + logical :: readv ! has variable been read in or not + + ! + ! netcdf read here + ! + + call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv) + + if ( .not. readv ) then + call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName)) + endif + + end subroutine readNcdioScalar + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray1d(ncid, varName, callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t,ncd_io + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal( 1: ) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + logical :: readv ! has variable been read in or not + + ! + ! netcdf read here + ! + + call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv) + + if ( .not. readv ) then + call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName)) + endif + + end subroutine readNcdioArray1d + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray2d(ncid, varName, callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t,ncd_io + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal( 1: , :) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + logical :: readv ! has variable been read in or not + + ! + ! netcdf read here + ! + + call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv) + + if ( .not. readv ) then + call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName)) + endif + + end subroutine readNcdioArray2d + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioScalarCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioScalarCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray1dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal( 1: ) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioArray1dCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray2dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal(1:, : ) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioArray2dCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine checkDimensions(ncid, varName, expected_numDims, expected_dimNames, callingName) + ! + ! Assert that the expected number of dimensions and dimension + ! names for a variable match the actual names on the file. + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, var_desc_t, check_var, ncd_inqvdname, ncd_inqvdims + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims ! number of expected dimensions on the variable + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension names + character(len=*), intent(in) :: callingName ! calling routine + integer :: error_num + + ! local vars + character(len=32) :: subname = 'checkDimensions::' + type(Var_desc_t) :: var_desc ! variable descriptor + logical :: readvar ! whether the variable was found + character(len=100) :: received_dimName + integer :: d, num_dims + character(len=256) :: msg + + call check_var(ncid, varName, readvar, vardesc=var_desc) + if (readvar) then + call ncd_inqvdims(ncid, num_dims, var_desc) + if (num_dims /= expected_numDims) then + write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: expected number of dimensions = ", & + expected_numDims, " num dimensions received from file = ", num_dims + call endrun(msg) + end if + do d = 1, num_dims + received_dimName = '' + call ncd_inqvdname(ncid, varname=trim(varName), dimnum=d, dname=received_dimName, err_code=error_num) + if (trim(expected_dimNames(d)) /= trim(received_dimName)) then + write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: dimension ", d, & + " expected dimension name '"//trim(expected_dimNames(d))//& + "' dimension name received from file '"//trim(received_dimName)//"'." + call endrun(msg) + end if + end do + end if + + end subroutine checkDimensions + !----------------------------------------------------------------------- + +end module paramUtilMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 new file mode 100644 index 000000000..38e600470 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -0,0 +1,163 @@ +module shr_abort_mod + ! This module defines procedures that can be used to abort the model cleanly in a + ! system-specific manner + ! + ! The public routines here are only meant to be used directly by shr_sys_mod. Other code + ! that wishes to use these routines should use the republished names from shr_sys_mod + ! (shr_sys_abort, shr_sys_backtrace). (This is for consistency with older code, from + ! when these routines were defined in shr_sys_mod.) + + use, intrinsic :: iso_fortran_env, only: output_unit, error_unit + + use MAPL_ExceptionHandling + use shr_kind_mod, only : shr_kind_in, shr_kind_cx +! use shr_mpi_mod , only : shr_mpi_initialized, shr_mpi_abort + use shr_log_mod , only : s_logunit => shr_log_Unit + +!#ifdef CPRNAG +! ! NAG does not provide this as an intrinsic, but it does provide modules +! ! that implement commonly used POSIX routines. +! use f90_unix_proc, only: abort +!#endif + + implicit none + + ! PUBLIC: Public interfaces + + private + + ! The public routines here are only meant to be used directly by shr_sys_mod. Other code + ! that wishes to use these routines should use the republished names from shr_sys_mod + ! (shr_sys_abort, shr_sys_backtrace). (This is for consistency with older code, from + ! when these routines were defined in shr_sys_mod.) + public :: shr_abort_abort ! abort a program + public :: shr_abort_backtrace ! print a backtrace, if possible + +contains + + !=============================================================================== + subroutine shr_abort_abort(string,rc) + ! Consistent stopping mechanism + + !----- arguments ----- + character(len=*) , intent(in), optional :: string ! error message string + integer(shr_kind_in), intent(in), optional :: rc ! error code + + !----- local ----- + logical :: flag + + ! Local version of the string. + ! (Gets a default value if string is not present.) + character(len=shr_kind_cx) :: local_string + !------------------------------------------------------------------------------- + + if (present(string)) then + local_string = trim(string) + else + local_string = "Unknown error submitted to shr_abort_abort." + end if + + call print_error_to_logs("ERROR", local_string) + + ! call shr_abort_backtrace() + +! call shr_mpi_initialized(flag) + + if (present(rc)) then + _ASSERT(.FALSE.,trim(local_string),rc) + else + _ASSERT(.FALSE.,trim(local_string),) + endif + + ! A compiler's abort method may print a backtrace or do other nice + ! things, but in fact we can rarely leverage this, because MPI_Abort + ! usually sends SIGTERM to the process, and we don't catch that signal. + !call abort() + + end subroutine shr_abort_abort + !=============================================================================== + + !=============================================================================== +! subroutine shr_abort_backtrace() +! ! This routine uses compiler-specific facilities to print a backtrace to +! ! error_unit (standard error, usually unit 0). +! +!#if defined(CPRIBM) +! +! ! This theoretically should be in xlfutility, but using it from that +! ! module doesn't seem to always work. +! interface +! subroutine xl_trbk() +! end subroutine xl_trbk +! end interface +! +! call xl__trbk() +! +!#elif defined(CPRGNU) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 8 )) +! +! ! gfortran 4.8 and later implement this intrinsic. We explicitly call it +! ! out as such to make sure that it really is available, just in case the +! ! CPP logic above screws up. +! intrinsic :: backtrace +! +! call backtrace() +! +!#elif defined(CPRINTEL) +! +! ! tracebackqq uses optional arguments, so *must* have an explicit +! ! interface. +! use ifcore, only: tracebackqq +! +! ! An exit code of -1 is a special value that prevents this subroutine +! ! from aborting the run. +! call tracebackqq(user_exit_code=-1) +! +!#else +! +! ! Currently we have no means to request a backtrace from the NAG runtime, +! ! even though it is capable of emitting backtraces itself, if you use the +! ! "-gline" option. +! +! ! Similarly, PGI has a -traceback option, but no user interface for +! ! requesting a backtrace to be printed. +! +!#endif +! +! flush(error_unit) +! +! end subroutine shr_abort_backtrace + !=============================================================================== + + !=============================================================================== + subroutine print_error_to_logs(error_type, message) + ! This routine prints error messages to s_logunit (which is standard output + ! for most tasks in CESM) and also to standard error if s_logunit is a + ! file. + ! + ! It also flushes these output units. + + character(len=*), intent(in) :: error_type, message + + integer, allocatable :: log_units(:) + + integer :: i + + if (s_logunit == output_unit .or. s_logunit == error_unit) then + ! If the log unit number is standard output or standard error, just + ! print to that. + allocate(log_units(1), source=[s_logunit]) + else + ! Otherwise print the same message to both the log unit and standard + ! error. + allocate(log_units(2), source=[error_unit, s_logunit]) + end if + + do i = 1, size(log_units) + write(log_units(i),*) trim(error_type), ": ", trim(message) + flush(log_units(i)) + end do + + end subroutine print_error_to_logs + !=============================================================================== + +end module shr_abort_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_file_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_file_mod.F90 new file mode 100755 index 000000000..167d67978 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_file_mod.F90 @@ -0,0 +1,1010 @@ +! !MODULE: shr_file_mod.F90 --- Module to handle various file utilily functions. +! +! !DESCRIPTION: +! +! Miscilaneous methods to handle file and directory utilities as well as FORTRAN +! unit control. Also put/get local files into/from archival location +! +! File utilites used with CCSM Message passing: +! +! shr_file_stdio is the main example here, it changes the working directory, +! changes stdin and stdout to a given filename. +! +! This is needed because some implementations of MPI with MPMD so that +! each executable can run in a different working directory and redirect +! output to different files. +! +! File name archival convention, eg. +! call shr_file_put(rcode,"foo","mss:/USER/foo",rtpd=3650) +! is extensible -- the existence of the option file name prefix, eg. "mss:", +! and optional arguments, eg. rtpd-3650 can be used to access site-specific +! storage devices. Based on CCM (atmosphere) getfile & putfile routines, but +! intended to be a more extensible, shared code. +! +! !REVISION HISTORY: +! 2006-05-08 E. Kluzek, Add in shr_file_mod and getUnit, freeUnif methods. +! 2000-??-?? B. Kauffman, original version circa 2000 +! +! !INTERFACE: ------------------------------------------------------------------ + +MODULE shr_file_mod + + ! !USES: + + use shr_kind_mod ! defines kinds + use shr_sys_mod ! system calls + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + IMPLICIT none + + PRIVATE ! By default everything is private to this module + + ! !PUBLIC TYPES: + + ! no public types + + ! !PUBLIC MEMBER FUNCTIONS: + + public :: shr_file_put ! Put a file to an archive location + public :: shr_file_get ! Get a file from an archive location + public :: shr_file_queryPrefix ! Get prefix type for a filename + public :: shr_file_getUnit ! Get a logical unit for reading or writing + public :: shr_file_freeUnit ! Free a logical unit + public :: shr_file_stdio ! change dir and stdin and stdout + public :: shr_file_chDir ! change current working directory + public :: shr_file_dirio ! change stdin and stdout + public :: shr_file_chStdIn ! change stdin (attach to a file) + public :: shr_file_chStdOut ! change stdout (attach to a file) + public :: shr_file_setIO ! open a log file from namelist + public :: shr_file_setLogUnit ! Reset the log unit number + public :: shr_file_setLogLevel ! Reset the logging debug level + public :: shr_file_getLogUnit ! Get the log unit number + public :: shr_file_getLogLevel ! Get the logging debug level +#if defined NEMO_IN_CCSM + public :: shr_file_maxUnit ! Max unit number to give +#endif + + ! !PUBLIC DATA MEMBERS: + + ! Integer flags for recognized prefixes on file get/put operations + integer(SHR_KIND_IN), parameter, public :: shr_file_noPrefix = 0 ! no recognized prefix + integer(SHR_KIND_IN), parameter, public :: shr_file_nullPrefix = 1 ! null: + integer(SHR_KIND_IN), parameter, public :: shr_file_cpPrefix = 2 ! cp: + integer(SHR_KIND_IN), parameter, public :: shr_file_mssPrefix = 3 ! mss: + integer(SHR_KIND_IN), parameter, public :: shr_file_hpssPrefix = 4 ! hpss: + + !EOP + !--- unit numbers, users can ask for unit numbers from 0 to min, but getUnit + !--- won't give a unit below min, users cannot ask for unit number above max + !--- for backward compatability. + !--- eventually, recommend min as hard lower limit (tcraig, 9/2007) + integer(SHR_KIND_IN),parameter :: shr_file_minUnit = 10 ! Min unit number to give + integer(SHR_KIND_IN),parameter :: shr_file_maxUnit = 99 ! Max unit number to give + logical, save :: UnitTag(0:shr_file_maxUnit) = .false. ! Logical units in use + + !=============================================================================== +CONTAINS + !=============================================================================== + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_put -- Put a file to an archival location. + ! + ! !DESCRIPTION: + ! a generic, extensible put-local-file-into-archive routine + ! USAGE: + ! call shr_file_put(rcode,"foo","/home/user/foo") + ! if ( rcode /= 0 ) call shr_sys_abort( "error copying foo" ) + ! call shr_file_put(rcode,"foo","cp:/home/user/foo",remove=.true.) + ! if ( rcode /= 0 ) call shr_sys_abort( "error copying foo" ) + ! call shr_file_put(rcode,"foo","mss:/USER/foo",rtpd=3650) + ! if ( rcode /= 0 ) call shr_sys_abort( "error archiving foo to MSS" ) + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_put(rcode,loc_fn,rem_fn,passwd,rtpd,async,remove) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: rcode ! return code (non-zero -- error) + character(*), intent(in) :: loc_fn ! local filename + character(*), intent(in) :: rem_fn ! remote filename + character(*), intent(in),optional :: passwd ! password + integer(SHR_KIND_IN),intent(in),optional :: rtpd ! MSS retention period + logical, intent(in),optional :: async ! true <=> asynchronous put + logical, intent(in),optional :: remove ! true <=> rm after put + + !EOP + + !----- local ----- + integer(SHR_KIND_IN) :: rtpd2 ! MSS retention period + logical :: remove2 ! true <=> rm after put + logical :: async2 ! true <=> asynchronous put + character(SHR_KIND_CL) :: passwd2 ! password + character(SHR_KIND_CL) :: rfn ! rem_fn without the destination prefix + character(SHR_KIND_CL) :: cmd ! command sent to system call + integer(SHR_KIND_IN) :: prefix ! remote file prefix type + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_put) ' + character(*),parameter :: F00 = "('(shr_file_put) ',4a)" + character(*),parameter :: F01 = "('(shr_file_put) ',a,i3,2a)" + character(*),parameter :: F02 = "(a,i4)" + + !------------------------------------------------------------------------------- + ! Notes: + ! - On some machines the system call will not return a valid error code + ! - when things are sent asynchronously, there probably won't be a error code + ! returned. + !------------------------------------------------------------------------------- + + remove2 =.false. ; if ( PRESENT(remove )) remove2 = remove + async2 =.true. ; if ( PRESENT(async )) async2 = async + passwd2 = " " ; if ( PRESENT(passwd )) passwd2 = passwd + rtpd2 = 365 ; if ( PRESENT(rtpd )) rtpd2 = rtpd + rcode = 0 + prefix = shr_file_queryPrefix( rem_fn ) + + if ( trim(rem_fn) == trim(loc_fn) ) then + !------------------------------------------------------ + ! (remote file name) == (local file name) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: remote file = local file = '//trim(loc_fn) + rcode = 0 + else if ( prefix == shr_file_cpPrefix .or. prefix == shr_file_noPrefix )then + !------------------------------------------------------ + ! put via unix cp + !------------------------------------------------------ + rfn = rem_fn + if ( rem_fn(1:3) == "cp:") rfn = rem_fn(4:len_trim(rem_fn)) + cmd = '/bin/cp -f '//trim(loc_fn)//' '//trim(rfn) + if (remove2) cmd = trim(cmd)//' && /bin/rm -f '//trim(loc_fn) + if (async2 ) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_mssPrefix )then + !------------------------------------------------------ + ! put onto NCAR's MSS + !------------------------------------------------------ + if (rtpd2 > 9999) rtpd2 = 9999 + write(cmd,F02) '/usr/local/bin/msrcp -period ',rtpd2 + if (async2 .and. (.not. remove2) ) cmd = trim(cmd)//' -async ' + if (len_trim(passwd2) > 0 ) cmd = trim(cmd)//' -wpwd '//trim(passwd) + cmd = trim(cmd)//' '//trim(loc_fn)//' '//trim(rem_fn) + if (remove2) cmd = trim(cmd)//' && /bin/rm -f '//trim(loc_fn) + if (async2 .and. remove2 ) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_hpssPrefix )then + !------------------------------------------------------ + ! put onto LANL's hpss + !------------------------------------------------------ + rcode = -1 + cmd = 'rem_fn='//trim(rem_fn)//' loc_fn='//trim(loc_fn) + write(s_logunit,F00) 'ERROR: hpss option not yet implemented' + call shr_sys_abort( subName//'ERROR: hpss option not yet implemented' ) + else if ( prefix == shr_file_nullPrefix )then + ! do nothing + cmd = "null prefix => no file archival, do nothing" + rcode = 0 + end if + + if (s_loglev > 0) write(s_logunit,F01) 'rcode =',rcode,' cmd = ', trim(cmd) + + END SUBROUTINE shr_file_put + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_get -- Get a file from archival location. + ! + ! !DESCRIPTION: + ! a generic, extensible get-local-file-from-archive routine + ! + ! USAGE: + ! call shr_file_get(rcode,"foo","/home/user/foo") + ! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo" ) + ! call shr_file_get(rcode,"foo","cp:/home/user/foo",remove=.true.) + ! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo" ) + ! call shr_file_get(rcode,"foo","mss:/USER/foo",clobber=.true.) + ! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo from MSS" ) + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_get(rcode,loc_fn,rem_fn,passwd,async,clobber) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: rcode ! return code (non-zero means error) + character(*) ,intent(in) :: loc_fn ! local filename + character(*) ,intent(in) :: rem_fn ! remote filename + character(*) ,intent(in),optional :: passwd ! password + logical ,intent(in),optional :: async ! true <=> asynchronous get + logical ,intent(in),optional :: clobber ! true <=> clobber existing file + + !EOP + + !----- local ----- + logical :: async2 ! true <=> asynchronous get + logical :: clobber2 ! true <=> clobber existing file + logical :: exists ! true <=> local file a ready exists + character(SHR_KIND_CL) :: passwd2 ! password + character(SHR_KIND_CL) :: rfn ! rem_fn without the destination prefix + character(SHR_KIND_CL) :: cmd ! command sent to system call + integer(SHR_KIND_IN) :: prefix ! remote file prefix type + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_get) ' + character(*),parameter :: F00 = "('(shr_file_get) ',4a)" + character(*),parameter :: F01 = "('(shr_file_get) ',a,i3,2a)" + + !------------------------------------------------------------------------------- + ! Notes: + ! - On some machines the system call will not return a valid error code + ! - When things are sent asynchronously, there probably won't be a error code + ! returned. + !------------------------------------------------------------------------------- + + passwd2 = " " ; if (PRESENT(passwd )) passwd2 = passwd + async2 = .false. ; if (PRESENT(async )) async2 = async + clobber2 = .false. ; if (PRESENT(clobber)) clobber2 = clobber + rcode = 0 + + inquire(file=trim(loc_fn),exist=exists) + prefix = shr_file_queryPrefix( rem_fn ) + + if ( exists .and. .not. clobber2 ) then + !------------------------------------------------------ + ! (file exists) and (don't clobber) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: file exists & no-clobber for '//trim(loc_fn) + rcode = 0 + else if ( trim(rem_fn) == trim(loc_fn) ) then + !------------------------------------------------------ + ! (remote file name) == (local file name) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: remote file = local file for '//trim(loc_fn) + rcode = 0 + else if ( prefix == shr_file_cpPrefix .or. prefix == shr_file_noPrefix )then + !------------------------------------------------------ + ! get via unix cp + !------------------------------------------------------ + rfn = rem_fn ! remove prefix from this temp file name + if (rem_fn(1:3) == "cp:") rfn = rem_fn(4:len_trim(rem_fn)) + cmd = '/bin/cp -f '//trim(rfn)//' '//trim(loc_fn) + if (async2) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_mssPrefix )then + !------------------------------------------------------ + ! get from NCAR's MSS + !------------------------------------------------------ + cmd = '/usr/local/bin/msrcp ' + if (async2) cmd = trim(cmd)//' -async ' + cmd = trim(cmd)//' '//trim(rem_fn)//' '//trim(loc_fn) + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_hpssPrefix )then + !------------------------------------------------------ + ! get from LANL's hpss + !------------------------------------------------------ + rcode = -1 + cmd = 'rem_fn='//trim(rem_fn)//' loc_fn='//trim(loc_fn) + write(s_logunit,F00) 'ERROR: hpss option not yet implemented' + call shr_sys_abort( subName//'ERROR: hpss option not yet implemented' ) + else if ( prefix == shr_file_nullPrefix )then + ! do nothing + cmd = "null prefix => no file retrieval, do nothing" + rcode = 0 + end if + + if (s_loglev > 0) write(s_logunit,F01) 'rcode =',rcode,' cmd = ', trim(cmd) + + END SUBROUTINE shr_file_get + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_queryPrefix -- Get the prefix type from a filepath. + ! + ! !DESCRIPTION: + ! + ! !INTERFACE: ------------------------------------------------------------------ + + integer(SHR_KIND_IN) FUNCTION shr_file_queryPrefix( filepath, prefix ) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*), intent(in) :: filepath ! Input filepath + character(*), intent(out), optional :: prefix ! Output prefix description + + !EOP + + !----- local ----- + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + if ( filepath(1:5) == "null:" )then + shr_file_queryPrefix = shr_file_nullPrefix + if ( present(prefix) ) prefix = "null:" + else if( filepath(1:3) == "cp:" )then + shr_file_queryPrefix = shr_file_cpPrefix + if ( present(prefix) ) prefix = "cp:" + else if( filepath(1:4) == "mss:" )then + shr_file_queryPrefix = shr_file_mssPrefix + if ( present(prefix) ) prefix = "mss:" + else if( filepath(1:5) == "hpss:" )then + shr_file_queryPrefix = shr_file_hpssPrefix + if ( present(prefix) ) prefix = "hpss:" + else + shr_file_queryPrefix = shr_file_noPrefix + if ( present(prefix) ) prefix = "" + end if + + END FUNCTION shr_file_queryPrefix + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_getUnit -- Get a free FORTRAN unit number + ! + ! !DESCRIPTION: Get the next free FORTRAN unit number. + ! + ! !REVISION HISTORY: + ! 2005-Dec-14 - E. Kluzek - creation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + INTEGER FUNCTION shr_file_getUnit ( unit ) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in),optional :: unit ! desired unit number + + !EOP + + !----- local ----- + integer(SHR_KIND_IN) :: n ! loop index + logical :: opened ! If unit opened or not + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_getUnit) ' + character(*),parameter :: F00 = "('(shr_file_getUnit) ',A,I4,A)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + shr_file_getUnit = -1 + if (present (unit)) then + inquire( unit, opened=opened ) + if (unit < 0 .or. unit > shr_file_maxUnit) then + write(s_logunit,F00) 'invalid unit number request:', unit + call shr_sys_abort( 'ERROR: bad input unit number' ) + else if (opened .or. UnitTag(unit) .or. unit == 0 .or. unit == 5 & + .or. unit == 6) then + write(s_logunit,F00) 'unit number ', unit, ' is already in use' + call shr_sys_abort( 'ERROR: Input unit number already in use' ) + else + shr_file_getUnit = unit + UnitTag (unit) = .true. + return + end if + + else + ! --- Choose first available unit other than 0, 5, or 6 ------ + do n=shr_file_maxUnit, shr_file_minUnit, -1 + inquire( n, opened=opened ) + if (n == 5 .or. n == 6 .or. opened) then + cycle + end if + if ( .not. UnitTag(n) ) then + shr_file_getUnit = n + UnitTag(n) = .true. + return + end if + end do + end if + + call shr_sys_abort( subName//': Error: no available units found' ) + + END FUNCTION shr_file_getUnit + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_freeUnit -- Free up a FORTRAN unit number + ! + ! !DESCRIPTION: Free up the given unit number + ! + ! !REVISION HISTORY: + ! 2005-Dec-14 - E. Kluzek - creation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_freeUnit ( unit) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! unit number to be freed + + !EOP + + !----- local ----- + + !----- formats ----- + character(*), parameter :: subName = '(shr_file_freeUnit) ' + character(*), parameter :: F00 = "('(shr_file_freeUnit) ',A,I4,A)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + if (unit < 0 .or. unit > shr_file_maxUnit) then + if (s_loglev > 0) write(s_logunit,F00) 'invalid unit number request:', unit + else if (unit == 0 .or. unit == 5 .or. unit == 6) then + call shr_sys_abort( subName//': Error: units 0, 5, and 6 must not be freed' ) + else if (UnitTag(unit)) then + UnitTag (unit) = .false. + else + if (s_loglev > 0) write(s_logunit,F00) 'unit ', unit, ' was not in use' + end if + + return + + END SUBROUTINE shr_file_freeUnit + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_stdio -- Change working directory, and redirect stdin/stdout + ! + ! !DESCRIPTION: + ! 1) change the cwd (current working directory) and + ! 2) redirect stdin & stdout (units 5 & 6) to named files, + ! where the desired cwd & files are specified by namelist file. + ! + ! Normally this is done to work around limitations in the execution syntax + ! of common MPI implementations. For example, SGI's mpirun syntax is not + ! flexible enough to allow MPMD models to select different execution + ! directories or to redirect stdin & stdout on the command line. + ! Such functionality is highly desireable for CCSM purposes. + ! ie. mpirun can't handle this: + ! unix> cd /usr/tmp/jdoe/csm/case01/atm ; atm < atm.parm > atm.log & + ! unix> cd /usr/tmp/jdoe/csm/case01/cpl ; cpl < cpl.parm > cpl.log & + ! etc. + ! + ! ASSUMPTIONS: + ! o if the cwd, stdin, or stdout are to be changed, there must be a namelist + ! file in the cwd named _stdio.nml where is provided via + ! subroutine dummy argument. + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_stdio(model) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: model ! used to construct env varible name + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_stdio) ' + character(*),parameter :: F00 = "('(shr_file_stdio) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + call shr_file_chdir (model) ! changes cwd + call shr_file_chStdOut(model) ! open units 5 & 6 to named files + call shr_file_chStdIn (model) ! open units 5 & 6 to named files + + END SUBROUTINE shr_file_stdio + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_chdir -- Change working directory. + ! + ! !DESCRIPTION: + ! change the cwd (current working directory), see shr_file_stdio for notes + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_chdir(model, rcodeOut) + + ! !USES: + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env varible name + integer(SHR_KIND_IN),intent(out),optional :: rcodeOut ! Return error code + + !EOP + + !--- local --- + character(SHR_KIND_CL) :: dir ! directory to cd to + integer (SHR_KIND_IN) :: rcode ! Return error code + character(SHR_KIND_CL) :: filename ! namelist file to read + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chdir) ' + character(*),parameter :: F00 = "('(shr_file_chdir) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, dirOut=dir, rcodeOut=rcode ) + if (dir /= "nochange") then + call shr_sys_chdir(dir ,rcode) + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", changed cwd to ",trim(dir) + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", cwd has *not* been changed" + rcode = 1 + endif + if ( present(rcodeOut) ) rcodeOut = rcode + + END SUBROUTINE shr_file_chdir + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_dirio --- Change stdin and stdout. + ! + ! !DESCRIPTION: + ! change the stdin & stdout (units 5 & 6), see shr_file_stdio for notes + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_dirio(model) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: model ! used to construct env varible name + + !EOP + + !--- local --- + + !--- formats --- + character(*),parameter :: subName = '(shr_file_dirio) ' + + !------------------------------------------------------------------------------- + ! Notes: + ! + !------------------------------------------------------------------------------- + + call shr_file_chStdIn (model) + call shr_file_chStdOut(model) + + END SUBROUTINE shr_file_dirio + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_chStdIn -- Change stdin + ! + ! !DESCRIPTION: + ! change the stdin (unit 5), see shr_file_stdio for notes + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_chStdIn( model, NLFilename, rcodeOut ) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env var name + character(SHR_KIND_CL),intent(out),optional :: NLFilename ! open unit 5 to this + integer (SHR_KIND_IN),intent(out),optional :: rcodeOut ! return code + + !EOP + + !--- local --- + character(SHR_KIND_CL) :: stdin ! open unit 5 to this file + character(SHR_KIND_CL) :: nlfile ! Namelist filename for model to read from + character(SHR_KIND_CL) :: filename ! namelist file to read + integer (SHR_KIND_IN) :: rcode ! return code + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chStdIn) ' + character(*),parameter :: F00 = "('(shr_file_chStdIn) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, stdinOut=stdin, & + nlfileOut=nlfile, rcodeOut=rcode ) + if (stdin /= "nochange") then + open(unit=5,file=stdin ,status='UNKNOWN',iostat=rcode) + if ( rcode /= 0 )then + if (s_loglev > 0) & + write(s_logunit,F00) "read ",trim(filename),': error opening file as unit 5:', & + trim(nlfile) + else + if (s_loglev > 0) & + write(s_logunit,F00) "read ",trim(filename),': unit 5 connected to ', & + trim(stdin) + end if + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 5 has *not* been redirected' + endif + if ( len_trim(nlfile) > 0) then + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': read namelist from file:',trim(nlfile) + if ( .not. present(NLFilename) )then + if (s_loglev > 0) write(s_logunit,F00) "error: namelist filename NOT present" + rcode = 7 + end if + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", " + if ( present(NLFilename) )then + if (s_loglev > 0) write(s_logunit,F00) "error: namelist filename present, but null" + rcode = 8 + end if + endif + if ( present(NLFilename) ) NLFilename = nlfile + if ( present(rcodeOut) ) rcodeOut = rcode + + END SUBROUTINE shr_file_chStdIn + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_stdout -- Change stdout + ! + ! !DESCRIPTION: + ! change the stdout (unit 6), see shr_file_stdio for notes + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_chStdOut(model,rcodeOut) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + !--- arguments --- + character(*) ,intent(in) :: model ! used to construct env varible name + integer(SHR_KIND_IN),intent(out),optional :: rcodeOut ! Return error code + !EOP + + !--- local --- + character(SHR_KIND_CL) :: filename ! namelist file to read + character(SHR_KIND_CL) :: stdout ! open unit 6 to this file + integer (SHR_KIND_IN) :: rcode ! return code + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chStdOut) ' + character(*),parameter :: F00 = "('(shr_file_chStdOut) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, stdoutOut=stdout, & + rcodeOut=rcode ) + if (stdout /= "nochange") then + close(6) + open(unit=6,file=stdout,position='APPEND') + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 6 connected to ',trim(stdout) + call shr_sys_flush(s_logunit) + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 6 has *not* been redirected' + rcode = 1 + endif + + if ( present(rcodeOut) ) rcodeOut = rcode + + END SUBROUTINE shr_file_chStdOut + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_stdioReadNL -- read in stdio namelist + ! + ! !DESCRIPTION: + ! Read in the stdio namelist for any given model type. Return any of the + ! needed input namelist variables as optional arguments. Return "nochange" in + ! dir, stdin, or stdout if shouldn't change. + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_stdioReadNL( model, filename, dirOut, stdinOut, stdoutOut, & + NLFileOut, rcodeOut ) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env varible name + character(SHR_KIND_CL),intent(out) :: filename ! nml file to read from unit 5 + character(SHR_KIND_CL),intent(out),optional :: NLFileOut ! open unit 6 to this file + character(SHR_KIND_CL),intent(out),optional :: dirOut ! directory to cd to + character(SHR_KIND_CL),intent(out),optional :: stdinOut ! open unit 5 to this file + character(SHR_KIND_CL),intent(out),optional :: stdoutOut ! open unit 6 to this file + integer (SHR_KIND_IN),intent(out),optional :: rcodeOut ! return code + + !EOP + + !--- local --- + logical :: exists ! true iff file exists + character(SHR_KIND_CL) :: dir ! directory to cd to + character(SHR_KIND_CL) :: stdin ! open unit 5 to this file + character(SHR_KIND_CL) :: stdout ! open unit 6 to this file + character(SHR_KIND_CL) :: NLFile ! namelist file to read seperately + integer (SHR_KIND_IN) :: rcode ! return code + integer (SHR_KIND_IN) :: unit ! Unit to read from + + namelist / stdio / dir,stdin,stdout,NLFile + + !--- formats --- + character(*),parameter :: subName = '(shr_file_stdioReadNL) ' + character(*),parameter :: F00 = "('(shr_file_stdioReadNL) ',4a)" + character(*),parameter :: F01 = "('(shr_file_stdioReadNL) ',3a,i6)" + + !------------------------------------------------------------------------------- + ! Notes: + ! + !------------------------------------------------------------------------------- + + rcode = 0 + dir = "nochange" + stdin = "nochange" + stdout = "nochange" + NLFile = " " + + filename = trim(model)//"_stdio.nml" ! eg. file="cpl_stdio.nml" + inquire(file=filename,exist=exists) + + if (.not. exists) then + if (s_loglev > 0) write(s_logunit,F00) "file ",trim(filename),& + & " doesn't exist, can not read stdio namelist from it" + rcode = 9 + else + unit = shr_file_getUnit() + open (unit,file=filename,action="READ") + read (unit,nml=stdio,iostat=rcode) + close(unit) + call shr_file_freeUnit( unit ) + if (rcode /= 0) then + write(s_logunit,F01) 'ERROR: reading ',trim(filename),': iostat=',rcode + call shr_sys_abort(subName//" ERROR reading "//trim(filename) ) + end if + endif + if ( len_trim(NLFile) > 0 .and. trim(stdin) /= "nochange" )then + write(s_logunit,F00) "Error: input namelist:" + write(s_logunit,nml=stdio) + call shr_sys_abort(subName//" ERROR trying to both redirect AND "// & + "open namelist filename" ) + end if + if ( present(NLFileOut) ) NLFileOut = NLFile + if ( present(dirOut) ) dirOut = dir + if ( present(stdinOut) ) stdinOut = stdin + if ( present(stdoutOut) ) stdoutOut = stdout + if ( present(rcodeOut) ) rcodeOut = rcode + + END SUBROUTINE shr_file_stdioReadNL + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_setIO -- read in stdio namelist + ! + ! !DESCRIPTION: + ! This opens a namelist file specified as an argument and then opens + ! a log file associated with the unit argument. This may be extended + ! in the future. + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_setIO( nmlfile, funit) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(len=*) ,intent(in) :: nmlfile ! namelist filename + integer(SHR_KIND_IN),intent(in) :: funit ! unit number for log file + + !EOP + + !--- local --- + logical :: exists ! true if file exists + character(SHR_KIND_CL) :: diri ! directory to cd to + character(SHR_KIND_CL) :: diro ! directory to cd to + character(SHR_KIND_CL) :: logfile ! open unit 6 to this file + integer(SHR_KIND_IN) :: unit ! unit number + integer(SHR_KIND_IN) :: rcode ! error code + + namelist / modelio / diri,diro,logfile + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setIO) ' + character(*),parameter :: F00 = "('(shr_file_setIO) ',4a)" + character(*),parameter :: F01 = "('(shr_file_setIO) ',3a,i6)" + + !------------------------------------------------------------------------------- + ! Notes: + ! + !------------------------------------------------------------------------------- + + diri = "." + diro = "." + logfile = "" + + inquire(file=nmlfile,exist=exists) + + if (.not. exists) then + if (s_loglev > 0) write(s_logunit,F00) "file ",trim(nmlfile)," nonexistent" + return + else + unit = shr_file_getUnit() + open (unit,file=nmlfile,action="READ") + read (unit,nml=modelio,iostat=rcode) + close(unit) + call shr_file_freeUnit( unit ) + if (rcode /= 0) then + write(s_logunit,F01) 'ERROR: reading ',trim(nmlfile),': iostat=',rcode + call shr_sys_abort(subName//" ERROR reading "//trim(nmlfile) ) + end if + endif + + if (len_trim(logfile) > 0) then + open(funit,file=trim(diro)//"/"//trim(logfile)) + else + if (s_loglev > 0) write(s_logunit,F00) "logfile not opened" + endif + + END SUBROUTINE shr_file_setIO + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_setLogUnit -- Set the Log I/O Unit number + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_setLogUnit(unit) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! new unit number + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setLogUnit) ' + character(*),parameter :: F00 = "('(shr_file_setLogUnit) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: Caller must be sure it's a valid unit number + !------------------------------------------------------------------------------- +#if DEBUG + if (s_loglev > 2 .and. s_logunit-unit /= 0) then + write(s_logunit,*) subName,': reset log unit number from/to ',s_logunit, unit + write( unit,*) subName,': reset log unit number from/to ',s_logunit, unit + endif +#endif + s_logunit = unit + + END SUBROUTINE shr_file_setLogUnit + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_setLogLevel -- Set the Log I/O Unit number + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_setLogLevel(newlevel) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: newlevel ! new log level + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setLogLevel) ' + character(*),parameter :: F00 = "('(shr_file_setLogLevel) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + if (s_loglev+newlevel > 2 .and. s_loglev-newlevel /= 0) & + write(s_logunit,*) subName,': reset log level from/to ',s_loglev, newlevel + + s_loglev = newlevel + + END SUBROUTINE shr_file_setLogLevel + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_getLogUnit -- Set the Log I/O Unit number + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_getLogUnit(unit) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: unit ! new unit number + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_getLogUnit) ' + character(*),parameter :: F00 = "('(shr_file_getLogUnit) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + unit = s_logunit + + END SUBROUTINE shr_file_getLogUnit + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_getLogLevel -- Set the Log I/O Unit number + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_getLogLevel(curlevel) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: curlevel ! new log level + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_getLogLevel) ' + character(*),parameter :: F00 = "('(shr_file_getLogLevel) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + curlevel = s_loglev + + END SUBROUTINE shr_file_getLogLevel + + !=============================================================================== + !=============================================================================== + +END MODULE shr_file_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_log_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_log_mod.F90 new file mode 100644 index 000000000..8a3153562 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_log_mod.F90 @@ -0,0 +1,105 @@ +!BOP =========================================================================== +! +! !MODULE: shr_log_mod -- variables and methods for logging +! +! !DESCRIPTION: +! Low-level shared variables for logging. +! +! Also, routines for generating log file messages. +! +! !INTERFACE: ------------------------------------------------------------------ + +module shr_log_mod + +! !USES: + + use shr_kind_mod +! use shr_strconvert_mod, only: toString + + use, intrinsic :: iso_fortran_env, only: output_unit + + implicit none + private + +! !PUBLIC TYPES: + + ! no public types + +! !PUBLIC MEMBER FUNCTIONS: + + public :: shr_log_errMsg +! public :: shr_log_OOBMsg + +! !PUBLIC DATA MEMBERS: + + public :: shr_log_Level + public :: shr_log_Unit + +!EOP + + ! low-level shared variables for logging, these may not be parameters + integer(SHR_KIND_IN) :: shr_log_Level = 0 + integer(SHR_KIND_IN) :: shr_log_Unit = output_unit + +contains + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_log_errMsg -- Return an error message containing file & line info +! +! !DESCRIPTION: +! Return an error message containing file & line info +! \newline +! errMsg = shr\_log\_errMsg(__FILE__, __LINE__) +! +! This is meant to be used when a routine expects a string argument for some message, +! but you want to provide file and line information. +! +! However: Note that the performance of this function can be very bad. It is currently +! maintained because it is used by old code, but you should probably avoid using this +! in new code if possible. +! +! !REVISION HISTORY: +! 2013-July-23 - Bill Sacks +! +! !INTERFACE: ------------------------------------------------------------------ + +pure function shr_log_errMsg(file, line) + +! !INPUT/OUTPUT PARAMETERS: + + character(len=SHR_KIND_CX) :: shr_log_errMsg + character(len=*), intent(in) :: file + integer , intent(in) :: line + character(len=40) :: line_str + +!EOP + write(line_str, '(i40)') line + shr_log_errMsg = 'ERROR in '//trim(file)//' at line '//trim(line_str) + +end function shr_log_errMsg + +!! Create a message for an out of bounds error. +!pure function shr_log_OOBMsg(operation, bounds, idx) result(OOBMsg) +! +! ! A name for the operation being attempted when the bounds error +! ! occurred. A string containing the subroutine name is ideal, but more +! ! generic descriptions such as "read", "modify", or "insert" could be used. +! character(len=*), intent(in) :: operation +! +! ! Upper and lower bounds allowed for the operation. +! integer, intent(in) :: bounds(2) +! +! ! Index at which access was attempted. +! integer, intent(in) :: idx +! +! ! Output message +! character(len=:), allocatable :: OOBMsg +! +! allocate(OOBMsg, source=(operation//": "//toString(idx)//" not in range ["//& +! toString(bounds(1))//", "//toString(bounds(2))//"].")) +! +!end function shr_log_OOBMsg + +end module shr_log_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_sys_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_sys_mod.F90 new file mode 100644 index 000000000..e0daed629 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_sys_mod.F90 @@ -0,0 +1,332 @@ +!=============================================================================== +! SVN $Id: shr_sys_mod.F90 66411 2014-12-19 22:40:08Z santos@ucar.edu $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_150116/shr/shr_sys_mod.F90 $ +!=============================================================================== + +! Currently supported by all compilers +!#define HAVE_GET_ENVIRONMENT +!#define HAVE_SLEEP +! +!! Except this combination? +!#if defined CPRPGI && defined CNL +!#undef HAVE_GET_ENVIRONMENT +!#endif +! +!#if defined CPRNAG +!#define HAVE_EXECUTE +!#endif + +MODULE shr_sys_mod + + use shr_kind_mod ! defines real & integer kinds + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + use shr_abort_mod, only: shr_sys_abort => shr_abort_abort +! use shr_abort_mod, only: shr_sys_backtrace => shr_abort_backtrace + +!#ifdef CPRNAG + ! ! NAG does not provide these as intrinsics, but it does provide modules + ! ! that implement commonly used POSIX routines. + ! use f90_unix_dir, only: chdir + ! use f90_unix_proc, only: abort, sleep +!#endif + + implicit none + +! PUBLIC: Public interfaces + + private + +! public :: shr_sys_system ! make a system call +! public :: shr_sys_chdir ! change current working dir +! public :: shr_sys_getenv ! get an environment variable +! public :: shr_sys_irtc ! returns real-time clock tick +! public :: shr_sys_sleep ! have program sleep for a while +! public :: shr_sys_flush ! flush an i/o buffer + + ! Imported from shr_abort_mod and republished with renames. Other code that wishes to + ! use these routines should use these shr_sys names rather than directly using the + ! routines from shr_abort_abort. (This is for consistency with older code, from when + ! these routines were defined in shr_sys_mod.) + public :: shr_sys_abort ! abort a program +! public :: shr_sys_backtrace ! print a backtrace, if possible + +!=============================================================================== +CONTAINS +!=============================================================================== + +!=============================================================================== +!=============================================================================== + +!SUBROUTINE shr_sys_system(str,rcode) +! +! IMPLICIT none +! +! !----- arguments --- +! character(*) ,intent(in) :: str ! system/shell command string +! integer(SHR_KIND_IN),intent(out) :: rcode ! function return error code +! +! !----- functions ----- +!#if (defined LINUX && !defined CPRGNU) +! integer(SHR_KIND_IN),external :: system ! function to envoke shell command +!#endif +! +! !----- formats ----- +! character(*),parameter :: subName = '(shr_sys_system) ' +! character(*),parameter :: F00 = "('(shr_sys_system) ',4a)" +! +!!------------------------------------------------------------------------------- +!! PURPOSE: an architecture independent system call +!!------------------------------------------------------------------------------- +! rcode = 0 +!#ifdef HAVE_EXECUTE +! call execute_command_line(str,exitstat=rcode) ! Intrinsic as of F2008 +!#else +!#if (defined AIX) +! +! call system(str,rcode) +! +!#elif (defined CPRGNU || defined LINUX) +! +! rcode = system(str) +! +!#else +! +! write(s_logunit,F00) 'ERROR: no implementation of system call for this architecture' +! call shr_sys_abort(subName//'no implementation of system call for this architecture') +!#endif +!#endif +! +!END SUBROUTINE shr_sys_system +! +!!=============================================================================== +!!=============================================================================== +! +!SUBROUTINE shr_sys_chdir(path, rcode) +! +! IMPLICIT none +! +! !----- arguments ----- +! character(*) ,intent(in) :: path ! chdir to this dir +! integer(SHR_KIND_IN),intent(out) :: rcode ! return code +! +! !----- local ----- +! integer(SHR_KIND_IN) :: lenpath ! length of path +!#if (defined AIX || (defined LINUX && !defined CPRGNU && !defined CPRNAG) || defined CPRINTEL) +! integer(SHR_KIND_IN),external :: chdir ! AIX system call +!#endif +! +! !----- formats ----- +! character(*),parameter :: subName = '(shr_sys_chdir) ' +! character(*),parameter :: F00 = "('(shr_sys_chdir) ',4a)" +! +!!------------------------------------------------------------------------------- +!! PURPOSE: an architecture independent system call +!!------------------------------------------------------------------------------- +! +! lenpath=len_trim(path) +! +!#if (defined AIX) +! +! rcode = chdir(%ref(path(1:lenpath)//'\0')) +! +!#elif (defined Darwin || (defined LINUX && !defined CPRNAG)) +! +! rcode=chdir(path(1:lenpath)) +! +!#elif (defined CPRNAG) +! +! call chdir(path(1:lenpath), errno=rcode) +! +!#else +! +! write(s_logunit,F00) 'ERROR: no implementation of chdir for this architecture' +! call shr_sys_abort(subname//'no implementation of chdir for this machine') +! +!#endif +! +!END SUBROUTINE shr_sys_chdir +! +!!=============================================================================== +!!=============================================================================== +! +!SUBROUTINE shr_sys_getenv(name, val, rcode) +! +! IMPLICIT none +! +! !----- arguments ----- +! character(*) ,intent(in) :: name ! env var name +! character(*) ,intent(out) :: val ! env var value +! integer(SHR_KIND_IN),intent(out) :: rcode ! return code +! +! !----- local ----- +!#ifndef HAVE_GET_ENVIRONMENT +! integer(SHR_KIND_IN) :: lenname ! length of env var name +! integer(SHR_KIND_IN) :: lenval ! length of env var value +! character(SHR_KIND_CL) :: tmpval ! temporary env var value +!#endif +! !----- formats ----- +! character(*),parameter :: subName = '(shr_sys_getenv) ' +! character(*),parameter :: F00 = "('(shr_sys_getenv) ',4a)" +! +!!------------------------------------------------------------------------------- +!! PURPOSE: an architecture independent system call +!!------------------------------------------------------------------------------- +! +!!$OMP master +! +! +!#ifdef HAVE_GET_ENVIRONMENT +! call get_environment_variable(name=name,value=val,status=rcode) ! Intrinsic in F2003 +!#else +! lenname=len_trim(name) +!#if (defined AIX || defined LINUX) +! +! call getenv(trim(name),tmpval) +! val=trim(tmpval) +! rcode = 0 +! if (len_trim(val) == 0 ) rcode = 1 +! if (len_trim(val) > SHR_KIND_CL) rcode = 2 +! +!#else +! +! write(s_logunit,F00) 'ERROR: no implementation of getenv for this architecture' +! call shr_sys_abort(subname//'no implementation of getenv for this machine') +! +!#endif +!#endif +!!$OMP end master +! +!END SUBROUTINE shr_sys_getenv +! +!!=============================================================================== +!!=============================================================================== +! +!integer(SHR_KIND_I8) FUNCTION shr_sys_irtc( rate ) +! +! IMPLICIT none +! +! !----- arguments ----- +! integer(SHR_KIND_I8), optional :: rate +! +! !----- local ----- +! integer(SHR_KIND_IN) :: count +! integer(SHR_KIND_IN) :: count_rate +! integer(SHR_KIND_IN) :: count_max +! +! integer(SHR_KIND_IN),save :: last_count = -1 +! integer(SHR_KIND_I8),save :: count_offset = 0 +!!$OMP THREADPRIVATE (last_count, count_offset) +! +! !----- formats ----- +! character(*),parameter :: subName = '(shr_sys_irtc) ' +! character(*),parameter :: F00 = "('(shr_sys_irtc) ',4a)" +! +!!------------------------------------------------------------------------------- +!! emulates Cray/SGI irtc function (returns clock tick since last reboot) +!! +!! This function is not intended to measure elapsed time between +!! multi-threaded regions with different numbers of threads. However, +!! use of the threadprivate declaration does guarantee accurate +!! measurement per thread within a single multi-threaded region as +!! long as the number of threads is not changed dynamically during +!! execution within the multi-threaded region. +!! +!!------------------------------------------------------------------------------- +! +! call system_clock(count=count,count_rate=count_rate, count_max=count_max) +! if ( present(rate) ) rate = count_rate +! shr_sys_irtc = count +! +! !--- adjust for clock wrap-around --- +! if ( last_count /= -1 ) then +! if ( count < last_count ) count_offset = count_offset + count_max +! end if +! shr_sys_irtc = shr_sys_irtc + count_offset +! last_count = count +! +!END FUNCTION shr_sys_irtc +! +!!=============================================================================== +!!=============================================================================== +! +!SUBROUTINE shr_sys_sleep(sec) +! +! IMPLICIT none +! +! !----- arguments ----- +! real (SHR_KIND_R8),intent(in) :: sec ! number of seconds to sleep +! +! !----- local ----- +! integer(SHR_KIND_IN) :: isec ! integer number of seconds +!#ifndef HAVE_SLEEP +! integer(SHR_KIND_IN) :: rcode ! return code +! character(90) :: str ! system call string +!#endif +! !----- formats ----- +! character(*),parameter :: subName = '(shr_sys_sleep) ' +! character(*),parameter :: F00 = "('(shr_sys_sleep) ',4a)" +! character(*),parameter :: F10 = "('sleep ',i8 )" +! +!!------------------------------------------------------------------------------- +!! PURPOSE: Sleep for approximately sec seconds +!!------------------------------------------------------------------------------- +! +! isec = nint(sec) +! +! if (isec < 0) then +! if (s_loglev > 0) write(s_logunit,F00) 'ERROR: seconds must be > 0, sec=',sec +! else if (isec == 0) then +! ! Don't consider this an error and don't call system sleep +! else +!#ifdef HAVE_SLEEP +! call sleep(isec) +!#else +! write(str,FMT=F10) isec +! call shr_sys_system( str, rcode ) +!#endif +! endif +! +!END SUBROUTINE shr_sys_sleep +! +!!=============================================================================== +!!=============================================================================== +! +!SUBROUTINE shr_sys_flush(unit) +! +! IMPLICIT none +! +! !----- arguments ----- +! integer(SHR_KIND_IN) :: unit ! flush output buffer for this unit +! +! !----- local ----- +! !----- formats ----- +! character(*),parameter :: subName = '(shr_sys_flush) ' +! character(*),parameter :: F00 = "('(shr_sys_flush) ',4a)" +! +!!------------------------------------------------------------------------------- +!! PURPOSE: an architecture independent system call +!! +!! This is probably no longer needed; the "flush" statement is supported by +!! all compilers that CESM supports for years now. +!! +!!------------------------------------------------------------------------------- +!!$OMP SINGLE +! flush(unit) +!!$OMP END SINGLE +!! +!! The following code was originally present, but there's an obvious issue. +!! Since shr_sys_flush is usually used to flush output to a log, when it +!! returns an error, does it do any good to print that error to the log? +!! +!! if (ierr > 0) then +!! write(s_logunit,*) subname,' Flush reports error: ',ierr +!! endif +!! +! +!END SUBROUTINE shr_sys_flush +! +!!=============================================================================== +!!=============================================================================== + +END MODULE shr_sys_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 new file mode 100755 index 000000000..78109631e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 @@ -0,0 +1,142 @@ + +module spmdMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: spmdMod +! +! !DESCRIPTION: +! SPMD initialization +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varctl , only: iulog + implicit none + + private + +#include + + save + + ! Default settings valid even if there is no spmd + + logical, public :: masterproc ! proc 0 logical for printing msgs + integer, public :: iam ! processor number + integer, public :: npes ! number of processors for clm + integer, public :: mpicom ! communicator group for clm + integer, public :: comp_id ! component id + + ! + ! Public methods + ! + public :: spmd_init ! Initialization + + ! + ! Values from mpif.h that can be used + ! + public :: MPI_INTEGER + public :: MPI_REAL8 + public :: MPI_LOGICAL + public :: MPI_SUM + public :: MPI_MIN + public :: MPI_MAX + public :: MPI_LOR + public :: MPI_STATUS_SIZE + public :: MPI_ANY_SOURCE + public :: MPI_CHARACTER + public :: MPI_COMM_WORLD + public :: MPI_MAX_PROCESSOR_NAME + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: spmd_init( clm_mpicom ) +! +! !INTERFACE: + subroutine spmd_init() +! +! !DESCRIPTION: +! MPI initialization (number of cpus, processes, tids, etc) +! +! !USES +! +! !ARGUMENTS: + implicit none +! integer, intent(in) :: clm_mpicom +! integer, intent(in) :: LNDID +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP +! integer :: i,j ! indices +! integer :: ier ! return error status +! integer :: mylength ! my processor length +! logical :: mpi_running ! temporary +! integer, allocatable :: length(:) +! integer, allocatable :: displ(:) +! character*(MPI_MAX_PROCESSOR_NAME), allocatable :: procname(:) +! character*(MPI_MAX_PROCESSOR_NAME) :: myprocname +!----------------------------------------------------------------------- + + ! Initialize mpi communicator group + + ! mpicom = clm_mpicom + + ! comp_id = LNDID + + ! Get my processor id + + ! call mpi_comm_rank(mpicom, iam, ier) + if (MAPL_Am_I_Root()) then + masterproc = .true. + else + masterproc = .false. + end if + + ! Get number of processors + +! call mpi_comm_size(mpicom, npes, ier) +! +! ! Get my processor names +! +! allocate (length(0:npes-1), displ(0:npes-1), procname(0:npes-1)) +! +! call mpi_get_processor_name (myprocname, mylength, ier) +! call mpi_allgather(mylength,1,MPI_INTEGER,length,1,MPI_INTEGER,mpicom,ier) +! +! do i = 0,npes-1 +! displ(i)=i*MPI_MAX_PROCESSOR_NAME +! end do +! call mpi_gatherv (myprocname,mylength,MPI_CHARACTER, & +! procname,length,displ,MPI_CHARACTER,0,mpicom,ier) +! if (masterproc) then +! write(iulog,100)npes +! write(iulog,200) +! write(iulog,220) +! do i=0,npes-1 +! write(iulog,250)i,(procname((i))(j:j),j=1,length(i)) +! end do +! endif +! +! deallocate (length, displ, procname) +! +!100 format(//,i3," pes participating in computation for CLM") +!200 format(/,35('-')) +!220 format(/,"NODE#",2x,"NAME") +!250 format("(",i5,")",2x,100a1,//) + + end subroutine spmd_init + +end module spmdMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 new file mode 100755 index 000000000..6bac019c1 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 @@ -0,0 +1,1363 @@ +module subgridAveMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Utilities to perfrom subgrid averaging + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg +! use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall +! use column_varcon , only : icol_road_perv , icol_road_imperv +! use clm_varcon , only : grlnd, nameg, namel, namec, namep,spval + use clm_varcon , only : namec, spval + use clm_varctl , only : iulog + use abortutils , only : endrun + use decompMod , only : bounds_type +! use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + private ! By default make everything private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: p2c ! Perform an average patches to columns + public :: p2l ! Perform an average patches to landunits + public :: p2g ! Perform an average patches to gridcells + public :: c2l ! Perform an average columns to landunits + public :: c2g ! Perform an average columns to gridcells + public :: l2g ! Perform an average landunits to gridcells + + interface p2c + module procedure p2c_1d + module procedure p2c_2d + module procedure p2c_1d_filter + module procedure p2c_2d_filter + end interface +! interface p2l +! module procedure p2l_1d +! module procedure p2l_2d +! end interface +! interface p2g +! module procedure p2g_1d +! module procedure p2g_2d +! end interface +! interface c2l +! module procedure c2l_1d +! module procedure c2l_2d +! end interface +! interface c2g +! module procedure c2g_1d +! module procedure c2g_2d +! end interface +! interface l2g +! module procedure l2g_1d +! module procedure l2g_2d +! end interface + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: build_scale_l2g + private :: create_scale_l2g_lookup + + ! Note about the urban scaling types used for c2l_scale_type (urbanf / urbans), from + ! Bill Sacks and Keith Oleson: These names originally meant to distinguish between + ! fluxes and states. However, that isn't the right distinction. In general, urbanf + ! should be used for variables that are expressed as something-per-m^2 ('extensive' + ! state or flux variables), whereas urbans should be used for variables that are not + ! expressed as per-m^2 ('intensive' state variables; an example is temperature). The + ! urbanf scaling converts from per-m^2 of vertical wall area to per-m^2 of ground area. + ! One way to think about this is: In the extreme case of a near-infinite canyon_hwr due + ! to massively tall walls, do you want a near-infinite multiplier for the walls for the + ! variable in question? If so, you want urbanf; if not, you want urbans. + ! + ! However, there may be some special cases, including some hydrology variables that + ! don't apply for urban walls. + + ! WJS (10-14-11): TODO: + ! + ! - I believe that scale_p2c, scale_c2l and scale_l2g should be included in the sumwt + ! accumulations (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but + ! that requires some more thought to (1) make sure that is correct, and (2) make sure it + ! doesn't break the urban scaling. (See also my notes in create_scale_l2g_lookup.) + ! - Once that is done, you could use a scale of 0, avoiding the need for the use of + ! spval and the special checks that requires. + ! + ! - Currently, there is a lot of repeated code to calculate scale_c2l. This should be + ! cleaned up. + ! - At a minimum, should collect the repeated code into a subroutine to eliminate this + ! repitition + ! - The best thing might be to use a lookup array, as is done for scale_l2g + + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + ! ----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine p2c_1d (bounds, parr, carr, p2c_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from patches to columns. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: parr( bounds%begp: ) ! patch array + real(r8), intent(out) :: carr( bounds%begc: ) ! column array + character(len=*), intent(in) :: p2c_scale_type ! scale type + ! + ! !LOCAL VARIABLES: + integer :: p,c,index ! indices + real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor for column->landunit mapping + logical :: found ! temporary for error check + real(r8) :: sumwt(bounds%begc:bounds%endc) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc/)), sourcefile, __LINE__) + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2c_1d error: scale type ',p2c_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + carr(bounds%begc:bounds%endc) = spval + sumwt(bounds%begc:bounds%endc) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtcol(p) /= 0._r8) then + if (parr(p) /= spval) then + c = patch%column(p) + if (sumwt(c) == 0._r8) carr(c) = 0._r8 + carr(c) = carr(c) + parr(p) * scale_p2c(p) * patch%wtcol(p) + sumwt(c) = sumwt(c) + patch%wtcol(p) + end if + end if + end do + found = .false. + do c = bounds%begc,bounds%endc + if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = c + else if (sumwt(c) /= 0._r8) then + carr(c) = carr(c)/sumwt(c) + end if + end do + if (found) then + write(iulog,*)'p2c_1d error: sumwt is greater than 1.0' + call endrun(decomp_index=index, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + end if + + end subroutine p2c_1d + + !----------------------------------------------------------------------- + subroutine p2c_2d (bounds, num2d, parr, carr, p2c_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from landunits to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8) , intent(in) :: parr( bounds%begp: , 1: ) ! patch array + real(r8) , intent(out) :: carr( bounds%begc: , 1: ) ! column array + character(len=*) , intent(in) :: p2c_scale_type ! scale type + ! + ! !LOCAL VARIABLES: + integer :: j,p,c,index ! indices + real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor for column->landunit mapping + logical :: found ! temporary for error check + real(r8) :: sumwt(bounds%begc:bounds%endc) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp, num2d/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc, num2d/)), sourcefile, __LINE__) + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2c_2d error: scale type ',p2c_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + carr(bounds%begc : bounds%endc, :) = spval + do j = 1,num2d + sumwt(bounds%begc : bounds%endc) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtcol(p) /= 0._r8) then + if (parr(p,j) /= spval) then + c = patch%column(p) + if (sumwt(c) == 0._r8) carr(c,j) = 0._r8 + carr(c,j) = carr(c,j) + parr(p,j) * scale_p2c(p) * patch%wtcol(p) + sumwt(c) = sumwt(c) + patch%wtcol(p) + end if + end if + end do + found = .false. + do c = bounds%begc,bounds%endc + if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = c + else if (sumwt(c) /= 0._r8) then + carr(c,j) = carr(c,j)/sumwt(c) + end if + end do + if (found) then + write(iulog,*)'p2c_2d error: sumwt is greater than 1.0 at c= ',index,' lev= ',j + call endrun(decomp_index=index, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + end if + end do + end subroutine p2c_2d + + !----------------------------------------------------------------------- + subroutine p2c_1d_filter (bounds, numfc, filterc, patcharr, colarr) + ! + ! !DESCRIPTION: + ! perform patch to column averaging for single level patch arrays + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: numfc + integer , intent(in) :: filterc(numfc) + real(r8), intent(in) :: patcharr( bounds%begp: ) + real(r8), intent(out) :: colarr( bounds%begc: ) + ! + ! !LOCAL VARIABLES: + integer :: fc,c,p ! indices + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(patcharr) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(colarr) == (/bounds%endc/)), sourcefile, __LINE__) + + do fc = 1,numfc + c = filterc(fc) + colarr(c) = 0._r8 + do p = col%patchi(c), col%patchf(c) + if (patch%active(p)) colarr(c) = colarr(c) + patcharr(p) * patch%wtcol(p) + end do + end do + + end subroutine p2c_1d_filter + + !----------------------------------------------------------------------- + subroutine p2c_2d_filter (lev, numfc, filterc, patcharr, colarr) + ! + ! !DESCRIPTION: + ! perform patch to column averaging for multi level patch arrays + ! + ! !ARGUMENTS: + integer , intent(in) :: lev + integer , intent(in) :: numfc + integer , intent(in) :: filterc(numfc) + real(r8), pointer :: patcharr(:,:) + real(r8), pointer :: colarr(:,:) + ! + ! !LOCAL VARIABLES: + integer :: fc,c,p,j ! indices + !----------------------------------------------------------------------- + + do j = 1,lev + do fc = 1,numfc + c = filterc(fc) + colarr(c,j) = 0._r8 + do p = col%patchi(c), col%patchf(c) + if (patch%active(p)) colarr(c,j) = colarr(c,j) + patcharr(p,j) * patch%wtcol(p) + end do + end do + end do + + end subroutine p2c_2d_filter + +! !----------------------------------------------------------------------- +! subroutine p2l_1d (bounds, parr, larr, p2c_scale_type, c2l_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from patches to landunits +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(in) :: parr( bounds%begp: ) ! input column array +! real(r8), intent(out) :: larr( bounds%begl: ) ! output landunit array +! character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging +! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) +! ! +! ! !LOCAL VARIABLES: +! integer :: p,c,l,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights +! real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor for patch->column mapping +! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(larr) == (/bounds%endl/)), sourcefile, __LINE__) +! +! if (c2l_scale_type == 'unity') then +! do c = bounds%begc,bounds%endc +! scale_c2l(c) = 1.0_r8 +! end do +! else if (c2l_scale_type == 'urbanf') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0_r8 +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else if (c2l_scale_type == 'urbans') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else +! write(iulog,*)'p2l_1d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! if (p2c_scale_type == 'unity') then +! do p = bounds%begp,bounds%endp +! scale_p2c(p) = 1.0_r8 +! end do +! else +! write(iulog,*)'p2l_1d error: scale type ',p2c_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! larr(bounds%begl : bounds%endl) = spval +! sumwt(bounds%begl : bounds%endl) = 0._r8 +! do p = bounds%begp,bounds%endp +! if (patch%active(p) .and. patch%wtlunit(p) /= 0._r8) then +! c = patch%column(p) +! if (parr(p) /= spval .and. scale_c2l(c) /= spval) then +! l = patch%landunit(p) +! if (sumwt(l) == 0._r8) larr(l) = 0._r8 +! larr(l) = larr(l) + parr(p) * scale_p2c(p) * scale_c2l(c) * patch%wtlunit(p) +! sumwt(l) = sumwt(l) + patch%wtlunit(p) +! end if +! end if +! end do +! found = .false. +! do l = bounds%begl,bounds%endl +! if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = l +! else if (sumwt(l) /= 0._r8) then +! larr(l) = larr(l)/sumwt(l) +! end if +! end do +! if (found) then +! write(iulog,*)'p2l_1d error: sumwt is greater than 1.0 at l= ',index +! call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) +! end if +! +! end subroutine p2l_1d +! +! !----------------------------------------------------------------------- +! subroutine p2l_2d(bounds, num2d, parr, larr, p2c_scale_type, c2l_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from patches to landunits +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! integer , intent(in) :: num2d ! size of second dimension +! real(r8), intent(in) :: parr( bounds%begp: , 1: ) ! input patch array +! real(r8), intent(out) :: larr( bounds%begl: , 1: ) ! output gridcell array +! character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging +! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) +! ! +! ! !LOCAL VARIABLES: +! integer :: j,p,c,l,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights +! real(r8) :: scale_p2c(bounds%begc:bounds%endc) ! scale factor for patch->column mapping +! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp, num2d/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(larr) == (/bounds%endl, num2d/)), sourcefile, __LINE__) +! +! if (c2l_scale_type == 'unity') then +! do c = bounds%begc,bounds%endc +! scale_c2l(c) = 1.0_r8 +! end do +! else if (c2l_scale_type == 'urbanf') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0_r8 +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else if (c2l_scale_type == 'urbans') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else +! write(iulog,*)'p2l_2d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! if (p2c_scale_type == 'unity') then +! do p = bounds%begp,bounds%endp +! scale_p2c(p) = 1.0_r8 +! end do +! else +! write(iulog,*)'p2l_2d error: scale type ',p2c_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! larr(bounds%begl : bounds%endl, :) = spval +! do j = 1,num2d +! sumwt(bounds%begl : bounds%endl) = 0._r8 +! do p = bounds%begp,bounds%endp +! if (patch%active(p) .and. patch%wtlunit(p) /= 0._r8) then +! c = patch%column(p) +! if (parr(p,j) /= spval .and. scale_c2l(c) /= spval) then +! l = patch%landunit(p) +! if (sumwt(l) == 0._r8) larr(l,j) = 0._r8 +! larr(l,j) = larr(l,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * patch%wtlunit(p) +! sumwt(l) = sumwt(l) + patch%wtlunit(p) +! end if +! end if +! end do +! found = .false. +! do l = bounds%begl,bounds%endl +! if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = l +! else if (sumwt(l) /= 0._r8) then +! larr(l,j) = larr(l,j)/sumwt(l) +! end if +! end do +! if (found) then +! write(iulog,*)'p2l_2d error: sumwt is greater than 1.0 at l= ',index,' j= ',j +! call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) +! end if +! end do +! +! end subroutine p2l_2d +! +! !----------------------------------------------------------------------- +! subroutine p2g_1d(bounds, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from patches to gridcells. +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(in) :: parr( bounds%begp: ) ! input patch array +! real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array +! character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging +! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) +! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! ! +! ! !LOCAL VARIABLES: +! integer :: p,c,l,g,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor +! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor +! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor +! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg/)), sourcefile, __LINE__) +! +! call build_scale_l2g(bounds, l2g_scale_type, & +! scale_l2g(bounds%begl:bounds%endl)) +! +! if (c2l_scale_type == 'unity') then +! do c = bounds%begc,bounds%endc +! scale_c2l(c) = 1.0_r8 +! end do +! else if (c2l_scale_type == 'urbanf') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0_r8 +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else if (c2l_scale_type == 'urbans') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else +! write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! if (p2c_scale_type == 'unity') then +! do p = bounds%begp,bounds%endp +! scale_p2c(p) = 1.0_r8 +! end do +! else +! write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! garr(bounds%begg : bounds%endg) = spval +! sumwt(bounds%begg : bounds%endg) = 0._r8 +! do p = bounds%begp,bounds%endp +! if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then +! c = patch%column(p) +! l = patch%landunit(p) +! if (parr(p) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then +! g = patch%gridcell(p) +! if (sumwt(g) == 0._r8) garr(g) = 0._r8 +! garr(g) = garr(g) + parr(p) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p) +! sumwt(g) = sumwt(g) + patch%wtgcell(p) +! end if +! end if +! end do +! found = .false. +! do g = bounds%begg, bounds%endg +! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = g +! else if (sumwt(g) /= 0._r8) then +! garr(g) = garr(g)/sumwt(g) +! end if +! end do +! if (found) then +! write(iulog,*)'p2g_1d error: sumwt is greater than 1.0 at g= ',index +! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) +! end if +! +! end subroutine p2g_1d +! +! !----------------------------------------------------------------------- +! subroutine p2g_2d(bounds, num2d, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from patches to gridcells. +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! integer , intent(in) :: num2d ! size of second dimension +! real(r8), intent(in) :: parr( bounds%begp: , 1: ) ! input patch array +! real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array +! character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging +! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) +! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! ! +! ! !LOCAL VARIABLES: +! integer :: j,p,c,l,g,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor +! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor +! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor +! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp, num2d/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg, num2d/)), sourcefile, __LINE__) +! +! call build_scale_l2g(bounds, l2g_scale_type, & +! scale_l2g(bounds%begl:bounds%endl)) +! +! if (c2l_scale_type == 'unity') then +! do c = bounds%begc,bounds%endc +! scale_c2l(c) = 1.0_r8 +! end do +! else if (c2l_scale_type == 'urbanf') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0_r8 +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else if (c2l_scale_type == 'urbans') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else +! write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! if (p2c_scale_type == 'unity') then +! do p = bounds%begp,bounds%endp +! scale_p2c(p) = 1.0_r8 +! end do +! else +! write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! garr(bounds%begg : bounds%endg, :) = spval +! do j = 1,num2d +! sumwt(bounds%begg : bounds%endg) = 0._r8 +! do p = bounds%begp,bounds%endp +! if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then +! c = patch%column(p) +! l = patch%landunit(p) +! if (parr(p,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then +! g = patch%gridcell(p) +! if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 +! garr(g,j) = garr(g,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p) +! sumwt(g) = sumwt(g) + patch%wtgcell(p) +! end if +! end if +! end do +! found = .false. +! do g = bounds%begg, bounds%endg +! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = g +! else if (sumwt(g) /= 0._r8) then +! garr(g,j) = garr(g,j)/sumwt(g) +! end if +! end do +! if (found) then +! write(iulog,*)'p2g_2d error: sumwt gt 1.0 at g/sumwt = ',index,sumwt(index) +! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) +! end if +! end do +! +! end subroutine p2g_2d +! +! !----------------------------------------------------------------------- +! subroutine c2l_1d (bounds, carr, larr, c2l_scale_type, include_inactive) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from columns to landunits +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(in) :: carr( bounds%begc: ) ! input column array +! real(r8), intent(out) :: larr( bounds%begl: ) ! output landunit array +! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) +! +! ! If include_inactive is present and .true., then include inactive as well as active +! ! columns in the averages. The purpose of this is to produce valid landunit-level +! ! output for inactive landunits. This should only be set if carr has no NaN values, +! ! even for inactive columns. +! logical, intent(in), optional :: include_inactive +! +! ! +! ! !LOCAL VARIABLES: +! logical :: l_include_inactive +! integer :: c,l,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping +! real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(larr) == (/bounds%endl/)), sourcefile, __LINE__) +! +! if (present(include_inactive)) then +! l_include_inactive = include_inactive +! else +! l_include_inactive = .false. +! end if +! +! if (c2l_scale_type == 'unity') then +! do c = bounds%begc,bounds%endc +! scale_c2l(c) = 1.0_r8 +! end do +! else if (c2l_scale_type == 'urbanf') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0_r8 +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else if (c2l_scale_type == 'urbans') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else +! write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! larr(bounds%begl : bounds%endl) = spval +! sumwt(bounds%begl : bounds%endl) = 0._r8 +! do c = bounds%begc,bounds%endc +! if ((col%active(c) .or. l_include_inactive) .and. col%wtlunit(c) /= 0._r8) then +! if (carr(c) /= spval .and. scale_c2l(c) /= spval) then +! l = col%landunit(c) +! if (sumwt(l) == 0._r8) larr(l) = 0._r8 +! larr(l) = larr(l) + carr(c) * scale_c2l(c) * col%wtlunit(c) +! sumwt(l) = sumwt(l) + col%wtlunit(c) +! end if +! end if +! end do +! found = .false. +! do l = bounds%begl,bounds%endl +! if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = l +! else if (sumwt(l) /= 0._r8) then +! larr(l) = larr(l)/sumwt(l) +! end if +! end do +! if (found) then +! write(iulog,*)'c2l_1d error: sumwt is greater than 1.0 at l= ',index +! call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) +! end if +! +! end subroutine c2l_1d +! +! !----------------------------------------------------------------------- +! subroutine c2l_2d (bounds, num2d, carr, larr, c2l_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from columns to landunits +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! integer , intent(in) :: num2d ! size of second dimension +! real(r8), intent(in) :: carr( bounds%begc: , 1: ) ! input column array +! real(r8), intent(out) :: larr( bounds%begl: , 1: ) ! output landunit array +! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) +! ! +! ! !LOCAL VARIABLES: +! integer :: j,l,c,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping +! real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc, num2d/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(larr) == (/bounds%endl, num2d/)), sourcefile, __LINE__) +! +! if (c2l_scale_type == 'unity') then +! do c = bounds%begc,bounds%endc +! scale_c2l(c) = 1.0_r8 +! end do +! else if (c2l_scale_type == 'urbanf') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0_r8 +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else if (c2l_scale_type == 'urbans') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else +! write(iulog,*)'c2l_2d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! larr(bounds%begl : bounds%endl, :) = spval +! do j = 1,num2d +! sumwt(bounds%begl : bounds%endl) = 0._r8 +! do c = bounds%begc,bounds%endc +! if (col%active(c) .and. col%wtlunit(c) /= 0._r8) then +! if (carr(c,j) /= spval .and. scale_c2l(c) /= spval) then +! l = col%landunit(c) +! if (sumwt(l) == 0._r8) larr(l,j) = 0._r8 +! larr(l,j) = larr(l,j) + carr(c,j) * scale_c2l(c) * col%wtlunit(c) +! sumwt(l) = sumwt(l) + col%wtlunit(c) +! end if +! end if +! end do +! found = .false. +! do l = bounds%begl,bounds%endl +! if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = l +! else if (sumwt(l) /= 0._r8) then +! larr(l,j) = larr(l,j)/sumwt(l) +! end if +! end do +! if (found) then +! write(iulog,*)'c2l_2d error: sumwt is greater than 1.0 at l= ',index,' lev= ',j +! call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) +! end if +! end do +! +! end subroutine c2l_2d +! +! !----------------------------------------------------------------------- +! subroutine c2g_1d(bounds, carr, garr, c2l_scale_type, l2g_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from columns to gridcells. +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(in) :: carr( bounds%begc: ) ! input column array +! real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array +! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) +! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! ! +! ! !LOCAL VARIABLES: +! integer :: c,l,g,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor +! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor +! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg/)), sourcefile, __LINE__) +! +! call build_scale_l2g(bounds, l2g_scale_type, & +! scale_l2g(bounds%begl:bounds%endl)) +! +! if (c2l_scale_type == 'unity') then +! do c = bounds%begc,bounds%endc +! scale_c2l(c) = 1.0_r8 +! end do +! else if (c2l_scale_type == 'urbanf') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0_r8 +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else if (c2l_scale_type == 'urbans') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else +! write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! garr(bounds%begg : bounds%endg) = spval +! sumwt(bounds%begg : bounds%endg) = 0._r8 +! do c = bounds%begc,bounds%endc +! if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then +! l = col%landunit(c) +! if (carr(c) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then +! g = col%gridcell(c) +! if (sumwt(g) == 0._r8) garr(g) = 0._r8 +! garr(g) = garr(g) + carr(c) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c) +! sumwt(g) = sumwt(g) + col%wtgcell(c) +! end if +! end if +! end do +! found = .false. +! do g = bounds%begg, bounds%endg +! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = g +! else if (sumwt(g) /= 0._r8) then +! garr(g) = garr(g)/sumwt(g) +! end if +! end do +! if (found) then +! write(iulog,*)'c2g_1d error: sumwt is greater than 1.0 at g= ',index +! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) +! end if +! +! end subroutine c2g_1d +! +! !----------------------------------------------------------------------- +! subroutine c2g_2d(bounds, num2d, carr, garr, c2l_scale_type, l2g_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from columns to gridcells. +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! integer , intent(in) :: num2d ! size of second dimension +! real(r8), intent(in) :: carr( bounds%begc: , 1: ) ! input column array +! real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array +! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) +! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! ! +! ! !LOCAL VARIABLES: +! integer :: j,c,g,l,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor +! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor +! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc, num2d/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg, num2d/)), sourcefile, __LINE__) +! +! call build_scale_l2g(bounds, l2g_scale_type, & +! scale_l2g(bounds%begl:bounds%endl)) +! +! if (c2l_scale_type == 'unity') then +! do c = bounds%begc,bounds%endc +! scale_c2l(c) = 1.0_r8 +! end do +! else if (c2l_scale_type == 'urbanf') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0_r8 +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else if (c2l_scale_type == 'urbans') then +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%urbpoi(l)) then +! if (col%itype(c) == icol_sunwall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_shadewall) then +! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then +! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) +! else if (col%itype(c) == icol_roof) then +! scale_c2l(c) = 1.0_r8 +! end if +! else +! scale_c2l(c) = 1.0_r8 +! end if +! end do +! else +! write(iulog,*)'c2g_2d error: scale type ',c2l_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! garr(bounds%begg : bounds%endg,:) = spval +! do j = 1,num2d +! sumwt(bounds%begg : bounds%endg) = 0._r8 +! do c = bounds%begc,bounds%endc +! if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then +! l = col%landunit(c) +! if (carr(c,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then +! g = col%gridcell(c) +! if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 +! garr(g,j) = garr(g,j) + carr(c,j) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c) +! sumwt(g) = sumwt(g) + col%wtgcell(c) +! end if +! end if +! end do +! found = .false. +! do g = bounds%begg, bounds%endg +! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = g +! else if (sumwt(g) /= 0._r8) then +! garr(g,j) = garr(g,j)/sumwt(g) +! end if +! end do +! if (found) then +! write(iulog,*)'c2g_2d error: sumwt is greater than 1.0 at g= ',index +! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) +! end if +! end do +! +! end subroutine c2g_2d +! +! !----------------------------------------------------------------------- +! subroutine l2g_1d(bounds, larr, garr, l2g_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from landunits to gridcells. +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(in) :: larr( bounds%begl: ) ! input landunit array +! real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array +! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! ! +! ! !LOCAL VARIABLES: +! integer :: l,g,index ! indices +! logical :: found ! temporary for error check +! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor +! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(larr) == (/bounds%endl/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg/)), sourcefile, __LINE__) +! +! call build_scale_l2g(bounds, l2g_scale_type, & +! scale_l2g(bounds%begl:bounds%endl)) +! +! garr(bounds%begg : bounds%endg) = spval +! sumwt(bounds%begg : bounds%endg) = 0._r8 +! do l = bounds%begl,bounds%endl +! if (lun%active(l) .and. lun%wtgcell(l) /= 0._r8) then +! if (larr(l) /= spval .and. scale_l2g(l) /= spval) then +! g = lun%gridcell(l) +! if (sumwt(g) == 0._r8) garr(g) = 0._r8 +! garr(g) = garr(g) + larr(l) * scale_l2g(l) * lun%wtgcell(l) +! sumwt(g) = sumwt(g) + lun%wtgcell(l) +! end if +! end if +! end do +! found = .false. +! do g = bounds%begg, bounds%endg +! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index = g +! else if (sumwt(g) /= 0._r8) then +! garr(g) = garr(g)/sumwt(g) +! end if +! end do +! if (found) then +! write(iulog,*)'l2g_1d error: sumwt is greater than 1.0 at g= ',index +! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) +! end if +! +! end subroutine l2g_1d +! +! !----------------------------------------------------------------------- +! subroutine l2g_2d(bounds, num2d, larr, garr, l2g_scale_type) +! ! +! ! !DESCRIPTION: +! ! Perfrom subgrid-average from landunits to gridcells. +! ! Averaging is only done for points that are not equal to "spval". +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! integer , intent(in) :: num2d ! size of second dimension +! real(r8), intent(in) :: larr( bounds%begl: , 1: ) ! input landunit array +! real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array +! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! ! +! ! !LOCAL VARIABLES: +! integer :: j,g,l,index ! indices +! integer :: max_lu_per_gcell ! max landunits per gridcell; on the fly +! logical :: found ! temporary for error check +! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor +! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights +! !------------------------------------------------------------------------ +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(larr) == (/bounds%endl, num2d/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg, num2d/)), sourcefile, __LINE__) +! +! call build_scale_l2g(bounds, l2g_scale_type, & +! scale_l2g(bounds%begl:bounds%endl)) +! +! garr(bounds%begg : bounds%endg, :) = spval +! do j = 1,num2d +! sumwt(bounds%begg : bounds%endg) = 0._r8 +! do l = bounds%begl,bounds%endl +! if (lun%active(l) .and. lun%wtgcell(l) /= 0._r8) then +! if (larr(l,j) /= spval .and. scale_l2g(l) /= spval) then +! g = lun%gridcell(l) +! if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 +! garr(g,j) = garr(g,j) + larr(l,j) * scale_l2g(l) * lun%wtgcell(l) +! sumwt(g) = sumwt(g) + lun%wtgcell(l) +! end if +! end if +! end do +! found = .false. +! do g = bounds%begg,bounds%endg +! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then +! found = .true. +! index= g +! else if (sumwt(g) /= 0._r8) then +! garr(g,j) = garr(g,j)/sumwt(g) +! end if +! end do +! if (found) then +! write(iulog,*)'l2g_2d error: sumwt is greater than 1.0 at g= ',index,' lev= ',j +! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) +! end if +! end do +! +! end subroutine l2g_2d +! +! !----------------------------------------------------------------------- +! subroutine build_scale_l2g(bounds, l2g_scale_type, scale_l2g) +! ! +! ! !DESCRIPTION: +! ! Fill the scale_l2g(bounds%begl:bounds%endl) array with appropriate values for the given l2g_scale_type. +! ! This array can later be used to scale each landunit in forming grid cell averages. +! ! +! ! !USES: +! use landunit_varcon, only : max_lunit +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! real(r8) , intent(out) :: scale_l2g( bounds%begl: ) ! scale factor +! ! +! ! !LOCAL VARIABLES: +! real(r8) :: scale_lookup(max_lunit) ! scale factor for each landunit type +! integer :: l ! index +! !----------------------------------------------------------------------- +! +! SHR_ASSERT_ALL_FL((ubound(scale_l2g) == (/bounds%endl/)), sourcefile, __LINE__) +! +! ! TODO(wjs, 2017-03-09) If this routine is a performance problem (which it may be, +! ! because I think it's called a lot), then a simple optimization would be to treat +! ! l2g_scale_type = 'unity' specially, rather than using the more general-purpose code +! ! for this special case. +! +! call create_scale_l2g_lookup(l2g_scale_type, scale_lookup) +! +! do l = bounds%begl,bounds%endl +! scale_l2g(l) = scale_lookup(lun%itype(l)) +! end do +! +! end subroutine build_scale_l2g +! +! !----------------------------------------------------------------------- +! subroutine create_scale_l2g_lookup(l2g_scale_type, scale_lookup) +! ! +! ! DESCRIPTION: +! ! Create a lookup array, scale_lookup(1..max_lunit), which gives the scale factor for +! ! each landunit type depending on l2g_scale_type +! ! +! ! !USES: +! use landunit_varcon, only : istsoil, istcrop, istice_mec, istdlak +! use landunit_varcon, only : isturb_MIN, isturb_MAX, max_lunit +! ! +! ! !ARGUMENTS: +! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! real(r8) , intent(out) :: scale_lookup(max_lunit) ! scale factor for each landunit type +! !----------------------------------------------------------------------- +! +! ! ------------ WJS (10-14-11): IMPORTANT GENERAL NOTES ------------ +! ! +! ! Since scale_l2g is not currently included in the sumwt accumulations, you need to +! ! be careful about the scale values you use. Values of 1 and spval are safe +! ! (including having multiple landunits with value 1), but only use other values if +! ! you know what you are doing! For example, using a value of 0 is NOT the correct way +! ! to exclude a landunit from the average, because the normalization will be done +! ! incorrectly in this case: instead, use spval to exclude a landunit from the +! ! average. Similarly, using a value of 2 is NOT the correct way to give a landunit +! ! double relative weight in general, because the normalization won't be done +! ! correctly in this case, either. +! ! +! ! In the longer-term, I believe that the correct solution to this problem is to +! ! include scale_l2g (and the other scale factors) in the sumwt accumulations +! ! (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but that +! ! requires some more thought to (1) make sure that is correct, and (2) make sure it +! ! doesn't break the urban scaling. +! ! +! ! ----------------------------------------------------------------- +! +! +! ! Initialize scale_lookup to spval for all landunits. Thus, any landunit that keeps +! ! the default value will be excluded from grid cell averages. +! scale_lookup(:) = spval +! +! if (l2g_scale_type == 'unity') then +! scale_lookup(:) = 1.0_r8 +! else if (l2g_scale_type == 'natveg') then +! scale_lookup(istsoil) = 1.0_r8 +! else if (l2g_scale_type == 'veg') then +! scale_lookup(istsoil) = 1.0_r8 +! scale_lookup(istcrop) = 1.0_r8 +! else if (l2g_scale_type == 'ice') then +! scale_lookup(istice_mec) = 1.0_r8 +! else if (l2g_scale_type == 'nonurb') then +! scale_lookup(:) = 1.0_r8 +! scale_lookup(isturb_MIN:isturb_MAX) = spval +! else if (l2g_scale_type == 'lake') then +! scale_lookup(istdlak) = 1.0_r8 +! else if (l2g_scale_type == 'veg_plus_lake') then +! scale_lookup(istsoil) = 1.0_r8 +! scale_lookup(istcrop) = 1.0_r8 +! scale_lookup(istdlak) = 1.0_r8 +! else +! write(iulog,*)'scale_l2g_lookup_array error: scale type ',l2g_scale_type,' not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! end subroutine create_scale_l2g_lookup + +end module subgridAveMod From 43d1196bd081cc1e18241aae70f96bb2f292278a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 13 Sep 2022 09:36:56 -0400 Subject: [PATCH 003/589] intermediate development update --- .../CLM45/.CN_DriverMod.F90.swp | Bin 16384 -> 0 bytes .../CLM51/.CN_init_mod.F90.swp | Bin 24576 -> 0 bytes .../CLM51/CNCLM_CNFireBaseMod.F90 | 1311 ++++++++++ .../CLM51/CNCLM_CNProductsMod.F90 | 322 +++ .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 11 +- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 6 + .../CLM51/CNCLM_ColumnType.F90 | 16 +- .../CLM51/CNCLM_FireDataBaseType.F90 | 104 + .../CLM51/CNCLM_PatchType.F90 | 6 +- .../CLM51/CNCLM_SaturatedExcessRunoffMod.F90 | 66 + .../CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 2 +- .../CLM51/CNCLM_Wateratm2lndBulkType.F90 | 84 + .../CLM51/CNCLM_Wateratm2lndType.F90 | 69 + .../CLM51/CNCLM_initVerticalMod.F90 | 95 + .../CLM51/CNCLM_pftconMod.F90 | 2 +- .../CLM51/CNCStateUpdate1Mod.F90 | 583 +++++ .../CLM51/CNCStateUpdate2Mod.F90 | 289 +++ .../CLM51/CNFireBaseMod.F90 | 1302 ++++++++++ .../CLM51/CNFireFactoryMod.F90 | 128 + .../CLM51/CNFireLi2014Mod.F90 | 1493 +++++++++++ .../CLM51/CNFireLi2016Mod.F90 | 656 +++++ .../CLM51/CNFireLi2021Mod.F90 | 658 +++++ .../CLM51/CNGRespMod.F90 | 214 ++ .../CLM51/CNGapMortalityMod.F90 | 613 +++++ .../CLM51/CNNStateUpdate1Mod.F90 | 344 +++ .../CLM51/CNNStateUpdate2Mod.F90 | 275 ++ .../CLM51/CNPrecisionControlMod.F90 | 865 +++++++ .../CLM51/CNRootDynMod.F90 | 277 ++ .../CLM51/CN_DriverMod.F90 | 62 +- .../CLM51/CN_init_mod.F90 | 50 +- .../CLM51/FireMethodType.F90 | 233 ++ .../CLM51/SoilBiogeochemLittVertTranspMod.F90 | 551 ++++ .../CLM51/SoilBiogeochemNStateUpdate1Mod.F90 | 272 ++ .../CLM51/TridiagonalMod.F90 | 93 + .../CLM51/clm_time_manager.F90 | 11 + .../CLM51/clm_varcon.F90 | 37 + .../CLM51/clm_varctl.F90 | 10 + .../CLM51/clm_varpar.F90 | 2 +- .../CLM51/dynSubgridControlMod.F90 | 417 ++++ .../CLM51/shr_mpi_mod.F90 | 2217 +++++++++++++++++ .../CLM51/shr_nl_mod.F90 | 134 + .../CLM51/spmdMod.F90 | 71 +- 42 files changed, 13885 insertions(+), 66 deletions(-) delete mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/.CN_DriverMod.F90.swp delete mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/.CN_init_mod.F90.swp create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate1Mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate2Mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireBaseMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGRespMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate1Mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate2Mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPrecisionControlMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNRootDynMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemLittVertTranspMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNStateUpdate1Mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/TridiagonalMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/dynSubgridControlMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/.CN_DriverMod.F90.swp b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/.CN_DriverMod.F90.swp deleted file mode 100644 index 09e6c4e7d0ba9cd0b27b64061e778949e0f3147b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 16384 zcmeHOTZ|<|8E(J}C@8Fo5`okKS!dRo>+XUK*(I|*mmPQK!kn1}HqlO0 z_t`TuJP;FtCTcV>zDP_I6BUgyMt#s1jfp1kf-md~L?1{%VG#wy3o3qpclEjSTo&Ud z^3a`pr>pC$`s=U1s;la+>eCoMwXn!;8$D#;y4o<#z4H0SgZm!2?DCHq#(if(UnGej zYOl-j5<5IA-$U17_?NM9&tFvb?C-7=SUj5JR!9y;7(vd1x`oryhEYcX_2=WZY0yKWU* zS>Ua2fvb#zlM`7_zWJsad*8nGx4z1ihLr^>3se@UEKpgXvOr~l$^w-IDhpgR3#8G9 zjRzp@QZ2FY2rkjj#r+L^P3rhlCH~(f{<9_iUz(rN@jol^|J3~LI{wuX|GMT2H+)1Z zR_ON+&9CTupDgiz*Sx3s@0a+$Y5pF~U#ksL$p5S6*EFw6{A-$TX#STa{x6zuYW^da z<$*%}tD3KC{&OY%70n;i{BKMA%bLGl^Vhs>Q2w7a{~^tfl=wes{sWqyE%7gD{yNQ{ zF7bcVe4$@b;$PJKn9l#L5`SLvw`u;#690nc7c_t6+w(wSzvnf7hvwHy{2w%bLi1lL z@xRynwC0~G@y}`A)cp1D$OA?Bx;cyknzu^4j;?N%1u6?v7N{&xS)j5&Wr4~9l?5sb zR2KNZSwJ|3@j;aS8FFN_!{sq@DT7IkOCYy0Mvke!0YcZjAwvz zz;}WBff?Zaz_V8w#3M%f$MEpm-z)yikf$snwFa^8@C-5gg09*_F0DAzR0A7Y| z$-WO2&f@mgW-OM%KX8aM#|xxNyig4(yEV+2r&6iXAx{mnsVUZpIx^)^;w8KxC6B^5 zO!(PmClDLF;rd~Rr(xO=DXXz0^n8Y(jM;t`iC6>@;ly~eMWxXMPoqiTAaDpc4BT2s zPGu0uSfuS(CT!@$@NROs+6tB2R*}RFAgLq0W-FBr(;soLAoLOv$?PzzHxmhSV_~z< zWp^Jp|I0$+t${+~Fib~Cn~Pjb+UyioDeB>iP1wE9MthlPn{gbm=}Xm2TM*j|4iB1L~>>1L#5 zkhDEy*raz)1uBuco!0rl$IDuy$z?Q<#ax1(frR!lN?6=hc&V8eM80QxDN}jzHCCHm zonK#^U0SPSTaoR2*&WAja%y_JNtWC3!b_8cfkHZ&#zG~1AuA0n6@{VS3P zj(%)%JM=Bri>0M}6u6iD8tqtdn^JK_IXGI!%AdQH+aa*uxZ(;OEy(_p0asCk3ery! zQ|)Bl7kDHbhocc}zL5lYkMy-`4VzBHTTZ}TPx_8!i-`Nm4fvKXJie9CPl_MZ(B{h6Ns+o;<)GuP@@x@L1iV4LcXGpu zx4OZ^&7OVk1QkJIc(_{1XIg`yVPA?-% zZFTn4LVaO*i5*|4uPv|MI|WIMMePO#a9YM-PO(t$lhX?W(TI{8URsXxFs78_@=r6V ztd;d+Cl^e%IJCC>-cPSg;r%rw_!;ja=ych4s}>qKNioD{iSu+b zr`PK1t8+(=n$v6MaZ5jPHgkG@trt1JX51{5^v1j_z9VZ6yHI@v3YaP+@6aO&1JeEYi8D5UR=@QA~!|*pnhF5WQLt$ zDzf7+!lcBR!XifE)`%V7wHzBZjxnDiQVU61ac&}Nqg+sKr26qy%S3Njv(`?`t)Awr z7h%p!->b9Ret=dB(85BAY+0pspnghg5G(Pvpa4Ch9WXd&LAxEt7WIq^Rs~;2Q@ihZ zna2bsaa)=#X`kV2ss9mqbJO=nqV004PqAYXJ*yDF^T$F!zD&upPb-CW#Cq19`?8x$ z{Y1C0x=c?AzfGN_-=^l$X&HxeetSbEmeZkElcbXo(UN#Qx-FTvL65MgYoQ(60a|@9 zTYm=_$Oa6Li*)X-7)M=yUeN44^YHJV27U~D9XJcL zfxCba;2iw?uL7R}ZUUZ#Pk#=068I7DWuOhL0Ly@a4}Ss}0?4Po0Wg3!w9e0x-qlrE zpt3+^fyx4v1u6?v7N{&xwg6l}?e7jQ|FGI6s&6}@=bAHejfwSKS{38!v?R9Xha~p9 z*imc@j1IFbe1yV-Nw6>0O+w)!31khiQ5B}6T}PJS1~6P4jR~LY^i69^4Ye! zPa-uyYjkqsaKw_W+I& z=p&tn{g>QgPDtj$Rb!d|PQtRCckD=nkwFX@Rwt{WO|l*O9^1#)*vi}*HqRZo(a(2N z;D|uF*hq3v?`EDND}V~g5@o)B{zSi?JA_TRgbtNbG~_U>j~h;#ulFgHrBo-^^*KT z2T*5W@QG~454~kuQx+*zgk<>n7@IJLOZa1oupv3Dt$L<@th^m`JotX zFk;gPn>6Uqs0pwIM5G&?vX;(R`!-v92XWY&#X}g;!54NAA(7q(6kNkApCX3#5k>^W f1N$C;UP@3yrX ze$1rL-g{@>uk+41XWsWcXWAOyb=fpKf88bx$GbIc@8f@N-EiN{tDZPV)2_PObM!FO z>C&LXv_r#NvVx5p22p9+SjTUN-7(W`ZCpQ=2p@B;J!4as&dhg=ZgVQI&AQk1`3b#r z#$Q|xZ6nN+g}tDy8&>|Lqq}DQjG;%yV!fd}S>G{z?)vNs|2YO)+qI)+*E82mUN}Cu zY1P%r18;2)^rH6K3r^NHZdlK|@`uhEV(&S1=Udz6%DTz}l?N&hR34~2PLr6@Tt4T#tWN zAC(6x4^$qgJWzR{@<8Q*$^(@LDi2g1s60@4pz^@~zyrFeX^nSi+Nmc(IM)A@{Qs4A zY1&_a2Z1jFJ}?7p1U>*9e5a=U`!>%WR9|QLQw*xx?29V8X0#CvITYHfi_?PR{)m-X8{L}*R*GVUjh#S_W<*N27LcGP1^!Ifg*@ag%H3& z!DBV>Itm;A0v-jv0qDRu@Fof>`+)$s0C*h*l}CVU;=&4J(Xwxi?9n4DFm1i#dSPT6 zt)6prlP-+1^w_+asijI>xv=-EyfK~#}96~Z7Tqmp?etLs~V9`%C0+~Ad|WNtm` zZg8;GqF{5Tmyza#O6D}&C9Bgk^q}RTB}&`DS*9w>z$T5r>sV?jsf;{TPKwj(`fc06 zo#@vNND%~y$7z2_k9LRjZ#a0Io|`Zj9<;av$ho6Hl`#0UUu7UYd6rWpEG@6+n&Chm zum~!QAU3pPrarL)U;aM_6gghUHgu=PJU_BMm%a@?Y&WvpXvB6$skMfCZWAsto9Hk> zga$DB#l)|+7qDp2V%WXImh`~ZTaFdtj2l#@k zJH#XJ6LdfD4Kb*0SpoCfyi0`;Jak!OcIU#_%+3XT;J4lN9ow)Y=6bG0*C*ztc1~Z~ zSeVE74tuS@>qWMUF(LM{QOB;4!8P(l&2Zs+{KY-4Ip|$A>dW{o53*5hXzdXlFu?HK zNXJZzuYO=JVUA~7-eiVLD;zF*Ung+Q8l!J`hJm9OTFh{|O>{0_4`KnBR9t77Z6>!- zi|CVgc>aajOVa{%dGUqX&d$cuT*#|8W*05j!wj`N?U_oWQVp0g%!Gbc5A-eursBBd zqcpjgf{`*HXAZEvu7`$hTJ?r#L@JaTuCl%E=B!uQu4L<@hVRfc zxfcyV(llsLQx6#+XWLYr+nbsz$q~$<-!(xJi>f!~7x55@Z)Khp9f5a&IchPdN|~nT ztT18W{{!n>h&hsL47TWfj*|H-JJr)oqrke23Yt|dvca={Do?kjSfw^zV z+MzF7K_<7}ARz;sR`=YJBx7+?Q9_+ZIwi_kdhnLc=G8UgNN&>UU9$pdod=FeLJ_GI z&H5zzctG^q5M!5w)5c@Na-7nIdSjQ>8E6-$7+?;+K2H&DNqD~XY8rH}z%zSBL|p*$ zC-2&-dzBce7L!*c%vDpSjw+dpsS{Ir(Xq3OUgU+#Zdjt9LAYUU(?hGsGB37lPdF{h z^h#{=*mWLEv_dby<lpcdD<=Hhc*R0R%s4@D2pa)O7E_xDz(>NR; z&6NMoBagj>@>=BoQ~03cd&u$c2DSrr;5p>-2Y}sx4}1hT2Y4EJ{8PZ^fa`z>U@Nd1 z(13@K!~Y1l9{4=44VVB<0!{>;M*jY7zya#O`+?Je_W`dVpZ^)q1ug)7k6iwDz@5My zz;56rvt;pt}8jlH-Qyk_e&tSZ=6h^}o zii)sugt>-ovQbV-a_lxS;oy8y*qepVBcei7;|0T3nyXOJ1!)2)7}X%aazctf59J8c z`Xq6~8o|`hgjUB`*#^qpAjWR9k@CZFlqx}P<{uGmiv%xr4Eco{!mS{Je264cGbQnW zOlg<|DVh3dND?CC<}ip+o47^gv?8WJVIW$xLxz7uXqi-*@kJKe>P5Vsg*+ISlZqI* zpJg{v5L*a`siYvZ2?t5}h)|Y!kgOZ_e9Ij{V%Z(x`VeSaqcwl>vYF=Gr4!q0tl6Ba zH=Clfr4;NEwq`7OMR3gZTDoy{&(GffL)J0IiOHfS$qdI3?RN1-o@muN1Me(dxMAZu z*I2_18bZwmDXs3<*NSpq%8oV%UN>tXRc$TKgNEV=ycz6QCVRsd;5n4+4EzE^B%yZ^jmp zHDrVx#Ip!hUgRS`4u_2Z`DGg=5lYSC77w?qj=x#V0K=Ft{M!1>NeO1Ow#MLT*BUW` zv+;}Sijb9#+qhUGsy3p2!^dl8PQjSNw}r2Y{5PiL`Vr|*%Ytwm_Z*$H-A>aFJnBhQ zaN;$-c-;bBdjlIx$cQlpZt1vimTVT8D<94#yk9 z_Sn%PGp)AXb0U<*oSqf;6_nJ`ozTHN<^^`gMvb1;7v`t4j*fb>=d!r67;|Mk!R#!F z6^QIc$KTSf!AZnpgtsnZMu+tIDCy74NtDb~&|R{c4plYsLQ>5+lH@^Fut8*3xFNi* zg<=@3E4fs9S3PG$H<4PfxGAqYZAoebN+$6`w4j*=L^ew|F~#v^tu|^FTxKF+5S`L9 z1qLyOR}w2xDTVURM?%sy%cQA^onqNCB~eNd>wBf9LR2b+YSxSwtr@RcV-<*(ZbjWX zULnj$i0^E{z4B6G+IVjB;i+25F+z_BmLk;X61N;~ljLx#(3HXrm2~Bs5_@V;AV>NC z`Izk&20VjYpVs+ljsFbbSIF(Z2FwE|0goe>zXhPR`_q6I zkiYK*rhrp`1IXX+0=@&>09+1i0Zs)@0p6fo9(WP>HSjpF54az=9rz~j8K4Pl1-1bH zMt=V$@N?i%;H$t_fUUq5AgKZT6?y+Fz>~mlfW5$Nz;3_?{(;>8@4$7yXMu}>i-6aV z=f4W<2Oa>f0%-mJRn$xV3G4?R01Ti73a=|F{K5dQdNurXiOeS-fgkn2wYkWKClYmOCY$K4bOpgw{!@k?|;n7P@jW zju81Tv{sSY|IN^r)=cY@x1OG&8+df<)Os{@-;tts*NmFv&Z)x%pW>;ZlpFg0bFG z#2u-~FdkKrQ#E}YE!G*GfLvkYT28xY8k{eVcO7m$9sf?FoWh6=o^7fv5 zFG?LClPF~*n|$*8cdl9o`g!OnHape z(3~q2$s~m(Ng$q0=Eyvftx0jOOg{4V3A%W==2VC)a;#3v27VNTe6iQ`_PB{i@fizF zWr>8DYET_4lwre7fCVY+7%R?2bd{FT%A-4PY8<=qO$W49CakeeV3cN>+%Bt}g{e4f zu`014JWTdl<(QiSy`GyCCf67V3T8RG^-r}{TR53!TFg~ZZ%5|Fes>UmP)g@QiRwkS)?k9 z$Yyed?WrAtO6D%y9+jA~+sk4MDV|R6SKLX4Lf|GWY#mQ81!?N%<;mx}QzaT85l6j@rSaC9i%U#lJ$uwwl5zk zguX1+O>`!~>Hto17;S<;AS`Q4!_@w)#3=`}iBdTN?ZXXLnTji>{QqX;w4X-4OZorW zH~~F~oPR&y0>=aQBj^7(@FH^kKLURMZUb6?4txTb0w#frfr|jz13+v44+1{`?f`BD zHUU&0xCNkn{P!dO{}}MX38*&!w4VPgZ~(X)2!UY`Ze9@{GoWu)Vxi@K~_iIJ9j1t(0h W^m0$5dco;PUvNscwqTp3ru_#33q;%i diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 new file mode 100755 index 000000000..d18153367 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -0,0 +1,1311 @@ +module CNFireBaseMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for fire dynamics + ! created in Nov, 2012 and revised in Apr, 2013 by F. Li and S. Levis + ! based on Li et al. (2012a,b; 2013) + ! revised in Apr, 2014 according Li et al.(2014) + ! Fire-related parameters were calibrated or tuned in Apr, 2013 based on the + ! 20th Century transient simulations at f19_g16 with (newfire05_clm45sci15_clm4_0_58) + ! a CLM4.5 version, Qian et al. (2006) atmospheric forcing, and + ! climatological lightning data. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use clm_varpar , only : nlevgrnd + use pftconMod , only : noveg, pftcon + use abortutils , only : endrun + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use CNDVType , only : dgvs_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterStateBulkType , only : waterstatebulk_type + use SoilStateType , only : soilstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + use FireMethodType , only : fire_method_type + use FireDataBaseType , only : fire_base_type + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: cnfire_base_type + + type, public :: cnfire_const_type + ! !PRIVATE MEMBER DATA: + real(r8) :: borealat = 40._r8 ! Latitude for boreal peat fires + real(r8) :: lfuel=75._r8 ! lower threshold of fuel mass (gC/m2) for ignition, Li et al.(2014) + real(r8) :: ufuel=650._r8 ! upper threshold of fuel mass(gC/m2) for ignition + real(r8) :: g0=0.05_r8 ! g(W) when W=0 m/s + real(r8) :: rh_low=30.0_r8 ! Relative humidty low (%) + real(r8) :: rh_hgh=80.0_r8 ! Relative humidty high (%) + real(r8) :: bt_min=0.3_r8 ! btran minimum (fraction) + real(r8) :: bt_max=0.7_r8 ! btran maximum (fraction) + real(r8) :: cli_scale=0.035_r8 ! global constant for deforestation fires (/d) + real(r8) :: boreal_peatfire_c = 4.2e-5_r8 ! c parameter for boreal peatland fire in Li et. al. (2013) (/hr) + real(r8) :: pot_hmn_ign_counts_alpha=0.0035_r8 ! Potential human ignition counts (alpha in Li et. al. 2012) (/person/month) + real(r8) :: non_boreal_peatfire_c = 0.001_r8 ! c parameter for non-boreal peatland fire in Li et. al. (2013) (/hr) + real(r8) :: cropfire_a1 = 0.3_r8 ! a1 parameter for cropland fire in (Li et. al., 2014) (/hr) + real(r8) :: occur_hi_gdp_tree = 0.39_r8 ! fire occurance for high GDP areas that are tree dominated (fraction) + + real(r8) :: cmb_cmplt_fact_litter = 0.5_r8 ! combustion completion factor for litter (unitless) + real(r8) :: cmb_cmplt_fact_cwd = 0.25_r8 ! combustion completion factor for CWD (unitless) + end type + + type, public :: params_type + real(r8) :: prh30 ! Factor related to dependence of fuel combustibility on 30-day running mean of relative humidity (unitless) + real(r8) :: ignition_efficiency ! Ignition efficiency of cloud-to-ground lightning (unitless) + end type params_type + + ! + type, abstract, extends(fire_base_type) :: cnfire_base_type + private + ! !PRIVATE MEMBER DATA: + ! !PUBLIC MEMBER DATA (used by extensions of the base class): + real(r8), public, pointer :: btran2_patch (:) ! patch root zone soil wetness factor (0 to 1) + + contains + ! + ! !PUBLIC MEMBER FUNCTIONS: + procedure, public :: FireInit => CNFireInit ! Initialization of Fire + procedure, public :: FireReadNML ! Read in namelist for CNFire + procedure, public :: CNFireReadParams ! Read in constant parameters from the paramsfile + procedure, public :: CNFireFluxes ! Calculate fire fluxes + procedure, public :: CNFire_calc_fire_root_wetness_Li2014 ! Calculate CN-fire specific root wetness: original version + procedure, public :: CNFire_calc_fire_root_wetness_Li2021 ! Calculate CN-fire specific root wetness: 2021 version + ! !PRIVATE MEMBER FUNCTIONS: + procedure, private :: InitAllocate ! Memory allocation of Fire + procedure, private :: InitHistory ! History file assignment of fire + ! + end type cnfire_base_type + !----------------------------------------------------------------------- + + abstract interface + !----------------------------------------------------------------------- + function need_lightning_and_popdens_interface(this) result(need_lightning_and_popdens) + ! + ! !DESCRIPTION: + ! Returns true if need lightning and popdens, false otherwise + ! + ! USES + import :: cnfire_base_type + ! + ! !ARGUMENTS: + class(cnfire_base_type), intent(in) :: this + logical :: need_lightning_and_popdens ! function result + !----------------------------------------------------------------------- + end function need_lightning_and_popdens_interface + end interface + + type(cnfire_const_type), public, protected :: cnfire_const ! Fire constants shared by Li versons + type(params_type) , public, protected :: cnfire_params ! Fire parameters shared by Li versions + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine CNFireInit( this, bounds, NLFilename ) + ! + ! !DESCRIPTION: + ! Initialize CN Fire module + ! !ARGUMENTS: + class(cnfire_base_type) :: this + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename + !----------------------------------------------------------------------- + ! Call the base-class Initialization method + call this%BaseFireInit( bounds, NLFilename ) + + ! Allocate memory + call this%InitAllocate( bounds ) + ! History file + call this%InitHistory( bounds ) + end subroutine CNFireInit + !---------------------------------------------------------------------- + + subroutine InitAllocate( this, bounds ) + ! + ! Initiaze memory allocate's + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(cnfire_base_type) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + integer :: begp, endp + !------------------------------------------------------------------------ + begp = bounds%begp; endp= bounds%endp + + allocate(this%btran2_patch (begp:endp)) ; this%btran2_patch (:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory( this, bounds ) + ! + ! Initailizae history variables + use clm_varcon , only : spval + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + class(cnfire_base_type) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + integer :: begp, endp + !------------------------------------------------------------------------ + begp = bounds%begp; endp= bounds%endp + this%btran2_patch(begp:endp) = spval + call hist_addfld1d(fname='BTRAN2', units='unitless', & + avgflag='A', long_name='root zone soil wetness factor', & + ptr_patch=this%btran2_patch, l2g_scale_type='veg') + end subroutine InitHistory + + !---------------------------------------------------------------------- + subroutine CNFire_calc_fire_root_wetness_Li2014( this, bounds, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve ) + ! + ! Calculate the root wetness term that will be used by the fire model + ! + class(cnfire_base_type) :: this + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: num_exposedvegp !number of filters + integer , intent(in) :: filter_exposedvegp(:) !filter array + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(waterstatebulk_type), intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! !LOCAL VARIABLES: + real(r8) :: smp_node, s_node !temporary variables + real(r8) :: smp_node_lf !temporary variable + integer :: p, fp, j, c, l !indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(filter_exposedvegp) >= (/num_exposedvegp/)), sourcefile, __LINE__) + + associate( & + smpso => pftcon%smpso , & ! Input: soil water potential at full stomatal opening (mm) + smpsc => pftcon%smpsc , & ! Input: soil water potential at full stomatal closure (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation + btran2 => this%btran2_patch , & ! Output: [real(r8) (:) ] integrated soil water stress square + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer + h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (porosity) (constant) + ) + + do fp = 1, num_noexposedvegp + p = filter_noexposedvegp(fp) + ! Set for the sake of history diagnostics. The "normal" btran is set to 0 over + ! this filter, so we do the same for btran2. + btran2(p) = 0._r8 + end do + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + btran2(p) = 0._r8 + end do + do j = 1,nlevgrnd + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + c = patch%column(p) + l = patch%landunit(p) + s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) + + call soil_water_retention_curve%soil_suction(c, j, s_node, soilstate_inst, smp_node_lf) + + smp_node_lf = max(smpsc(patch%itype(p)), smp_node_lf) + btran2(p) = btran2(p) +rootfr(p,j)*max(0._r8,min((smp_node_lf - smpsc(patch%itype(p))) / & + (smpso(patch%itype(p)) - smpsc(patch%itype(p))), 1._r8)) + end do + end do + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + if (btran2(p) > 1._r8) then + btran2(p) = 1._r8 + end if + end do + + end associate + + end subroutine CNFire_calc_fire_root_wetness_Li2014 + + !---------------------------------------------------------------------- + subroutine CNFire_calc_fire_root_wetness_Li2021( this, bounds, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve ) + ! + ! Calculate the root wetness term that will be used by the fire model + ! + use pftconMod , only : pftcon + use PatchType , only : patch + class(cnfire_base_type) :: this + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: num_exposedvegp !number of filters + integer , intent(in) :: filter_exposedvegp(:) !filter array + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(waterstatebulk_type), intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! !LOCAL VARIABLES: + real(r8) :: s_node !temporary variables + integer :: p, fp, j, c !indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(filter_exposedvegp) >= (/num_exposedvegp/)), sourcefile, __LINE__) + + associate( & + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation + btran2 => this%btran2_patch , & ! Output: [real(r8) (:) ] integrated soil water stress square + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer + h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (porosity) (constant) + ) + + do fp = 1, num_noexposedvegp + p = filter_noexposedvegp(fp) + ! Set for the sake of history diagnostics. The "normal" btran is set to 0 over + ! this filter, so we do the same for btran2. + btran2(p) = 0._r8 + end do + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + btran2(p) = 0._r8 + end do + do j = 1,nlevgrnd + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + c = patch%column(p) + s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) + + btran2(p) = btran2(p) + rootfr(p,j)*s_node + end do + end do + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + if (btran2(p) > 1._r8) then + btran2(p) = 1._r8 + end if + end do + + end associate + + end subroutine CNFire_calc_fire_root_wetness_Li2021 + !---------------------------------------------------------------------- + + !---------------------------------------------------------------------- + subroutine FireReadNML( this, NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for CNFire + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + class(cnfire_base_type) :: this + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'FireReadNML' + character(len=*), parameter :: nmlname = 'lifire_inparm' + !----------------------------------------------------------------------- + real(r8) :: cli_scale, boreal_peatfire_c, pot_hmn_ign_counts_alpha + real(r8) :: non_boreal_peatfire_c, cropfire_a1 + real(r8) :: rh_low, rh_hgh, bt_min, bt_max, occur_hi_gdp_tree + real(r8) :: lfuel, ufuel, cmb_cmplt_fact_litter, cmb_cmplt_fact_cwd + + namelist /lifire_inparm/ cli_scale, boreal_peatfire_c, pot_hmn_ign_counts_alpha, & + non_boreal_peatfire_c, cropfire_a1, & + rh_low, rh_hgh, bt_min, bt_max, occur_hi_gdp_tree, & + lfuel, ufuel, cmb_cmplt_fact_litter, cmb_cmplt_fact_cwd + + if ( this%need_lightning_and_popdens() ) then + cli_scale = cnfire_const%cli_scale + boreal_peatfire_c = cnfire_const%boreal_peatfire_c + non_boreal_peatfire_c = cnfire_const%non_boreal_peatfire_c + pot_hmn_ign_counts_alpha = cnfire_const%pot_hmn_ign_counts_alpha + cropfire_a1 = cnfire_const%cropfire_a1 + rh_low = cnfire_const%rh_low + rh_hgh = cnfire_const%rh_hgh + lfuel = cnfire_const%lfuel + ufuel = cnfire_const%ufuel + bt_min = cnfire_const%bt_min + bt_max = cnfire_const%bt_max + occur_hi_gdp_tree = cnfire_const%occur_hi_gdp_tree + cmb_cmplt_fact_litter = cnfire_const%cmb_cmplt_fact_litter + cmb_cmplt_fact_cwd = cnfire_const%cmb_cmplt_fact_cwd + ! Initialize options to default values, in case they are not specified in + ! the namelist + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=lifire_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (cli_scale , mpicom) + call shr_mpi_bcast (boreal_peatfire_c , mpicom) + call shr_mpi_bcast (pot_hmn_ign_counts_alpha, mpicom) + call shr_mpi_bcast (non_boreal_peatfire_c , mpicom) + call shr_mpi_bcast (cropfire_a1 , mpicom) + call shr_mpi_bcast (rh_low , mpicom) + call shr_mpi_bcast (rh_hgh , mpicom) + call shr_mpi_bcast (lfuel , mpicom) + call shr_mpi_bcast (ufuel , mpicom) + call shr_mpi_bcast (bt_min , mpicom) + call shr_mpi_bcast (bt_max , mpicom) + call shr_mpi_bcast (occur_hi_gdp_tree , mpicom) + call shr_mpi_bcast (cmb_cmplt_fact_litter , mpicom) + call shr_mpi_bcast (cmb_cmplt_fact_cwd , mpicom) + + cnfire_const%cli_scale = cli_scale + cnfire_const%boreal_peatfire_c = boreal_peatfire_c + cnfire_const%non_boreal_peatfire_c = non_boreal_peatfire_c + cnfire_const%pot_hmn_ign_counts_alpha = pot_hmn_ign_counts_alpha + cnfire_const%cropfire_a1 = cropfire_a1 + cnfire_const%rh_low = rh_low + cnfire_const%rh_hgh = rh_hgh + cnfire_const%lfuel = lfuel + cnfire_const%ufuel = ufuel + cnfire_const%bt_min = bt_min + cnfire_const%bt_max = bt_max + cnfire_const%occur_hi_gdp_tree = occur_hi_gdp_tree + cnfire_const%cmb_cmplt_fact_litter = cmb_cmplt_fact_litter + cnfire_const%cmb_cmplt_fact_cwd = cmb_cmplt_fact_cwd + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=lifire_inparm) + write(iulog,*) ' ' + end if + end if + + end subroutine FireReadNML + + !----------------------------------------------------------------------- + subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & + dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, & + leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch, & + totsomc_col, decomp_cpools_vr_col, decomp_npools_vr_col, somc_fire_col) + ! + ! !DESCRIPTION: + ! Fire effects routine for coupled carbon-nitrogen code (CN). + ! Relies primarily on estimate of fractional area burned, from CNFireArea(). + ! + ! Total fire carbon emissions (g C/m2 land area/yr) + ! =avg(COL_FIRE_CLOSS)*seconds_per_year + avg(SOMC_FIRE)*seconds_per_year + + ! avg(LF_CONV_CFLUX)*seconds_per_year*min(1.0,avg(LFC2)*seconds_per_year)*0.8 + ! where avg means the temporal average in a year + ! seconds_per_year is the number of seconds in a year. + ! + ! !USES: + use clm_time_manager , only: get_step_size_real,get_days_per_year,get_curr_date + use clm_varctl , only: use_cndv, use_soil_matrixcn, use_matrixcn + use clm_varcon , only: secspday + use pftconMod , only: nc3crop + use dynSubgridControlMod , only: run_has_transient_landcover + use clm_varpar , only: nlevdecomp_full, ndecomp_pools, nlevdecomp + use clm_varpar , only: ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,iretransn,ioutc,ioutn + use CNVegMatrixMod , only: matrix_update_fic, matrix_update_fin + ! + ! !ARGUMENTS: + class(cnfire_base_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(out) :: num_actfirep ! number of active patches on fire in filter + integer , intent(out) :: filter_actfirep(:) ! filter for soil patches + integer , intent(out) :: num_actfirec ! number of active columns on fire in filter + integer , intent(out) :: filter_actfirec(:) ! filter for soil columns + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst ! only for matrix_decomp_fire_k: (gC/m3/step) VR deomp. C fire loss in matrix representation + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: totsomc_col(bounds%begc:) ! (gC/m2) total soil organic matter C + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(in) :: decomp_npools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(out) :: somc_fire_col(bounds%begc:) ! (gC/m2/s) fire C emissions due to peat burning + ! + ! !LOCAL VARIABLES: + integer :: g,c,p,j,l,kyr, kmo, kda, mcsec ! indices + integer :: fp,fc ! filter indices + real(r8):: f ! rate for fire effects (1/s) + real(r8):: m ! acceleration factor for fuel carbon + real(r8):: dt ! time step variable (s) + real(r8):: dayspyr ! days per year + logical :: transient_landcover ! whether this run has any prescribed transient landcover + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(totsomc_col) == (/bounds%endc/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_npools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(somc_fire_col) == (/bounds%endc/)) , sourcefile, __LINE__) + + ! NOTE: VR = Vertically Resolved + ! conv. = conversion + ! frac. = fraction + ! BAF = Burned Area Fraction + ! ann. = annual + ! GC = gridcell + ! dt = timestep + ! C = Carbon + ! N = Nitrogen + ! emis. = emissions + ! decomp. = decomposing + + associate( & + croot_prof => croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + totsomc => totsomc_col , & ! Input: [real(r8) (:) ] (gC/m2) total soil organic matter C + decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + decomp_npools_vr => decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + somc_fire => somc_fire_col , & ! Output: [real(r8) (:) ] (gC/m2/s) fire C emissions due to peat burning + + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + is_litter => decomp_cascade_con%is_litter , & ! Input: [logical (:) ] TRUE => pool is a litter pool + + woody => pftcon%woody , & ! Input: woody lifeform (1=woody, 0=not woody) + cc_leaf => pftcon%cc_leaf , & ! Input: + cc_lstem => pftcon%cc_lstem , & ! Input: + cc_dstem => pftcon%cc_dstem , & ! Input: + cc_other => pftcon%cc_other , & ! Input: + fm_leaf => pftcon%fm_leaf , & ! Input: + fm_lstem => pftcon%fm_lstem , & ! Input: + fm_other => pftcon%fm_other , & ! Input: + fm_root => pftcon%fm_root , & ! Input: + fm_lroot => pftcon%fm_lroot , & ! Input: + fm_droot => pftcon%fm_droot , & ! Input: + lf_flab => pftcon%lf_flab , & ! Input: + lf_fcel => pftcon%lf_fcel , & ! Input: + lf_flig => pftcon%lf_flig , & ! Input: + fr_flab => pftcon%fr_flab , & ! Input: + fr_fcel => pftcon%fr_fcel , & ! Input: + fr_flig => pftcon%fr_flig , & ! Input: + + cmb_cmplt_fact_litter => cnfire_const%cmb_cmplt_fact_litter , & ! Input: [real(r8) (:) ] Combustion completion factor for litter (unitless) + cmb_cmplt_fact_cwd => cnfire_const%cmb_cmplt_fact_cwd , & ! Input: [real(r8) (:) ] Combustion completion factor for CWD (unitless) + + nind => dgvs_inst%nind_patch , & ! Input: [real(r8) (:) ] number of individuals (#/m2) + + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] fractional area burned (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Input: [real(r8) (:) ] burned area out of conv. region due to LU fire + fbac => cnveg_state_inst%fbac_col , & ! Input: [real(r8) (:) ] total burned area out of conversion (/sec) + baf_crop => cnveg_state_inst%baf_crop_col , & ! Input: [real(r8) (:) ] BAF for cropland + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Input: [real(r8) (:) ] BAF for peatlabd + trotr1_col => cnveg_state_inst%trotr1_col , & ! Input: [real(r8) (:) ] patch weight of BET on the column (0-1) + trotr2_col => cnveg_state_inst%trotr2_col , & ! Input: [real(r8) (:) ] patch weight of BDT on the column (0-1) + dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Input: [real(r8) (:) ] ann. decreased frac. coverage of BET+BDT (0-1) on GC + lfc => cnveg_state_inst%lfc_col , & ! Input: [real(r8) (:) ] conv. area frac. of BET+BDT that haven't burned before + lfc2 => cnveg_state_inst%lfc2_col , & ! Output: [real(r8) (:) ] conv. area frac. of BET+BDT burned this dt (/sec) + + leafcmax => cnveg_carbonstate_inst%leafcmax_patch , & ! Output: [real(r8) (:) ] (gC/m2) ann max leaf C + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C transfer + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + gresp_xfer => cnveg_carbonstate_inst%gresp_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration transfer + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N transfer + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn => cnveg_nitrogenstate_inst%deadstemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N transfer + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn => cnveg_nitrogenstate_inst%deadcrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + fire_mortality_c_to_cwdc => cnveg_carbonflux_inst%fire_mortality_c_to_cwdc_col , & ! Input: [real(r8) (:,:) ] C flux fire mortality to CWD (gC/m3/s) + m_leafc_to_fire => cnveg_carbonflux_inst%m_leafc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc + m_leafc_storage_to_fire => cnveg_carbonflux_inst%m_leafc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_storage + m_leafc_xfer_to_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_xfer + m_livestemc_to_fire => cnveg_carbonflux_inst%m_livestemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from livestemc + m_livestemc_storage_to_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_storage + m_livestemc_xfer_to_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_xfer + m_deadstemc_to_fire => cnveg_carbonflux_inst%m_deadstemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer + m_deadstemc_storage_to_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_storage + m_deadstemc_xfer_to_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer + m_frootc_to_fire => cnveg_carbonflux_inst%m_frootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc + m_frootc_storage_to_fire => cnveg_carbonflux_inst%m_frootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_storage + m_frootc_xfer_to_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_xfer + m_livecrootc_to_fire => cnveg_carbonflux_inst%m_livecrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc + m_livecrootc_storage_to_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_storage + m_livecrootc_xfer_to_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_xfer + m_deadcrootc_to_fire => cnveg_carbonflux_inst%m_deadcrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc + m_deadcrootc_storage_to_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_storage + m_deadcrootc_xfer_to_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_xfer + m_gresp_storage_to_fire => cnveg_carbonflux_inst%m_gresp_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_storage + m_gresp_xfer_to_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_xfer + m_leafc_to_litter_fire => cnveg_carbonflux_inst%m_leafc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafc_storage_to_litter_fire => cnveg_carbonflux_inst%m_leafc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_to_deadstemc_fire => cnveg_carbonflux_inst%m_livestemc_to_deadstemc_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_to_litter_fire => cnveg_carbonflux_inst%m_frootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_frootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_to_deadcrootc_fire => cnveg_carbonflux_inst%m_livecrootc_to_deadcrootc_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_gresp_storage_to_litter_fire => cnveg_carbonflux_inst%m_gresp_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_gresp_xfer_to_litter_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_decomp_cpools_to_fire_vr => cnveg_carbonflux_inst%m_decomp_cpools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] (gC/m3/s) VR decomp. C fire loss + m_c_to_litr_met_fire => cnveg_carbonflux_inst%m_c_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] + m_c_to_litr_cel_fire => cnveg_carbonflux_inst%m_c_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] + m_c_to_litr_lig_fire => cnveg_carbonflux_inst%m_c_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] + + fire_mortality_n_to_cwdn => cnveg_nitrogenflux_inst%fire_mortality_n_to_cwdn_col , & ! Input: [real(r8) (:,:) ] N flux fire mortality to CWD (gN/m3/s) + m_leafn_to_fire => cnveg_nitrogenflux_inst%m_leafn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn + m_leafn_storage_to_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_storage + m_leafn_xfer_to_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_xfer + m_livestemn_to_fire => cnveg_nitrogenflux_inst%m_livestemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn + m_livestemn_storage_to_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_s + m_livestemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_xfer + m_deadstemn_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn + m_deadstemn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_storage + m_deadstemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_xfer + m_frootn_to_fire => cnveg_nitrogenflux_inst%m_frootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn + m_frootn_storage_to_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_storage + m_frootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_xfer + m_livecrootn_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. m_livecrootn_to_fire + m_livecrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_storage + m_livecrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_xfer + m_deadcrootn_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn + m_deadcrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_storage + m_deadcrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_xfer + m_retransn_to_fire => cnveg_nitrogenflux_inst%m_retransn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. retransn + m_leafn_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_to_deadstemn_fire => cnveg_nitrogenflux_inst%m_livestemn_to_deadstemn_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_to_deadcrootn_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_deadcrootn_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_retransn_to_litter_fire => cnveg_nitrogenflux_inst%m_retransn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_decomp_npools_to_fire_vr => cnveg_nitrogenflux_inst%m_decomp_npools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] VR decomp. N fire loss (gN/m3/s) + m_n_to_litr_met_fire => cnveg_nitrogenflux_inst%m_n_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] + m_n_to_litr_cel_fire => cnveg_nitrogenflux_inst%m_n_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] + m_n_to_litr_lig_fire => cnveg_nitrogenflux_inst%m_n_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] + ileaf_to_iout_fic => cnveg_carbonflux_inst%ileaf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_fic => cnveg_carbonflux_inst%ileafst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_fic => cnveg_carbonflux_inst%ileafxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_fic => cnveg_carbonflux_inst%ifroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_fic => cnveg_carbonflux_inst%ifrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_fic => cnveg_carbonflux_inst%ifrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root transfer pool to outside of vegetation pools + ilivestem_to_iout_fic => cnveg_carbonflux_inst%ilivestem_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_fic => cnveg_carbonflux_inst%ilivestemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_fic => cnveg_carbonflux_inst%ilivestemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_fic => cnveg_carbonflux_inst%ideadstem_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_fic => cnveg_carbonflux_inst%ideadstemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_fic => cnveg_carbonflux_inst%ideadstemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_fic => cnveg_carbonflux_inst%ilivecroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_fic => cnveg_carbonflux_inst%ilivecrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_fic => cnveg_carbonflux_inst%ilivecrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_fic => cnveg_carbonflux_inst%ideadcroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_fic => cnveg_carbonflux_inst%ideadcrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_fic => cnveg_carbonflux_inst%ideadcrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root transfer pool to outside of vegetation pools + ilivestem_to_ideadstem_fic => cnveg_carbonflux_inst%ilivestem_to_ideadstem_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_fic => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to dead coarse root pool + ileaf_to_iout_fin => cnveg_nitrogenflux_inst%ileaf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_fin => cnveg_nitrogenflux_inst%ileafst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_fin => cnveg_nitrogenflux_inst%ileafxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_fin => cnveg_nitrogenflux_inst%ifroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_fin => cnveg_nitrogenflux_inst%ifrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ifrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine transfer pool to outside of vegetation pools + ilivestem_to_iout_fin => cnveg_nitrogenflux_inst%ilivestem_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_fin => cnveg_nitrogenflux_inst%ideadstem_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_fin => cnveg_nitrogenflux_inst%ilivecroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_fin => cnveg_nitrogenflux_inst%ideadcroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root transfer pool to outside of vegetation pools + ilivestem_to_ideadstem_fin => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem to dead stem pool + ilivecroot_to_ideadcroot_fin => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to dead coarse root pool + iretransn_to_iout_fin => cnveg_nitrogenflux_inst%iretransn_to_iout_fi & ! Input: [integer (:)] Index of fire related N transfer from retranslocated N pool to outside of vegetation pools + ) + + transient_landcover = run_has_transient_landcover() + + ! Get model step size + ! calculate burned area fraction per sec + dt = get_step_size_real() + + dayspyr = get_days_per_year() + ! + ! patch loop + ! + num_actfirep = 0 + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8)then + ! For non-crop (bare-soil and natural vegetation) + if (transient_landcover) then + f = (fbac(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) + else + f = (farea_burned(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) + end if + else + ! For crops + if(cropf_col(c) > 0._r8)then + f = baf_crop(c) /cropf_col(c) + else + f = 0._r8 + end if + end if + + ! apply this rate to the patch state variables to get flux rates + ! biomass burning + ! carbon fluxes + m = spinup_factor_deadwood + + if(f /= 0)then + num_actfirep = num_actfirep + 1 + filter_actfirep(num_actfirep) = p + end if + m_gresp_storage_to_fire(p) = gresp_storage(p) * f * cc_other(patch%itype(p)) + m_gresp_xfer_to_fire(p) = gresp_xfer(p) * f * cc_other(patch%itype(p)) + if ( .not. use_matrixcn )then + ! NOTE: The non matrix version of this is in CNCStateUpdate3::CStateUpdate3 EBK (11/26/2019) + ! and CNNStateUpdate3::NStateUpdate3 + m_leafc_to_fire(p) = leafc(p) * f * cc_leaf(patch%itype(p)) + m_leafc_storage_to_fire(p) = leafc_storage(p) * f * cc_other(patch%itype(p)) + m_leafc_xfer_to_fire(p) = leafc_xfer(p) * f * cc_other(patch%itype(p)) + m_livestemc_to_fire(p) = livestemc(p) * f * cc_lstem(patch%itype(p)) + m_livestemc_storage_to_fire(p) = livestemc_storage(p) * f * cc_other(patch%itype(p)) + m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * f * cc_other(patch%itype(p)) + m_deadstemc_to_fire(p) = deadstemc(p) * f * cc_dstem(patch%itype(p)) * m + m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * f * cc_other(patch%itype(p)) + m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * f * cc_other(patch%itype(p)) + m_frootc_to_fire(p) = frootc(p) * f * 0._r8 + m_frootc_storage_to_fire(p) = frootc_storage(p) * f * cc_other(patch%itype(p)) + m_frootc_xfer_to_fire(p) = frootc_xfer(p) * f * cc_other(patch%itype(p)) + m_livecrootc_to_fire(p) = livecrootc(p) * f * 0._r8 + m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * f * cc_other(patch%itype(p)) + m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootc_to_fire(p) = deadcrootc(p) * f * 0._r8 + m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * f* cc_other(patch%itype(p)) + m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * f * cc_other(patch%itype(p)) + + + ! nitrogen fluxes + m_leafn_to_fire(p) = leafn(p) * f * cc_leaf(patch%itype(p)) + m_leafn_storage_to_fire(p) = leafn_storage(p) * f * cc_other(patch%itype(p)) + m_leafn_xfer_to_fire(p) = leafn_xfer(p) * f * cc_other(patch%itype(p)) + m_livestemn_to_fire(p) = livestemn(p) * f * cc_lstem(patch%itype(p)) + m_livestemn_storage_to_fire(p) = livestemn_storage(p) * f * cc_other(patch%itype(p)) + m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadstemn_to_fire(p) = deadstemn(p) * f * cc_dstem(patch%itype(p)) * m + m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * f * cc_other(patch%itype(p)) + m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * f * cc_other(patch%itype(p)) + m_frootn_to_fire(p) = frootn(p) * f * 0._r8 + m_frootn_storage_to_fire(p) = frootn_storage(p) * f * cc_other(patch%itype(p)) + m_frootn_xfer_to_fire(p) = frootn_xfer(p) * f * cc_other(patch%itype(p)) + m_livecrootn_to_fire(p) = livecrootn(p) * f * 0._r8 + m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * f * cc_other(patch%itype(p)) + m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootn_to_fire(p) = deadcrootn(p) * f * 0._r8 + m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * f * cc_other(patch%itype(p)) + m_retransn_to_fire(p) = retransn(p) * f * cc_other(patch%itype(p)) + + else + m_leafc_to_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_storage_to_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_xfer_to_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_storage_to_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_to_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_to_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_storage_to_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_xfer_to_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_to_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + + m_leafn_to_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_storage_to_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_xfer_to_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_storage_to_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_to_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_to_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_storage_to_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_xfer_to_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_to_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_retransn_to_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + end if + ! mortality due to fire + ! carbon pools + if ( .not. use_matrixcn )then + ! NOTE: The non matrix version of this is in CNCStateUpdate3::CStateUpdate3 EBK (11/26/2019) + ! and CNNStateUpdate3::NStateUpdate3 + m_leafc_to_litter_fire(p) = leafc(p) * f * & + (1._r8 - cc_leaf(patch%itype(p))) * & + fm_leaf(patch%itype(p)) + m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livestemc_to_litter_fire(p) = livestemc(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent the fraction of plant-tissue mortality for deadstem/deadcroot + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 + m_livestemc_to_deadstemc_fire(p) = livestemc(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from deadstem/deadcroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_deadstemc_to_litter_fire(p) = deadstemc(p) * f * m * & + (1._r8 - cc_dstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootc_to_litter_fire(p) = frootc(p) * f * & + fm_root(patch%itype(p)) + m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livecrootc_to_litter_fire(p) = livecrootc(p) * f * & + fm_droot(patch%itype(p)) + m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * f * & + (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * f * m * & + fm_droot(patch%itype(p)) + m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_gresp_storage_to_litter_fire(p) = gresp_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_gresp_xfer_to_litter_fire(p) = gresp_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + + + ! nitrogen pools + m_leafn_to_litter_fire(p) = leafn(p) * f * & + (1._r8 - cc_leaf(patch%itype(p))) * & + fm_leaf(patch%itype(p)) + m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livestemn_to_litter_fire(p) = livestemn(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent the fraction of plant-tissue mortality for deadstem/deadcroot + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 + m_livestemn_to_deadstemn_fire(p) = livestemn(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from deadstem/deadcroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_deadstemn_to_litter_fire(p) = deadstemn(p) * f * m * & + (1._r8 - cc_dstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootn_to_litter_fire(p) = frootn(p) * f * & + fm_root(patch%itype(p)) + m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livecrootn_to_litter_fire(p) = livecrootn(p) * f * & + fm_droot(patch%itype(p)) + m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * f * & + (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * f * m * & + fm_droot(patch%itype(p)) + m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_retransn_to_litter_fire(p) = retransn(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + + else + m_leafc_to_litter_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic, & + f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_litter_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic, & + f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_deadstemc_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_ideadstem_fic,& + f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_to_litter_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic, & + f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_to_litter_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic, & + f * fm_root(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_litter_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic, & + f * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_ideadcroot_fic,& + f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic, & + f * m * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + + m_leafn_to_litter_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin, & + f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_litter_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin, & + f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_deadstemn_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_ideadstem_fin,& + f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_to_litter_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin, & + f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_to_litter_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin, & + f * fm_root(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_litter_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin, & + f * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_ideadcroot_fin,& + f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin, & + f * m * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + end if + + if (use_cndv) then + if ( woody(patch%itype(p)) == 1._r8 )then + if ( livestemc(p)+deadstemc(p) > 0._r8 )then + nind(p) = nind(p)*(1._r8-1._r8*fm_droot(patch%itype(p))*f) + else + nind(p) = 0._r8 + end if + end if + leafcmax(p) = max(leafc(p)-m_leafc_to_fire(p)*dt, leafcmax(p)) + if (patch%itype(p) == noveg) leafcmax(p) = 0._r8 + end if + + end do ! end of patches loop + + ! fire-induced transfer of carbon and nitrogen pools to litter and cwd + + do j = 1,nlevdecomp + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_deadstemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_deadcrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_deadstemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_deadcrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + + + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_livestemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_livecrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_livestemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_livecrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + + + m_c_to_litr_met_fire(c,j)=m_c_to_litr_met_fire(c,j) + & + ((m_leafc_to_litter_fire(p)*lf_flab(patch%itype(p)) & + +m_leafc_storage_to_litter_fire(p) + & + m_leafc_xfer_to_litter_fire(p) + & + m_gresp_storage_to_litter_fire(p) & + +m_gresp_xfer_to_litter_fire(p))*leaf_prof(p,j) + & + (m_frootc_to_litter_fire(p)*fr_flab(patch%itype(p)) & + +m_frootc_storage_to_litter_fire(p) + & + m_frootc_xfer_to_litter_fire(p))*froot_prof(p,j) & + +(m_livestemc_storage_to_litter_fire(p) + & + m_livestemc_xfer_to_litter_fire(p) & + +m_deadstemc_storage_to_litter_fire(p) + & + m_deadstemc_xfer_to_litter_fire(p))* stem_prof(p,j)& + +(m_livecrootc_storage_to_litter_fire(p) + & + m_livecrootc_xfer_to_litter_fire(p) & + +m_deadcrootc_storage_to_litter_fire(p) + & + m_deadcrootc_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) + m_c_to_litr_cel_fire(c,j)=m_c_to_litr_cel_fire(c,j) + & + (m_leafc_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & + m_frootc_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + m_c_to_litr_lig_fire(c,j)=m_c_to_litr_lig_fire(c,j) + & + (m_leafc_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & + m_frootc_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + + m_n_to_litr_met_fire(c,j)=m_n_to_litr_met_fire(c,j) + & + ((m_leafn_to_litter_fire(p)*lf_flab(patch%itype(p)) & + +m_leafn_storage_to_litter_fire(p) + & + m_leafn_xfer_to_litter_fire(p)+m_retransn_to_litter_fire(p)) & + *leaf_prof(p,j) +(m_frootn_to_litter_fire(p)*fr_flab(patch%itype(p)) & + +m_frootn_storage_to_litter_fire(p) + & + m_frootn_xfer_to_litter_fire(p))*froot_prof(p,j) & + +(m_livestemn_storage_to_litter_fire(p) + & + m_livestemn_xfer_to_litter_fire(p) & + +m_deadstemn_storage_to_litter_fire(p) + & + m_deadstemn_xfer_to_litter_fire(p))* stem_prof(p,j)& + +(m_livecrootn_storage_to_litter_fire(p) + & + m_livecrootn_xfer_to_litter_fire(p) & + +m_deadcrootn_storage_to_litter_fire(p) + & + m_deadcrootn_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) + m_n_to_litr_cel_fire(c,j)=m_n_to_litr_cel_fire(c,j) + & + (m_leafn_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & + m_frootn_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + m_n_to_litr_lig_fire(c,j)=m_n_to_litr_lig_fire(c,j) + & + (m_leafn_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & + m_frootn_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + end do + end do + ! + ! vertically-resolved decomposing C/N fire loss + ! column loop + ! + num_actfirec = 0 + do fc = 1,num_soilc + c = filter_soilc(fc) + + f = farea_burned(c) + + if(f /= 0 .or. f /= baf_crop(c))then + num_actfirec = num_actfirec + 1 + filter_actfirec(num_actfirec) = c + end if + do j = 1, nlevdecomp + ! carbon fluxes + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * f * & + cmb_cmplt_fact_litter + if(use_soil_matrixcn)then! matrix is the same for C and N in the fire. + associate( & + matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] (gC/m3/step) VR deomp. C fire loss in matrix representation + ) + matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) & + - f * cmb_cmplt_fact_litter * dt + end associate + end if + end if + if ( is_cwd(l) ) then + m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * & + (f-baf_crop(c)) * cmb_cmplt_fact_cwd + if(use_soil_matrixcn)then + associate( & + matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] (gC/m3/step) VR deomp. C fire loss in matrix representation + ) + matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) & + - (f-baf_crop(c)) * cmb_cmplt_fact_cwd * dt + end associate + end if + end if + end do + + ! nitrogen fluxes + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * f * & + cmb_cmplt_fact_litter + end if + if ( is_cwd(l) ) then + m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * & + (f-baf_crop(c)) * cmb_cmplt_fact_cwd + end if + end do + + end do + end do ! end of column loop + + ! carbon loss due to deforestation fires + + if (transient_landcover) then + call get_curr_date (kyr, kmo, kda, mcsec) + do fc = 1,num_soilc + c = filter_soilc(fc) + lfc2(c)=0._r8 + if( .not. (kmo == 1 .and. kda == 1 .and. mcsec == 0) )then + if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 .and. dtrotr_col(c) > 0._r8 .and. & + lfc(c) > 0._r8 .and. fbac1(c) == 0._r8) then + lfc2(c) = max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & + baf_peatf(c))/2.0*dt))/(dtrotr_col(c)*dayspyr*secspday/dt)/dt + lfc(c) = lfc(c) - max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & + baf_peatf(c))*dt/2.0_r8)) + end if + end if + end do + end if + ! + ! Carbon loss due to peat fires + ! + ! somc_fire is not connected to clm45 soil carbon pool, ie does not decrease + ! soil carbon b/c clm45 soil carbon was very low in several peatland grids + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if( grc%latdeg(g) < cnfire_const%borealat)then + somc_fire(c)= totsomc(c)*baf_peatf(c)*6.0_r8/33.9_r8 + else + somc_fire(c)= baf_peatf(c)*2.2e3_r8 + end if + end do + + ! Fang Li has not added aerosol and trace gas emissions due to fire, yet + ! They will be added here in proportion to the carbon emission + ! Emission factors differ for various fire types + + end associate + + end subroutine CNFireFluxes + + !----------------------------------------------------------------------- + subroutine CNFireReadParams( this, ncid ) + ! + ! Read in the constant parameters from the input NetCDF parameter file + ! !USES: + use ncdio_pio , only: file_desc_t + use paramUtilMod, only: readNcdioScalar + ! + ! !ARGUMENTS: + implicit none + class(cnfire_base_type) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'CNFireReadParams' + !-------------------------------------------------------------------- + + ! Factor related to dependence of fuel combustibility on 30-day running mean of relative humidity (unitless) + call readNcdioScalar(ncid, 'prh30', subname, cnfire_params%prh30) + ! Ignition efficiency of cloud-to-ground lightning (unitless) + call readNcdioScalar(ncid, 'ignition_efficiency', subname, cnfire_params%ignition_efficiency) + + end subroutine CNFireReadParams + +end module CNFireBaseMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index dc9c09b9b..8871ee946 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -53,6 +53,15 @@ module CNCLM_CNProductsMod real(r8), pointer :: prod100_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 100-yr wood product pool real(r8), pointer :: tot_woodprod_loss_grc(:) ! (g[C or N]/m2/s) decompomposition loss from all wood product pools + contains + + ! Science routines + procedure, public :: UpdateProducts + procedure, private :: PartitionWoodFluxes + procedure, private :: PartitionGrainFluxes + procedure, private :: ComputeSummaryVars + + end type cn_products_type type(cn_products_type), public, target, save :: cn_products_inst @@ -134,4 +143,317 @@ subroutine init_cn_products_type(bounds, nch, cncol, species, this) end do ! nc end subroutine init_cn_products_type + !----------------------------------------------------------------------- + subroutine UpdateProducts(this, bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch, & + wood_harvest_patch, & + dwt_crop_product_gain_patch, & + grain_to_cropprod_patch) + ! + ! !DESCRIPTION: + ! Update all loss fluxes from wood and grain product pools, and update product pool + ! state variables for both loss and gain terms + ! + ! !ARGUMENTS: + class(cn_products_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + + ! dynamic landcover addition to wood product pools (g/m2/s) [patch]; although this is + ! a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), intent(in) :: dwt_wood_product_gain_patch( bounds%begp: ) + + ! wood harvest addition to wood product pools (g/m2/s) [patch] + real(r8), intent(in) :: wood_harvest_patch( bounds%begp: ) + + ! dynamic landcover addition to crop product pools (g/m2/s) [patch]; although this is + ! a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), intent(in) :: dwt_crop_product_gain_patch( bounds%begp: ) + + ! grain to crop product pool (g/m2/s) [patch] + real(r8), intent(in) :: grain_to_cropprod_patch( bounds%begp: ) + ! + ! !LOCAL VARIABLES: + integer :: g ! indices + real(r8) :: dt ! time step (seconds) + real(r8) :: kprod1 ! decay constant for 1-year product pool + real(r8) :: kprod10 ! decay constant for 10-year product pool + real(r8) :: kprod100 ! decay constant for 100-year product pool + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(dwt_wood_product_gain_patch) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(wood_harvest_patch) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(dwt_crop_product_gain_patch) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(grain_to_cropprod_patch) == (/bounds%endp/)), sourcefile, __LINE__) + + call this%PartitionWoodFluxes(bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch(bounds%begp:bounds%endp), & + wood_harvest_patch(bounds%begp:bounds%endp)) + + call this%PartitionGrainFluxes(bounds, & + num_soilp, filter_soilp, & + dwt_crop_product_gain_patch(bounds%begp:bounds%endp), & + grain_to_cropprod_patch(bounds%begp:bounds%endp)) + + ! calculate losses from product pools + ! the following (1/s) rate constants result in ~90% loss of initial state over 1, 10 and 100 years, + ! respectively, using a discrete-time fractional decay algorithm. + kprod1 = 7.2e-8 + kprod10 = 7.2e-9 + kprod100 = 7.2e-10 + + do g = bounds%begg, bounds%endg + ! calculate fluxes out of product pools (1/sec) + this%cropprod1_loss_grc(g) = this%cropprod1_grc(g) * kprod1 + this%prod10_loss_grc(g) = this%prod10_grc(g) * kprod10 + this%prod100_loss_grc(g) = this%prod100_grc(g) * kprod100 + end do + + ! set time steps + dt = get_step_size_real() + + ! update product state variables + do g = bounds%begg, bounds%endg + + ! fluxes into wood & crop product pools, from landcover change + this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%dwt_cropprod1_gain_grc(g)*dt + this%prod10_grc(g) = this%prod10_grc(g) + this%dwt_prod10_gain_grc(g)*dt + this%prod100_grc(g) = this%prod100_grc(g) + this%dwt_prod100_gain_grc(g)*dt + + ! fluxes into wood & crop product pools, from harvest + this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%grain_to_cropprod1_grc(g)*dt + this%prod10_grc(g) = this%prod10_grc(g) + this%hrv_deadstem_to_prod10_grc(g)*dt + this%prod100_grc(g) = this%prod100_grc(g) + this%hrv_deadstem_to_prod100_grc(g)*dt + + ! fluxes out of wood & crop product pools, from decomposition + this%cropprod1_grc(g) = this%cropprod1_grc(g) - this%cropprod1_loss_grc(g)*dt + this%prod10_grc(g) = this%prod10_grc(g) - this%prod10_loss_grc(g)*dt + this%prod100_grc(g) = this%prod100_grc(g) - this%prod100_loss_grc(g)*dt + + end do + + call this%ComputeSummaryVars(bounds) + + end subroutine UpdateProducts + + !----------------------------------------------------------------------- + subroutine PartitionWoodFluxes(this, bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch, & + wood_harvest_patch) + ! + ! !DESCRIPTION: + ! Partition input wood fluxes into 10 and 100 year product pools + ! + ! !USES: + use pftconMod , only : pftcon + use subgridAveMod, only : p2g + ! + ! !ARGUMENTS: + class(cn_products_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + + ! dynamic landcover addition to wood product pools (g/m2/s) [patch]; although this is + ! a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), intent(in) :: dwt_wood_product_gain_patch( bounds%begp: ) + + ! wood harvest addition to wood product pools (g/m2/s) [patch] + real(r8), intent(in) :: wood_harvest_patch( bounds%begp: ) + + ! + ! !LOCAL VARIABLES: + integer :: fp + integer :: p + integer :: g + real(r8) :: pprod10 ! PFT proportion of deadstem to 10-year product pool + real(r8) :: pprod100 ! PFT proportion of deadstem to 100-year product pool + real(r8) :: pprod_tot ! PFT proportion of deadstem to any product pool + real(r8) :: pprod10_frac ! PFT fraction of deadstem to product pool that goes to 10-year product pool + real(r8) :: pprod100_frac ! PFT fraction of deadstem to product pool that goes to 100-year product pool + + character(len=*), parameter :: subname = 'PartitionWoodFluxes' + !----------------------------------------------------------------------- + + ! Partition patch-level harvest fluxes to 10 and 100-year product pools + do fp = 1, num_soilp + p = filter_soilp(fp) + this%hrv_deadstem_to_prod10_patch(p) = & + wood_harvest_patch(p) * pftcon%pprodharv10(patch%itype(p)) + this%hrv_deadstem_to_prod100_patch(p) = & + wood_harvest_patch(p) * (1.0_r8 - pftcon%pprodharv10(patch%itype(p))) + end do + + ! Average harvest fluxes from patch to gridcell + call p2g(bounds, & + this%hrv_deadstem_to_prod10_patch(bounds%begp:bounds%endp), & + this%hrv_deadstem_to_prod10_grc(bounds%begg:bounds%endg), & + p2c_scale_type = 'unity', & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + call p2g(bounds, & + this%hrv_deadstem_to_prod100_patch(bounds%begp:bounds%endp), & + this%hrv_deadstem_to_prod100_grc(bounds%begg:bounds%endg), & + p2c_scale_type = 'unity', & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + ! Zero the dwt gains + do g = bounds%begg, bounds%endg + this%dwt_prod10_gain_grc(g) = 0._r8 + this%dwt_prod100_gain_grc(g) = 0._r8 + end do + + + ! Partition dynamic land cover fluxes to 10 and 100-year product pools. + do p = bounds%begp, bounds%endp + g = patch%gridcell(p) + + ! Note that pprod10 + pprod100 do NOT sum to 1: some fraction of the dwt changes + ! was lost to other fluxes. dwt_wood_product_gain_patch gives the amount that goes + ! to all product pools, so we need to determine the fraction of that flux that + ! goes to each pool. + pprod10 = pftcon%pprod10(patch%itype(p)) + pprod100 = pftcon%pprod100(patch%itype(p)) + pprod_tot = pprod10 + pprod100 + if (pprod_tot > 0) then + pprod10_frac = pprod10 / pprod_tot + pprod100_frac = pprod100 / pprod_tot + else + ! Avoid divide by 0 + pprod10_frac = 0._r8 + pprod100_frac = 0._r8 + end if + + ! Note that the patch-level fluxes are expressed per unit gridcell area. So, to go + ! from patch-level fluxes to gridcell-level fluxes, we simply add up the various + ! patch contributions, without having to multiply by any area weightings. + this%dwt_prod10_gain_grc(g) = this%dwt_prod10_gain_grc(g) + & + dwt_wood_product_gain_patch(p) * pprod10_frac + this%dwt_prod100_gain_grc(g) = this%dwt_prod100_gain_grc(g) + & + dwt_wood_product_gain_patch(p) * pprod100_frac + end do + + end subroutine PartitionWoodFluxes + + !----------------------------------------------------------------------- + subroutine PartitionGrainFluxes(this, bounds, & + num_soilp, filter_soilp, & + dwt_crop_product_gain_patch, & + grain_to_cropprod_patch) + ! + ! !DESCRIPTION: + ! Partition input grain fluxes into crop product pools + ! + ! For now this doesn't do much, since there is just a single (1-year) crop product + ! pool. But this provides the capability to add different crop product pools in the + ! future, without requiring any changes to code outside of this class. It also gives + ! symmetry with the wood fluxes. + ! + ! !USES: + use subgridAveMod, only : p2g + ! + ! !ARGUMENTS: + class(cn_products_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + + ! dynamic landcover addition to crop product pool (g/m2/s) [patch]; although this is + ! a patch-level flux, it is expressed per unit GRIDCELL area + real(r8), intent(in) :: dwt_crop_product_gain_patch( bounds%begp: ) + + ! grain to crop product pool(s) (g/m2/s) [patch] + real(r8) , intent(in) :: grain_to_cropprod_patch( bounds%begp: ) + ! + ! !LOCAL VARIABLES: + integer :: fp + integer :: p + integer :: g + + character(len=*), parameter :: subname = 'PartitionGrainFluxes' + !----------------------------------------------------------------------- + + ! Determine gains from crop harvest + + do fp = 1, num_soilp + p = filter_soilp(fp) + + ! For now all crop product is put in the 1-year crop product pool + this%grain_to_cropprod1_patch(p) = grain_to_cropprod_patch(p) + end do + + call p2g(bounds, & + this%grain_to_cropprod1_patch(bounds%begp:bounds%endp), & + this%grain_to_cropprod1_grc(bounds%begg:bounds%endg), & + p2c_scale_type = 'unity', & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + ! Determine gains from dynamic landcover + + do g = bounds%begg, bounds%endg + this%dwt_cropprod1_gain_grc(g) = 0._r8 + end do + + do p = bounds%begp, bounds%endp + g = patch%gridcell(p) + + ! Note that the patch-level fluxes are expressed per unit gridcell area. So, to go + ! from patch-level fluxes to gridcell-level fluxes, we simply add up the various + ! patch contributions, without having to multiply by any area weightings. + this%dwt_cropprod1_gain_grc(g) = this%dwt_cropprod1_gain_grc(g) + & + dwt_crop_product_gain_patch(p) + end do + + end subroutine PartitionGrainFluxes + + !----------------------------------------------------------------------- + subroutine ComputeSummaryVars(this, bounds) + ! + ! !DESCRIPTION: + ! Compute summary variables in this object: sums across multiple product pools + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_products_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g ! indices + + character(len=*), parameter :: subname = 'ComputeSummaryVars' + !----------------------------------------------------------------------- + + do g = bounds%begg, bounds%endg + + ! total wood products + this%tot_woodprod_grc(g) = & + this%prod10_grc(g) + & + this%prod100_grc(g) + + ! total loss from wood products + this%tot_woodprod_loss_grc(g) = & + this%prod10_loss_grc(g) + & + this%prod100_loss_grc(g) + + ! total loss from ALL products + this%product_loss_grc(g) = & + this%cropprod1_loss_grc(g) + & + this%prod10_loss_grc(g) + & + this%prod100_loss_grc(g) + + this%dwt_woodprod_gain_grc(g) = & + this%dwt_prod100_gain_grc(g) + & + this%dwt_prod10_gain_grc(g) + end do + + end subroutine ComputeSummaryVars + end module CNCLM_CNProductsMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 35cd16b7d..f7e90ca4f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -457,6 +457,11 @@ module CNCLM_CNVegCarbonFluxType integer,pointer :: list_agmc (:) ! Indices of non-diagnoal entries in full sparse matrix Agm for C cycle integer,pointer :: list_afic (:) ! Indices of non-diagnoal entries in full sparse matrix Afi for C cycle + contains + + procedure , public :: SetValues + + end type cnveg_carbonflux_type type(cnveg_carbonflux_type), public, target, save :: cnveg_carbonflux_inst @@ -1030,7 +1035,7 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi allocate(this%npp_Nfix_patch (begp:endp)) ; this%npp_Nfix_patch (:) = nan allocate(this%npp_Nretrans_patch (begp:endp)) ; this%npp_Nretrans_patch (:) = nan allocate(this%npp_Nuptake_patch (begp:endp)) ; this%npp_Nuptake_patch (:) = nan - allocate(this%npp_growth_patch (begp:endp)) ; this%npp_growth_patch (:) = nan + allocate(this%npp_growth_patch (begp:endp)) ; this%npp_growth_patch (:) = nan allocate(this%leafc_change_patch (begp:endp)) ; this%leafc_change_patch (:) = nan allocate(this%soilc_change_patch (begp:endp)) ; this%soilc_change_patch (:) = nan @@ -1054,7 +1059,9 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi this%prev_leafc_to_litter_patch (np) = cnpft(nc,nz,nv, 42) this%tempsum_npp_patch (np) = cnpft(nc,nz,nv, 45) this%xsmrpool_recover_patch (np) = cnpft(nc,nz,nv, 47) - + this%dwt_wood_productc_gain_patch(np) = 0. ! following CNCLM45 setting + this%dwt_crop_productc_gain_patch(np) = 0. ! following CNCLM45 setting + end if end do !nv end do ! p diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index 1a710595e..3be118078 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -354,6 +354,10 @@ module CNCLM_CNVegNitrogenFluxType integer,pointer :: list_agmn (:) ! Indices of non-diagnoal entries in full sparse matrix Agm for N cycle integer,pointer :: list_afin (:) ! Indices of non-diagnoal entries in full sparse matrix Afi for N cycle + contains + + procedure , public :: SetValues + end type cnveg_nitrogenflux_type type(cnveg_nitrogenflux_type), public, target, save :: cnveg_nitrogenflux_inst @@ -965,6 +969,8 @@ subroutine init_cnveg_nitrogenflux_type(bounds, nch, ityp, fveg, cncol, cnpft, t if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then this%plant_ndemand_patch (np) = cnpft(nc,nz,nv, 75) + this%dwt_wood_productn_gain_patch(np) = 0. ! following CNCLM45 setting + this%dwt_crop_productn_gain_patch(np) = 0. ! following CNCLM45 setting end if end do !nv diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index f8b790c00..171579027 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -22,9 +22,9 @@ module CNCLM_ColumnType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use CNCLM_decompMod , only : bounds_type - use clm_varcon , only : ispval + use clm_varcon , only : zsoi, dzsoi, zisoi, dzsoi_decomp, spval, ispval use clm_varctl , only : use_fates - use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevmaxurbgrnd + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevmaxurbgrnd,nlevurb ! !PUBLIC TYPES: @@ -139,7 +139,17 @@ subroutine init_column_type(bounds, this) this%nbedrock(:) = 1 !jkolassa: set this to 1, since we only have one soil layer - this%dz(:) = 1. ! jkolassa: setting this to 1, since we only have 1 soil layer for now; consistent with previous versions of CNCLM + + do c = bounds%begc,bounds%endc + col%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd) + col%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd) + col%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd) + if (nlevgrnd < nlevurb) then + col%z(c,nlevgrnd+1:nlevurb) = spval + col%zi(c,nlevgrnd+1:nlevurb) = spval + col%dz(c,nlevgrnd+1:nlevurb) = spval + end if + end do end subroutine init_column_type end module CNCLM_ColumnType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 new file mode 100755 index 000000000..8d10e3133 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 @@ -0,0 +1,104 @@ +module FireDataBaseType + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for handling of fire data + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use fileutils , only : getavu, relavu + use abortutils , only : endrun + use decompMod , only : bounds_type + use FireMethodType , only : fire_method_type + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: fire_base_type + + ! + type, abstract, extends(fire_method_type) :: fire_base_type + private + ! !PRIVATE MEMBER DATA: + + real(r8), public, pointer :: forc_lnfm(:) ! Lightning frequency + real(r8), public, pointer :: forc_hdm(:) ! Human population density + + contains + ! + ! !PUBLIC MEMBER FUNCTIONS: + procedure, public :: FireInit => BaseFireInit ! Initialization of Fire + procedure, public :: BaseFireInit ! Initialization of Fire + procedure(FireReadNML_interface), public, deferred :: FireReadNML ! Read in namelist for Fire + procedure(need_lightning_and_popdens_interface), public, deferred :: & + need_lightning_and_popdens ! Returns true if need lightning & popdens + ! + end type fire_base_type + !----------------------------------------------------------------------- + + abstract interface + !----------------------------------------------------------------------- + function need_lightning_and_popdens_interface(this) result(need_lightning_and_popdens) + ! + ! !DESCRIPTION: + ! Returns true if need lightning and popdens, false otherwise + ! + ! USES + import :: fire_base_type + ! + ! !ARGUMENTS: + class(fire_base_type), intent(in) :: this + logical :: need_lightning_and_popdens ! function result + !----------------------------------------------------------------------- + end function need_lightning_and_popdens_interface + end interface + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine FireReadNML_interface( this, NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for Fire + ! + ! !USES: + ! + ! !ARGUMENTS: + class(fire_base_type) :: this + character(len=*), intent(in) :: NLFilename ! Namelist filename + end subroutine FireReadNML_interface + + !----------------------------------------------------------------------- + subroutine BaseFireInit( this, bounds ) + ! + ! !DESCRIPTION: + ! Initialize CN Fire module + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(fire_base_type) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + + if ( this%need_lightning_and_popdens() ) then + ! Allocate lightning forcing data + allocate( this%forc_lnfm(bounds%begg:bounds%endg) ) + this%forc_lnfm(bounds%begg:) = nan + ! Allocate pop dens forcing data + allocate( this%forc_hdm(bounds%begg:bounds%endg) ) + this%forc_hdm(bounds%begg:) = nan + end if + + end subroutine BaseFireInit + + +end module FireDataBaseType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 64224ba45..cd6589fb1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -69,7 +69,7 @@ module CNCLM_PatchType contains !---------------------------------------------------- - subroutine init_patch_type(bounds, nch, ityp, this) + subroutine init_patch_type(bounds, nch, ityp, fveg, this) ! !ARGUMENTS: implicit none @@ -78,6 +78,7 @@ subroutine init_patch_type(bounds, nch, ityp, this) type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of Catchment tiles integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction type(patch_type), intent(inout) :: this ! LOCAL: @@ -122,7 +123,8 @@ subroutine init_patch_type(bounds, nch, ityp, this) do p = 0,numpft ! PFT index loop np = np + 1 do nv = 1,num_veg ! defined veg loop - this%itype(np) = ityp(nc,nz,nz) + this%itype(np) = ityp(nc,nv,nz) + this%wtcol(np) = fveg(nc,nv,nz) this%column(np) = n end do ! nv end do ! p diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 new file mode 100644 index 000000000..8e01660d0 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 @@ -0,0 +1,66 @@ +module SaturatedExcessRunoffMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Type and associated routines for calculating surface runoff due to saturated surface + ! + ! This also includes calculations of fsat (fraction of each column that is saturated) + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varcon , only : spval + + implicit none + save + private + + public :: init_saturated_excess_runoff_type + + ! !PUBLIC TYPES: + + type, public :: saturated_excess_runoff_type + private + ! Public data members + ! Note: these should be treated as read-only by other modules + real(r8), pointer, public :: fsat_col(:) ! fractional area with water table at surface + + ! Private data members + integer :: fsat_method + real(r8), pointer :: fcov_col(:) ! fractional impermeable area + end type saturated_excess_runoff_type + + type, private :: params_type + real(r8) :: fff ! Decay factor for fractional saturated area (1/m) + end type params_type + type(params_type), private :: params_inst + +contains + +!-------------------------------------------------------------- + subroutine init_saturated_excess_runoff_type(bounds, this) + + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + implicit none + ! INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(saturated_excess_runoff_type), intent(inout):: this + + ! LOCAL + integer :: begc, endc + !------------------------------- + + begc = bounds%begc; endc= bounds%endc + + allocate(this%fsat_col(begc:endc)) ; this%fsat_col(:) = nan + allocate(this%fcov_col(begc:endc)) ; this%fcov_col(:) = nan + + end subroutine init_saturated_excess_runoff_type + +end module SaturatedExcessRunoffMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index 090d5044c..b39575de5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -348,7 +348,7 @@ subroutine SetValues ( this, & do fi = 1,num_column i = filter_column(fi) - this%ndep_to_sminn_col(i) = value_column + tndep_to_sminn_colhis%(i) = value_column this%nfix_to_sminn_col(i) = value_column this%ffix_to_sminn_col(i) = value_column this%fert_to_sminn_col(i) = value_column diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 new file mode 100644 index 000000000..4159b567f --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 @@ -0,0 +1,84 @@ +module Wateratm2lndBulkType + + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Defines a derived type containing water atm2lnd variables that just apply to bulk + ! water. Note that this type extends the base wateratm2lnd_type, so the full + ! wateratm2lndbulk_type contains the union of the fields defined here and the fields + ! defined in wateratm2lnd_type. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use PatchType , only : patch + use clm_varctl , only : iulog, use_fates, use_cn, use_cndv + use clm_varcon , only : spval + use WaterAtm2lndType , only : wateratm2lnd_type + + implicit none + save + private + + ! !PUBLIC MEMBER FUNCTIONS: + public :: init_wateratm2lndbulk_type + ! + ! !PUBLIC TYPES: + type, extends(wateratm2lnd_type), public :: wateratm2lndbulk_type + + real(r8), pointer :: volrmch_grc (:) ! rof volr main channel (m3) + real(r8), pointer :: volr_grc (:) ! rof volr total volume (m3) + real(r8), pointer :: forc_rh_grc (:) ! atmospheric relative humidity (%) + real(r8) , pointer :: prec365_col (:) ! col 365-day running mean of tot. precipitation (see comment in UpdateAccVars regarding why this is col-level despite other prec accumulators being patch-level) + real(r8) , pointer :: prec60_patch (:) ! patch 60-day running mean of tot. precipitation (mm/s) + real(r8) , pointer :: prec10_patch (:) ! patch 10-day running mean of tot. precipitation (mm/s) + real(r8) , pointer :: rh30_patch (:) ! patch 30-day running mean of relative humidity + real(r8) , pointer :: prec24_patch (:) ! patch 24-hour running mean of tot. precipitation (mm/s) + real(r8) , pointer :: rh24_patch (:) ! patch 24-hour running mean of relative humidity + + end type wateratm2lndbulk_type + + contains + + !------------------------------------------------------------------------ + subroutine init_wateratm2lndbulk_type(bounds, this) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(wateratm2lndbulk_type), intent(inout) :: this + + ! + ! !LOCAL VARIABLES: + real(r8) :: ival = 0.0_r8 ! initial value + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + allocate(this%volr_grc (begg:endg)) ; this%volr_grc (:) = ival + allocate(this%volrmch_grc (begg:endg)) ; this%volrmch_grc (:) = ival + allocate(this%forc_rh_grc (begg:endg)) ; this%forc_rh_grc (:) = ival + allocate(this%prec365_col (begc:endc)) ; this%prec365_col (:) = nan + allocate(this%prec60_patch (begp:endp)) ; this%prec60_patch(:) = nan + allocate(this%prec10_patch (begp:endp)) ; this%prec10_patch(:) = nan + allocate(this%rh30_patch (begp:endp)) ; this%rh30_patch (:) = nan + if (use_fates) then + allocate(this%prec24_patch (begp:endp)) ; this%prec24_patch(:) = nan + allocate(this%rh24_patch (begp:endp)) ; this%rh24_patch (:) = nan + end if + + + end subroutine init_wateratm2lndbulk_type +module Wateratm2lndBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 new file mode 100644 index 000000000..930c5c843 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 @@ -0,0 +1,69 @@ +module Wateratm2lndType + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Defines a derived type containing water atm2lnd variables that apply to both bulk water + ! and water tracers. + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varcon , only : spval + + implicit none + save + private + + ! !PUBLIC MEMBER FUNCTIONS: + public :: init_wateratm2lnd_type + ! + ! !PUBLIC TYPES: + type, public :: wateratm2lnd_type + + real(r8), pointer :: forc_q_not_downscaled_grc (:) ! not downscaled atm specific humidity (kg/kg) + real(r8), pointer :: forc_rain_not_downscaled_grc (:) ! not downscaled atm rain rate [mm/s] + real(r8), pointer :: forc_snow_not_downscaled_grc (:) ! not downscaled atm snow rate [mm/s] + real(r8), pointer :: forc_q_downscaled_col (:) ! downscaled atm specific humidity (kg/kg) + real(r8), pointer :: forc_flood_grc (:) ! rof flood (mm/s) + real(r8), pointer :: forc_rain_downscaled_col (:) ! downscaled atm rain rate [mm/s] + real(r8), pointer :: forc_snow_downscaled_col (:) ! downscaled atm snow rate [mm/s] + + real(r8), pointer :: rain_to_snow_conversion_col (:) ! amount of rain converted to snow via precipitation repartitioning (mm/s) + real(r8), pointer :: snow_to_rain_conversion_col (:) ! amount of snow converted to rain via precipitation repartitioning (mm/s) + + + end type wateratm2lnd_type + type(wateratm2lnd_type), public, target, save :: wateratm2lnd_inst + + contains + + !------------------------------------------------------------------------ + subroutine init_wateratm2lnd_type(bounds,this) + ! + ! !DESCRIPTION: + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(wateratm2lnd_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + this%forc_rain_not_downscaled_grc(begg:endg) = spval + this%forc_snow_not_downscaled_grc(begg:endg) = spval + this%forc_q_downscaled_col(begc:endc) = spval + this%forc_flood_grc(begg:endg) = spval + this%forc_rain_downscaled_col(begc:endc) = spval + this%forc_snow_downscaled_col(begc:endc) = spval + + end subroutine init_wateratm2lnd_type +end module Wateratm2lndType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 new file mode 100755 index 000000000..e536ddfda --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 @@ -0,0 +1,95 @@ +module initVerticalMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Initialize vertical components of column datatype + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_abort + use decompMod , only : bounds_type + use spmdMod , only : masterproc + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak + use clm_varpar , only : nlevsoi, nlevurb, nlevmaxurbgrnd + use clm_varctl , only : iulog + use clm_varctl , only : use_vertsoilc + use clm_varctl , only : use_fates + use clm_varcon , only : zsoi, dzsoi, zisoi, dzsoi_decomp, spval, ispval + use fileutils , only : getfil + use LandunitType , only : lun + use GridcellType , only : grc + use ColumnType , only : col + use glcBehaviorMod , only : glc_behavior_type + use SnowHydrologyMod , only : InitSnowLayers + use abortUtils , only : endrun + use ncdio_pio + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + ! public :: initVertical + public :: find_soil_layer_containing_depth + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + ! + !------------------------------------------------------------------------ + +contains + + !----------------------------------------------------------------------- + subroutine find_soil_layer_containing_depth(depth, layer) + ! + ! !DESCRIPTION: + ! Find the soil layer that contains the given depth + ! + ! Aborts if the given depth doesn't exist in the soil profile + ! + ! We consider the interface between two layers to belong to the layer *above* that + ! interface. This implies that the top interface (at exactly 0 m) is not considered + ! to be part of the soil profile. + ! + ! !ARGUMENTS: + real(r8), intent(in) :: depth ! target depth, m + integer , intent(out) :: layer ! layer containing target depth + ! + ! !LOCAL VARIABLES: + logical :: found + integer :: i + + character(len=*), parameter :: subname = 'find_soil_layer_containing_depth' + !----------------------------------------------------------------------- + + if (depth <= zisoi(0)) then + write(iulog,*) subname, ': ERROR: depth above top of soil' + write(iulog,*) 'depth = ', depth + write(iulog,*) 'zisoi = ', zisoi + call endrun(msg=subname//': depth above top of soil') + end if + + found = .false. + do i = 1, nlevgrnd + if (depth <= zisoi(i)) then + layer = i + found = .true. + exit + end if + end do + + if (.not. found) then + write(iulog,*) subname, ': ERROR: depth below bottom of soil' + write(iulog,*) 'depth = ', depth + write(iulog,*) 'zisoi = ', zisoi + call endrun(msg=subname//': depth below bottom of soil') + end if + + end subroutine find_soil_layer_containing_depth + +end module initVerticalMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 822b185bb..baa33aeb6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -34,7 +34,7 @@ module CNCLM_pftconMod integer, public :: nc3_nonarctic_grass = 13 ! Cool c3 grass [moisture + deciduous] integer, public :: nc4_grass = 14 ! Warm c4 grass [moisture + deciduous] integer, public :: nc3crop = 15 ! C3_crop [moisture + deciduous] - integer, public :: npcropmin = nc3crop ! value for first crop + integer, public :: npcropmin = nc3crop ! value for first crop functional type (not including the more generic C3 crop PFT) ! type, public :: pftcon_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate1Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate1Mod.F90 new file mode 100755 index 000000000..2599c386c --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate1Mod.F90 @@ -0,0 +1,583 @@ +module CNCStateUpdate1Mod + + !----------------------------------------------------------------------- + ! Module for carbon state variable update, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp + use clm_time_manager , only : get_step_size_real + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use pftconMod , only : npcropmin, nc3crop, pftcon + use abortutils , only : endrun + use decompMod , only : bounds_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CropType , only : crop_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use PatchType , only : patch + use clm_varctl , only : use_fates, use_cn, iulog + use clm_varctl , only : use_matrixcn, use_soil_matrixcn + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CStateUpdateDynPatch + public :: CStateUpdate0 + public :: CStateUpdate1 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) + ! + ! !DESCRIPTION: + ! Update carbon states based on fluxes from dyn_cnbal_patch + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_soilc_with_inactive ! number of columns in soil filter + integer, intent(in) :: filter_soilc_with_inactive(:) ! soil column filter that includes inactive points + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c ! column index + integer :: fc ! column filter index + integer :: g ! gridcell index + integer :: j ! level index + real(r8) :: dt ! time step (seconds) + + character(len=*), parameter :: subname = 'CStateUpdateDynPatch' + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & + cs_veg => cnveg_carbonstate_inst , & + cs_soil => soilbiogeochem_carbonstate_inst & + ) + + dt = get_step_size_real() + + if (.not. use_fates) then + do j = 1,nlevdecomp + do fc = 1, num_soilc_with_inactive + c = filter_soilc_with_inactive(fc) + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) + & + cf_veg%dwt_frootc_to_litr_met_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) + & + cf_veg%dwt_frootc_to_litr_cel_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) + & + cf_veg%dwt_frootc_to_litr_lig_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + & + ( cf_veg%dwt_livecrootc_to_cwdc_col(c,j) + cf_veg%dwt_deadcrootc_to_cwdc_col(c,j) ) * dt + end do + end do + + do g = bounds%begg, bounds%endg + cs_veg%seedc_grc(g) = cs_veg%seedc_grc(g) - cf_veg%dwt_seedc_to_leaf_grc(g) * dt + cs_veg%seedc_grc(g) = cs_veg%seedc_grc(g) - cf_veg%dwt_seedc_to_deadstem_grc(g) * dt + end do + + end if + + ! TODO(wjs, 2017-01-02) Do we need to move some of the FATES fluxes into here (from + ! CStateUpdate1) if use_fates is true? Specifically, some portion or all of the fluxes + ! from these updates in CStateUpdate1: + ! cf_soil%decomp_cpools_sourcesink_col(c,j,i_met_lit) = cf_soil%FATES_c_to_litr_lab_c_col(c,j) * dt + ! cf_soil%decomp_cpools_sourcesink_col(c,j,i_cel_lit) = cf_soil%FATES_c_to_litr_cel_c_col(c,j) * dt + ! cf_soil%decomp_cpools_sourcesink_col(c,j,i_lig_lit) = cf_soil%FATES_c_to_litr_lig_c_col(c,j) * dt + + end associate + + end subroutine CStateUpdateDynPatch + + !----------------------------------------------------------------------- + subroutine CStateUpdate0(num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update cpool carbon state + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & + cs_veg => cnveg_carbonstate_inst & + ) + + ! set time steps + dt = get_step_size_real() + + + + ! gross photosynthesis fluxes + do fp = 1,num_soilp + p = filter_soilp(fp) + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) + cf_veg%psnsun_to_cpool_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) + cf_veg%psnshade_to_cpool_patch(p)*dt + end do + + + end associate + + end subroutine CStateUpdate0 + + !----------------------------------------------------------------------- + subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & + crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic carbon state + ! variables (except for gap-phase mortality and fire fluxes) + ! + use clm_varctl , only : carbon_resp_opt + use CNVegMatrixMod, only : matrix_update_phc + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(crop_type) , intent(in) :: crop_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst ! See note below for xsmrpool_to_atm_patch + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + logical , intent(in) :: dribble_crophrv_xsmrpool_2atm + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! filter indices + real(r8) :: dt ! radiation time step (seconds) + real(r8) :: check_cpool + real(r8) :: cpool_delta + real(r8), parameter :: kprod05 = 1.44e-7 ! decay constant for 0.5-year product pool (1/s) (lose ~90% over a half year) + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + + harvdate => crop_inst%harvdate_patch , & ! Input: [integer (:) ] harvest date + + cf_veg => cnveg_carbonflux_inst , & ! Output: + cs_veg => cnveg_carbonstate_inst , & ! Output: + cf_soil => soilbiogeochem_carbonflux_inst & ! Output: + ) + + ! set time steps + dt = get_step_size_real() + + ! Below is the input into the soil biogeochemistry model + + ! plant to litter fluxes + if (.not. use_fates) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (.not. use_soil_matrixcn) then + ! phenology and dynamic land cover fluxes + cf_soil%decomp_cpools_sourcesink_col(c,j,i_met_lit) = & + cf_veg%phenology_c_to_litr_met_c_col(c,j) *dt + cf_soil%decomp_cpools_sourcesink_col(c,j,i_cel_lit) = & + cf_veg%phenology_c_to_litr_cel_c_col(c,j) *dt + cf_soil%decomp_cpools_sourcesink_col(c,j,i_lig_lit) = & + cf_veg%phenology_c_to_litr_lig_c_col(c,j) *dt + + + ! NOTE(wjs, 2017-01-02) This used to be set to a non-zero value, but the + ! terms have been moved to CStateUpdateDynPatch. I think this is zeroed every + ! time step, but to be safe, I'm explicitly setting it to zero here. + cf_soil%decomp_cpools_sourcesink_col(c,j,i_cwd) = 0._r8 + else + cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_met_c_col(c,j) *dt + cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_cel_c_col(c,j) *dt + cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_lig_c_col(c,j) *dt + end if + end do + end do + else !use_fates + ! here add all fates litterfall and CWD breakdown to litter fluxes + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ! TODO(wjs, 2017-01-02) Should some portion or all of the following fluxes + ! be moved to the updates in CStateUpdateDynPatch? + cf_soil%decomp_cpools_sourcesink_col(c,j,i_met_lit) = cf_soil%FATES_c_to_litr_lab_c_col(c,j) * dt + cf_soil%decomp_cpools_sourcesink_col(c,j,i_cel_lit) = cf_soil%FATES_c_to_litr_cel_c_col(c,j) * dt + cf_soil%decomp_cpools_sourcesink_col(c,j,i_lig_lit) = cf_soil%FATES_c_to_litr_lig_c_col(c,j) * dt + end do + end do + endif + + ! litter and SOM HR fluxes + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (.not. use_soil_matrixcn) then + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) & + - ( cf_soil%decomp_cascade_hr_vr_col(c,j,k) + cf_soil%decomp_cascade_ctransfer_vr_col(c,j,k)) *dt + end if !not use_soil_matrixcn + end do + end do + end do + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (.not. use_soil_matrixcn) then + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) & + + cf_soil%decomp_cascade_ctransfer_vr_col(c,j,k)*dt + end if !not use_soil_matrixcn + end do + end do + end if + end do + + if (.not. use_fates) then +ptch: do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! phenology: transfer growth fluxes + if(.not. use_matrixcn)then + ! NOTE: Any changes that go here MUST be applied to the matrix + ! version as well + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) + cf_veg%leafc_xfer_to_leafc_patch(p)*dt + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) - cf_veg%leafc_xfer_to_leafc_patch(p)*dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) + cf_veg%frootc_xfer_to_frootc_patch(p)*dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) - cf_veg%frootc_xfer_to_frootc_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) + cf_veg%livestemc_xfer_to_livestemc_patch(p)*dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) - cf_veg%livestemc_xfer_to_livestemc_patch(p)*dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) + cf_veg%deadstemc_xfer_to_deadstemc_patch(p)*dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) - cf_veg%deadstemc_xfer_to_deadstemc_patch(p)*dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) + cf_veg%livecrootc_xfer_to_livecrootc_patch(p)*dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) - cf_veg%livecrootc_xfer_to_livecrootc_patch(p)*dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) + cf_veg%deadcrootc_xfer_to_deadcrootc_patch(p)*dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) - cf_veg%deadcrootc_xfer_to_deadcrootc_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) + cf_veg%livestemc_xfer_to_livestemc_patch(p)*dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) - cf_veg%livestemc_xfer_to_livestemc_patch(p)*dt + cs_veg%grainc_patch(p) = cs_veg%grainc_patch(p) + cf_veg%grainc_xfer_to_grainc_patch(p)*dt + cs_veg%grainc_xfer_patch(p) = cs_veg%grainc_xfer_patch(p) - cf_veg%grainc_xfer_to_grainc_patch(p)*dt + end if + + ! phenology: litterfall fluxes + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) - cf_veg%leafc_to_litter_patch(p)*dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) - cf_veg%frootc_to_litter_patch(p)*dt + + ! livewood turnover fluxes + if (woody(ivt(p)) == 1._r8) then + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - cf_veg%livestemc_to_deadstemc_patch(p)*dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) + cf_veg%livestemc_to_deadstemc_patch(p)*dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) - cf_veg%livecrootc_to_deadcrootc_patch(p)*dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) + cf_veg%livecrootc_to_deadcrootc_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - cf_veg%livestemc_to_litter_patch(p)*dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - cf_veg%livestemc_to_biofuelc_patch(p)*dt + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) - cf_veg%leafc_to_biofuelc_patch(p)*dt + cs_veg%grainc_patch(p) = cs_veg%grainc_patch(p) & + - (cf_veg%grainc_to_food_patch(p) + cf_veg%grainc_to_seed_patch(p))*dt + cs_veg%cropseedc_deficit_patch(p) = cs_veg%cropseedc_deficit_patch(p) & + - cf_veg%crop_seedc_to_leaf_patch(p) * dt & + + cf_veg%grainc_to_seed_patch(p) * dt + end if + else + ! NOTE: Changes for above that apply for matrix code are in CNPhenology EBK (11/26/2019) + + ! This part below MUST match exactly the code for the non-matrix part + ! above! + if (ivt(p) >= npcropmin) then + cs_veg%cropseedc_deficit_patch(p) = cs_veg%cropseedc_deficit_patch(p) & + - cf_veg%crop_seedc_to_leaf_patch(p) * dt & + + cf_veg%grainc_to_seed_patch(p) * dt + end if + end if !not use_matrixcn + + check_cpool = cs_veg%cpool_patch(p)- cf_veg%psnsun_to_cpool_patch(p)*dt-cf_veg%psnshade_to_cpool_patch(p)*dt + cpool_delta = cs_veg%cpool_patch(p) + + ! maintenance respiration fluxes from cpool + + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_xsmrpool_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%leaf_curmr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%froot_curmr_patch(p)*dt + If (woody(ivt(p)) == 1._r8) then + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%livestem_curmr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%livecroot_curmr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%livestem_curmr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%grain_curmr_patch(p)*dt + end if + + + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_resp_patch(p)*dt + + !RF Add in the carbon spent on uptake respiration. + cs_veg%cpool_patch(p)= cs_veg%cpool_patch(p) - cf_veg%soilc_change_patch(p)*dt + + ! maintenance respiration fluxes from xsmrpool + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) + cf_veg%cpool_to_xsmrpool_patch(p)*dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%leaf_xsmr_patch(p)*dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%froot_xsmr_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%livestem_xsmr_patch(p)*dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%livecroot_xsmr_patch(p)*dt + end if + + ! allocation fluxes + if (carbon_resp_opt == 1) then + cf_veg%cpool_to_leafc_patch(p) = cf_veg%cpool_to_leafc_patch(p) - cf_veg%cpool_to_leafc_resp_patch(p) + cf_veg%cpool_to_leafc_storage_patch(p) = cf_veg%cpool_to_leafc_storage_patch(p) - & + cf_veg%cpool_to_leafc_storage_resp_patch(p) + cf_veg%cpool_to_frootc_patch(p) = cf_veg%cpool_to_frootc_patch(p) - cf_veg%cpool_to_frootc_resp_patch(p) + cf_veg%cpool_to_frootc_storage_patch(p) = cf_veg%cpool_to_frootc_storage_patch(p) & + - cf_veg%cpool_to_frootc_storage_resp_patch(p) + end if + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_leafc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_leafc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_frootc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_frootc_storage_patch(p)*dt + if(.not. use_matrixcn) then + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) + cf_veg%cpool_to_leafc_patch(p)*dt + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) + cf_veg%cpool_to_leafc_storage_patch(p)*dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) + cf_veg%cpool_to_frootc_patch(p)*dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) + cf_veg%cpool_to_frootc_storage_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + if (woody(ivt(p)) == 1._r8) then + if (carbon_resp_opt == 1) then + cf_veg%cpool_to_livecrootc_patch(p) = cf_veg%cpool_to_livecrootc_patch(p) - cf_veg%cpool_to_livecrootc_resp_patch(p) + cf_veg%cpool_to_livecrootc_storage_patch(p) = cf_veg%cpool_to_livecrootc_storage_patch(p) - & + cf_veg%cpool_to_livecrootc_storage_resp_patch(p) + cf_veg%cpool_to_livestemc_patch(p) = cf_veg%cpool_to_livestemc_patch(p) - cf_veg%cpool_to_livestemc_resp_patch(p) + cf_veg%cpool_to_livestemc_storage_patch(p) = cf_veg%cpool_to_livestemc_storage_patch(p) - & + cf_veg%cpool_to_livestemc_storage_resp_patch(p) + end if + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livestemc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livestemc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_deadstemc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_deadstemc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livecrootc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livecrootc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_deadcrootc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_deadcrootc_storage_patch(p)*dt + if(.not. use_matrixcn)then + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) + cf_veg%cpool_to_livestemc_patch(p)*dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) + cf_veg%cpool_to_livestemc_storage_patch(p)*dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) + cf_veg%cpool_to_deadstemc_patch(p)*dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) + cf_veg%cpool_to_deadstemc_storage_patch(p)*dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) + cf_veg%cpool_to_livecrootc_patch(p)*dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) + cf_veg%cpool_to_livecrootc_storage_patch(p)*dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) + cf_veg%cpool_to_deadcrootc_patch(p)*dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) + cf_veg%cpool_to_deadcrootc_storage_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if (carbon_resp_opt == 1) then + cf_veg%cpool_to_livestemc_patch(p) = cf_veg%cpool_to_livestemc_patch(p) - cf_veg%cpool_to_livestemc_resp_patch(p) + cf_veg%cpool_to_livestemc_storage_patch(p) = cf_veg%cpool_to_livestemc_storage_patch(p) - & + cf_veg%cpool_to_livestemc_storage_resp_patch(p) + end if + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livestemc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livestemc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_grainc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_grainc_storage_patch(p)*dt + if(.not. use_matrixcn)then + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) + cf_veg%cpool_to_livestemc_patch(p)*dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) + cf_veg%cpool_to_livestemc_storage_patch(p)*dt + cs_veg%grainc_patch(p) = cs_veg%grainc_patch(p) + cf_veg%cpool_to_grainc_patch(p)*dt + cs_veg%grainc_storage_patch(p) = cs_veg%grainc_storage_patch(p) + cf_veg%cpool_to_grainc_storage_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + end if + + ! growth respiration fluxes for current growth + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_leaf_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_froot_gr_patch(p)*dt + + if (woody(ivt(p)) == 1._r8) then + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livestem_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_deadstem_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livecroot_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_deadcroot_gr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livestem_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_grain_gr_patch(p)*dt + end if + + ! growth respiration for transfer growth + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_leaf_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_froot_gr_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_livestem_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_deadstem_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_livecroot_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_deadcroot_gr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_livestem_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_grain_gr_patch(p)*dt + end if + + ! growth respiration at time of storage + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_leaf_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_froot_storage_gr_patch(p)*dt + + if (woody(ivt(p)) == 1._r8) then + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livestem_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_deadstem_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livecroot_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_deadcroot_storage_gr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livestem_storage_gr_patch(p)*dt + + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_grain_storage_gr_patch(p)*dt + + end if + + ! growth respiration stored for release during transfer growth + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_gresp_storage_patch(p)*dt + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) + cf_veg%cpool_to_gresp_storage_patch(p)*dt + + ! move storage pools into transfer pools + if(.not. use_matrixcn)then + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) - cf_veg%leafc_storage_to_xfer_patch(p)*dt + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) + cf_veg%leafc_storage_to_xfer_patch(p)*dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) - cf_veg%frootc_storage_to_xfer_patch(p)*dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) + cf_veg%frootc_storage_to_xfer_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + if (woody(ivt(p)) == 1._r8) then + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) - cf_veg%gresp_storage_to_xfer_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) + cf_veg%gresp_storage_to_xfer_patch(p)*dt + if(.not. use_matrixcn)then + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) - cf_veg%livestemc_storage_to_xfer_patch(p)*dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) + cf_veg%livestemc_storage_to_xfer_patch(p)*dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) - cf_veg%deadstemc_storage_to_xfer_patch(p)*dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) + cf_veg%deadstemc_storage_to_xfer_patch(p)*dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p)- cf_veg%livecrootc_storage_to_xfer_patch(p)*dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) + cf_veg%livecrootc_storage_to_xfer_patch(p)*dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p)- cf_veg%deadcrootc_storage_to_xfer_patch(p)*dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) + cf_veg%deadcrootc_storage_to_xfer_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + if(.not. use_matrixcn)then + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) - cf_veg%livestemc_storage_to_xfer_patch(p)*dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) + cf_veg%livestemc_storage_to_xfer_patch(p)*dt + cs_veg%grainc_storage_patch(p) = cs_veg%grainc_storage_patch(p) - cf_veg%grainc_storage_to_xfer_patch(p)*dt + cs_veg%grainc_xfer_patch(p) = cs_veg%grainc_xfer_patch(p) + cf_veg%grainc_storage_to_xfer_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%livestem_xsmr_patch(p)*dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%grain_xsmr_patch(p)*dt + if (harvdate(p) < 999) then ! beginning at harvest, send to atm + ! TODO (mv, 11-02-2014) the following lines are why the cf_veg is + ! an intent(inout) + ! fluxes should not be updated in this module - not sure where + ! this belongs + ! DML (06-20-2017) While debugging crop isotope code, found that cpool_patch and frootc_patch + ! could occasionally be very small but nonzero numbers after crop harvest, which persists + ! through to next planting and for reasons that could not 100% + ! isolate, caused C12/C13 ratios to occasionally go out of + ! bounds. Zeroing out these small pools and putting them into the flux to the + ! atmosphere solved many of the crop isotope problems + + if ( .not. dribble_crophrv_xsmrpool_2atm ) then + cf_veg%xsmrpool_to_atm_patch(p) = cf_veg%xsmrpool_to_atm_patch(p) + cs_veg%xsmrpool_patch(p)/dt + cf_veg%xsmrpool_to_atm_patch(p) = cf_veg%xsmrpool_to_atm_patch(p) + cs_veg%cpool_patch(p)/dt + if(.not. use_matrixcn)then + cf_veg%xsmrpool_to_atm_patch(p) = cf_veg%xsmrpool_to_atm_patch(p) + cs_veg%frootc_patch(p)/dt + else + cf_veg%xsmrpool_to_atm_patch(p) = cf_veg%xsmrpool_to_atm_patch(p) & + + cs_veg%frootc_patch(p) * matrix_update_phc(p,cf_veg%ifroot_to_iout_ph,1._r8/dt,dt,cnveg_carbonflux_inst,.true.,.true.) + end if + ! Save xsmrpool, cpool, frootc to loss state variable for + ! dribbling + else + ! EBK: 10/08/2020 this could potentially change answers by + ! roundoff relative to the baseline (becuase frootc isn't + ! alsto subtracted here) + cs_veg%xsmrpool_loss_patch(p) = cs_veg%xsmrpool_loss_patch(p) + & + cs_veg%xsmrpool_patch(p) + & + cs_veg%cpool_patch(p) + if(.not. use_matrixcn)then + cs_veg%xsmrpool_loss_patch(p) = cs_veg%xsmrpool_loss_patch(p) + cs_veg%frootc_patch(p) + else + cs_veg%xsmrpool_loss_patch(p) = cs_veg%xsmrpool_loss_patch(p) & + + cs_veg%frootc_patch(p) * matrix_update_phc(p,cf_veg%ifroot_to_iout_ph,1._r8/dt,dt,cnveg_carbonflux_inst,.true.,.true.) + end if + end if + if (.not. use_matrixcn) then + cs_veg%frootc_patch(p) = 0._r8 + end if + cs_veg%xsmrpool_patch(p) = 0._r8 + cs_veg%cpool_patch(p) = 0._r8 + end if + ! Slowly release xsmrpool to atmosphere + if ( dribble_crophrv_xsmrpool_2atm ) then + ! calculate flux of xsmrpool loss to atm + cf_veg%xsmrpool_to_atm_patch(p) = cs_veg%xsmrpool_loss_patch(p) * kprod05 + + ! update xsmrpool loss state + cs_veg%xsmrpool_loss_patch(p) = cs_veg%xsmrpool_loss_patch(p) - cf_veg%xsmrpool_to_atm_patch(p) * dt + end if + end if + + + end do ptch ! end of patch loop + end if ! end of NOT fates + + end associate + + end subroutine CStateUpdate1 + +end module CNCStateUpdate1Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate2Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate2Mod.F90 new file mode 100755 index 000000000..d273520af --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate2Mod.F90 @@ -0,0 +1,289 @@ +module CNCStateUpdate2Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for carbon state variable update, mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_time_manager , only : get_step_size_real + use clm_varpar , only : nlevdecomp, i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use CNvegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use SoilBiogeochemCarbonStatetype , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxtype , only : soilbiogeochem_carbonflux_type + use clm_varctl , only : use_matrixcn, use_soil_matrixcn + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CStateUpdate2 + public:: CStateUpdate2h + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic carbon state + ! variables affected by gap-phase mortality fluxes + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c ,p,j ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & + cs_veg => cnveg_carbonstate_inst , & + + cf_soil => soilbiogeochem_carbonflux_inst, & + cs_soil => soilbiogeochem_carbonstate_inst & + ) + + ! set time steps + dt = get_step_size_real() + + ! column level carbon fluxes from gap-phase mortality + do j = 1,nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column gap mortality fluxes + if (.not. use_soil_matrixcn)then + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) + cf_veg%gap_mortality_c_to_litr_met_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) + cf_veg%gap_mortality_c_to_litr_cel_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) + cf_veg%gap_mortality_c_to_litr_lig_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = & + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + cf_veg%gap_mortality_c_to_cwdc_col(c,j) * dt + else + cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_met_c_col(c,j) * dt + cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_cel_c_col(c,j) * dt + cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_lig_c_col(c,j) * dt + cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_cwdc_col(c,j) * dt + end if !soil_matrix + end do + end do + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) & + - cf_veg%m_gresp_storage_to_litter_patch(p) * dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) & + - cf_veg%m_gresp_xfer_to_litter_patch(p) * dt + if(.not. use_matrixcn)then + ! patch-level carbon fluxes from gap-phase mortality + ! displayed pools + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) & + - cf_veg%m_leafc_to_litter_patch(p) * dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) & + - cf_veg%m_frootc_to_litter_patch(p) * dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) & + - cf_veg%m_livestemc_to_litter_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) & + - cf_veg%m_deadstemc_to_litter_patch(p) * dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) & + - cf_veg%m_livecrootc_to_litter_patch(p) * dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) & + - cf_veg%m_deadcrootc_to_litter_patch(p) * dt + + ! storage pools + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) & + - cf_veg%m_leafc_storage_to_litter_patch(p) * dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) & + - cf_veg%m_frootc_storage_to_litter_patch(p) * dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) & + - cf_veg%m_livestemc_storage_to_litter_patch(p) * dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) & + - cf_veg%m_deadstemc_storage_to_litter_patch(p) * dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) & + - cf_veg%m_livecrootc_storage_to_litter_patch(p) * dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) & + - cf_veg%m_deadcrootc_storage_to_litter_patch(p) * dt + + ! transfer pools + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) & + - cf_veg%m_leafc_xfer_to_litter_patch(p) * dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) & + - cf_veg%m_frootc_xfer_to_litter_patch(p) * dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) & + - cf_veg%m_livestemc_xfer_to_litter_patch(p) * dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) & + - cf_veg%m_deadstemc_xfer_to_litter_patch(p) * dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) & + - cf_veg%m_livecrootc_xfer_to_litter_patch(p) * dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) & + - cf_veg%m_deadcrootc_xfer_to_litter_patch(p) * dt + else + ! NOTE: The matrix version of this is in CNGapMortality (EBK 11/25/2019) + end if !not use_matrixcn + end do ! end of patch loop + + end associate + + end subroutine CStateUpdate2 + + !----------------------------------------------------------------------- + subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! Update all the prognostic carbon state + ! variables affected by harvest mortality fluxes + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & + cs_veg => cnveg_carbonstate_inst , & + cf_soil => soilbiogeochem_carbonflux_inst, & + cs_soil => soilbiogeochem_carbonstate_inst & + ) + + ! set time steps + dt = get_step_size_real() + + ! column level carbon fluxes from harvest mortality + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column harvest fluxes + if (.not. use_soil_matrixcn)then + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) + cf_veg%harvest_c_to_litr_met_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) + cf_veg%harvest_c_to_litr_cel_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) + cf_veg%harvest_c_to_litr_lig_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = & + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + cf_veg%harvest_c_to_cwdc_col(c,j) * dt + else + cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_met_c_col(c,j) * dt + cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_cel_c_col(c,j) * dt + cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_lig_c_col(c,j) * dt + cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = & + cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + cf_veg%harvest_c_to_cwdc_col(c,j) * dt + end if + + ! wood to product pools - states updated in CNProducts + end do + end do + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! xsmrpool + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) & + - cf_veg%hrv_xsmrpool_to_atm_patch(p) * dt + + ! patch-level carbon fluxes from harvest mortality + ! storage pools + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) & + - cf_veg%hrv_gresp_storage_to_litter_patch(p) * dt + + ! transfer pools + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) & + - cf_veg%hrv_gresp_xfer_to_litter_patch(p) * dt + + + if(.not. use_matrixcn)then + ! displayed pools + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) & + - cf_veg%hrv_leafc_to_litter_patch(p) * dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) & + - cf_veg%hrv_frootc_to_litter_patch(p) * dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) & + - cf_veg%hrv_livestemc_to_litter_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) & + - cf_veg%wood_harvestc_patch(p) * dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) & + - cf_veg%hrv_livecrootc_to_litter_patch(p) * dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) & + - cf_veg%hrv_deadcrootc_to_litter_patch(p) * dt + + ! storage pools + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) & + - cf_veg%hrv_leafc_storage_to_litter_patch(p) * dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) & + - cf_veg%hrv_frootc_storage_to_litter_patch(p) * dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) & + - cf_veg%hrv_livestemc_storage_to_litter_patch(p) * dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) & + - cf_veg%hrv_deadstemc_storage_to_litter_patch(p) * dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) & + - cf_veg%hrv_livecrootc_storage_to_litter_patch(p) * dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) & + - cf_veg%hrv_deadcrootc_storage_to_litter_patch(p) * dt + + ! transfer pools + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) & + - cf_veg%hrv_leafc_xfer_to_litter_patch(p) * dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) & + - cf_veg%hrv_frootc_xfer_to_litter_patch(p) * dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) & + - cf_veg%hrv_livestemc_xfer_to_litter_patch(p) * dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) & + - cf_veg%hrv_deadstemc_xfer_to_litter_patch(p) * dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) & + - cf_veg%hrv_livecrootc_xfer_to_litter_patch(p) * dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) & + - cf_veg%hrv_deadcrootc_xfer_to_litter_patch(p) * dt + else + ! NOTE: The matrix equivalent of the above is in CNHarvest (EBK 11/25/2019) + end if + + end do ! end of patch loop + + end associate + + end subroutine CStateUpdate2h + +end module CNCStateUpdate2Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireBaseMod.F90 new file mode 100755 index 000000000..1c5398268 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireBaseMod.F90 @@ -0,0 +1,1302 @@ +module CNFireBaseMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for fire dynamics + ! created in Nov, 2012 and revised in Apr, 2013 by F. Li and S. Levis + ! based on Li et al. (2012a,b; 2013) + ! revised in Apr, 2014 according Li et al.(2014) + ! Fire-related parameters were calibrated or tuned in Apr, 2013 based on the + ! 20th Century transient simulations at f19_g16 with (newfire05_clm45sci15_clm4_0_58) + ! a CLM4.5 version, Qian et al. (2006) atmospheric forcing, and + ! climatological lightning data. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use clm_varpar , only : nlevgrnd + use pftconMod , only : noveg, pftcon + use abortutils , only : endrun + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use CNDVType , only : dgvs_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterStateBulkType , only : waterstatebulk_type + use SoilStateType , only : soilstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + use FireMethodType , only : fire_method_type + use FireDataBaseType , only : fire_base_type + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: cnfire_base_type + + type, public :: cnfire_const_type + ! !PRIVATE MEMBER DATA: + real(r8) :: borealat = 40._r8 ! Latitude for boreal peat fires + real(r8) :: lfuel=75._r8 ! lower threshold of fuel mass (gC/m2) for ignition, Li et al.(2014) + real(r8) :: ufuel=650._r8 ! upper threshold of fuel mass(gC/m2) for ignition + real(r8) :: g0=0.05_r8 ! g(W) when W=0 m/s + real(r8) :: rh_low=30.0_r8 ! Relative humidty low (%) + real(r8) :: rh_hgh=80.0_r8 ! Relative humidty high (%) + real(r8) :: bt_min=0.3_r8 ! btran minimum (fraction) + real(r8) :: bt_max=0.7_r8 ! btran maximum (fraction) + real(r8) :: cli_scale=0.035_r8 ! global constant for deforestation fires (/d) + real(r8) :: boreal_peatfire_c = 4.2e-5_r8 ! c parameter for boreal peatland fire in Li et. al. (2013) (/hr) + real(r8) :: pot_hmn_ign_counts_alpha=0.0035_r8 ! Potential human ignition counts (alpha in Li et. al. 2012) (/person/month) + real(r8) :: non_boreal_peatfire_c = 0.001_r8 ! c parameter for non-boreal peatland fire in Li et. al. (2013) (/hr) + real(r8) :: cropfire_a1 = 0.3_r8 ! a1 parameter for cropland fire in (Li et. al., 2014) (/hr) + real(r8) :: occur_hi_gdp_tree = 0.39_r8 ! fire occurance for high GDP areas that are tree dominated (fraction) + + real(r8) :: cmb_cmplt_fact_litter = 0.5_r8 ! combustion completion factor for litter (unitless) + real(r8) :: cmb_cmplt_fact_cwd = 0.25_r8 ! combustion completion factor for CWD (unitless) + end type + + type, public :: params_type + real(r8) :: prh30 ! Factor related to dependence of fuel combustibility on 30-day running mean of relative humidity (unitless) + real(r8) :: ignition_efficiency ! Ignition efficiency of cloud-to-ground lightning (unitless) + end type params_type + + ! + type, abstract, extends(fire_base_type) :: cnfire_base_type + private + ! !PRIVATE MEMBER DATA: + ! !PUBLIC MEMBER DATA (used by extensions of the base class): + real(r8), public, pointer :: btran2_patch (:) ! patch root zone soil wetness factor (0 to 1) + + contains + ! + ! !PUBLIC MEMBER FUNCTIONS: + procedure, public :: FireInit => CNFireInit ! Initialization of Fire + procedure, public :: FireReadNML ! Read in namelist for CNFire + procedure, public :: CNFireReadParams ! Read in constant parameters from the paramsfile + procedure, public :: CNFireFluxes ! Calculate fire fluxes + procedure, public :: CNFire_calc_fire_root_wetness_Li2014 ! Calculate CN-fire specific root wetness: original version + procedure, public :: CNFire_calc_fire_root_wetness_Li2021 ! Calculate CN-fire specific root wetness: 2021 version + ! !PRIVATE MEMBER FUNCTIONS: + procedure, private :: InitAllocate ! Memory allocation of Fire + procedure, private :: InitHistory ! History file assignment of fire + ! + end type cnfire_base_type + !----------------------------------------------------------------------- + + abstract interface + !----------------------------------------------------------------------- + function need_lightning_and_popdens_interface(this) result(need_lightning_and_popdens) + ! + ! !DESCRIPTION: + ! Returns true if need lightning and popdens, false otherwise + ! + ! USES + import :: cnfire_base_type + ! + ! !ARGUMENTS: + class(cnfire_base_type), intent(in) :: this + logical :: need_lightning_and_popdens ! function result + !----------------------------------------------------------------------- + end function need_lightning_and_popdens_interface + end interface + + type(cnfire_const_type), public, protected :: cnfire_const ! Fire constants shared by Li versons + type(params_type) , public, protected :: cnfire_params ! Fire parameters shared by Li versions + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine CNFireInit( this, bounds ) + ! + ! !DESCRIPTION: + ! Initialize CN Fire module + ! !ARGUMENTS: + class(cnfire_base_type) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + ! Call the base-class Initialization method + call this%BaseFireInit( bounds ) + + ! Allocate memory + call this%InitAllocate( bounds ) + ! History file + ! call this%InitHistory( bounds ) + end subroutine CNFireInit + !---------------------------------------------------------------------- + + subroutine InitAllocate( this, bounds ) + ! + ! Initiaze memory allocate's + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(cnfire_base_type) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + integer :: begp, endp + !------------------------------------------------------------------------ + begp = bounds%begp; endp= bounds%endp + + allocate(this%btran2_patch (begp:endp)) ; this%btran2_patch (:) = nan + + end subroutine InitAllocate + + !---------------------------------------------------------------------- + subroutine CNFire_calc_fire_root_wetness_Li2014( this, bounds, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve ) + ! + ! Calculate the root wetness term that will be used by the fire model + ! + class(cnfire_base_type) :: this + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: num_exposedvegp !number of filters + integer , intent(in) :: filter_exposedvegp(:) !filter array + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(waterstatebulk_type), intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! !LOCAL VARIABLES: + real(r8) :: smp_node, s_node !temporary variables + real(r8) :: smp_node_lf !temporary variable + integer :: p, fp, j, c, l !indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(filter_exposedvegp) >= (/num_exposedvegp/)), sourcefile, __LINE__) + + associate( & + smpso => pftcon%smpso , & ! Input: soil water potential at full stomatal opening (mm) + smpsc => pftcon%smpsc , & ! Input: soil water potential at full stomatal closure (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation + btran2 => this%btran2_patch , & ! Output: [real(r8) (:) ] integrated soil water stress square + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer + h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (porosity) (constant) + ) + + do fp = 1, num_noexposedvegp + p = filter_noexposedvegp(fp) + ! Set for the sake of history diagnostics. The "normal" btran is set to 0 over + ! this filter, so we do the same for btran2. + btran2(p) = 0._r8 + end do + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + btran2(p) = 0._r8 + end do + do j = 1,nlevgrnd + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + c = patch%column(p) + l = patch%landunit(p) + s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) + + call soil_water_retention_curve%soil_suction(c, j, s_node, soilstate_inst, smp_node_lf) + + smp_node_lf = max(smpsc(patch%itype(p)), smp_node_lf) + btran2(p) = btran2(p) +rootfr(p,j)*max(0._r8,min((smp_node_lf - smpsc(patch%itype(p))) / & + (smpso(patch%itype(p)) - smpsc(patch%itype(p))), 1._r8)) + end do + end do + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + if (btran2(p) > 1._r8) then + btran2(p) = 1._r8 + end if + end do + + end associate + + end subroutine CNFire_calc_fire_root_wetness_Li2014 + + !---------------------------------------------------------------------- + subroutine CNFire_calc_fire_root_wetness_Li2021( this, bounds, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve ) + ! + ! Calculate the root wetness term that will be used by the fire model + ! + use pftconMod , only : pftcon + use PatchType , only : patch + class(cnfire_base_type) :: this + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: num_exposedvegp !number of filters + integer , intent(in) :: filter_exposedvegp(:) !filter array + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(waterstatebulk_type), intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! !LOCAL VARIABLES: + real(r8) :: s_node !temporary variables + integer :: p, fp, j, c !indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(filter_exposedvegp) >= (/num_exposedvegp/)), sourcefile, __LINE__) + + associate( & + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation + btran2 => this%btran2_patch , & ! Output: [real(r8) (:) ] integrated soil water stress square + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer + h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (porosity) (constant) + ) + + do fp = 1, num_noexposedvegp + p = filter_noexposedvegp(fp) + ! Set for the sake of history diagnostics. The "normal" btran is set to 0 over + ! this filter, so we do the same for btran2. + btran2(p) = 0._r8 + end do + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + btran2(p) = 0._r8 + end do + do j = 1,nlevgrnd + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + c = patch%column(p) + s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) + + btran2(p) = btran2(p) + rootfr(p,j)*s_node + end do + end do + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + if (btran2(p) > 1._r8) then + btran2(p) = 1._r8 + end if + end do + + end associate + + end subroutine CNFire_calc_fire_root_wetness_Li2021 + !---------------------------------------------------------------------- + + !---------------------------------------------------------------------- + subroutine FireReadNML( this, fire_method ) + ! + ! !DESCRIPTION: + ! Read the namelist for CNFire + ! + ! !USES: + use shr_nl_mod , only : shr_nl_find_group_name + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + class(cnfire_base_type) :: this + character(len=*), intent(in) :: fire_method ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'FireReadNML' + character(len=*), parameter :: nmlname = 'lifire_inparm' + !----------------------------------------------------------------------- + real(r8) :: cli_scale, boreal_peatfire_c, pot_hmn_ign_counts_alpha + real(r8) :: non_boreal_peatfire_c, cropfire_a1 + real(r8) :: rh_low, rh_hgh, bt_min, bt_max, occur_hi_gdp_tree + real(r8) :: lfuel, ufuel, cmb_cmplt_fact_litter, cmb_cmplt_fact_cwd + + + if ( this%need_lightning_and_popdens() ) then + cli_scale = cnfire_const%cli_scale + boreal_peatfire_c = cnfire_const%boreal_peatfire_c + non_boreal_peatfire_c = cnfire_const%non_boreal_peatfire_c + pot_hmn_ign_counts_alpha = cnfire_const%pot_hmn_ign_counts_alpha + cropfire_a1 = cnfire_const%cropfire_a1 + rh_low = cnfire_const%rh_low + rh_hgh = cnfire_const%rh_hgh + lfuel = cnfire_const%lfuel + ufuel = cnfire_const%ufuel + bt_min = cnfire_const%bt_min + bt_max = cnfire_const%bt_max + occur_hi_gdp_tree = cnfire_const%occur_hi_gdp_tree + cmb_cmplt_fact_litter = cnfire_const%cmb_cmplt_fact_litter + cmb_cmplt_fact_cwd = cnfire_const%cmb_cmplt_fact_cwd + ! Initialize options to default values, in case they are not specified in + ! the namelist + + select case (trim(fire_method)) + + case ("nofire") + + case ("li2014qianfrc") + lfuel = 75._r8 + ufuel = 1050._r8 + rh_low = 30.0_r8 + rh_hgh = 80.0_r8 + bt_min = 0.3_r8 + bt_max = 0.7_r8 + cli_scale = 0.035_r8 + boreal_peatfire_c = 4.2e-5_r8 + pot_hmn_ign_counts_alpha = 0.0035_r8 + non_boreal_peatfire_c = 0.001_r8 + cropfire_a1 = 0.3_r8 + occur_hi_gdp_tree = 0.39_r8 + cmb_cmplt_fact_litter = 0.5_r8 + cmb_cmplt_fact_cwd = 0.25_r8 + case ("li2016crufrc") + lfuel = 105._r8 + ufuel = 1050._r8 + rh_low = 30.0_r8 + rh_hgh = 80.0_r8 + bt_min = 0.85_r8 + bt_max = 0.98_r8 + cli_scale = 0.033_r8 + boreal_peatfire_c = 0.09e-4_r8 + pot_hmn_ign_counts_alpha = 0.01_r8 + non_boreal_peatfire_c = 0.17e-3_r8 + cropfire_a1 = 1.6e-4_r8 + occur_hi_gdp_tree = 0.33_r8 + cmb_cmplt_fact_litter = 0.5_r8 + cmb_cmplt_fact_cwd = 0.28_r8 + case ("li2021gswpfrc") + lfuel = 75._r8 + ufuel = 1050._r8 + rh_low = 30.0_r8 + rh_hgh = 80.0_r8 + bt_min = 0.85_r8 + bt_max = 0.98_r8 + cli_scale = 0.025_r8 + boreal_peatfire_c = 0.09e-4_r8 + pot_hmn_ign_counts_alpha = 0.01_r8 + non_boreal_peatfire_c = 0.17e-3_r8 + cropfire_a1 = 1.6e-4_r8 + occur_hi_gdp_tree = 0.33_r8 + cmb_cmplt_fact_litter = 0.5_r8 + cmb_cmplt_fact_cwd = 0.28_r8 + + case default + write(iulog,*) subname//' ERROR: unknown method: ', fire_method + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + + cnfire_const%cli_scale = cli_scale + cnfire_const%boreal_peatfire_c = boreal_peatfire_c + cnfire_const%non_boreal_peatfire_c = non_boreal_peatfire_c + cnfire_const%pot_hmn_ign_counts_alpha = pot_hmn_ign_counts_alpha + cnfire_const%cropfire_a1 = cropfire_a1 + cnfire_const%rh_low = rh_low + cnfire_const%rh_hgh = rh_hgh + cnfire_const%lfuel = lfuel + cnfire_const%ufuel = ufuel + cnfire_const%bt_min = bt_min + cnfire_const%bt_max = bt_max + cnfire_const%occur_hi_gdp_tree = occur_hi_gdp_tree + cnfire_const%cmb_cmplt_fact_litter = cmb_cmplt_fact_litter + cnfire_const%cmb_cmplt_fact_cwd = cmb_cmplt_fact_cwd + + end if + + end subroutine FireReadNML + + !----------------------------------------------------------------------- + subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & + dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, & + leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch, & + totsomc_col, decomp_cpools_vr_col, decomp_npools_vr_col, somc_fire_col) + ! + ! !DESCRIPTION: + ! Fire effects routine for coupled carbon-nitrogen code (CN). + ! Relies primarily on estimate of fractional area burned, from CNFireArea(). + ! + ! Total fire carbon emissions (g C/m2 land area/yr) + ! =avg(COL_FIRE_CLOSS)*seconds_per_year + avg(SOMC_FIRE)*seconds_per_year + + ! avg(LF_CONV_CFLUX)*seconds_per_year*min(1.0,avg(LFC2)*seconds_per_year)*0.8 + ! where avg means the temporal average in a year + ! seconds_per_year is the number of seconds in a year. + ! + ! !USES: + use clm_time_manager , only: get_step_size_real,get_days_per_year,get_curr_date + use clm_varctl , only: use_cndv, use_soil_matrixcn, use_matrixcn + use clm_varcon , only: secspday + use pftconMod , only: nc3crop + use dynSubgridControlMod , only: run_has_transient_landcover + use clm_varpar , only: nlevdecomp_full, ndecomp_pools, nlevdecomp + use clm_varpar , only: ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,iretransn,ioutc,ioutn + use CNVegMatrixMod , only: matrix_update_fic, matrix_update_fin + ! + ! !ARGUMENTS: + class(cnfire_base_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(out) :: num_actfirep ! number of active patches on fire in filter + integer , intent(out) :: filter_actfirep(:) ! filter for soil patches + integer , intent(out) :: num_actfirec ! number of active columns on fire in filter + integer , intent(out) :: filter_actfirec(:) ! filter for soil columns + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst ! only for matrix_decomp_fire_k: (gC/m3/step) VR deomp. C fire loss in matrix representation + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: totsomc_col(bounds%begc:) ! (gC/m2) total soil organic matter C + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(in) :: decomp_npools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(out) :: somc_fire_col(bounds%begc:) ! (gC/m2/s) fire C emissions due to peat burning + ! + ! !LOCAL VARIABLES: + integer :: g,c,p,j,l,kyr, kmo, kda, mcsec ! indices + integer :: fp,fc ! filter indices + real(r8):: f ! rate for fire effects (1/s) + real(r8):: m ! acceleration factor for fuel carbon + real(r8):: dt ! time step variable (s) + real(r8):: dayspyr ! days per year + logical :: transient_landcover ! whether this run has any prescribed transient landcover + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(totsomc_col) == (/bounds%endc/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_npools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(somc_fire_col) == (/bounds%endc/)) , sourcefile, __LINE__) + + ! NOTE: VR = Vertically Resolved + ! conv. = conversion + ! frac. = fraction + ! BAF = Burned Area Fraction + ! ann. = annual + ! GC = gridcell + ! dt = timestep + ! C = Carbon + ! N = Nitrogen + ! emis. = emissions + ! decomp. = decomposing + + associate( & + croot_prof => croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + totsomc => totsomc_col , & ! Input: [real(r8) (:) ] (gC/m2) total soil organic matter C + decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + decomp_npools_vr => decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + somc_fire => somc_fire_col , & ! Output: [real(r8) (:) ] (gC/m2/s) fire C emissions due to peat burning + + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + is_litter => decomp_cascade_con%is_litter , & ! Input: [logical (:) ] TRUE => pool is a litter pool + + woody => pftcon%woody , & ! Input: woody lifeform (1=woody, 0=not woody) + cc_leaf => pftcon%cc_leaf , & ! Input: + cc_lstem => pftcon%cc_lstem , & ! Input: + cc_dstem => pftcon%cc_dstem , & ! Input: + cc_other => pftcon%cc_other , & ! Input: + fm_leaf => pftcon%fm_leaf , & ! Input: + fm_lstem => pftcon%fm_lstem , & ! Input: + fm_other => pftcon%fm_other , & ! Input: + fm_root => pftcon%fm_root , & ! Input: + fm_lroot => pftcon%fm_lroot , & ! Input: + fm_droot => pftcon%fm_droot , & ! Input: + lf_flab => pftcon%lf_flab , & ! Input: + lf_fcel => pftcon%lf_fcel , & ! Input: + lf_flig => pftcon%lf_flig , & ! Input: + fr_flab => pftcon%fr_flab , & ! Input: + fr_fcel => pftcon%fr_fcel , & ! Input: + fr_flig => pftcon%fr_flig , & ! Input: + + cmb_cmplt_fact_litter => cnfire_const%cmb_cmplt_fact_litter , & ! Input: [real(r8) (:) ] Combustion completion factor for litter (unitless) + cmb_cmplt_fact_cwd => cnfire_const%cmb_cmplt_fact_cwd , & ! Input: [real(r8) (:) ] Combustion completion factor for CWD (unitless) + + nind => dgvs_inst%nind_patch , & ! Input: [real(r8) (:) ] number of individuals (#/m2) + + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] fractional area burned (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Input: [real(r8) (:) ] burned area out of conv. region due to LU fire + fbac => cnveg_state_inst%fbac_col , & ! Input: [real(r8) (:) ] total burned area out of conversion (/sec) + baf_crop => cnveg_state_inst%baf_crop_col , & ! Input: [real(r8) (:) ] BAF for cropland + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Input: [real(r8) (:) ] BAF for peatlabd + trotr1_col => cnveg_state_inst%trotr1_col , & ! Input: [real(r8) (:) ] patch weight of BET on the column (0-1) + trotr2_col => cnveg_state_inst%trotr2_col , & ! Input: [real(r8) (:) ] patch weight of BDT on the column (0-1) + dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Input: [real(r8) (:) ] ann. decreased frac. coverage of BET+BDT (0-1) on GC + lfc => cnveg_state_inst%lfc_col , & ! Input: [real(r8) (:) ] conv. area frac. of BET+BDT that haven't burned before + lfc2 => cnveg_state_inst%lfc2_col , & ! Output: [real(r8) (:) ] conv. area frac. of BET+BDT burned this dt (/sec) + + leafcmax => cnveg_carbonstate_inst%leafcmax_patch , & ! Output: [real(r8) (:) ] (gC/m2) ann max leaf C + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C transfer + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + gresp_xfer => cnveg_carbonstate_inst%gresp_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration transfer + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N transfer + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn => cnveg_nitrogenstate_inst%deadstemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N transfer + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn => cnveg_nitrogenstate_inst%deadcrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + fire_mortality_c_to_cwdc => cnveg_carbonflux_inst%fire_mortality_c_to_cwdc_col , & ! Input: [real(r8) (:,:) ] C flux fire mortality to CWD (gC/m3/s) + m_leafc_to_fire => cnveg_carbonflux_inst%m_leafc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc + m_leafc_storage_to_fire => cnveg_carbonflux_inst%m_leafc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_storage + m_leafc_xfer_to_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_xfer + m_livestemc_to_fire => cnveg_carbonflux_inst%m_livestemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from livestemc + m_livestemc_storage_to_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_storage + m_livestemc_xfer_to_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_xfer + m_deadstemc_to_fire => cnveg_carbonflux_inst%m_deadstemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer + m_deadstemc_storage_to_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_storage + m_deadstemc_xfer_to_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer + m_frootc_to_fire => cnveg_carbonflux_inst%m_frootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc + m_frootc_storage_to_fire => cnveg_carbonflux_inst%m_frootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_storage + m_frootc_xfer_to_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_xfer + m_livecrootc_to_fire => cnveg_carbonflux_inst%m_livecrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc + m_livecrootc_storage_to_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_storage + m_livecrootc_xfer_to_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_xfer + m_deadcrootc_to_fire => cnveg_carbonflux_inst%m_deadcrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc + m_deadcrootc_storage_to_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_storage + m_deadcrootc_xfer_to_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_xfer + m_gresp_storage_to_fire => cnveg_carbonflux_inst%m_gresp_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_storage + m_gresp_xfer_to_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_xfer + m_leafc_to_litter_fire => cnveg_carbonflux_inst%m_leafc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafc_storage_to_litter_fire => cnveg_carbonflux_inst%m_leafc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_to_deadstemc_fire => cnveg_carbonflux_inst%m_livestemc_to_deadstemc_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_to_litter_fire => cnveg_carbonflux_inst%m_frootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_frootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_to_deadcrootc_fire => cnveg_carbonflux_inst%m_livecrootc_to_deadcrootc_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_gresp_storage_to_litter_fire => cnveg_carbonflux_inst%m_gresp_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_gresp_xfer_to_litter_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_decomp_cpools_to_fire_vr => cnveg_carbonflux_inst%m_decomp_cpools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] (gC/m3/s) VR decomp. C fire loss + m_c_to_litr_met_fire => cnveg_carbonflux_inst%m_c_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] + m_c_to_litr_cel_fire => cnveg_carbonflux_inst%m_c_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] + m_c_to_litr_lig_fire => cnveg_carbonflux_inst%m_c_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] + + fire_mortality_n_to_cwdn => cnveg_nitrogenflux_inst%fire_mortality_n_to_cwdn_col , & ! Input: [real(r8) (:,:) ] N flux fire mortality to CWD (gN/m3/s) + m_leafn_to_fire => cnveg_nitrogenflux_inst%m_leafn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn + m_leafn_storage_to_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_storage + m_leafn_xfer_to_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_xfer + m_livestemn_to_fire => cnveg_nitrogenflux_inst%m_livestemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn + m_livestemn_storage_to_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_s + m_livestemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_xfer + m_deadstemn_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn + m_deadstemn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_storage + m_deadstemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_xfer + m_frootn_to_fire => cnveg_nitrogenflux_inst%m_frootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn + m_frootn_storage_to_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_storage + m_frootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_xfer + m_livecrootn_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. m_livecrootn_to_fire + m_livecrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_storage + m_livecrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_xfer + m_deadcrootn_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn + m_deadcrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_storage + m_deadcrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_xfer + m_retransn_to_fire => cnveg_nitrogenflux_inst%m_retransn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. retransn + m_leafn_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_to_deadstemn_fire => cnveg_nitrogenflux_inst%m_livestemn_to_deadstemn_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_to_deadcrootn_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_deadcrootn_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_retransn_to_litter_fire => cnveg_nitrogenflux_inst%m_retransn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_decomp_npools_to_fire_vr => cnveg_nitrogenflux_inst%m_decomp_npools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] VR decomp. N fire loss (gN/m3/s) + m_n_to_litr_met_fire => cnveg_nitrogenflux_inst%m_n_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] + m_n_to_litr_cel_fire => cnveg_nitrogenflux_inst%m_n_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] + m_n_to_litr_lig_fire => cnveg_nitrogenflux_inst%m_n_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] + ileaf_to_iout_fic => cnveg_carbonflux_inst%ileaf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_fic => cnveg_carbonflux_inst%ileafst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_fic => cnveg_carbonflux_inst%ileafxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_fic => cnveg_carbonflux_inst%ifroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_fic => cnveg_carbonflux_inst%ifrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_fic => cnveg_carbonflux_inst%ifrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root transfer pool to outside of vegetation pools + ilivestem_to_iout_fic => cnveg_carbonflux_inst%ilivestem_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_fic => cnveg_carbonflux_inst%ilivestemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_fic => cnveg_carbonflux_inst%ilivestemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_fic => cnveg_carbonflux_inst%ideadstem_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_fic => cnveg_carbonflux_inst%ideadstemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_fic => cnveg_carbonflux_inst%ideadstemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_fic => cnveg_carbonflux_inst%ilivecroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_fic => cnveg_carbonflux_inst%ilivecrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_fic => cnveg_carbonflux_inst%ilivecrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_fic => cnveg_carbonflux_inst%ideadcroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_fic => cnveg_carbonflux_inst%ideadcrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_fic => cnveg_carbonflux_inst%ideadcrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root transfer pool to outside of vegetation pools + ilivestem_to_ideadstem_fic => cnveg_carbonflux_inst%ilivestem_to_ideadstem_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_fic => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to dead coarse root pool + ileaf_to_iout_fin => cnveg_nitrogenflux_inst%ileaf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_fin => cnveg_nitrogenflux_inst%ileafst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_fin => cnveg_nitrogenflux_inst%ileafxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_fin => cnveg_nitrogenflux_inst%ifroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_fin => cnveg_nitrogenflux_inst%ifrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ifrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine transfer pool to outside of vegetation pools + ilivestem_to_iout_fin => cnveg_nitrogenflux_inst%ilivestem_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_fin => cnveg_nitrogenflux_inst%ideadstem_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_fin => cnveg_nitrogenflux_inst%ilivecroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_fin => cnveg_nitrogenflux_inst%ideadcroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root transfer pool to outside of vegetation pools + ilivestem_to_ideadstem_fin => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem to dead stem pool + ilivecroot_to_ideadcroot_fin => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to dead coarse root pool + iretransn_to_iout_fin => cnveg_nitrogenflux_inst%iretransn_to_iout_fi & ! Input: [integer (:)] Index of fire related N transfer from retranslocated N pool to outside of vegetation pools + ) + + transient_landcover = run_has_transient_landcover() + + ! Get model step size + ! calculate burned area fraction per sec + dt = get_step_size_real() + + dayspyr = get_days_per_year() + ! + ! patch loop + ! + num_actfirep = 0 + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8)then + ! For non-crop (bare-soil and natural vegetation) + if (transient_landcover) then + f = (fbac(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) + else + f = (farea_burned(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) + end if + else + ! For crops + if(cropf_col(c) > 0._r8)then + f = baf_crop(c) /cropf_col(c) + else + f = 0._r8 + end if + end if + + ! apply this rate to the patch state variables to get flux rates + ! biomass burning + ! carbon fluxes + m = spinup_factor_deadwood + + if(f /= 0)then + num_actfirep = num_actfirep + 1 + filter_actfirep(num_actfirep) = p + end if + m_gresp_storage_to_fire(p) = gresp_storage(p) * f * cc_other(patch%itype(p)) + m_gresp_xfer_to_fire(p) = gresp_xfer(p) * f * cc_other(patch%itype(p)) + if ( .not. use_matrixcn )then + ! NOTE: The non matrix version of this is in CNCStateUpdate3::CStateUpdate3 EBK (11/26/2019) + ! and CNNStateUpdate3::NStateUpdate3 + m_leafc_to_fire(p) = leafc(p) * f * cc_leaf(patch%itype(p)) + m_leafc_storage_to_fire(p) = leafc_storage(p) * f * cc_other(patch%itype(p)) + m_leafc_xfer_to_fire(p) = leafc_xfer(p) * f * cc_other(patch%itype(p)) + m_livestemc_to_fire(p) = livestemc(p) * f * cc_lstem(patch%itype(p)) + m_livestemc_storage_to_fire(p) = livestemc_storage(p) * f * cc_other(patch%itype(p)) + m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * f * cc_other(patch%itype(p)) + m_deadstemc_to_fire(p) = deadstemc(p) * f * cc_dstem(patch%itype(p)) * m + m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * f * cc_other(patch%itype(p)) + m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * f * cc_other(patch%itype(p)) + m_frootc_to_fire(p) = frootc(p) * f * 0._r8 + m_frootc_storage_to_fire(p) = frootc_storage(p) * f * cc_other(patch%itype(p)) + m_frootc_xfer_to_fire(p) = frootc_xfer(p) * f * cc_other(patch%itype(p)) + m_livecrootc_to_fire(p) = livecrootc(p) * f * 0._r8 + m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * f * cc_other(patch%itype(p)) + m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootc_to_fire(p) = deadcrootc(p) * f * 0._r8 + m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * f* cc_other(patch%itype(p)) + m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * f * cc_other(patch%itype(p)) + + + ! nitrogen fluxes + m_leafn_to_fire(p) = leafn(p) * f * cc_leaf(patch%itype(p)) + m_leafn_storage_to_fire(p) = leafn_storage(p) * f * cc_other(patch%itype(p)) + m_leafn_xfer_to_fire(p) = leafn_xfer(p) * f * cc_other(patch%itype(p)) + m_livestemn_to_fire(p) = livestemn(p) * f * cc_lstem(patch%itype(p)) + m_livestemn_storage_to_fire(p) = livestemn_storage(p) * f * cc_other(patch%itype(p)) + m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadstemn_to_fire(p) = deadstemn(p) * f * cc_dstem(patch%itype(p)) * m + m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * f * cc_other(patch%itype(p)) + m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * f * cc_other(patch%itype(p)) + m_frootn_to_fire(p) = frootn(p) * f * 0._r8 + m_frootn_storage_to_fire(p) = frootn_storage(p) * f * cc_other(patch%itype(p)) + m_frootn_xfer_to_fire(p) = frootn_xfer(p) * f * cc_other(patch%itype(p)) + m_livecrootn_to_fire(p) = livecrootn(p) * f * 0._r8 + m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * f * cc_other(patch%itype(p)) + m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootn_to_fire(p) = deadcrootn(p) * f * 0._r8 + m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * f * cc_other(patch%itype(p)) + m_retransn_to_fire(p) = retransn(p) * f * cc_other(patch%itype(p)) + + else + m_leafc_to_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_storage_to_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_xfer_to_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_storage_to_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_to_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_to_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_storage_to_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_xfer_to_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_to_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + + m_leafn_to_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_storage_to_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_xfer_to_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_storage_to_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_to_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_to_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_storage_to_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_xfer_to_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_to_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_retransn_to_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + end if + ! mortality due to fire + ! carbon pools + if ( .not. use_matrixcn )then + ! NOTE: The non matrix version of this is in CNCStateUpdate3::CStateUpdate3 EBK (11/26/2019) + ! and CNNStateUpdate3::NStateUpdate3 + m_leafc_to_litter_fire(p) = leafc(p) * f * & + (1._r8 - cc_leaf(patch%itype(p))) * & + fm_leaf(patch%itype(p)) + m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livestemc_to_litter_fire(p) = livestemc(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent the fraction of plant-tissue mortality for deadstem/deadcroot + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 + m_livestemc_to_deadstemc_fire(p) = livestemc(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from deadstem/deadcroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_deadstemc_to_litter_fire(p) = deadstemc(p) * f * m * & + (1._r8 - cc_dstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootc_to_litter_fire(p) = frootc(p) * f * & + fm_root(patch%itype(p)) + m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livecrootc_to_litter_fire(p) = livecrootc(p) * f * & + fm_droot(patch%itype(p)) + m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * f * & + (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * f * m * & + fm_droot(patch%itype(p)) + m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_gresp_storage_to_litter_fire(p) = gresp_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_gresp_xfer_to_litter_fire(p) = gresp_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + + + ! nitrogen pools + m_leafn_to_litter_fire(p) = leafn(p) * f * & + (1._r8 - cc_leaf(patch%itype(p))) * & + fm_leaf(patch%itype(p)) + m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livestemn_to_litter_fire(p) = livestemn(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent the fraction of plant-tissue mortality for deadstem/deadcroot + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 + m_livestemn_to_deadstemn_fire(p) = livestemn(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from deadstem/deadcroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_deadstemn_to_litter_fire(p) = deadstemn(p) * f * m * & + (1._r8 - cc_dstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootn_to_litter_fire(p) = frootn(p) * f * & + fm_root(patch%itype(p)) + m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livecrootn_to_litter_fire(p) = livecrootn(p) * f * & + fm_droot(patch%itype(p)) + m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * f * & + (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * f * m * & + fm_droot(patch%itype(p)) + m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_retransn_to_litter_fire(p) = retransn(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + + else + m_leafc_to_litter_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic, & + f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_litter_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic, & + f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_deadstemc_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_ideadstem_fic,& + f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_to_litter_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic, & + f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_to_litter_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic, & + f * fm_root(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_litter_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic, & + f * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_ideadcroot_fic,& + f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic, & + f * m * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + + m_leafn_to_litter_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin, & + f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_litter_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin, & + f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_deadstemn_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_ideadstem_fin,& + f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_to_litter_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin, & + f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_to_litter_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin, & + f * fm_root(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_litter_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin, & + f * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_ideadcroot_fin,& + f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin, & + f * m * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + end if + + if (use_cndv) then + if ( woody(patch%itype(p)) == 1._r8 )then + if ( livestemc(p)+deadstemc(p) > 0._r8 )then + nind(p) = nind(p)*(1._r8-1._r8*fm_droot(patch%itype(p))*f) + else + nind(p) = 0._r8 + end if + end if + leafcmax(p) = max(leafc(p)-m_leafc_to_fire(p)*dt, leafcmax(p)) + if (patch%itype(p) == noveg) leafcmax(p) = 0._r8 + end if + + end do ! end of patches loop + + ! fire-induced transfer of carbon and nitrogen pools to litter and cwd + + do j = 1,nlevdecomp + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_deadstemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_deadcrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_deadstemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_deadcrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + + + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_livestemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_livecrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_livestemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_livecrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + + + m_c_to_litr_met_fire(c,j)=m_c_to_litr_met_fire(c,j) + & + ((m_leafc_to_litter_fire(p)*lf_flab(patch%itype(p)) & + +m_leafc_storage_to_litter_fire(p) + & + m_leafc_xfer_to_litter_fire(p) + & + m_gresp_storage_to_litter_fire(p) & + +m_gresp_xfer_to_litter_fire(p))*leaf_prof(p,j) + & + (m_frootc_to_litter_fire(p)*fr_flab(patch%itype(p)) & + +m_frootc_storage_to_litter_fire(p) + & + m_frootc_xfer_to_litter_fire(p))*froot_prof(p,j) & + +(m_livestemc_storage_to_litter_fire(p) + & + m_livestemc_xfer_to_litter_fire(p) & + +m_deadstemc_storage_to_litter_fire(p) + & + m_deadstemc_xfer_to_litter_fire(p))* stem_prof(p,j)& + +(m_livecrootc_storage_to_litter_fire(p) + & + m_livecrootc_xfer_to_litter_fire(p) & + +m_deadcrootc_storage_to_litter_fire(p) + & + m_deadcrootc_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) + m_c_to_litr_cel_fire(c,j)=m_c_to_litr_cel_fire(c,j) + & + (m_leafc_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & + m_frootc_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + m_c_to_litr_lig_fire(c,j)=m_c_to_litr_lig_fire(c,j) + & + (m_leafc_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & + m_frootc_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + + m_n_to_litr_met_fire(c,j)=m_n_to_litr_met_fire(c,j) + & + ((m_leafn_to_litter_fire(p)*lf_flab(patch%itype(p)) & + +m_leafn_storage_to_litter_fire(p) + & + m_leafn_xfer_to_litter_fire(p)+m_retransn_to_litter_fire(p)) & + *leaf_prof(p,j) +(m_frootn_to_litter_fire(p)*fr_flab(patch%itype(p)) & + +m_frootn_storage_to_litter_fire(p) + & + m_frootn_xfer_to_litter_fire(p))*froot_prof(p,j) & + +(m_livestemn_storage_to_litter_fire(p) + & + m_livestemn_xfer_to_litter_fire(p) & + +m_deadstemn_storage_to_litter_fire(p) + & + m_deadstemn_xfer_to_litter_fire(p))* stem_prof(p,j)& + +(m_livecrootn_storage_to_litter_fire(p) + & + m_livecrootn_xfer_to_litter_fire(p) & + +m_deadcrootn_storage_to_litter_fire(p) + & + m_deadcrootn_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) + m_n_to_litr_cel_fire(c,j)=m_n_to_litr_cel_fire(c,j) + & + (m_leafn_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & + m_frootn_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + m_n_to_litr_lig_fire(c,j)=m_n_to_litr_lig_fire(c,j) + & + (m_leafn_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & + m_frootn_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + end do + end do + ! + ! vertically-resolved decomposing C/N fire loss + ! column loop + ! + num_actfirec = 0 + do fc = 1,num_soilc + c = filter_soilc(fc) + + f = farea_burned(c) + + if(f /= 0 .or. f /= baf_crop(c))then + num_actfirec = num_actfirec + 1 + filter_actfirec(num_actfirec) = c + end if + do j = 1, nlevdecomp + ! carbon fluxes + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * f * & + cmb_cmplt_fact_litter + if(use_soil_matrixcn)then! matrix is the same for C and N in the fire. + associate( & + matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] (gC/m3/step) VR deomp. C fire loss in matrix representation + ) + matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) & + - f * cmb_cmplt_fact_litter * dt + end associate + end if + end if + if ( is_cwd(l) ) then + m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * & + (f-baf_crop(c)) * cmb_cmplt_fact_cwd + if(use_soil_matrixcn)then + associate( & + matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] (gC/m3/step) VR deomp. C fire loss in matrix representation + ) + matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) & + - (f-baf_crop(c)) * cmb_cmplt_fact_cwd * dt + end associate + end if + end if + end do + + ! nitrogen fluxes + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * f * & + cmb_cmplt_fact_litter + end if + if ( is_cwd(l) ) then + m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * & + (f-baf_crop(c)) * cmb_cmplt_fact_cwd + end if + end do + + end do + end do ! end of column loop + + ! carbon loss due to deforestation fires + + if (transient_landcover) then + call get_curr_date (kyr, kmo, kda, mcsec) + do fc = 1,num_soilc + c = filter_soilc(fc) + lfc2(c)=0._r8 + if( .not. (kmo == 1 .and. kda == 1 .and. mcsec == 0) )then + if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 .and. dtrotr_col(c) > 0._r8 .and. & + lfc(c) > 0._r8 .and. fbac1(c) == 0._r8) then + lfc2(c) = max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & + baf_peatf(c))/2.0*dt))/(dtrotr_col(c)*dayspyr*secspday/dt)/dt + lfc(c) = lfc(c) - max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & + baf_peatf(c))*dt/2.0_r8)) + end if + end if + end do + end if + ! + ! Carbon loss due to peat fires + ! + ! somc_fire is not connected to clm45 soil carbon pool, ie does not decrease + ! soil carbon b/c clm45 soil carbon was very low in several peatland grids + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if( grc%latdeg(g) < cnfire_const%borealat)then + somc_fire(c)= totsomc(c)*baf_peatf(c)*6.0_r8/33.9_r8 + else + somc_fire(c)= baf_peatf(c)*2.2e3_r8 + end if + end do + + ! Fang Li has not added aerosol and trace gas emissions due to fire, yet + ! They will be added here in proportion to the carbon emission + ! Emission factors differ for various fire types + + end associate + + end subroutine CNFireFluxes + + !----------------------------------------------------------------------- + subroutine CNFireReadParams( this, ncid ) + ! + ! Read in the constant parameters from the input NetCDF parameter file + ! !USES: + use ncdio_pio , only: file_desc_t + use paramUtilMod, only: readNcdioScalar + ! + ! !ARGUMENTS: + implicit none + class(cnfire_base_type) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'CNFireReadParams' + !-------------------------------------------------------------------- + + ! Factor related to dependence of fuel combustibility on 30-day running mean of relative humidity (unitless) + call readNcdioScalar(ncid, 'prh30', subname, cnfire_params%prh30) + ! Ignition efficiency of cloud-to-ground lightning (unitless) + call readNcdioScalar(ncid, 'ignition_efficiency', subname, cnfire_params%ignition_efficiency) + + end subroutine CNFireReadParams + +end module CNFireBaseMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 new file mode 100755 index 000000000..8eedce3fc --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 @@ -0,0 +1,128 @@ +module CNFireFactoryMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Factory to create an instance of fire_method_type. This module figures + ! out the particular type to return. + ! + ! !USES: + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + + implicit none + save + private + ! + ! !PUBLIC ROUTINES: + public :: CNFireReadNML ! read the fire namelist + public :: create_cnfire_method ! create an object of class fire_method_type + + ! !PRIVATE DATA MEMBERS: + character(len=80), private :: fire_method = "li2014qianfrc" + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine CNFireReadNML( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for cnfire + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'CNFireReadNML' + character(len=*), parameter :: nmlname = 'cnfire_inparm' + !----------------------------------------------------------------------- + + namelist /cnfire_inparm/ fire_method + + ! Initialize options to default values, in case they are not specified in + ! the namelist + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=cnfire_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR finding "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (fire_method, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=cnfire_inparm) + write(iulog,*) ' ' + end if + end subroutine CNFireReadNML + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + subroutine create_cnfire_method( cnfire_method ) + ! + ! !DESCRIPTION: + ! Create and return an object of fire_method_type. The particular type + ! is determined based on a namelist parameter. + ! + ! !USES: + use shr_kind_mod , only : SHR_KIND_CL + use FireMethodType , only : fire_method_type + use CNFireNoFireMod , only : cnfire_nofire_type + use CNFireLi2014Mod , only : cnfire_li2014_type + use CNFireLi2016Mod , only : cnfire_li2016_type + use CNFireLi2021Mod , only : cnfire_li2021_type + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + class(fire_method_type), allocatable, intent(inout) :: cnfire_method + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'create_cnfire_method' + !----------------------------------------------------------------------- + + select case (trim(fire_method)) + + case ("nofire") + allocate(cnfire_nofire_type :: cnfire_method) + case ("li2014qianfrc") + allocate(cnfire_li2014_type :: cnfire_method) + case ("li2016crufrc") + allocate(cnfire_li2016_type :: cnfire_method) + case ("li2021gswpfrc") + allocate(cnfire_li2021_type :: cnfire_method) + + case default + write(iulog,*) subname//' ERROR: unknown method: ', fire_method + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + call cnfire_method%FireReadNML( fire_method ) + + end subroutine create_cnfire_method + !----------------------------------------------------------------------- + +end module CNFireFactoryMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 new file mode 100755 index 000000000..e87fac728 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 @@ -0,0 +1,1493 @@ +module CNFireLi2014Mod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for fire dynamics + ! created in Nov, 2012 and revised in Apr, 2013 by F. Li and S. Levis + ! based on Li et al. (2012a,b; 2013) + ! revised in Apr, 2014 according Li et al.(2014) + ! Fire-related parameters were calibrated or tuned in Apr, 2013 based on the + ! 20th Century transient simulations at f19_g16 with (newfire05_clm45sci15_clm4_0_58) + ! a CLM4.5 version, Qian et al. (2006) atmospheric forcing, and + ! climatological lightning data. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_const_mod , only : SHR_CONST_PI,SHR_CONST_TKFRZ + use shr_infnan_mod , only : shr_infnan_isnan + use clm_varctl , only : iulog, use_matrixcn, use_soil_matrixcn + use clm_varpar , only : nlevdecomp, ndecomp_pools, nlevdecomp_full + use clm_varcon , only : dzsoi_decomp + use pftconMod , only : noveg, pftcon + use abortutils , only : endrun + use decompMod , only : bounds_type + use subgridAveMod , only : p2c + use atm2lndType , only : atm2lnd_type + use CNDVType , only : dgvs_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterStateBulkType , only : waterstatebulk_type + use SoilStateType , only : soilstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + use FireMethodType , only : fire_method_type + use CNFireBaseMod , only : cnfire_base_type, cnfire_const, cnfire_params + use CNVegMatrixMod , only : matrix_update_fic, matrix_update_fin + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: cnfire_li2014_type + ! + type, extends(cnfire_base_type) :: cnfire_li2014_type + private + contains + ! + ! !PUBLIC MEMBER FUNCTIONS: + procedure, public :: need_lightning_and_popdens + procedure, public :: CNFireArea ! Calculate fire area + procedure, public :: CNFireFluxes + end type cnfire_li2014_type + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + function need_lightning_and_popdens(this) + ! !ARGUMENTS: + class(cnfire_li2014_type), intent(in) :: this + logical :: need_lightning_and_popdens ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'need_lightning_and_popdens' + !----------------------------------------------------------------------- + + need_lightning_and_popdens = .true. + end function need_lightning_and_popdens + + !----------------------------------------------------------------------- + subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, & + wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) + ! + ! !DESCRIPTION: + ! Computes column-level burned area + ! + ! !USES: + use clm_time_manager , only: get_step_size_real, get_days_per_year, get_curr_date, get_nstep + use clm_varcon , only: secspday, secsphr + use pftconMod , only: nc4_grass, nc3crop, ndllf_evr_tmp_tree + use pftconMod , only: nbrdlf_evr_trp_tree, nbrdlf_dcd_trp_tree, nbrdlf_evr_shrub + use dynSubgridControlMod , only: run_has_transient_landcover + ! + ! !ARGUMENTS: + class(cnfire_li2014_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + real(r8) , intent(in) :: totlitc_col(bounds%begc:) + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) + real(r8) , intent(in) :: t_soi17cm_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,p,pi,j,fc,fp,kyr, kmo, kda, mcsec ! index variables + real(r8) :: dt ! time step variable (s) + real(r8) :: m ! top-layer soil moisture (proportion) + real(r8) :: dayspyr ! days per year + real(r8) :: cli ! effect of climate on deforestation fires (0-1) + real(r8) :: cri ! thresholds used for cli, (mm/d), see Eq.(7) in Li et al.(2013) + real(r8) :: fb ! availability of fuel for regs A and C + real(r8) :: fhd ! impact of hd on agricultural fire + real(r8) :: fgdp ! impact of gdp on agricultural fire + real(r8) :: fire_m ! combustability of fuel for fire occurrence + real(r8) :: spread_m ! combustability of fuel for fire spread + real(r8) :: Lb_lf ! length-to-breadth ratio added by Lifang + integer :: i_cwd ! cwd pool + real(r8) :: lh ! anthro. ignitions (count/km2/hr) + real(r8) :: fs ! hd-dependent fires suppression (0-1) + real(r8) :: ig ! total ignitions (count/km2/hr) + real(r8) :: hdmlf ! human density + real(r8) :: btran_col(bounds%begc:bounds%endc) + logical :: transient_landcover ! whether this run has any prescribed transient landcover + real(r8), target :: prec60_col_target(bounds%begc:bounds%endc) + real(r8), target :: prec10_col_target(bounds%begc:bounds%endc) + real(r8), pointer :: prec60_col(:) + real(r8), pointer :: prec10_col(:) + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(totlitc_col) == (/bounds%endc/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(t_soi17cm_col) == (/bounds%endc/)) , sourcefile, __LINE__) + + associate( & + totlitc => totlitc_col , & ! Input: [real(r8) (:) ] (gC/m2) total lit C (column-level mean) + decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + tsoi17 => t_soi17cm_col , & ! Input: [real(r8) (:) ] (K) soil T for top 0.17 m + lfuel => cnfire_const%lfuel , & ! Input: [real(r8) ] (gC/m2) Lower threshold of fuel mass + ufuel => cnfire_const%ufuel , & ! Input: [real(r8) ] (gC/m2) Upper threshold of fuel mass + rh_hgh => cnfire_const%rh_hgh , & ! Input: [real(r8) ] (%) High relative humidity + rh_low => cnfire_const%rh_low , & ! Input: [real(r8) ] (%) Low relative humidity + bt_min => cnfire_const%bt_min , & ! Input: [real(r8) ] (0-1) Minimum btran + bt_max => cnfire_const%bt_max , & ! Input: [real(r8) ] (0-1) Maximum btran + cli_scale => cnfire_const%cli_scale , & ! Input: [real(r8) ] (/d) global constant for deforestation fires + cropfire_a1 => cnfire_const%cropfire_a1 , & ! Input: [real(r8) ] (/hr) a1 parameter for cropland fire + non_boreal_peatfire_c => cnfire_const%non_boreal_peatfire_c , & ! Input: [real(r8) ] (/hr) c parameter for non-boreal peatland fire + pot_hmn_ign_counts_alpha => cnfire_const%pot_hmn_ign_counts_alpha , & ! Input: [real(r8) ] (/person/month) Potential human ignition counts + boreal_peatfire_c => cnfire_const%boreal_peatfire_c , & ! Input: [real(r8) ] (/hr) c parameter for boreal peatland fire + + fsr_pft => pftcon%fsr_pft , & ! Input: + fd_pft => pftcon%fd_pft , & ! Input: + + btran2 => this%cnfire_base_type%btran2_patch , & ! Input: [real(r8) (:) ] root zone soil wetness + fsat => saturated_excess_runoff_inst%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface + wf => waterdiagnosticbulk_inst%wf_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.05 m + wf2 => waterdiagnosticbulk_inst%wf2_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.17 m + + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + + forc_rh => wateratm2lndbulk_inst%forc_rh_grc , & ! Input: [real(r8) (:) ] relative humidity + forc_wind => atm2lnd_inst%forc_wind_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed (m/s) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric temperature (Kelvin) + forc_rain => wateratm2lndbulk_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] downscaled rain + forc_snow => wateratm2lndbulk_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] downscaled snow + prec60 => wateratm2lndbulk_inst%prec60_patch , & ! Input: [real(r8) (:) ] 60-day running mean of tot. precipitation + prec10 => wateratm2lndbulk_inst%prec10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of tot. precipitation + + dwt_smoothed => cnveg_state_inst%dwt_smoothed_patch , & ! Input: [real(r8) (:) ] change in patch weight (-1 to 1) on the gridcell, smoothed over the year + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + gdp_lf => cnveg_state_inst%gdp_lf_col , & ! Input: [real(r8) (:) ] gdp data + peatf_lf => cnveg_state_inst%peatf_lf_col , & ! Input: [real(r8) (:) ] peatland fraction data + abm_lf => cnveg_state_inst%abm_lf_col , & ! Input: [integer (:) ] prescribed crop fire time + baf_crop => cnveg_state_inst%baf_crop_col , & ! Output: [real(r8) (:) ] burned area fraction for cropland (/sec) + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Output: [real(r8) (:) ] burned area fraction for peatland (/sec) + burndate => cnveg_state_inst%burndate_patch , & ! Output: [integer (:) ] burn date for crop + fbac => cnveg_state_inst%fbac_col , & ! Output: [real(r8) (:) ] total burned area out of conversion (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Output: [real(r8) (:) ] burned area out of conversion region due to land use fire + farea_burned => cnveg_state_inst%farea_burned_col , & ! Output: [real(r8) (:) ] total fractional area burned (/sec) + nfire => cnveg_state_inst%nfire_col , & ! Output: [real(r8) (:) ] fire counts (count/km2/sec), valid only in Reg. C + fsr_col => cnveg_state_inst%fsr_col , & ! Output: [real(r8) (:) ] fire spread rate at column level + fd_col => cnveg_state_inst%fd_col , & ! Output: [real(r8) (:) ] fire duration rate at column level + lgdp_col => cnveg_state_inst%lgdp_col , & ! Output: [real(r8) (:) ] gdp limitation factor for nfire + lgdp1_col => cnveg_state_inst%lgdp1_col , & ! Output: [real(r8) (:) ] gdp limitation factor for baf per fire + lpop_col => cnveg_state_inst%lpop_col , & ! Output: [real(r8) (:) ] pop limitation factor for baf per fire + lfwt => cnveg_state_inst%lfwt_col , & ! Output: [real(r8) (:) ] fractional coverage of non-crop and non-bare-soil Patches + trotr1_col => cnveg_state_inst%trotr1_col , & ! Output: [real(r8) (:) ] patch weight of BET on the column (0-1) + trotr2_col => cnveg_state_inst%trotr2_col , & ! Output: [real(r8) (:) ] patch weight of BDT on the column (0-1) + dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Output: [real(r8) (:) ] decreased frac. coverage of BET+BDT on grid for dt + lfc => cnveg_state_inst%lfc_col , & ! Output: [real(r8) (:) ] conversion area frac. of BET+BDT that haven't burned before + wtlf => cnveg_state_inst%wtlf_col , & ! Output: [real(r8) (:) ] fractional coverage of non-crop Patches + + totvegc => cnveg_carbonstate_inst%totvegc_col , & ! Input: [real(r8) (:) ] totvegc at column level + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + rootc_col => cnveg_carbonstate_inst%rootc_col , & ! Output: [real(r8) (:) ] root carbon + leafc_col => cnveg_carbonstate_inst%leafc_col , & ! Output: [real(r8) (:) ] leaf carbon at column level + fuelc => cnveg_carbonstate_inst%fuelc_col , & ! Output: [real(r8) (:) ] fuel avalability factor for Reg.C + fuelc_crop => cnveg_carbonstate_inst%fuelc_crop_col & ! Output: [real(r8) (:) ] fuel avalability factor for Reg.A + ) + + transient_landcover = run_has_transient_landcover() + + !pft to column average + prec10_col =>prec10_col_target + call p2c(bounds, num_soilc, filter_soilc, & + prec10(bounds%begp:bounds%endp), & + prec10_col(bounds%begc:bounds%endc)) + + prec60_col =>prec60_col_target + call p2c(bounds, num_soilc, filter_soilc, & + prec60(bounds%begp:bounds%endp), & + prec60_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + leafc(bounds%begp:bounds%endp), & + leafc_col(bounds%begc:bounds%endc)) + + call get_curr_date (kyr, kmo, kda, mcsec) + dayspyr = get_days_per_year() + ! Get model step size + dt = get_step_size_real() + ! + ! On first time-step, just set area burned to zero and exit + ! + if ( get_nstep() == 0 )then + do fc = 1,num_soilc + c = filter_soilc(fc) + farea_burned(c) = 0._r8 + baf_crop(c) = 0._r8 + baf_peatf(c) = 0._r8 + fbac(c) = 0._r8 + fbac1(c) = 0._r8 + cropf_col(c) = 0._r8 + end do + return + end if + ! + ! Calculate fraction of crop (cropf_col) and non-crop and non-bare-soil + ! vegetation (lfwt) in vegetated column + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + cropf_col(c) = 0._r8 + lfwt(c) = 0._r8 + end do + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + ! For crop veg types + if( patch%itype(p) > nc4_grass )then + cropf_col(c) = cropf_col(c) + patch%wtcol(p) + end if + ! For natural vegetation (non-crop and non-bare-soil) + if( patch%itype(p) >= ndllf_evr_tmp_tree .and. patch%itype(p) <= nc4_grass )then + lfwt(c) = lfwt(c) + patch%wtcol(p) + end if + end do + ! + ! Calculate crop fuel + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + fuelc_crop(c)=0._r8 + end do + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + ! For crop PFTs, fuel load includes leaf and litter; only + ! column-level litter carbon + ! is available, so we use leaf carbon to estimate the + ! litter carbon for crop PFTs + if( patch%itype(p) > nc4_grass .and. patch%wtcol(p) > 0._r8 .and. leafc_col(c) > 0._r8 )then + fuelc_crop(c)=fuelc_crop(c) + (leafc(p) + leafc_storage(p) + & + leafc_xfer(p))*patch%wtcol(p)/cropf_col(c) + & + totlitc(c)*leafc(p)/leafc_col(c)*patch%wtcol(p)/cropf_col(c) + end if + end do + ! + ! Calculate noncrop column variables + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + fsr_col(c) = 0._r8 + fd_col(c) = 0._r8 + rootc_col(c) = 0._r8 + lgdp_col(c) = 0._r8 + lgdp1_col(c) = 0._r8 + lpop_col(c) = 0._r8 + btran_col(c) = 0._r8 + wtlf(c) = 0._r8 + trotr1_col(c)= 0._r8 + trotr2_col(c)= 0._r8 + if (transient_landcover) then + dtrotr_col(c)=0._r8 + end if + end do + + ! This subroutine calculates btran2 + call this%CNFire_calc_fire_root_wetness_Li2014(bounds, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + c = patch%column(p) + ! For non-crop -- natural vegetation and bare-soil + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8 )then + btran_col(c) = btran_col(c)+btran2(p)*patch%wtcol(p) + wtlf(c) = wtlf(c)+patch%wtcol(p) + end if + end do + + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = col%gridcell(c) + + ! For non-crop -- natural vegetation and bare-soil + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8 )then + + ! NOTE(wjs, 2016-12-15) These calculations of the fraction of evergreen + ! and deciduous tropical trees (used to determine if a column is + ! tropical closed forest) use the current fractions. However, I think + ! they are used in code that applies to land cover change. Note that + ! land cover change is currently generated on the first time step of the + ! year (even though the fire code sees the annually-smoothed dwt). Thus, + ! I think that, for this to be totally consistent, this code should + ! consider the fractional coverage of each PFT prior to the relevant + ! land cover change event. (These fractions could be computed in the + ! code that handles land cover change, so that the fire code remains + ! agnostic to exactly how and when land cover change happens.) + ! + ! For example, if a year started with fractional coverages of + ! nbrdlf_evr_trp_tree = 0.35 and nbrdlf_dcd_trp_tree = 0.35, but then + ! the start-of-year land cover change reduced both of these to 0.2: The + ! current code would consider the column to NOT be tropical closed + ! forest (because nbrdlf_evr_trp_tree+nbrdlf_dcd_trp_tree < 0.6), + ! whereas in fact the land cover change occurred when the column *was* + ! tropical closed forest. + if( patch%itype(p) == nbrdlf_evr_trp_tree .and. patch%wtcol(p) > 0._r8 )then + trotr1_col(c)=trotr1_col(c)+patch%wtcol(p) + end if + if( patch%itype(p) == nbrdlf_dcd_trp_tree .and. patch%wtcol(p) > 0._r8 )then + trotr2_col(c)=trotr2_col(c)+patch%wtcol(p) + end if + + if (transient_landcover) then + if( patch%itype(p) == nbrdlf_evr_trp_tree .or. patch%itype(p) == nbrdlf_dcd_trp_tree )then + if(dwt_smoothed(p) < 0._r8)then + ! Land cover change in CLM happens all at once on the first time + ! step of the year. However, the fire code needs deforestation + ! rates throughout the year, in order to combine these + ! deforestation rates with the current season's climate. So we + ! use a smoothed version of dwt. + ! + ! This isn't ideal, because the carbon stocks that the fire code + ! is operating on will have decreased by the full annual amount + ! before the fire code does anything. But the biggest effect of + ! these deforestation fires is as a trigger for other fires, and + ! the C fluxes are merely diagnostic so don't need to be + ! conservative, so this isn't a big issue. + ! + ! (Actually, it would be even better if the fire code had a + ! realistic breakdown of annual deforestation into the + ! different seasons. But having deforestation spread evenly + ! throughout the year is much better than having it all + ! concentrated on January 1.) + dtrotr_col(c)=dtrotr_col(c)-dwt_smoothed(p) + end if + end if + end if + rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & + frootc_xfer(p) + deadcrootc(p) + & + deadcrootc_storage(p) + deadcrootc_xfer(p) + & + livecrootc(p)+livecrootc_storage(p) + & + livecrootc_xfer(p))*patch%wtcol(p) + + fsr_col(c) = fsr_col(c) + fsr_pft(patch%itype(p))*patch%wtcol(p)/(1.0_r8-cropf_col(c)) + + if( lfwt(c) /= 0.0_r8 )then + hdmlf=this%forc_hdm(g) + + ! all these constants are in Li et al. BG (2012a,b;2013) + + if( hdmlf > 0.1_r8 )then + ! For NOT bare-soil + if( patch%itype(p) /= noveg )then + ! For shrub and grass (crop already excluded above) + if( patch%itype(p) >= nbrdlf_evr_shrub )then !for shurb and grass + lgdp_col(c) = lgdp_col(c) + (0.1_r8 + 0.9_r8* & + exp(-1._r8*SHR_CONST_PI* & + (gdp_lf(c)/8._r8)**0.5_r8))*patch%wtcol(p) & + /(1.0_r8 - cropf_col(c)) + lgdp1_col(c) = lgdp1_col(c) + (0.2_r8 + 0.8_r8* & + exp(-1._r8*SHR_CONST_PI* & + (gdp_lf(c)/7._r8)))*patch%wtcol(p)/lfwt(c) + lpop_col(c) = lpop_col(c) + (0.2_r8 + 0.8_r8* & + exp(-1._r8*SHR_CONST_PI* & + (hdmlf/450._r8)**0.5_r8))*patch%wtcol(p)/lfwt(c) + else ! for trees + if( gdp_lf(c) > 20._r8 )then + lgdp_col(c) =lgdp_col(c)+cnfire_const%occur_hi_gdp_tree*patch%wtcol(p)/(1.0_r8 - cropf_col(c)) + else + lgdp_col(c) = lgdp_col(c)+patch%wtcol(p)/(1.0_r8 - cropf_col(c)) + end if + if( gdp_lf(c) > 20._r8 )then + lgdp1_col(c) = lgdp1_col(c)+0.62_r8*patch%wtcol(p)/lfwt(c) + else + if( gdp_lf(c) > 8._r8 ) then + lgdp1_col(c)=lgdp1_col(c)+0.83_r8*patch%wtcol(p)/lfwt(c) + else + lgdp1_col(c)=lgdp1_col(c)+patch%wtcol(p)/lfwt(c) + end if + end if + lpop_col(c) = lpop_col(c) + (0.4_r8 + 0.6_r8* & + exp(-1._r8*SHR_CONST_PI* & + (hdmlf/125._r8)))*patch%wtcol(p)/lfwt(c) + end if + end if + else + lgdp_col(c) = lgdp_col(c)+patch%wtcol(p)/(1.0_r8 - cropf_col(c)) + lgdp1_col(c) = lgdp1_col(c)+patch%wtcol(p)/lfwt(c) + lpop_col(c) = lpop_col(c)+patch%wtcol(p)/lfwt(c) + end if + end if + + fd_col(c) = fd_col(c) + fd_pft(patch%itype(p)) * patch%wtcol(p) * secsphr / (1.0_r8-cropf_col(c)) + end if + end do + + ! estimate annual decreased fractional coverage of BET+BDT + ! land cover conversion in CLM4.5 is the same for each timestep except for the beginning + + if (transient_landcover) then + do fc = 1,num_soilc + c = filter_soilc(fc) + if( dtrotr_col(c) > 0._r8 )then + if( kmo == 1 .and. kda == 1 .and. mcsec == 0)then + lfc(c) = 0._r8 + end if + if( kmo == 1 .and. kda == 1 .and. mcsec == dt)then + lfc(c) = dtrotr_col(c)*dayspyr*secspday/dt + end if + else + lfc(c)=0._r8 + end if + end do + end if + ! + ! calculate burned area fraction in cropland + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + baf_crop(c)=0._r8 + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if( kmo == 1 .and. kda == 1 .and. mcsec == 0 )then + burndate(p) = 10000 ! init. value; actual range [0 365] + end if + end do + + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = col%gridcell(c) + ! For crop + if( forc_t(c) >= SHR_CONST_TKFRZ .and. patch%itype(p) > nc4_grass .and. & + kmo == abm_lf(c) .and. forc_rain(c)+forc_snow(c) == 0._r8 .and. & + burndate(p) >= 999 .and. patch%wtcol(p) > 0._r8 )then ! catch crop burn time + + hdmlf = this%forc_hdm(g) + + ! calculate human density impact on ag. fire + fhd = 0.04_r8+0.96_r8*exp(-1._r8*SHR_CONST_PI*(hdmlf/350._r8)**0.5_r8) + + ! calculate impact of GDP on ag. fire + fgdp = 0.01_r8+0.99_r8*exp(-1._r8*SHR_CONST_PI*(gdp_lf(c)/10._r8)) + + ! calculate burned area + fb = max(0.0_r8,min(1.0_r8,(fuelc_crop(c)-lfuel)/(ufuel-lfuel))) + + ! crop fire only for generic crop types at this time + ! managed crops are treated as grasses if crop model is turned on + baf_crop(c) = baf_crop(c) + cropfire_a1/secsphr*fb*fhd*fgdp*patch%wtcol(p) + if( fb*fhd*fgdp*patch%wtcol(p) > 0._r8)then + burndate(p)=kda + end if + end if + end do + ! + ! calculate peatland fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + g= col%gridcell(c) + if(grc%latdeg(g) < cnfire_const%borealat )then + baf_peatf(c) = non_boreal_peatfire_c/secsphr*max(0._r8, & + min(1._r8,(4.0_r8-prec60_col(c)*secspday)/ & + 4.0_r8))**2*peatf_lf(c)*(1._r8-fsat(c)) + else + baf_peatf(c) = boreal_peatfire_c/secsphr*exp(-SHR_CONST_PI*(max(wf2(c),0._r8)/0.3_r8))* & + max(0._r8,min(1._r8,(tsoi17(c)-SHR_CONST_TKFRZ)/10._r8))*peatf_lf(c)* & + (1._r8-fsat(c)) + end if + end do + ! + ! calculate other fires + ! + + ! Set the number of timesteps for e-folding. + ! When the simulation has run fewer than this number of steps, + ! re-scale the e-folding time to get a stable early estimate. + + ! find which pool is the cwd pool + i_cwd = 0 + do l = 1, ndecomp_pools + if ( is_cwd(l) ) then + i_cwd = l + endif + end do + + ! + ! begin column loop to calculate fractional area affected by fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + hdmlf=this%forc_hdm(g) + nfire(c) = 0._r8 + if( cropf_col(c) < 1.0 )then + if (trotr1_col(c)+trotr2_col(c)>0.6_r8) then + farea_burned(c)=min(1.0_r8,baf_crop(c)+baf_peatf(c)) + else + fuelc(c) = totlitc(c)+totvegc(c)-rootc_col(c)-fuelc_crop(c)*cropf_col(c) + do j = 1, nlevdecomp + fuelc(c) = fuelc(c)+decomp_cpools_vr(c,j,i_cwd) * dzsoi_decomp(j) + end do + fuelc(c) = fuelc(c)/(1._r8-cropf_col(c)) + fb = max(0.0_r8,min(1.0_r8,(fuelc(c)-lfuel)/(ufuel-lfuel))) + m = max(0._r8,wf(c)) + fire_m = exp(-SHR_CONST_PI *(m/0.69_r8)**2)*(1.0_r8 - max(0._r8, & + min(1._r8,(forc_rh(g)-rh_low)/(rh_hgh-rh_low))))* & + min(1._r8,exp(SHR_CONST_PI*(forc_t(c)-SHR_CONST_TKFRZ)/10._r8)) + lh = pot_hmn_ign_counts_alpha*6.8_r8*hdmlf**(0.43_r8)/30._r8/24._r8 + fs = 1._r8-(0.01_r8+0.98_r8*exp(-0.025_r8*hdmlf)) + ig = (lh+this%forc_lnfm(g)/(5.16_r8+2.16_r8*cos(3._r8*grc%lat(g)))* & + cnfire_params%ignition_efficiency)*(1._r8-fs)*(1._r8-cropf_col(c)) + nfire(c) = ig/secsphr*fb*fire_m*lgdp_col(c) !fire counts/km2/sec + Lb_lf = 1._r8+10.0_r8*(1._r8-EXP(-0.06_r8*forc_wind(g))) + if ( wtlf(c) > 0.0_r8 )then + spread_m = (1.0_r8 - max(0._r8,min(1._r8,(btran_col(c)/wtlf(c)-bt_min)/ & + (bt_max-bt_min))))*(1.0_r8-max(0._r8, & + min(1._r8,(forc_rh(g)-rh_low)/(rh_hgh-rh_low)))) + else + spread_m = 0.0_r8 + end if + farea_burned(c) = min(1._r8,(cnfire_const%g0*spread_m*fsr_col(c)* & + fd_col(c)/1000._r8)**2*lgdp1_col(c)* & + lpop_col(c)*nfire(c)*SHR_CONST_PI*Lb_lf+ & + baf_crop(c)+baf_peatf(c)) ! fraction (0-1) per sec + end if + ! + ! if landuse change data is used, calculate deforestation fires and + ! add it in the total of burned area fraction + ! + if (transient_landcover) then + if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 )then + if(( kmo == 1 .and. kda == 1 .and. mcsec == 0) .or. & + dtrotr_col(c) <=0._r8 )then + fbac1(c) = 0._r8 + farea_burned(c) = baf_crop(c)+baf_peatf(c) + else + cri = (4.0_r8*trotr1_col(c)+1.8_r8*trotr2_col(c))/(trotr1_col(c)+trotr2_col(c)) + cli = (max(0._r8,min(1._r8,(cri-prec60_col(c)*secspday)/cri))**0.5)* & + (max(0._r8,min(1._r8,(cri-prec10_col(c)*secspday)/cri))**0.5)* & + max(0.0005_r8,min(1._r8,19._r8*dtrotr_col(c)*dayspyr*secspday/dt-0.001_r8))* & + max(0._r8,min(1._r8,(0.25_r8-(forc_rain(c)+forc_snow(c))*secsphr)/0.25_r8)) + farea_burned(c) = cli*(cli_scale/secspday)+baf_crop(c)+baf_peatf(c) + ! burned area out of conversion region due to land use fire + fbac1(c) = max(0._r8,cli*(cli_scale/secspday) - 2.0_r8*lfc(c)/dt) + end if + ! total burned area out of conversion + fbac(c) = fbac1(c)+baf_crop(c)+baf_peatf(c) + else + fbac(c) = farea_burned(c) + end if + end if + + else + farea_burned(c) = min(1._r8,baf_crop(c)+baf_peatf(c)) + end if + + end do ! end of column loop + + end associate + + end subroutine CNFireArea + + !----------------------------------------------------------------------- + subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch, & + totsomc_col, decomp_cpools_vr_col, decomp_npools_vr_col, somc_fire_col) + ! + ! !DESCRIPTION: + ! Fire effects routine for coupled carbon-nitrogen code (CN). + ! Relies primarily on estimate of fractional area burned, from CNFireArea(). + ! + ! Total fire carbon emissions (g C/m2 land area/yr) + ! =avg(COL_FIRE_CLOSS)*seconds_per_year + avg(SOMC_FIRE)*seconds_per_year + + ! avg(LF_CONV_CFLUX)*seconds_per_year*min(1.0,avg(LFC2)*seconds_per_year)*0.8 + ! where avg means the temporal average in a year + ! seconds_per_year is the number of seconds in a year. + ! + ! !USES: + use clm_time_manager , only: get_step_size_real,get_days_per_year,get_curr_date + use clm_varctl , only: use_cndv + use clm_varcon , only: secspday + use pftconMod , only: nc3crop + use dynSubgridControlMod , only: run_has_transient_landcover + use clm_varpar , only: ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,iretransn,ioutc,ioutn + ! + ! !ARGUMENTS: + class(cnfire_li2014_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(out) :: num_actfirep ! number of active patches on fire in filter + integer , intent(out) :: filter_actfirep(:) ! filter for soil patches + integer , intent(out) :: num_actfirec ! number of active columns on fire in filter + integer , intent(out) :: filter_actfirec(:) ! filter for soil columns + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: totsomc_col(bounds%begc:) ! (gC/m2) total soil organic matter C + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(in) :: decomp_npools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(out) :: somc_fire_col(bounds%begc:) ! (gC/m2/s) fire C emissions due to peat burning + ! + ! !LOCAL VARIABLES: + integer :: g,c,p,j,l,pi,kyr, kmo, kda, mcsec ! indices + integer :: fp,fc ! filter indices + real(r8):: f ! rate for fire effects (1/s) + real(r8):: m ! acceleration factor for fuel carbon + real(r8):: dt ! time step variable (s) + real(r8):: dayspyr ! days per year + logical :: transient_landcover ! whether this run has any prescribed transient landcover + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(totsomc_col) == (/bounds%endc/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_npools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(somc_fire_col) == (/bounds%endc/)) , sourcefile, __LINE__) + + ! NOTE: VR = Vertically Resolved + ! conv. = conversion + ! frac. = fraction + ! BAF = Burned Area Fraction + ! ann. = annual + ! GC = gridcell + ! dt = timestep + ! C = Carbon + ! N = Nitrogen + ! emis. = emissions + ! decomp. = decomposing + + associate( & + croot_prof => croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + totsomc => totsomc_col , & ! Input: [real(r8) (:) ] (gC/m2) total soil organic matter C + decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + decomp_npools_vr => decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + somc_fire => somc_fire_col , & ! Output: [real(r8) (:) ] (gC/m2/s) fire C emissions due to peat burning + + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + is_litter => decomp_cascade_con%is_litter , & ! Input: [logical (:) ] TRUE => pool is a litter pool + + woody => pftcon%woody , & ! Input: woody lifeform (1=woody, 0=not woody) + cc_leaf => pftcon%cc_leaf , & ! Input: + cc_lstem => pftcon%cc_lstem , & ! Input: + cc_dstem => pftcon%cc_dstem , & ! Input: + cc_other => pftcon%cc_other , & ! Input: + fm_leaf => pftcon%fm_leaf , & ! Input: + fm_lstem => pftcon%fm_lstem , & ! Input: + fm_other => pftcon%fm_other , & ! Input: + fm_root => pftcon%fm_root , & ! Input: + fm_lroot => pftcon%fm_lroot , & ! Input: + fm_droot => pftcon%fm_droot , & ! Input: + lf_flab => pftcon%lf_flab , & ! Input: + lf_fcel => pftcon%lf_fcel , & ! Input: + lf_flig => pftcon%lf_flig , & ! Input: + fr_flab => pftcon%fr_flab , & ! Input: + fr_fcel => pftcon%fr_fcel , & ! Input: + fr_flig => pftcon%fr_flig , & ! Input: + + nind => dgvs_inst%nind_patch , & ! Input: [real(r8) (:) ] number of individuals (#/m2) + + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] fractional area burned (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Input: [real(r8) (:) ] burned area out of conv. region due to LU fire + fbac => cnveg_state_inst%fbac_col , & ! Input: [real(r8) (:) ] total burned area out of conversion (/sec) + baf_crop => cnveg_state_inst%baf_crop_col , & ! Input: [real(r8) (:) ] BAF for cropland + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Input: [real(r8) (:) ] BAF for peatlabd + trotr1_col => cnveg_state_inst%trotr1_col , & ! Input: [real(r8) (:) ] patch weight of BET on the column (0-1) + trotr2_col => cnveg_state_inst%trotr2_col , & ! Input: [real(r8) (:) ] patch weight of BDT on the column (0-1) + dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Input: [real(r8) (:) ] ann. decreased frac. coverage of BET+BDT (0-1) on GC + lfc => cnveg_state_inst%lfc_col , & ! Input: [real(r8) (:) ] conv. area frac. of BET+BDT that haven't burned before + lfc2 => cnveg_state_inst%lfc2_col , & ! Output: [real(r8) (:) ] conv. area frac. of BET+BDT burned this dt (/sec) + + leafcmax => cnveg_carbonstate_inst%leafcmax_patch , & ! Output: [real(r8) (:) ] (gC/m2) ann max leaf C + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C transfer + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + gresp_xfer => cnveg_carbonstate_inst%gresp_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration transfer + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N transfer + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn => cnveg_nitrogenstate_inst%deadstemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N transfer + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn => cnveg_nitrogenstate_inst%deadcrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + fire_mortality_c_to_cwdc => cnveg_carbonflux_inst%fire_mortality_c_to_cwdc_col , & ! Input: [real(r8) (:,:) ] C flux fire mortality to CWD (gC/m3/s) + m_leafc_to_fire => cnveg_carbonflux_inst%m_leafc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc + m_leafc_storage_to_fire => cnveg_carbonflux_inst%m_leafc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_storage + m_leafc_xfer_to_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_xfer + m_livestemc_to_fire => cnveg_carbonflux_inst%m_livestemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from livestemc + m_livestemc_storage_to_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_storage + m_livestemc_xfer_to_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_xfer + m_deadstemc_to_fire => cnveg_carbonflux_inst%m_deadstemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer + m_deadstemc_storage_to_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_storage + m_deadstemc_xfer_to_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer + m_frootc_to_fire => cnveg_carbonflux_inst%m_frootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc + m_frootc_storage_to_fire => cnveg_carbonflux_inst%m_frootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_storage + m_frootc_xfer_to_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_xfer + m_livecrootc_to_fire => cnveg_carbonflux_inst%m_livecrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc + m_livecrootc_storage_to_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_storage + m_livecrootc_xfer_to_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_xfer + m_deadcrootc_to_fire => cnveg_carbonflux_inst%m_deadcrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc + m_deadcrootc_storage_to_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_storage + m_deadcrootc_xfer_to_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_xfer + m_gresp_storage_to_fire => cnveg_carbonflux_inst%m_gresp_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_storage + m_gresp_xfer_to_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_xfer + m_leafc_to_litter_fire => cnveg_carbonflux_inst%m_leafc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafc_storage_to_litter_fire => cnveg_carbonflux_inst%m_leafc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_to_deadstemc_fire => cnveg_carbonflux_inst%m_livestemc_to_deadstemc_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_to_litter_fire => cnveg_carbonflux_inst%m_frootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_frootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_to_deadcrootc_fire => cnveg_carbonflux_inst%m_livecrootc_to_deadcrootc_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_gresp_storage_to_litter_fire => cnveg_carbonflux_inst%m_gresp_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_gresp_xfer_to_litter_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_decomp_cpools_to_fire_vr => cnveg_carbonflux_inst%m_decomp_cpools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] (gC/m3/s) VR decomp. C fire loss + m_c_to_litr_met_fire => cnveg_carbonflux_inst%m_c_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] + m_c_to_litr_cel_fire => cnveg_carbonflux_inst%m_c_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] + m_c_to_litr_lig_fire => cnveg_carbonflux_inst%m_c_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] + + fire_mortality_n_to_cwdn => cnveg_nitrogenflux_inst%fire_mortality_n_to_cwdn_col , & ! Input: [real(r8) (:,:) ] N flux fire mortality to CWD (gN/m3/s) + m_leafn_to_fire => cnveg_nitrogenflux_inst%m_leafn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn + m_leafn_storage_to_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_storage + m_leafn_xfer_to_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_xfer + m_livestemn_to_fire => cnveg_nitrogenflux_inst%m_livestemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn + m_livestemn_storage_to_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_s + m_livestemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_xfer + m_deadstemn_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn + m_deadstemn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_storage + m_deadstemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_xfer + m_frootn_to_fire => cnveg_nitrogenflux_inst%m_frootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn + m_frootn_storage_to_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_storage + m_frootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_xfer + m_livecrootn_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. m_livecrootn_to_fire + m_livecrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_storage + m_livecrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_xfer + m_deadcrootn_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn + m_deadcrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_storage + m_deadcrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_xfer + m_retransn_to_fire => cnveg_nitrogenflux_inst%m_retransn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. retransn + m_leafn_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_to_deadstemn_fire => cnveg_nitrogenflux_inst%m_livestemn_to_deadstemn_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_to_deadcrootn_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_deadcrootn_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_retransn_to_litter_fire => cnveg_nitrogenflux_inst%m_retransn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_decomp_npools_to_fire_vr => cnveg_nitrogenflux_inst%m_decomp_npools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] VR decomp. N fire loss (gN/m3/s) + m_n_to_litr_met_fire => cnveg_nitrogenflux_inst%m_n_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] + m_n_to_litr_cel_fire => cnveg_nitrogenflux_inst%m_n_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] + m_n_to_litr_lig_fire => cnveg_nitrogenflux_inst%m_n_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] + ileaf_to_iout_fic => cnveg_carbonflux_inst%ileaf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_fic => cnveg_carbonflux_inst%ileafst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_fic => cnveg_carbonflux_inst%ileafxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_fic => cnveg_carbonflux_inst%ifroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_fic => cnveg_carbonflux_inst%ifrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_fic => cnveg_carbonflux_inst%ifrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root transfer pool to outside of vegetation pools + ilivestem_to_iout_fic => cnveg_carbonflux_inst%ilivestem_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_fic => cnveg_carbonflux_inst%ilivestemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_fic => cnveg_carbonflux_inst%ilivestemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_fic => cnveg_carbonflux_inst%ideadstem_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_fic => cnveg_carbonflux_inst%ideadstemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_fic => cnveg_carbonflux_inst%ideadstemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_fic => cnveg_carbonflux_inst%ilivecroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_fic => cnveg_carbonflux_inst%ilivecrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_fic => cnveg_carbonflux_inst%ilivecrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_fic => cnveg_carbonflux_inst%ideadcroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_fic => cnveg_carbonflux_inst%ideadcrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_fic => cnveg_carbonflux_inst%ideadcrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root transfer pool to outside of vegetation pools + ilivestem_to_ideadstem_fic => cnveg_carbonflux_inst%ilivestem_to_ideadstem_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_fic => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to dead coarse root pool + ileaf_to_iout_fin => cnveg_nitrogenflux_inst%ileaf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_fin => cnveg_nitrogenflux_inst%ileafst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_fin => cnveg_nitrogenflux_inst%ileafxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_fin => cnveg_nitrogenflux_inst%ifroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_fin => cnveg_nitrogenflux_inst%ifrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ifrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine transfer pool to outside of vegetation pools + ilivestem_to_iout_fin => cnveg_nitrogenflux_inst%ilivestem_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem storage pool to outside of vegetation pool + ilivestemxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_fin => cnveg_nitrogenflux_inst%ideadstem_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_fin => cnveg_nitrogenflux_inst%ilivecroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_fin => cnveg_nitrogenflux_inst%ideadcroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root transfer pool to outside of vegetation pools + ilivestem_to_ideadstem_fin => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem to dead stem pool + ilivecroot_to_ideadcroot_fin => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to dead coarse root pool + iretransn_to_iout_fin => cnveg_nitrogenflux_inst%iretransn_to_iout_fi & ! Input: [integer (:)] Index of fire related N transfer from retranslocated N pool to outside of vegetation pools + ) + + transient_landcover = run_has_transient_landcover() + + ! Get model step size + ! calculate burned area fraction per sec + dt = get_step_size_real() + + dayspyr = get_days_per_year() + ! + ! patch loop + ! + num_actfirep = 0 + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8)then + ! For non-crop (bare-soil and natural vegetation) + if (transient_landcover) then + f = (fbac(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) + else + f = (farea_burned(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) + end if + else + ! For crops + if(cropf_col(c) > 0._r8)then + f = baf_crop(c) /cropf_col(c) + else + f = 0._r8 + end if + end if + + ! apply this rate to the patch state variables to get flux rates + ! biomass burning + ! carbon fluxes + m = spinup_factor_deadwood + + if(f /= 0)then + num_actfirep = num_actfirep + 1 + filter_actfirep(num_actfirep) = p + end if + + m_gresp_storage_to_fire(p) = gresp_storage(p) * f * cc_other(patch%itype(p)) + m_gresp_xfer_to_fire(p) = gresp_xfer(p) * f * cc_other(patch%itype(p)) + if ( .not. use_matrixcn )then + ! NOTE: The non matrix version of this is in CNCStateUpdate3::CStateUpdate3 EBK (11/26/2019) + ! and CNNStateUpdate3::NStateUpdate3 + m_leafc_to_fire(p) = leafc(p) * f * cc_leaf(patch%itype(p)) + m_leafc_storage_to_fire(p) = leafc_storage(p) * f * cc_other(patch%itype(p)) + m_leafc_xfer_to_fire(p) = leafc_xfer(p) * f * cc_other(patch%itype(p)) + m_livestemc_to_fire(p) = livestemc(p) * f * cc_lstem(patch%itype(p)) + m_livestemc_storage_to_fire(p) = livestemc_storage(p) * f * cc_other(patch%itype(p)) + m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * f * cc_other(patch%itype(p)) + m_deadstemc_to_fire(p) = deadstemc(p) * f * cc_dstem(patch%itype(p)) * m + m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * f * cc_other(patch%itype(p)) + m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * f * cc_other(patch%itype(p)) + m_frootc_to_fire(p) = frootc(p) * f * 0._r8 + m_frootc_storage_to_fire(p) = frootc_storage(p) * f * cc_other(patch%itype(p)) + m_frootc_xfer_to_fire(p) = frootc_xfer(p) * f * cc_other(patch%itype(p)) + m_livecrootc_to_fire(p) = livecrootc(p) * f * 0._r8 + m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * f * cc_other(patch%itype(p)) + m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootc_to_fire(p) = deadcrootc(p) * f * 0._r8 + m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * f* cc_other(patch%itype(p)) + m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * f * cc_other(patch%itype(p)) + + + ! nitrogen fluxes + m_leafn_to_fire(p) = leafn(p) * f * cc_leaf(patch%itype(p)) + m_leafn_storage_to_fire(p) = leafn_storage(p) * f * cc_other(patch%itype(p)) + m_leafn_xfer_to_fire(p) = leafn_xfer(p) * f * cc_other(patch%itype(p)) + m_livestemn_to_fire(p) = livestemn(p) * f * cc_lstem(patch%itype(p)) + m_livestemn_storage_to_fire(p) = livestemn_storage(p) * f * cc_other(patch%itype(p)) + m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadstemn_to_fire(p) = deadstemn(p) * f * cc_dstem(patch%itype(p)) * m + m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * f * cc_other(patch%itype(p)) + m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * f * cc_other(patch%itype(p)) + m_frootn_to_fire(p) = frootn(p) * f * 0._r8 + m_frootn_storage_to_fire(p) = frootn_storage(p) * f * cc_other(patch%itype(p)) + m_frootn_xfer_to_fire(p) = frootn_xfer(p) * f * cc_other(patch%itype(p)) + m_livecrootn_to_fire(p) = livecrootn(p) * f * 0._r8 + m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * f * cc_other(patch%itype(p)) + m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootn_to_fire(p) = deadcrootn(p) * f * 0._r8 + m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * f * cc_other(patch%itype(p)) + m_retransn_to_fire(p) = retransn(p) * f * cc_other(patch%itype(p)) + + else + m_leafc_to_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_storage_to_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_xfer_to_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_storage_to_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_to_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_to_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_storage_to_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_xfer_to_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_to_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) + + m_leafn_to_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_storage_to_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_xfer_to_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_storage_to_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_to_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_to_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_storage_to_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_xfer_to_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_to_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_retransn_to_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) + end if + ! mortality due to fire + ! carbon pools + if ( .not. use_matrixcn )then + ! NOTE: The non matrix version of this is in CNCStateUpdate3::CStateUpdate3 EBK (11/26/2019) + ! and CNNStateUpdate3::NStateUpdate3 + m_leafc_to_litter_fire(p) = leafc(p) * f * & + (1._r8 - cc_leaf(patch%itype(p))) * & + fm_leaf(patch%itype(p)) + m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livestemc_to_litter_fire(p) = livestemc(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent the fraction of plant-tissue mortality for deadstem/deadcroot + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 + m_livestemc_to_deadstemc_fire(p) = livestemc(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from deadstem/deadcroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_deadstemc_to_litter_fire(p) = deadstemc(p) * f * m * & + (1._r8 - cc_dstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootc_to_litter_fire(p) = frootc(p) * f * & + fm_root(patch%itype(p)) + m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livecrootc_to_litter_fire(p) = livecrootc(p) * f * & + fm_droot(patch%itype(p)) + m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * f * & + (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * f * m * & + fm_droot(patch%itype(p)) + m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * f * & + (1._r8- cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_gresp_storage_to_litter_fire(p) = gresp_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_gresp_xfer_to_litter_fire(p) = gresp_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + + + ! nitrogen pools + m_leafn_to_litter_fire(p) = leafn(p) * f * & + (1._r8 - cc_leaf(patch%itype(p))) * & + fm_leaf(patch%itype(p)) + m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livestemn_to_litter_fire(p) = livestemn(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent the fraction of plant-tissue mortality for deadstem/deadcroot + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 + m_livestemn_to_deadstemn_fire(p) = livestemn(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from deadstem/deadcroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_deadstemn_to_litter_fire(p) = deadstemn(p) * f * m * & + (1._r8 - cc_dstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootn_to_litter_fire(p) = frootn(p) * f * & + fm_root(patch%itype(p)) + m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter + ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) + m_livecrootn_to_litter_fire(p) = livecrootn(p) * f * & + fm_droot(patch%itype(p)) + m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * f * & + (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * f * m * & + fm_droot(patch%itype(p)) + m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_retransn_to_litter_fire(p) = retransn(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + + else + m_leafc_to_litter_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic, & + f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_litter_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic, & + f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livestemc_to_deadstemc_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_ideadstem_fic,& + f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_to_litter_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic, & + f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_to_litter_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic, & + f * fm_root(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_litter_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic, & + f * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_ideadcroot_fic,& + f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic, & + f * m * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) + + m_leafn_to_litter_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin, & + f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_litter_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin, & + f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livestemn_to_deadstemn_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_ideadstem_fin,& + f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_to_litter_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin, & + f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_to_litter_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin, & + f * fm_root(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_litter_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin, & + f * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_ideadcroot_fin,& + f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin, & + f * m * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) + m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin, & + f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +!KO + ! This term is not currently in the matrix code version of CNFireBaseMod, but there are non-matrix terms for this + ! in CNFireLi2014Mod and in CNFireBaseMod in ctsm5.1.dev012. I'm not adding it here because tests are passing without it. +!KO m_retransn_to_litter_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin, & +!KO f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +!KO + end if + + if (use_cndv) then + if ( woody(patch%itype(p)) == 1._r8 )then + if ( livestemc(p)+deadstemc(p) > 0._r8 )then + nind(p) = nind(p)*(1._r8-1._r8*fm_droot(patch%itype(p))*f) + else + nind(p) = 0._r8 + end if + end if + leafcmax(p) = max(leafc(p)-m_leafc_to_fire(p)*dt, leafcmax(p)) + if (patch%itype(p) == noveg) leafcmax(p) = 0._r8 + end if + + end do ! end of patches loop + + ! fire-induced transfer of carbon and nitrogen pools to litter and cwd + + do j = 1,nlevdecomp + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_deadstemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_deadcrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_deadstemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_deadcrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + + + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_livestemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_livecrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_livestemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_livecrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + + + m_c_to_litr_met_fire(c,j)=m_c_to_litr_met_fire(c,j) + & + ((m_leafc_to_litter_fire(p)*lf_flab(patch%itype(p)) & + +m_leafc_storage_to_litter_fire(p) + & + m_leafc_xfer_to_litter_fire(p) + & + m_gresp_storage_to_litter_fire(p) & + +m_gresp_xfer_to_litter_fire(p))*leaf_prof(p,j) + & + (m_frootc_to_litter_fire(p)*fr_flab(patch%itype(p)) & + +m_frootc_storage_to_litter_fire(p) + & + m_frootc_xfer_to_litter_fire(p))*froot_prof(p,j) & + +(m_livestemc_storage_to_litter_fire(p) + & + m_livestemc_xfer_to_litter_fire(p) & + +m_deadstemc_storage_to_litter_fire(p) + & + m_deadstemc_xfer_to_litter_fire(p))* stem_prof(p,j)& + +(m_livecrootc_storage_to_litter_fire(p) + & + m_livecrootc_xfer_to_litter_fire(p) & + +m_deadcrootc_storage_to_litter_fire(p) + & + m_deadcrootc_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) + m_c_to_litr_cel_fire(c,j)=m_c_to_litr_cel_fire(c,j) + & + (m_leafc_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & + m_frootc_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + m_c_to_litr_lig_fire(c,j)=m_c_to_litr_lig_fire(c,j) + & + (m_leafc_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & + m_frootc_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + + m_n_to_litr_met_fire(c,j)=m_n_to_litr_met_fire(c,j) + & + ((m_leafn_to_litter_fire(p)*lf_flab(patch%itype(p)) & + +m_leafn_storage_to_litter_fire(p) + & + m_leafn_xfer_to_litter_fire(p)+m_retransn_to_litter_fire(p)) & + *leaf_prof(p,j) +(m_frootn_to_litter_fire(p)*fr_flab(patch%itype(p)) & + +m_frootn_storage_to_litter_fire(p) + & + m_frootn_xfer_to_litter_fire(p))*froot_prof(p,j) & + +(m_livestemn_storage_to_litter_fire(p) + & + m_livestemn_xfer_to_litter_fire(p) & + +m_deadstemn_storage_to_litter_fire(p) + & + m_deadstemn_xfer_to_litter_fire(p))* stem_prof(p,j)& + +(m_livecrootn_storage_to_litter_fire(p) + & + m_livecrootn_xfer_to_litter_fire(p) & + +m_deadcrootn_storage_to_litter_fire(p) + & + m_deadcrootn_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) + m_n_to_litr_cel_fire(c,j)=m_n_to_litr_cel_fire(c,j) + & + (m_leafn_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & + m_frootn_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + m_n_to_litr_lig_fire(c,j)=m_n_to_litr_lig_fire(c,j) + & + (m_leafn_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & + m_frootn_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + end do + end do + ! + ! vertically-resolved decomposing C/N fire loss + ! column loop + ! + num_actfirec = 0 + do fc = 1,num_soilc + c = filter_soilc(fc) + + f = farea_burned(c) + + if(f .ne. 0 .or. f .ne. baf_crop(c))then + num_actfirec = num_actfirec + 1 + filter_actfirec(num_actfirec) = c + end if + + ! change CC for litter from 0.4_r8 to 0.5_r8 and CC for CWD from 0.2_r8 + ! to 0.25_r8 according to Li et al.(2014) + do j = 1, nlevdecomp + ! carbon fluxes + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * f * 0.5_r8 + if(use_soil_matrixcn)then + associate( & + matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] + ) + matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) - f * 0.5_r8 * dt + end associate + end if + end if + if ( is_cwd(l) ) then + m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * & + (f-baf_crop(c)) * 0.25_r8 + if(use_soil_matrixcn)then + associate( & + matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] + ) + matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) - (f-baf_crop(c)) * 0.25_r8 * dt + end associate + end if + end if + end do + + ! nitrogen fluxes + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * f * 0.5_r8 + end if + if ( is_cwd(l) ) then + m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * & + (f-baf_crop(c)) * 0.25_r8 + end if + end do + + end do + end do ! end of column loop + + ! carbon loss due to deforestation fires + + if (transient_landcover) then + call get_curr_date (kyr, kmo, kda, mcsec) + do fc = 1,num_soilc + c = filter_soilc(fc) + lfc2(c)=0._r8 + if( .not. (kmo == 1 .and. kda == 1 .and. mcsec == 0) )then + if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 .and. dtrotr_col(c) > 0._r8 .and. & + lfc(c) > 0._r8 .and. fbac1(c) == 0._r8) then + lfc2(c) = max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & + baf_peatf(c))/2.0*dt))/(dtrotr_col(c)*dayspyr*secspday/dt)/dt + lfc(c) = lfc(c) - max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & + baf_peatf(c))*dt/2.0_r8)) + end if + end if + end do + end if + ! + ! Carbon loss due to peat fires + ! + ! somc_fire is not connected to clm45 soil carbon pool, ie does not decrease + ! soil carbon b/c clm45 soil carbon was very low in several peatland grids + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if( grc%latdeg(g) < cnfire_const%borealat)then + somc_fire(c)= totsomc(c)*baf_peatf(c)*6.0_r8/33.9_r8 + else + somc_fire(c)= baf_peatf(c)*2.2e3_r8 + end if + end do + + ! Fang Li has not added aerosol and trace gas emissions due to fire, yet + ! They will be added here in proportion to the carbon emission + ! Emission factors differ for various fire types + + end associate + + end subroutine CNFireFluxes + +end module CNFireLi2014Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 new file mode 100755 index 000000000..afd661cd2 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 @@ -0,0 +1,656 @@ +module CNFireLi2016Mod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for fire dynamics + ! created in Nov, 2012 and revised in Apr, 2013 by F. Li and S. Levis + ! based on Li et al. (2012a,b; 2013) + ! revised in Apr, 2014 according to Li et al.(2014) + ! revised in May, 2015, according to Li et al. (2015, in prep.) + ! Fire-related parameters were calibrated or tuned in May, 2015 based on the + ! 20th Century transient simulations at f19_g16 with a CLM4.5 version + ! (clm50fire), CRUNCEPv5, and climatological lightning data. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_const_mod , only : SHR_CONST_PI,SHR_CONST_TKFRZ + use shr_infnan_mod , only : shr_infnan_isnan + use clm_varctl , only : iulog + use clm_varpar , only : nlevdecomp, ndecomp_pools, nlevdecomp_full + use clm_varcon , only : dzsoi_decomp + use pftconMod , only : noveg, pftcon + use abortutils , only : endrun + use decompMod , only : bounds_type + use subgridAveMod , only : p2c + use atm2lndType , only : atm2lnd_type + use CNDVType , only : dgvs_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterStateBulkType , only : waterstatebulk_type + use SoilStateType , only : soilstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + use SoilBiogeochemStateType , only : get_spinup_latitude_term + use FireMethodType , only : fire_method_type + use CNFireBaseMod , only : cnfire_base_type, cnfire_const, cnfire_params + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: cnfire_li2016_type + ! + type, extends(cnfire_base_type) :: cnfire_li2016_type + private + contains + ! + ! !PUBLIC MEMBER FUNCTIONS: + procedure, public :: need_lightning_and_popdens + procedure, public :: CNFireArea ! Calculate fire area + end type cnfire_li2016_type + + ! + ! !PRIVATE MEMBER DATA: + !----------------------------------------------------------------------- + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + function need_lightning_and_popdens(this) + ! !ARGUMENTS: + class(cnfire_li2016_type), intent(in) :: this + logical :: need_lightning_and_popdens ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'need_lightning_and_popdens' + !----------------------------------------------------------------------- + + need_lightning_and_popdens = .true. + end function need_lightning_and_popdens + + !----------------------------------------------------------------------- + subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, & + wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) + ! + ! !DESCRIPTION: + ! Computes column-level burned area + ! + ! !USES: + use clm_time_manager , only: get_step_size_real, get_days_per_year, get_curr_date, get_nstep + use clm_varcon , only: secspday, secsphr + use clm_varctl , only: spinup_state + use pftconMod , only: nc4_grass, nc3crop, ndllf_evr_tmp_tree + use pftconMod , only: nbrdlf_evr_trp_tree, nbrdlf_dcd_trp_tree, nbrdlf_evr_shrub + use dynSubgridControlMod , only : run_has_transient_landcover + ! + ! !ARGUMENTS: + class(cnfire_li2016_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + real(r8) , intent(in) :: totlitc_col(bounds%begc:) + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) + real(r8) , intent(in) :: t_soi17cm_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + ! + integer :: g,l,c,p,pi,j,fc,fp,kyr, kmo, kda, mcsec ! index variables + real(r8) :: dt ! time step variable (s) + real(r8) :: dayspyr ! days per year + real(r8) :: cli ! effect of climate on deforestation fires (0-1) + real(r8) :: cri ! thresholds used for cli, (mm/d), see Eq.(7) in Li et al.(2013) + real(r8) :: fb ! availability of fuel for regs A and C + real(r8) :: fhd ! impact of hd on agricultural fire + real(r8) :: fgdp ! impact of gdp on agricultural fire + real(r8) :: fire_m ! combustability of fuel for fire occurrence + real(r8) :: spread_m ! combustability of fuel for fire spread + real(r8) :: Lb_lf ! length-to-breadth ratio added by Lifang + integer :: i_cwd ! cwd pool + real(r8) :: lh ! anthro. ignitions (count/km2/hr) + real(r8) :: fs ! hd-dependent fires suppression (0-1) + real(r8) :: ig ! total ignitions (count/km2/hr) + real(r8) :: hdmlf ! human density + real(r8) :: arh, arh30 !combustability of fuel related to RH and RH30 + real(r8) :: afuel !weight for arh and arh30 + real(r8) :: btran_col(bounds%begc:bounds%endc) + logical :: transient_landcover ! whether this run has any prescribed transient landcover + real(r8), target :: prec60_col_target(bounds%begc:bounds%endc) + real(r8), target :: prec10_col_target(bounds%begc:bounds%endc) + real(r8), target :: rh30_col_target(bounds%begc:bounds%endc) + real(r8), pointer :: prec60_col(:) + real(r8), pointer :: prec10_col(:) + real(r8), pointer :: rh30_col(:) + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(totlitc_col) == (/bounds%endc/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(t_soi17cm_col) == (/bounds%endc/)) , sourcefile, __LINE__) + + associate( & + totlitc => totlitc_col , & ! Input: [real(r8) (:) ] (gC/m2) total lit C (column-level mean) + decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + tsoi17 => t_soi17cm_col , & ! Input: [real(r8) (:) ] (K) soil T for top 0.17 m + + lfuel => cnfire_const%lfuel , & ! Input: [real(r8) ] (gC/m2) Lower threshold of fuel mass + ufuel => cnfire_const%ufuel , & ! Input: [real(r8) ] (gC/m2) Upper threshold of fuel mass + rh_hgh => cnfire_const%rh_hgh , & ! Input: [real(r8) ] (%) High relative humidity + rh_low => cnfire_const%rh_low , & ! Input: [real(r8) ] (%) Low relative humidity + bt_min => cnfire_const%bt_min , & ! Input: [real(r8) ] (0-1) Minimum btran + bt_max => cnfire_const%bt_max , & ! Input: [real(r8) ] (0-1) Maximum btran + cli_scale => cnfire_const%cli_scale , & ! Input: [real(r8) ] (/d) global constant for deforestation fires + cropfire_a1 => cnfire_const%cropfire_a1 , & ! Input: [real(r8) ] (/hr) a1 parameter for cropland fire + non_boreal_peatfire_c => cnfire_const%non_boreal_peatfire_c , & ! Input: [real(r8) ] (/hr) c parameter for non-boreal peatland fire + pot_hmn_ign_counts_alpha => cnfire_const%pot_hmn_ign_counts_alpha , & ! Input: [real(r8) ] (/person/month) Potential human ignition counts + boreal_peatfire_c => cnfire_const%boreal_peatfire_c , & ! Input: [real(r8) ] (/hr) c parameter for boreal peatland fire + + fsr_pft => pftcon%fsr_pft , & ! Input: + fd_pft => pftcon%fd_pft , & ! Input: + + btran2 => this%cnfire_base_type%btran2_patch , & ! Input: [real(r8) (:) ] root zone soil wetness + fsat => saturated_excess_runoff_inst%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface + wf2 => waterdiagnosticbulk_inst%wf2_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.17 m + + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + spinup_factor => decomp_cascade_con%spinup_factor , & ! Input: [real(r8) (:) ] factor for AD spinup associated with each pool + + forc_rh => wateratm2lndbulk_inst%forc_rh_grc , & ! Input: [real(r8) (:) ] relative humidity + forc_wind => atm2lnd_inst%forc_wind_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed (m/s) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric temperature (Kelvin) + forc_rain => wateratm2lndbulk_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] downscaled rain + forc_snow => wateratm2lndbulk_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] downscaled snow + prec60 => wateratm2lndbulk_inst%prec60_patch , & ! Input: [real(r8) (:) ] 60-day running mean of tot. precipitation + prec10 => wateratm2lndbulk_inst%prec10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of tot. precipitation + rh30 => wateratm2lndbulk_inst%rh30_patch , & ! Input: [real(r8) (:) ] 10-day running mean of tot. precipitation + dwt_smoothed => cnveg_state_inst%dwt_smoothed_patch , & ! Input: [real(r8) (:) ] change in patch weight (-1 to 1) on the gridcell, smoothed over the year + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + gdp_lf => cnveg_state_inst%gdp_lf_col , & ! Input: [real(r8) (:) ] gdp data + peatf_lf => cnveg_state_inst%peatf_lf_col , & ! Input: [real(r8) (:) ] peatland fraction data + abm_lf => cnveg_state_inst%abm_lf_col , & ! Input: [integer (:) ] prescribed crop fire time + baf_crop => cnveg_state_inst%baf_crop_col , & ! Output: [real(r8) (:) ] burned area fraction for cropland (/sec) + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Output: [real(r8) (:) ] burned area fraction for peatland (/sec) + burndate => cnveg_state_inst%burndate_patch , & ! Output: [integer (:) ] burn date for crop + fbac => cnveg_state_inst%fbac_col , & ! Output: [real(r8) (:) ] total burned area out of conversion (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Output: [real(r8) (:) ] burned area out of conversion region due to land use fire + farea_burned => cnveg_state_inst%farea_burned_col , & ! Output: [real(r8) (:) ] total fractional area burned (/sec) + nfire => cnveg_state_inst%nfire_col , & ! Output: [real(r8) (:) ] fire counts (count/km2/sec), valid only in Reg. C + fsr_col => cnveg_state_inst%fsr_col , & ! Output: [real(r8) (:) ] fire spread rate at column level + fd_col => cnveg_state_inst%fd_col , & ! Output: [real(r8) (:) ] fire duration rate at column level + lgdp_col => cnveg_state_inst%lgdp_col , & ! Output: [real(r8) (:) ] gdp limitation factor for nfire + lgdp1_col => cnveg_state_inst%lgdp1_col , & ! Output: [real(r8) (:) ] gdp limitation factor for baf per fire + lpop_col => cnveg_state_inst%lpop_col , & ! Output: [real(r8) (:) ] pop limitation factor for baf per fire + lfwt => cnveg_state_inst%lfwt_col , & ! Output: [real(r8) (:) ] fractional coverage of non-crop and non-bare-soil Patches + trotr1_col => cnveg_state_inst%trotr1_col , & ! Output: [real(r8) (:) ] patch weight of BET on the column (0-1) + trotr2_col => cnveg_state_inst%trotr2_col , & ! Output: [real(r8) (:) ] patch weight of BDT on the column (0-1) + dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Output: [real(r8) (:) ] decreased frac. coverage of BET+BDT on grid for dt + lfc => cnveg_state_inst%lfc_col , & ! Output: [real(r8) (:) ] conversion area frac. of BET+BDT that haven't burned before + wtlf => cnveg_state_inst%wtlf_col , & ! Output: [real(r8) (:) ] fractional coverage of non-crop Patches + + totvegc => cnveg_carbonstate_inst%totvegc_col , & ! Input: [real(r8) (:) ] totvegc at column level + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem root C + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + rootc_col => cnveg_carbonstate_inst%rootc_col , & ! Output: [real(r8) (:) ] root carbon + leafc_col => cnveg_carbonstate_inst%leafc_col , & ! Output: [real(r8) (:) ] leaf carbon at column level + deadstemc_col => cnveg_carbonstate_inst%deadstemc_col , & ! Output: [real(r8) (:) ] deadstem carbon at column level + fuelc => cnveg_carbonstate_inst%fuelc_col , & ! Output: [real(r8) (:) ] fuel load coutside cropland + fuelc_crop => cnveg_carbonstate_inst%fuelc_crop_col & ! Output: [real(r8) (:) ] fuel load for cropland + ) + + transient_landcover = run_has_transient_landcover() + + !pft to column average + prec10_col =>prec10_col_target + call p2c(bounds, num_soilc, filter_soilc, & + prec10(bounds%begp:bounds%endp), & + prec10_col(bounds%begc:bounds%endc)) + + prec60_col =>prec60_col_target + call p2c(bounds, num_soilc, filter_soilc, & + prec60(bounds%begp:bounds%endp), & + prec60_col(bounds%begc:bounds%endc)) + + rh30_col =>rh30_col_target + call p2c(bounds, num_soilc, filter_soilc, & + rh30(bounds%begp:bounds%endp), & + rh30_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + leafc(bounds%begp:bounds%endp), & + leafc_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + deadstemc(bounds%begp:bounds%endp), & + deadstemc_col(bounds%begc:bounds%endc)) + + call get_curr_date (kyr, kmo, kda, mcsec) + dayspyr = get_days_per_year() + ! Get model step size + dt = get_step_size_real() + ! + ! On first time-step, just set area burned to zero and exit + ! + if ( get_nstep() == 0 )then + do fc = 1,num_soilc + c = filter_soilc(fc) + farea_burned(c) = 0._r8 + baf_crop(c) = 0._r8 + baf_peatf(c) = 0._r8 + fbac(c) = 0._r8 + fbac1(c) = 0._r8 + cropf_col(c) = 0._r8 + end do + return + end if + ! + ! Calculate fraction of crop (cropf_col) and non-crop and non-bare-soil + ! vegetation (lfwt) in vegetated column + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + cropf_col(c) = 0._r8 + lfwt(c) = 0._r8 + end do + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + ! For crop veg types + if( patch%itype(p) > nc4_grass )then + cropf_col(c) = cropf_col(c) + patch%wtcol(p) + end if + ! For natural vegetation (non-crop and non-bare-soil) + if( patch%itype(p) >= ndllf_evr_tmp_tree .and. patch%itype(p) <= nc4_grass )then + lfwt(c) = lfwt(c) + patch%wtcol(p) + end if + end do + ! + ! Calculate crop fuel + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + fuelc_crop(c)=0._r8 + end do + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + ! For crop PFTs, fuel load includes leaf and litter; only + ! column-level litter carbon + ! is available, so we use leaf carbon to estimate the + ! litter carbon for crop PFTs + if( patch%itype(p) > nc4_grass .and. patch%wtcol(p) > 0._r8 .and. leafc_col(c) > 0._r8 )then + fuelc_crop(c)=fuelc_crop(c) + (leafc(p) + leafc_storage(p) + & + leafc_xfer(p))*patch%wtcol(p)/cropf_col(c) + & + totlitc(c)*leafc(p)/leafc_col(c)*patch%wtcol(p)/cropf_col(c) + end if + end do + ! + ! Calculate noncrop column variables + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + fsr_col(c) = 0._r8 + fd_col(c) = 0._r8 + rootc_col(c) = 0._r8 + lgdp_col(c) = 0._r8 + lgdp1_col(c) = 0._r8 + lpop_col(c) = 0._r8 + btran_col(c) = 0._r8 + wtlf(c) = 0._r8 + trotr1_col(c)= 0._r8 + trotr2_col(c)= 0._r8 + if (transient_landcover) then + dtrotr_col(c)=0._r8 + end if + end do + + ! This subroutine calculates btran2 + call this%CNFire_calc_fire_root_wetness_Li2014(bounds, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + c = patch%column(p) + ! For non-crop -- natural vegetation and bare-soil + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8 )then + btran_col(c) = btran_col(c)+btran2(p)*patch%wtcol(p) + wtlf(c) = wtlf(c)+patch%wtcol(p) + end if + end do + + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = col%gridcell(c) + + ! For non-crop -- natural vegetation and bare-soil + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8 )then + + ! NOTE(wjs, 2016-12-15) These calculations of the fraction of evergreen + ! and deciduous tropical trees (used to determine if a column is + ! tropical closed forest) use the current fractions. However, I think + ! they are used in code that applies to land cover change. Note that + ! land cover change is currently generated on the first time step of the + ! year (even though the fire code sees the annually-smoothed dwt). Thus, + ! I think that, for this to be totally consistent, this code should + ! consider the fractional coverage of each PFT prior to the relevant + ! land cover change event. (These fractions could be computed in the + ! code that handles land cover change, so that the fire code remains + ! agnostic to exactly how and when land cover change happens.) + ! + ! For example, if a year started with fractional coverages of + ! nbrdlf_evr_trp_tree = 0.35 and nbrdlf_dcd_trp_tree = 0.35, but then + ! the start-of-year land cover change reduced both of these to 0.2: The + ! current code would consider the column to NOT be tropical closed + ! forest (because nbrdlf_evr_trp_tree+nbrdlf_dcd_trp_tree < 0.6), + ! whereas in fact the land cover change occurred when the column *was* + ! tropical closed forest. + if( patch%itype(p) == nbrdlf_evr_trp_tree .and. patch%wtcol(p) > 0._r8 )then + trotr1_col(c)=trotr1_col(c)+patch%wtcol(p) + end if + if( patch%itype(p) == nbrdlf_dcd_trp_tree .and. patch%wtcol(p) > 0._r8 )then + trotr2_col(c)=trotr2_col(c)+patch%wtcol(p) + end if + + if (transient_landcover) then + if( patch%itype(p) == nbrdlf_evr_trp_tree .or. patch%itype(p) == nbrdlf_dcd_trp_tree )then + if(dwt_smoothed(p) < 0._r8)then + ! Land cover change in CLM happens all at once on the first time + ! step of the year. However, the fire code needs deforestation + ! rates throughout the year, in order to combine these + ! deforestation rates with the current season's climate. So we + ! use a smoothed version of dwt. + ! + ! This isn't ideal, because the carbon stocks that the fire code + ! is operating on will have decreased by the full annual amount + ! before the fire code does anything. But the biggest effect of + ! these deforestation fires is as a trigger for other fires, and + ! the C fluxes are merely diagnostic so don't need to be + ! conservative, so this isn't a big issue. + ! + ! (Actually, it would be even better if the fire code had a + ! realistic breakdown of annual deforestation into the + ! different seasons. But having deforestation spread evenly + ! throughout the year is much better than having it all + ! concentrated on January 1.) + dtrotr_col(c)=dtrotr_col(c)-dwt_smoothed(p) + end if + end if + end if + rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & + frootc_xfer(p) + deadcrootc(p) * spinup_factor_deadwood + & + deadcrootc_storage(p) + deadcrootc_xfer(p) + & + livecrootc(p)+livecrootc_storage(p) + & + livecrootc_xfer(p))*patch%wtcol(p) + + fsr_col(c) = fsr_col(c) + fsr_pft(patch%itype(p))*patch%wtcol(p)/(1.0_r8-cropf_col(c)) + + hdmlf=this%forc_hdm(g) + + ! all these constants are in Li et al. BG (2012a,b;2013) + + if( hdmlf > 0.1_r8 )then + ! For NOT bare-soil + if( patch%itype(p) /= noveg )then + ! For shrub and grass (crop already excluded above) + if( patch%itype(p) >= nbrdlf_evr_shrub )then !for shurb and grass + lgdp_col(c) = lgdp_col(c) + (0.1_r8 + 0.9_r8* & + exp(-1._r8*SHR_CONST_PI* & + (gdp_lf(c)/8._r8)**0.5_r8))*patch%wtcol(p) & + /(1.0_r8 - cropf_col(c)) + lgdp1_col(c) = lgdp1_col(c) + (0.2_r8 + 0.8_r8* & + exp(-1._r8*SHR_CONST_PI* & + (gdp_lf(c)/7._r8)))*patch%wtcol(p)/(1._r8 - cropf_col(c)) + lpop_col(c) = lpop_col(c) + (0.2_r8 + 0.8_r8* & + exp(-1._r8*SHR_CONST_PI* & + (hdmlf/450._r8)**0.5_r8))*patch%wtcol(p)/(1._r8 - cropf_col(c)) + else ! for trees + if( gdp_lf(c) > 20._r8 )then + lgdp_col(c) =lgdp_col(c)+cnfire_const%occur_hi_gdp_tree*patch%wtcol(p)/(1._r8 - cropf_col(c)) + lgdp1_col(c) =lgdp1_col(c)+0.62_r8*patch%wtcol(p)/(1._r8 - cropf_col(c)) + else + if( gdp_lf(c) > 8._r8 )then + lgdp_col(c)=lgdp_col(c)+0.79_r8*patch%wtcol(p)/(1._r8 - cropf_col(c)) + lgdp1_col(c)=lgdp1_col(c)+0.83_r8*patch%wtcol(p)/(1._r8 - cropf_col(c)) + else + lgdp_col(c) = lgdp_col(c)+patch%wtcol(p)/(1._r8 - cropf_col(c)) + lgdp1_col(c)=lgdp1_col(c)+patch%wtcol(p)/(1._r8 - cropf_col(c)) + end if + end if + lpop_col(c) = lpop_col(c) + (0.4_r8 + 0.6_r8* & + exp(-1._r8*SHR_CONST_PI* & + (hdmlf/125._r8)))*patch%wtcol(p)/(1._r8 -cropf_col(c)) + end if + end if + else + lgdp_col(c) = lgdp_col(c)+patch%wtcol(p)/(1.0_r8 - cropf_col(c)) + lgdp1_col(c) = lgdp1_col(c)+patch%wtcol(p)/(1.0_r8 -cropf_col(c)) + lpop_col(c) = lpop_col(c)+patch%wtcol(p)/(1.0_r8 -cropf_col(c)) + end if + + fd_col(c) = fd_col(c) + fd_pft(patch%itype(p)) * patch%wtcol(p) * secsphr / (1.0_r8-cropf_col(c)) + end if + end do + + ! estimate annual decreased fractional coverage of BET+BDT + ! land cover conversion in CLM4.5 is the same for each timestep except for the beginning + + if (transient_landcover) then + do fc = 1,num_soilc + c = filter_soilc(fc) + if( dtrotr_col(c) > 0._r8 )then + if( kmo == 1 .and. kda == 1 .and. mcsec == 0)then + lfc(c) = 0._r8 + end if + if( kmo == 1 .and. kda == 1 .and. mcsec == dt)then + lfc(c) = dtrotr_col(c)*dayspyr*secspday/dt + end if + else + lfc(c)=0._r8 + end if + end do + end if + ! + ! calculate burned area fraction in cropland + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + baf_crop(c)=0._r8 + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if( kmo == 1 .and. kda == 1 .and. mcsec == 0 )then + burndate(p) = 10000 ! init. value; actual range [0 365] + end if + end do + + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = col%gridcell(c) + + ! For crop + if( forc_t(c) >= SHR_CONST_TKFRZ .and. patch%itype(p) > nc4_grass .and. & + kmo == abm_lf(c) .and. & + burndate(p) >= 999 .and. patch%wtcol(p) > 0._r8 )then ! catch crop burn time + + hdmlf = this%forc_hdm(g) + + ! calculate human density impact on ag. fire + fhd = 0.04_r8+0.96_r8*exp(-1._r8*SHR_CONST_PI*(hdmlf/350._r8)**0.5_r8) + + ! calculate impact of GDP on ag. fire + fgdp = 0.01_r8+0.99_r8*exp(-1._r8*SHR_CONST_PI*(gdp_lf(c)/10._r8)) + + ! calculate burned area + fb = max(0.0_r8,min(1.0_r8,(fuelc_crop(c)-lfuel)/(ufuel-lfuel))) + + ! crop fire only for generic crop types at this time + ! managed crops are treated as grasses if crop model is turned on + baf_crop(c) = baf_crop(c) + cropfire_a1/secsphr*fhd*fgdp*patch%wtcol(p) + if( fb*fhd*fgdp*patch%wtcol(p) > 0._r8)then + burndate(p)=kda + end if + end if + end do + ! + ! calculate peatland fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + g= col%gridcell(c) + if(grc%latdeg(g) < cnfire_const%borealat )then + baf_peatf(c) = non_boreal_peatfire_c/secsphr*max(0._r8, & + min(1._r8,(4.0_r8-prec60_col(c)*secspday)/ & + 4.0_r8))**2*peatf_lf(c)*(1._r8-fsat(c)) + else + baf_peatf(c) = boreal_peatfire_c/secsphr*exp(-SHR_CONST_PI*(max(wf2(c),0._r8)/0.3_r8))* & + max(0._r8,min(1._r8,(tsoi17(c)-SHR_CONST_TKFRZ)/10._r8))*peatf_lf(c)* & + (1._r8-fsat(c)) + end if + end do + ! + ! calculate other fires + ! + + ! Set the number of timesteps for e-folding. + ! When the simulation has run fewer than this number of steps, + ! re-scale the e-folding time to get a stable early estimate. + + ! find which pool is the cwd pool + i_cwd = 0 + do l = 1, ndecomp_pools + if ( is_cwd(l) ) then + i_cwd = l + endif + end do + + ! + ! begin column loop to calculate fractional area affected by fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + hdmlf=this%forc_hdm(g) + nfire(c) = 0._r8 + if( cropf_col(c) < 1._r8 )then + fuelc(c) = totlitc(c)+totvegc(c)-rootc_col(c)-fuelc_crop(c)*cropf_col(c) + if (spinup_state == 2) then + fuelc(c) = fuelc(c) + ((spinup_factor_deadwood - 1._r8)*deadstemc_col(c)) + do j = 1, nlevdecomp + fuelc(c) = fuelc(c)+decomp_cpools_vr(c,j,i_cwd) * dzsoi_decomp(j) * spinup_factor(i_cwd) & + * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + end do + else + do j = 1, nlevdecomp + fuelc(c) = fuelc(c)+decomp_cpools_vr(c,j,i_cwd) * dzsoi_decomp(j) + end do + end if + fuelc(c) = fuelc(c)/(1._r8-cropf_col(c)) + fb = max(0.0_r8,min(1.0_r8,(fuelc(c)-lfuel)/(ufuel-lfuel))) + if (trotr1_col(c)+trotr2_col(c)<=0.6_r8) then + afuel =min(1._r8,max(0._r8,(fuelc(c)-2500._r8)/(5000._r8-2500._r8))) + arh=1._r8-max(0._r8, min(1._r8,(forc_rh(g)-rh_low)/(rh_hgh-rh_low))) + arh30=1._r8-max(cnfire_params%prh30, min(1._r8,rh30_col(c)/90._r8)) + if (forc_rh(g) < rh_hgh.and. wtlf(c) > 0._r8 .and. tsoi17(c)> SHR_CONST_TKFRZ)then + fire_m = ((afuel*arh30+(1._r8-afuel)*arh)**1.5_r8)*((1._r8 -max(0._r8,& + min(1._r8,(btran_col(c)/wtlf(c)-bt_min)/(bt_max-bt_min))))**0.5_r8) + else + fire_m = 0._r8 + end if + lh = pot_hmn_ign_counts_alpha*6.8_r8*hdmlf**(0.43_r8)/30._r8/24._r8 + fs = 1._r8-(0.01_r8+0.98_r8*exp(-0.025_r8*hdmlf)) + ig = (lh+this%forc_lnfm(g)/(5.16_r8+2.16_r8*cos(SHR_CONST_PI/180._r8*3*min(60._r8,abs(grc%latdeg(g)))))* & + cnfire_params%ignition_efficiency)*(1._r8-fs)*(1._r8-cropf_col(c)) + nfire(c) = ig/secsphr*fb*fire_m*lgdp_col(c) !fire counts/km2/sec + Lb_lf = 1._r8+10._r8*(1._r8-EXP(-0.06_r8*forc_wind(g))) + spread_m = fire_m**0.5_r8 + farea_burned(c) = min(1._r8,(cnfire_const%g0*spread_m*fsr_col(c)* & + fd_col(c)/1000._r8)**2*lgdp1_col(c)* & + lpop_col(c)*nfire(c)*SHR_CONST_PI*Lb_lf+ & + baf_crop(c)+baf_peatf(c)) ! fraction (0-1) per sec + else + farea_burned(c)=min(1._r8,baf_crop(c)+baf_peatf(c)) + end if + ! + ! if landuse change data is used, calculate deforestation fires and + ! add it in the total of burned area fraction + ! + if (transient_landcover) then + if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 )then + if(( kmo == 1 .and. kda == 1 .and. mcsec == 0) .or. & + dtrotr_col(c) <=0._r8 )then + fbac1(c) = 0._r8 + farea_burned(c) = baf_crop(c)+baf_peatf(c) + else + cri = (4.0_r8*trotr1_col(c)+1.8_r8*trotr2_col(c))/(trotr1_col(c)+trotr2_col(c)) + cli = (max(0._r8,min(1._r8,(cri-prec60_col(c)*secspday)/cri))**0.5)* & + (max(0._r8,min(1._r8,(cri-prec10_col(c)*secspday)/cri))**0.5)* & + max(0.0005_r8,min(1._r8,19._r8*dtrotr_col(c)*dayspyr*secspday/dt-0.001_r8))* & + max(0._r8,min(1._r8,(0.25_r8-(forc_rain(c)+forc_snow(c))*secsphr)/0.25_r8)) + farea_burned(c) = cli*(cli_scale/secspday)+baf_crop(c)+baf_peatf(c) + ! burned area out of conversion region due to land use fire + fbac1(c) = max(0._r8,fb*cli*(cli_scale/secspday) - 2.0_r8*lfc(c)/dt) + end if + ! total burned area out of conversion + fbac(c) = fbac1(c)+baf_crop(c)+baf_peatf(c) + else + fbac(c) = farea_burned(c) + end if + end if + + else + farea_burned(c) = min(1._r8,baf_crop(c)+baf_peatf(c)) + end if + + end do ! end of column loop + + end associate + + end subroutine CNFireArea + +end module CNFireLi2016Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 new file mode 100755 index 000000000..aa61e291e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 @@ -0,0 +1,658 @@ +module CNFireLi2021Mod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for fire dynamics + ! created in Nov, 2012 and revised in Apr, 2013 by F. Li and S. Levis + ! based on Li et al. (2012a,b; 2013) + ! revised in Apr, 2014 according to Li et al.(2014) + ! revised in May, 2015, according to Li et al. (2015, in prep.) + ! Fire-related parameters were calibrated or tuned in May, 2015 based on the + ! 20th Century transient simulations at f19_g16 with a CLM4.5 version + ! (clm50fire), CRUNCEPv5, and climatological lightning data. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_const_mod , only : SHR_CONST_PI,SHR_CONST_TKFRZ + use shr_infnan_mod , only : shr_infnan_isnan + use clm_varctl , only : iulog + use clm_varpar , only : nlevdecomp, ndecomp_pools, nlevdecomp_full, nlevgrnd + use clm_varcon , only : dzsoi_decomp + use pftconMod , only : noveg, pftcon + use abortutils , only : endrun + use decompMod , only : bounds_type + use subgridAveMod , only : p2c + use atm2lndType , only : atm2lnd_type + use CNDVType , only : dgvs_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterStateBulkType , only : waterstatebulk_type + use SoilStateType , only : soilstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + use SoilBiogeochemStateType , only : get_spinup_latitude_term + use FireMethodType , only : fire_method_type + use CNFireBaseMod , only : cnfire_base_type, cnfire_const, cnfire_params + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: cnfire_li2021_type + ! + type, extends(cnfire_base_type) :: cnfire_li2021_type + private + contains + ! + ! !PUBLIC MEMBER FUNCTIONS: + procedure, public :: need_lightning_and_popdens + procedure, public :: CNFireArea ! Calculate fire area + end type cnfire_li2021_type + + ! + ! !PRIVATE MEMBER DATA: + !----------------------------------------------------------------------- + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + function need_lightning_and_popdens(this) + ! !ARGUMENTS: + class(cnfire_li2021_type), intent(in) :: this + logical :: need_lightning_and_popdens ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'need_lightning_and_popdens' + !----------------------------------------------------------------------- + + need_lightning_and_popdens = .true. + end function need_lightning_and_popdens + + !----------------------------------------------------------------------- + subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, & + wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) + ! + ! !DESCRIPTION: + ! Computes column-level burned area + ! + ! !USES: + use clm_time_manager , only: get_step_size_real, get_days_per_year, get_curr_date, get_nstep + use clm_varcon , only: secspday, secsphr + use clm_varctl , only: spinup_state + use pftconMod , only: nc4_grass, nc3crop, ndllf_evr_tmp_tree + use pftconMod , only: nbrdlf_evr_trp_tree, nbrdlf_dcd_trp_tree, nbrdlf_evr_shrub + use dynSubgridControlMod , only : run_has_transient_landcover + ! + ! !ARGUMENTS: + class(cnfire_li2021_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + real(r8) , intent(in) :: totlitc_col(bounds%begc:) + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) + real(r8) , intent(in) :: t_soi17cm_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + ! + integer :: g,l,c,p,pi,j,fc,fp,kyr, kmo, kda, mcsec ! index variables + real(r8) :: dt ! time step variable (s) + real(r8) :: dayspyr ! days per year + real(r8) :: cli ! effect of climate on deforestation fires (0-1) + real(r8) :: cri ! thresholds used for cli, (mm/d), see Eq.(7) in Li et al.(2013) + real(r8) :: fb ! availability of fuel for regs A and C + real(r8) :: fhd ! impact of hd on agricultural fire + real(r8) :: fgdp ! impact of gdp on agricultural fire + real(r8) :: fire_m ! combustability of fuel for fire occurrence + real(r8) :: spread_m ! combustability of fuel for fire spread + real(r8) :: Lb_lf ! length-to-breadth ratio added by Lifang + integer :: i_cwd ! cwd pool + real(r8) :: lh ! anthro. ignitions (count/km2/hr) + real(r8) :: fs ! hd-dependent fires suppression (0-1) + real(r8) :: ig ! total ignitions (count/km2/hr) + real(r8) :: hdmlf ! human density + real(r8) :: arh, arh30 !combustability of fuel related to RH and RH30 + real(r8) :: afuel !weight for arh and arh30 + real(r8) :: btran_col(bounds%begc:bounds%endc) + logical :: transient_landcover ! whether this run has any prescribed transient landcover + real(r8), target :: prec60_col_target(bounds%begc:bounds%endc) + real(r8), target :: prec10_col_target(bounds%begc:bounds%endc) + real(r8), target :: rh30_col_target(bounds%begc:bounds%endc) + real(r8), pointer :: prec60_col(:) + real(r8), pointer :: prec10_col(:) + real(r8), pointer :: rh30_col(:) + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(totlitc_col) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(t_soi17cm_col) == (/bounds%endc/)), sourcefile, __LINE__) + + associate( & + totlitc => totlitc_col , & ! Input: [real(r8) (:) ] (gC/m2) total lit C (column-level mean) + decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + tsoi17 => t_soi17cm_col , & ! Input: [real(r8) (:) ] (K) soil T for top 0.17 m + + lfuel => cnfire_const%lfuel , & ! Input: [real(r8) ] (gC/m2) Lower threshold of fuel mass + ufuel => cnfire_const%ufuel , & ! Input: [real(r8) ] (gC/m2) Upper threshold of fuel mass + rh_hgh => cnfire_const%rh_hgh , & ! Input: [real(r8) ] (%) High relative humidity + rh_low => cnfire_const%rh_low , & ! Input: [real(r8) ] (%) Low relative humidity + cli_scale => cnfire_const%cli_scale , & ! Input: [real(r8) ] (/d) global constant for deforestation fires + cropfire_a1 => cnfire_const%cropfire_a1 , & ! Input: [real(r8) ] (/hr) a1 parameter for cropland fire + non_boreal_peatfire_c => cnfire_const%non_boreal_peatfire_c , & ! Input: [real(r8) ] (/hr) c parameter for non-boreal peatland fire + pot_hmn_ign_counts_alpha => cnfire_const%pot_hmn_ign_counts_alpha , & ! Input: [real(r8) ] (/person/month) Potential human ignition counts + boreal_peatfire_c => cnfire_const%boreal_peatfire_c , & ! Input: [real(r8) ] (/hr) c parameter for boreal peatland fire + + fsr_pft => pftcon%fsr_pft , & ! Input: + fd_pft => pftcon%fd_pft , & ! Input: + rswf_min => pftcon%rswf_min , & ! Input: + rswf_max => pftcon%rswf_max , & ! Input: + btran2 => this%cnfire_base_type%btran2_patch , & ! Input: [real(r8) (:) ] root zone soil wetness + fsat => saturated_excess_runoff_inst%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface + wf2 => waterdiagnosticbulk_inst%wf2_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.17 m + + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + spinup_factor => decomp_cascade_con%spinup_factor , & ! Input: [real(r8) (:) ] factor for AD spinup associated with each pool + + forc_rh => wateratm2lndbulk_inst%forc_rh_grc , & ! Input: [real(r8) (:) ] relative humidity + forc_wind => atm2lnd_inst%forc_wind_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed (m/s) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric temperature (Kelvin) + forc_rain => wateratm2lndbulk_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] downscaled rain + forc_snow => wateratm2lndbulk_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] downscaled snow + prec60 => wateratm2lndbulk_inst%prec60_patch , & ! Input: [real(r8) (:) ] 60-day running mean of tot. precipitation + prec10 => wateratm2lndbulk_inst%prec10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of tot. precipitation + rh30 => wateratm2lndbulk_inst%rh30_patch , & ! Input: [real(r8) (:) ] 10-day running mean of tot. precipitation + dwt_smoothed => cnveg_state_inst%dwt_smoothed_patch , & ! Input: [real(r8) (:) ] change in patch weight (-1 to 1) on the gridcell, smoothed over the year + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + gdp_lf => cnveg_state_inst%gdp_lf_col , & ! Input: [real(r8) (:) ] gdp data + peatf_lf => cnveg_state_inst%peatf_lf_col , & ! Input: [real(r8) (:) ] peatland fraction data + abm_lf => cnveg_state_inst%abm_lf_col , & ! Input: [integer (:) ] prescribed crop fire time + baf_crop => cnveg_state_inst%baf_crop_col , & ! Output: [real(r8) (:) ] burned area fraction for cropland (/sec) + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Output: [real(r8) (:) ] burned area fraction for peatland (/sec) + burndate => cnveg_state_inst%burndate_patch , & ! Output: [integer (:) ] burn date for crop + fbac => cnveg_state_inst%fbac_col , & ! Output: [real(r8) (:) ] total burned area out of conversion (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Output: [real(r8) (:) ] burned area out of conversion region due to land use fire + farea_burned => cnveg_state_inst%farea_burned_col , & ! Output: [real(r8) (:) ] total fractional area burned (/sec) + nfire => cnveg_state_inst%nfire_col , & ! Output: [real(r8) (:) ] fire counts (count/km2/sec), valid only in Reg. C + fsr_col => cnveg_state_inst%fsr_col , & ! Output: [real(r8) (:) ] fire spread rate at column level + fd_col => cnveg_state_inst%fd_col , & ! Output: [real(r8) (:) ] fire duration rate at column level + lgdp_col => cnveg_state_inst%lgdp_col , & ! Output: [real(r8) (:) ] gdp limitation factor for nfire + lgdp1_col => cnveg_state_inst%lgdp1_col , & ! Output: [real(r8) (:) ] gdp limitation factor for baf per fire + lpop_col => cnveg_state_inst%lpop_col , & ! Output: [real(r8) (:) ] pop limitation factor for baf per fire + lfwt => cnveg_state_inst%lfwt_col , & ! Output: [real(r8) (:) ] fractional coverage of non-crop and non-bare-soil Patches + trotr1_col => cnveg_state_inst%trotr1_col , & ! Output: [real(r8) (:) ] patch weight of BET on the column (0-1) + trotr2_col => cnveg_state_inst%trotr2_col , & ! Output: [real(r8) (:) ] patch weight of BDT on the column (0-1) + dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Output: [real(r8) (:) ] decreased frac. coverage of BET+BDT on grid for dt + lfc => cnveg_state_inst%lfc_col , & ! Output: [real(r8) (:) ] conversion area frac. of BET+BDT that haven't burned before + wtlf => cnveg_state_inst%wtlf_col , & ! Output: [real(r8) (:) ] fractional coverage of non-crop Patches + + totvegc => cnveg_carbonstate_inst%totvegc_col , & ! Input: [real(r8) (:) ] totvegc at column level + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem root C + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + rootc_col => cnveg_carbonstate_inst%rootc_col , & ! Output: [real(r8) (:) ] root carbon + leafc_col => cnveg_carbonstate_inst%leafc_col , & ! Output: [real(r8) (:) ] leaf carbon at column level + deadstemc_col => cnveg_carbonstate_inst%deadstemc_col , & ! Output: [real(r8) (:) ] deadstem carbon at column level + fuelc => cnveg_carbonstate_inst%fuelc_col , & ! Output: [real(r8) (:) ] fuel load coutside cropland + fuelc_crop => cnveg_carbonstate_inst%fuelc_crop_col & ! Output: [real(r8) (:) ] fuel load for cropland + ) + + transient_landcover = run_has_transient_landcover() + + !pft to column average + prec10_col =>prec10_col_target + call p2c(bounds, num_soilc, filter_soilc, & + prec10(bounds%begp:bounds%endp), & + prec10_col(bounds%begc:bounds%endc)) + + prec60_col =>prec60_col_target + call p2c(bounds, num_soilc, filter_soilc, & + prec60(bounds%begp:bounds%endp), & + prec60_col(bounds%begc:bounds%endc)) + + rh30_col =>rh30_col_target + call p2c(bounds, num_soilc, filter_soilc, & + rh30(bounds%begp:bounds%endp), & + rh30_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + leafc(bounds%begp:bounds%endp), & + leafc_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + deadstemc(bounds%begp:bounds%endp), & + deadstemc_col(bounds%begc:bounds%endc)) + + call get_curr_date (kyr, kmo, kda, mcsec) + dayspyr = get_days_per_year() + ! Get model step size + dt = get_step_size_real() + ! + ! On first time-step, just set area burned to zero and exit + ! + if ( get_nstep() == 0 )then + do fc = 1,num_soilc + c = filter_soilc(fc) + farea_burned(c) = 0._r8 + baf_crop(c) = 0._r8 + baf_peatf(c) = 0._r8 + fbac(c) = 0._r8 + fbac1(c) = 0._r8 + cropf_col(c) = 0._r8 + end do + return + end if + ! + ! Calculate fraction of crop (cropf_col) and non-crop and non-bare-soil + ! vegetation (lfwt) in vegetated column + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + cropf_col(c) = 0._r8 + lfwt(c) = 0._r8 + end do + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + ! For crop veg types + if( patch%itype(p) > nc4_grass )then + cropf_col(c) = cropf_col(c) + patch%wtcol(p) + end if + ! For natural vegetation (non-crop and non-bare-soil) + if( patch%itype(p) >= ndllf_evr_tmp_tree .and. patch%itype(p) <= nc4_grass )then + lfwt(c) = lfwt(c) + patch%wtcol(p) + end if + end do + ! + ! Calculate crop fuel + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + fuelc_crop(c)=0._r8 + end do + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + ! For crop PFTs, fuel load includes leaf and litter; only + ! column-level litter carbon + ! is available, so we use leaf carbon to estimate the + ! litter carbon for crop PFTs + if( patch%itype(p) > nc4_grass .and. patch%wtcol(p) > 0._r8 .and. leafc_col(c) > 0._r8 )then + fuelc_crop(c)=fuelc_crop(c) + (leafc(p) + leafc_storage(p) + & + leafc_xfer(p))*patch%wtcol(p)/cropf_col(c) + & + totlitc(c)*leafc(p)/leafc_col(c)*patch%wtcol(p)/cropf_col(c) + end if + end do + ! + ! Calculate noncrop column variables + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + fsr_col(c) = 0._r8 + fd_col(c) = 0._r8 + rootc_col(c) = 0._r8 + lgdp_col(c) = 0._r8 + lgdp1_col(c) = 0._r8 + lpop_col(c) = 0._r8 + btran_col(c) = 0._r8 + wtlf(c) = 0._r8 + trotr1_col(c)= 0._r8 + trotr2_col(c)= 0._r8 + if (transient_landcover) then + dtrotr_col(c)=0._r8 + end if + end do + + ! This subroutine calculates btran2 + call this%CNFire_calc_fire_root_wetness_Li2021(bounds, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + c = patch%column(p) + ! For non-crop -- natural vegetation and bare-soil + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8 )then + btran_col(c) = btran_col(c)+max(0._r8, min(1._r8, & + (btran2(p)-rswf_min(patch%itype(p)))/(rswf_max(patch%itype(p)) & + -rswf_min(patch%itype(p)))))*patch%wtcol(p) + wtlf(c) = wtlf(c)+patch%wtcol(p) + end if + end do + + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = col%gridcell(c) + + ! For non-crop -- natural vegetation and bare-soil + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8 )then + + ! NOTE(wjs, 2016-12-15) These calculations of the fraction of evergreen + ! and deciduous tropical trees (used to determine if a column is + ! tropical closed forest) use the current fractions. However, I think + ! they are used in code that applies to land cover change. Note that + ! land cover change is currently generated on the first time step of the + ! year (even though the fire code sees the annually-smoothed dwt). Thus, + ! I think that, for this to be totally consistent, this code should + ! consider the fractional coverage of each PFT prior to the relevant + ! land cover change event. (These fractions could be computed in the + ! code that handles land cover change, so that the fire code remains + ! agnostic to exactly how and when land cover change happens.) + ! + ! For example, if a year started with fractional coverages of + ! nbrdlf_evr_trp_tree = 0.35 and nbrdlf_dcd_trp_tree = 0.35, but then + ! the start-of-year land cover change reduced both of these to 0.2: The + ! current code would consider the column to NOT be tropical closed + ! forest (because nbrdlf_evr_trp_tree+nbrdlf_dcd_trp_tree < 0.6), + ! whereas in fact the land cover change occurred when the column *was* + ! tropical closed forest. + if( patch%itype(p) == nbrdlf_evr_trp_tree .and. patch%wtcol(p) > 0._r8 )then + trotr1_col(c)=trotr1_col(c)+patch%wtcol(p) + end if + if( patch%itype(p) == nbrdlf_dcd_trp_tree .and. patch%wtcol(p) > 0._r8 )then + trotr2_col(c)=trotr2_col(c)+patch%wtcol(p) + end if + + if (transient_landcover) then + if( patch%itype(p) == nbrdlf_evr_trp_tree .or. patch%itype(p) == nbrdlf_dcd_trp_tree )then + if(dwt_smoothed(p) < 0._r8)then + ! Land cover change in CLM happens all at once on the first time + ! step of the year. However, the fire code needs deforestation + ! rates throughout the year, in order to combine these + ! deforestation rates with the current season's climate. So we + ! use a smoothed version of dwt. + ! + ! This isn't ideal, because the carbon stocks that the fire code + ! is operating on will have decreased by the full annual amount + ! before the fire code does anything. But the biggest effect of + ! these deforestation fires is as a trigger for other fires, and + ! the C fluxes are merely diagnostic so don't need to be + ! conservative, so this isn't a big issue. + ! + ! (Actually, it would be even better if the fire code had a + ! realistic breakdown of annual deforestation into the + ! different seasons. But having deforestation spread evenly + ! throughout the year is much better than having it all + ! concentrated on January 1.) + dtrotr_col(c)=dtrotr_col(c)-dwt_smoothed(p) + end if + end if + end if + rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & + frootc_xfer(p) + deadcrootc(p) * spinup_factor_deadwood + & + deadcrootc_storage(p) + deadcrootc_xfer(p) + & + livecrootc(p)+livecrootc_storage(p) + & + livecrootc_xfer(p))*patch%wtcol(p) + + fsr_col(c) = fsr_col(c) + fsr_pft(patch%itype(p))*patch%wtcol(p)/(1.0_r8-cropf_col(c)) + + hdmlf=this%forc_hdm(g) + + ! all these constants are in Li et al. BG (2012a,b;2013) + + if( hdmlf > 0.1_r8 )then + ! For NOT bare-soil + if( patch%itype(p) /= noveg )then + ! For shrub and grass (crop already excluded above) + if( patch%itype(p) >= nbrdlf_evr_shrub )then !for shurb and grass + lgdp_col(c) = lgdp_col(c) + (0.1_r8 + 0.9_r8* & + exp(-1._r8*SHR_CONST_PI* & + (gdp_lf(c)/8._r8)**0.5_r8))*patch%wtcol(p) & + /(1.0_r8 - cropf_col(c)) + lgdp1_col(c) = lgdp1_col(c) + (0.2_r8 + 0.8_r8* & + exp(-1._r8*SHR_CONST_PI* & + (gdp_lf(c)/7._r8)))*patch%wtcol(p)/(1._r8 - cropf_col(c)) + lpop_col(c) = lpop_col(c) + (0.2_r8 + 0.8_r8* & + exp(-1._r8*SHR_CONST_PI* & + (hdmlf/450._r8)**0.5_r8))*patch%wtcol(p)/(1._r8 - cropf_col(c)) + else ! for trees + if( gdp_lf(c) > 20._r8 )then + lgdp_col(c) =lgdp_col(c)+cnfire_const%occur_hi_gdp_tree*patch%wtcol(p)/(1._r8 - cropf_col(c)) + lgdp1_col(c) =lgdp1_col(c)+0.62_r8*patch%wtcol(p)/(1._r8 - cropf_col(c)) + else + if( gdp_lf(c) > 8._r8 )then + lgdp_col(c)=lgdp_col(c)+0.79_r8*patch%wtcol(p)/(1._r8 - cropf_col(c)) + lgdp1_col(c)=lgdp1_col(c)+0.83_r8*patch%wtcol(p)/(1._r8 - cropf_col(c)) + else + lgdp_col(c) = lgdp_col(c)+patch%wtcol(p)/(1._r8 - cropf_col(c)) + lgdp1_col(c)=lgdp1_col(c)+patch%wtcol(p)/(1._r8 - cropf_col(c)) + end if + end if + lpop_col(c) = lpop_col(c) + (0.4_r8 + 0.6_r8* & + exp(-1._r8*SHR_CONST_PI* & + (hdmlf/125._r8)))*patch%wtcol(p)/(1._r8 -cropf_col(c)) + end if + end if + else + lgdp_col(c) = lgdp_col(c)+patch%wtcol(p)/(1.0_r8 - cropf_col(c)) + lgdp1_col(c) = lgdp1_col(c)+patch%wtcol(p)/(1.0_r8 -cropf_col(c)) + lpop_col(c) = lpop_col(c)+patch%wtcol(p)/(1.0_r8 -cropf_col(c)) + end if + + fd_col(c) = fd_col(c) + fd_pft(patch%itype(p)) * patch%wtcol(p) * secsphr / (1.0_r8-cropf_col(c)) + end if + end do + + ! estimate annual decreased fractional coverage of BET+BDT + ! land cover conversion in CLM4.5 is the same for each timestep except for the beginning + + if (transient_landcover) then + do fc = 1,num_soilc + c = filter_soilc(fc) + if( dtrotr_col(c) > 0._r8 )then + if( kmo == 1 .and. kda == 1 .and. mcsec == 0)then + lfc(c) = 0._r8 + end if + if( kmo == 1 .and. kda == 1 .and. mcsec == dt)then + lfc(c) = dtrotr_col(c)*dayspyr*secspday/dt + end if + else + lfc(c)=0._r8 + end if + end do + end if + ! + ! calculate burned area fraction in cropland + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + baf_crop(c)=0._r8 + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if( kmo == 1 .and. kda == 1 .and. mcsec == 0 )then + burndate(p) = 10000 ! init. value; actual range [0 365] + end if + end do + + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = col%gridcell(c) + + ! For crop + if( forc_t(c) >= SHR_CONST_TKFRZ .and. patch%itype(p) > nc4_grass .and. & + kmo == abm_lf(c) .and. & + burndate(p) >= 999 .and. patch%wtcol(p) > 0._r8 )then ! catch crop burn time + + hdmlf = this%forc_hdm(g) + + ! calculate human density impact on ag. fire + fhd = 0.04_r8+0.96_r8*exp(-1._r8*SHR_CONST_PI*(hdmlf/350._r8)**0.5_r8) + + ! calculate impact of GDP on ag. fire + fgdp = 0.01_r8+0.99_r8*exp(-1._r8*SHR_CONST_PI*(gdp_lf(c)/10._r8)) + + ! calculate burned area + fb = max(0.0_r8,min(1.0_r8,(fuelc_crop(c)-lfuel)/(ufuel-lfuel))) + + ! crop fire only for generic crop types at this time + ! managed crops are treated as grasses if crop model is turned on + baf_crop(c) = baf_crop(c) + cropfire_a1/secsphr*fhd*fgdp*patch%wtcol(p) + if( fb*fhd*fgdp*patch%wtcol(p) > 0._r8)then + burndate(p)=kda + end if + end if + end do + ! + ! calculate peatland fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + g= col%gridcell(c) + if(grc%latdeg(g) < cnfire_const%borealat )then + baf_peatf(c) = non_boreal_peatfire_c/secsphr*max(0._r8, & + min(1._r8,(4.0_r8-prec60_col(c)*secspday)/ & + 4.0_r8))**2*peatf_lf(c)*(1._r8-fsat(c)) + else + baf_peatf(c) = boreal_peatfire_c/secsphr*exp(-SHR_CONST_PI*(max(wf2(c),0._r8)/0.3_r8))* & + max(0._r8,min(1._r8,(tsoi17(c)-SHR_CONST_TKFRZ)/10._r8))*peatf_lf(c)* & + (1._r8-fsat(c)) + end if + end do + ! + ! calculate other fires + ! + + ! Set the number of timesteps for e-folding. + ! When the simulation has run fewer than this number of steps, + ! re-scale the e-folding time to get a stable early estimate. + + ! find which pool is the cwd pool + i_cwd = 0 + do l = 1, ndecomp_pools + if ( is_cwd(l) ) then + i_cwd = l + endif + end do + + ! + ! begin column loop to calculate fractional area affected by fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + hdmlf=this%forc_hdm(g) + nfire(c) = 0._r8 + if( cropf_col(c) < 1._r8 )then + fuelc(c) = totlitc(c)+totvegc(c)-rootc_col(c)-fuelc_crop(c)*cropf_col(c) + if (spinup_state == 2) then + fuelc(c) = fuelc(c) + ((spinup_factor_deadwood - 1._r8)*deadstemc_col(c)) + do j = 1, nlevdecomp + fuelc(c) = fuelc(c)+decomp_cpools_vr(c,j,i_cwd) * dzsoi_decomp(j) * spinup_factor(i_cwd) & + * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + end do + else + do j = 1, nlevdecomp + fuelc(c) = fuelc(c)+decomp_cpools_vr(c,j,i_cwd) * dzsoi_decomp(j) + end do + end if + fuelc(c) = fuelc(c)/(1._r8-cropf_col(c)) + fb = max(0.0_r8,min(1.0_r8,(fuelc(c)-lfuel)/(ufuel-lfuel))) + if (trotr1_col(c)+trotr2_col(c)<=0.6_r8) then + afuel =min(1._r8,max(0._r8,(fuelc(c)-2500._r8)/(5000._r8-2500._r8))) + arh=1._r8-max(0._r8, min(1._r8,(forc_rh(g)-rh_low)/(rh_hgh-rh_low))) + arh30=1._r8-max(cnfire_params%prh30, min(1._r8,rh30_col(c)/90._r8)) + if (forc_rh(g) < rh_hgh.and. wtlf(c) > 0._r8 .and. tsoi17(c)> SHR_CONST_TKFRZ)then + fire_m = ((afuel*arh30+(1._r8-afuel)*arh)**1.5_r8) & + *((1._r8-btran_col(c)/wtlf(c))**0.5_r8) + else + fire_m = 0._r8 + end if + lh = pot_hmn_ign_counts_alpha*6.8_r8*hdmlf**(0.43_r8)/30._r8/24._r8 + fs = 1._r8-(0.01_r8+0.98_r8*exp(-0.025_r8*hdmlf)) + ig = (lh+this%forc_lnfm(g)/(5.16_r8+2.16_r8* & + cos(SHR_CONST_PI/180._r8*3*min(60._r8,abs(grc%latdeg(g)))))* & + cnfire_params%ignition_efficiency)*(1._r8-fs)*(1._r8-cropf_col(c)) + nfire(c) = ig/secsphr*fb*fire_m*lgdp_col(c) !fire counts/km2/sec + Lb_lf = 1._r8+10._r8*(1._r8-EXP(-0.06_r8*forc_wind(g))) + spread_m = fire_m**0.5_r8 + farea_burned(c) = min(1._r8,(cnfire_const%g0*spread_m*fsr_col(c)* & + fd_col(c)/1000._r8)**2*lgdp1_col(c)* & + lpop_col(c)*nfire(c)*SHR_CONST_PI*Lb_lf+ & + baf_crop(c)+baf_peatf(c)) ! fraction (0-1) per sec + else + farea_burned(c)=min(1._r8,baf_crop(c)+baf_peatf(c)) + end if + ! + ! if landuse change data is used, calculate deforestation fires and + ! add it in the total of burned area fraction + ! + if (transient_landcover) then + if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 )then + if(( kmo == 1 .and. kda == 1 .and. mcsec == 0) .or. & + dtrotr_col(c) <=0._r8 )then + fbac1(c) = 0._r8 + farea_burned(c) = baf_crop(c)+baf_peatf(c) + else + cri = (4.0_r8*trotr1_col(c)+1.8_r8*trotr2_col(c))/(trotr1_col(c)+trotr2_col(c)) + cli = (max(0._r8,min(1._r8,(cri-prec60_col(c)*secspday)/cri))**0.5)* & + (max(0._r8,min(1._r8,(cri-prec10_col(c)*secspday)/cri))**0.5)* & + (15._r8*min(0.0016_r8,dtrotr_col(c)/dt*dayspyr*secspday)+0.009_r8)* & + max(0._r8,min(1._r8,(0.25_r8-(forc_rain(c)+forc_snow(c))*secsphr)/0.25_r8)) + farea_burned(c) = fb*cli*(cli_scale/secspday)+baf_crop(c)+baf_peatf(c) + ! burned area out of conversion region due to land use fire + fbac1(c) = max(0._r8,fb*cli*(cli_scale/secspday) - 2.0_r8*lfc(c)/dt) + end if + ! total burned area out of conversion + fbac(c) = fbac1(c)+baf_crop(c)+baf_peatf(c) + else + fbac(c) = farea_burned(c) + end if + end if + + else + farea_burned(c) = min(1._r8,baf_crop(c)+baf_peatf(c)) + end if + + end do ! end of column loop + + end associate + + end subroutine CNFireArea + +end module CNFireLi2021Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGRespMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGRespMod.F90 new file mode 100755 index 000000000..d95761e61 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGRespMod.F90 @@ -0,0 +1,214 @@ +module CNGRespMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for growth respiration fluxes, + ! for coupled carbon-nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use pftconMod , only : npcropmin, pftcon + use CNVegcarbonfluxType , only : cnveg_carbonflux_type + use PatchType , only : patch + use CanopyStateType , only : canopystate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNGResp + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + ! subroutine CNGResp(num_soilp, filter_soilp, cnveg_carbonflux_inst) + subroutine CNGResp(num_soilp, filter_soilp, cnveg_carbonflux_inst, canopystate_inst, cnveg_carbonstate_inst, & + cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic carbon state + ! variables + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8):: respfact_leaf + real(r8):: respfact_froot + real(r8):: respfact_livecroot + real(r8):: respfact_livestem + real(r8):: respfact_leaf_storage + real(r8):: respfact_froot_storage + real(r8):: respfact_livecroot_storage + real(r8):: respfact_livestem_storage + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:)] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + grperc => pftcon%grperc , & ! Input: growth respiration parameter + grpnow => pftcon%grpnow , & ! Input: growth respiration parameter + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:)] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:)] shaded projected leaf area index + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:)] + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:)] + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:)] + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:)] + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live coarse root C storage + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N storage + + cpool_to_leafc => cnveg_carbonflux_inst%cpool_to_leafc_patch , & ! Input: [real(r8) (:)] + cpool_to_leafc_storage => cnveg_carbonflux_inst%cpool_to_leafc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Input: [real(r8) (:)] + cpool_to_frootc_storage => cnveg_carbonflux_inst%cpool_to_frootc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_livestemc => cnveg_carbonflux_inst%cpool_to_livestemc_patch , & ! Input: [real(r8) (:)] + cpool_to_livestemc_storage => cnveg_carbonflux_inst%cpool_to_livestemc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_deadstemc => cnveg_carbonflux_inst%cpool_to_deadstemc_patch , & ! Input: [real(r8) (:)] + cpool_to_deadstemc_storage => cnveg_carbonflux_inst%cpool_to_deadstemc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_livecrootc => cnveg_carbonflux_inst%cpool_to_livecrootc_patch , & ! Input: [real(r8) (:)] + cpool_to_livecrootc_storage => cnveg_carbonflux_inst%cpool_to_livecrootc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_deadcrootc => cnveg_carbonflux_inst%cpool_to_deadcrootc_patch , & ! Input: [real(r8) (:)] allocation to dead coarse root C (gC/m2/s) + cpool_to_deadcrootc_storage => cnveg_carbonflux_inst%cpool_to_deadcrootc_storage_patch , & ! Input: [real(r8) (:)] allocation to dead coarse root C storage (gC/m2/s) + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch , & ! Input: [real(r8) (:)] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => cnveg_carbonflux_inst%cpool_to_grainc_storage_patch , & ! Input: [real(r8) (:)] allocation to grain C storage (gC/m2/s) + grainc_xfer_to_grainc => cnveg_carbonflux_inst%grainc_xfer_to_grainc_patch , & ! Input: [real(r8) (:)] grain C growth from storage (gC/m2/s) + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! Input: [real(r8) (:)] leaf C growth from storage (gC/m2/s) + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Input: [real(r8) (:)] fine root C growth from storage (gC/m2/s) + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! Input: [real(r8) (:)] live stem C growth from storage (gC/m2/s) + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! Input: [real(r8) (:)] dead stem C growth from storage (gC/m2/s) + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! Input: [real(r8) (:)] live coarse root C growth from storage (gC/m2/s) + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! Input: [real(r8) (:)] dead coarse root C growth from storage (gC/m2/s) + cpool_grain_gr => cnveg_carbonflux_inst%cpool_grain_gr_patch , & ! Output: [real(r8) (:)] + cpool_grain_storage_gr => cnveg_carbonflux_inst%cpool_grain_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_grain_gr => cnveg_carbonflux_inst%transfer_grain_gr_patch , & ! Output: [real(r8) (:)] + cpool_leaf_gr => cnveg_carbonflux_inst%cpool_leaf_gr_patch , & ! Output: [real(r8) (:)] + cpool_leaf_storage_gr => cnveg_carbonflux_inst%cpool_leaf_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_leaf_gr => cnveg_carbonflux_inst%transfer_leaf_gr_patch , & ! Output: [real(r8) (:)] + cpool_froot_gr => cnveg_carbonflux_inst%cpool_froot_gr_patch , & ! Output: [real(r8) (:)] + cpool_froot_storage_gr => cnveg_carbonflux_inst%cpool_froot_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_froot_gr => cnveg_carbonflux_inst%transfer_froot_gr_patch , & ! Output: [real(r8) (:)] + cpool_livestem_gr => cnveg_carbonflux_inst%cpool_livestem_gr_patch , & ! Output: [real(r8) (:)] + cpool_livestem_storage_gr => cnveg_carbonflux_inst%cpool_livestem_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_livestem_gr => cnveg_carbonflux_inst%transfer_livestem_gr_patch , & ! Output: [real(r8) (:)] + cpool_deadstem_gr => cnveg_carbonflux_inst%cpool_deadstem_gr_patch , & ! Output: [real(r8) (:)] + cpool_deadstem_storage_gr => cnveg_carbonflux_inst%cpool_deadstem_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_deadstem_gr => cnveg_carbonflux_inst%transfer_deadstem_gr_patch , & ! Output: [real(r8) (:)] + cpool_livecroot_gr => cnveg_carbonflux_inst%cpool_livecroot_gr_patch , & ! Output: [real(r8) (:)] + cpool_livecroot_storage_gr => cnveg_carbonflux_inst%cpool_livecroot_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_livecroot_gr => cnveg_carbonflux_inst%transfer_livecroot_gr_patch , & ! Output: [real(r8) (:)] + cpool_deadcroot_gr => cnveg_carbonflux_inst%cpool_deadcroot_gr_patch , & ! Output: [real(r8) (:)] + cpool_deadcroot_storage_gr => cnveg_carbonflux_inst%cpool_deadcroot_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_deadcroot_gr => cnveg_carbonflux_inst%transfer_deadcroot_gr_patch & ! Output: [real(r8) (:)] + ) + + ! Loop through patches + ! start patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + respfact_leaf = 1.0_r8 + respfact_froot = 1.0_r8 + respfact_livecroot = 1.0_r8 + respfact_livestem = 1.0_r8 + respfact_livecroot = 1.0_r8 + respfact_livestem = 1.0_r8 + respfact_leaf_storage = 1.0_r8 + respfact_froot_storage = 1.0_r8 + respfact_livecroot_storage = 1.0_r8 + respfact_livestem_storage = 1.0_r8 + respfact_livecroot_storage = 1.0_r8 + respfact_livestem_storage = 1.0_r8 + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_livestem_gr(p) = cpool_to_livestemc(p) * grperc(ivt(p)) * respfact_livestem + + cpool_livestem_storage_gr(p) = cpool_to_livestemc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * & + respfact_livestem_storage + + transfer_livestem_gr(p) = livestemc_xfer_to_livestemc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * & + respfact_livestem_storage + + cpool_grain_gr(p) = cpool_to_grainc(p) * grperc(ivt(p)) + + cpool_grain_storage_gr(p) = cpool_to_grainc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) + + transfer_grain_gr(p) = grainc_xfer_to_grainc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + end if + + ! leaf and fine root growth respiration + cpool_leaf_gr(p) = cpool_to_leafc(p) * grperc(ivt(p)) * respfact_leaf + + cpool_leaf_storage_gr(p) = cpool_to_leafc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * respfact_leaf_storage + + transfer_leaf_gr(p) = leafc_xfer_to_leafc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * respfact_leaf_storage + + cpool_froot_gr(p) = cpool_to_frootc(p) * grperc(ivt(p)) * respfact_froot * respfact_froot + + cpool_froot_storage_gr(p) = cpool_to_frootc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * respfact_froot_storage + + transfer_froot_gr(p) = frootc_xfer_to_frootc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * respfact_froot_storage + + if (woody(ivt(p)) == 1._r8) then + cpool_livestem_gr(p) = cpool_to_livestemc(p) * grperc(ivt(p)) * respfact_livestem + + cpool_livestem_storage_gr(p) = cpool_to_livestemc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * & +respfact_livestem_storage + + transfer_livestem_gr(p) = livestemc_xfer_to_livestemc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * & +respfact_livestem_storage + + cpool_deadstem_gr(p) = cpool_to_deadstemc(p) * grperc(ivt(p)) + + cpool_deadstem_storage_gr(p) = cpool_to_deadstemc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) + + transfer_deadstem_gr(p) = deadstemc_xfer_to_deadstemc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + + cpool_livecroot_gr(p) = cpool_to_livecrootc(p) * grperc(ivt(p)) * respfact_livecroot + + cpool_livecroot_storage_gr(p) = cpool_to_livecrootc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * & +respfact_livecroot_storage + + transfer_livecroot_gr(p) = livecrootc_xfer_to_livecrootc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * & +respfact_livecroot_storage + + cpool_deadcroot_gr(p) = cpool_to_deadcrootc(p) * grperc(ivt(p)) + + cpool_deadcroot_storage_gr(p) = cpool_to_deadcrootc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) + + transfer_deadcroot_gr(p) = deadcrootc_xfer_to_deadcrootc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + end if + + end do + + end associate + + end subroutine CNGResp + +end module CNGRespMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 new file mode 100755 index 000000000..19407316f --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 @@ -0,0 +1,613 @@ +module CNGapMortalityMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines used in gap mortality for coupled carbon + ! nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use pftconMod , only : pftcon + use CNDVType , only : dgvs_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use CanopyStateType , only : canopystate_type + use ColumnType , only : col + use PatchType , only : patch + use GridcellType , only : grc + use clm_varctl , only : use_matrixcn + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,iretransn,ioutc,ioutn + use CNVegMatrixMod , only : matrix_update_gmc, matrix_update_gmn + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: CNGapMortality + + type, private :: params_type + real(r8):: am ! mortality rate based on annual rate, fractional mortality (1/yr) + real(r8):: k_mort ! coeff. of growth efficiency in mortality equation + end type params_type + ! + type(params_type), private :: params_inst + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: CNGap_PatchToColumn + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read in parameters + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNGapMortParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='r_mort' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%am=tempr + + tString='k_mort' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_mort=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst,& + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & + leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch) + ! + ! !DESCRIPTION: + ! Gap-phase mortality routine for coupled carbon-nitrogen code (CN) + ! + ! !USES: + use clm_time_manager , only: get_days_per_year, get_step_size_real, get_step_size + use clm_varpar , only: nlevdecomp_full + use clm_varcon , only: secspday + use clm_varctl , only: use_cndv, spinup_state + use pftconMod , only: npcropmin + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! column filter for soil points + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + integer :: fp ! patch filter index + real(r8):: am ! rate for fractional mortality (1/yr) + real(r8):: m ! rate for fractional mortality (1/s) + real(r8):: mort_max ! asymptotic max mortality rate (/yr) + real(r8):: k_mort = 0.3 ! coeff of growth efficiency in mortality equation + real(r8):: dt + logical,parameter :: matrixcheck_gm = .False. + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform + + greffic => dgvs_inst%greffic_patch , & ! Input: [real(r8) (:) ] + heatstress => dgvs_inst%heatstress_patch , & ! Input: [real(r8) (:) ] + + leafcn => pftcon%leafcn , & ! Input: [real(r8) (:)] leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: [real(r8) (:)] fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: [real(r8) (:)] live wood (phloem and ray parenchyma) C:N (gC/gN) + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + nind => dgvs_inst%nind_patch , & ! Output:[real(r8)(:)] number of individuals (#/m2) added by F. Li and S. Levis + ileaf_to_iout_gmc => cnveg_carbonflux_inst%ileaf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_gmc => cnveg_carbonflux_inst%ileafst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_gmc => cnveg_carbonflux_inst%ileafxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_gmc => cnveg_carbonflux_inst%ifroot_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_gmc => cnveg_carbonflux_inst%ifrootst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_gmc => cnveg_carbonflux_inst%ifrootxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from fine root transfer pool to outside of vegetation pools + ilivestem_to_iout_gmc => cnveg_carbonflux_inst%ilivestem_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_gmc => cnveg_carbonflux_inst%ilivestemst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_gmc => cnveg_carbonflux_inst%ilivestemxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_gmc => cnveg_carbonflux_inst%ideadstem_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_gmc => cnveg_carbonflux_inst%ideadstemst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_gmc => cnveg_carbonflux_inst%ideadstemxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_gmc => cnveg_carbonflux_inst%ilivecroot_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_gmc => cnveg_carbonflux_inst%ilivecrootst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_gmc => cnveg_carbonflux_inst%ilivecrootxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_gmc => cnveg_carbonflux_inst%ideadcroot_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_gmc => cnveg_carbonflux_inst%ideadcrootst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_gmc => cnveg_carbonflux_inst%ideadcrootxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root transfer pool to outside of vegetation pools + ileaf_to_iout_gmn => cnveg_nitrogenflux_inst%ileaf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_gmn => cnveg_nitrogenflux_inst%ileafst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_gmn => cnveg_nitrogenflux_inst%ileafxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_gmn => cnveg_nitrogenflux_inst%ifroot_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ifrootst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ifrootxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from fine root transfer pool to outside of vegetation pools + ilivestem_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestem_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestemst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstem_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstemst_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecroot_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_gm, & ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_gm, & ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcroot_to_iout_gm , & ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_gm, & ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_gm, & ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root transfer pool to outside of vegetation pools + iretransn_to_iout_gmn => cnveg_nitrogenflux_inst%iretransn_to_iout_gm & ! Input: [integer (:)] Index of gap mortality related N transfer from retranslocation pool to outside of vegetation pools + ) + + dt = real( get_step_size(), r8 ) + ! set the mortality rate based on annual rate + am = params_inst%am + ! set coeff of growth efficiency in mortality equation + k_mort = params_inst%k_mort + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + if (use_cndv) then + ! Stress mortality from lpj's subr Mortality. + + if (woody(ivt(p)) == 1._r8) then + + if (ivt(p) == 8) then + mort_max = 0.03_r8 ! BDT boreal + else + mort_max = 0.01_r8 ! original value for all patches + end if + + ! heatstress and greffic calculated in Establishment once/yr + + ! Mortality rate inversely related to growth efficiency + ! (Prentice et al 1993) + am = mort_max / (1._r8 + k_mort * greffic(p)) + + ! Mortality rate inversely related to growth efficiency + ! (Prentice et al 1993) + am = mort_max / (1._r8 + k_mort * greffic(p)) + + am = min(1._r8, am + heatstress(p)) + else ! lpj didn't set this for grasses; cn does + ! set the mortality rate based on annual rate + am = params_inst%am + end if + + end if + + m = am/(get_days_per_year() * secspday) + + !------------------------------------------------------ + ! patch-level gap mortality carbon fluxes + !------------------------------------------------------ + + ! displayed pools + if(.not. use_matrixcn)then + cnveg_carbonflux_inst%m_leafc_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_patch(p) * m + cnveg_carbonflux_inst%m_frootc_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) * m + cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * m + cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * m + else + cnveg_carbonflux_inst%m_leafc_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_patch(p) * matrix_update_gmc(p,ileaf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_frootc_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) * matrix_update_gmc(p,ifroot_to_iout_gmc,m,dt,cnveg_carbonflux_inst,.true.,.True.) + cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * matrix_update_gmc(p,ilivestem_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * matrix_update_gmc(p,ilivecroot_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + end if + if(.not. use_matrixcn)then + cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m * spinup_factor_deadwood + cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m * spinup_factor_deadwood + else + cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * matrix_update_gmc(p,ideadstem_to_iout_gmc, & + m*spinup_factor_deadwood,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * matrix_update_gmc(p,ideadcroot_to_iout_gmc, & + m*spinup_factor_deadwood,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + end if !use_matrixcn + + ! storage pools + if(.not. use_matrixcn)then + cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) * m + cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_storage_patch(p) * m + cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_storage_patch(p) * m + cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_storage_patch(p) * m + cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_storage_patch(p) * m + cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_storage_patch(p) * m + cnveg_carbonflux_inst%m_gresp_storage_to_litter_patch(p) = cnveg_carbonstate_inst%gresp_storage_patch(p) * m + + ! transfer pools + cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_gresp_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%gresp_xfer_patch(p) * m + else + ! NOTE: The non-matrix version of this is in CNCStateUpdate2Mod CStateUpdate2 (EBK 11/25/2019) + + ! storage pools + cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) * matrix_update_gmc(p,ileafst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_storage_patch(p) * matrix_update_gmc(p,ifrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_storage_patch(p) * matrix_update_gmc(p,ilivestemst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_storage_patch(p) * matrix_update_gmc(p,ideadstemst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_storage_patch(p) * matrix_update_gmc(p,ilivecrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_storage_patch(p) * matrix_update_gmc(p,ideadcrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + + ! transfer pools + cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_xfer_patch(p) * matrix_update_gmc(p,ileafxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_xfer_patch(p) * matrix_update_gmc(p,ifrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_xfer_patch(p) * matrix_update_gmc(p,ilivestemxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_xfer_patch(p) * matrix_update_gmc(p,ideadstemxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_xfer_patch(p) * matrix_update_gmc(p,ilivecrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) * matrix_update_gmc(p,ideadcrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + end if !use_matrixcn + + !------------------------------------------------------ + ! patch-level gap mortality nitrogen fluxes + !------------------------------------------------------ + + ! displayed pools + if(.not. use_matrixcn)then + cnveg_nitrogenflux_inst%m_leafn_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_patch(p) * m + cnveg_nitrogenflux_inst%m_frootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_patch(p) * m + cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) * m + cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) * m + else + cnveg_nitrogenflux_inst%m_leafn_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_patch(p) * matrix_update_gmn(p,ileaf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_frootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_patch(p) * matrix_update_gmn(p,ifroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,.true.,.True.) + cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) * matrix_update_gmn(p,ilivestem_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) * matrix_update_gmn(p,ilivecroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + end if + + if (spinup_state == 2 .and. .not. use_cndv) then !accelerate mortality of dead woody pools + if(.not. use_matrixcn)then + cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m * spinup_factor_deadwood + cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m * spinup_factor_deadwood + else + cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * matrix_update_gmn(p,ideadstem_to_iout_gmn , & + m*spinup_factor_deadwood,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * matrix_update_gmn(p,ideadcroot_to_iout_gmn, & + m*spinup_factor_deadwood,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + end if !.not. use_matrixcn + else + if (.not. use_matrixcn) then + cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m + cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m + else + cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * matrix_update_gmn(p,ideadstem_to_iout_gmn ,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * matrix_update_gmn(p,ideadcroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + end if !use_matrixcn + end if + + if (ivt(p) < npcropmin) then + if(.not. use_matrixcn)then + cnveg_nitrogenflux_inst%m_retransn_to_litter_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) * m + else + cnveg_nitrogenflux_inst%m_retransn_to_litter_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) * matrix_update_gmn(p,iretransn_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + end if + end if + + if(.not. use_matrixcn)then + ! storage pools + cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) * m + + ! transfer pools + cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) * m + else + ! storage pools + cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_storage_patch(p) * matrix_update_gmn(p,ileafst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_storage_patch(p) * matrix_update_gmn(p,ifrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_storage_patch(p) * matrix_update_gmn(p,ilivestemst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) * matrix_update_gmn(p,ideadstemst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) * matrix_update_gmn(p,ilivecrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) * matrix_update_gmn(p,ideadcrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + + ! transfer pools + cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_xfer_patch(p) * matrix_update_gmn(p,ileafxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_xfer_patch(p) * matrix_update_gmn(p,ifrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) * matrix_update_gmn(p,ilivestemxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) * matrix_update_gmn(p,ideadstemxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) * matrix_update_gmn(p,ilivecrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) * matrix_update_gmn(p,ideadcrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + end if !use_matrixcn + + ! added by F. Li and S. Levis + if (use_cndv) then + if (woody(ivt(p)) == 1._r8)then + if (cnveg_carbonstate_inst%livestemc_patch(p) + cnveg_carbonstate_inst%deadstemc_patch(p)> 0._r8)then + nind(p)=nind(p)*(1._r8-m) + else + nind(p) = 0._r8 + end if + end if + end if + + end do ! end of patch loop + + ! gather all patch-level litterfall fluxes to the column + ! for litter C and N inputs + + call CNGap_PatchToColumn(bounds, num_soilc, filter_soilc, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & + froot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & + croot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & + stem_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full)) + + end associate + + end subroutine CNGapMortality + + !----------------------------------------------------------------------- + subroutine CNGap_PatchToColumn (bounds, num_soilc, filter_soilc, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch) + ! + ! !DESCRIPTION: + ! gathers all patch-level gap mortality fluxes to the column level and + ! assigns them to the three litter pools + ! + ! !USES: + use clm_varpar , only : maxsoil_patches, nlevdecomp, nlevdecomp_full + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! soil column filter + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) + + associate( & + leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + croot_prof => croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] patch weight relative to column (0-1) + + lf_flab => pftcon%lf_flab , & ! Input: [real(r8) (:) ] leaf litter labile fraction + lf_fcel => pftcon%lf_fcel , & ! Input: [real(r8) (:) ] leaf litter cellulose fraction + lf_flig => pftcon%lf_flig , & ! Input: [real(r8) (:) ] leaf litter lignin fraction + fr_flab => pftcon%fr_flab , & ! Input: [real(r8) (:) ] fine root litter labile fraction + fr_fcel => pftcon%fr_fcel , & ! Input: [real(r8) (:) ] fine root litter cellulose fraction + fr_flig => pftcon%fr_flig , & ! Input: [real(r8) (:) ] fine root litter lignin fraction + + m_leafc_to_litter => cnveg_carbonflux_inst%m_leafc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_to_litter => cnveg_carbonflux_inst%m_frootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_to_litter => cnveg_carbonflux_inst%m_livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_to_litter => cnveg_carbonflux_inst%m_deadstemc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_to_litter => cnveg_carbonflux_inst%m_livecrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_to_litter => cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafc_storage_to_litter => cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_storage_to_litter => cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_storage_to_litter => cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_storage_to_litter => cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_storage_to_litter => cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_storage_to_litter => cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_gresp_storage_to_litter => cnveg_carbonflux_inst%m_gresp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafc_xfer_to_litter => cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_xfer_to_litter => cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_xfer_to_litter => cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_xfer_to_litter => cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_xfer_to_litter => cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_xfer_to_litter => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_gresp_xfer_to_litter => cnveg_carbonflux_inst%m_gresp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + gap_mortality_c_to_litr_met_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_met_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter metabolic pool (gC/m3/s) + gap_mortality_c_to_litr_cel_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_cel_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter cellulose pool (gC/m3/s) + gap_mortality_c_to_litr_lig_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_lig_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter lignin pool (gC/m3/s) + gap_mortality_c_to_cwdc => cnveg_carbonflux_inst%gap_mortality_c_to_cwdc_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to CWD pool (gC/m3/s) + + m_leafn_to_litter => cnveg_nitrogenflux_inst%m_leafn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_to_litter => cnveg_nitrogenflux_inst%m_frootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_to_litter => cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_retransn_to_litter => cnveg_nitrogenflux_inst%m_retransn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafn_storage_to_litter => cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_storage_to_litter => cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_storage_to_litter => cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_storage_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_storage_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_storage_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafn_xfer_to_litter => cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_xfer_to_litter => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_xfer_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + gap_mortality_n_to_litr_met_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_met_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter metabolic pool (gN/m3/s) + gap_mortality_n_to_litr_cel_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_cel_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter cellulose pool (gN/m3/s) + gap_mortality_n_to_litr_lig_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_lig_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter lignin pool (gN/m3/s) + gap_mortality_n_to_cwdn => cnveg_nitrogenflux_inst%gap_mortality_n_to_cwdn_col & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to CWD pool (gN/m3/s) + ) + + do j = 1,nlevdecomp + do pi = 1,maxsoil_patches + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + if (patch%active(p)) then + + ! leaf gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_cel_c(c,j) = gap_mortality_c_to_litr_cel_c(c,j) + & + m_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_lig_c(c,j) = gap_mortality_c_to_litr_lig_c(c,j) + & + m_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_cel_c(c,j) = gap_mortality_c_to_litr_cel_c(c,j) + & + m_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_lig_c(c,j) = gap_mortality_c_to_litr_lig_c(c,j) + & + m_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood gap mortality carbon fluxes + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + (m_livestemc_to_litter(p) + m_deadstemc_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + (m_livecrootc_to_litter(p) + m_deadcrootc_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! storage gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_leafc_storage_to_litter(p) + m_gresp_storage_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livestemc_storage_to_litter(p) + m_deadstemc_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livecrootc_storage_to_litter(p) + m_deadcrootc_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! transfer gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_leafc_xfer_to_litter(p) + m_gresp_xfer_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livestemc_xfer_to_litter(p) + m_deadstemc_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livecrootc_xfer_to_litter(p) + m_deadcrootc_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! leaf gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_cel_n(c,j) = gap_mortality_n_to_litr_cel_n(c,j) + & + m_leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_lig_n(c,j) = gap_mortality_n_to_litr_lig_n(c,j) + & + m_leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_cel_n(c,j) = gap_mortality_n_to_litr_cel_n(c,j) + & + m_frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_lig_n(c,j) = gap_mortality_n_to_litr_lig_n(c,j) + & + m_frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood gap mortality nitrogen fluxes + gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & + (m_livestemn_to_litter(p) + m_deadstemn_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & + (m_livecrootn_to_litter(p) + m_deadcrootn_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! retranslocated N pool gap mortality fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! storage gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livestemn_storage_to_litter(p) + m_deadstemn_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livecrootn_storage_to_litter(p) + m_deadcrootn_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! transfer gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livestemn_xfer_to_litter(p) + m_deadstemn_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livecrootn_xfer_to_litter(p) + m_deadcrootn_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + + end if + end if + + end do + end do + end do + + end associate + + end subroutine CNGap_PatchToColumn + +end module CNGapMortalityMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate1Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate1Mod.F90 new file mode 100755 index 000000000..3aabe0c3f --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate1Mod.F90 @@ -0,0 +1,344 @@ +module CNNStateUpdate1Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable updates, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size_real + use clm_varpar , only : nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd, ioutn, iretransn + use clm_varctl , only : iulog, use_nitrif_denitrif, use_matrixcn, use_soil_matrixcn + use clm_varcon , only : nitrif_n2o_loss_frac + use pftconMod , only : npcropmin, pftcon + use decompMod , only : bounds_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: NStateUpdateDynPatch + public :: NStateUpdate1 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Update nitrogen states based on fluxes from dyn_cnbal_patch + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_soilc_with_inactive ! number of columns in soil filter + integer, intent(in) :: filter_soilc_with_inactive(:) ! soil column filter that includes inactive points + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c ! column index + integer :: g ! gridcell index + integer :: fc ! column filter index + integer :: j ! level index + real(r8) :: dt ! time step (seconds) + + character(len=*), parameter :: subname = 'NStateUpdateDynPatch' + !----------------------------------------------------------------------- + + associate( & + nf_veg => cnveg_nitrogenflux_inst , & + ns_veg => cnveg_nitrogenstate_inst , & + nf_soil => soilbiogeochem_nitrogenflux_inst, & + ns_soil => soilbiogeochem_nitrogenstate_inst & + ) + + dt = get_step_size_real() + + do j = 1, nlevdecomp + do fc = 1, num_soilc_with_inactive + c = filter_soilc_with_inactive(fc) + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) = ns_soil%decomp_npools_vr_col(c,j,i_met_lit) + & + nf_veg%dwt_frootn_to_litr_met_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) = ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) + & + nf_veg%dwt_frootn_to_litr_cel_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) = ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) + & + nf_veg%dwt_frootn_to_litr_lig_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cwd) = ns_soil%decomp_npools_vr_col(c,j,i_cwd) + & + ( nf_veg%dwt_livecrootn_to_cwdn_col(c,j) + nf_veg%dwt_deadcrootn_to_cwdn_col(c,j) ) * dt + end do + end do + + do g = bounds%begg, bounds%endg + ns_veg%seedn_grc(g) = ns_veg%seedn_grc(g) - nf_veg%dwt_seedn_to_leaf_grc(g) * dt + ns_veg%seedn_grc(g) = ns_veg%seedn_grc(g) - nf_veg%dwt_seedn_to_deadstem_grc(g) * dt + end do + + end associate + + end subroutine NStateUpdateDynPatch + + !----------------------------------------------------------------------- + subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + use CNSharedParamsMod , only : use_fun + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables (except for gap-phase mortality and fire fluxes) + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,g,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + nf_veg => cnveg_nitrogenflux_inst , & ! Input: + ns_veg => cnveg_nitrogenstate_inst , & ! Output: + nf_soil => soilbiogeochem_nitrogenflux_inst & ! Output: + ) + + ! set time steps + dt = get_step_size_real() + + + ! soilbiogeochemistry fluxes TODO - this should be moved elsewhere + ! plant to litter fluxes - phenology and dynamic landcover fluxes + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (.not. use_soil_matrixcn) then ! to be consistent with C + nf_soil%decomp_npools_sourcesink_col(c,j,i_met_lit) = & + nf_veg%phenology_n_to_litr_met_n_col(c,j) * dt + + nf_soil%decomp_npools_sourcesink_col(c,j,i_cel_lit) = & + nf_veg%phenology_n_to_litr_cel_n_col(c,j) * dt + + nf_soil%decomp_npools_sourcesink_col(c,j,i_lig_lit) = & + nf_veg%phenology_n_to_litr_lig_n_col(c,j) * dt + + ! NOTE(wjs, 2017-01-02) This used to be set to a non-zero value, but the + ! terms have been moved to CStateUpdateDynPatch. I think this is zeroed every + ! time step, but to be safe, I'm explicitly setting it to zero here. + nf_soil%decomp_npools_sourcesink_col(c,j,i_cwd) = 0._r8 + + else + nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_met_n_col(c,j) *dt + + nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_cel_n_col(c,j) *dt + + nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_lig_n_col(c,j) *dt + + end if + end do + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! phenology: transfer growth fluxes + if(.not. use_matrixcn)then + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) + nf_veg%leafn_xfer_to_leafn_patch(p)*dt + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) - nf_veg%leafn_xfer_to_leafn_patch(p)*dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) + nf_veg%frootn_xfer_to_frootn_patch(p)*dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) - nf_veg%frootn_xfer_to_frootn_patch(p)*dt + + if (woody(ivt(p)) == 1.0_r8) then + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) + nf_veg%livestemn_xfer_to_livestemn_patch(p)*dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) - nf_veg%livestemn_xfer_to_livestemn_patch(p)*dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) + nf_veg%deadstemn_xfer_to_deadstemn_patch(p)*dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) - nf_veg%deadstemn_xfer_to_deadstemn_patch(p)*dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) + nf_veg%livecrootn_xfer_to_livecrootn_patch(p)*dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) - nf_veg%livecrootn_xfer_to_livecrootn_patch(p)*dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) + nf_veg%deadcrootn_xfer_to_deadcrootn_patch(p)*dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) - nf_veg%deadcrootn_xfer_to_deadcrootn_patch(p)*dt + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) + nf_veg%livestemn_xfer_to_livestemn_patch(p)*dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) - nf_veg%livestemn_xfer_to_livestemn_patch(p)*dt + ns_veg%grainn_patch(p) = ns_veg%grainn_patch(p) + nf_veg%grainn_xfer_to_grainn_patch(p)*dt + ns_veg%grainn_xfer_patch(p) = ns_veg%grainn_xfer_patch(p) - nf_veg%grainn_xfer_to_grainn_patch(p)*dt + end if + + ! phenology: litterfall and retranslocation fluxes + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - nf_veg%leafn_to_litter_patch(p)*dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - nf_veg%frootn_to_litter_patch(p)*dt + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - nf_veg%leafn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%leafn_to_retransn_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + + ! live wood turnover and retranslocation fluxes + if (woody(ivt(p)) == 1._r8) then + if(.not. use_matrixcn)then + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_deadstemn_patch(p)*dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) + nf_veg%livestemn_to_deadstemn_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%livestemn_to_retransn_patch(p)*dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - nf_veg%livecrootn_to_deadcrootn_patch(p)*dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) + nf_veg%livecrootn_to_deadcrootn_patch(p)*dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - nf_veg%livecrootn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%livecrootn_to_retransn_patch(p)*dt + ! WW change logic so livestem_retrans goes to npool (via free_retrans flux) + ! this should likely be done more cleanly if it works, i.e. not update fluxes w/ states + ! additional considerations for crop? + ! Matrix version of this is in CNLivewoodTurnover + if (use_fun ) then + nf_veg%free_retransn_to_npool_patch(p) = nf_veg%free_retransn_to_npool_patch(p) + nf_veg%livestemn_to_retransn_patch(p) + nf_veg%free_retransn_to_npool_patch(p) = nf_veg%free_retransn_to_npool_patch(p) + nf_veg%livecrootn_to_retransn_patch(p) + end if + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + end if + if (ivt(p) >= npcropmin) then ! Beth adds retrans from froot + if(.not. use_matrixcn)then + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - nf_veg%frootn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%frootn_to_retransn_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_litter_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_biofueln_patch(p)*dt + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - nf_veg%leafn_to_biofueln_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%livestemn_to_retransn_patch(p)*dt + ns_veg%grainn_patch(p) = ns_veg%grainn_patch(p) & + - (nf_veg%grainn_to_food_patch(p) + nf_veg%grainn_to_seed_patch(p))*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if !not use_matrixcn + ns_veg%cropseedn_deficit_patch(p) = ns_veg%cropseedn_deficit_patch(p) & + - nf_veg%crop_seedn_to_leaf_patch(p) * dt & + + nf_veg%grainn_to_seed_patch(p) * dt + end if + + ! uptake from soil mineral N pool + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) + nf_veg%sminn_to_npool_patch(p)*dt + + ! deployment from retranslocation pool + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) + nf_veg%retransn_to_npool_patch(p)*dt + + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) + nf_veg%free_retransn_to_npool_patch(p)*dt + + ! allocation fluxes + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_leafn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_leafn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_frootn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_frootn_storage_patch(p)*dt + if (.not. use_matrixcn) then + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) - nf_veg%retransn_to_npool_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) - nf_veg%free_retransn_to_npool_patch(p)*dt !how is retransn a state? + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) + nf_veg%npool_to_leafn_patch(p)*dt + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) + nf_veg%npool_to_leafn_storage_patch(p)*dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) + nf_veg%npool_to_frootn_patch(p)*dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) + nf_veg%npool_to_frootn_storage_patch(p)*dt + else + ! No matrix code needed here + end if + + if (woody(ivt(p)) == 1._r8) then + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livestemn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livestemn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_deadstemn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_deadstemn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livecrootn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livecrootn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_deadcrootn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_deadcrootn_storage_patch(p)*dt + if(.not. use_matrixcn) then + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) + nf_veg%npool_to_livestemn_patch(p)*dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) + nf_veg%npool_to_livestemn_storage_patch(p)*dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) + nf_veg%npool_to_deadstemn_patch(p)*dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) + nf_veg%npool_to_deadstemn_storage_patch(p)*dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) + nf_veg%npool_to_livecrootn_patch(p)*dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) + nf_veg%npool_to_livecrootn_storage_patch(p)*dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) + nf_veg%npool_to_deadcrootn_patch(p)*dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) + nf_veg%npool_to_deadcrootn_storage_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if ! not use_matrixcn + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livestemn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livestemn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_grainn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_grainn_storage_patch(p)*dt + if(.not. use_matrixcn) then + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) + nf_veg%npool_to_livestemn_patch(p)*dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) + nf_veg%npool_to_livestemn_storage_patch(p)*dt + ns_veg%grainn_patch(p) = ns_veg%grainn_patch(p) + nf_veg%npool_to_grainn_patch(p)*dt + ns_veg%grainn_storage_patch(p) = ns_veg%grainn_storage_patch(p) + nf_veg%npool_to_grainn_storage_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if ! not use_matrixcn + end if + + ! move storage pools into transfer pools + if(.not. use_matrixcn) then + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) - nf_veg%leafn_storage_to_xfer_patch(p)*dt + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) + nf_veg%leafn_storage_to_xfer_patch(p)*dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) - nf_veg%frootn_storage_to_xfer_patch(p)*dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) + nf_veg%frootn_storage_to_xfer_patch(p)*dt + + if (woody(ivt(p)) == 1._r8) then + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) - nf_veg%livestemn_storage_to_xfer_patch(p)*dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) + nf_veg%livestemn_storage_to_xfer_patch(p)*dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) - nf_veg%deadstemn_storage_to_xfer_patch(p)*dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) + nf_veg%deadstemn_storage_to_xfer_patch(p)*dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) - nf_veg%livecrootn_storage_to_xfer_patch(p)*dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) + nf_veg%livecrootn_storage_to_xfer_patch(p)*dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) - nf_veg%deadcrootn_storage_to_xfer_patch(p)*dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) + nf_veg%deadcrootn_storage_to_xfer_patch(p)*dt + end if + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if ! not use_matrixcn + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + if(.not. use_matrixcn)then + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) - nf_veg%livestemn_storage_to_xfer_patch(p)*dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) + nf_veg%livestemn_storage_to_xfer_patch(p)*dt + ns_veg%grainn_storage_patch(p) = ns_veg%grainn_storage_patch(p) - nf_veg%grainn_storage_to_xfer_patch(p)*dt + ns_veg%grainn_xfer_patch(p) = ns_veg%grainn_xfer_patch(p) + nf_veg%grainn_storage_to_xfer_patch(p)*dt + else + ! NOTE: The equivalent changes for matrix code are in CNPhenology EBK (11/26/2019) + end if ! not use_matrixcn + end if + + end do + + end associate + + end subroutine NStateUpdate1 + +end module CNNStateUpdate1Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate2Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate2Mod.F90 new file mode 100755 index 000000000..15423f19a --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate2Mod.F90 @@ -0,0 +1,275 @@ +module CNNStateUpdate2Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable update, mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size_real + use clm_varpar , only : nlevsoi, nlevdecomp + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, use_matrixcn,use_soil_matrixcn + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate2 + public:: NStateUpdate2h + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables affected by gap-phase mortality fluxes + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf_veg => cnveg_nitrogenflux_inst , & + ns_veg => cnveg_nitrogenstate_inst , & + nf_soil => soilbiogeochem_nitrogenflux_inst, & + ns_soil => soilbiogeochem_nitrogenstate_inst & + ) + + ! set time steps + dt = get_step_size_real() + + ! column-level nitrogen fluxes from gap-phase mortality + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_soil_matrixcn)then + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) + nf_veg%gap_mortality_n_to_litr_met_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) + nf_veg%gap_mortality_n_to_litr_cel_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) + nf_veg%gap_mortality_n_to_litr_lig_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cwd) = & + ns_soil%decomp_npools_vr_col(c,j,i_cwd) + nf_veg%gap_mortality_n_to_cwdn_col(c,j) * dt + else + nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_met_n_col(c,j) * dt + nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_cel_n_col(c,j) * dt + nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_lig_n_col(c,j) * dt + nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_cwdn_col(c,j) * dt + end if !not use_soil_matrix + end do + end do + + ! patch -level nitrogen fluxes from gap-phase mortality + + do fp = 1,num_soilp + p = filter_soilp(fp) + + if(.not. use_matrixcn)then + ! displayed pools + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) & + - nf_veg%m_leafn_to_litter_patch(p) * dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) & + - nf_veg%m_frootn_to_litter_patch(p) * dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) & + - nf_veg%m_livestemn_to_litter_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) & + - nf_veg%m_deadstemn_to_litter_patch(p) * dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) & + - nf_veg%m_livecrootn_to_litter_patch(p) * dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) & + - nf_veg%m_deadcrootn_to_litter_patch(p) * dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) & + - nf_veg%m_retransn_to_litter_patch(p) * dt + + ! storage pools + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) & + - nf_veg%m_leafn_storage_to_litter_patch(p) * dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) & + - nf_veg%m_frootn_storage_to_litter_patch(p) * dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) & + - nf_veg%m_livestemn_storage_to_litter_patch(p) * dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) & + - nf_veg%m_deadstemn_storage_to_litter_patch(p) * dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) & + - nf_veg%m_livecrootn_storage_to_litter_patch(p) * dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) & + - nf_veg%m_deadcrootn_storage_to_litter_patch(p) * dt + + ! transfer pools + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) & + - nf_veg%m_leafn_xfer_to_litter_patch(p) * dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) & + - nf_veg%m_frootn_xfer_to_litter_patch(p) * dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) & + - nf_veg%m_livestemn_xfer_to_litter_patch(p) * dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) & + - nf_veg%m_deadstemn_xfer_to_litter_patch(p) * dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) & + - nf_veg%m_livecrootn_xfer_to_litter_patch(p) * dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) & + - nf_veg%m_deadcrootn_xfer_to_litter_patch(p) * dt + + else + ! NOTE: The equivalent changes for matrix code are in dynHarvest::CNHarvest EBK (11/26/2019) + end if !not use_matrixcn + end do + + end associate + + end subroutine NStateUpdate2 + + !----------------------------------------------------------------------- + subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Update all the prognostic nitrogen state + ! variables affected by harvest mortality fluxes + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf_veg => cnveg_nitrogenflux_inst , & + ns_veg => cnveg_nitrogenstate_inst , & + nf_soil => soilbiogeochem_nitrogenflux_inst , & + ns_soil => soilbiogeochem_nitrogenstate_inst & + ) + + ! set time steps + dt = get_step_size_real() + + ! column-level nitrogen fluxes from harvest mortality + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (.not. use_soil_matrixcn)then + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) + nf_veg%harvest_n_to_litr_met_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) + nf_veg%harvest_n_to_litr_cel_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) + nf_veg%harvest_n_to_litr_lig_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cwd) = & + ns_soil%decomp_npools_vr_col(c,j,i_cwd) + nf_veg%harvest_n_to_cwdn_col(c,j) * dt + else + nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_met_n_col(c,j) * dt + nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_cel_n_col(c,j) * dt + nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_lig_n_col(c,j) * dt + nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = & + nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + nf_veg%harvest_n_to_cwdn_col(c,j) * dt + end if !not use_soil_matrixcn + end do + end do + + ! patch-level nitrogen fluxes from harvest mortality + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed pools + if(.not. use_matrixcn)then + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) & + - nf_veg%hrv_leafn_to_litter_patch(p) * dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) & + - nf_veg%hrv_frootn_to_litter_patch(p) * dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) & + - nf_veg%hrv_livestemn_to_litter_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) & + - nf_veg%wood_harvestn_patch(p) * dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) & + - nf_veg%hrv_livecrootn_to_litter_patch(p) * dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) & + - nf_veg%hrv_deadcrootn_to_litter_patch(p) * dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) & + - nf_veg%hrv_retransn_to_litter_patch(p) * dt + + ! storage pools + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) & + - nf_veg%hrv_leafn_storage_to_litter_patch(p) * dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) & + - nf_veg%hrv_frootn_storage_to_litter_patch(p) * dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) & + - nf_veg%hrv_livestemn_storage_to_litter_patch(p) * dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) & + - nf_veg%hrv_deadstemn_storage_to_litter_patch(p) * dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) & + - nf_veg%hrv_livecrootn_storage_to_litter_patch(p) * dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) & + - nf_veg%hrv_deadcrootn_storage_to_litter_patch(p) * dt + + ! transfer pools + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) & + - nf_veg%hrv_leafn_xfer_to_litter_patch(p) *dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) & + - nf_veg%hrv_frootn_xfer_to_litter_patch(p) *dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) & + - nf_veg%hrv_livestemn_xfer_to_litter_patch(p) *dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) & + - nf_veg%hrv_deadstemn_xfer_to_litter_patch(p) *dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) & + - nf_veg%hrv_livecrootn_xfer_to_litter_patch(p) *dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) & + - nf_veg%hrv_deadcrootn_xfer_to_litter_patch(p) *dt + else + ! NOTE: The equivalent changes for matrix code are in dynHarvest::CNHarvest EBK (11/26/2019) + end if !not use_matrixcn + + end do + + end associate + + end subroutine NStateUpdate2h + +end module CNNStateUpdate2Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPrecisionControlMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPrecisionControlMod.F90 new file mode 100755 index 000000000..e904c7f2b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPrecisionControlMod.F90 @@ -0,0 +1,865 @@ +module CNPrecisionControlMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! controls on very low values in critical state variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use PatchType , only : patch + use abortutils , only : endrun + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CNPrecisionControlReadNML + public:: CNPrecisionControl + + ! !PUBLIC DATA: + real(r8), public :: ccrit = 1.e-8_r8 ! critical carbon state value for truncation (gC/m2) + real(r8), public :: cnegcrit = -6.e+1_r8 ! critical negative carbon state value for abort (gC/m2) + real(r8), public :: ncrit = 1.e-8_r8 ! critical nitrogen state value for truncation (gN/m2) + real(r8), public :: nnegcrit = -7.e+0_r8 ! critical negative nitrogen state value for abort (gN/m2) + real(r8), public, parameter :: n_min = 0.000000001_r8 ! Minimum Nitrogen value to use when calculating CN ratio (gN/m2) + + ! !PRIVATE DATA: + logical, private :: prec_control_for_froot = .true. ! If true do precision control for frootc/frootn + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNPrecisionControlReadNML( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for CN Precision control + ! + ! !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog, use_nguardrail + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'CNPrecisionControlReadNML' + character(len=*), parameter :: nmlname = 'cnprecision_inparm' + !----------------------------------------------------------------------- + namelist /cnprecision_inparm/ ncrit, ccrit, cnegcrit, nnegcrit + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=cnprecision_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (ncrit , mpicom) + call shr_mpi_bcast (ccrit , mpicom) + call shr_mpi_bcast (nnegcrit, mpicom) + call shr_mpi_bcast (cnegcrit, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=cnprecision_inparm) + write(iulog,*) ' ' + end if + + ! Have precision control for froot be determined by use_nguardrail setting + prec_control_for_froot = .not. use_nguardrail + + end subroutine CNPrecisionControlReadNML + + !----------------------------------------------------------------------- + subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Force leaf and deadstem c and n to 0 if they get too small. + ! + ! !USES: + use clm_varctl , only : iulog, use_c13, use_c14 + use clm_varctl , only : use_crop + use pftconMod , only : nc3crop + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilp ! number of soil patchs in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p,j,k ! indices + integer :: fp ! filter indices + integer :: num_truncatep ! number of points in filter_truncatep + integer :: filter_truncatep(bounds%endp-bounds%begp+1) ! filter for points that need truncation + real(r8):: pc(bounds%begp:bounds%endp) ! truncation terms for patch-level corrections Carbon + real(r8):: pn(bounds%begp:bounds%endp) ! truncation terms for patch-level corrections nitrogen + real(r8):: pc13(bounds%begp:bounds%endp) ! truncation terms for patch-level corrections + real(r8):: pc14(bounds%begp:bounds%endp) ! truncation terms for patch-level corrections + !----------------------------------------------------------------------- + + ! cnveg_carbonstate_inst%cpool_patch Output: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + ! cnveg_carbonstate_inst%deadcrootc_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C + ! cnveg_carbonstate_inst%deadcrootc_storage_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C storage + ! cnveg_carbonstate_inst%deadcrootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + ! cnveg_carbonstate_inst%deadstemc_patch Output: [real(r8) (:) ] (gC/m2) dead stem C + ! cnveg_carbonstate_inst%deadstemc_storage_patch Output: [real(r8) (:) ] (gC/m2) dead stem C storage + ! cnveg_carbonstate_inst%deadstemc_xfer_patch Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + ! cnveg_carbonstate_inst%frootc_patch Output: [real(r8) (:) ] (gC/m2) fine root C + ! cnveg_carbonstate_inst%frootc_storage_patch Output: [real(r8) (:) ] (gC/m2) fine root C storage + ! cnveg_carbonstate_inst%frootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) fine root C transfer + ! cnveg_carbonstate_inst%gresp_storage_patch Output: [real(r8) (:) ] (gC/m2) growth respiration storage + ! cnveg_carbonstate_inst%gresp_xfer_patch Output: [real(r8) (:) ] (gC/m2) growth respiration transfer + ! cnveg_carbonstate_inst%leafc_patch Output: [real(r8) (:) ] (gC/m2) leaf C + ! cnveg_carbonstate_inst%leafc_storage_patch Output: [real(r8) (:) ] (gC/m2) leaf C storage + ! cnveg_carbonstate_inst%leafc_xfer_patch Output: [real(r8) (:) ] (gC/m2) leaf C transfer + ! cnveg_carbonstate_inst%livecrootc_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C + ! cnveg_carbonstate_inst%livecrootc_storage_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C storage + ! cnveg_carbonstate_inst%livecrootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + ! cnveg_carbonstate_inst%livestemc_patch Output: [real(r8) (:) ] (gC/m2) live stem C + ! cnveg_carbonstate_inst%livestemc_storage_patch Output: [real(r8) (:) ] (gC/m2) live stem C storage + ! cnveg_carbonstate_inst%livestemc_xfer_patch Output: [real(r8) (:) ] (gC/m2) live stem C transfer + ! cnveg_carbonstate_inst%ctrunc_patch Output: [real(r8) (:) ] (gC/m2) patch-level sink for C truncation + ! cnveg_carbonstate_inst%xsmrpool_patch Output: [real(r8) (:) ] (gC/m2) execss maint resp C pool + ! cnveg_carbonstate_inst%grainc_patch Output: [real(r8) (:) ] (gC/m2) grain C + ! cnveg_carbonstate_inst%grainc_storage_patch Output: [real(r8) (:) ] (gC/m2) grain C storage + ! cnveg_carbonstate_inst%grainc_xfer_patch Output: [real(r8) (:) ] (gC/m2) grain C transfer + + ! cnveg_nitrogenstate_inst%deadcrootn_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N + ! cnveg_nitrogenstate_inst%deadcrootn_storage_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N storage + ! cnveg_nitrogenstate_inst%deadcrootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + ! cnveg_nitrogenstate_inst%deadstemn_patch Output: [real(r8) (:) ] (gN/m2) dead stem N + ! cnveg_nitrogenstate_inst%deadstemn_storage_patch Output: [real(r8) (:) ] (gN/m2) dead stem N storage + ! cnveg_nitrogenstate_inst%deadstemn_xfer_patch Output: [real(r8) (:) ] (gN/m2) dead stem N transfer + ! cnveg_nitrogenstate_inst%frootn_patch Output: [real(r8) (:) ] (gN/m2) fine root N + ! cnveg_nitrogenstate_inst%frootn_storage_patch Output: [real(r8) (:) ] (gN/m2) fine root N storage + ! cnveg_nitrogenstate_inst%frootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) fine root N transfer + ! cnveg_nitrogenstate_inst%leafn_patch Output: [real(r8) (:) ] (gN/m2) leaf N + ! cnveg_nitrogenstate_inst%leafn_storage_patch Output: [real(r8) (:) ] (gN/m2) leaf N storage + ! cnveg_nitrogenstate_inst%leafn_xfer_patch Output: [real(r8) (:) ] (gN/m2) leaf N transfer + ! cnveg_nitrogenstate_inst%livecrootn_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N + ! cnveg_nitrogenstate_inst%livecrootn_storage_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N storage + ! cnveg_nitrogenstate_inst%livecrootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer + ! cnveg_nitrogenstate_inst%grainn_patch Output: [real(r8) (:) ] (gC/m2) grain N + ! cnveg_nitrogenstate_inst%grainn_storage_patch Output: [real(r8) (:) ] (gC/m2) grain N storage + ! cnveg_nitrogenstate_inst%grainn_xfer_patch Output: [real(r8) (:) ] (gC/m2) grain N transfer + ! cnveg_nitrogenstate_inst%livestemn_patch Output: [real(r8) (:) ] (gN/m2) live stem N + ! cnveg_nitrogenstate_inst%livestemn_storage_patch Output: [real(r8) (:) ] (gN/m2) live stem N storage + ! cnveg_nitrogenstate_inst%livestemn_xfer_patch Output: [real(r8) (:) ] (gN/m2) live stem N transfer + ! cnveg_nitrogenstate_inst%npool_patch Output: [real(r8) (:) ] (gN/m2) temporary plant N pool + ! cnveg_nitrogenstate_inst%ntrunc_patch Output: [real(r8) (:) ] (gN/m2) patch-level sink for N truncation + ! cnveg_nitrogenstate_inst%retransn_patch Output: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + + associate( & + cs => cnveg_carbonstate_inst , & + ns => cnveg_nitrogenstate_inst , & + c13cs => c13_cnveg_carbonstate_inst , & + c14cs => c14_cnveg_carbonstate_inst & + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! initialize the patch-level C and N truncation terms + pc(p) = 0._r8 + pn(p) = 0._r8 + if ( use_c13 ) pc13(p) = 0._r8 + if ( use_c14 ) pc14(p) = 0._r8 + end do + + ! do tests on state variables for precision control + ! for linked C-N state variables, perform precision test on + ! the C component, but truncate C, C13, and N components + + ! leaf C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_patch(bounds%begp:bounds%endp), & + ns%leafn_patch(bounds%begp:bounds%endp), & + pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep) + + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%leafc_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%leafc_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + + ! leaf storage C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_storage_patch(bounds%begp:bounds%endp), & + ns%leafn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%leafc_storage_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%leafc_storage_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! leaf transfer C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_xfer_patch(bounds%begp:bounds%endp), & + ns%leafn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%leafc_xfer_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%leafc_xfer_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! froot C and N + ! EBK KO DML: For some reason frootc/frootn can go negative and allowing + ! it to be negative is important for C4 crops (otherwise they die) Jun/3/2016 + if ( prec_control_for_froot ) then + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_patch(bounds%begp:bounds%endp), & + ns%frootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep, allowneg=.true.) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%frootc_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%frootc_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + end if + + ! froot storage C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_storage_patch(bounds%begp:bounds%endp), & + ns%frootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%frootc_storage_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%frootc_storage_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! froot transfer C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_xfer_patch(bounds%begp:bounds%endp), & + ns%frootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%frootc_xfer_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%frootc_xfer_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + if ( use_crop )then + ! grain C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%grainc_patch(bounds%begp:bounds%endp), & + ns%grainn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep, croponly=.true. ) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%grainc_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%grainc_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! grain storage C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%grainc_storage_patch(bounds%begp:bounds%endp), & + ns%grainn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep, croponly=.true. ) + + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%grainc_storage_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%grainc_storage_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! grain transfer C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%grainc_xfer_patch(bounds%begp:bounds%endp), & + ns%grainn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep, croponly=.true.) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%grainc_xfer_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%grainc_xfer_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! grain transfer C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%cropseedc_deficit_patch(bounds%begp:bounds%endp), & + ns%cropseedn_deficit_patch(bounds%begp:bounds%endp), pc(bounds%begp:), & + pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep, & + allowneg=.true., croponly=.true. ) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%cropseedc_deficit_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%cropseedc_deficit_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + end if + + ! livestem C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_patch(bounds%begp:bounds%endp), & + ns%livestemn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%livestemc_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%livestemc_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! livestem storage C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_storage_patch(bounds%begp:bounds%endp), & + ns%livestemn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%livestemc_storage_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%livestemc_storage_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + ! livestem transfer C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_xfer_patch(bounds%begp:bounds%endp), & + ns%livestemn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%livestemc_xfer_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%livestemc_xfer_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! deadstem C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_patch(bounds%begp:bounds%endp), & + ns%deadstemn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%deadstemc_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%deadstemc_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + ! deadstem storage C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_storage_patch(bounds%begp:bounds%endp), & + ns%deadstemn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%deadstemc_storage_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%deadstemc_storage_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! deadstem transfer C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_xfer_patch(bounds%begp:bounds%endp), & + ns%deadstemn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%deadstemc_xfer_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%deadstemc_xfer_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! livecroot C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_patch(bounds%begp:bounds%endp), & + ns%livecrootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%livecrootc_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%livecrootc_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! livecroot storage C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_storage_patch(bounds%begp:bounds%endp), & + ns%livecrootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%livecrootc_storage_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%livecrootc_storage_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! livecroot transfer C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_xfer_patch(bounds%begp:bounds%endp), & + ns%livecrootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%livecrootc_xfer_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%livecrootc_xfer_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! deadcroot C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_patch(bounds%begp:bounds%endp), & + ns%deadcrootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & + num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%deadcrootc_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%deadcrootc_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! deadcroot storage C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_storage_patch(bounds%begp:bounds%endp), & + ns%deadcrootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%deadcrootc_storage_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%deadcrootc_storage_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! deadcroot transfer C and N + call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_xfer_patch(bounds%begp:bounds%endp), & + ns%deadcrootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & + __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%deadcrootc_xfer_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%deadcrootc_xfer_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! gresp_storage (C only) + call TruncateCStates( bounds, filter_soilp, num_soilp, cs%gresp_storage_patch(bounds%begp:bounds%endp), & + pc(bounds%begp:), __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%gresp_storage_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%gresp_storage_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! gresp_xfer(c only) + call TruncateCStates( bounds, filter_soilp, num_soilp, cs%gresp_xfer_patch(bounds%begp:bounds%endp), & + pc(bounds%begp:), __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%gresp_xfer_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%gresp_xfer_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + ! cpool (C only) + call TruncateCStates( bounds, filter_soilp, num_soilp, cs%cpool_patch(bounds%begp:bounds%endp), & + pc(bounds%begp:), __LINE__, num_truncatep, filter_truncatep) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%cpool_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%cpool_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + if ( use_crop )then + ! xsmrpool (C only) + ! xsmr is a pool to balance the budget and as such can be freely negative + call TruncateCStates( bounds, filter_soilp, num_soilp, cs%xsmrpool_patch(bounds%begp:bounds%endp), & + pc(bounds%begp:), __LINE__, num_truncatep, filter_truncatep, & + allowneg=.true., croponly=.true. ) + if (use_c13) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c13cs%xsmrpool_patch(bounds%begp:bounds%endp), pc13(bounds%begp:bounds%endp), & + __LINE__) + end if + if (use_c14) then + call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + c14cs%xsmrpool_patch(bounds%begp:bounds%endp), pc14(bounds%begp:bounds%endp), & + __LINE__) + end if + + end if + + ! retransn (N only) + call TruncateNStates( bounds, filter_soilp, num_soilp, ns%retransn_patch(bounds%begp:bounds%endp), pn(bounds%begp:), & + __LINE__ ) + + ! npool (N only) + call TruncateNStates( bounds, filter_soilp, num_soilp, ns%npool_patch(bounds%begp:bounds%endp), pn(bounds%begp:), & + __LINE__ ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + cs%ctrunc_patch(p) = cs%ctrunc_patch(p) + pc(p) + + ns%ntrunc_patch(p) = ns%ntrunc_patch(p) + pn(p) + + if ( use_c13 ) then + c13cs%ctrunc_patch(p) = c13cs%ctrunc_patch(p) + pc13(p) + endif + if ( use_c14 ) then + c14cs%ctrunc_patch(p) = c14cs%ctrunc_patch(p) + pc14(p) + endif + end do + + end associate + + end subroutine CNPrecisionControl + + subroutine TruncateCandNStates( bounds, filter_soilp, num_soilp, carbon_patch, nitrogen_patch, pc, pn, lineno, & + num_truncatep, filter_truncatep, croponly, allowneg ) + ! + ! !DESCRIPTION: + ! Truncate paired Carbon and Nitrogen states. If a paired carbon and nitrogen state iare too small truncate + ! the pair of them to zero. + ! + ! !USES: + use shr_log_mod, only : errMsg => shr_log_errMsg + use clm_varctl , only : use_c13, use_c14, use_nguardrail, use_matrixcn + use clm_varctl , only : iulog + use pftconMod , only : nc3crop + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilp ! number of soil patchs in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + real(r8), intent(inout) :: carbon_patch(bounds%begp:) + real(r8), intent(inout) :: nitrogen_patch(bounds%begp:) + real(r8), intent(inout) :: pc(bounds%begp:) + real(r8), intent(inout) :: pn(bounds%begp:) + integer, intent(in) :: lineno + integer, intent(out) :: num_truncatep ! number of points in filter_truncatep + integer, intent(out) :: filter_truncatep(:) ! filter for points that need truncation + logical , intent(in) , optional :: croponly + logical , intent(in) , optional :: allowneg + + logical :: lcroponly, lallowneg + integer :: fp, p + + SHR_ASSERT_ALL_FL((ubound(carbon_patch) == (/bounds%endp/)), 'ubnd(carb)'//sourcefile, lineno) + SHR_ASSERT_ALL_FL((ubound(nitrogen_patch) == (/bounds%endp/)), 'ubnd(nitro)'//sourcefile, lineno) + SHR_ASSERT_ALL_FL((ubound(pc) == (/bounds%endp/)), 'ubnd(pc)'//sourcefile, lineno) + SHR_ASSERT_ALL_FL((ubound(pn) == (/bounds%endp/)), 'ubnd(pn)'//sourcefile, lineno) + + ! patch loop + lcroponly = .false. + if ( present(croponly) )then + if ( croponly ) lcroponly = .true. + end if + lallowneg = .false. + if ( present(allowneg) )then + if ( allowneg ) lallowneg = .true. + end if + + num_truncatep = 0 + do fp = 1,num_soilp + p = filter_soilp(fp) + + if ( .not. lcroponly .or. (patch%itype(p) >= nc3crop) ) then + if ( .not. lallowneg .and. ((carbon_patch(p) < cnegcrit) .or. (nitrogen_patch(p) < nnegcrit)) ) then + write(iulog,*) 'ERROR: Carbon or Nitrogen patch negative = ', carbon_patch(p), nitrogen_patch(p) + write(iulog,*) 'ERROR: limits = ', cnegcrit, nnegcrit + call endrun(msg='ERROR: carbon or nitrogen state critically negative '//errMsg(sourcefile, lineno)) + else + if (use_matrixcn)then + if ( (carbon_patch(p) < ccrit .and. carbon_patch(p) > -ccrit * 1.e+6) .or. (use_nguardrail .and. nitrogen_patch(p) < ncrit .and. nitrogen_patch(p) > -ncrit*1.e+6) ) then + num_truncatep = num_truncatep + 1 + filter_truncatep(num_truncatep) = p + + pc(p) = pc(p) + carbon_patch(p) + carbon_patch(p) = 0._r8 + + pn(p) = pn(p) + nitrogen_patch(p) + nitrogen_patch(p) = 0._r8 + + end if + else + if ( abs(carbon_patch(p)) < ccrit .or. (use_nguardrail .and. abs(nitrogen_patch(p)) < ncrit ) ) then + num_truncatep = num_truncatep + 1 + filter_truncatep(num_truncatep) = p + + pc(p) = pc(p) + carbon_patch(p) + carbon_patch(p) = 0._r8 + + pn(p) = pn(p) + nitrogen_patch(p) + nitrogen_patch(p) = 0._r8 + + end if + end if + end if + end if + end do + end subroutine TruncateCandNStates + + subroutine TruncateCStates( bounds, filter_soilp, num_soilp, carbon_patch, pc, lineno, & + num_truncatep, filter_truncatep, croponly, allowneg ) + ! + ! !DESCRIPTION: + ! Truncate Carbon states. If a carbon state is too small truncate it to + ! zero. + ! + ! !USES: + use abortutils , only : endrun + use clm_varctl , only : iulog + use shr_log_mod, only : errMsg => shr_log_errMsg + use clm_varctl , only : use_c13, use_c14 + use pftconMod , only : nc3crop + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilp ! number of soil patchs in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + real(r8) , intent(inout) :: carbon_patch(bounds%begp:) + real(r8) , intent(inout) :: pc(bounds%begp:) + integer , intent(in) :: lineno + integer , intent(out) :: num_truncatep ! number of points in filter_truncatep + integer , intent(out) :: filter_truncatep(:) ! filter for points that need truncation + logical , intent(in) , optional :: croponly + logical , intent(in) , optional :: allowneg + + logical :: lcroponly, lallowneg + integer :: fp, p + + SHR_ASSERT_ALL_FL((ubound(carbon_patch) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(pc) == (/bounds%endp/)), sourcefile, __LINE__) + + if ( -ccrit < cnegcrit )then + call endrun(msg='ERROR: cnegcrit should be less than -ccrit: '//errMsg(sourcefile, lineno)) + end if + lcroponly = .false. + if ( present(croponly) )then + if ( croponly ) lcroponly = .true. + end if + lallowneg = .false. + if ( present(allowneg) )then + if ( allowneg ) lallowneg = .true. + end if + + num_truncatep = 0 + do fp = 1,num_soilp + p = filter_soilp(fp) + + if ( .not. lcroponly .or. (patch%itype(p) >= nc3crop) ) then + if ( .not. lallowneg .and. (carbon_patch(p) < cnegcrit) ) then + write(iulog,*) 'ERROR: Carbon patch negative = ', carbon_patch(p) + write(iulog,*) 'ERROR: limit = ', cnegcrit + call endrun(msg='ERROR: carbon state critically negative '//errMsg(sourcefile, lineno)) + else if ( abs(carbon_patch(p)) < ccrit) then + + num_truncatep = num_truncatep + 1 + filter_truncatep(num_truncatep) = p + + pc(p) = pc(p) + carbon_patch(p) + carbon_patch(p) = 0._r8 + end if + end if + end do + end subroutine TruncateCStates + + subroutine TruncateNStates( bounds, filter_soilp, num_soilp, nitrogen_patch, pn, lineno ) + ! + ! !DESCRIPTION: + ! Truncate Nitrogen states. If a nitrogen state is too small truncate it to + ! zero. + ! + ! !USES: + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilp ! number of soil patchs in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + real(r8), intent(inout) :: nitrogen_patch(bounds%begp:) + real(r8), intent(inout) :: pn(bounds%begp:) + integer, intent(in) :: lineno + + integer :: fp, p + + SHR_ASSERT_ALL_FL((ubound(nitrogen_patch) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(pn) == (/bounds%endp/)), sourcefile, __LINE__) + do fp = 1,num_soilp + p = filter_soilp(fp) + if ( nitrogen_patch(p) < nnegcrit ) then + !write(iulog,*) 'WARNING: Nitrogen patch negative = ', nitrogen_patch + !call endrun(msg='ERROR: nitrogen state critically negative'//errMsg(sourcefile, lineno)) + else if ( abs(nitrogen_patch(p)) < ncrit) then + pn(p) = pn(p) + nitrogen_patch(p) + nitrogen_patch(p) = 0._r8 + + end if + end do + end subroutine TruncateNStates + + !----------------------------------------------------------------------- + subroutine TruncateAdditional( bounds, num_truncatep, filter_truncatep, & + state_patch, truncation_patch, lineno) + ! + ! !DESCRIPTION: + ! Given a filter of points for which we have already determined that truncation should + ! occur, do the truncation for the given patch-level state, putting the truncation + ! amount in truncation_patch. + ! + use decompMod , only : bounds_type + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent (in) :: bounds ! bounds + integer , intent (in) :: num_truncatep ! number of points in filter_truncatep + integer , intent (in) :: filter_truncatep(:) ! filter for points that need truncation + real(r8) , intent (inout) :: state_patch(bounds%begp: ) + real(r8) , intent (inout) :: truncation_patch(bounds%begp: ) + integer , intent (in) :: lineno + ! + ! !LOCAL VARIABLES: + integer :: fp, p + character(len=*), parameter :: subname = 'TruncateAdditional' + !----------------------------------------------------------------------- + + SHR_ASSERT_FL((ubound(state_patch, 1) == bounds%endp), 'state_patch ' //sourcefile, lineno) + SHR_ASSERT_FL((ubound(truncation_patch, 1) == bounds%endp), 'truncation_patch '//sourcefile, lineno) + + do fp = 1, num_truncatep + p = filter_truncatep(fp) + truncation_patch(p) = truncation_patch(p) + state_patch(p) + state_patch(p) = 0._r8 + end do + + end subroutine TruncateAdditional + +end module CNPrecisionControlMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNRootDynMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNRootDynMod.F90 new file mode 100755 index 000000000..8929f7f90 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNRootDynMod.F90 @@ -0,0 +1,277 @@ +module CNRootDynMod + +!----------------------------------------------------------------------- +! !DESCRIPTION: +! Module holding routines used for determining fine root distribution for all pfts. +! Includes dynamic root depth for crops +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size_real + use clm_varpar , only : nlevsoi, nlevgrnd + use clm_varctl , only : use_vertsoilc, use_bedrock + use decompMod , only : bounds_type + use pftconMod , only : noveg, npcropmin, pftcon + use ColumnType , only : col + use PatchType , only : patch + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type + use SoilStateType , only : soilstate_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use CropType , only : crop_type + +! !PUBLIC TYPES: + implicit none + save + private + public :: CNRootDyn +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +! +subroutine CNRootDyn(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, & + cnveg_state_inst, crop_inst, soilstate_inst, soilbiogeochem_nitrogenstate_inst) +! +! !DESCRIPTION: +! This routine determine the fine root distribution +! Needs to be called after the photosynthesis calculation +! May need to update other subroutines that use the fixed root profile for calculations +! i.e. CNVerticalProfileMod +! +! !USES: + + +! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: num_soilc + integer, intent(in) :: filter_soilc(:) + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(crop_type) , intent(in) :: crop_inst + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + +! +! !LOCAL VARIABLES: + + integer :: f,c,p,lev,j ! indices + real(r8):: dt ! radiation time step delta t (seconds) + real(r8), allocatable :: w_limit(:) + real(r8), allocatable :: rswa(:,:) ! soil water availability in each soil layer + real(r8), allocatable :: rsmn(:,:) ! soil nitrogen availability in each soil layer + real(r8), allocatable :: sumrswa(:) ! scaling soil water availability in each soil layer + real(r8), allocatable :: sumrsmn(:) ! scaling soil mineral N availability in each soil layer + real(r8) :: frootc_dz(bounds%begp:bounds%endp, 1:nlevgrnd) + real(r8), allocatable :: sumfrootc(:) ! fine root carbon total before turnover in each step + real(r8):: minpsi ! minimum soil moisture potential + real(r8):: psi + real(r8):: maxpsi + real(r8):: new_growth + +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays (in) + associate(& + ivt => patch%itype , & ! Input: [integer (:)] pft vegetation type + pcolumn => patch%column , & ! Input: [integer (:)] pft's column index + roota_par => pftcon%roota_par , & ! Input: [real(r8) (:)] pft's roota index + rootb_par => pftcon%rootb_par , & ! Input: [real(r8) (:)] pft's rootb index + root_dmx => pftcon%root_dmx , & ! Input: [real(r8) (:)] crop maximum root depth + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Input: [real(r8) (:)] allocation to fine root C (gC/m2/s) + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Input: [real(r8) (:)] fine root C growth from storage (gC/m2/s) + dormant_flag => cnveg_state_inst%dormant_flag_patch , & ! Input: [real(r8) (:)] dormancy flag + root_depth => soilstate_inst%root_depth_patch , & ! InOut: [real(r8) (:)] current root depth + dz => col%dz , & ! Input: layer thickness (m) (-nlevsno+1:nlevgrnd) + zi => col%zi , & ! Input: interface level below a "z" level (m) (-nlevsno+0:nlevgrnd) + rootfr => soilstate_inst%rootfr_patch , & ! Output: [real(r8) (:,:)] fraction of roots in each soil layer + sucsat => soilstate_inst%sucsat_col , & ! Input: minimum soil suction (mm) + soilpsi => soilstate_inst%soilpsi_col , & ! Input: soil water potential in each soil layer (MPa) + sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Iniput: [real(r8) (:,:)] (gN/m3) soil mineral N + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:)] (gC/m2) fine root C + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:)] =gdd since planting (gddplant) + croplive => crop_inst%croplive_patch , & ! Input: [logical (:)] flag, true if planted, not harvested + huigrain => cnveg_state_inst%huigrain_patch & ! Input: [real(r8) (:)] same to reach vegetative maturity + ) + +! set time steps + dt = get_step_size_real() + +! set minpsi to permanent wilting point + minpsi = -1.5_r8 + + allocate(sumrswa(bounds%begp:bounds%endp)) + allocate(sumrsmn(bounds%begp:bounds%endp)) + allocate(sumfrootc(bounds%begp:bounds%endp)) + allocate(rswa(bounds%begp:bounds%endp,nlevgrnd)) + allocate(rsmn(bounds%begp:bounds%endp,nlevgrnd)) + allocate(w_limit(bounds%begp:bounds%endp)) + +!initialize to 0 + w_limit(bounds%begp:bounds%endp) = 0._r8 + sumrswa(bounds%begp:bounds%endp) = 0._r8 + sumrsmn(bounds%begp:bounds%endp) = 0._r8 + sumfrootc(bounds%begp:bounds%endp) = 0._r8 + rswa(bounds%begp:bounds%endp,:) = 0._r8 + rsmn(bounds%begp:bounds%endp,:) = 0._r8 + + frootc_dz(bounds%begp:bounds%endp,1:nlevgrnd) = 0._r8 + + +!--------------------------------------------------------------- +! Set root depth, dynamic for crops, fixed for other vegetation +!--------------------------------------------------------------- + + do f = 1, num_soilp + p = filter_soilp(f) + c = pcolumn(p) + if (ivt(p) /= noveg) then + if((ivt(p)) >= npcropmin)then !skip generic crop types + if(huigrain(p) > 0._r8)then + root_depth(p) = max(zi(c,2), min(hui(p)/huigrain(p)* root_dmx(ivt(p)), root_dmx(ivt(p)))) + end if + else + ! this can be changed to any depth (i.e. the maximum soil depth) + root_depth(p) = zi(c,nlevsoi) + end if + if (use_bedrock) then + root_depth(p) = min(root_depth(p),zi(c,col%nbedrock(c))) + end if + else + root_depth(p) = 0._r8 + end if + end do + +!---------------------------------------------------------------- +! ! calculate a weighting function by soil depth that depends on the + ! fine root distribution per pft and depth and the pft weight on the column. + ! This will be used to weight the temperature and water potential scalars + ! for decomposition control. + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + do j = 1,nlevsoi + do f = 1,num_soilp + p = filter_soilp(f) + c = pcolumn(p) + maxpsi = sucsat(c,j) * (-9.8e-6_r8) + psi = min(soilpsi(c,j),maxpsi) + if (psi > minpsi) then +! First calculate water in the root zone + if(root_depth(p) > 0.15_r8 .and. (zi(c,j) <= root_depth(p) .or. & + (zi(c,j-1) < root_depth(p) .and. zi(c,j) > root_depth(p)))) then + w_limit(p) = w_limit(p) + max(0._r8,log(minpsi/psi)/log(minpsi/maxpsi))*rootfr(p,j) + end if +! Calculate the water in each soil layer + if (root_depth(p) >= zi(c,j) .or. & + (zi(c,j-1) < root_depth(p) .and. zi(c,j) > root_depth(p))) then + rswa(p,j) = max(0._r8, (log(minpsi/psi)/log(minpsi/maxpsi))) + end if + end if + sumrswa(p) = sumrswa(p) + rswa(p,j) + +! Calculate the nitrogen profile in each layer +! For now, the profile for each PFT is equivilent to the +! column profile, in the future, this could be changed to a weighted profile + if(use_vertsoilc) then !for vertical soil profile + rsmn(p,j) = sminn_vr(c,j) + else ! need to calculate a profile, top 0.2m are constant, and decrease linearly + if(zi(c,j) <= 0.2_r8)then + rsmn(p,j) = dz(c,j) + end if + if(zi(c,j) > 0.2_r8)then + rsmn(p,j) = dz(c,j) * (zi(c,nlevsoi) - zi(c,j)) / (zi(c,nlevsoi) - 0.2_r8) + end if + end if + if (root_depth(p) >= zi(c,j).or. & + (zi(c,j-1) < root_depth(p) .and. zi(c,j) > root_depth(p))) then + sumrsmn(p) = sumrsmn(p) + rsmn(p,j) + end if + end do + end do + + +!-------------------------------------------------------------------- +! Now calculate the density of roots in each soil layer for each pft +! based on this timesteps growth +!-------------------------------------------------------------------- + do lev = 1, nlevgrnd + + do f = 1, num_soilp + p = filter_soilp(f) + c = pcolumn(p) + + new_growth = (cpool_to_frootc(p) + frootc_xfer_to_frootc(p))*dt + if(zi(c,lev) <= root_depth(p) .or. & + (zi(c,lev-1) < root_depth(p) .and. zi(c,lev) > root_depth(p))) then + if(sumrswa(p) <= 0._r8 .or. sumrsmn(p) <= 0._r8) then +! when sumrswa or sumrsmn are less than or equal to 0 rootfr will not be updated + else + frootc_dz(p,lev) = (frootc(p))*rootfr(p,lev) & + + new_growth * ((1._r8 - w_limit(p)) * rswa(p,lev) / sumrswa(p) & + + w_limit(p) * rsmn(p,lev) / sumrsmn(p)) + end if + else + frootc_dz(p,lev) = 0._r8 + end if + + sumfrootc(p) = sumfrootc(p) + frootc_dz(p,lev) + + end do + end do +!---------------------------------- +!Calculate root fraction +!---------------------------------- + + do lev = 1, nlevgrnd + do f = 1, num_soilp + p = filter_soilp(f) + c = pcolumn(p) + if(sumfrootc(p) > 0._r8)then + rootfr(p,lev) = frootc_dz(p,lev)/sumfrootc(p) + end if + if(ivt(p) >= npcropmin .and. .not. croplive(p))then +! CROPS are dormant, there are no roots! +! but, need an initial frootr so crops can start root production + if (lev < 2)then + rootfr(p,lev) = .5_r8*( exp(-roota_par(patch%itype(p)) * zi(c,lev-1)) & + + exp(-rootb_par(patch%itype(p)) * zi(c,lev-1)) & + - exp(-roota_par(patch%itype(p)) * zi(c,lev )) & + - exp(-rootb_par(patch%itype(p)) * zi(c,lev )) ) + elseif (lev == 2) then + rootfr(p,lev) = .5_r8*( exp(-roota_par(patch%itype(p)) * zi(c,lev-1)) & + + exp(-rootb_par(patch%itype(p)) * zi(c,lev-1)) ) + else + rootfr(p,lev) = 0.0_r8 + end if + + end if + end do + end do + +!********************** + deallocate(sumrswa) + deallocate(sumrsmn) + deallocate(sumfrootc) + deallocate(rsmn) + deallocate(rswa) + deallocate(w_limit) + + end associate + + end subroutine CNRootDyn + +end module CNRootDynMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 index 68c46747e..02942365e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 @@ -3,14 +3,16 @@ module CN_DriverMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan use CNVegetationFacade - use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_zon + use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_zon, CN_zone_weight use clm_varcon , only : grav, denh2o contains !--------------------------------- - subroutine CN_Driver(nch,ndep,tp1,tairm,rzm,psis,bee,dayl) + subroutine CN_Driver(nch,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& + rzm,sfm,tm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& + abm,peatf,hdm,lnfm) use CNCLM_decompMod, only : bounds use CNCLM_filterMod, only : filter @@ -18,6 +20,12 @@ subroutine CN_Driver(nch,ndep,tp1,tairm,rzm,psis,bee,dayl) use CNCLM_SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type use CNCLM_ActiveLayerMod use CNCLM_GridcellType + use FireMethodType , only : fire_method_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use CNCLM_WaterDiagnosticBulkType, only : waterdiagnosticbulk_type + use CNCLM_atm2lndType , only : atm2lnd_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use CNCLM_CNVegStateType , only : cnveg_state_type !ARGUMENTS implicit none @@ -27,10 +35,25 @@ subroutine CN_Driver(nch,ndep,tp1,tairm,rzm,psis,bee,dayl) real, dimension(nch), intent(in) :: ndep ! nitrogen deposition [g m^-2 s^-1] real, dimension(nch), intent(in) :: tp1 ! soil temperatures [K] real, dimension(nch), intent(in) :: tairm ! surface air temperature [K] averaged over CN interval - real, dimension(nch,nzone), intent(in) :: rzm ! weighted root-zone moisture content as frac of WHC real, dimension(nch), intent(in) :: bee ! Clapp-Hornberger 'b' [-] real, dimension(nch), intent(in) :: psis ! saturated matric potential [m] real, dimension(nch), intent(in) :: dayl ! daylength [seconds] + real, dimension(nch,num_zon), intent(in) :: btran_fire + real, dimension(nch), intent(in) :: car1m ! fraction of tile that is saturated area + real, dimension(nch,num_zon), intent(in) :: rzm ! weighted root-zone moisture content as frac of WHC + real, dimension(nch,num_zon), intent(in) :: sfm ! weighted surface moisture content as frac of WHC + real, dimension(nch), intent(in) :: tm ! air temperature (K) + real, dimension(nch), intent(in) :: rhm ! relative humidity (%) + real, dimension(nch), intent(in) :: windm ! wind speed (m/s) + real, dimension(nch), intent(in) :: rainfm ! rainfall (convective + largescale) (kg/m2/s) + real, dimension(nch), intent(in) :: snowfm ! snowfall (kg/m2/s) + real, dimension(nch), intent(in) :: prec10d ! 10-day running mean of total precipitation (mm H2O/s) + real, dimension(nch), intent(in) :: prec60d ! 60-day running mean of total precipitation (mm H2O/s) + real, dimension(nch), intent(in) :: gdp ! Real GDP (K 1995US$/capita) + real, dimension(nch), intent(in) :: abm ! Peak month for agricultural fire, unitless + real, dimension(nch), intent(in) :: peatf ! Fraction of peatland, unitless (0-1) + real, dimension(nch), intent(in) :: hdm ! Human population density in 2010 (individual/km2) + real, dimension(nch), intent(in) :: lnfm ! Lightning frequency [Flashes/km^2/day] !LOCAL @@ -42,6 +65,9 @@ subroutine CN_Driver(nch,ndep,tp1,tairm,rzm,psis,bee,dayl) type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst type(gridcell_type) :: grc + type(cn_vegetation_type), public :: bgc_vegetation_inst + type(fire_method_type) :: cnfire_method + type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions integer :: n, p, nc, nz, np @@ -54,15 +80,43 @@ subroutine CN_Driver(nch,ndep,tp1,tairm,rzm,psis,bee,dayl) p = 0 do nc = 1,nch ! catchment tile loop - grc%dayl(nc) = dayl(nc) + grc%dayl(nc) = dayl(nc) + wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) + atm2lnd_inst%forc_wind_grc(nc) = windm(nc) + cnfire_method%forc_hdm(nc) = hdm(nc) + cnfire_method%forc_lnfm(nc) = lnfm(nc) do nz = 1,num_zon ! CN zone loop n = n + 1 + temperature_inst%t_soisno_col(n,-nlevsno+1:nlevmaxurbgrnd) = tp1(nc) ! jkolassa: only one soil and no snow column at this point (may change in future) + temperature_inst%t_grnd_col(n) = temperature_inst%t_soisno_col(n) + temperature_inst%t_soi17cm_col(n) = temperature_inst%t_grnd_col(n) soilstate_inst%soilpsi_col(n,nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point + atm2lnd_inst%forc_t_downscaled_col(n) = tm(nc) + wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) + wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) + waterdiagnosticbulk_inst%wf_col(n) = sfm(nc,nz) + waterdiagnosticbulk_inst%wf2_col(n) = rzm(nc,nz) + cnveg_state_inst%gdp_lf_col(n) = gdp(nc) + cnveg_state_inst%abm_lf_col(n) = abm(nc) + cnveg_state_inst%peatf_lf_col(n) = peatf(nc) + + ! compute column-level saturated area fraction (water table at surface) + if(nz==1) then + saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,car1m(nc)/CN_zone_weight(nz)),1.) + elseif(nz==2) then + saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,(car1m(nc)-CN_zone_weight(1))/CN_zone_weight(nz)),1.) + elseif(nz==3) + saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,(car1m(nc)-CN_zone_weight(1)-CN_zone_weight(2))/CN_zone_weight(nz)),1.) + endif + do np = 0,numpft ! PFT index loop p = p + 1 temperature_inst%t_ref2m_patch(p) = tairm(nc) + cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 + wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) + wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) end do ! np end do ! nz end do ! nc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 4361b2ca4..6c8c9afd7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -1,6 +1,9 @@ module CN_initMod - use clm_varpar , only : VAR_COL, VAR_PFT + use ESMF + + use clm_varcon , only : clm_varcon_init + use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init use clm_varctl , only : use_century_decomp use CNCLM_decompMod use CNCLM_VegNitrogenStateType @@ -40,6 +43,9 @@ module CN_initMod use CNMRespMod , only : readCNMRespParams => readParams use CNSharedParamsMod , only : CNParamsReadShared use spmdMod + use Wateratm2lndBulkType + use CNCLM_WaterDiagnosticBulkType + use Wateratm2lndType use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn @@ -47,7 +53,11 @@ module CN_initMod use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method use SoilBiogeochemDecompMod , only : readSoilBiogeochemDecompParams => readParams use CNPhenologyMod , only : readCNPhenolParams => readParams - + use SoilBiogeochemLittVertTranspMod , only : readSoilBiogeochemLittVertTranspParams => readParams + use CNPhenologyMod , only : CNPhenologyReadNML + use dynSubgridControlMod , only : dynSubgridControl_init + use CNFireFactoryMod , only : CNFireReadNML, create_cnfire_method + use FireMethodType , only : fire_method_type use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -85,6 +95,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(temperature_type) :: temperature_inst type(soilstate_type) :: soilstate_inst type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst + type(wateratm2lnd_type) :: wateratm2lnd_inst type(canopystate_type) :: canopystate_inst type(solarabs_type) :: solarabs_inst type(surfalb_type) :: surfalb_inst @@ -107,26 +119,32 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(ch4_type) :: ch4_inst type(crop_type) :: crop_inst type(dgvs_type) :: dgvs_inst + type(fire_method_type) :: cnfire_method + type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst character(300) :: paramfile type(Netcdf4_fileformatter) :: ncid integer :: rc + + type (ESMF_VM) :: VM !----------------------------------------- ! initialize CN model ! ------------------- - call spmd_init() + call spmd_init(VM) call clm_varpar_init() + call clm_varcon_init() + call init_clm_varctl() call init_bounds (nch, bounds) ! initialize subrgid types - call init_patch_type (bound, nch, ityp, patch) + call init_patch_type (bound, nch, ityp, fveg, patch) call init_column_type (bounds, col) @@ -142,6 +160,12 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_filter_type (bounds, nch, filter) + ! read parameters and configurations from namelist file + + call CNPhenologyReadNML ( NLFilename ) + call dynSubgridControl_init ( NLFilename ) + call CNFireReadNML ( NLFilename ) + ! initialize states and fluxes call init_cnveg_nitrogenstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenstate_inst, cn5_cold_start) @@ -156,6 +180,10 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_waterdiagnosticbulk_type (bounds, waterdiagnosticbulk_inst) + call init_wateratm2lndbulk_type (bounds, wateratm2lndbulk_inst) + + call init_wateratm2lnd_type (bounds, wateratm2lnd_type) + call init_canopystate_type (bounds, nch, ityp, fveg, cncol, cnpft, canopystate_inst, cn5_cold_start) call init_solarabs_type (bounds, solarabs_inst) @@ -202,6 +230,11 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_dgvs_type (bounds, dgvs_inst) + call init_saturated_excess_runoff_type(bounds, saturated_excess_runoff_inst) + + call create_cnfire_method(cnfire_method) + call cnfire_method%FireInit(bounds) + ! calls to original CTSM initialization routines ! initialize rooting profile with default values @@ -234,6 +267,12 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call nutrient_competition_method%readParams(ncid) call readSoilBiogeochemDecompParams(ncid) call readCNPhenolParams(ncid) + call readSoilBiogeochemLittVertTranspParams(ncid) + call photosyns_inst%ReadParams( ncid ) + call cnfire_method%CNFireReadParams( ncid ) + + call ncid%close(rc=status) + if (use_century_decomp) then call init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, & @@ -242,9 +281,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_decompcascade_cn(bounds, soilbiogeochem_state_inst) end if - call photosyns_inst%ReadParams( ncid ) - - end subroutine CN_init end module CN_initMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 new file mode 100755 index 000000000..63c05821b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 @@ -0,0 +1,233 @@ +module FireMethodType + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abstract base class for functions to implement fire model and fire data for + ! both FATES and BGC. + ! + ! Created by Erik Kluzek, following Bill Sack's implementation of polymorphism + ! !USES: + implicit none + private + ! + ! !PUBLIC TYPES: + public :: fire_method_type + + type, abstract :: fire_method_type + contains + + ! Initialize the fire datasets + procedure(FireInit_interface) , public, deferred :: FireInit + + ! Read namelist for the fire datasets + procedure(FireReadNML_interface), public, deferred :: FireReadNML + + ! Read parameters for the fire datasets + procedure(CNFireReadParams_interface), public, deferred :: CNFireReadParams + + ! Interpolate the fire datasets + procedure(FireInterp_interface) , public, deferred :: FireInterp + + ! Figure out the fire area + procedure(CNFireArea_interface) , public, deferred :: CNFireArea + + ! Figure out the fire fluxes + procedure(CNFireFluxes_interface) , public, deferred :: CNFireFluxes + + end type fire_method_type + + abstract interface + + ! Note: The following code is adapted based on what Bill Sacks has done for soil water retention curve + ! polymorphism. Therefore, I also keep some suggestions he gave there. + ! + ! - Make the interfaces contain all possible inputs that are needed by any + ! implementation; each implementation will then ignore the inputs it doesn't need. + ! + ! - For inputs that are needed only by particular implementations - and particularly + ! for inputs that are constant in time + ! pass these into the constructor, and save pointers to these inputs as components + ! of the child type that needs them. Then they aren't needed as inputs to the + ! individual routines, allowing the interfaces for these routines to remain more + ! consistent between different implementations. + ! + !--------------------------------------------------------------------------- + subroutine FireInit_interface(this, bounds, NLFilename ) + ! + ! !DESCRIPTION: + ! Initialize Fire datasets + ! + ! USES + use decompMod , only : bounds_type + import :: fire_method_type + ! !ARGUMENTS: + class(fire_method_type) :: this + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename + !----------------------------------------------------------------------- + + end subroutine FireInit_interface + + subroutine FireReadNML_interface(this, NLFilename ) + ! + ! !DESCRIPTION: + ! Read general fire namelist + ! + ! USES + import :: fire_method_type + ! !ARGUMENTS: + class(fire_method_type) :: this + character(len=*), intent(in) :: NLFilename + !----------------------------------------------------------------------- + + end subroutine FireReadNML_interface + + subroutine FireInterp_interface(this, bounds) + ! + ! !DESCRIPTION: + ! Interpolate Fire datasets + ! + ! USES + use decompMod , only : bounds_type + import :: fire_method_type + ! !ARGUMENTS: + class(fire_method_type) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + + end subroutine FireInterp_interface + + !----------------------------------------------------------------------- + subroutine CNFireReadParams_interface( this, ncid ) + ! + ! Read in the constant parameters from the input NetCDF parameter file + ! !USES: + use ncdio_pio , only: file_desc_t + import :: fire_method_type + ! + ! !ARGUMENTS: + implicit none + class(fire_method_type) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + !-------------------------------------------------------------------- + + end subroutine CNFireReadParams_interface + + !----------------------------------------------------------------------- + subroutine CNFireArea_interface (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, & + waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) + ! + ! !DESCRIPTION: + ! Computes column-level burned area + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterStateBulkType , only : waterstatebulk_type + use SoilStateType , only : soilstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + import :: fire_method_type + ! + ! !ARGUMENTS: + class(fire_method_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + real(r8) , intent(in) :: totlitc_col(bounds%begc:) + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) + real(r8) , intent(in) :: t_soi17cm_col(bounds%begc:) + !----------------------------------------------------------------------- + end subroutine CNFireArea_interface + + !----------------------------------------------------------------------- + subroutine CNFireFluxes_interface (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & + dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, & + leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch, & + totsomc_col, decomp_cpools_vr_col, decomp_npools_vr_col, somc_fire_col) + ! + ! !DESCRIPTION: + ! Fire effects routine for coupled carbon-nitrogen code (CN). + ! Relies primarily on estimate of fractional area burned, from FireArea(). + ! + ! Total fire carbon emissions (g C/m2 land area/yr) + ! =avg(COL_FIRE_CLOSS)*seconds_per_year + avg(SOMC_FIRE)*seconds_per_year + + ! avg(LF_CONV_CFLUX)*seconds_per_year*min(1.0,avg(LFC2)*seconds_per_year)*0.8 + ! where avg means the temporal average in a year + ! seconds_per_year is the number of seconds in a year. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use CNDVType , only : dgvs_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use SoilbiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + import :: fire_method_type + ! + ! !ARGUMENTS: + class(fire_method_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(out) :: num_actfirep ! number of active patches on fire in filter + integer , intent(out) :: filter_actfirep(:) ! filter for soil patches + integer , intent(out) :: num_actfirec ! number of active columns on fire in filter + integer , intent(out) :: filter_actfirec(:) ! filter for soil columns + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: totsomc_col(bounds%begc:) ! (gC/m2) total soil organic matter C + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(in) :: decomp_npools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(out) :: somc_fire_col(bounds%begc:) ! (gC/m2/s) fire C emissions due to peat burning + !----------------------------------------------------------------------- + end subroutine CNFireFluxes_interface + + !----------------------------------------------------------------------- + + end interface + +end module FireMethodType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemLittVertTranspMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemLittVertTranspMod.F90 new file mode 100755 index 000000000..c020d4c2e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemLittVertTranspMod.F90 @@ -0,0 +1,551 @@ +module SoilBiogeochemLittVertTranspMod + + !----------------------------------------------------------------------- + ! calculate vertical mixing of all decomposing C and N pools + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog, use_c13, use_c14, spinup_state, use_vertsoilc, use_fates, use_cn + use clm_varctl , only : use_soil_matrixcn + use clm_varcon , only : secspday + use decompMod , only : bounds_type + use abortutils , only : endrun + use ActiveLayerMod , only : active_layer_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use ColumnType , only : col + use GridcellType , only : grc + use SoilBiogeochemStateType , only : get_spinup_latitude_term + ! + implicit none + private + ! + public :: readParams + public :: SoilBiogeochemLittVertTransp + + type, private :: params_type + real(r8) :: som_diffus ! Soil organic matter diffusion + real(r8) :: cryoturb_diffusion_k ! The cryoturbation diffusive constant cryoturbation to the active layer thickness + real(r8) :: max_altdepth_cryoturbation ! (m) maximum active layer thickness for cryoturbation to occur + end type params_type + + type(params_type), private :: params_inst + ! + real(r8), public :: som_adv_flux = 0._r8 + real(r8), public :: max_depth_cryoturb = 3._r8 ! (m) this is the maximum depth of cryoturbation + real(r8) :: som_diffus ! [m^2/sec] = 1 cm^2 / yr + real(r8) :: cryoturb_diffusion_k ! [m^2/sec] = 5 cm^2 / yr = 1m^2 / 200 yr + real(r8) :: max_altdepth_cryoturbation ! (m) maximum active layer thickness for cryoturbation to occur + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + use ncdio_pio , only : file_desc_t,ncd_io + ! + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + character(len=32) :: subname = 'SoilBiogeochemLittVertTranspType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + ! + ! read in parameters + ! + + tString='som_diffus' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%som_diffus=tempr + + tString='cryoturb_diffusion_k' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%cryoturb_diffusion_k=tempr + + tString='max_altdepth_cryoturbation' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%max_altdepth_cryoturbation=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & + active_layer_inst, soilbiogeochem_state_inst, & + soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & + c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Calculate vertical mixing of soil and litter pools. Also reconcile sources and sinks of these pools + ! calculated in the CStateUpdate1 and NStateUpdate1 subroutines. + ! Advection-diffusion code based on algorithm in Patankar (1980) + ! Initial code by C. Koven and W. Riley + ! + ! !USES: + use clm_time_manager , only : get_step_size_real + use clm_varpar , only : nlevdecomp, ndecomp_pools, nlevdecomp_full + use clm_varcon , only : zsoi, dzsoi_decomp, zisoi + use TridiagonalMod , only : Tridiagonal + use ColumnType , only : col + use clm_varctl , only : use_bedrock + + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(active_layer_type) , intent(in) :: active_layer_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: diffus (bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity (m2/s) (includes spinup correction, if any) + real(r8) :: adv_flux(bounds%begc:bounds%endc,1:nlevdecomp+1) ! advective flux (m/s) (includes spinup correction, if any) + real(r8) :: aaa ! "A" function in Patankar + real(r8) :: pe ! Pe for "A" function in Patankar + real(r8) :: w_m1, w_p1 ! Weights for calculating harmonic mean of diffusivity + real(r8) :: d_m1, d_p1 ! Harmonic mean of diffusivity + real(r8) :: a_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "a" vector for tridiagonal matrix + real(r8) :: b_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "b" vector for tridiagonal matrix + real(r8) :: c_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "c" vector for tridiagonal matrix + real(r8) :: r_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "r" vector for tridiagonal solution + real(r8) :: d_p1_zp1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity/delta_z for next j (set to zero for no diffusion) + real(r8) :: d_m1_zm1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity/delta_z for previous j (set to zero for no diffusion) + real(r8) :: f_p1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! water flux for next j + real(r8) :: f_m1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! water flux for previous j + real(r8) :: pe_p1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! Peclet # for next j + real(r8) :: pe_m1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! Peclet # for previous j + real(r8) :: dz_node(1:nlevdecomp+1) ! difference between nodes + real(r8) :: epsilon_t (bounds%begc:bounds%endc,1:nlevdecomp+1,1:ndecomp_pools) ! + real(r8) :: conc_trcr(bounds%begc:bounds%endc,0:nlevdecomp+1) ! + real(r8) :: a_p_0 + real(r8) :: deficit + integer :: ntype + integer :: i_type,s,fc,c,j,l,i ! indices + integer :: jtop(bounds%begc:bounds%endc) ! top level at each column + real(r8) :: dtime ! land model time step (sec) + integer :: zerolev_diffus + real(r8) :: spinup_term ! spinup accelerated decomposition factor, used to accelerate transport as well + real(r8) :: epsilon ! small number + real(r8), pointer :: conc_ptr(:,:,:) ! pointer, concentration state variable being transported + real(r8), pointer :: source(:,:,:) ! pointer, source term + real(r8), pointer :: trcr_tendency_ptr(:,:,:) ! poiner, store the vertical tendency (gain/loss due to vertical transport) + real(r8), pointer :: matrix_input(:,:) ! poiner, store the vertical tendency (gain/loss due to vertical transport) + !----------------------------------------------------------------------- + + ! Set statement functions + aaa (pe) = max (0._r8, (1._r8 - 0.1_r8 * abs(pe))**5) ! A function from Patankar, Table 5.2, pg 95 + + associate( & + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + spinup_factor => decomp_cascade_con%spinup_factor , & ! Input: [real(r8) (:) ] spinup accelerated decomposition factor, used to accelerate transport as well + + altmax => active_layer_inst%altmax_col , & ! Input: [real(r8) (:) ] maximum annual depth of thaw + altmax_lastyear => active_layer_inst%altmax_lastyear_col , & ! Input: [real(r8) (:) ] prior year maximum annual depth of thaw + + som_adv_coef => soilbiogeochem_state_inst%som_adv_coef_col , & ! Output: [real(r8) (:,:) ] SOM advective flux (m/s) + som_diffus_coef => soilbiogeochem_state_inst%som_diffus_coef_col,& ! Output: [real(r8) (:,:) ] SOM diffusivity due to bio/cryo-turbation (m2/s) + tri_ma_vr => soilbiogeochem_carbonflux_inst%tri_ma_vr & ! Output: [real(r8) (:,:) ] Vertical CN transfer rate in sparse matrix format (gC*m3)/(gC*m3*step)) + ) + + !Set parameters of vertical mixing of SOM + som_diffus = params_inst%som_diffus + cryoturb_diffusion_k = params_inst%cryoturb_diffusion_k + max_altdepth_cryoturbation = params_inst%max_altdepth_cryoturbation + + dtime = get_step_size_real() + + ntype = 2 + if ( use_c13 ) then + ntype = ntype+1 + endif + if ( use_c14 ) then + ntype = ntype+1 + endif + if ( use_fates ) then + ntype = 1 + endif + spinup_term = 1._r8 + epsilon = 1.e-30 + + if (use_vertsoilc) then + !------ first get diffusivity / advection terms -------! + ! use different mixing rates for bioturbation and cryoturbation, with fixed bioturbation and cryoturbation set to a maximum depth + do fc = 1, num_soilc + c = filter_soilc (fc) + if (( max(altmax(c), altmax_lastyear(c)) <= max_altdepth_cryoturbation ) .and. & + ( max(altmax(c), altmax_lastyear(c)) > 0._r8) ) then + ! use mixing profile modified slightly from Koven et al. (2009): constant through active layer, linear decrease from base of active layer to zero at a fixed depth + do j = 1,nlevdecomp+1 + if ( j <= col%nbedrock(c)+1 ) then + if ( zisoi(j) < max(altmax(c), altmax_lastyear(c)) ) then + som_diffus_coef(c,j) = cryoturb_diffusion_k + som_adv_coef(c,j) = 0._r8 + else + som_diffus_coef(c,j) = max(cryoturb_diffusion_k * & + ( 1._r8 - ( zisoi(j) - max(altmax(c), altmax_lastyear(c)) ) / & + ( min(max_depth_cryoturb, zisoi(col%nbedrock(c)+1)) - max(altmax(c), altmax_lastyear(c)) ) ), 0._r8) ! go linearly to zero between ALT and max_depth_cryoturb + som_adv_coef(c,j) = 0._r8 + endif + else + som_adv_coef(c,j) = 0._r8 + som_diffus_coef(c,j) = 0._r8 + endif + end do + elseif ( max(altmax(c), altmax_lastyear(c)) > 0._r8 ) then + ! constant advection, constant diffusion + do j = 1,nlevdecomp+1 + if ( j <= col%nbedrock(c)+1 ) then + som_adv_coef(c,j) = som_adv_flux + som_diffus_coef(c,j) = som_diffus + else + som_adv_coef(c,j) = 0._r8 + som_diffus_coef(c,j) = 0._r8 + endif + end do + else + ! completely frozen soils--no mixing + do j = 1,nlevdecomp+1 + som_adv_coef(c,j) = 0._r8 + som_diffus_coef(c,j) = 0._r8 + end do + endif + end do + + ! Set the distance between the node and the one ABOVE it + dz_node(1) = zsoi(1) + do j = 2,nlevdecomp+1 + dz_node(j)= zsoi(j) - zsoi(j-1) + enddo + + endif + + !------ loop over litter/som types + do i_type = 1, ntype + + select case (i_type) + case (1) ! C + conc_ptr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col + source => soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col + trcr_tendency_ptr => soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col + matrix_input => soilbiogeochem_carbonflux_inst%matrix_Cinput%V + case (2) ! N + if (use_cn ) then + conc_ptr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col + source => soilbiogeochem_nitrogenflux_inst%decomp_npools_sourcesink_col + trcr_tendency_ptr => soilbiogeochem_nitrogenflux_inst%decomp_npools_transport_tendency_col + matrix_input => soilbiogeochem_nitrogenflux_inst%matrix_Ninput%V + endif + case (3) + if ( use_c13 ) then + ! C13 + conc_ptr => c13_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col + source => c13_soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col + trcr_tendency_ptr => c13_soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col + else + ! C14 + conc_ptr => c14_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col + source => c14_soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col + trcr_tendency_ptr => c14_soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col + endif + case (4) + if ( use_c14 .and. use_c13 ) then + ! C14 + conc_ptr => c14_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col + source => c14_soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col + trcr_tendency_ptr => c14_soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col + else + write(iulog,*) 'error. ncase = 4, but c13 and c14 not both enabled.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + end select + if (use_vertsoilc) then + + do s = 1, ndecomp_pools + if ( .not. is_cwd(s) ) then + if(.not. use_soil_matrixcn .or. s .eq. 1)then + do j = 1,nlevdecomp+1 + do fc = 1, num_soilc + c = filter_soilc (fc) + ! + if ( spinup_state >= 1 ) then + ! increase transport (both advection and diffusion) by the same factor as accelerated decomposition for a given pool + spinup_term = spinup_factor(s) + else + spinup_term = 1._r8 + endif + + if (abs(spinup_term - 1._r8) > .000001_r8 ) then + spinup_term = spinup_term * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) + endif + + if ( abs(som_adv_coef(c,j)) * spinup_term < epsilon ) then + adv_flux(c,j) = epsilon + else + adv_flux(c,j) = som_adv_coef(c,j) * spinup_term + endif + ! + if ( abs(som_diffus_coef(c,j)) * spinup_term < epsilon ) then + diffus(c,j) = epsilon + else + diffus(c,j) = som_diffus_coef(c,j) * spinup_term + endif + ! + end do + end do + + ! Set Pe (Peclet #) and D/dz throughout column + + do fc = 1, num_soilc ! dummy terms here + c = filter_soilc (fc) + conc_trcr(c,0) = 0._r8 + conc_trcr(c,col%nbedrock(c)+1:nlevdecomp+1) = 0._r8 + end do + + + do j = 1,nlevdecomp+1 + do fc = 1, num_soilc + c = filter_soilc (fc) + + conc_trcr(c,j) = conc_ptr(c,j,s) + + ! dz_tracer below is the difference between gridcell edges (dzsoi_decomp) + ! dz_node_tracer is difference between cell centers + + ! Calculate the D and F terms in the Patankar algorithm + if (j == 1) then + d_m1_zm1(c,j) = 0._r8 + w_p1 = (zsoi(j+1) - zisoi(j)) / dz_node(j+1) + if ( diffus(c,j+1) > 0._r8 .and. diffus(c,j) > 0._r8) then + d_p1 = 1._r8 / ((1._r8 - w_p1) / diffus(c,j) + w_p1 / diffus(c,j+1)) ! Harmonic mean of diffus + else + d_p1 = 0._r8 + endif + d_p1_zp1(c,j) = d_p1 / dz_node(j+1) + f_m1(c,j) = adv_flux(c,j) ! Include infiltration here + f_p1(c,j) = adv_flux(c,j+1) + pe_m1(c,j) = 0._r8 + pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet # + elseif (j >= col%nbedrock(c)+1) then + ! At the bottom, assume no gradient in d_z (i.e., they're the same) + w_m1 = (zisoi(j-1) - zsoi(j-1)) / dz_node(j) + if ( diffus(c,j) > 0._r8 .and. diffus(c,j-1) > 0._r8) then + d_m1 = 1._r8 / ((1._r8 - w_m1) / diffus(c,j) + w_m1 / diffus(c,j-1)) ! Harmonic mean of diffus + else + d_m1 = 0._r8 + endif + d_m1_zm1(c,j) = d_m1 / dz_node(j) + d_p1_zp1(c,j) = d_m1_zm1(c,j) ! Set to be the same + f_m1(c,j) = adv_flux(c,j) + !f_p1(c,j) = adv_flux(c,j+1) + f_p1(c,j) = 0._r8 + pe_m1(c,j) = f_m1(c,j) / d_m1_zm1(c,j) ! Peclet # + pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet # + else + ! Use distance from j-1 node to interface with j divided by distance between nodes + w_m1 = (zisoi(j-1) - zsoi(j-1)) / dz_node(j) + if ( diffus(c,j-1) > 0._r8 .and. diffus(c,j) > 0._r8) then + d_m1 = 1._r8 / ((1._r8 - w_m1) / diffus(c,j) + w_m1 / diffus(c,j-1)) ! Harmonic mean of diffus + else + d_m1 = 0._r8 + endif + w_p1 = (zsoi(j+1) - zisoi(j)) / dz_node(j+1) + if ( diffus(c,j+1) > 0._r8 .and. diffus(c,j) > 0._r8) then + d_p1 = 1._r8 / ((1._r8 - w_p1) / diffus(c,j) + w_p1 / diffus(c,j+1)) ! Harmonic mean of diffus + else + d_p1 = (1._r8 - w_m1) * diffus(c,j) + w_p1 * diffus(c,j+1) ! Arithmetic mean of diffus + endif + d_m1_zm1(c,j) = d_m1 / dz_node(j) + d_p1_zp1(c,j) = d_p1 / dz_node(j+1) + f_m1(c,j) = adv_flux(c,j) + f_p1(c,j) = adv_flux(c,j+1) + pe_m1(c,j) = f_m1(c,j) / d_m1_zm1(c,j) ! Peclet # + pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet # + end if + enddo ! fc + enddo ! j; nlevdecomp + end if + + + ! Calculate the tridiagonal coefficients + do j = 0,nlevdecomp +1 + do fc = 1, num_soilc + c = filter_soilc (fc) + ! g = cgridcell(c) + + if (j > 0 .and. j < nlevdecomp+1) then + a_p_0 = dzsoi_decomp(j) / dtime + endif + + if (j == 0) then ! top layer (atmosphere) + a_tri(c,j) = 0._r8 + b_tri(c,j) = 1._r8 + c_tri(c,j) = -1._r8 + r_tri(c,j) = 0._r8 + elseif (j == 1) then + a_tri(c,j) = -(d_m1_zm1(c,j) * aaa(pe_m1(c,j)) + max( f_m1(c,j), 0._r8)) ! Eqn 5.47 Patankar + c_tri(c,j) = -(d_p1_zp1(c,j) * aaa(pe_p1(c,j)) + max(-f_p1(c,j), 0._r8)) + b_tri(c,j) = - a_tri(c,j) - c_tri(c,j) + a_p_0 + r_tri(c,j) = source(c,j,s) * dzsoi_decomp(j) /dtime + (a_p_0 - adv_flux(c,j)) * conc_trcr(c,j) + if(s .eq. 1 .and. i_type .eq. 1 .and. use_soil_matrixcn .and. use_vertsoilc)then !vertical matrix are the same for all pools + do i = 1,ndecomp_pools-1 !excluding cwd + tri_ma_vr(c,1+(i-1)*(nlevdecomp*3-2)) = (b_tri(c,j) - a_p_0) / dzsoi_decomp(j) * (-dtime) + tri_ma_vr(c,3+(i-1)*(nlevdecomp*3-2)) = c_tri(c,j) / dzsoi_decomp(j) * (-dtime) + end do + end if + elseif (j < nlevdecomp+1) then + a_tri(c,j) = -(d_m1_zm1(c,j) * aaa(pe_m1(c,j)) + max( f_m1(c,j), 0._r8)) ! Eqn 5.47 Patankar + c_tri(c,j) = -(d_p1_zp1(c,j) * aaa(pe_p1(c,j)) + max(-f_p1(c,j), 0._r8)) + b_tri(c,j) = - a_tri(c,j) - c_tri(c,j) + a_p_0 + r_tri(c,j) = source(c,j,s) * dzsoi_decomp(j) /dtime + a_p_0 * conc_trcr(c,j) + if(s .eq. 1 .and. i_type .eq. 1 .and. use_soil_matrixcn .and. use_vertsoilc)then + if(j .le. col%nbedrock(c))then + do i = 1,ndecomp_pools-1 + tri_ma_vr(c,j*3-4+(i-1)*(nlevdecomp*3-2)) = a_tri(c,j) / dzsoi_decomp(j) * (-dtime) + if(j .ne. nlevdecomp)then + tri_ma_vr(c,j*3 +(i-1)*(nlevdecomp*3-2)) = c_tri(c,j) / dzsoi_decomp(j) * (-dtime) + end if + tri_ma_vr(c,j*3-2+(i-1)*(nlevdecomp*3-2)) = (b_tri(c,j) - a_p_0) / dzsoi_decomp(j) * (-dtime) + end do + else + if(j .eq. col%nbedrock(c) + 1 .and. j .ne. nlevdecomp .and. j .gt. 1)then + do i = 1,ndecomp_pools-1 + tri_ma_vr(c,(j-1)*3-2+(i-1)*(nlevdecomp*3-2)) = tri_ma_vr(c,(j-1)*3-2+(i-1)*(nlevdecomp*3-2)) & + + a_tri(c,j) / dzsoi_decomp(j-1)*(-dtime) + end do + end if + end if + end if + else ! j==nlevdecomp+1; 0 concentration gradient at bottom + a_tri(c,j) = -1._r8 + b_tri(c,j) = 1._r8 + c_tri(c,j) = 0._r8 + r_tri(c,j) = 0._r8 + endif + enddo ! fc; column + enddo ! j; nlevdecomp + + do fc = 1, num_soilc + c = filter_soilc (fc) + jtop(c) = 0 + enddo + + ! subtract initial concentration and source terms for tendency calculation + do fc = 1, num_soilc + c = filter_soilc (fc) + do j = 1, nlevdecomp + if (.not. use_soil_matrixcn) then + trcr_tendency_ptr(c,j,s) = 0.-(conc_trcr(c,j) + source(c,j,s)) + else + trcr_tendency_ptr(c,j,s) = 0.0_r8 + end if !soil_matrix + end do + end do + + if (.not. use_soil_matrixcn) then + ! Solve for the concentration profile for this time step + call Tridiagonal(bounds, 0, nlevdecomp+1, & + jtop(bounds%begc:bounds%endc), & + num_soilc, filter_soilc, & + a_tri(bounds%begc:bounds%endc, :), & + b_tri(bounds%begc:bounds%endc, :), & + c_tri(bounds%begc:bounds%endc, :), & + r_tri(bounds%begc:bounds%endc, :), & + conc_trcr(bounds%begc:bounds%endc,0:nlevdecomp+1)) + ! add post-transport concentration to calculate tendency term + do fc = 1, num_soilc + c = filter_soilc (fc) + do j = 1, nlevdecomp + trcr_tendency_ptr(c,j,s) = trcr_tendency_ptr(c,j,s) + conc_trcr(c,j) + trcr_tendency_ptr(c,j,s) = trcr_tendency_ptr(c,j,s) / dtime + end do + end do + else + do j = 1,nlevdecomp + do fc =1,num_soilc + c = filter_soilc(fc) + matrix_input(c,j+(s-1)*nlevdecomp) = matrix_input(c,j+(s-1)*nlevdecomp) + source(c,j,s) + end do + end do + end if !soil_matrix + else + ! for CWD pools, just add + do j = 1,nlevdecomp + do fc = 1, num_soilc + c = filter_soilc (fc) + if(.not. use_soil_matrixcn)then + conc_trcr(c,j) = conc_ptr(c,j,s) + source(c,j,s) + else + matrix_input(c,j+(s-1)*nlevdecomp) = matrix_input(c,j+(s-1)*nlevdecomp) + source(c,j,s) + end if + if (j > col%nbedrock(c) .and. source(c,j,s) > 0._r8) then + write(iulog,*) 'source >0',c,j,s,source(c,j,s) + end if + if (j > col%nbedrock(c) .and. conc_ptr(c,j,s) > 0._r8) then + write(iulog,*) 'conc_ptr >0',c,j,s,conc_ptr(c,j,s) + end if + end do + end do + end if ! not CWD + + if (.not. use_soil_matrixcn) then + do j = 1,nlevdecomp + do fc = 1, num_soilc + c = filter_soilc (fc) + conc_ptr(c,j,s) = conc_trcr(c,j) + ! Correct for small amounts of carbon that leak into bedrock + if (j > col%nbedrock(c)) then + conc_ptr(c,col%nbedrock(c),s) = conc_ptr(c,col%nbedrock(c),s) + & + conc_trcr(c,j) * (dzsoi_decomp(j) / dzsoi_decomp(col%nbedrock(c))) + conc_ptr(c,j,s) = 0._r8 + end if + end do + end do + end if !not soil_matrix + end do ! s (pool loop) + + else + + !! for single level case, no transport; just update the fluxes calculated in the StateUpdate1 subroutines + do l = 1, ndecomp_pools + do j = 1,nlevdecomp + do fc = 1, num_soilc + c = filter_soilc (fc) + + conc_ptr(c,j,l) = conc_ptr(c,j,l) + source(c,j,l) + + trcr_tendency_ptr(c,j,l) = 0._r8 + + end do + end do + end do + endif + + end do ! i_type + + end associate + + end subroutine SoilBiogeochemLittVertTransp + +end module SoilBiogeochemLittVertTranspMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNStateUpdate1Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNStateUpdate1Mod.F90 new file mode 100755 index 000000000..eab4f40d5 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNStateUpdate1Mod.F90 @@ -0,0 +1,272 @@ +module SoilBiogeochemNStateUpdate1Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable updates, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size_real + use clm_varpar , only : nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, use_nitrif_denitrif, use_crop + use clm_varctl , only : use_soil_matrixcn + use clm_varcon , only : nitrif_n2o_loss_frac, dzsoi_decomp + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenfluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use CNSharedParamsMod , only : use_fun + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: SoilBiogeochemNStateUpdate1 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables (except for gap-phase mortality and fire fluxes) + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + + !----------------------------------------------------------------------- + + associate( & + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + + ndep_prof => soilbiogeochem_state_inst%ndep_prof_col , & ! Input: [real(r8) (:,:) ] profile over which N deposition is distributed through column (1/m) + nfixation_prof => soilbiogeochem_state_inst%nfixation_prof_col , & ! Input: [real(r8) (:,:) ] profile over which N fixation is distributed through column (1/m) + + nf => soilbiogeochem_nitrogenflux_inst , & ! Output: + ns => soilbiogeochem_nitrogenstate_inst & ! Output: + ) + + ! set time steps + dt = get_step_size_real() + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if(use_fun)then !RF in FUN logic, the fixed N goes straight into the plant, and not into the SMINN pool. + ! N deposition and fixation (put all into NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%ffix_to_sminn_col(c)*dt * nfixation_prof(c,j) + else + if (.not. use_nitrif_denitrif) then + + ! N deposition and fixation + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) + + else + + ! N deposition and fixation (put all into NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) + + end if + end if + + end do + + end do + + ! repeating N dep and fixation for crops + if ( use_crop )then + do j = 1, nlevdecomp + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + if (.not. use_nitrif_denitrif) then + + ! N deposition and fixation + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) & + + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) & + + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) + + else + + ! N deposition and fixation (put all into NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) & + + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) & + + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) + + end if + end do + end do + end if + + ! decomposition fluxes + if (.not. use_soil_matrixcn) then + do k = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & + nf%decomp_cascade_ntransfer_vr_col(c,j,k) * dt + end do + end do + end do + + + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & + nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) + & + (nf%decomp_cascade_ntransfer_vr_col(c,j,k) + & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k)) * dt + end do + end do + else ! terminal transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k) * dt + end do + end do + end if + end do + end if ! + + if (.not. use_nitrif_denitrif) then + + !-------------------------------------------------------- + !------------- NITRIF_DENITRIF OFF ------------------- + !-------------------------------------------------------- + + ! immobilization/mineralization in litter-to-SOM and SOM-to-SOM fluxes and denitrification fluxes + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - & + (nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k) + & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k))* dt + end do + end do + else + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - & + nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k)* dt + + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k)* dt + + end do + end do + endif + end do + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ! "bulk denitrification" + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_denit_excess_vr_col(c,j) * dt + + ! total plant uptake from mineral N + if ( .not. use_fun ) then + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_plant_vr_col(c,j)*dt + else + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_plant_fun_vr_col(c,j)*dt + end if + ! flux that prevents N limitation (when Carbon_only is set) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt + end do + end do + + else + + !-------------------------------------------------------- + !------------- NITRIF_DENITRIF ON -------------------- + !-------------------------------------------------------- + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! mineralization fluxes (divert a fraction of this stream to nitrification flux, add the rest to NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%gross_nmin_vr_col(c,j)*dt + + ! immobilization fluxes + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%actual_immob_nh4_vr_col(c,j)*dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%actual_immob_no3_vr_col(c,j)*dt + + ! plant uptake fluxes + if ( .not. use_fun )then + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%smin_nh4_to_plant_vr_col(c,j)*dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%smin_no3_to_plant_vr_col(c,j)*dt + else + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%sminn_to_plant_fun_nh4_vr_col(c,j)*dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%sminn_to_plant_fun_no3_vr_col(c,j)*dt + end if + + + ! Account for nitrification fluxes + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%f_nit_vr_col(c,j) * dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) + nf%f_nit_vr_col(c,j) * dt & + * (1._r8 - nitrif_n2o_loss_frac) + + ! Account for denitrification fluxes + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%f_denit_vr_col(c,j) * dt + + ! flux that prevents N limitation (when Carbon_only is set; put all into NH4) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt + + ! update diagnostic total + ns%sminn_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + ns%smin_no3_vr_col(c,j) + + end do ! end of column loop + end do + + end if + + end associate + + end subroutine SoilBiogeochemNStateUpdate1 + +end module SoilBiogeochemNStateUpdate1Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/TridiagonalMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/TridiagonalMod.F90 new file mode 100755 index 000000000..46532b0d8 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/TridiagonalMod.F90 @@ -0,0 +1,93 @@ +module TridiagonalMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Tridiagonal matrix solution + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: Tridiagonal + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine Tridiagonal (bounds, lbj, ubj, jtop, numf, filter, a, b, c, r, u) + ! + ! !DESCRIPTION: + ! Tridiagonal matrix solution + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + use decompMod , only : bounds_type + use ColumnType , only : col + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: jtop( bounds%begc: ) ! top level for each column [col] + integer , intent(in) :: numf ! filter dimension (should not include hydrologically inactive points) + integer , intent(in) :: filter(:) ! filter (should not include hydrologically inactive points) + real(r8), intent(in) :: a( bounds%begc: , lbj: ) ! "a" left off diagonal of tridiagonal matrix [col, j] + real(r8), intent(in) :: b( bounds%begc: , lbj: ) ! "b" diagonal column for tridiagonal matrix [col, j] + real(r8), intent(in) :: c( bounds%begc: , lbj: ) ! "c" right off diagonal tridiagonal matrix [col, j] + real(r8), intent(in) :: r( bounds%begc: , lbj: ) ! "r" forcing term of tridiagonal matrix [col, j] + real(r8), intent(inout) :: u( bounds%begc: , lbj: ) ! solution [col, j] + ! + integer :: j,ci,fc !indices + real(r8) :: gam(bounds%begc:bounds%endc,lbj:ubj) !temporary + real(r8) :: bet(bounds%begc:bounds%endc) !temporary + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(jtop) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(a) == (/bounds%endc, ubj/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(b) == (/bounds%endc, ubj/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(c) == (/bounds%endc, ubj/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(r) == (/bounds%endc, ubj/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(u) == (/bounds%endc, ubj/)), sourcefile, __LINE__) + + ! Solve the matrix + + do fc = 1,numf + ci = filter(fc) + bet(ci) = b(ci,jtop(ci)) + end do + + do j = lbj, ubj + do fc = 1,numf + ci = filter(fc) + if (j >= jtop(ci)) then + if (j == jtop(ci)) then + u(ci,j) = r(ci,j) / bet(ci) + else + gam(ci,j) = c(ci,j-1) / bet(ci) + bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j) + u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci) + end if + end if + end do + end do + + do j = ubj-1,lbj,-1 + do fc = 1,numf + ci = filter(fc) + if (j >= jtop(ci)) then + u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1) + end if + end do + end do + + end subroutine Tridiagonal + +end module TridiagonalMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index b092e945d..3dd3d8ae7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -12,6 +12,7 @@ module clm_time_manager public ::& get_step_size, &! return step size in seconds + get_step_size_real, &! return step size in seconds, real-valued get_rad_step_size, &! return radiation step size in seconds get_nstep, &! return CN timestep number @@ -52,6 +53,16 @@ end function get_step_size !========================================================================================= +real(r8) function get_step_size_real() + + ! Return the step size in seconds, as a real value + + get_step_size_real = real(get_step_size(), r8) + + end function get_step_size_real + +!========================================================================================= + integer function get_nstep(istep) ! Return the timestep number. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index 931408286..dc43db540 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -60,4 +60,41 @@ module clm_varcon character(len=16), public, parameter :: namep = 'pft' ! name of patches character(len=16), public, parameter :: nameCohort = 'cohort' ! name of cohorts (ED specific) +! !PUBLIC MEMBER FUNCTIONS: + public clm_varcon_init ! Initialze constants that need to be initialized + +! !REVISION HISTORY: +! Created by Mariana Vertenstein + +!EOP +!----------------------------------------------------------------------- +contains +!------------------------------- + subroutine clm_varcon_init() +! +! !DESCRIPTION: +! This subroutine initializes constants in clm_varcon. MUST be called +! after the clm_varpar_init. +! +! !USES: +! +! !ARGUMENTS: + implicit none +! +! +!EOP +!------------------------------------------------------------------------------ + allocate( zsoi(1:nlevgrnd) ) + allocate( dzsoi(1:nlevgrnd) ) + allocate( zisoi(0:nlevgrnd) ) + allocate( dzsoi_decomp(1:nlevdecomp_full) ) + + ! jkolassa Aug 2022: This follows previous implementations of Catchment-CN and works as long as we use a single soil layer (for CN); we will have to update this if we increase the number of soil layers. + zsoi(1) = 0.5 + dzsoi(1) = 1. + zisoi(0) = 0. + zisoi(1) = 1. + dzsoi_decomp(1) = dzsoi(1) + + end subroutine clm_varcon_init end module clm_varcon diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 79c85730b..3d087a816 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -15,6 +15,8 @@ module clm_varctl public init_clm_varctl ! set parameters implicit none + logical, public :: use_nguardrail = .true. ! true => use precision control + logical, public :: use_luna = .false. ! true => use LUNA logical, public :: use_fates = .false. ! true => use fates logical, public :: use_hydrstress = .true. ! true => use plant hydraulic stress calculation @@ -30,6 +32,9 @@ module clm_varctl logical, public :: use_cn = .true. logical, public :: use_cndv = .false. logical, public :: use_grainproduct = .false. + logical, public :: use_dynroot = .false. + logical, public :: use_bedrock = .false. ! true => use spatially variable soil depth + logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model @@ -53,6 +58,11 @@ module clm_varctl logical, public :: use_flexibleCN = .false. logical, public :: CNratio_floating = .false. integer, public :: CN_evergreen_phenology_opt = 0 + + ! State of the model for the accelerated decomposition (AD) spinup. + ! 0 (default) = normal model; 1 = AD SPINUP + integer, public :: spinup_state = 0 + contains !--------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index d34726cae..c8e8fad30 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -19,7 +19,7 @@ module clm_varpar integer, parameter :: nlevsoi = 1 ! number of hydrologically active soil layers integer, parameter :: nlevgrnd = 1 ! number of ground layers (includes lower layers that are hydrologically inactive) integer, parameter :: nlevsno = 0 ! maximum number of snow layers - integer, public :: nlevurb = 5 ! number of urban layers; jk Oct 2021: using CTSM5.1 value for now + integer, public :: nlevurb = 0 ! number of urban layers; jk Oct 2021: using CTSM5.1 value of 5 for now; jkolassa Aug 2022: changed because having more urban than ground layers caused and issue with the initialization of the soil layers in column type integer, public :: nlevmaxurbgrnd ! maximum of the number of ground and urban layers integer, public, parameter :: nlayer = 3 ! number of VIC soil layer --Added by AWang diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/dynSubgridControlMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/dynSubgridControlMod.F90 new file mode 100755 index 000000000..b4da85be7 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/dynSubgridControlMod.F90 @@ -0,0 +1,417 @@ +module dynSubgridControlMod + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Defines a class for storing and querying control flags related to dynamic subgrid + ! operation. + ! + ! Note that this is implemented (essentially) as a singleton, so the only instance of + ! this class is stored in this module. This is done for convenience, to avoid having to + ! pass around the single instance just to query these control flags. + ! + ! !USES: +#include "shr_assert.h" + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_varctl , only : fname_len + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: dynSubgridControl_init + public :: get_flanduse_timeseries ! return the value of the flanduse_timeseries file name + public :: get_do_transient_pfts ! return the value of the do_transient_pfts control flag + public :: get_do_transient_crops ! return the value of the do_transient_crops control flag + public :: get_do_transient_lakes ! return the value of the do_transient_lakes control flag + public :: run_has_transient_landcover ! returns true if any aspects of prescribed transient landcover are enabled + public :: get_do_harvest ! return the value of the do_harvest control flag + public :: get_reset_dynbal_baselines ! return the value of the reset_dynbal_baselines control flag + public :: get_for_testing_allow_non_annual_changes ! return true if user has requested to allow area changes at times other than the year boundary, for testing purposes + public :: get_for_testing_zero_dynbal_fluxes ! return true if user has requested to set the dynbal water and energy fluxes to zero, for testing purposes + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: read_namelist ! read namelist variables + private :: check_namelist_consistency ! check consistency of namelist settings + ! + ! !PRIVATE TYPES: + type dyn_subgrid_control_type + private + character(len=fname_len) :: flanduse_timeseries = ' ' ! transient landuse dataset + logical :: do_transient_pfts = .false. ! whether to apply transient natural PFTs from dataset + logical :: do_transient_crops = .false. ! whether to apply transient crops from dataset + logical :: do_transient_lakes = .false. ! whether to apply transient lakes from dataset + logical :: do_harvest = .false. ! whether to apply harvest from dataset + + logical :: reset_dynbal_baselines = .false. ! whether to reset baseline values of total column water and energy in the first step of the run + + ! The following is only meant for testing: Whether area changes are allowed at times + ! other than the year boundary. This should only arise in some test configurations + ! where we artificially create changes more frequently so that we can run short + ! tests. This flag is only used for error-checking, not controlling any model + ! behavior. + logical :: for_testing_allow_non_annual_changes = .false. + + ! The following is only meant for testing: If .true., set the dynbal water and + ! energy fluxes to zero. This is needed in some tests where we have daily rather + ! than annual glacier dynamics: if we allow the true dynbal adjustment fluxes in + ! those tests, we end up with sensible heat fluxes of thousands of W m-2 or more, + ! which causes CAM to blow up. However, note that setting it to true will break + ! water and energy conservation! + logical :: for_testing_zero_dynbal_fluxes = .false. + + logical :: initialized = .false. ! whether this object has been initialized + end type dyn_subgrid_control_type + + type(dyn_subgrid_control_type) :: dyn_subgrid_control_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine dynSubgridControl_init( NLFilename ) + ! + ! !DESCRIPTION: + ! Initialize the dyn_subgrid_control settings. + ! + ! !USES: + use spmdMod , only : masterproc + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'dynSubgridControl_init' + !----------------------------------------------------------------------- + + call read_namelist( NLFilename ) + if (masterproc) then + call check_namelist_consistency + end if + + dyn_subgrid_control_inst%initialized = .true. + + end subroutine dynSubgridControl_init + + !----------------------------------------------------------------------- + subroutine read_namelist( NLFilename ) + ! + ! !DESCRIPTION: + ! Read dyn_subgrid_control namelist variables + ! + ! !USES: + use fileutils , only : getavu, relavu + use clm_nlUtilsMod , only : find_nlgroup_name + use clm_varctl , only : iulog + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + ! temporary variables corresponding to the components of dyn_subgrid_control_type: + character(len=fname_len) :: flanduse_timeseries + logical :: do_transient_pfts + logical :: do_transient_crops + logical :: do_transient_lakes + logical :: do_harvest + logical :: reset_dynbal_baselines + logical :: for_testing_allow_non_annual_changes + logical :: for_testing_zero_dynbal_fluxes + ! other local variables: + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + + character(len=*), parameter :: subname = 'read_namelist' + !----------------------------------------------------------------------- + + namelist /dynamic_subgrid/ & + flanduse_timeseries, & + do_transient_pfts, & + do_transient_crops, & + do_transient_lakes, & + do_harvest, & + reset_dynbal_baselines, & + for_testing_allow_non_annual_changes, & + for_testing_zero_dynbal_fluxes + + ! Initialize options to default values, in case they are not specified in the namelist + flanduse_timeseries = ' ' + do_transient_pfts = .false. + do_transient_crops = .false. + do_transient_lakes = .false. + do_harvest = .false. + reset_dynbal_baselines = .false. + for_testing_allow_non_annual_changes = .false. + for_testing_zero_dynbal_fluxes = .false. + + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'dynamic_subgrid', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=dynamic_subgrid, iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading dynamic_subgrid namelist'//errMsg(sourcefile, __LINE__)) + end if + else + call endrun(msg='ERROR finding dynamic_subgrid namelist'//errMsg(sourcefile, __LINE__)) + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast (flanduse_timeseries, mpicom) + call shr_mpi_bcast (do_transient_pfts, mpicom) + call shr_mpi_bcast (do_transient_crops, mpicom) + call shr_mpi_bcast (do_transient_lakes, mpicom) + call shr_mpi_bcast (do_harvest, mpicom) + call shr_mpi_bcast (reset_dynbal_baselines, mpicom) + call shr_mpi_bcast (for_testing_allow_non_annual_changes, mpicom) + call shr_mpi_bcast (for_testing_zero_dynbal_fluxes, mpicom) + + dyn_subgrid_control_inst = dyn_subgrid_control_type( & + flanduse_timeseries = flanduse_timeseries, & + do_transient_pfts = do_transient_pfts, & + do_transient_crops = do_transient_crops, & + do_transient_lakes = do_transient_lakes, & + do_harvest = do_harvest, & + reset_dynbal_baselines = reset_dynbal_baselines, & + for_testing_allow_non_annual_changes = for_testing_allow_non_annual_changes, & + for_testing_zero_dynbal_fluxes = for_testing_zero_dynbal_fluxes) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'dynamic_subgrid settings:' + write(iulog,nml=dynamic_subgrid) + write(iulog,*) ' ' + end if + + end subroutine read_namelist + + !----------------------------------------------------------------------- + subroutine check_namelist_consistency + ! + ! !DESCRIPTION: + ! Check consistency of namelist settings + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varctl, only : iulog, use_cndv, use_fates, use_cn, use_crop, & + n_dom_pfts, n_dom_landunits, collapse_urban, & + toosmall_soil, toosmall_crop, toosmall_glacier, & + toosmall_lake, toosmall_wetland, toosmall_urban + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'check_namelist_consistency' + !----------------------------------------------------------------------- + + if (dyn_subgrid_control_inst%flanduse_timeseries == ' ') then + if (dyn_subgrid_control_inst%do_transient_pfts) then + write(iulog,*) 'ERROR: do_transient_pfts can only be true if you are running with' + write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (dyn_subgrid_control_inst%do_transient_crops) then + write(iulog,*) 'ERROR: do_transient_crops can only be true if you are running with' + write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (dyn_subgrid_control_inst%do_transient_lakes) then + write(iulog,*) 'ERROR: do_transient_lakes can only be true if you are running with' + write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (dyn_subgrid_control_inst%do_harvest) then + write(iulog,*) 'ERROR: do_harvest can only be true if you are running with' + write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + if (dyn_subgrid_control_inst%do_transient_pfts) then + if (use_cndv) then + write(iulog,*) 'ERROR: do_transient_pfts is incompatible with use_cndv' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (use_fates) then + write(iulog,*) 'ERROR: do_transient_pfts is incompatible with use_fates' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + ! NOTE(wjs, 2020-08-23) In the following error checks, I'm treating do_transient_lakes + ! similar to do_transient_pfts and do_transient_crops. I'm not sure if all of these + ! checks are truly important for transient lakes (in particular, my guess is that + ! collapse_urban could probably be done with transient lakes - as well as transient + ! pfts and transient crops for that matter), but some of the checks probably are + ! needed, and it seems best to keep transient lakes consistent with other transient + ! areas in this respect. + if (dyn_subgrid_control_inst%do_transient_pfts .or. & + dyn_subgrid_control_inst%do_transient_crops .or. & + dyn_subgrid_control_inst%do_transient_lakes) then + if (collapse_urban) then + write(iulog,*) 'ERROR: do_transient_pfts, do_transient_crops and do_transient_lakes are & + incompatible with collapse_urban = .true.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (n_dom_pfts > 0 .or. n_dom_landunits > 0 & + .or. toosmall_soil > 0._r8 .or. toosmall_crop > 0._r8 & + .or. toosmall_glacier > 0._r8 .or. toosmall_lake > 0._r8 & + .or. toosmall_wetland > 0._r8 .or. toosmall_urban > 0._r8) then + write(iulog,*) 'ERROR: do_transient_pfts, do_transient_crops and do_transient_lakes are & + incompatible with any of the following set to > 0: & + n_dom_pfts > 0, n_dom_landunits > 0, & + toosmall_soil > 0._r8, toosmall_crop > 0._r8, & + toosmall_glacier > 0._r8, toosmall_lake > 0._r8, & + toosmall_wetland > 0._r8, toosmall_urban > 0._r8.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + if (dyn_subgrid_control_inst%do_transient_crops) then + if (use_fates) then + ! NOTE(wjs, 2017-01-13) ED / FATES does not currently have a mechanism for + ! changing its column areas, with the consequent changes in aboveground biomass + ! per unit area. See https://github.com/NGEET/ed-clm/issues/173 + write(iulog,*) 'ERROR: do_transient_crops does not currently work with use_fates' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + if (dyn_subgrid_control_inst%do_harvest) then + if (.not. (use_cn .or. use_fates)) then + write(iulog,*) 'ERROR: do_harvest can only be true if either use_cn or use_fates are true' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + end subroutine check_namelist_consistency + + !----------------------------------------------------------------------- + character(len=fname_len) function get_flanduse_timeseries() + ! !DESCRIPTION: + ! Return the value of the flanduse_timeseries file name + + character(len=*), parameter :: subname = 'get_flanduse_timeseries' + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_flanduse_timeseries = dyn_subgrid_control_inst%flanduse_timeseries + + end function get_flanduse_timeseries + + !----------------------------------------------------------------------- + logical function get_do_transient_pfts() + ! !DESCRIPTION: + ! Return the value of the do_transient_pfts control flag + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_do_transient_pfts = dyn_subgrid_control_inst%do_transient_pfts + + end function get_do_transient_pfts + + !----------------------------------------------------------------------- + logical function get_do_transient_crops() + ! !DESCRIPTION: + ! Return the value of the do_transient_crops control flag + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_do_transient_crops = dyn_subgrid_control_inst%do_transient_crops + + end function get_do_transient_crops + + !----------------------------------------------------------------------- + logical function get_do_transient_lakes() + ! !DESCRIPTION: + ! Return the value of the do_transient_lakes control flag + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_do_transient_lakes = dyn_subgrid_control_inst%do_transient_lakes + + end function get_do_transient_lakes + + !----------------------------------------------------------------------- + logical function run_has_transient_landcover() + ! !DESCRIPTION: + ! Returns true if any aspects of prescribed transient landcover are enabled + !----------------------------------------------------------------------- + + run_has_transient_landcover = & + (get_do_transient_pfts() .or. & + get_do_transient_crops()) + end function run_has_transient_landcover + + !----------------------------------------------------------------------- + logical function get_do_harvest() + ! !DESCRIPTION: + ! Return the value of the do_harvest control flag + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_do_harvest = dyn_subgrid_control_inst%do_harvest + + end function get_do_harvest + + !----------------------------------------------------------------------- + logical function get_reset_dynbal_baselines() + ! !DESCRIPTION: + ! Return the value of the reset_dynbal_baselines control flag + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_reset_dynbal_baselines = dyn_subgrid_control_inst%reset_dynbal_baselines + + end function get_reset_dynbal_baselines + + !----------------------------------------------------------------------- + logical function get_for_testing_allow_non_annual_changes() + ! + ! !DESCRIPTION: + ! Return true if the user has requested to allow area changes at times other than the + ! year boundary. (This should typically only be true for testing.) (This only + ! controls error-checking, not any operation of the code.) + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_for_testing_allow_non_annual_changes = dyn_subgrid_control_inst%for_testing_allow_non_annual_changes + + end function get_for_testing_allow_non_annual_changes + + !----------------------------------------------------------------------- + logical function get_for_testing_zero_dynbal_fluxes() + ! + ! !DESCRIPTION: + ! Return true if the user has requested to set the dynbal water and energy fluxes to + ! zero. This should typically only be true for testing: This is needed in some tests + ! where we have daily rather than annual glacier dynamics: if we allow the true dynbal + ! adjustment fluxes in those tests, we end up with sensible heat fluxes of thousands + ! of W m-2 or more, which causes CAM to blow up. However, note that setting it to + ! true will break water and energy conservation! + ! ----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_for_testing_zero_dynbal_fluxes = dyn_subgrid_control_inst%for_testing_zero_dynbal_fluxes + + end function get_for_testing_zero_dynbal_fluxes + +end module dynSubgridControlMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 new file mode 100755 index 000000000..ab872a270 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 @@ -0,0 +1,2217 @@ +Module shr_mpi_mod + + !------------------------------------------------------------------------------- + ! PURPOSE: general layer on MPI functions + !------------------------------------------------------------------------------- + + use shr_kind_mod + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + private + + ! PUBLIC: Public interfaces + + public :: shr_mpi_chkerr + public :: shr_mpi_send + public :: shr_mpi_recv + public :: shr_mpi_bcast + public :: shr_mpi_gathScatVInit + public :: shr_mpi_gatherV + public :: shr_mpi_scatterV + public :: shr_mpi_sum + public :: shr_mpi_min + public :: shr_mpi_max + public :: shr_mpi_commsize + public :: shr_mpi_commrank + public :: shr_mpi_initialized + public :: shr_mpi_abort + public :: shr_mpi_barrier + public :: shr_mpi_init + public :: shr_mpi_finalize + + interface shr_mpi_send ; module procedure & + shr_mpi_sendi0, & + shr_mpi_sendi1, & + shr_mpi_sendr0, & + shr_mpi_sendr1, & + shr_mpi_sendr3 + end interface shr_mpi_send + interface shr_mpi_recv ; module procedure & + shr_mpi_recvi0, & + shr_mpi_recvi1, & + shr_mpi_recvr0, & + shr_mpi_recvr1, & + shr_mpi_recvr3 + end interface shr_mpi_recv + interface shr_mpi_bcast ; module procedure & + shr_mpi_bcastc0, & + shr_mpi_bcastc1, & + shr_mpi_bcastl0, & + shr_mpi_bcastl1, & + shr_mpi_bcasti0, & + shr_mpi_bcasti1, & + shr_mpi_bcasti80, & + shr_mpi_bcasti81, & + shr_mpi_bcasti2, & + shr_mpi_bcastr0, & + shr_mpi_bcastr1, & + shr_mpi_bcastr2, & + shr_mpi_bcastr3 + end interface shr_mpi_bcast + interface shr_mpi_gathScatVInit ; module procedure & + shr_mpi_gathScatVInitr1 + end interface shr_mpi_gathScatVInit + interface shr_mpi_gatherv ; module procedure & + shr_mpi_gatherVr1 + end interface shr_mpi_gatherv + interface shr_mpi_scatterv ; module procedure & + shr_mpi_scatterVr1 + end interface shr_mpi_scatterv + interface shr_mpi_sum ; module procedure & + shr_mpi_sumi0, & + shr_mpi_sumi1, & + shr_mpi_sumb0, & + shr_mpi_sumb1, & + shr_mpi_sumr0, & + shr_mpi_sumr1, & + shr_mpi_sumr2, & + shr_mpi_sumr3 + end interface shr_mpi_sum + interface shr_mpi_min ; module procedure & + shr_mpi_mini0, & + shr_mpi_mini1, & + shr_mpi_minr0, & + shr_mpi_minr1 + end interface shr_mpi_min + interface shr_mpi_max ; module procedure & + shr_mpi_maxi0, & + shr_mpi_maxi1, & + shr_mpi_maxr0, & + shr_mpi_maxr1 + end interface shr_mpi_max + +#include ! mpi library include file + + !=============================================================================== +CONTAINS + !=============================================================================== + + SUBROUTINE shr_mpi_chkerr(rcode,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: rcode ! input MPI error code + character(*), intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_chkerr) ' + character(MPI_MAX_ERROR_STRING) :: lstring + integer(SHR_KIND_IN) :: len + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: layer on MPI error checking + !------------------------------------------------------------------------------- + + if (rcode /= MPI_SUCCESS) then + call MPI_ERROR_STRING(rcode,lstring,len,ierr) + write(s_logunit,*) trim(subName),":",lstring(1:len) + call shr_mpi_abort(string,rcode) + endif + + END SUBROUTINE shr_mpi_chkerr + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sendi0(lvec,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec ! send value + integer(SHR_KIND_IN), intent(in) :: pid ! pid to send to + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sendi0) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Send a single integer + !------------------------------------------------------------------------------- + + lsize = 1 + + call MPI_SEND(lvec,lsize,MPI_INTEGER,pid,tag,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_sendi0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sendi1(lvec,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec(:) ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to send to + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sendi1) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Send a vector of integers + !------------------------------------------------------------------------------- + + lsize = size(lvec) + + call MPI_SEND(lvec,lsize,MPI_INTEGER,pid,tag,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_sendi1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sendr0(lvec,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to send to + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sendr0) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Send a real scalar + !------------------------------------------------------------------------------- + + lsize = 1 + + call MPI_SEND(lvec,lsize,MPI_REAL8,pid,tag,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_sendr0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sendr1(lvec,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec(:) ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to send to + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sendr1) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Send a vector of reals + !------------------------------------------------------------------------------- + + lsize = size(lvec) + + call MPI_SEND(lvec,lsize,MPI_REAL8,pid,tag,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_sendr1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sendr3(array,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + real (SHR_KIND_R8), intent(in) :: array(:,:,:) ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to send to + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sendr3) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Send a vector of reals + !------------------------------------------------------------------------------- + + lsize = size(array) + + call MPI_SEND(array,lsize,MPI_REAL8,pid,tag,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_sendr3 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_recvi0(lvec,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(out):: lvec ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to recv from + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_recvi0) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: status(MPI_STATUS_SIZE) ! mpi status info + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Recv a vector of reals + !------------------------------------------------------------------------------- + + lsize = 1 + + call MPI_RECV(lvec,lsize,MPI_INTEGER,pid,tag,comm,status,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_recvi0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_recvi1(lvec,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(out):: lvec(:) ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to recv from + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_recvi1) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: status(MPI_STATUS_SIZE) ! mpi status info + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Recv a vector of reals + !------------------------------------------------------------------------------- + + lsize = size(lvec) + + call MPI_RECV(lvec,lsize,MPI_INTEGER,pid,tag,comm,status,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_recvi1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_recvr0(lvec,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(out):: lvec ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to recv from + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_recvr0) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: status(MPI_STATUS_SIZE) ! mpi status info + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Recv a vector of reals + !------------------------------------------------------------------------------- + + lsize = 1 + + call MPI_RECV(lvec,lsize,MPI_REAL8,pid,tag,comm,status,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_recvr0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_recvr1(lvec,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(out):: lvec(:) ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to recv from + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_recvr1) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: status(MPI_STATUS_SIZE) ! mpi status info + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Recv a vector of reals + !------------------------------------------------------------------------------- + + lsize = size(lvec) + + call MPI_RECV(lvec,lsize,MPI_REAL8,pid,tag,comm,status,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_recvr1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_recvr3(array,pid,tag,comm,string) + + IMPLICIT none + + !----- arguments --- + real (SHR_KIND_R8), intent(out):: array(:,:,:) ! in/out local values + integer(SHR_KIND_IN), intent(in) :: pid ! pid to recv from + integer(SHR_KIND_IN), intent(in) :: tag ! tag + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_recvr3) ' + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: status(MPI_STATUS_SIZE) ! mpi status info + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Recv a vector of reals + !------------------------------------------------------------------------------- + + lsize = size(array) + + call MPI_RECV(array,lsize,MPI_REAL8,pid,tag,comm,status,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_recvr3 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcasti0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti0) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast an integer + !------------------------------------------------------------------------------- + + lsize = 1 + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_INTEGER,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcasti0 + + SUBROUTINE shr_mpi_bcasti80(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_I8), intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti0) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast an integer + !------------------------------------------------------------------------------- + + lsize = 1 + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_INTEGER8,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcasti80 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcastl0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + logical, intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastl0) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a logical + !------------------------------------------------------------------------------- + + lsize = 1 + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_LOGICAL,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcastl0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcastc0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + character(len=*), intent(inout) :: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastc0) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a character string + !------------------------------------------------------------------------------- + + lsize = len(vec) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_CHARACTER,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcastc0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcastc1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + character(len=*), intent(inout) :: vec(:) ! 1D vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastc1) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a character string + !------------------------------------------------------------------------------- + + lsize = size(vec)*len(vec) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_CHARACTER,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcastc1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcastr0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastr0) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a real + !------------------------------------------------------------------------------- + + lsize = 1 + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_REAL8,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcastr0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcasti1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(inout):: vec(:) ! vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti1) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a vector of integers + !------------------------------------------------------------------------------- + + lsize = size(vec) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_INTEGER,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcasti1 + + SUBROUTINE shr_mpi_bcasti81(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_I8), intent(inout):: vec(:) ! vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti1) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a vector of integers + !------------------------------------------------------------------------------- + + lsize = size(vec) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_INTEGER8,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcasti81 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcastl1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + logical, intent(inout):: vec(:) ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastl1) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a logical + !------------------------------------------------------------------------------- + + lsize = size(vec) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_LOGICAL,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcastl1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcastr1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(inout):: vec(:) ! vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastr1) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a vector of reals + !------------------------------------------------------------------------------- + + lsize = size(vec) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(vec,lsize,MPI_REAL8,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcastr1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcastr2(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + real(SHR_KIND_R8), intent(inout):: arr(:,:) ! array, 2d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !----- formats ----- + character(*),parameter :: subName = '(shr_mpi_bcastr2) ' + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a 2d array of reals + !------------------------------------------------------------------------------- + + lsize = size(arr) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(arr,lsize,MPI_REAL8,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcastr2 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcasti2(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + integer, intent(inout):: arr(:,:) ! array, 2d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !----- formats ----- + character(*),parameter :: subName = '(shr_mpi_bcasti2) ' + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a 2d array of integers + !------------------------------------------------------------------------------- + + lsize = size(arr) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(arr,lsize,MPI_INTEGER,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcasti2 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_bcastr3(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + real(SHR_KIND_R8), intent(inout):: arr(:,:,:) ! array, 3d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: lpebcast + + !----- formats ----- + character(*),parameter :: subName = '(shr_mpi_bcastr3) ' + + !------------------------------------------------------------------------------- + ! PURPOSE: Broadcast a 3d array of reals + !------------------------------------------------------------------------------- + + lsize = size(arr) + lpebcast = 0 + if (present(pebcast)) lpebcast = pebcast + + call MPI_BCAST(arr,lsize,MPI_REAL8,lpebcast,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_bcastr3 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_gathScatvInitr1(comm, rootid, locArr, glob1DArr, globSize, & + displs, string ) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + integer(SHR_KIND_IN), intent(in) :: rootid ! MPI task to gather/scatter on + real(SHR_KIND_R8), intent(in) :: locArr(:) ! Local array of distributed data + real(SHR_KIND_R8), pointer :: glob1DArr(:) ! Global 1D array of gathered data + integer(SHR_KIND_IN), pointer :: globSize(:) ! Size of each distributed piece + integer(SHR_KIND_IN), pointer :: displs(:) ! Displacements for receive + character(*),optional,intent(in) :: string ! message + + !----- local ----- + integer(SHR_KIND_IN) :: npes ! Number of MPI tasks + integer(SHR_KIND_IN) :: locSize ! Size of local distributed data + integer(SHR_KIND_IN), pointer :: sendSize(:) ! Size to send for initial gather + integer(SHR_KIND_IN) :: i ! Index + integer(SHR_KIND_IN) :: rank ! Rank of this MPI task + integer(SHR_KIND_IN) :: nSize ! Maximum size to send + integer(SHR_KIND_IN) :: ierr ! Error code + integer(SHR_KIND_IN) :: nSiz1D ! Size of 1D global array + integer(SHR_KIND_IN) :: maxSize ! Maximum size + + !----- formats ----- + character(*),parameter :: subName = '(shr_mpi_gathScatvInitr1) ' + + !------------------------------------------------------------------------------- + ! PURPOSE: Setup arrays for a gatherv/scatterv operation + !------------------------------------------------------------------------------- + + locSize = size(locarr) + call shr_mpi_commsize( comm, npes ) + call shr_mpi_commrank( comm, rank ) + allocate( globSize(npes) ) + ! + ! --- Gather the send global sizes from each MPI task ----------------------- + ! + allocate( sendSize(npes) ) + sendSize(:) = 1 + globSize(:) = 1 + call MPI_GATHER( locSize, 1, MPI_INTEGER, globSize, sendSize, & + MPI_INTEGER, rootid, comm, ierr ) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + deallocate( sendSize ) + ! + ! --- Prepare the displacement and allocate arrays ------------------------- + ! + allocate( displs(npes) ) + displs(1) = 0 + if ( rootid /= rank )then + maxSize = 1 + globSize = 1 + else + maxSize = maxval(globSize) + end if + nsiz1D = min(maxSize,globSize(1)) + do i = 2, npes + nSize = min(maxSize,globSize(i-1)) + displs(i) = displs(i-1) + nSize + nsiz1D = nsiz1D + min(maxSize,globSize(i)) + end do + allocate( glob1DArr(nsiz1D) ) + !----- Do some error checking for the root task arrays computed ---- + if ( rootid == rank )then + if ( nsiz1D /= sum(globSize) ) & + call shr_mpi_abort( subName//" : Error, size of global array not right" ) + if ( any(displs < 0) .or. any(displs >= nsiz1D) ) & + call shr_mpi_abort( subName//" : Error, displacement array not right" ) + if ( (displs(npes)+globSize(npes)) /= nsiz1D ) & + call shr_mpi_abort( subName//" : Error, displacement array values too big" ) + end if + + END SUBROUTINE shr_mpi_gathScatvInitr1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_gathervr1(locarr, locSize, glob1DArr, globSize, displs, rootid, & + comm, string ) + + IMPLICIT none + + !----- arguments ----- + real(SHR_KIND_R8), intent(in) :: locArr(:) ! Local array + real(SHR_KIND_R8), intent(inout):: glob1DArr(:) ! Global 1D array to receive in on + integer(SHR_KIND_IN), intent(in) :: locSize ! Number to send this PE + integer(SHR_KIND_IN), intent(in) :: globSize(:) ! Number to receive each PE + integer(SHR_KIND_IN), intent(in) :: displs(:) ! Displacements for receive + integer(SHR_KIND_IN), intent(in) :: rootid ! MPI task to gather on + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local ----- + integer(SHR_KIND_IN) :: ierr ! Error code + + !----- formats ----- + character(*),parameter :: subName = '(shr_mpi_gathervr1) ' + + !------------------------------------------------------------------------------- + ! PURPOSE: Gather a 1D array of reals + !------------------------------------------------------------------------------- + + call MPI_GATHERV( locarr, locSize, MPI_REAL8, glob1Darr, globSize, displs, & + MPI_REAL8, rootid, comm, ierr ) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_gathervr1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_scattervr1(locarr, locSize, glob1Darr, globSize, displs, rootid, & + comm, string ) + + IMPLICIT none + + !----- arguments ----- + real(SHR_KIND_R8), intent(out) :: locarr(:) ! Local array + real(SHR_KIND_R8), intent(in) :: glob1Darr(:) ! Global 1D array to send from + integer(SHR_KIND_IN), intent(in) :: locSize ! Number to receive this PE + integer(SHR_KIND_IN), intent(in) :: globSize(:) ! Number to send to each PE + integer(SHR_KIND_IN), intent(in) :: displs(:) ! Displacements for send + integer(SHR_KIND_IN), intent(in) :: rootid ! MPI task to scatter on + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local ----- + integer(SHR_KIND_IN) :: ierr ! Error code + + !----- formats ----- + character(*),parameter :: subName = '(shr_mpi_scattervr1) ' + + !------------------------------------------------------------------------------- + ! PURPOSE: Scatter a 1D array of reals + !------------------------------------------------------------------------------- + + + call MPI_SCATTERV( glob1Darr, globSize, displs, MPI_REAL8, locarr, locSize, & + MPI_REAL8, rootid, comm, ierr ) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_scattervr1 + + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sumi0(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec ! in/out local values + integer(SHR_KIND_IN), intent(out):: gvec ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sumi0) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds sum of a distributed vector of values, assume local sum + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_SUM + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = 1 + gsize = 1 + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_sumi0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sumi1(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec(:) ! in/out local values + integer(SHR_KIND_IN), intent(out):: gvec(:) ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sumi1) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds sum of a distributed vector of values, assume local sum + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_SUM + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_sumi1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sumb0(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_I8), intent(in) :: lvec ! in/out local values + integer(SHR_KIND_I8), intent(out):: gvec ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sumb0) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds sum of a distributed vector of values, assume local sum + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_SUM + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = 1 + gsize = 1 + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_sumb0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sumb1(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_I8), intent(in) :: lvec(:) ! in/out local values + integer(SHR_KIND_I8), intent(out):: gvec(:) ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sumb1) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds sum of a distributed vector of values, assume local sum + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_SUM + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_sumb1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sumr0(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec ! in/out local values + real(SHR_KIND_R8), intent(out):: gvec ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sumr0) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds sum of a distributed vector of values, assume local sum + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_SUM + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = 1 + gsize = 1 + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_sumr0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sumr1(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec(:) ! in/out local values + real(SHR_KIND_R8), intent(out):: gvec(:) ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sumr1) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds sum of a distributed vector of values, assume local sum + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_SUM + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_sumr1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sumr2(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec(:,:)! in/out local values + real(SHR_KIND_R8), intent(out):: gvec(:,:)! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sumr2) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds sum of a distributed vector of values, assume local sum + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_SUM + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_sumr2 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_sumr3(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec(:,:,:) ! in/out local values + real(SHR_KIND_R8), intent(out):: gvec(:,:,:) ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_sumr3) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds sum of a distributed vector of values, assume local sum + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_SUM + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_sumr3 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_mini0(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec ! in/out local values + integer(SHR_KIND_IN), intent(out):: gvec ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_mini0) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds min of a distributed vector of values, assume local min + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_MIN + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = 1 + gsize = 1 + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_mini0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_mini1(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec(:) ! in/out local values + integer(SHR_KIND_IN), intent(out):: gvec(:) ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_mini1) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds min of a distributed vector of values, assume local min + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_MIN + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_mini1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_minr0(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec ! in/out local values + real(SHR_KIND_R8), intent(out):: gvec ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_minr0) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds min of a distributed vector of values, assume local min + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_MIN + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = 1 + gsize = 1 + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_minr0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_minr1(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec(:) ! in/out local values + real(SHR_KIND_R8), intent(out):: gvec(:) ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_minr1) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds min of a distributed vector of values, assume local min + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_MIN + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_minr1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_maxi0(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec ! in/out local values + integer(SHR_KIND_IN), intent(out):: gvec ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_maxi0) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds max of a distributed vector of values, assume local max + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_MAX + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = 1 + gsize = 1 + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_maxi0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_maxi1(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec(:) ! in/out local values + integer(SHR_KIND_IN), intent(out):: gvec(:) ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_maxi1) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds max of a distributed vector of values, assume local max + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_MAX + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_maxi1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_maxr0(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec ! in/out local values + real(SHR_KIND_R8), intent(out):: gvec ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_maxr0) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds max of a distributed vector of values, assume local max + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_MAX + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = 1 + gsize = 1 + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_maxr0 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_maxr1(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(in) :: lvec(:) ! in/out local values + real(SHR_KIND_R8), intent(out):: gvec(:) ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_maxr1) ' + logical :: lall + character(SHR_KIND_CL) :: lstring + integer(SHR_KIND_IN) :: reduce_type ! mpi reduction type + integer(SHR_KIND_IN) :: lsize + integer(SHR_KIND_IN) :: gsize + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: Finds max of a distributed vector of values, assume local max + ! already computed + !------------------------------------------------------------------------------- + + reduce_type = MPI_MAX + if (present(all)) then + lall = all + else + lall = .false. + endif + if (present(string)) then + lstring = trim(subName)//":"//trim(string) + else + lstring = trim(subName) + endif + + lsize = size(lvec) + gsize = size(gvec) + + if (lsize /= gsize) then + call shr_mpi_abort(subName//" lsize,gsize incompatable "//trim(string)) + endif + + if (lall) then + call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE") + else + call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr) + call shr_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE") + endif + + END SUBROUTINE shr_mpi_maxr1 + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_commsize(comm,size,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + integer,intent(out) :: size + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_commsize) ' + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: MPI commsize + !------------------------------------------------------------------------------- + + call MPI_COMM_SIZE(comm,size,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_commsize + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_commrank(comm,rank,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + integer,intent(out) :: rank + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_commrank) ' + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: MPI commrank + !------------------------------------------------------------------------------- + + call MPI_COMM_RANK(comm,rank,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_commrank + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_initialized(flag,string) + + IMPLICIT none + + !----- arguments --- + logical,intent(out) :: flag + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_initialized) ' + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: MPI initialized + !------------------------------------------------------------------------------- + + call MPI_INITIALIZED(flag,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_initialized + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_abort(string,rcode) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + integer,optional,intent(in) :: rcode ! optional code + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_abort) ' + integer(SHR_KIND_IN) :: ierr + integer :: rc ! return code + + !------------------------------------------------------------------------------- + ! PURPOSE: MPI abort + !------------------------------------------------------------------------------- + + if ( present(string) .and. present(rcode) ) then + write(s_logunit,*) trim(subName),":",trim(string),rcode + endif + if ( present(rcode) )then + rc = rcode + else + rc = 1001 + end if + call MPI_ABORT(MPI_COMM_WORLD,rc,ierr) + + END SUBROUTINE shr_mpi_abort + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_barrier(comm,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_barrier) ' + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: MPI barrier + !------------------------------------------------------------------------------- + + call MPI_BARRIER(comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_barrier + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_init(string) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_init) ' + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: MPI init + !------------------------------------------------------------------------------- + + call MPI_INIT(ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_init + + !=============================================================================== + !=============================================================================== + + SUBROUTINE shr_mpi_finalize(string) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_finalize) ' + integer(SHR_KIND_IN) :: ierr + + !------------------------------------------------------------------------------- + ! PURPOSE: MPI finalize + !------------------------------------------------------------------------------- + + call MPI_BARRIER(MPI_COMM_WORLD,ierr) + call MPI_FINALIZE(ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + + END SUBROUTINE shr_mpi_finalize + + !=============================================================================== + !=============================================================================== + +END MODULE shr_mpi_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 new file mode 100755 index 000000000..14d91e22d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 @@ -0,0 +1,134 @@ +module shr_nl_mod + +! Utilities for namelist reading +! Adapted Fall 2012 from CAM's namelist_utils. + +implicit none +private + +save + +public :: & + shr_nl_find_group_name ! seek through a file to find a specified namelist +public :: shr_string_toLower ! Convert string to lower-case + +contains + +! This routine probably discards more error code information than it needs to. + +subroutine shr_nl_find_group_name(unit, group, status) + + +!--------------------------------------------------------------------------------------- +! Purpose: +! Search a file that contains namelist input for the specified namelist group name. +! Leave the file positioned so that the current record is the first record of the +! input for the specified group. +! +! Method: +! Read the file line by line. Each line is searched for an '&' which may only +! be preceded by blanks, immediately followed by the group name which is case +! insensitive. If found then backspace the file so the current record is the +! one containing the group name and return success. Otherwise return -1. +! +! Author: B. Eaton, August 2007 +!--------------------------------------------------------------------------------------- + + integer, intent(in) :: unit ! fortran unit attached to file + character(len=*), intent(in) :: group ! namelist group name + integer, intent(out) :: status ! 0 for success, -1 if group name not found + + ! Local variables + + integer :: len_grp + integer :: ios ! io status + character(len=80) :: inrec ! first 80 characters of input record + character(len=80) :: inrec2 ! left adjusted input record + character(len=len(group)) :: lc_group + + !--------------------------------------------------------------------------- + + len_grp = len_trim(group) + lc_group = shr_string_toLower(group) + + ios = 0 + do while (ios <= 0) + + read(unit, '(a)', iostat=ios, end=100) inrec + + if (ios <= 0) then ! ios < 0 indicates an end of record condition + + ! look for group name in this record + + ! remove leading blanks + inrec2 = adjustl(inrec) + + ! check for leading '&' + if (inrec2(1:1) == '&') then + + ! check for case insensitive group name + if (trim(lc_group) == shr_string_toLower(inrec2(2:len_grp+1))) then + + ! found group name. backspace to leave file position at this record + backspace(unit) + status = 0 + return + + end if + end if + end if + + end do + + 100 continue ! end of file processing + status = -1 + +end subroutine shr_nl_find_group_name + + !=============================================================================== + !BOP =========================================================================== + ! !IROUTINE: shr_string_toLower -- Convert string to lower case + ! + ! !DESCRIPTION: + ! Convert the input string to lower-case. + ! Use achar and iachar intrinsics to ensure use of ascii collating sequence. + ! + ! !REVISION HISTORY: + ! 2006-Apr-20 - Creation + ! + ! !INTERFACE: ------------------------------------------------------------------ + function shr_string_toLower(str) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to lower case + character(len=len(str)) :: shr_string_toLower + + !----- local ----- + integer(SHR_KIND_IN) :: i ! Index + integer(SHR_KIND_IN) :: aseq ! ascii collating sequence + integer(SHR_KIND_IN) :: UpperToLower ! integer to convert case + character(len=1) :: ctmp ! Character temporary + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_toLower) " + character(*),parameter :: F00 = "('(shr_string_toLower) ',4a)" + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + UpperToLower = iachar("a") - iachar("A") + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) & + ctmp = achar(aseq + UpperToLower) + shr_string_toLower(i:i) = ctmp + end do + + end function shr_string_toLower + +end module shr_nl_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 index 78109631e..4f6d2dec1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 @@ -15,6 +15,8 @@ module spmdMod !EOP !----------------------------------------------------------------------- + use ESMF + use MAPL use shr_kind_mod, only: r8 => shr_kind_r8 use clm_varctl , only: iulog implicit none @@ -62,7 +64,7 @@ module spmdMod ! !IROUTINE: spmd_init( clm_mpicom ) ! ! !INTERFACE: - subroutine spmd_init() + subroutine spmd_init(vm) ! ! !DESCRIPTION: ! MPI initialization (number of cpus, processes, tids, etc) @@ -71,6 +73,7 @@ subroutine spmd_init() ! ! !ARGUMENTS: implicit none + type(ESMF_VM), intent(in) :: vm ! integer, intent(in) :: clm_mpicom ! integer, intent(in) :: LNDID ! @@ -80,62 +83,40 @@ subroutine spmd_init() ! ! !LOCAL VARIABLES: !EOP -! integer :: i,j ! indices -! integer :: ier ! return error status -! integer :: mylength ! my processor length -! logical :: mpi_running ! temporary -! integer, allocatable :: length(:) -! integer, allocatable :: displ(:) -! character*(MPI_MAX_PROCESSOR_NAME), allocatable :: procname(:) -! character*(MPI_MAX_PROCESSOR_NAME) :: myprocname + integer :: i,j ! indices + integer :: npes + type (MaplGrid ),pointer :: MYGRID !----------------------------------------------------------------------- - ! Initialize mpi communicator group + ! Get MPI communicator - ! mpicom = clm_mpicom + call ESMF_VmGet(VM, mpicommunicator=mpicom, __RC__) - ! comp_id = LNDID + ! Get my processor id and number of processors - ! Get my processor id + call ESMF_VmGet(VM, localPet=MYGRID%MYID, petCount=npes, __RC__) - ! call mpi_comm_rank(mpicom, iam, ier) - if (MAPL_Am_I_Root()) then + ! determine master process + if (MAPL_Am_I_Root(vm)) then masterproc = .true. else masterproc = .false. end if - ! Get number of processors + if (masterproc) then + write(iulog,100)npes + write(iulog,200) + write(iulog,220) + do i=0,npes-1 + write(iulog,250)i,MYGRID%MYID + end do + endif -! call mpi_comm_size(mpicom, npes, ier) -! -! ! Get my processor names -! -! allocate (length(0:npes-1), displ(0:npes-1), procname(0:npes-1)) -! -! call mpi_get_processor_name (myprocname, mylength, ier) -! call mpi_allgather(mylength,1,MPI_INTEGER,length,1,MPI_INTEGER,mpicom,ier) -! -! do i = 0,npes-1 -! displ(i)=i*MPI_MAX_PROCESSOR_NAME -! end do -! call mpi_gatherv (myprocname,mylength,MPI_CHARACTER, & -! procname,length,displ,MPI_CHARACTER,0,mpicom,ier) -! if (masterproc) then -! write(iulog,100)npes -! write(iulog,200) -! write(iulog,220) -! do i=0,npes-1 -! write(iulog,250)i,(procname((i))(j:j),j=1,length(i)) -! end do -! endif -! -! deallocate (length, displ, procname) -! -!100 format(//,i3," pes participating in computation for CLM") -!200 format(/,35('-')) -!220 format(/,"NODE#",2x,"NAME") -!250 format("(",i5,")",2x,100a1,//) + +100 format(//,i3," pes participating in computation for CLM") +200 format(/,35('-')) +220 format(/,"NODE#",2x,"NAME") +250 format("(",i5,")",2x,100a1,//) end subroutine spmd_init From 1ec1b64c5b8e43c5f9898781f283b134cc70eca6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Sep 2022 09:07:40 -0400 Subject: [PATCH 004/589] intermediate development update --- .../CLM51/CNCLM_CNFireBaseMod.F90 | 131 +- .../CLM51/CNCLM_ColumnType.F90 | 18 +- .../CLM51/CNCLM_EnergyFluxType.F90 | 232 +++ .../CLM51/CNCLM_WaterStateBulkType.F90 | 63 + .../CLM51/CNCLM_WaterStateType.F90 | 91 ++ .../CLM51/CNCLM_dynSubgridControlMod.F90 | 119 ++ .../CLM51/CNCStateUpdate3Mod.F90 | 211 +++ .../CLM51/CNFireBaseMod.F90 | 1302 ----------------- .../CLM51/CNFireEmissionsMod.F90 | 288 ++++ .../CLM51/CNFireLi2014Mod.F90 | 6 +- .../CLM51/CNFireLi2016Mod.F90 | 6 +- .../CLM51/CNFireLi2021Mod.F90 | 6 +- .../CLM51/CN_DriverMod.F90 | 8 +- .../CLM51/CN_init_mod.F90 | 16 +- .../CLM51/SoilWaterRetentionCurveMod.F90 | 111 ++ .../CLM51/dynSubgridControlMod.F90 | 417 ------ 16 files changed, 1222 insertions(+), 1803 deletions(-) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate3Mod.F90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireBaseMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilWaterRetentionCurveMod.F90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/dynSubgridControlMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 index d18153367..57da84d30 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -124,22 +124,21 @@ end function need_lightning_and_popdens_interface contains !----------------------------------------------------------------------- - subroutine CNFireInit( this, bounds, NLFilename ) + subroutine CNFireInit( this, bounds ) ! ! !DESCRIPTION: ! Initialize CN Fire module ! !ARGUMENTS: class(cnfire_base_type) :: this type(bounds_type), intent(in) :: bounds - character(len=*), intent(in) :: NLFilename !----------------------------------------------------------------------- ! Call the base-class Initialization method - call this%BaseFireInit( bounds, NLFilename ) + call this%BaseFireInit( bounds ) ! Allocate memory call this%InitAllocate( bounds ) ! History file - call this%InitHistory( bounds ) + ! call this%InitHistory( bounds ) end subroutine CNFireInit !---------------------------------------------------------------------- @@ -160,26 +159,6 @@ subroutine InitAllocate( this, bounds ) end subroutine InitAllocate - !----------------------------------------------------------------------- - subroutine InitHistory( this, bounds ) - ! - ! Initailizae history variables - use clm_varcon , only : spval - use histFileMod , only : hist_addfld1d - ! - ! !ARGUMENTS: - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - !----------------------------------------------------------------------- - integer :: begp, endp - !------------------------------------------------------------------------ - begp = bounds%begp; endp= bounds%endp - this%btran2_patch(begp:endp) = spval - call hist_addfld1d(fname='BTRAN2', units='unitless', & - avgflag='A', long_name='root zone soil wetness factor', & - ptr_patch=this%btran2_patch, l2g_scale_type='veg') - end subroutine InitHistory - !---------------------------------------------------------------------- subroutine CNFire_calc_fire_root_wetness_Li2014( this, bounds, & num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & @@ -316,21 +295,18 @@ end subroutine CNFire_calc_fire_root_wetness_Li2021 !---------------------------------------------------------------------- !---------------------------------------------------------------------- - subroutine FireReadNML( this, NLFilename ) + subroutine FireReadNML( this, fire_method ) ! ! !DESCRIPTION: ! Read the namelist for CNFire ! ! !USES: - use fileutils , only : getavu, relavu, opnfil use shr_nl_mod , only : shr_nl_find_group_name - use spmdMod , only : masterproc, mpicom - use shr_mpi_mod , only : shr_mpi_bcast use clm_varctl , only : iulog ! ! !ARGUMENTS: class(cnfire_base_type) :: this - character(len=*), intent(in) :: NLFilename ! Namelist filename + character(len=*), intent(in) :: fire_method ! Namelist filename ! ! !LOCAL VARIABLES: integer :: ierr ! error code @@ -344,10 +320,6 @@ subroutine FireReadNML( this, NLFilename ) real(r8) :: rh_low, rh_hgh, bt_min, bt_max, occur_hi_gdp_tree real(r8) :: lfuel, ufuel, cmb_cmplt_fact_litter, cmb_cmplt_fact_cwd - namelist /lifire_inparm/ cli_scale, boreal_peatfire_c, pot_hmn_ign_counts_alpha, & - non_boreal_peatfire_c, cropfire_a1, & - rh_low, rh_hgh, bt_min, bt_max, occur_hi_gdp_tree, & - lfuel, ufuel, cmb_cmplt_fact_litter, cmb_cmplt_fact_cwd if ( this%need_lightning_and_popdens() ) then cli_scale = cnfire_const%cli_scale @@ -367,36 +339,61 @@ subroutine FireReadNML( this, NLFilename ) ! Initialize options to default values, in case they are not specified in ! the namelist - if (masterproc) then - unitn = getavu() - write(iulog,*) 'Read in '//nmlname//' namelist' - call opnfil (NLFilename, unitn, 'F') - call shr_nl_find_group_name(unitn, nmlname, status=ierr) - if (ierr == 0) then - read(unitn, nml=lifire_inparm, iostat=ierr) - if (ierr /= 0) then - call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) - end if - else - call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) - end if - call relavu( unitn ) - end if - - call shr_mpi_bcast (cli_scale , mpicom) - call shr_mpi_bcast (boreal_peatfire_c , mpicom) - call shr_mpi_bcast (pot_hmn_ign_counts_alpha, mpicom) - call shr_mpi_bcast (non_boreal_peatfire_c , mpicom) - call shr_mpi_bcast (cropfire_a1 , mpicom) - call shr_mpi_bcast (rh_low , mpicom) - call shr_mpi_bcast (rh_hgh , mpicom) - call shr_mpi_bcast (lfuel , mpicom) - call shr_mpi_bcast (ufuel , mpicom) - call shr_mpi_bcast (bt_min , mpicom) - call shr_mpi_bcast (bt_max , mpicom) - call shr_mpi_bcast (occur_hi_gdp_tree , mpicom) - call shr_mpi_bcast (cmb_cmplt_fact_litter , mpicom) - call shr_mpi_bcast (cmb_cmplt_fact_cwd , mpicom) + select case (trim(fire_method)) + + case ("nofire") + + case ("li2014qianfrc") + lfuel = 75._r8 + ufuel = 1050._r8 + rh_low = 30.0_r8 + rh_hgh = 80.0_r8 + bt_min = 0.3_r8 + bt_max = 0.7_r8 + cli_scale = 0.035_r8 + boreal_peatfire_c = 4.2e-5_r8 + pot_hmn_ign_counts_alpha = 0.0035_r8 + non_boreal_peatfire_c = 0.001_r8 + cropfire_a1 = 0.3_r8 + occur_hi_gdp_tree = 0.39_r8 + cmb_cmplt_fact_litter = 0.5_r8 + cmb_cmplt_fact_cwd = 0.25_r8 + case ("li2016crufrc") + lfuel = 105._r8 + ufuel = 1050._r8 + rh_low = 30.0_r8 + rh_hgh = 80.0_r8 + bt_min = 0.85_r8 + bt_max = 0.98_r8 + cli_scale = 0.033_r8 + boreal_peatfire_c = 0.09e-4_r8 + pot_hmn_ign_counts_alpha = 0.01_r8 + non_boreal_peatfire_c = 0.17e-3_r8 + cropfire_a1 = 1.6e-4_r8 + occur_hi_gdp_tree = 0.33_r8 + cmb_cmplt_fact_litter = 0.5_r8 + cmb_cmplt_fact_cwd = 0.28_r8 + case ("li2021gswpfrc") + lfuel = 75._r8 + ufuel = 1050._r8 + rh_low = 30.0_r8 + rh_hgh = 80.0_r8 + bt_min = 0.85_r8 + bt_max = 0.98_r8 + cli_scale = 0.025_r8 + boreal_peatfire_c = 0.09e-4_r8 + pot_hmn_ign_counts_alpha = 0.01_r8 + non_boreal_peatfire_c = 0.17e-3_r8 + cropfire_a1 = 1.6e-4_r8 + occur_hi_gdp_tree = 0.33_r8 + cmb_cmplt_fact_litter = 0.5_r8 + cmb_cmplt_fact_cwd = 0.28_r8 + + case default + write(iulog,*) subname//' ERROR: unknown method: ', fire_method + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select cnfire_const%cli_scale = cli_scale cnfire_const%boreal_peatfire_c = boreal_peatfire_c @@ -413,12 +410,6 @@ subroutine FireReadNML( this, NLFilename ) cnfire_const%cmb_cmplt_fact_litter = cmb_cmplt_fact_litter cnfire_const%cmb_cmplt_fact_cwd = cmb_cmplt_fact_cwd - if (masterproc) then - write(iulog,*) ' ' - write(iulog,*) nmlname//' settings:' - write(iulog,nml=lifire_inparm) - write(iulog,*) ' ' - end if end if end subroutine FireReadNML @@ -454,7 +445,7 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte ideadstem,ideadstem_st,ideadstem_xf,& ilivecroot,ilivecroot_st,ilivecroot_xf,& ideadcroot,ideadcroot_st,ideadcroot_xf,iretransn,ioutc,ioutn - use CNVegMatrixMod , only: matrix_update_fic, matrix_update_fin + ! use CNVegMatrixMod , only: matrix_update_fic, matrix_update_fin ! ! !ARGUMENTS: class(cnfire_base_type) :: this diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index 171579027..7d6e0e1c1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -24,7 +24,8 @@ module CNCLM_ColumnType use CNCLM_decompMod , only : bounds_type use clm_varcon , only : zsoi, dzsoi, zisoi, dzsoi_decomp, spval, ispval use clm_varctl , only : use_fates - use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevmaxurbgrnd,nlevurb + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevmaxurbgrnd,nlevurb, & + CN_zone_weight, numpft ! !PUBLIC TYPES: @@ -100,7 +101,7 @@ subroutine init_column_type(bounds, this) ! LOCAL: integer :: begc, endc - + integer :: nc, nz, n !---------------------------- begc = bounds%begc ; endc = bounds%endc @@ -151,5 +152,18 @@ subroutine init_column_type(bounds, this) end if end do + + + n = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + n = n + 1 + this%gridcell(n) = nc + this%wtgcell(n) = CN_zone_weight(nz) + this%patchi(n) = (numpft+1)*(n-1) + 1 + this%patchf(n) = (numpft+1)*n + end do ! nz + end do ! nc + end subroutine init_column_type end module CNCLM_ColumnType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 new file mode 100644 index 000000000..251ff43cc --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 @@ -0,0 +1,232 @@ +module EnergyFluxType + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! Energy flux data structure + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : spval + use clm_varctl , only : use_biomass_heat_storage + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + + ! + implicit none + save + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_energyflux_type + + ! + type, public :: energyflux_type + + ! Fluxes + real(r8), pointer :: eflx_sh_stem_patch (:) ! patch sensible heat flux from stem (W/m**2) [+ to atm] + real(r8), pointer :: eflx_h2osfc_to_snow_col (:) ! col snow melt to h2osfc heat flux (W/m**2) + real(r8), pointer :: eflx_sh_grnd_patch (:) ! patch sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_veg_patch (:) ! patch sensible heat flux from leaves (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_snow_patch (:) ! patch sensible heat flux from snow (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_soil_patch (:) ! patch sensible heat flux from soil (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_h2osfc_patch (:) ! patch sensible heat flux from surface water (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_patch (:) ! patch total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_u_patch (:) ! patch urban total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_r_patch (:) ! patch rural total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_precip_conversion_col(:) ! col sensible heat flux from precipitation conversion (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_patch (:) ! patch total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_u_patch (:) ! patch urban total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_r_patch (:) ! patch rural total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_vegt_patch (:) ! patch transpiration heat flux from veg (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_vege_patch (:) ! patch evaporation heat flux from veg (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_grnd_patch (:) ! patch evaporation heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: eflx_soil_grnd_patch (:) ! patch soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_soil_grnd_u_patch (:) ! patch urban soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_soil_grnd_r_patch (:) ! patch rural soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_lwrad_net_patch (:) ! patch net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_r_patch (:) ! patch rural net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_u_patch (:) ! patch urban net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_out_patch (:) ! patch emitted infrared (longwave) radiation (W/m**2) + real(r8), pointer :: eflx_lwrad_out_r_patch (:) ! patch rural emitted infrared (longwave) rad (W/m**2) + real(r8), pointer :: eflx_lwrad_out_u_patch (:) ! patch urban emitted infrared (longwave) rad (W/m**2) + real(r8), pointer :: eflx_snomelt_col (:) ! col snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_r_col (:) ! col rural snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_u_col (:) ! col urban snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_gnet_patch (:) ! patch net heat flux into ground (W/m**2) + real(r8), pointer :: eflx_grnd_lake_patch (:) ! patch net heat flux into lake / snow surface, excluding light transmission (W/m**2) + real(r8), pointer :: eflx_dynbal_grc (:) ! grc dynamic land cover change conversion energy flux (W/m**2) + real(r8), pointer :: eflx_bot_col (:) ! col heat flux from beneath the soil or ice column (W/m**2) + real(r8), pointer :: eflx_fgr12_col (:) ! col ground heat flux between soil layers 1 and 2 (W/m**2) + real(r8), pointer :: eflx_fgr_col (:,:) ! col (rural) soil downward heat flux (W/m2) (1:nlevgrnd) (pos upward; usually eflx_bot >= 0) + real(r8), pointer :: eflx_building_heat_errsoi_col(:) ! col heat flux to interior surface of walls and roof for errsoi check (W m-2) + real(r8), pointer :: eflx_urban_ac_col (:) ! col urban air conditioning flux (W/m**2) + real(r8), pointer :: eflx_urban_heat_col (:) ! col urban heating flux (W/m**2) + real(r8), pointer :: eflx_anthro_patch (:) ! patch total anthropogenic heat flux (W/m**2) + real(r8), pointer :: eflx_traffic_patch (:) ! patch traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat_patch (:) ! patch sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac_patch (:) ! patch sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: eflx_traffic_lun (:) ! lun traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat_lun (:) ! lun sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac_lun (:) ! lun sensible heat flux to be put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: eflx_building_lun (:) ! lun building heat flux from change in interior building air temperature (W/m**2) + real(r8), pointer :: eflx_urban_ac_lun (:) ! lun urban air conditioning flux (W/m**2) + real(r8), pointer :: eflx_urban_heat_lun (:) ! lun urban heating flux (W/m**2) + + ! Derivatives of energy fluxes + real(r8), pointer :: dgnetdT_patch (:) ! patch derivative of net ground heat flux wrt soil temp (W/m**2 K) + real(r8), pointer :: netrad_patch (:) ! col net radiation (W/m**2) [+ = to sfc] + real(r8), pointer :: cgrnd_patch (:) ! col deriv. of soil energy flux wrt to soil temp [W/m2/k] + real(r8), pointer :: cgrndl_patch (:) ! col deriv. of soil latent heat flux wrt soil temp [W/m**2/k] + real(r8), pointer :: cgrnds_patch (:) ! col deriv. of soil sensible heat flux wrt soil temp [W/m2/k] + + ! Canopy radiation + real(r8), pointer :: dlrad_patch (:) ! col downward longwave radiation below the canopy [W/m2] + real(r8), pointer :: ulrad_patch (:) ! col upward longwave radiation above the canopy [W/m2] + + ! Wind Stress + real(r8), pointer :: taux_patch (:) ! patch wind (shear) stress: e-w (kg/m/s**2) + real(r8), pointer :: tauy_patch (:) ! patch wind (shear) stress: n-s (kg/m/s**2) + + ! Conductance + real(r8), pointer :: canopy_cond_patch (:) ! patch tracer conductance for canopy [m/s] + + ! Transpiration + real(r8), pointer :: btran_patch (:) ! patch transpiration wetness factor (0 to 1) + real(r8), pointer :: btran_min_patch (:) ! patch daily minimum transpiration wetness factor (0 to 1) + real(r8), pointer :: btran_min_inst_patch (:) ! patch instantaneous daily minimum transpiration wetness factor (0 to 1) + real(r8), pointer :: bsun_patch (:) ! patch sunlit canopy transpiration wetness factor (0 to 1) + real(r8), pointer :: bsha_patch (:) ! patch shaded canopy transpiration wetness factor (0 to 1) + + ! Roots + real(r8), pointer :: rresis_patch (:,:) ! patch root resistance by layer (0-1) (nlevgrnd) + + ! Latent heat + real(r8), pointer :: htvp_col (:) ! latent heat of vapor of water (or sublimation) [j/kg] + + ! Canopy heat + real(r8), pointer :: dhsdt_canopy_patch (:) ! patch change in heat content of canopy (leaf+stem) (W/m**2) [+ to atm] + + ! Balance Checks + real(r8), pointer :: errsoi_patch (:) ! soil/lake energy conservation error (W/m**2) + real(r8), pointer :: errsoi_col (:) ! soil/lake energy conservation error (W/m**2) + real(r8), pointer :: errseb_patch (:) ! surface energy conservation error (W/m**2) + real(r8), pointer :: errseb_col (:) ! surface energy conservation error (W/m**2) + real(r8), pointer :: errsol_patch (:) ! solar radiation conservation error (W/m**2) + real(r8), pointer :: errsol_col (:) ! solar radiation conservation error (W/m**2) + real(r8), pointer :: errlon_patch (:) ! longwave radiation conservation error (W/m**2) + real(r8), pointer :: errlon_col (:) ! longwave radiation conservation error (W/m**2) + end type energyflux_type + type(energyflux_type), public, target, save :: energyflux_inst + +contains + +!--------------------------------------------- + subroutine init_energyflux_type(bounds, this) + + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(energyflux_type), intent(inout):: this + + !LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + !-------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + begl = bounds%begl ; endl= bounds%endl + begg = bounds%begg ; endg = bounds%endg + + allocate( this%eflx_h2osfc_to_snow_col (begc:endc)) ; this%eflx_h2osfc_to_snow_col (:) = nan + allocate( this%eflx_sh_snow_patch (begp:endp)) ; this%eflx_sh_snow_patch (:) = nan + allocate( this%eflx_sh_soil_patch (begp:endp)) ; this%eflx_sh_soil_patch (:) = nan + allocate( this%eflx_sh_h2osfc_patch (begp:endp)) ; this%eflx_sh_h2osfc_patch (:) = nan + allocate( this%eflx_sh_tot_patch (begp:endp)) ; this%eflx_sh_tot_patch (:) = nan + allocate( this%eflx_sh_tot_u_patch (begp:endp)) ; this%eflx_sh_tot_u_patch (:) = nan + allocate( this%eflx_sh_tot_r_patch (begp:endp)) ; this%eflx_sh_tot_r_patch (:) = nan + allocate( this%eflx_sh_grnd_patch (begp:endp)) ; this%eflx_sh_grnd_patch (:) = nan + allocate( this%eflx_sh_stem_patch (begp:endp)) ; this%eflx_sh_stem_patch (:) = nan + allocate( this%eflx_sh_veg_patch (begp:endp)) ; this%eflx_sh_veg_patch (:) = nan + allocate( this%eflx_sh_precip_conversion_col(begc:endc)) ; this%eflx_sh_precip_conversion_col(:) = nan + allocate( this%eflx_lh_tot_u_patch (begp:endp)) ; this%eflx_lh_tot_u_patch (:) = nan + allocate( this%eflx_lh_tot_patch (begp:endp)) ; this%eflx_lh_tot_patch (:) = nan + allocate( this%eflx_lh_tot_r_patch (begp:endp)) ; this%eflx_lh_tot_r_patch (:) = nan + allocate( this%eflx_lh_grnd_patch (begp:endp)) ; this%eflx_lh_grnd_patch (:) = nan + allocate( this%eflx_lh_vege_patch (begp:endp)) ; this%eflx_lh_vege_patch (:) = nan + allocate( this%eflx_lh_vegt_patch (begp:endp)) ; this%eflx_lh_vegt_patch (:) = nan + allocate( this%eflx_soil_grnd_patch (begp:endp)) ; this%eflx_soil_grnd_patch (:) = nan + allocate( this%eflx_soil_grnd_u_patch (begp:endp)) ; this%eflx_soil_grnd_u_patch (:) = nan + allocate( this%eflx_soil_grnd_r_patch (begp:endp)) ; this%eflx_soil_grnd_r_patch (:) = nan + allocate( this%eflx_lwrad_net_patch (begp:endp)) ; this%eflx_lwrad_net_patch (:) = nan + allocate( this%eflx_lwrad_net_u_patch (begp:endp)) ; this%eflx_lwrad_net_u_patch (:) = nan + allocate( this%eflx_lwrad_net_r_patch (begp:endp)) ; this%eflx_lwrad_net_r_patch (:) = nan + allocate( this%eflx_lwrad_out_patch (begp:endp)) ; this%eflx_lwrad_out_patch (:) = nan + allocate( this%eflx_lwrad_out_u_patch (begp:endp)) ; this%eflx_lwrad_out_u_patch (:) = nan + allocate( this%eflx_lwrad_out_r_patch (begp:endp)) ; this%eflx_lwrad_out_r_patch (:) = nan + allocate( this%eflx_gnet_patch (begp:endp)) ; this%eflx_gnet_patch (:) = nan + allocate( this%eflx_grnd_lake_patch (begp:endp)) ; this%eflx_grnd_lake_patch (:) = nan + allocate( this%eflx_dynbal_grc (begg:endg)) ; this%eflx_dynbal_grc (:) = nan + allocate( this%eflx_bot_col (begc:endc)) ; this%eflx_bot_col (:) = nan + allocate( this%eflx_snomelt_col (begc:endc)) ; this%eflx_snomelt_col (:) = nan + allocate( this%eflx_snomelt_r_col (begc:endc)) ; this%eflx_snomelt_r_col (:) = nan + allocate( this%eflx_snomelt_u_col (begc:endc)) ; this%eflx_snomelt_u_col (:) = nan + allocate( this%eflx_fgr12_col (begc:endc)) ; this%eflx_fgr12_col (:) = nan + allocate( this%eflx_fgr_col (begc:endc, 1:nlevgrnd)) ; this%eflx_fgr_col (:,:) = nan + allocate( this%eflx_building_heat_errsoi_col (begc:endc)) ; this%eflx_building_heat_errsoi_col(:)= nan + allocate( this%eflx_urban_ac_col (begc:endc)) ; this%eflx_urban_ac_col (:) = nan + allocate( this%eflx_urban_heat_col (begc:endc)) ; this%eflx_urban_heat_col (:) = nan + allocate( this%eflx_wasteheat_patch (begp:endp)) ; this%eflx_wasteheat_patch (:) = nan + allocate( this%eflx_traffic_patch (begp:endp)) ; this%eflx_traffic_patch (:) = nan + allocate( this%eflx_heat_from_ac_patch (begp:endp)) ; this%eflx_heat_from_ac_patch (:) = nan + allocate( this%eflx_heat_from_ac_lun (begl:endl)) ; this%eflx_heat_from_ac_lun (:) = nan + allocate( this%eflx_building_lun (begl:endl)) ; this%eflx_building_lun (:) = nan + allocate( this%eflx_urban_ac_lun (begl:endl)) ; this%eflx_urban_ac_lun (:) = nan + allocate( this%eflx_urban_heat_lun (begl:endl)) ; this%eflx_urban_heat_lun (:) = nan + allocate( this%eflx_traffic_lun (begl:endl)) ; this%eflx_traffic_lun (:) = nan + allocate( this%eflx_wasteheat_lun (begl:endl)) ; this%eflx_wasteheat_lun (:) = nan + allocate( this%eflx_anthro_patch (begp:endp)) ; this%eflx_anthro_patch (:) = nan + + allocate( this%dgnetdT_patch (begp:endp)) ; this%dgnetdT_patch (:) = nan + allocate( this%cgrnd_patch (begp:endp)) ; this%cgrnd_patch (:) = nan + allocate( this%cgrndl_patch (begp:endp)) ; this%cgrndl_patch (:) = nan + allocate( this%cgrnds_patch (begp:endp)) ; this%cgrnds_patch (:) = nan + allocate( this%dlrad_patch (begp:endp)) ; this%dlrad_patch (:) = nan + allocate( this%ulrad_patch (begp:endp)) ; this%ulrad_patch (:) = nan + allocate( this%netrad_patch (begp:endp)) ; this%netrad_patch (:) = nan + + allocate( this%taux_patch (begp:endp)) ; this%taux_patch (:) = nan + allocate( this%tauy_patch (begp:endp)) ; this%tauy_patch (:) = nan + + allocate( this%canopy_cond_patch (begp:endp)) ; this%canopy_cond_patch (:) = nan + + allocate( this%htvp_col (begc:endc)) ; this%htvp_col (:) = nan + + allocate( this%dhsdt_canopy_patch (begp:endp)) ; this%dhsdt_canopy_patch (:) = nan + + allocate(this%rresis_patch (begp:endp,1:nlevgrnd)) ; this%rresis_patch (:,:) = nan + allocate(this%btran_patch (begp:endp)) ; this%btran_patch (:) = nan + allocate(this%btran_min_patch (begp:endp)) ; this%btran_min_patch (:) = nan + allocate(this%btran_min_inst_patch (begp:endp)) ; this%btran_min_inst_patch (:) = nan + allocate( this%bsun_patch (begp:endp)) ; this%bsun_patch (:) = nan + allocate( this%bsha_patch (begp:endp)) ; this%bsha_patch (:) = nan + allocate( this%errsoi_patch (begp:endp)) ; this%errsoi_patch (:) = nan + allocate( this%errsoi_col (begc:endc)) ; this%errsoi_col (:) = nan + allocate( this%errseb_patch (begp:endp)) ; this%errseb_patch (:) = nan + allocate( this%errseb_col (begc:endc)) ; this%errseb_col (:) = nan + allocate( this%errsol_patch (begp:endp)) ; this%errsol_patch (:) = nan + allocate( this%errsol_col (begc:endc)) ; this%errsol_col (:) = nan + allocate( this%errlon_patch (begp:endp)) ; this%errlon_patch (:) = nan + allocate( this%errlon_col (begc:endc)) ; this%errlon_col (:) = nan + + + end subroutine init_energyflux_type + +end module EnergyFluxType + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 new file mode 100644 index 000000000..660a293eb --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 @@ -0,0 +1,63 @@ +module WaterStateBulkType + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Defines a derived type containing water state variables that just apply to bulk + ! water. Note that this type extends the base waterstate_type, so the full + ! waterstatebulk_type contains the union of the fields defined here and the fields + ! defined in waterstate_type. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varpar , only : nlevmaxurbgrnd, nlevsno + use clm_varcon , only : spval + use WaterStateType , only : waterstate_type + ! + implicit none + save + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: init_waterstatebulk_type + ! + ! !PUBLIC TYPES: + type, extends(waterstate_type), public :: waterstatebulk_type + + real(r8), pointer :: snow_persistence_col (:) ! col length of time that ground has had non-zero snow thickness (sec) + real(r8), pointer :: int_snow_col (:) ! col integrated snowfall (mm H2O) + + end type waterstatebulk_type + type(waterstatebulk_type), public, target, save :: waterstatebulk_inst + +contains + +!--------------------------------------------- + subroutine init_waterstatebulk_type(bounds, this) + + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(waterstatebulk_type), intent(inout):: this + + !LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + !-------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + begl = bounds%begl ; endl= bounds%endl + begg = bounds%begg ; endg = bounds%endg + + allocate(this%snow_persistence_col (begc:endc)) ; this%snow_persistence_col (:) = nan + allocate(this%int_snow_col (begc:endc)) ; this%int_snow_col (:) = nan + + end subroutine init_waterstatebulk_type + +end module WaterStateBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 new file mode 100644 index 000000000..51f51e169 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 @@ -0,0 +1,91 @@ +module WaterStateType + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Defines a derived type containing water state variables that apply to both bulk water + ! and water tracers. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use clm_varpar , only : nlevgrnd, nlevsoi, nlevurb, nlevmaxurbgrnd, nlevsno + use clm_varcon , only : spval + use LandunitType , only : lun + use ColumnType , only : col + + implicit none + save + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: init_waterstate_type + + ! + ! !PUBLIC TYPES: + type, public :: waterstate_type + + real(r8), pointer :: h2osno_no_layers_col (:) ! col snow that is not resolved into layers; this is non-zero only if there is too little snow for there to be explicit snow layers (mm H2O) + real(r8), pointer :: h2osoi_liq_col (:,:) ! col liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: h2osoi_ice_col (:,:) ! col ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: h2osoi_vol_col (:,:) ! col volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) + real(r8), pointer :: h2osoi_vol_prs_grc (:,:) ! grc volumetric soil water prescribed (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) + real(r8), pointer :: h2osfc_col (:) ! col surface water (mm H2O) + real(r8), pointer :: snocan_patch (:) ! patch canopy snow water (mm H2O) + real(r8), pointer :: liqcan_patch (:) ! patch canopy liquid water (mm H2O) + + real(r8), pointer :: wa_col (:) ! col water in the unconfined aquifer (mm) + + ! For the following dynbal baseline variables: positive values are subtracted to + ! avoid counting liquid water content of "virtual" states; negative values are added + ! to account for missing states in the model. + real(r8), pointer :: dynbal_baseline_liq_col(:) ! baseline liquid water content subtracted from each column's total liquid water calculation (mm H2O) + real(r8), pointer :: dynbal_baseline_ice_col(:) ! baseline ice content subtracted from each column's total ice calculation (mm H2O) + + real(r8) :: aquifer_water_baseline ! baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) + + end type waterstate_type + type(waterstate_type), public, target, save :: waterstate_inst + +contains + +!--------------------------------------------- + subroutine init_waterstate_type(bounds, this) + + ! !ARGUMENTS: + implicit none + !INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + type(waterstate_type), intent(inout):: this + + !LOCAL + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + !-------------------- + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + begl = bounds%begl ; endl= bounds%endl + begg = bounds%begg ; endg = bounds%endg + + allocate( this%h2osfc_col (begc:endc)) ; this%h2osfc_col(begc:endc) = 0._r8 + allocate( this%snocan_patch (begp:endp)) ; this%snocan_patch(begp:endp) = 0._r8 + allocate( this%liqcan_patch (begp:endp)) ; this%liqcan_patch(begp:endp) = 0._r8 + + allocate(this%h2osoi_vol_col(begc:endc,1:nlevmaxurbgrnd)) ; this%h2osoi_vol_col(begc:endc, 1:) = spval + allocate(this%h2osoi_vol_prs_grc(begg:endg,1:nlevgrnd)) ; this%h2osoi_vol_prs_grc(begg:endg, 1:) = spval + allocate(this%h2osoi_liq_col(begc:endc,-nlevsno+1nlevmaxurbgrnd)) ; this%h2osoi_liq_col(begc:endc,-nlevsno+1:) = spval + allocate(this%h2osoi_ice_col(begc:endc,-nlevsno+1nlevmaxurbgrnd)) ; this%h2osoi_ice_col(bounds%begc:bounds%endc,-nlevsno+1:) = spval + + allocate( this%wa_col (begc:endc)) ; this%wa_col(begc:endc) = spval + allocate( this%h2osno_no_layers_col (begc:endc)) ; this%h2osno_no_layers_col(begc:endc) = nan + allocate( this%dynbal_baseline_liq_col (begc:endc)); this%dynbal_baseline_liq_col(begc:endc) = nan + allocate( this%dynbal_baseline_ice_col (begc:endc)); this%dynbal_baseline_ice_col(begc:endc) = nan + + end subroutine init_waterstate_type +end module WaterStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 new file mode 100755 index 000000000..9a60a90bc --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 @@ -0,0 +1,119 @@ +module dynSubgridControlMod + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Defines a class for storing and querying control flags related to dynamic subgrid + ! operation. + ! + ! Note that this is implemented (essentially) as a singleton, so the only instance of + ! this class is stored in this module. This is done for convenience, to avoid having to + ! pass around the single instance just to query these control flags. + ! + ! !USES: +#include "shr_assert.h" + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: get_do_transient_pfts ! return the value of the do_transient_pfts control flag + public :: get_do_transient_crops ! return the value of the do_transient_crops control flag + public :: run_has_transient_landcover ! returns true if any aspects of prescribed transient landcover are enabled + ! + ! !PRIVATE TYPES: + type dyn_subgrid_control_type + private + logical :: do_transient_pfts = .false. ! whether to apply transient natural PFTs from dataset + logical :: do_transient_crops = .false. ! whether to apply transient crops from dataset + logical :: do_transient_lakes = .false. ! whether to apply transient lakes from dataset + logical :: do_harvest = .false. ! whether to apply harvest from dataset + + logical :: reset_dynbal_baselines = .false. ! whether to reset baseline values of total column water and energy in the first step of the run + + ! The following is only meant for testing: Whether area changes are allowed at times + ! other than the year boundary. This should only arise in some test configurations + ! where we artificially create changes more frequently so that we can run short + ! tests. This flag is only used for error-checking, not controlling any model + ! behavior. + logical :: for_testing_allow_non_annual_changes = .false. + + ! The following is only meant for testing: If .true., set the dynbal water and + ! energy fluxes to zero. This is needed in some tests where we have daily rather + ! than annual glacier dynamics: if we allow the true dynbal adjustment fluxes in + ! those tests, we end up with sensible heat fluxes of thousands of W m-2 or more, + ! which causes CAM to blow up. However, note that setting it to true will break + ! water and energy conservation! + logical :: for_testing_zero_dynbal_fluxes = .false. + + logical :: initialized = .false. ! whether this object has been initialized + end type dyn_subgrid_control_type + + type(dyn_subgrid_control_type) :: dyn_subgrid_control_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine dynSubgridControl_init( ) + ! + ! !DESCRIPTION: + ! Initialize the dyn_subgrid_control settings. + ! + ! !USES: + use spmdMod , only : masterproc + ! + ! !ARGUMENTS: + + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'dynSubgridControl_init' + !----------------------------------------------------------------------- + + dyn_subgrid_control_inst%initialized = .true. + + end subroutine dynSubgridControl_init + + !----------------------------------------------------------------------- + logical function get_do_transient_pfts() + ! !DESCRIPTION: + ! Return the value of the do_transient_pfts control flag + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_do_transient_pfts = dyn_subgrid_control_inst%do_transient_pfts + + end function get_do_transient_pfts + + !----------------------------------------------------------------------- + logical function get_do_transient_crops() + ! !DESCRIPTION: + ! Return the value of the do_transient_crops control flag + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_do_transient_crops = dyn_subgrid_control_inst%do_transient_crops + + end function get_do_transient_crops + + !----------------------------------------------------------------------- + logical function run_has_transient_landcover() + ! !DESCRIPTION: + ! Returns true if any aspects of prescribed transient landcover are enabled + !----------------------------------------------------------------------- + + run_has_transient_landcover = & + (get_do_transient_pfts() .or. & + get_do_transient_crops()) + end function run_has_transient_landcover + + !----------------------------------------------------------------------- + +end module dynSubgridControlMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate3Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate3Mod.F90 new file mode 100755 index 000000000..4ed4b828b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate3Mod.F90 @@ -0,0 +1,211 @@ +module CNCStateUpdate3Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for carbon state variable update, mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_time_manager , only : get_step_size_real + use clm_varpar , only : nlevdecomp, ndecomp_pools, i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use clm_varctl , only : use_matrixcn,use_soil_matrixcn + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CStateUpdate3 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst,& + soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic carbon state + ! variables affected by fire fluxes + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & ! Input + cs_veg => cnveg_carbonstate_inst, & ! Output + cf_soil => soilbiogeochem_carbonflux_inst, & ! Output + cs_soil => soilbiogeochem_carbonstate_inst & ! Output + ) + + ! set time steps + dt = get_step_size_real() + + ! column level carbon fluxes from fire + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ! patch-level wood to column-level CWD (uncombusted wood) + if (.not. use_soil_matrixcn) then + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + & + cf_veg%fire_mortality_c_to_cwdc_col(c,j) * dt + + ! patch-level wood to column-level litter (uncombusted wood) + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) + & + cf_veg%m_c_to_litr_met_fire_col(c,j)* dt + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) + & + cf_veg%m_c_to_litr_cel_fire_col(c,j)* dt + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) + & + cf_veg%m_c_to_litr_lig_fire_col(c,j)* dt + else + ! patch-level wood to column-level CWD (uncombusted wood) + cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + & + cf_veg%fire_mortality_c_to_cwdc_col(c,j) * dt + + ! patch-level wood to column-level litter (uncombusted wood) + cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + & + cf_veg%m_c_to_litr_met_fire_col(c,j)* dt + cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + & + cf_veg%m_c_to_litr_cel_fire_col(c,j)* dt + cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + & + cf_veg%m_c_to_litr_lig_fire_col(c,j)* dt + end if + end do + end do + + ! litter and CWD losses to fire + if(.not. use_soil_matrixcn)then + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cs_soil%decomp_cpools_vr_col(c,j,l) = cs_soil%decomp_cpools_vr_col(c,j,l) - & + cf_veg%m_decomp_cpools_to_fire_vr_col(c,j,l) * dt + end do + end do + end do + end if + + ! patch-level carbon fluxes from fire + do fp = 1,num_soilp + p = filter_soilp(fp) + + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) - & + cf_veg%m_gresp_storage_to_fire_patch(p) * dt + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) - & + cf_veg%m_gresp_storage_to_litter_fire_patch(p) * dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - & + cf_veg%m_gresp_xfer_to_fire_patch(p) * dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - & + cf_veg%m_gresp_xfer_to_litter_fire_patch(p) * dt + if(.not. use_matrixcn)then + ! displayed pools + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) - & + cf_veg%m_leafc_to_fire_patch(p) * dt + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) - & + cf_veg%m_leafc_to_litter_fire_patch(p) * dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) - & + cf_veg%m_frootc_to_fire_patch(p) * dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) - & + cf_veg%m_frootc_to_litter_fire_patch(p) * dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - & + cf_veg%m_livestemc_to_fire_patch(p) * dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - & + cf_veg%m_livestemc_to_litter_fire_patch(p) * dt - & + cf_veg%m_livestemc_to_deadstemc_fire_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) - & + cf_veg%m_deadstemc_to_fire_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) - & + cf_veg%m_deadstemc_to_litter_fire_patch(p) * dt + & + cf_veg%m_livestemc_to_deadstemc_fire_patch(p) * dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) - & + cf_veg%m_livecrootc_to_fire_patch(p) * dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) - & + cf_veg%m_livecrootc_to_litter_fire_patch(p) * dt - & + cf_veg%m_livecrootc_to_deadcrootc_fire_patch(p) * dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) - & + cf_veg%m_deadcrootc_to_fire_patch(p) * dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) - & + cf_veg%m_deadcrootc_to_litter_fire_patch(p)* dt + & + cf_veg%m_livecrootc_to_deadcrootc_fire_patch(p) * dt + + ! storage pools + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) - & + cf_veg%m_leafc_storage_to_fire_patch(p) * dt + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) - & + cf_veg%m_leafc_storage_to_litter_fire_patch(p) * dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) - & + cf_veg%m_frootc_storage_to_fire_patch(p) * dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) - & + cf_veg%m_frootc_storage_to_litter_fire_patch(p) * dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) - & + cf_veg%m_livestemc_storage_to_fire_patch(p) * dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) - & + cf_veg%m_livestemc_storage_to_litter_fire_patch(p) * dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) - & + cf_veg%m_deadstemc_storage_to_fire_patch(p) * dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) - & + cf_veg%m_deadstemc_storage_to_litter_fire_patch(p) * dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) - & + cf_veg%m_livecrootc_storage_to_fire_patch(p) * dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) - & + cf_veg%m_livecrootc_storage_to_litter_fire_patch(p)* dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) - & + cf_veg%m_deadcrootc_storage_to_fire_patch(p) * dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) - & + cf_veg%m_deadcrootc_storage_to_litter_fire_patch(p)* dt + + ! transfer pools + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) - & + cf_veg%m_leafc_xfer_to_fire_patch(p) * dt + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) - & + cf_veg%m_leafc_xfer_to_litter_fire_patch(p) * dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) - & + cf_veg%m_frootc_xfer_to_fire_patch(p) * dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) - & + cf_veg%m_frootc_xfer_to_litter_fire_patch(p) * dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) - & + cf_veg%m_livestemc_xfer_to_fire_patch(p) * dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) - & + cf_veg%m_livestemc_xfer_to_litter_fire_patch(p) * dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) - & + cf_veg%m_deadstemc_xfer_to_fire_patch(p) * dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) - & + cf_veg%m_deadstemc_xfer_to_litter_fire_patch(p) * dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) - & + cf_veg%m_livecrootc_xfer_to_fire_patch(p) * dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) - & + cf_veg%m_livecrootc_xfer_to_litter_fire_patch(p)* dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) - & + cf_veg%m_deadcrootc_xfer_to_fire_patch(p) * dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) - & + cf_veg%m_deadcrootc_xfer_to_litter_fire_patch(p)* dt + else + ! NOTE: The equivalent changes for matrix code are in CNFireBase and CNFireLi2014 codes EBK (11/26/2019) + end if !not use_matrixcn + end do ! end of patch loop + + end associate + + end subroutine CStateUpdate3 + +end module CNCStateUpdate3Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireBaseMod.F90 deleted file mode 100755 index 1c5398268..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireBaseMod.F90 +++ /dev/null @@ -1,1302 +0,0 @@ -module CNFireBaseMod - -#include "shr_assert.h" - - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! module for fire dynamics - ! created in Nov, 2012 and revised in Apr, 2013 by F. Li and S. Levis - ! based on Li et al. (2012a,b; 2013) - ! revised in Apr, 2014 according Li et al.(2014) - ! Fire-related parameters were calibrated or tuned in Apr, 2013 based on the - ! 20th Century transient simulations at f19_g16 with (newfire05_clm45sci15_clm4_0_58) - ! a CLM4.5 version, Qian et al. (2006) atmospheric forcing, and - ! climatological lightning data. - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL - use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : iulog - use clm_varpar , only : nlevgrnd - use pftconMod , only : noveg, pftcon - use abortutils , only : endrun - use decompMod , only : bounds_type - use atm2lndType , only : atm2lnd_type - use CNDVType , only : dgvs_type - use CNVegStateType , only : cnveg_state_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood - use CNVegCarbonFluxType , only : cnveg_carbonflux_type - use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type - use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type - use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type - use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con - use EnergyFluxType , only : energyflux_type - use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type - use Wateratm2lndBulkType , only : wateratm2lndbulk_type - use WaterStateBulkType , only : waterstatebulk_type - use SoilStateType , only : soilstate_type - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type - use GridcellType , only : grc - use ColumnType , only : col - use PatchType , only : patch - use FireMethodType , only : fire_method_type - use FireDataBaseType , only : fire_base_type - ! - implicit none - private - ! - ! !PUBLIC TYPES: - public :: cnfire_base_type - - type, public :: cnfire_const_type - ! !PRIVATE MEMBER DATA: - real(r8) :: borealat = 40._r8 ! Latitude for boreal peat fires - real(r8) :: lfuel=75._r8 ! lower threshold of fuel mass (gC/m2) for ignition, Li et al.(2014) - real(r8) :: ufuel=650._r8 ! upper threshold of fuel mass(gC/m2) for ignition - real(r8) :: g0=0.05_r8 ! g(W) when W=0 m/s - real(r8) :: rh_low=30.0_r8 ! Relative humidty low (%) - real(r8) :: rh_hgh=80.0_r8 ! Relative humidty high (%) - real(r8) :: bt_min=0.3_r8 ! btran minimum (fraction) - real(r8) :: bt_max=0.7_r8 ! btran maximum (fraction) - real(r8) :: cli_scale=0.035_r8 ! global constant for deforestation fires (/d) - real(r8) :: boreal_peatfire_c = 4.2e-5_r8 ! c parameter for boreal peatland fire in Li et. al. (2013) (/hr) - real(r8) :: pot_hmn_ign_counts_alpha=0.0035_r8 ! Potential human ignition counts (alpha in Li et. al. 2012) (/person/month) - real(r8) :: non_boreal_peatfire_c = 0.001_r8 ! c parameter for non-boreal peatland fire in Li et. al. (2013) (/hr) - real(r8) :: cropfire_a1 = 0.3_r8 ! a1 parameter for cropland fire in (Li et. al., 2014) (/hr) - real(r8) :: occur_hi_gdp_tree = 0.39_r8 ! fire occurance for high GDP areas that are tree dominated (fraction) - - real(r8) :: cmb_cmplt_fact_litter = 0.5_r8 ! combustion completion factor for litter (unitless) - real(r8) :: cmb_cmplt_fact_cwd = 0.25_r8 ! combustion completion factor for CWD (unitless) - end type - - type, public :: params_type - real(r8) :: prh30 ! Factor related to dependence of fuel combustibility on 30-day running mean of relative humidity (unitless) - real(r8) :: ignition_efficiency ! Ignition efficiency of cloud-to-ground lightning (unitless) - end type params_type - - ! - type, abstract, extends(fire_base_type) :: cnfire_base_type - private - ! !PRIVATE MEMBER DATA: - ! !PUBLIC MEMBER DATA (used by extensions of the base class): - real(r8), public, pointer :: btran2_patch (:) ! patch root zone soil wetness factor (0 to 1) - - contains - ! - ! !PUBLIC MEMBER FUNCTIONS: - procedure, public :: FireInit => CNFireInit ! Initialization of Fire - procedure, public :: FireReadNML ! Read in namelist for CNFire - procedure, public :: CNFireReadParams ! Read in constant parameters from the paramsfile - procedure, public :: CNFireFluxes ! Calculate fire fluxes - procedure, public :: CNFire_calc_fire_root_wetness_Li2014 ! Calculate CN-fire specific root wetness: original version - procedure, public :: CNFire_calc_fire_root_wetness_Li2021 ! Calculate CN-fire specific root wetness: 2021 version - ! !PRIVATE MEMBER FUNCTIONS: - procedure, private :: InitAllocate ! Memory allocation of Fire - procedure, private :: InitHistory ! History file assignment of fire - ! - end type cnfire_base_type - !----------------------------------------------------------------------- - - abstract interface - !----------------------------------------------------------------------- - function need_lightning_and_popdens_interface(this) result(need_lightning_and_popdens) - ! - ! !DESCRIPTION: - ! Returns true if need lightning and popdens, false otherwise - ! - ! USES - import :: cnfire_base_type - ! - ! !ARGUMENTS: - class(cnfire_base_type), intent(in) :: this - logical :: need_lightning_and_popdens ! function result - !----------------------------------------------------------------------- - end function need_lightning_and_popdens_interface - end interface - - type(cnfire_const_type), public, protected :: cnfire_const ! Fire constants shared by Li versons - type(params_type) , public, protected :: cnfire_params ! Fire parameters shared by Li versions - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - -contains - - !----------------------------------------------------------------------- - subroutine CNFireInit( this, bounds ) - ! - ! !DESCRIPTION: - ! Initialize CN Fire module - ! !ARGUMENTS: - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - !----------------------------------------------------------------------- - ! Call the base-class Initialization method - call this%BaseFireInit( bounds ) - - ! Allocate memory - call this%InitAllocate( bounds ) - ! History file - ! call this%InitHistory( bounds ) - end subroutine CNFireInit - !---------------------------------------------------------------------- - - subroutine InitAllocate( this, bounds ) - ! - ! Initiaze memory allocate's - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - ! - ! !ARGUMENTS: - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - !----------------------------------------------------------------------- - integer :: begp, endp - !------------------------------------------------------------------------ - begp = bounds%begp; endp= bounds%endp - - allocate(this%btran2_patch (begp:endp)) ; this%btran2_patch (:) = nan - - end subroutine InitAllocate - - !---------------------------------------------------------------------- - subroutine CNFire_calc_fire_root_wetness_Li2014( this, bounds, & - num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve ) - ! - ! Calculate the root wetness term that will be used by the fire model - ! - class(cnfire_base_type) :: this - type(bounds_type) , intent(in) :: bounds !bounds - integer , intent(in) :: num_exposedvegp !number of filters - integer , intent(in) :: filter_exposedvegp(:) !filter array - integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp - integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 - type(waterstatebulk_type), intent(in) :: waterstatebulk_inst - type(soilstate_type) , intent(in) :: soilstate_inst - class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve - ! !LOCAL VARIABLES: - real(r8) :: smp_node, s_node !temporary variables - real(r8) :: smp_node_lf !temporary variable - integer :: p, fp, j, c, l !indices - !----------------------------------------------------------------------- - - SHR_ASSERT_ALL_FL((ubound(filter_exposedvegp) >= (/num_exposedvegp/)), sourcefile, __LINE__) - - associate( & - smpso => pftcon%smpso , & ! Input: soil water potential at full stomatal opening (mm) - smpsc => pftcon%smpsc , & ! Input: soil water potential at full stomatal closure (mm) - watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation - btran2 => this%btran2_patch , & ! Output: [real(r8) (:) ] integrated soil water stress square - rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer - h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (porosity) (constant) - ) - - do fp = 1, num_noexposedvegp - p = filter_noexposedvegp(fp) - ! Set for the sake of history diagnostics. The "normal" btran is set to 0 over - ! this filter, so we do the same for btran2. - btran2(p) = 0._r8 - end do - - do fp = 1, num_exposedvegp - p = filter_exposedvegp(fp) - btran2(p) = 0._r8 - end do - do j = 1,nlevgrnd - do fp = 1, num_exposedvegp - p = filter_exposedvegp(fp) - c = patch%column(p) - l = patch%landunit(p) - s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) - - call soil_water_retention_curve%soil_suction(c, j, s_node, soilstate_inst, smp_node_lf) - - smp_node_lf = max(smpsc(patch%itype(p)), smp_node_lf) - btran2(p) = btran2(p) +rootfr(p,j)*max(0._r8,min((smp_node_lf - smpsc(patch%itype(p))) / & - (smpso(patch%itype(p)) - smpsc(patch%itype(p))), 1._r8)) - end do - end do - - do fp = 1, num_exposedvegp - p = filter_exposedvegp(fp) - if (btran2(p) > 1._r8) then - btran2(p) = 1._r8 - end if - end do - - end associate - - end subroutine CNFire_calc_fire_root_wetness_Li2014 - - !---------------------------------------------------------------------- - subroutine CNFire_calc_fire_root_wetness_Li2021( this, bounds, & - num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve ) - ! - ! Calculate the root wetness term that will be used by the fire model - ! - use pftconMod , only : pftcon - use PatchType , only : patch - class(cnfire_base_type) :: this - type(bounds_type) , intent(in) :: bounds !bounds - integer , intent(in) :: num_exposedvegp !number of filters - integer , intent(in) :: filter_exposedvegp(:) !filter array - integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp - integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 - type(waterstatebulk_type), intent(in) :: waterstatebulk_inst - type(soilstate_type) , intent(in) :: soilstate_inst - class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve - ! !LOCAL VARIABLES: - real(r8) :: s_node !temporary variables - integer :: p, fp, j, c !indices - !----------------------------------------------------------------------- - - SHR_ASSERT_ALL_FL((ubound(filter_exposedvegp) >= (/num_exposedvegp/)), sourcefile, __LINE__) - - associate( & - watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation - btran2 => this%btran2_patch , & ! Output: [real(r8) (:) ] integrated soil water stress square - rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer - h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (porosity) (constant) - ) - - do fp = 1, num_noexposedvegp - p = filter_noexposedvegp(fp) - ! Set for the sake of history diagnostics. The "normal" btran is set to 0 over - ! this filter, so we do the same for btran2. - btran2(p) = 0._r8 - end do - - do fp = 1, num_exposedvegp - p = filter_exposedvegp(fp) - btran2(p) = 0._r8 - end do - do j = 1,nlevgrnd - do fp = 1, num_exposedvegp - p = filter_exposedvegp(fp) - c = patch%column(p) - s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) - - btran2(p) = btran2(p) + rootfr(p,j)*s_node - end do - end do - - do fp = 1, num_exposedvegp - p = filter_exposedvegp(fp) - if (btran2(p) > 1._r8) then - btran2(p) = 1._r8 - end if - end do - - end associate - - end subroutine CNFire_calc_fire_root_wetness_Li2021 - !---------------------------------------------------------------------- - - !---------------------------------------------------------------------- - subroutine FireReadNML( this, fire_method ) - ! - ! !DESCRIPTION: - ! Read the namelist for CNFire - ! - ! !USES: - use shr_nl_mod , only : shr_nl_find_group_name - use clm_varctl , only : iulog - ! - ! !ARGUMENTS: - class(cnfire_base_type) :: this - character(len=*), intent(in) :: fire_method ! Namelist filename - ! - ! !LOCAL VARIABLES: - integer :: ierr ! error code - integer :: unitn ! unit for namelist file - - character(len=*), parameter :: subname = 'FireReadNML' - character(len=*), parameter :: nmlname = 'lifire_inparm' - !----------------------------------------------------------------------- - real(r8) :: cli_scale, boreal_peatfire_c, pot_hmn_ign_counts_alpha - real(r8) :: non_boreal_peatfire_c, cropfire_a1 - real(r8) :: rh_low, rh_hgh, bt_min, bt_max, occur_hi_gdp_tree - real(r8) :: lfuel, ufuel, cmb_cmplt_fact_litter, cmb_cmplt_fact_cwd - - - if ( this%need_lightning_and_popdens() ) then - cli_scale = cnfire_const%cli_scale - boreal_peatfire_c = cnfire_const%boreal_peatfire_c - non_boreal_peatfire_c = cnfire_const%non_boreal_peatfire_c - pot_hmn_ign_counts_alpha = cnfire_const%pot_hmn_ign_counts_alpha - cropfire_a1 = cnfire_const%cropfire_a1 - rh_low = cnfire_const%rh_low - rh_hgh = cnfire_const%rh_hgh - lfuel = cnfire_const%lfuel - ufuel = cnfire_const%ufuel - bt_min = cnfire_const%bt_min - bt_max = cnfire_const%bt_max - occur_hi_gdp_tree = cnfire_const%occur_hi_gdp_tree - cmb_cmplt_fact_litter = cnfire_const%cmb_cmplt_fact_litter - cmb_cmplt_fact_cwd = cnfire_const%cmb_cmplt_fact_cwd - ! Initialize options to default values, in case they are not specified in - ! the namelist - - select case (trim(fire_method)) - - case ("nofire") - - case ("li2014qianfrc") - lfuel = 75._r8 - ufuel = 1050._r8 - rh_low = 30.0_r8 - rh_hgh = 80.0_r8 - bt_min = 0.3_r8 - bt_max = 0.7_r8 - cli_scale = 0.035_r8 - boreal_peatfire_c = 4.2e-5_r8 - pot_hmn_ign_counts_alpha = 0.0035_r8 - non_boreal_peatfire_c = 0.001_r8 - cropfire_a1 = 0.3_r8 - occur_hi_gdp_tree = 0.39_r8 - cmb_cmplt_fact_litter = 0.5_r8 - cmb_cmplt_fact_cwd = 0.25_r8 - case ("li2016crufrc") - lfuel = 105._r8 - ufuel = 1050._r8 - rh_low = 30.0_r8 - rh_hgh = 80.0_r8 - bt_min = 0.85_r8 - bt_max = 0.98_r8 - cli_scale = 0.033_r8 - boreal_peatfire_c = 0.09e-4_r8 - pot_hmn_ign_counts_alpha = 0.01_r8 - non_boreal_peatfire_c = 0.17e-3_r8 - cropfire_a1 = 1.6e-4_r8 - occur_hi_gdp_tree = 0.33_r8 - cmb_cmplt_fact_litter = 0.5_r8 - cmb_cmplt_fact_cwd = 0.28_r8 - case ("li2021gswpfrc") - lfuel = 75._r8 - ufuel = 1050._r8 - rh_low = 30.0_r8 - rh_hgh = 80.0_r8 - bt_min = 0.85_r8 - bt_max = 0.98_r8 - cli_scale = 0.025_r8 - boreal_peatfire_c = 0.09e-4_r8 - pot_hmn_ign_counts_alpha = 0.01_r8 - non_boreal_peatfire_c = 0.17e-3_r8 - cropfire_a1 = 1.6e-4_r8 - occur_hi_gdp_tree = 0.33_r8 - cmb_cmplt_fact_litter = 0.5_r8 - cmb_cmplt_fact_cwd = 0.28_r8 - - case default - write(iulog,*) subname//' ERROR: unknown method: ', fire_method - call endrun(msg=errMsg(sourcefile, __LINE__)) - - end select - - cnfire_const%cli_scale = cli_scale - cnfire_const%boreal_peatfire_c = boreal_peatfire_c - cnfire_const%non_boreal_peatfire_c = non_boreal_peatfire_c - cnfire_const%pot_hmn_ign_counts_alpha = pot_hmn_ign_counts_alpha - cnfire_const%cropfire_a1 = cropfire_a1 - cnfire_const%rh_low = rh_low - cnfire_const%rh_hgh = rh_hgh - cnfire_const%lfuel = lfuel - cnfire_const%ufuel = ufuel - cnfire_const%bt_min = bt_min - cnfire_const%bt_max = bt_max - cnfire_const%occur_hi_gdp_tree = occur_hi_gdp_tree - cnfire_const%cmb_cmplt_fact_litter = cmb_cmplt_fact_litter - cnfire_const%cmb_cmplt_fact_cwd = cmb_cmplt_fact_cwd - - end if - - end subroutine FireReadNML - - !----------------------------------------------------------------------- - subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & - dgvs_inst, cnveg_state_inst, & - cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & - soilbiogeochem_carbonflux_inst, & - leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch, & - totsomc_col, decomp_cpools_vr_col, decomp_npools_vr_col, somc_fire_col) - ! - ! !DESCRIPTION: - ! Fire effects routine for coupled carbon-nitrogen code (CN). - ! Relies primarily on estimate of fractional area burned, from CNFireArea(). - ! - ! Total fire carbon emissions (g C/m2 land area/yr) - ! =avg(COL_FIRE_CLOSS)*seconds_per_year + avg(SOMC_FIRE)*seconds_per_year + - ! avg(LF_CONV_CFLUX)*seconds_per_year*min(1.0,avg(LFC2)*seconds_per_year)*0.8 - ! where avg means the temporal average in a year - ! seconds_per_year is the number of seconds in a year. - ! - ! !USES: - use clm_time_manager , only: get_step_size_real,get_days_per_year,get_curr_date - use clm_varctl , only: use_cndv, use_soil_matrixcn, use_matrixcn - use clm_varcon , only: secspday - use pftconMod , only: nc3crop - use dynSubgridControlMod , only: run_has_transient_landcover - use clm_varpar , only: nlevdecomp_full, ndecomp_pools, nlevdecomp - use clm_varpar , only: ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& - ilivestem,ilivestem_st,ilivestem_xf,& - ideadstem,ideadstem_st,ideadstem_xf,& - ilivecroot,ilivecroot_st,ilivecroot_xf,& - ideadcroot,ideadcroot_st,ideadcroot_xf,iretransn,ioutc,ioutn - use CNVegMatrixMod , only: matrix_update_fic, matrix_update_fin - ! - ! !ARGUMENTS: - class(cnfire_base_type) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - integer , intent(out) :: num_actfirep ! number of active patches on fire in filter - integer , intent(out) :: filter_actfirep(:) ! filter for soil patches - integer , intent(out) :: num_actfirec ! number of active columns on fire in filter - integer , intent(out) :: filter_actfirec(:) ! filter for soil columns - type(dgvs_type) , intent(inout) :: dgvs_inst - type(cnveg_state_type) , intent(inout) :: cnveg_state_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst ! only for matrix_decomp_fire_k: (gC/m3/step) VR deomp. C fire loss in matrix representation - type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst - type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst - type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst - type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst - real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) - real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) - real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) - real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) - real(r8) , intent(in) :: totsomc_col(bounds%begc:) ! (gC/m2) total soil organic matter C - real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) - real(r8) , intent(in) :: decomp_npools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) - real(r8) , intent(out) :: somc_fire_col(bounds%begc:) ! (gC/m2/s) fire C emissions due to peat burning - ! - ! !LOCAL VARIABLES: - integer :: g,c,p,j,l,kyr, kmo, kda, mcsec ! indices - integer :: fp,fc ! filter indices - real(r8):: f ! rate for fire effects (1/s) - real(r8):: m ! acceleration factor for fuel carbon - real(r8):: dt ! time step variable (s) - real(r8):: dayspyr ! days per year - logical :: transient_landcover ! whether this run has any prescribed transient landcover - !----------------------------------------------------------------------- - - SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(totsomc_col) == (/bounds%endc/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(decomp_npools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(somc_fire_col) == (/bounds%endc/)) , sourcefile, __LINE__) - - ! NOTE: VR = Vertically Resolved - ! conv. = conversion - ! frac. = fraction - ! BAF = Burned Area Fraction - ! ann. = annual - ! GC = gridcell - ! dt = timestep - ! C = Carbon - ! N = Nitrogen - ! emis. = emissions - ! decomp. = decomposing - - associate( & - croot_prof => croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots - stem_prof => stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems - froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots - leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves - totsomc => totsomc_col , & ! Input: [real(r8) (:) ] (gC/m2) total soil organic matter C - decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) - decomp_npools_vr => decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) - somc_fire => somc_fire_col , & ! Output: [real(r8) (:) ] (gC/m2/s) fire C emissions due to peat burning - - is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool - is_litter => decomp_cascade_con%is_litter , & ! Input: [logical (:) ] TRUE => pool is a litter pool - - woody => pftcon%woody , & ! Input: woody lifeform (1=woody, 0=not woody) - cc_leaf => pftcon%cc_leaf , & ! Input: - cc_lstem => pftcon%cc_lstem , & ! Input: - cc_dstem => pftcon%cc_dstem , & ! Input: - cc_other => pftcon%cc_other , & ! Input: - fm_leaf => pftcon%fm_leaf , & ! Input: - fm_lstem => pftcon%fm_lstem , & ! Input: - fm_other => pftcon%fm_other , & ! Input: - fm_root => pftcon%fm_root , & ! Input: - fm_lroot => pftcon%fm_lroot , & ! Input: - fm_droot => pftcon%fm_droot , & ! Input: - lf_flab => pftcon%lf_flab , & ! Input: - lf_fcel => pftcon%lf_fcel , & ! Input: - lf_flig => pftcon%lf_flig , & ! Input: - fr_flab => pftcon%fr_flab , & ! Input: - fr_fcel => pftcon%fr_fcel , & ! Input: - fr_flig => pftcon%fr_flig , & ! Input: - - cmb_cmplt_fact_litter => cnfire_const%cmb_cmplt_fact_litter , & ! Input: [real(r8) (:) ] Combustion completion factor for litter (unitless) - cmb_cmplt_fact_cwd => cnfire_const%cmb_cmplt_fact_cwd , & ! Input: [real(r8) (:) ] Combustion completion factor for CWD (unitless) - - nind => dgvs_inst%nind_patch , & ! Input: [real(r8) (:) ] number of individuals (#/m2) - - cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column - farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] fractional area burned (/sec) - fbac1 => cnveg_state_inst%fbac1_col , & ! Input: [real(r8) (:) ] burned area out of conv. region due to LU fire - fbac => cnveg_state_inst%fbac_col , & ! Input: [real(r8) (:) ] total burned area out of conversion (/sec) - baf_crop => cnveg_state_inst%baf_crop_col , & ! Input: [real(r8) (:) ] BAF for cropland - baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Input: [real(r8) (:) ] BAF for peatlabd - trotr1_col => cnveg_state_inst%trotr1_col , & ! Input: [real(r8) (:) ] patch weight of BET on the column (0-1) - trotr2_col => cnveg_state_inst%trotr2_col , & ! Input: [real(r8) (:) ] patch weight of BDT on the column (0-1) - dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Input: [real(r8) (:) ] ann. decreased frac. coverage of BET+BDT (0-1) on GC - lfc => cnveg_state_inst%lfc_col , & ! Input: [real(r8) (:) ] conv. area frac. of BET+BDT that haven't burned before - lfc2 => cnveg_state_inst%lfc2_col , & ! Output: [real(r8) (:) ] conv. area frac. of BET+BDT burned this dt (/sec) - - leafcmax => cnveg_carbonstate_inst%leafcmax_patch , & ! Output: [real(r8) (:) ] (gC/m2) ann max leaf C - leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C - leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage - leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer - livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C - livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage - livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C transfer - deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C - deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage - deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C transfer - frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C - frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage - frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer - livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C - livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage - livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer - deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C - deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage - deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer - gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage - gresp_xfer => cnveg_carbonstate_inst%gresp_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration transfer - - leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N - leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage - leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N transfer - livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N - livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage - livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N transfer - deadstemn => cnveg_nitrogenstate_inst%deadstemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N - deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage - deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N transfer - frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N - frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage - frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer - livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N - livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage - livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N transfer - deadcrootn => cnveg_nitrogenstate_inst%deadcrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N - deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage - deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N transfer - retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N - - fire_mortality_c_to_cwdc => cnveg_carbonflux_inst%fire_mortality_c_to_cwdc_col , & ! Input: [real(r8) (:,:) ] C flux fire mortality to CWD (gC/m3/s) - m_leafc_to_fire => cnveg_carbonflux_inst%m_leafc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc - m_leafc_storage_to_fire => cnveg_carbonflux_inst%m_leafc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_storage - m_leafc_xfer_to_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_xfer - m_livestemc_to_fire => cnveg_carbonflux_inst%m_livestemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from livestemc - m_livestemc_storage_to_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_storage - m_livestemc_xfer_to_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_xfer - m_deadstemc_to_fire => cnveg_carbonflux_inst%m_deadstemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer - m_deadstemc_storage_to_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_storage - m_deadstemc_xfer_to_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer - m_frootc_to_fire => cnveg_carbonflux_inst%m_frootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc - m_frootc_storage_to_fire => cnveg_carbonflux_inst%m_frootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_storage - m_frootc_xfer_to_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_xfer - m_livecrootc_to_fire => cnveg_carbonflux_inst%m_livecrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc - m_livecrootc_storage_to_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_storage - m_livecrootc_xfer_to_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_xfer - m_deadcrootc_to_fire => cnveg_carbonflux_inst%m_deadcrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc - m_deadcrootc_storage_to_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_storage - m_deadcrootc_xfer_to_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_xfer - m_gresp_storage_to_fire => cnveg_carbonflux_inst%m_gresp_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_storage - m_gresp_xfer_to_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_xfer - m_leafc_to_litter_fire => cnveg_carbonflux_inst%m_leafc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_leafc_storage_to_litter_fire => cnveg_carbonflux_inst%m_leafc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_leafc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livestemc_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livestemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livestemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livestemc_to_deadstemc_fire => cnveg_carbonflux_inst%m_livestemc_to_deadstemc_fire_patch , & ! Output: [real(r8) (:) ] - m_deadstemc_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_deadstemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_deadstemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_frootc_to_litter_fire => cnveg_carbonflux_inst%m_frootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_frootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_frootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_frootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livecrootc_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livecrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livecrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livecrootc_to_deadcrootc_fire => cnveg_carbonflux_inst%m_livecrootc_to_deadcrootc_fire_patch , & ! Output: [real(r8) (:) ] - m_deadcrootc_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_deadcrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_deadcrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_gresp_storage_to_litter_fire => cnveg_carbonflux_inst%m_gresp_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_gresp_xfer_to_litter_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_decomp_cpools_to_fire_vr => cnveg_carbonflux_inst%m_decomp_cpools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] (gC/m3/s) VR decomp. C fire loss - m_c_to_litr_met_fire => cnveg_carbonflux_inst%m_c_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] - m_c_to_litr_cel_fire => cnveg_carbonflux_inst%m_c_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] - m_c_to_litr_lig_fire => cnveg_carbonflux_inst%m_c_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] - - fire_mortality_n_to_cwdn => cnveg_nitrogenflux_inst%fire_mortality_n_to_cwdn_col , & ! Input: [real(r8) (:,:) ] N flux fire mortality to CWD (gN/m3/s) - m_leafn_to_fire => cnveg_nitrogenflux_inst%m_leafn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn - m_leafn_storage_to_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_storage - m_leafn_xfer_to_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_xfer - m_livestemn_to_fire => cnveg_nitrogenflux_inst%m_livestemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn - m_livestemn_storage_to_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_s - m_livestemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_xfer - m_deadstemn_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn - m_deadstemn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_storage - m_deadstemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_xfer - m_frootn_to_fire => cnveg_nitrogenflux_inst%m_frootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn - m_frootn_storage_to_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_storage - m_frootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_xfer - m_livecrootn_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. m_livecrootn_to_fire - m_livecrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_storage - m_livecrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_xfer - m_deadcrootn_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn - m_deadcrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_storage - m_deadcrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_xfer - m_retransn_to_fire => cnveg_nitrogenflux_inst%m_retransn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. retransn - m_leafn_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_leafn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_leafn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livestemn_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livestemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livestemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livestemn_to_deadstemn_fire => cnveg_nitrogenflux_inst%m_livestemn_to_deadstemn_fire_patch , & ! Output: [real(r8) (:) ] - m_deadstemn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_deadstemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_deadstemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_frootn_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_frootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_frootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livecrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livecrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livecrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_livecrootn_to_deadcrootn_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_deadcrootn_fire_patch , & ! Output: [real(r8) (:) ] - m_deadcrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_deadcrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_deadcrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_retransn_to_litter_fire => cnveg_nitrogenflux_inst%m_retransn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] - m_decomp_npools_to_fire_vr => cnveg_nitrogenflux_inst%m_decomp_npools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] VR decomp. N fire loss (gN/m3/s) - m_n_to_litr_met_fire => cnveg_nitrogenflux_inst%m_n_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] - m_n_to_litr_cel_fire => cnveg_nitrogenflux_inst%m_n_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] - m_n_to_litr_lig_fire => cnveg_nitrogenflux_inst%m_n_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] - ileaf_to_iout_fic => cnveg_carbonflux_inst%ileaf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf pool to outside of vegetation pools - ileafst_to_iout_fic => cnveg_carbonflux_inst%ileafst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf storage pool to outside of vegetation pools - ileafxf_to_iout_fic => cnveg_carbonflux_inst%ileafxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from leaf transfer pool to outside of vegetation pools - ifroot_to_iout_fic => cnveg_carbonflux_inst%ifroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root pool to outside of vegetation pools - ifrootst_to_iout_fic => cnveg_carbonflux_inst%ifrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root storage pool to outside of vegetation pools - ifrootxf_to_iout_fic => cnveg_carbonflux_inst%ifrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from fine root transfer pool to outside of vegetation pools - ilivestem_to_iout_fic => cnveg_carbonflux_inst%ilivestem_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem pool to outside of vegetation pools - ilivestemst_to_iout_fic => cnveg_carbonflux_inst%ilivestemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem storage pool to outside of vegetation pools - ilivestemxf_to_iout_fic => cnveg_carbonflux_inst%ilivestemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem transfer pool to outside of vegetation pools - ideadstem_to_iout_fic => cnveg_carbonflux_inst%ideadstem_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem pool to outside of vegetation pools - ideadstemst_to_iout_fic => cnveg_carbonflux_inst%ideadstemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem storage pool to outside of vegetation pools - ideadstemxf_to_iout_fic => cnveg_carbonflux_inst%ideadstemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead stem transfer pool to outside of vegetation pools - ilivecroot_to_iout_fic => cnveg_carbonflux_inst%ilivecroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to outside of vegetation pools - ilivecrootst_to_iout_fic => cnveg_carbonflux_inst%ilivecrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root storage pool to outside of vegetation pools - ilivecrootxf_to_iout_fic => cnveg_carbonflux_inst%ilivecrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root transfer pool to outside of vegetation pools - ideadcroot_to_iout_fic => cnveg_carbonflux_inst%ideadcroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root pool to outside of vegetation pools - ideadcrootst_to_iout_fic => cnveg_carbonflux_inst%ideadcrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root storage pool to outside of vegetation pools - ideadcrootxf_to_iout_fic => cnveg_carbonflux_inst%ideadcrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related C transfer from dead coarse root transfer pool to outside of vegetation pools - ilivestem_to_ideadstem_fic => cnveg_carbonflux_inst%ilivestem_to_ideadstem_fi , & ! Input: [integer (:)] Index of fire related C transfer from live stem pool to dead stem pool - ilivecroot_to_ideadcroot_fic => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_fi , & ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to dead coarse root pool - ileaf_to_iout_fin => cnveg_nitrogenflux_inst%ileaf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf pool to outside of vegetation pools - ileafst_to_iout_fin => cnveg_nitrogenflux_inst%ileafst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf storage pool to outside of vegetation pools - ileafxf_to_iout_fin => cnveg_nitrogenflux_inst%ileafxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from leaf transfer pool to outside of vegetation pools - ifroot_to_iout_fin => cnveg_nitrogenflux_inst%ifroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine root pool to outside of vegetation pools - ifrootst_to_iout_fin => cnveg_nitrogenflux_inst%ifrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine root storage pool to outside of vegetation pools - ifrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ifrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from fine transfer pool to outside of vegetation pools - ilivestem_to_iout_fin => cnveg_nitrogenflux_inst%ilivestem_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem pool to outside of vegetation pools - ilivestemst_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem storage pool to outside of vegetation pools - ilivestemxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem transfer pool to outside of vegetation pools - ideadstem_to_iout_fin => cnveg_nitrogenflux_inst%ideadstem_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem pool to outside of vegetation pools - ideadstemst_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem storage pool to outside of vegetation pools - ideadstemxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead stem transfer pool to outside of vegetation pools - ilivecroot_to_iout_fin => cnveg_nitrogenflux_inst%ilivecroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to outside of vegetation pools - ilivecrootst_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root storage pool to outside of vegetation pools - ilivecrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root transfer pool to outside of vegetation pools - ideadcroot_to_iout_fin => cnveg_nitrogenflux_inst%ideadcroot_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root pool to outside of vegetation pools - ideadcrootst_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root storage pool to outside of vegetation pools - ideadcrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_fi , & ! Input: [integer (:)] Index of fire related N transfer from dead coarse root transfer pool to outside of vegetation pools - ilivestem_to_ideadstem_fin => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_fi , & ! Input: [integer (:)] Index of fire related N transfer from live stem to dead stem pool - ilivecroot_to_ideadcroot_fin => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_fi , & ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to dead coarse root pool - iretransn_to_iout_fin => cnveg_nitrogenflux_inst%iretransn_to_iout_fi & ! Input: [integer (:)] Index of fire related N transfer from retranslocated N pool to outside of vegetation pools - ) - - transient_landcover = run_has_transient_landcover() - - ! Get model step size - ! calculate burned area fraction per sec - dt = get_step_size_real() - - dayspyr = get_days_per_year() - ! - ! patch loop - ! - num_actfirep = 0 - do fp = 1,num_soilp - p = filter_soilp(fp) - c = patch%column(p) - - if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8)then - ! For non-crop (bare-soil and natural vegetation) - if (transient_landcover) then - f = (fbac(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) - else - f = (farea_burned(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) - end if - else - ! For crops - if(cropf_col(c) > 0._r8)then - f = baf_crop(c) /cropf_col(c) - else - f = 0._r8 - end if - end if - - ! apply this rate to the patch state variables to get flux rates - ! biomass burning - ! carbon fluxes - m = spinup_factor_deadwood - - if(f /= 0)then - num_actfirep = num_actfirep + 1 - filter_actfirep(num_actfirep) = p - end if - m_gresp_storage_to_fire(p) = gresp_storage(p) * f * cc_other(patch%itype(p)) - m_gresp_xfer_to_fire(p) = gresp_xfer(p) * f * cc_other(patch%itype(p)) - if ( .not. use_matrixcn )then - ! NOTE: The non matrix version of this is in CNCStateUpdate3::CStateUpdate3 EBK (11/26/2019) - ! and CNNStateUpdate3::NStateUpdate3 - m_leafc_to_fire(p) = leafc(p) * f * cc_leaf(patch%itype(p)) - m_leafc_storage_to_fire(p) = leafc_storage(p) * f * cc_other(patch%itype(p)) - m_leafc_xfer_to_fire(p) = leafc_xfer(p) * f * cc_other(patch%itype(p)) - m_livestemc_to_fire(p) = livestemc(p) * f * cc_lstem(patch%itype(p)) - m_livestemc_storage_to_fire(p) = livestemc_storage(p) * f * cc_other(patch%itype(p)) - m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * f * cc_other(patch%itype(p)) - m_deadstemc_to_fire(p) = deadstemc(p) * f * cc_dstem(patch%itype(p)) * m - m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * f * cc_other(patch%itype(p)) - m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * f * cc_other(patch%itype(p)) - m_frootc_to_fire(p) = frootc(p) * f * 0._r8 - m_frootc_storage_to_fire(p) = frootc_storage(p) * f * cc_other(patch%itype(p)) - m_frootc_xfer_to_fire(p) = frootc_xfer(p) * f * cc_other(patch%itype(p)) - m_livecrootc_to_fire(p) = livecrootc(p) * f * 0._r8 - m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * f * cc_other(patch%itype(p)) - m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * f * cc_other(patch%itype(p)) - m_deadcrootc_to_fire(p) = deadcrootc(p) * f * 0._r8 - m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * f* cc_other(patch%itype(p)) - m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * f * cc_other(patch%itype(p)) - - - ! nitrogen fluxes - m_leafn_to_fire(p) = leafn(p) * f * cc_leaf(patch%itype(p)) - m_leafn_storage_to_fire(p) = leafn_storage(p) * f * cc_other(patch%itype(p)) - m_leafn_xfer_to_fire(p) = leafn_xfer(p) * f * cc_other(patch%itype(p)) - m_livestemn_to_fire(p) = livestemn(p) * f * cc_lstem(patch%itype(p)) - m_livestemn_storage_to_fire(p) = livestemn_storage(p) * f * cc_other(patch%itype(p)) - m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * f * cc_other(patch%itype(p)) - m_deadstemn_to_fire(p) = deadstemn(p) * f * cc_dstem(patch%itype(p)) * m - m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * f * cc_other(patch%itype(p)) - m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * f * cc_other(patch%itype(p)) - m_frootn_to_fire(p) = frootn(p) * f * 0._r8 - m_frootn_storage_to_fire(p) = frootn_storage(p) * f * cc_other(patch%itype(p)) - m_frootn_xfer_to_fire(p) = frootn_xfer(p) * f * cc_other(patch%itype(p)) - m_livecrootn_to_fire(p) = livecrootn(p) * f * 0._r8 - m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * f * cc_other(patch%itype(p)) - m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * f * cc_other(patch%itype(p)) - m_deadcrootn_to_fire(p) = deadcrootn(p) * f * 0._r8 - m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * f * cc_other(patch%itype(p)) - m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * f * cc_other(patch%itype(p)) - m_retransn_to_fire(p) = retransn(p) * f * cc_other(patch%itype(p)) - - else - m_leafc_to_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_storage_to_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_xfer_to_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_storage_to_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_to_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_to_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_storage_to_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_xfer_to_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_to_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - - m_leafn_to_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_storage_to_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_xfer_to_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_storage_to_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_to_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_to_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_storage_to_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_xfer_to_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_to_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_retransn_to_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - end if - ! mortality due to fire - ! carbon pools - if ( .not. use_matrixcn )then - ! NOTE: The non matrix version of this is in CNCStateUpdate3::CStateUpdate3 EBK (11/26/2019) - ! and CNNStateUpdate3::NStateUpdate3 - m_leafc_to_litter_fire(p) = leafc(p) * f * & - (1._r8 - cc_leaf(patch%itype(p))) * & - fm_leaf(patch%itype(p)) - m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter - ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) - m_livestemc_to_litter_fire(p) = livestemc(p) * f * & - (1._r8 - cc_lstem(patch%itype(p))) * & - fm_droot(patch%itype(p)) - m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent the fraction of plant-tissue mortality for deadstem/deadcroot - ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 - m_livestemc_to_deadstemc_fire(p) = livestemc(p) * f * & - (1._r8 - cc_lstem(patch%itype(p))) * & - (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) - ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from deadstem/deadcroot to litter - ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) - m_deadstemc_to_litter_fire(p) = deadstemc(p) * f * m * & - (1._r8 - cc_dstem(patch%itype(p))) * & - fm_droot(patch%itype(p)) - m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_frootc_to_litter_fire(p) = frootc(p) * f * & - fm_root(patch%itype(p)) - m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * f * & - (1._r8- cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * f * & - (1._r8- cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter - ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) - m_livecrootc_to_litter_fire(p) = livecrootc(p) * f * & - fm_droot(patch%itype(p)) - m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * f * & - (1._r8- cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * f * & - (1._r8- cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * f * & - (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) - m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * f * m * & - fm_droot(patch%itype(p)) - m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * f * & - (1._r8- cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * f * & - (1._r8- cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_gresp_storage_to_litter_fire(p) = gresp_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_gresp_xfer_to_litter_fire(p) = gresp_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - - - ! nitrogen pools - m_leafn_to_litter_fire(p) = leafn(p) * f * & - (1._r8 - cc_leaf(patch%itype(p))) * & - fm_leaf(patch%itype(p)) - m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter - ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) - m_livestemn_to_litter_fire(p) = livestemn(p) * f * & - (1._r8 - cc_lstem(patch%itype(p))) * & - fm_droot(patch%itype(p)) - m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent the fraction of plant-tissue mortality for deadstem/deadcroot - ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 - m_livestemn_to_deadstemn_fire(p) = livestemn(p) * f * & - (1._r8 - cc_lstem(patch%itype(p))) * & - (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) - ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from deadstem/deadcroot to litter - ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) - m_deadstemn_to_litter_fire(p) = deadstemn(p) * f * m * & - (1._r8 - cc_dstem(patch%itype(p))) * & - fm_droot(patch%itype(p)) - m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_frootn_to_litter_fire(p) = frootn(p) * f * & - fm_root(patch%itype(p)) - m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - ! NOTE: It looks incorrect to use fm_droot here, but it's used to represent fraction of transport from livestem/livecroot to litter - ! EBK Oct/06/2017 see bug 2516 http://bugs.cgd.ucar.edu/show_bug.cgi?id=2516 (stem and root live or dead assumed to have the same transport) - m_livecrootn_to_litter_fire(p) = livecrootn(p) * f * & - fm_droot(patch%itype(p)) - m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * f * & - (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) - m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * f * m * & - fm_droot(patch%itype(p)) - m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - m_retransn_to_litter_fire(p) = retransn(p) * f * & - (1._r8 - cc_other(patch%itype(p))) * & - fm_other(patch%itype(p)) - - else - m_leafc_to_litter_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic, & - f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_litter_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic, & - f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_deadstemc_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_ideadstem_fic,& - f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_to_litter_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic, & - f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_to_litter_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic, & - f * fm_root(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_litter_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic, & - f * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_ideadcroot_fic,& - f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic, & - f * m * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - - m_leafn_to_litter_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin, & - f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_litter_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin, & - f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_deadstemn_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_ideadstem_fin,& - f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_to_litter_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin, & - f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_to_litter_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin, & - f * fm_root(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_litter_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin, & - f * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_ideadcroot_fin,& - f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin, & - f * m * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - end if - - if (use_cndv) then - if ( woody(patch%itype(p)) == 1._r8 )then - if ( livestemc(p)+deadstemc(p) > 0._r8 )then - nind(p) = nind(p)*(1._r8-1._r8*fm_droot(patch%itype(p))*f) - else - nind(p) = 0._r8 - end if - end if - leafcmax(p) = max(leafc(p)-m_leafc_to_fire(p)*dt, leafcmax(p)) - if (patch%itype(p) == noveg) leafcmax(p) = 0._r8 - end if - - end do ! end of patches loop - - ! fire-induced transfer of carbon and nitrogen pools to litter and cwd - - do j = 1,nlevdecomp - do fp = 1, num_soilp - p = filter_soilp(fp) - c = patch%column(p) - - fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & - m_deadstemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) - fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & - m_deadcrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) - fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & - m_deadstemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) - fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & - m_deadcrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) - - - fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & - m_livestemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) - fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & - m_livecrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) - fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & - m_livestemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) - fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & - m_livecrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) - - - m_c_to_litr_met_fire(c,j)=m_c_to_litr_met_fire(c,j) + & - ((m_leafc_to_litter_fire(p)*lf_flab(patch%itype(p)) & - +m_leafc_storage_to_litter_fire(p) + & - m_leafc_xfer_to_litter_fire(p) + & - m_gresp_storage_to_litter_fire(p) & - +m_gresp_xfer_to_litter_fire(p))*leaf_prof(p,j) + & - (m_frootc_to_litter_fire(p)*fr_flab(patch%itype(p)) & - +m_frootc_storage_to_litter_fire(p) + & - m_frootc_xfer_to_litter_fire(p))*froot_prof(p,j) & - +(m_livestemc_storage_to_litter_fire(p) + & - m_livestemc_xfer_to_litter_fire(p) & - +m_deadstemc_storage_to_litter_fire(p) + & - m_deadstemc_xfer_to_litter_fire(p))* stem_prof(p,j)& - +(m_livecrootc_storage_to_litter_fire(p) + & - m_livecrootc_xfer_to_litter_fire(p) & - +m_deadcrootc_storage_to_litter_fire(p) + & - m_deadcrootc_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) - m_c_to_litr_cel_fire(c,j)=m_c_to_litr_cel_fire(c,j) + & - (m_leafc_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & - m_frootc_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) - m_c_to_litr_lig_fire(c,j)=m_c_to_litr_lig_fire(c,j) + & - (m_leafc_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & - m_frootc_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) - - m_n_to_litr_met_fire(c,j)=m_n_to_litr_met_fire(c,j) + & - ((m_leafn_to_litter_fire(p)*lf_flab(patch%itype(p)) & - +m_leafn_storage_to_litter_fire(p) + & - m_leafn_xfer_to_litter_fire(p)+m_retransn_to_litter_fire(p)) & - *leaf_prof(p,j) +(m_frootn_to_litter_fire(p)*fr_flab(patch%itype(p)) & - +m_frootn_storage_to_litter_fire(p) + & - m_frootn_xfer_to_litter_fire(p))*froot_prof(p,j) & - +(m_livestemn_storage_to_litter_fire(p) + & - m_livestemn_xfer_to_litter_fire(p) & - +m_deadstemn_storage_to_litter_fire(p) + & - m_deadstemn_xfer_to_litter_fire(p))* stem_prof(p,j)& - +(m_livecrootn_storage_to_litter_fire(p) + & - m_livecrootn_xfer_to_litter_fire(p) & - +m_deadcrootn_storage_to_litter_fire(p) + & - m_deadcrootn_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) - m_n_to_litr_cel_fire(c,j)=m_n_to_litr_cel_fire(c,j) + & - (m_leafn_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & - m_frootn_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) - m_n_to_litr_lig_fire(c,j)=m_n_to_litr_lig_fire(c,j) + & - (m_leafn_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & - m_frootn_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) - end do - end do - ! - ! vertically-resolved decomposing C/N fire loss - ! column loop - ! - num_actfirec = 0 - do fc = 1,num_soilc - c = filter_soilc(fc) - - f = farea_burned(c) - - if(f /= 0 .or. f /= baf_crop(c))then - num_actfirec = num_actfirec + 1 - filter_actfirec(num_actfirec) = c - end if - do j = 1, nlevdecomp - ! carbon fluxes - do l = 1, ndecomp_pools - if ( is_litter(l) ) then - m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * f * & - cmb_cmplt_fact_litter - if(use_soil_matrixcn)then! matrix is the same for C and N in the fire. - associate( & - matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] (gC/m3/step) VR deomp. C fire loss in matrix representation - ) - matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) & - - f * cmb_cmplt_fact_litter * dt - end associate - end if - end if - if ( is_cwd(l) ) then - m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * & - (f-baf_crop(c)) * cmb_cmplt_fact_cwd - if(use_soil_matrixcn)then - associate( & - matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] (gC/m3/step) VR deomp. C fire loss in matrix representation - ) - matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) & - - (f-baf_crop(c)) * cmb_cmplt_fact_cwd * dt - end associate - end if - end if - end do - - ! nitrogen fluxes - do l = 1, ndecomp_pools - if ( is_litter(l) ) then - m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * f * & - cmb_cmplt_fact_litter - end if - if ( is_cwd(l) ) then - m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * & - (f-baf_crop(c)) * cmb_cmplt_fact_cwd - end if - end do - - end do - end do ! end of column loop - - ! carbon loss due to deforestation fires - - if (transient_landcover) then - call get_curr_date (kyr, kmo, kda, mcsec) - do fc = 1,num_soilc - c = filter_soilc(fc) - lfc2(c)=0._r8 - if( .not. (kmo == 1 .and. kda == 1 .and. mcsec == 0) )then - if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 .and. dtrotr_col(c) > 0._r8 .and. & - lfc(c) > 0._r8 .and. fbac1(c) == 0._r8) then - lfc2(c) = max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & - baf_peatf(c))/2.0*dt))/(dtrotr_col(c)*dayspyr*secspday/dt)/dt - lfc(c) = lfc(c) - max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & - baf_peatf(c))*dt/2.0_r8)) - end if - end if - end do - end if - ! - ! Carbon loss due to peat fires - ! - ! somc_fire is not connected to clm45 soil carbon pool, ie does not decrease - ! soil carbon b/c clm45 soil carbon was very low in several peatland grids - ! - do fc = 1,num_soilc - c = filter_soilc(fc) - g = col%gridcell(c) - if( grc%latdeg(g) < cnfire_const%borealat)then - somc_fire(c)= totsomc(c)*baf_peatf(c)*6.0_r8/33.9_r8 - else - somc_fire(c)= baf_peatf(c)*2.2e3_r8 - end if - end do - - ! Fang Li has not added aerosol and trace gas emissions due to fire, yet - ! They will be added here in proportion to the carbon emission - ! Emission factors differ for various fire types - - end associate - - end subroutine CNFireFluxes - - !----------------------------------------------------------------------- - subroutine CNFireReadParams( this, ncid ) - ! - ! Read in the constant parameters from the input NetCDF parameter file - ! !USES: - use ncdio_pio , only: file_desc_t - use paramUtilMod, only: readNcdioScalar - ! - ! !ARGUMENTS: - implicit none - class(cnfire_base_type) :: this - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - ! - ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'CNFireReadParams' - !-------------------------------------------------------------------- - - ! Factor related to dependence of fuel combustibility on 30-day running mean of relative humidity (unitless) - call readNcdioScalar(ncid, 'prh30', subname, cnfire_params%prh30) - ! Ignition efficiency of cloud-to-ground lightning (unitless) - call readNcdioScalar(ncid, 'ignition_efficiency', subname, cnfire_params%ignition_efficiency) - - end subroutine CNFireReadParams - -end module CNFireBaseMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 new file mode 100755 index 000000000..5046ce5f4 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 @@ -0,0 +1,288 @@ +module CNFireEmissionsMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Gathers carbon emissions from fire sources to be sent to CAM-Chem via + ! the coupler .... + ! Created by F. Vitt, and revised by F. Li + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils, only : endrun + use PatchType, only : patch + use decompMod, only : bounds_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNFireEmisUpdate + public :: init_fireemis_type + ! + ! !PRIVATE TYPES: + type, private :: emis_t + real(r8), pointer :: emis(:) + end type emis_t + ! + ! !PUBLIC TYPES: + type, public :: fireemis_type + real(r8), pointer, public :: fireflx_patch(:,:) ! carbon flux from fire sources (kg/m2/sec) + real(r8), pointer, public :: ztop_patch(:) ! height of the smoke plume (meters) + type(emis_t), pointer, private :: comp(:) ! fire emissions component (corresponds to emis factors table input file) + type(emis_t), pointer, private :: mech(:) ! cam-chem mechism species emissions + type(emis_t), private :: totfire ! sum of all species emissions + + end type fireemis_type + + integer :: shr_fire_emis_mechcomps_n = 0 + + !------------------------------------------------------------------------ +contains + + + !----------------------------------------------------------------------- + subroutine init_fireemis_type(bounds, this) + ! + ! Allocate memory for module datatypes + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varcon , only : spval + + ! !ARGUMENTS: + type(fireemis_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: beg, end, i + !--------------------------------------------------------------------- + + beg = bounds%begp + end = bounds%endp + + allocate(this%totfire%emis(beg:end)) + this%totfire%emis(beg:end) = nan + + if (shr_fire_emis_mechcomps_n>0) then + allocate(this%ztop_patch(beg:end)) + this%ztop_patch(beg:end) = spval + + allocate(this%fireflx_patch(beg:end,shr_fire_emis_mechcomps_n)) + this%fireflx_patch(beg:end,:) = spval + + allocate(this%mech(shr_fire_emis_mechcomps_n)) + do i = 1, shr_fire_emis_mechcomps_n + allocate(this%mech(i)%emis(beg:end)) + this%mech(i)%emis(beg:end) = nan + enddo + endif + + if (shr_fire_emis_comps_n>0) then + allocate(this%comp(shr_fire_emis_comps_n)) + do i = 1, shr_fire_emis_comps_n + allocate(this%comp(i)%emis(beg:end)) + this%comp(i)%emis(beg:end) = nan + enddo + endif + + end subroutine init_fireemis_type + + !----------------------------------------------------------------------- + subroutine CNFireEmisUpdate(bounds, num_soilp, filter_soilp, cnveg_cf_inst, cnveg_cs_inst, fireemis_inst ) + + use CNVegcarbonfluxType, only : cnveg_carbonflux_type + use CNVegCarbonStateType, only : cnveg_carbonstate_type + use clm_varpar, only : ndecomp_pools, nlevdecomp + use clm_varcon, only : dzsoi_decomp + + !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts + type(cnveg_carbonflux_type), intent(in) :: cnveg_cf_inst + type(cnveg_carbonstate_type),intent(in) :: cnveg_cs_inst + type(fireemis_type), intent(inout) :: fireemis_inst + + !LOCAL VARIABLES: + real(r8) :: fire_flux + real(r8) :: fire_flux_lf + real(r8) :: fire_flux_lf1 + type(shr_fire_emis_comp_t), pointer :: emis_cmp + real(r8) :: emis_flux(shr_fire_emis_comps_n) + integer :: fp,p,g,c ! indices + real(r8) :: epsilon ! emission factor [ug m-2 h-1] + integer :: i, ii, icomp, imech, n_emis_comps, l, j + + if ( shr_fire_emis_mechcomps_n < 1) return + + associate( & + fire_emis => fireemis_inst%fireflx_patch, & + totfire => fireemis_inst%totfire, & + mech => fireemis_inst%mech, & + comp => fireemis_inst%comp, & + ztop => fireemis_inst%ztop_patch & + ) + + ! initialize to zero ... + fire_emis(bounds%begp:bounds%endp,:) = 0._r8 + totfire%emis(bounds%begp:bounds%endp) = 0._r8 + ztop(bounds%begp:bounds%endp) = 0._r8 + + do i = 1, shr_fire_emis_mechcomps_n + mech(i)%emis(bounds%begp:bounds%endp) = 0._r8 + enddo + + do i = 1, shr_fire_emis_comps_n + comp(i)%emis(bounds%begp:bounds%endp) = 0._r8 + enddo + + ! Begin loop over points + !_______________________________________________________________________________ + do fp = 1,num_soilp + p = filter_soilp(fp) + g = patch%gridcell(p) + c = patch%column(p) + + ! initialize EF + epsilon=0._r8 + emis_flux(:) = 0._r8 + + ! calculate fire emissions for non-bare ground PFTs + if (patch%itype(p) > 0)then + if(cnveg_cs_inst%totvegc_col(c) > 0._r8)then + fire_flux_lf1=0._r8 + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + fire_flux_lf1 = fire_flux_lf1 + & + cnveg_cf_inst%m_decomp_cpools_to_fire_vr_col(c,j,l)*dzsoi_decomp(j) + enddo + end do + fire_flux_lf = fire_flux_lf1*cnveg_cs_inst%totvegc_patch(p)/cnveg_cs_inst%totvegc_col(c) + else + fire_flux_lf=0._r8 + end if + fire_flux = fire_flux_lf & + + cnveg_cf_inst%m_leafc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from leafc + + cnveg_cf_inst%m_leafc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from leafc_storage + + cnveg_cf_inst%m_leafc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from leafc_xfer + + cnveg_cf_inst%m_livestemc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livestemc + + cnveg_cf_inst%m_livestemc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livestemc_storage + + cnveg_cf_inst%m_livestemc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livestemc_xfer + + cnveg_cf_inst%m_deadstemc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadstemc_xfer + + cnveg_cf_inst%m_deadstemc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadstemc_storage + + cnveg_cf_inst%m_deadstemc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadstemc_xfer + + cnveg_cf_inst%m_frootc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from frootc + + cnveg_cf_inst%m_frootc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from frootc_storage + + cnveg_cf_inst%m_frootc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from frootc_xfer + + cnveg_cf_inst%m_livecrootc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livecrootc + + cnveg_cf_inst%m_livecrootc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livecrootc_storage + + cnveg_cf_inst%m_livecrootc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livecrootc_xfer + + cnveg_cf_inst%m_deadcrootc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadcrootc + + cnveg_cf_inst%m_deadcrootc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadcrootc_storage + + cnveg_cf_inst%m_deadcrootc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadcrootc_xfer + + cnveg_cf_inst%m_gresp_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from gresp_storage + + cnveg_cf_inst%m_gresp_xfer_to_fire_patch (p) ! (gC/m2/s) fire C emissions from gresp_xfer + ! for diagnostics + totfire%emis(p) = fire_flux ! gC/m2/sec + + ! loop over fire components + emis_cmp => shr_fire_emis_linkedlist + emis_cmp_loop: do while(associated(emis_cmp)) + + icomp = emis_cmp%index + epsilon = emis_cmp%emis_factors(patch%itype(p)) + + comp(icomp)%emis(p) = epsilon * fire_flux* 1.e-3_r8/0.5_r8 ! (to convert gC/m2/sec to kg species/m2/sec) + emis_flux(icomp) = emis_cmp%coeff*comp(icomp)%emis(p) + + emis_cmp => emis_cmp%next_emiscomp + + enddo emis_cmp_loop + + ! sum up the emissions compontent fluxes for the fluxes of chem mechanism compounds + do imech = 1,shr_fire_emis_mechcomps_n + n_emis_comps = shr_fire_emis_mechcomps(imech)%n_emis_comps + do icomp = 1,n_emis_comps ! loop over number of emission components that make up the nth mechanism compoud + ii = shr_fire_emis_mechcomps(imech)%emis_comps(icomp)%ptr%index + fire_emis(p,imech) = fire_emis(p,imech) + emis_flux(ii) + mech(imech)%emis(p) = fire_emis(p,imech) + enddo + enddo + + ztop(p) = vert_dist_top( patch%itype(p) ) + + end if ! ivt(1:15 only) + + enddo ! fp + end associate + + end subroutine CNFireEmisUpdate + +! Private methods +!----------------------------------------------------------------------- +!ztop compiled from Val Martin et al ACP 2010, Tosca et al. JGR 2011 and Jian et al., ACP 2013 +!st ztop updated based on Val Martin pers. communication Jan2015 +!----------------------------------------------------------------------- +! not_vegetated 500 m +!PFT1: needleleaf_evergreen_temperate_tree 4000 m +!2: needleleaf_evergreen_boreal_tree 4000 m +!3: needleleaf_deciduous_boreal_tree 3000 m +!4: broadleaf_evergreen_tropical_tree 2500 m +!5: broadleaf_evergreen_temperate_tree 3000 m +!6: broadleaf_deciduous_tropical_tree 2500 m +!7: broadleaf_deciduous_temperate_tree 3000 m +!8: broadleaf_deciduous_boreal_tree 3000 m +!9: broadleaf_evergreen_shrub 2000 m +!10: broadleaf_deciduous_temperate_shrub 2000 m +!11: broadleaf_deciduous_boreal_shrub 2000 m +!12: c3_arctic_grass 1000 m +!13: c3_non-arctic_grass 1000 m +!14: c4_grass 1000 m +!15: c3_crop 1000 m +!(and all new crops: 1000m) + + function vert_dist_top( veg_type ) result(ztop) + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use pftconMod , only : noveg, ndllf_evr_tmp_tree, ndllf_evr_brl_tree + use pftconMod , only : ndllf_dcd_brl_tree, nbrdlf_evr_tmp_tree + use pftconMod , only : nbrdlf_dcd_tmp_tree, nbrdlf_dcd_brl_tree + use pftconMod , only : nbrdlf_evr_trp_tree, nbrdlf_dcd_trp_tree + use pftconMod , only : nbrdlf_evr_shrub, nbrdlf_dcd_brl_shrub + use pftconMod , only : nc3_arctic_grass, nc3_nonarctic_grass + use pftconMod , only : nc3crop, nc3irrig + use pftconMod , only : npcropmin, npcropmax + implicit none + integer, intent(in) :: veg_type + + real(r8) :: ztop + + ! Bare soil, won't be used + if ( veg_type == noveg ) then + ztop = nan + ! temperate and boreal evergreen needleleaf trees + else if ( veg_type == ndllf_evr_tmp_tree .or. veg_type == ndllf_evr_brl_tree ) then + ztop = 4.e3_r8 ! m + ! temperate and boreal trees + else if ( veg_type == ndllf_dcd_brl_tree .or. veg_type == nbrdlf_evr_tmp_tree .or. & + veg_type == nbrdlf_dcd_tmp_tree .or. veg_type == nbrdlf_dcd_brl_tree ) then + ztop = 3.e3_r8 ! m + ! tropical broadleaf trees (evergreen and decidious) + else if ( veg_type == nbrdlf_evr_trp_tree .or. veg_type == nbrdlf_dcd_trp_tree ) then + ztop = 2.5e3_r8 ! m + ! shrubs + else if ( veg_type >= nbrdlf_evr_shrub .and. veg_type <= nbrdlf_dcd_brl_shrub ) then + ztop = 2.e3_r8 ! m + ! grasses + else if ( veg_type >= nc3_arctic_grass .and. veg_type <= nc3_nonarctic_grass ) then + ztop = 1.e3_r8 ! m + ! generic unmanaged crops + else if ( veg_type == nc3crop .or. veg_type <= nc3irrig ) then + ztop = 1.e3_r8 ! m + ! Prognostic crops + else if ( veg_type >= npcropmin .and. veg_type <= npcropmax ) then + ztop = 1.e3_r8 ! m + else + call endrun('ERROR:: undefined veg_type' ) + end if + + end function vert_dist_top + +end module CNFireEmissionsMod + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 index e87fac728..cc2ec215b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 @@ -329,9 +329,9 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ end do ! This subroutine calculates btran2 - call this%CNFire_calc_fire_root_wetness_Li2014(bounds, & - num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + ! call this%CNFire_calc_fire_root_wetness_Li2014(bounds, & + ! num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + ! waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) do fp = 1, num_exposedvegp p = filter_exposedvegp(fp) c = patch%column(p) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 index afd661cd2..74ac5e744 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 @@ -348,9 +348,9 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ end do ! This subroutine calculates btran2 - call this%CNFire_calc_fire_root_wetness_Li2014(bounds, & - num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + ! call this%CNFire_calc_fire_root_wetness_Li2014(bounds, & + ! num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + ! waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) do fp = 1, num_exposedvegp p = filter_exposedvegp(fp) c = patch%column(p) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 index aa61e291e..1fc851c46 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 @@ -347,9 +347,9 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ end do ! This subroutine calculates btran2 - call this%CNFire_calc_fire_root_wetness_Li2021(bounds, & - num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + ! call this%CNFire_calc_fire_root_wetness_Li2021(bounds, & + ! num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + ! waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) do fp = 1, num_exposedvegp p = filter_exposedvegp(fp) c = patch%column(p) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 index 02942365e..a7c3a56d6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 @@ -12,7 +12,7 @@ module CN_DriverMod !--------------------------------- subroutine CN_Driver(nch,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& rzm,sfm,tm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& - abm,peatf,hdm,lnfm) + abm,peatf,hdm,lnfm,poros,rh30) use CNCLM_decompMod, only : bounds use CNCLM_filterMod, only : filter @@ -54,6 +54,8 @@ subroutine CN_Driver(nch,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& real, dimension(nch), intent(in) :: peatf ! Fraction of peatland, unitless (0-1) real, dimension(nch), intent(in) :: hdm ! Human population density in 2010 (individual/km2) real, dimension(nch), intent(in) :: lnfm ! Lightning frequency [Flashes/km^2/day] + real, dimension(nch), intent(in) :: poros ! porosity + real, dimension(nch), intent(in) :: rh30 ! 30-day running mean of relative humidity !LOCAL @@ -92,7 +94,8 @@ subroutine CN_Driver(nch,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& temperature_inst%t_soisno_col(n,-nlevsno+1:nlevmaxurbgrnd) = tp1(nc) ! jkolassa: only one soil and no snow column at this point (may change in future) temperature_inst%t_grnd_col(n) = temperature_inst%t_soisno_col(n) temperature_inst%t_soi17cm_col(n) = temperature_inst%t_grnd_col(n) - soilstate_inst%soilpsi_col(n,nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point + soilstate_inst%soilpsi_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point + soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd) = poros(nc) atm2lnd_inst%forc_t_downscaled_col(n) = tm(nc) wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) @@ -117,6 +120,7 @@ subroutine CN_Driver(nch,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) + wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) end do ! np end do ! nz end do ! nc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 6c8c9afd7..f6e249181 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -46,6 +46,10 @@ module CN_initMod use Wateratm2lndBulkType use CNCLM_WaterDiagnosticBulkType use Wateratm2lndType + use EnergyFluxType + use SaturatedExcessRunoffMod + use WaterStateBulkType + use WaterStateType use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn @@ -121,6 +125,10 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(dgvs_type) :: dgvs_inst type(fire_method_type) :: cnfire_method type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst + type(energyflux_type) :: energyflux_inst + type(waterstatebulk_type) :: waterstatebulk_inst + type(waterstate_type) :: waterstate_inst + character(300) :: paramfile type(Netcdf4_fileformatter) :: ncid @@ -163,7 +171,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) ! read parameters and configurations from namelist file call CNPhenologyReadNML ( NLFilename ) - call dynSubgridControl_init ( NLFilename ) + call dynSubgridControl_init ( ) call CNFireReadNML ( NLFilename ) ! initialize states and fluxes @@ -232,6 +240,12 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_saturated_excess_runoff_type(bounds, saturated_excess_runoff_inst) + call init_energyflux_type (bounds, energyflux_inst) + + call init_waterstatebulk_type (bounds, waterstatebulk_inst) + + call init_waterstate_type (bounds, waterstate_inst) + call create_cnfire_method(cnfire_method) call cnfire_method%FireInit(bounds) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilWaterRetentionCurveMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilWaterRetentionCurveMod.F90 new file mode 100755 index 000000000..74f8299d5 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilWaterRetentionCurveMod.F90 @@ -0,0 +1,111 @@ +module SoilWaterRetentionCurveMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abstract base class for functions to compute soil water retention curve + ! + ! !USES: + implicit none + save + private + ! + ! !PUBLIC TYPES: + public :: soil_water_retention_curve_type + + type, abstract :: soil_water_retention_curve_type + private + contains + ! compute hydraulic conductivity + procedure(soil_hk_interface), deferred :: soil_hk + + ! compute soil suction potential + procedure(soil_suction_interface), deferred :: soil_suction + + ! compute relative saturation at which soil suction is equal to a target value + procedure(soil_suction_inverse_interface), deferred :: soil_suction_inverse + end type soil_water_retention_curve_type + + abstract interface + + ! Note: The following interfaces are set up based on the arguments needed for the + ! clapphornberg1978 implementations. It's likely that these interfaces are not + ! totally general for all desired implementations. In that case, we'll need to think + ! about how to support different interfaces. Some possible solutions are: + ! + ! - Make the interfaces contain all possible inputs that are needed by any + ! implementation; each implementation will then ignore the inputs it doesn't need. + ! + ! - For inputs that are needed only by particular implementations - and particularly + ! for inputs that are constant in time (e.g., this is the case for bsw, I think): + ! pass these into the constructor, and save pointers to these inputs as components + ! of the child type that needs them. Then they aren't needed as inputs to the + ! individual routines, allowing the interfaces for these routines to remain more + ! consistent between different implementations. + + subroutine soil_hk_interface(this, c, j, s, imped, soilstate_inst, & + hk, dhkds) + + ! !DESCRIPTION: + ! Compute hydraulic conductivity + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use SoilStateType , only : soilstate_type + import :: soil_water_retention_curve_type + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_type), intent(in) :: this + integer, intent(in) :: c !column index + integer, intent(in) :: j !level index + real(r8), intent(in) :: s !relative saturation, [0, 1] + real(r8), intent(in) :: imped !ice impedance + type(soilstate_type), intent(in) :: soilstate_inst + real(r8), intent(out):: hk !hydraulic conductivity [mm/s] + real(r8), optional, intent(out):: dhkds !d[hk]/ds [mm/s] + end subroutine soil_hk_interface + + + subroutine soil_suction_interface(this, c, j, s, soilstate_inst, & + smp, dsmpds) + + ! !DESCRIPTION: + ! Compute soil suction potential + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use SoilStateType , only : soilstate_type + import :: soil_water_retention_curve_type + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_type), intent(in) :: this + integer, intent(in) :: c !column index + integer, intent(in) :: j !level index + real(r8), intent(in) :: s !relative saturation, [0, 1] + type(soilstate_type), intent(in) :: soilstate_inst + real(r8), intent(out) :: smp !soil suction, negative, [mm] + real(r8), optional, intent(out) :: dsmpds !d[smp]/ds, [mm] + end subroutine soil_suction_interface + + subroutine soil_suction_inverse_interface(this, c, j, smp_target, & + soilstate_inst, s_target) + ! !DESCRIPTION: + ! Compute relative saturation at which soil suction is equal to a target value. + ! This is done by inverting the soil_suction equation to solve for s. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use SoilStateType , only : soilstate_type + import :: soil_water_retention_curve_type + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_type), intent(in) :: this + integer, intent(in) :: c !column index + integer, intent(in) :: j !level index + real(r8), intent(in) :: smp_target ! target soil suction, negative [mm] + type(soilstate_type), intent(in) :: soilstate_inst + real(r8) , intent(out) :: s_target ! relative saturation at which smp = smp_target [0,1] + end subroutine soil_suction_inverse_interface + + end interface + +end module SoilWaterRetentionCurveMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/dynSubgridControlMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/dynSubgridControlMod.F90 deleted file mode 100755 index b4da85be7..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/dynSubgridControlMod.F90 +++ /dev/null @@ -1,417 +0,0 @@ -module dynSubgridControlMod - - !--------------------------------------------------------------------------- - ! - ! !DESCRIPTION: - ! Defines a class for storing and querying control flags related to dynamic subgrid - ! operation. - ! - ! Note that this is implemented (essentially) as a singleton, so the only instance of - ! this class is stored in this module. This is done for convenience, to avoid having to - ! pass around the single instance just to query these control flags. - ! - ! !USES: -#include "shr_assert.h" - use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun - use clm_varctl , only : fname_len - ! - implicit none - private - ! - ! !PUBLIC MEMBER FUNCTIONS: - public :: dynSubgridControl_init - public :: get_flanduse_timeseries ! return the value of the flanduse_timeseries file name - public :: get_do_transient_pfts ! return the value of the do_transient_pfts control flag - public :: get_do_transient_crops ! return the value of the do_transient_crops control flag - public :: get_do_transient_lakes ! return the value of the do_transient_lakes control flag - public :: run_has_transient_landcover ! returns true if any aspects of prescribed transient landcover are enabled - public :: get_do_harvest ! return the value of the do_harvest control flag - public :: get_reset_dynbal_baselines ! return the value of the reset_dynbal_baselines control flag - public :: get_for_testing_allow_non_annual_changes ! return true if user has requested to allow area changes at times other than the year boundary, for testing purposes - public :: get_for_testing_zero_dynbal_fluxes ! return true if user has requested to set the dynbal water and energy fluxes to zero, for testing purposes - ! - ! !PRIVATE MEMBER FUNCTIONS: - private :: read_namelist ! read namelist variables - private :: check_namelist_consistency ! check consistency of namelist settings - ! - ! !PRIVATE TYPES: - type dyn_subgrid_control_type - private - character(len=fname_len) :: flanduse_timeseries = ' ' ! transient landuse dataset - logical :: do_transient_pfts = .false. ! whether to apply transient natural PFTs from dataset - logical :: do_transient_crops = .false. ! whether to apply transient crops from dataset - logical :: do_transient_lakes = .false. ! whether to apply transient lakes from dataset - logical :: do_harvest = .false. ! whether to apply harvest from dataset - - logical :: reset_dynbal_baselines = .false. ! whether to reset baseline values of total column water and energy in the first step of the run - - ! The following is only meant for testing: Whether area changes are allowed at times - ! other than the year boundary. This should only arise in some test configurations - ! where we artificially create changes more frequently so that we can run short - ! tests. This flag is only used for error-checking, not controlling any model - ! behavior. - logical :: for_testing_allow_non_annual_changes = .false. - - ! The following is only meant for testing: If .true., set the dynbal water and - ! energy fluxes to zero. This is needed in some tests where we have daily rather - ! than annual glacier dynamics: if we allow the true dynbal adjustment fluxes in - ! those tests, we end up with sensible heat fluxes of thousands of W m-2 or more, - ! which causes CAM to blow up. However, note that setting it to true will break - ! water and energy conservation! - logical :: for_testing_zero_dynbal_fluxes = .false. - - logical :: initialized = .false. ! whether this object has been initialized - end type dyn_subgrid_control_type - - type(dyn_subgrid_control_type) :: dyn_subgrid_control_inst - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - -contains - - !----------------------------------------------------------------------- - subroutine dynSubgridControl_init( NLFilename ) - ! - ! !DESCRIPTION: - ! Initialize the dyn_subgrid_control settings. - ! - ! !USES: - use spmdMod , only : masterproc - ! - ! !ARGUMENTS: - character(len=*), intent(in) :: NLFilename ! Namelist filename - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'dynSubgridControl_init' - !----------------------------------------------------------------------- - - call read_namelist( NLFilename ) - if (masterproc) then - call check_namelist_consistency - end if - - dyn_subgrid_control_inst%initialized = .true. - - end subroutine dynSubgridControl_init - - !----------------------------------------------------------------------- - subroutine read_namelist( NLFilename ) - ! - ! !DESCRIPTION: - ! Read dyn_subgrid_control namelist variables - ! - ! !USES: - use fileutils , only : getavu, relavu - use clm_nlUtilsMod , only : find_nlgroup_name - use clm_varctl , only : iulog - use spmdMod , only : masterproc, mpicom - use shr_mpi_mod , only : shr_mpi_bcast - ! - ! !ARGUMENTS: - character(len=*), intent(in) :: NLFilename ! Namelist filename - ! - ! !LOCAL VARIABLES: - ! temporary variables corresponding to the components of dyn_subgrid_control_type: - character(len=fname_len) :: flanduse_timeseries - logical :: do_transient_pfts - logical :: do_transient_crops - logical :: do_transient_lakes - logical :: do_harvest - logical :: reset_dynbal_baselines - logical :: for_testing_allow_non_annual_changes - logical :: for_testing_zero_dynbal_fluxes - ! other local variables: - integer :: nu_nml ! unit for namelist file - integer :: nml_error ! namelist i/o error flag - - character(len=*), parameter :: subname = 'read_namelist' - !----------------------------------------------------------------------- - - namelist /dynamic_subgrid/ & - flanduse_timeseries, & - do_transient_pfts, & - do_transient_crops, & - do_transient_lakes, & - do_harvest, & - reset_dynbal_baselines, & - for_testing_allow_non_annual_changes, & - for_testing_zero_dynbal_fluxes - - ! Initialize options to default values, in case they are not specified in the namelist - flanduse_timeseries = ' ' - do_transient_pfts = .false. - do_transient_crops = .false. - do_transient_lakes = .false. - do_harvest = .false. - reset_dynbal_baselines = .false. - for_testing_allow_non_annual_changes = .false. - for_testing_zero_dynbal_fluxes = .false. - - if (masterproc) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call find_nlgroup_name(nu_nml, 'dynamic_subgrid', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=dynamic_subgrid, iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg='ERROR reading dynamic_subgrid namelist'//errMsg(sourcefile, __LINE__)) - end if - else - call endrun(msg='ERROR finding dynamic_subgrid namelist'//errMsg(sourcefile, __LINE__)) - end if - close(nu_nml) - call relavu( nu_nml ) - endif - - call shr_mpi_bcast (flanduse_timeseries, mpicom) - call shr_mpi_bcast (do_transient_pfts, mpicom) - call shr_mpi_bcast (do_transient_crops, mpicom) - call shr_mpi_bcast (do_transient_lakes, mpicom) - call shr_mpi_bcast (do_harvest, mpicom) - call shr_mpi_bcast (reset_dynbal_baselines, mpicom) - call shr_mpi_bcast (for_testing_allow_non_annual_changes, mpicom) - call shr_mpi_bcast (for_testing_zero_dynbal_fluxes, mpicom) - - dyn_subgrid_control_inst = dyn_subgrid_control_type( & - flanduse_timeseries = flanduse_timeseries, & - do_transient_pfts = do_transient_pfts, & - do_transient_crops = do_transient_crops, & - do_transient_lakes = do_transient_lakes, & - do_harvest = do_harvest, & - reset_dynbal_baselines = reset_dynbal_baselines, & - for_testing_allow_non_annual_changes = for_testing_allow_non_annual_changes, & - for_testing_zero_dynbal_fluxes = for_testing_zero_dynbal_fluxes) - - if (masterproc) then - write(iulog,*) ' ' - write(iulog,*) 'dynamic_subgrid settings:' - write(iulog,nml=dynamic_subgrid) - write(iulog,*) ' ' - end if - - end subroutine read_namelist - - !----------------------------------------------------------------------- - subroutine check_namelist_consistency - ! - ! !DESCRIPTION: - ! Check consistency of namelist settings - ! - ! !USES: - use shr_kind_mod, only: r8 => shr_kind_r8 - use clm_varctl, only : iulog, use_cndv, use_fates, use_cn, use_crop, & - n_dom_pfts, n_dom_landunits, collapse_urban, & - toosmall_soil, toosmall_crop, toosmall_glacier, & - toosmall_lake, toosmall_wetland, toosmall_urban - ! - ! !ARGUMENTS: - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'check_namelist_consistency' - !----------------------------------------------------------------------- - - if (dyn_subgrid_control_inst%flanduse_timeseries == ' ') then - if (dyn_subgrid_control_inst%do_transient_pfts) then - write(iulog,*) 'ERROR: do_transient_pfts can only be true if you are running with' - write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (dyn_subgrid_control_inst%do_transient_crops) then - write(iulog,*) 'ERROR: do_transient_crops can only be true if you are running with' - write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (dyn_subgrid_control_inst%do_transient_lakes) then - write(iulog,*) 'ERROR: do_transient_lakes can only be true if you are running with' - write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (dyn_subgrid_control_inst%do_harvest) then - write(iulog,*) 'ERROR: do_harvest can only be true if you are running with' - write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if - - if (dyn_subgrid_control_inst%do_transient_pfts) then - if (use_cndv) then - write(iulog,*) 'ERROR: do_transient_pfts is incompatible with use_cndv' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (use_fates) then - write(iulog,*) 'ERROR: do_transient_pfts is incompatible with use_fates' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if - - ! NOTE(wjs, 2020-08-23) In the following error checks, I'm treating do_transient_lakes - ! similar to do_transient_pfts and do_transient_crops. I'm not sure if all of these - ! checks are truly important for transient lakes (in particular, my guess is that - ! collapse_urban could probably be done with transient lakes - as well as transient - ! pfts and transient crops for that matter), but some of the checks probably are - ! needed, and it seems best to keep transient lakes consistent with other transient - ! areas in this respect. - if (dyn_subgrid_control_inst%do_transient_pfts .or. & - dyn_subgrid_control_inst%do_transient_crops .or. & - dyn_subgrid_control_inst%do_transient_lakes) then - if (collapse_urban) then - write(iulog,*) 'ERROR: do_transient_pfts, do_transient_crops and do_transient_lakes are & - incompatible with collapse_urban = .true.' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (n_dom_pfts > 0 .or. n_dom_landunits > 0 & - .or. toosmall_soil > 0._r8 .or. toosmall_crop > 0._r8 & - .or. toosmall_glacier > 0._r8 .or. toosmall_lake > 0._r8 & - .or. toosmall_wetland > 0._r8 .or. toosmall_urban > 0._r8) then - write(iulog,*) 'ERROR: do_transient_pfts, do_transient_crops and do_transient_lakes are & - incompatible with any of the following set to > 0: & - n_dom_pfts > 0, n_dom_landunits > 0, & - toosmall_soil > 0._r8, toosmall_crop > 0._r8, & - toosmall_glacier > 0._r8, toosmall_lake > 0._r8, & - toosmall_wetland > 0._r8, toosmall_urban > 0._r8.' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if - - if (dyn_subgrid_control_inst%do_transient_crops) then - if (use_fates) then - ! NOTE(wjs, 2017-01-13) ED / FATES does not currently have a mechanism for - ! changing its column areas, with the consequent changes in aboveground biomass - ! per unit area. See https://github.com/NGEET/ed-clm/issues/173 - write(iulog,*) 'ERROR: do_transient_crops does not currently work with use_fates' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if - - if (dyn_subgrid_control_inst%do_harvest) then - if (.not. (use_cn .or. use_fates)) then - write(iulog,*) 'ERROR: do_harvest can only be true if either use_cn or use_fates are true' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if - - end subroutine check_namelist_consistency - - !----------------------------------------------------------------------- - character(len=fname_len) function get_flanduse_timeseries() - ! !DESCRIPTION: - ! Return the value of the flanduse_timeseries file name - - character(len=*), parameter :: subname = 'get_flanduse_timeseries' - !----------------------------------------------------------------------- - - SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) - - get_flanduse_timeseries = dyn_subgrid_control_inst%flanduse_timeseries - - end function get_flanduse_timeseries - - !----------------------------------------------------------------------- - logical function get_do_transient_pfts() - ! !DESCRIPTION: - ! Return the value of the do_transient_pfts control flag - !----------------------------------------------------------------------- - - SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) - - get_do_transient_pfts = dyn_subgrid_control_inst%do_transient_pfts - - end function get_do_transient_pfts - - !----------------------------------------------------------------------- - logical function get_do_transient_crops() - ! !DESCRIPTION: - ! Return the value of the do_transient_crops control flag - !----------------------------------------------------------------------- - - SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) - - get_do_transient_crops = dyn_subgrid_control_inst%do_transient_crops - - end function get_do_transient_crops - - !----------------------------------------------------------------------- - logical function get_do_transient_lakes() - ! !DESCRIPTION: - ! Return the value of the do_transient_lakes control flag - !----------------------------------------------------------------------- - - SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) - - get_do_transient_lakes = dyn_subgrid_control_inst%do_transient_lakes - - end function get_do_transient_lakes - - !----------------------------------------------------------------------- - logical function run_has_transient_landcover() - ! !DESCRIPTION: - ! Returns true if any aspects of prescribed transient landcover are enabled - !----------------------------------------------------------------------- - - run_has_transient_landcover = & - (get_do_transient_pfts() .or. & - get_do_transient_crops()) - end function run_has_transient_landcover - - !----------------------------------------------------------------------- - logical function get_do_harvest() - ! !DESCRIPTION: - ! Return the value of the do_harvest control flag - !----------------------------------------------------------------------- - - SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) - - get_do_harvest = dyn_subgrid_control_inst%do_harvest - - end function get_do_harvest - - !----------------------------------------------------------------------- - logical function get_reset_dynbal_baselines() - ! !DESCRIPTION: - ! Return the value of the reset_dynbal_baselines control flag - !----------------------------------------------------------------------- - - SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) - - get_reset_dynbal_baselines = dyn_subgrid_control_inst%reset_dynbal_baselines - - end function get_reset_dynbal_baselines - - !----------------------------------------------------------------------- - logical function get_for_testing_allow_non_annual_changes() - ! - ! !DESCRIPTION: - ! Return true if the user has requested to allow area changes at times other than the - ! year boundary. (This should typically only be true for testing.) (This only - ! controls error-checking, not any operation of the code.) - !----------------------------------------------------------------------- - - SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) - - get_for_testing_allow_non_annual_changes = dyn_subgrid_control_inst%for_testing_allow_non_annual_changes - - end function get_for_testing_allow_non_annual_changes - - !----------------------------------------------------------------------- - logical function get_for_testing_zero_dynbal_fluxes() - ! - ! !DESCRIPTION: - ! Return true if the user has requested to set the dynbal water and energy fluxes to - ! zero. This should typically only be true for testing: This is needed in some tests - ! where we have daily rather than annual glacier dynamics: if we allow the true dynbal - ! adjustment fluxes in those tests, we end up with sensible heat fluxes of thousands - ! of W m-2 or more, which causes CAM to blow up. However, note that setting it to - ! true will break water and energy conservation! - ! ----------------------------------------------------------------------- - - SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) - - get_for_testing_zero_dynbal_fluxes = dyn_subgrid_control_inst%for_testing_zero_dynbal_fluxes - - end function get_for_testing_zero_dynbal_fluxes - -end module dynSubgridControlMod From ecb442ee97fedb0175ffed943c136e7c10a5c0d6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Sep 2022 11:36:58 -0400 Subject: [PATCH 005/589] updating GEOS_CatchCNCLM51GridComp.F90 to latest develop --- .../GEOS_CatchCNCLM51GridComp.F90 | 66 ++++++++----------- 1 file changed, 28 insertions(+), 38 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 4c8e3074d..2998aef4f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -34,7 +34,6 @@ module GEOS_CatchCNCLM51GridCompMod use GEOS_UtilsMod use DragCoefficientsMod use CATCHMENT_CN_MODEL - use compute_rc_mod use CN_DriverMod use CN_initMod USE STIEGLITZSNOW, ONLY : & @@ -52,7 +51,9 @@ module GEOS_CatchCNCLM51GridCompMod RHOFS => CATCH_SNWALB_RHOFS, & SNWALB_VISMAX => CATCH_SNWALB_VISMAX, & SNWALB_NIRMAX => CATCH_SNWALB_NIRMAX, & - SLOPE => CATCH_SNWALB_SLOPE + SLOPE => CATCH_SNWALB_SLOPE, & + PEATCLSM_POROS_THRESHOLD + USE clm_varpar, ONLY : & NUM_ZON, NUM_VEG, VAR_COL, VAR_PFT, & @@ -63,7 +64,7 @@ module GEOS_CatchCNCLM51GridCompMod use clm_time_manager, only: get_days_per_year, get_step_size use pftvarcon, only: noveg USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & - catch_calc_zbar, catch_calc_watertabled, irrigation_rate, & + catch_calc_zbar, catch_calc_peatclsm_waterlevel, irrigation_rate, & gndtmp use update_model_para4cn, only : upd_curr_date_time @@ -3669,9 +3670,9 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'depth_to_water_table_from_surface',& + LONG_NAME = 'depth_to_water_table_from_surface_in_peat',& UNITS = 'm' ,& - SHORT_NAME = 'WATERTABLED' ,& + SHORT_NAME = 'PEATCLSM_WATERLEVEL' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) @@ -3680,7 +3681,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FSWCHANGE' ,& + SHORT_NAME = 'PEATCLSM_FSWCHANGE' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) @@ -4855,8 +4856,8 @@ subroutine Driver ( RC ) real, pointer, dimension(:) :: RMELTOC001 real, pointer, dimension(:) :: RMELTOC002 real, pointer, dimension(:) :: IRRIGRATE - real, pointer, dimension(:) :: WATERTABLED - real, pointer, dimension(:) :: FSWCHANGE + real, pointer, dimension(:) :: PEATCLSM_WATERLEVEL + real, pointer, dimension(:) :: PEATCLSM_FSWCHANGE ! -------------------------------------------------------------------------- ! Local pointers for tile variables @@ -5533,8 +5534,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,RMELTBC002 ,'RMELTBC002' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTOC001 ,'RMELTOC001' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTOC002 ,'RMELTOC002' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WATERTABLED ,'WATERTABLED' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSWCHANGE ,'FSWCHANGE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PEATCLSM_WATERLEVEL,'PEATCLSM_WATERLEVEL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PEATCLSM_FSWCHANGE ,'PEATCLSM_FSWCHANGE' , RC=STATUS); VERIFY_(STATUS) IF (RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) @@ -7580,9 +7581,16 @@ subroutine Driver ( RC ) if(associated(RMELTBC002)) RMELTBC002 = RMELT(:,7) if(associated(RMELTOC001)) RMELTOC001 = RMELT(:,8) if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) - if(associated(FSWCHANGE)) FSWCHANGE = FSW_CHANGE - if(associated(WATERTABLED)) then - WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) + if(associated(PEATCLSM_FSWCHANGE )) then + where (POROS >= PEATCLSM_POROS_THRESHOLD) + PEATCLSM_FSWCHANGE = FSW_CHANGE + elsewhere + PEATCLSM_FSWCHANGE = MAPL_UNDEF + end where + end if + + if(associated(PEATCLSM_WATERLEVEL)) then + PEATCLSM_WATERLEVEL = catch_calc_peatclsm_waterlevel( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) endif if(associated(TPSN1OUT)) then @@ -7871,35 +7879,17 @@ subroutine Driver ( RC ) deallocate( tp ) deallocate( soilice ) deallocate (PLSIN) - call MAPL_TimerOff ( MAPL, "-CATCHCNCLM45" ) + call MAPL_TimerOff ( MAPL, "-CATCHCNCLM51" ) RETURN_(ESMF_SUCCESS) end subroutine Driver -! ! ----------------- routines for CDF scaling ------------------- -! -! REAL FUNCTION cdf2fpar (cdf, k,l, m, m1, m2) -! -! REAL, intent (in) :: cdf, k,l,m, m1, m2 -! REAL :: x, ThisCDF, ThisFPAR -! integer, parameter :: nBINS = 40 -! -! x = real (nBINS) -! ThisCDF = 1. -! -! do while (ThisCDF >= cdf) -! ThisFPAR = 1. - (real(nbins)-x)/real(nbins) - 1./2./real(nbins) -! ThisCDF = K * betai (L, M, ThisFPAR) -! x = x - 1. -! if(x == 0) exit -! end do -! -! cdf2fpar = ThisFPAR * m2 + m1 -! if(cdf2fpar > m2) cdf2fpar = m2 -! if(cdf2fpar < m1) cdf2fpar = m1 -! return -! -! END FUNCTION cdf2fpar +! Commented out functions betai(), betacf(), and gammln(). +! These functions are not used and were reproduced identically in +! GEOS_CatchCNCLM40GridComp.F90 and in GEOS_CatchCNCLM45GridComp.F90. +! Another copy was in GEOScatchCN_GridComp/utils/math_routines.F90 but +! there function betai() was missing the restriction 0.0125 Date: Mon, 17 Oct 2022 16:42:24 -0400 Subject: [PATCH 006/589] commit before merge with develop --- .../CLM51/AnnualFluxDribbler.F90 | 615 ++++++++ .../CLM51/CNAnnualUpdateMod.F90 | 113 ++ .../CLM51/CNBalanceCheckMod.F90 | 628 ++++++++ .../CLM51/CNCLM51_Photosynthesis.F90 | 3 + .../CLM51/CNCLM_CNDVType.F90 | 49 + .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 691 +++++++- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 95 +- .../CLM51/CNCLM_CanopyStateType.F90 | 4 +- .../CLM51/CNCLM_DriverMod.F90 | 604 +++++++ .../CLM51/CNCLM_FrictionVelocityMod.F90 | 135 ++ .../CLM51/CNCLM_PhotosynsType.F90 | 4 +- .../CNCLM_SoilBiogeochemCarbonFluxType.F90 | 124 +- .../CNCLM_SoilBiogeochemCarbonStateType.F90 | 218 ++- .../CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 184 ++- .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 239 ++- .../CLM51/CNCLM_VegCarbonStateType.F90 | 165 +- .../CLM51/CNCLM_VegNitrogenStateType.F90 | 152 +- .../CLM51/CNCLM_filterMod.F90 | 5 + .../CLM51/CNDriverMod.F90 | 1153 ++++++++++++++ .../CLM51/CNNStateUpdate3Mod.F90 | 229 +++ .../CLM51/CNVegetationFacade.F90 | 10 - .../CLM51/CN_DriverMod.F90 | 162 -- .../CLM51/CN_init_mod.F90 | 19 +- .../CLM51/PhotosynthesisMod.F90 | 1393 ++--------------- .../CLM51/SoilBiogeochemNLeachingMod.F90 | 289 ++++ .../SoilBiogeochemPrecisionControlMod.F90 | 196 +++ .../CLM51/clm_varpar.F90 | 2 +- .../CLM51/filterColMod.F90 | 443 ++++++ .../CLM51/perf_mod.F90 | 98 ++ .../CLM51/quadraticMod.F90 | 76 + .../CLM51/shr_assert.h | 22 + .../CLM51/shr_assert_mod.F90.in | 438 ++++++ .../CLM51/shr_infnan_mod.F90.in | 406 +++++ .../CLM51/subgridAveMod.F90 | 414 ++--- .../GEOS_CatchCNCLM51GridComp.F90 | 207 ++- .../Utils/mk_restarts/CatchmentCNRst.F90 | 1 + .../Utils/mk_restarts/Scale_CatchCN.F90 | 1 + .../Utils/mk_restarts/mk_GEOSldasRestarts.F90 | 1 + 38 files changed, 7781 insertions(+), 1807 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNAnnualUpdateMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate3Mod.F90 delete mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNLeachingMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemPrecisionControlMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/filterColMod.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/perf_mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/quadraticMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 new file mode 100755 index 000000000..aa1e3bbcd --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -0,0 +1,615 @@ +module AnnualFluxDribbler + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! + ! Defines a class for handling fluxes that are generated once per year (e.g., due to + ! transient landcover changes that happen at the year boundary), but are meant to be + ! dribbled in evenly throughout the year. + ! + ! This assumes that the once-per-year fluxes are generated on the first timestep of the + ! year. Any flux given on the first timestep of the year is dribbled evenly for every + ! timestep of the coming year. Any flux given on other timesteps is applied entirely in + ! the current timestep. (Note that, if there is a combination of an annual flux and an + ! every-time-step flux, with both combined in the same delta term, then, on the first + ! timestep of the year, the every-time-step flux generated on that timestep will be + ! dribbled over the year rather than applied in that timestep.) + ! + ! NOTE(wjs, 2016-08-30) If we change the glc coupling time to be more frequent, then + ! we'll need to make this more dynamic: e.g., for coupling every 73 days (5 times per + ! year), we'd need to dribble fluxes over the next 73 days. + ! + ! Typical usage: + ! + ! - call mydribbler%set_curr_delta every time step + ! + ! This must be called every timestep, even if the delta is currently zero, in order + ! to zero out any existing stored delta. This can (and generally should) even be + ! called when it isn't the first timestep of the year. For deltas that are non-zero + ! at times other than the first timestep of the year, they will simply be passed on + ! to the output flux in get_curr_flux, making for easier handling by the client. + ! + ! - call mydribbler%get_curr_flux every time step, AFTER set_curr_delta + ! + ! This will get the current flux for this timestep, which is the sum of (1) the + ! dribbled flux from the last start-of-year timestep, and (2) the current timestep's + ! flux, based on the delta passed in to set_curr_delta in this timestep, if this is + ! not the start-of-year timestep. + ! + ! Alternatively, you can call mydribbler%get_dribbled_delta, if you need the result as + ! a delta over the time step rather than as a per-second flux. + ! + ! And, for the sake of checking conservation: + ! + ! - To get gridcell water (or whatever) content at the start of the time step: + ! + ! call mydribbler%get_amount_left_to_dribble_beg + ! + ! - To get gridcell water (or whatever) content at the end of the time step: + ! + ! call mydribbler%get_amount_left_to_dribble_end + ! + ! These both return the pseudo-state representing how much of the original delta + ! still needs to be dribbled. The 'beg' version includes the amount left to dribble + ! in the current time step; the 'end' version does not. + ! + ! + ! !USES: + use clm_varctl , only : iulog + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type, get_beg, get_end + use decompMod , only : BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_PATCH + use clm_varcon , only : secspday, nameg, namep + use clm_time_manager , only : get_days_per_year, get_step_size_real, is_beg_curr_year + use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac, get_prev_date + use clm_time_manager , only : is_first_step + ! + implicit none + private + + ! Compiler support for allocatable characters isn't fully robust (particularly for + ! pgi), so using a max lengths for now + ! + ! (If we used allocatable characters, these max lengths could be removed + integer, parameter :: name_maxlen = 128 + integer, parameter :: units_maxlen = 64 + integer, parameter :: subgrid_maxlen = 64 + + ! !PUBLIC TYPES: + + type, public :: annual_flux_dribbler_type + private + ! Metadata + character(len=name_maxlen) :: name + character(len=units_maxlen) :: units + + ! Whether this dribbler allows non-zero deltas on time steps other than the first + ! time step of the year + logical :: allows_non_annual_delta + + ! Which subgrid level this dribbler is operating at, stored in various ways + character(len=subgrid_maxlen) :: dim1name + character(len=subgrid_maxlen) :: name_subgrid + integer :: bounds_subgrid_level + + ! Annual amount to dribble in over the year + real(r8), pointer :: amount_to_dribble(:) + + ! Amount from the current timestep to pass through to the flux, if this isn't the + ! first timestep of the year + real(r8), pointer :: amount_from_this_timestep(:) + contains + ! Public infrastructure methods + procedure, public :: Restart + procedure, public :: Clean + + ! Public science methods + procedure, public :: set_curr_delta ! Set the delta state for this time step + procedure, public :: get_curr_flux ! Get the current flux for this time step + procedure, public :: get_dribbled_delta ! Similar to get_curr_flux, but gets result as a delta rather than a per-second flux + procedure, public :: get_amount_left_to_dribble_beg ! Get the pseudo-state representing the amount that still needs to be dribbled in this and future time steps + procedure, public :: get_amount_left_to_dribble_end ! Get the pseudo-state representing the amount that still needs to be dribbled in just future time steps + + ! Private methods + procedure, private :: allocate_and_initialize_data + procedure, private :: set_metadata + procedure, private :: get_amount_left_to_dribble + end type annual_flux_dribbler_type + + public :: annual_flux_dribbler_gridcell ! Creates an annual_flux_dribbler_type object at the gridcell-level + public :: annual_flux_dribbler_patch ! Creates an annual_flux_dribbler_type object at the patch-level + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + ! ======================================================================== + ! Factory methods + ! + ! For now, there are only factory methods for gridcell-level and patch-level. But + ! adding the ability to work at other levels is as easy as adding another factory + ! method like this (along with some variables in the 'only' clauses of the 'use' + ! statements). + ! ======================================================================== + + !----------------------------------------------------------------------- + function annual_flux_dribbler_gridcell(bounds, name, units, allows_non_annual_delta) & + result(this) + ! + ! !DESCRIPTION: + ! Creates an annual_flux_dribbler_type object at the gridcell-level + ! + ! !USES: + ! + ! !ARGUMENTS: + type(annual_flux_dribbler_type) :: this ! function result + type(bounds_type), intent(in) :: bounds + character(len=*) , intent(in) :: name ! name of this object, used for i/o + character(len=*) , intent(in) :: units ! units metadata - should be state units, not flux (i.e., NOT per-second) + + ! If allows_non_annual_delta is .false., then an error check is performed for each + ! call to set_curr_delta, ensuring that the delta is 0 at all times other than the + ! first time step of the year. This is just provided as a convenient sanity check - + ! to ensure that the code is behaving as expected. (However, non-zero deltas are + ! always allowed on the first step of the run.) + ! + ! If allows_non_annual_delta is not provided, it is assumed to be .true. + logical, intent(in), optional :: allows_non_annual_delta + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'annual_flux_dribbler_gridcell' + !----------------------------------------------------------------------- + + this%dim1name = 'gridcell' + this%name_subgrid = nameg + this%bounds_subgrid_level = BOUNDS_SUBGRID_GRIDCELL + + call this%allocate_and_initialize_data(bounds) + call this%set_metadata(name, units, allows_non_annual_delta) + + end function annual_flux_dribbler_gridcell + + !----------------------------------------------------------------------- + function annual_flux_dribbler_patch(bounds, name, units, allows_non_annual_delta) & + result(this) + ! + ! !DESCRIPTION: + ! Creates an annual_flux_dribbler_type object at the patch-level + ! + ! !USES: + ! + ! !ARGUMENTS: + type(annual_flux_dribbler_type) :: this ! function result + type(bounds_type), intent(in) :: bounds + character(len=*) , intent(in) :: name ! name of this object, used for i/o + character(len=*) , intent(in) :: units ! units metadata - should be state units, not flux (i.e., NOT per-second) + + ! If allows_non_annual_delta is .false., then an error check is performed for each + ! call to set_curr_delta, ensuring that the delta is 0 at all times other than the + ! first time step of the year. This is just provided as a convenient sanity check - + ! to ensure that the code is behaving as expected. + ! + ! If allows_non_annual_delta is not provided, it is assumed to be .true. + logical, intent(in), optional :: allows_non_annual_delta + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'annual_flux_dribbler_patch' + !----------------------------------------------------------------------- + + this%dim1name = 'pft' + this%name_subgrid = namep + this%bounds_subgrid_level = BOUNDS_SUBGRID_PATCH + + call this%allocate_and_initialize_data(bounds) + call this%set_metadata(name, units, allows_non_annual_delta) + + end function annual_flux_dribbler_patch + + ! ======================================================================== + ! Public methods + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine set_curr_delta(this, bounds, delta) + ! + ! !DESCRIPTION: + ! Sets the delta state for this time step. Note that the delta is specified just as + ! the change in state - NOT as a flux (per-second) quantity. + ! + ! This must be called every timestep, even if the deltas are currently 0, in order to + ! zero out any existing stored delta. This can (and generally should) even be called + ! when it isn't the first timestep of the year. For deltas that are non-zero at times + ! other than the first timestep of the year, they will simply be passed on to the + ! output flux in get_curr_flux, making for easier handling by the client. (i.e., this + ! class handles the addition of the dribbled flux and the current flux for you.) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: delta( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + integer :: beg_index, end_index + integer :: i + integer :: yr, mon, day, tod + + character(len=*), parameter :: subname = 'set_curr_delta' + !----------------------------------------------------------------------- + + beg_index = lbound(delta, 1) + end_index = get_end(bounds, this%bounds_subgrid_level) + SHR_ASSERT_ALL_FL((ubound(delta) == (/end_index/)), sourcefile, __LINE__) + + if (is_beg_curr_year()) then + do i = beg_index, end_index + this%amount_to_dribble(i) = delta(i) + + ! On the first timestep of the year, we don't have any pass-through flux. Need + ! to zero out any previously-set amount_from_this_timestep. + this%amount_from_this_timestep(i) = 0._r8 + end do + else + do i = beg_index, end_index + this%amount_from_this_timestep(i) = delta(i) + end do + if (.not. this%allows_non_annual_delta .and. .not. is_first_step()) then + do i = beg_index, end_index + if (this%amount_from_this_timestep(i) /= 0._r8) then + write(iulog,*) subname//' ERROR: found unexpected non-zero delta mid-year' + write(iulog,*) 'Dribbler name: ', trim(this%name) + write(iulog,*) 'i, delta = ', i, this%amount_from_this_timestep(i) + call get_prev_date(yr, mon, day, tod) + write(iulog,*) 'Start of time step date (yr, mon, day, tod) = ', & + yr, mon, day, tod + write(iulog,*) 'This indicates that some non-zero flux was generated at a time step' + write(iulog,*) 'other than the first time step of the year, which this dribbler was told not to expect.' + write(iulog,*) 'If this non-zero mid-year delta is expected, then you can suppress this error' + write(iulog,*) 'by setting allows_non_annual_delta to .true. when constructing this dribbler.' + call endrun(decomp_index=i, clmlevel=this%name_subgrid, & + msg=subname//': found unexpected non-zero delta mid-year: ' // & + errMsg(sourcefile, __LINE__)) + end if + end do + end if + end if + + end subroutine set_curr_delta + + !----------------------------------------------------------------------- + subroutine get_curr_flux(this, bounds, flux) + ! + ! !DESCRIPTION: + ! Gets the current flux for this timestep, and stores it in the flux argument. + ! + ! This should be called AFTER set_curr_delta is called for the given timestep. + ! + ! This will get the current flux for this timestep, which is the sum of (1) the + ! dribbled flux from the last start-of-year timestep, and (2) the current timestep's + ! flux, based on the delta passed in to set_curr_delta in this timestep, if this is + ! not the start-of-year timestep. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(out) :: flux( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + integer :: beg_index, end_index + integer :: i + real(r8) :: secs_per_year + real(r8) :: dtime + real(r8) :: flux_from_dribbling + real(r8) :: flux_from_this_timestep + + character(len=*), parameter :: subname = 'get_curr_flux' + !----------------------------------------------------------------------- + + beg_index = lbound(flux, 1) + end_index = get_end(bounds, this%bounds_subgrid_level) + SHR_ASSERT_ALL_FL((ubound(flux) == (/end_index/)), sourcefile, __LINE__) + + secs_per_year = get_days_per_year() * secspday + dtime = get_step_size_real() + + do i = beg_index, end_index + flux_from_dribbling = this%amount_to_dribble(i) / secs_per_year + flux_from_this_timestep = this%amount_from_this_timestep(i) / dtime + flux(i) = flux_from_dribbling + flux_from_this_timestep + end do + + end subroutine get_curr_flux + + !----------------------------------------------------------------------- + subroutine get_dribbled_delta(this, bounds, delta) + ! + ! !DESCRIPTION: + ! Gets the current delta for this timestep, and stores it in the delta argument. + ! + ! This is similar to get_curr_flux, but returns the total, dribbled delta over this + ! timestep, rather than a per-second flux. See documentation in get_curr_flux for + ! more usage details. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(out) :: delta( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + integer :: beg_index, end_index + integer :: i + real(r8) :: dtime + real(r8), allocatable :: flux(:) + + character(len=*), parameter :: subname = 'get_dribbled_delta' + !----------------------------------------------------------------------- + + beg_index = lbound(delta, 1) + end_index = get_end(bounds, this%bounds_subgrid_level) + SHR_ASSERT_ALL_FL((ubound(delta) == (/end_index/)), sourcefile, __LINE__) + + allocate(flux(beg_index:end_index)) + + call this%get_curr_flux(bounds, flux(beg_index:end_index)) + + dtime = get_step_size_real() + do i = beg_index, end_index + delta(i) = flux(i) * dtime + end do + + end subroutine get_dribbled_delta + + + !----------------------------------------------------------------------- + subroutine get_amount_left_to_dribble_beg(this, bounds, amount_left_to_dribble) + ! + ! !DESCRIPTION: + ! Get the pseudo-state representing the amount that still needs to be dribbled in + ! this and future time steps. This represents the pseudo-state before this time + ! step's dribbling flux has been removed. (This behavior is regardless of whether + ! get_curr_flux has been called already this time step.) + ! + ! As a special case, this returns 0 in the first time step of the year, because we + ! haven't created this year's dribbling pool as of the beginning of this time step. + ! + ! i.e., if we imagined that the total amount to dribble was added to a state + ! variable, and then this state variable was updated each time step as the flux + ! dribbles out, then this subroutine gives the amount left in that state. (However, + ! the actual implementation doesn't explicitly track this state, which is why we + ! refer to it as a pseudo-state.) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + real(r8) :: yearfrac + + character(len=*), parameter :: subname = 'get_amount_left_to_dribble_beg' + !----------------------------------------------------------------------- + + yearfrac = get_prev_yearfrac() + call this%get_amount_left_to_dribble(bounds, yearfrac, amount_left_to_dribble) + + end subroutine get_amount_left_to_dribble_beg + + + !----------------------------------------------------------------------- + subroutine get_amount_left_to_dribble_end(this, bounds, amount_left_to_dribble) + ! + ! !DESCRIPTION: + ! Gets the pseudo-state representing the amount that still needs to be dribbled in + ! future time steps. This represents the pseudo-state after this time step's dribbling + ! flux has been removed. i.e., this includes the amount that will be dribbled starting + ! with the *next* time step, through the end of this year. So this will return 0 on + ! the last time step of the year. (This behavior is regardless of whether + ! get_curr_flux has been called already this time step.) + ! + ! See documentation of get_amount_left_to_dribble_beg for more details. + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + real(r8) :: yearfrac + + character(len=*), parameter :: subname = 'get_amount_left_to_dribble_end' + !----------------------------------------------------------------------- + + yearfrac = get_curr_yearfrac() + call this%get_amount_left_to_dribble(bounds, yearfrac, amount_left_to_dribble) + + end subroutine get_amount_left_to_dribble_end + + + !----------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use ncdio_pio, only : file_desc_t, ncd_double + use restUtilMod + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + character(len=:), allocatable :: restname ! name of field on restart file + logical :: readvar + + character(len=*), parameter :: subname = 'Restart' + !----------------------------------------------------------------------- + + restname = trim(this%name) // '_amt_to_dribble' + call restartvar(ncid=ncid, flag=flag, varname=restname, xtype=ncd_double, & + dim1name = this%dim1name, & + long_name = 'total amount to dribble over the year for ' // trim(this%name), & + units = trim(this%units), & + interpinic_flag = 'interp', & + readvar = readvar, & + data = this%amount_to_dribble) + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine Clean(this) + ! + ! !DESCRIPTION: + ! Deallocate memory associated with this object + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'Clean' + !----------------------------------------------------------------------- + + deallocate(this%amount_to_dribble) + deallocate(this%amount_from_this_timestep) + + end subroutine Clean + + ! ======================================================================== + ! Private methods + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine allocate_and_initialize_data(this, bounds) + ! + ! !DESCRIPTION: + ! Allocate arrays in this object and set them to initial values + ! + ! Assumes this%bounds_subgrid_level is already set + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: beg_index, end_index + + character(len=*), parameter :: subname = 'allocate_and_initialize_data' + !----------------------------------------------------------------------- + + beg_index = get_beg(bounds, this%bounds_subgrid_level) + end_index = get_end(bounds, this%bounds_subgrid_level) + + allocate(this%amount_to_dribble(beg_index:end_index)) + this%amount_to_dribble(beg_index:end_index) = 0._r8 + + allocate(this%amount_from_this_timestep(beg_index:end_index)) + this%amount_from_this_timestep(beg_index:end_index) = 0._r8 + + end subroutine allocate_and_initialize_data + + !----------------------------------------------------------------------- + subroutine set_metadata(this, name, units, allows_non_annual_delta) + ! + ! !DESCRIPTION: + ! Set metadata in this object + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(inout) :: this + character(len=*) , intent(in) :: name ! name of this object, used for i/o + character(len=*) , intent(in) :: units ! units metadata - should be state units, not flux (i.e., NOT per-second) + + ! If allows_non_annual_delta is .false., then an error check is performed for each + ! call to set_curr_delta, ensuring that the delta is 0 at all times other than the + ! first time step of the year. This is just provided as a convenient sanity check - + ! to ensure that the code is behaving as expected. + ! + ! If allows_non_annual_delta is not provided, it is assumed to be .true. + logical, intent(in), optional :: allows_non_annual_delta + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'set_metadata' + !----------------------------------------------------------------------- + + if (len_trim(name) > name_maxlen) then + write(iulog,*) subname // ': name too long' + write(iulog,*) trim(name) // ' exceeds max length: ', name_maxlen + call endrun(msg=subname // ': name too long: ' // & + errMsg(sourcefile, __LINE__)) + end if + this%name = trim(name) + + if (len_trim(units) > units_maxlen) then + write(iulog,*) subname // ': units too long' + write(iulog,*) trim(units) // ' exceeds max length: ', units_maxlen + call endrun(msg=subname // ': units too long: ' // & + errMsg(sourcefile, __LINE__)) + end if + this%units = trim(units) + + if (present(allows_non_annual_delta)) then + this%allows_non_annual_delta = allows_non_annual_delta + else + this%allows_non_annual_delta = .true. + end if + + end subroutine set_metadata + + !----------------------------------------------------------------------- + subroutine get_amount_left_to_dribble(this, bounds, yearfrac, amount_left_to_dribble) + ! + ! !DESCRIPTION: + ! Helper method shared by get_amount_left_to_dribble_beg and + ! get_amount_left_to_dribble_end. Returns amount left to dribble as of a given + ! yearfrac. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: yearfrac + real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + integer :: beg_index, end_index + integer :: i + + character(len=*), parameter :: subname = 'get_amount_left_to_dribble' + !----------------------------------------------------------------------- + + beg_index = lbound(amount_left_to_dribble, 1) + end_index = get_end(bounds, this%bounds_subgrid_level) + SHR_ASSERT_ALL_FL((ubound(amount_left_to_dribble) == (/end_index/)), sourcefile, __LINE__) + + do i = beg_index, end_index + if (yearfrac < 1.e-15_r8) then + ! last time step of year; we'd like this to be given a yearfrac of 1 rather than + ! 0 in this case; since it's given as 0, we need to handle it specially + amount_left_to_dribble(i) = 0._r8 + else + amount_left_to_dribble(i) = this%amount_to_dribble(i) * (1._r8 - yearfrac) + end if + end do + + end subroutine get_amount_left_to_dribble + + +end module AnnualFluxDribbler diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNAnnualUpdateMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNAnnualUpdateMod.F90 new file mode 100755 index 000000000..7e1d34464 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNAnnualUpdateMod.F90 @@ -0,0 +1,113 @@ +module CNAnnualUpdateMod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for updating annual summation variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNvegStateType , only : cnveg_state_type + use PatchType , only : patch + use filterColMod , only : filter_col_type, col_filter_from_filter_and_logical_array + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CNAnnualUpdate + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update annual summation variables + ! + ! !USES: + use clm_time_manager, only: get_step_size_real, get_days_per_year + use clm_varcon , only: secspday + use SubgridAveMod , only: p2c + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: secspyear + real(r8):: dt ! radiation time step (seconds) + logical :: end_of_year(bounds%begc:bounds%endc) ! whether each column has reached the end of the year, according to its own annsum_counter + type(filter_col_type) :: filter_endofyear_c + !----------------------------------------------------------------------- + + dt = get_step_size_real() + secspyear = get_days_per_year() * secspday + + do fc = 1,num_soilc + c = filter_soilc(fc) + cnveg_state_inst%annsum_counter_col(c) = cnveg_state_inst%annsum_counter_col(c) + dt + if (cnveg_state_inst%annsum_counter_col(c) >= secspyear) then + end_of_year(c) = .true. + cnveg_state_inst%annsum_counter_col(c) = 0._r8 + else + end_of_year(c) = .false. + end if + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + if (end_of_year(c)) then + + ! update annual plant ndemand accumulator + cnveg_state_inst%annsum_potential_gpp_patch(p) = cnveg_state_inst%tempsum_potential_gpp_patch(p) + cnveg_state_inst%tempsum_potential_gpp_patch(p) = 0._r8 + + ! update annual total N retranslocation accumulator + cnveg_state_inst%annmax_retransn_patch(p) = cnveg_state_inst%tempmax_retransn_patch(p) + cnveg_state_inst%tempmax_retransn_patch(p) = 0._r8 + + ! update annual average 2m air temperature accumulator + cnveg_state_inst%annavg_t2m_patch(p) = cnveg_state_inst%tempavg_t2m_patch(p) + cnveg_state_inst%tempavg_t2m_patch(p) = 0._r8 + + ! update annual NPP accumulator, convert to annual total + cnveg_carbonflux_inst%annsum_npp_patch(p) = cnveg_carbonflux_inst%tempsum_npp_patch(p) * dt + cnveg_carbonflux_inst%tempsum_npp_patch(p) = 0._r8 + + ! update annual litfall accumulator, convert to annual total + cnveg_carbonflux_inst%annsum_litfall_patch(p) = cnveg_carbonflux_inst%tempsum_litfall_patch(p) * dt + cnveg_carbonflux_inst%tempsum_litfall_patch(p) = 0._r8 + + end if + end do + + ! Get column-level averages, just for the columns that have reached their personal end-of-year + filter_endofyear_c = col_filter_from_filter_and_logical_array( & + bounds = bounds, & + num_orig = num_soilc, & + filter_orig = filter_soilc, & + logical_col = end_of_year(bounds%begc:bounds%endc)) + + call p2c(bounds, filter_endofyear_c%num, filter_endofyear_c%indices, & + cnveg_carbonflux_inst%annsum_npp_patch(bounds%begp:bounds%endp), & + cnveg_carbonflux_inst%annsum_npp_col(bounds%begc:bounds%endc)) + + call p2c(bounds, filter_endofyear_c%num, filter_endofyear_c%indices, & + cnveg_state_inst%annavg_t2m_patch(bounds%begp:bounds%endp), & + cnveg_state_inst%annavg_t2m_col(bounds%begc:bounds%endc)) + + end subroutine CNAnnualUpdate + +end module CNAnnualUpdateMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 new file mode 100755 index 000000000..cc7aa660d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 @@ -0,0 +1,628 @@ +module CNBalanceCheckMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for carbon/nitrogen mass balance checking. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : iulog, use_nitrif_denitrif + use clm_time_manager , only : get_step_size_real + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use SoilBiogeochemNitrogenfluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemCarbonfluxType , only : soilbiogeochem_carbonflux_type + use CNProductsMod , only : cn_products_type + use ColumnType , only : col + use GridcellType , only : grc + use CNSharedParamsMod , only : use_fun + + ! + implicit none + private + ! + ! !PUBLIC TYPES: + type, public :: cn_balance_type + private + real(r8), pointer :: begcb_col(:) ! (gC/m2) column carbon mass, beginning of time step + real(r8), pointer :: endcb_col(:) ! (gC/m2) column carbon mass, end of time step + real(r8), pointer :: begnb_col(:) ! (gN/m2) column nitrogen mass, beginning of time step + real(r8), pointer :: endnb_col(:) ! (gN/m2) column nitrogen mass, end of time step + real(r8), pointer :: begcb_grc(:) ! (gC/m2) gridcell carbon mass, beginning of time step + real(r8), pointer :: endcb_grc(:) ! (gC/m2) gridcell carbon mass, end of time step + real(r8), pointer :: begnb_grc(:) ! (gN/m2) gridcell nitrogen mass, beginning of time step + real(r8), pointer :: endnb_grc(:) ! (gN/m2) gridcell nitrogen mass, end of time step + real(r8) :: cwarning ! (gC/m2) For a Carbon balance warning + real(r8) :: nwarning ! (gN/m2) For a Nitrogen balance warning + real(r8) :: cerror ! (gC/m2) For a Carbon balance error + real(r8) :: nerror ! (gN/m2) For a Nitrogen balance error + contains + procedure , public :: Init + procedure , public :: BeginCNGridcellBalance + procedure , public :: BeginCNColumnBalance + procedure , public :: CBalanceCheck + procedure , public :: NBalanceCheck + end type cn_balance_type + ! + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine Init(this, bounds) + use clm_varctl , only : use_matrixcn, use_soil_matrixcn + class(cn_balance_type) :: this + type(bounds_type) , intent(in) :: bounds + + integer :: begc, endc + integer :: begg, endg + !------------------------------------------- + + begg = bounds%begg; endg = bounds%endg + + allocate(this%begcb_grc(begg:endg)) ; this%begcb_grc(:) = nan + allocate(this%endcb_grc(begg:endg)) ; this%endcb_grc(:) = nan + allocate(this%begnb_grc(begg:endg)) ; this%begnb_grc(:) = nan + allocate(this%endnb_grc(begg:endg)) ; this%endnb_grc(:) = nan + + begc = bounds%begc; endc= bounds%endc + + allocate(this%begcb_col(begc:endc)) ; this%begcb_col(:) = nan + allocate(this%endcb_col(begc:endc)) ; this%endcb_col(:) = nan + allocate(this%begnb_col(begc:endc)) ; this%begnb_col(:) = nan + allocate(this%endnb_col(begc:endc)) ; this%endnb_col(:) = nan + + this%cwarning = 1.e-8_r8 + this%nwarning = 1.e-7_r8 + this%nerror = 1.e-3_r8 + this%cerror = 1.e-7_r8 + end subroutine Init + + !----------------------------------------------------------------------- + subroutine BeginCNGridcellBalance(this, bounds, cnveg_carbonflux_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + c_products_inst, n_products_inst) + ! + ! !DESCRIPTION: + ! Calculate beginning gridcell-level carbon/nitrogen balance + ! for mass conservation check + ! + ! Should be called after CN state summaries have been computed + ! and before the dynamic landunit area updates + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_balance_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cn_products_type) , intent(in) :: c_products_inst + type(cn_products_type) , intent(in) :: n_products_inst + ! + ! !LOCAL VARIABLES: + integer :: g + integer :: begg, endg + real(r8) :: hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) + real(r8) :: dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) + !----------------------------------------------------------------------- + + associate( & + begcb => this%begcb_grc , & ! Output: [real(r8) (:)] (gC/m2) gridcell carbon mass, beginning of time step + begnb => this%begnb_grc , & ! Output: [real(r8) (:)] (gN/m2) gridcell nitrogen mass, beginning of time step + totc => cnveg_carbonstate_inst%totc_grc , & ! Input: [real(r8) (:)] (gC/m2) total gridcell carbon, incl veg and cpool + totn => cnveg_nitrogenstate_inst%totn_grc, & ! Input: [real(r8) (:)] (gN/m2) total gridcell nitrogen, incl veg + c_cropprod1 => c_products_inst%cropprod1_grc , & ! Input: [real(r8) (:)] (gC/m2) carbon in crop products + n_cropprod1 => n_products_inst%cropprod1_grc , & ! Input: [real(r8) (:)] (gC/m2) nitrogen in crop products + c_tot_woodprod => c_products_inst%tot_woodprod_grc , & ! Input: [real(r8) (:)] (gC/m2) total carbon in wood products + n_tot_woodprod => n_products_inst%tot_woodprod_grc & ! Input: [real(r8) (:)] (gC/m2) total nitrogen in wood products + ) + + begg = bounds%begg; endg = bounds%endg + + call cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_dribbler%get_amount_left_to_dribble_beg( & + bounds, hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg)) + call cnveg_carbonflux_inst%dwt_conv_cflux_dribbler%get_amount_left_to_dribble_beg( & + bounds, dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg)) + + do g = begg, endg + begcb(g) = totc(g) + c_tot_woodprod(g) + c_cropprod1(g) + & + hrv_xsmrpool_amount_left_to_dribble(g) + & + dwt_conv_cflux_amount_left_to_dribble(g) + begnb(g) = totn(g) + n_tot_woodprod(g) + n_cropprod1(g) + end do + + end associate + + end subroutine BeginCNGridcellBalance + + !----------------------------------------------------------------------- + subroutine BeginCNColumnBalance(this, bounds, num_soilc, filter_soilc, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Calculate beginning column-level carbon/nitrogen balance, for mass conservation check + ! + ! Should be called after CN state summaries have been recomputed for this time step + ! (which should be after the dynamic landunit area updates and the associated filter + ! updates - i.e., using the new version of the filters) + ! + ! !ARGUMENTS: + class(cn_balance_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: fc,c + !----------------------------------------------------------------------- + + associate( & + col_begcb => this%begcb_col , & ! Output: [real(r8) (:)] (gC/m2) column carbon mass, beginning of time step + col_begnb => this%begnb_col , & ! Output: [real(r8) (:)] (gN/m2) column nitrogen mass, beginning of time step + totcolc => cnveg_carbonstate_inst%totc_col , & ! Input: [real(r8) (:)] (gC/m2) total column carbon, incl veg and cpool + totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:)] (gN/m2) total column nitrogen, incl veg + ) + + do fc = 1,num_soilc + c = filter_soilc(fc) + col_begcb(c) = totcolc(c) + col_begnb(c) = totcoln(c) + end do + + end associate + + end subroutine BeginCNColumnBalance + + !----------------------------------------------------------------------- + subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & + soilbiogeochem_carbonflux_inst, cnveg_carbonflux_inst, & + cnveg_carbonstate_inst, c_products_inst) + ! + ! !USES: + use subgridAveMod, only: c2g + ! + ! !DESCRIPTION: + ! Perform carbon mass conservation check for column and patch + ! + ! !ARGUMENTS: + class(cn_balance_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cn_products_type) , intent(in) :: c_products_inst + ! + ! !LOCAL VARIABLES: + integer :: c, g, err_index ! indices + integer :: fc ! lake filter indices + logical :: err_found ! error flag + real(r8) :: dt ! radiation time step (seconds) + real(r8) :: col_cinputs, grc_cinputs + real(r8) :: col_coutputs, grc_coutputs + real(r8) :: col_errcb(bounds%begc:bounds%endc) + real(r8) :: grc_errcb(bounds%begg:bounds%endg) + real(r8) :: som_c_leached_grc(bounds%begg:bounds%endg) + real(r8) :: hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) + real(r8) :: dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) + !----------------------------------------------------------------------- + + associate( & + grc_begcb => this%begcb_grc , & ! Input: [real(r8) (:) ] (gC/m2) gridcell-level carbon mass, beginning of time step + grc_endcb => this%endcb_grc , & ! Output: [real(r8) (:) ] (gC/m2) gridcell-level carbon mass, end of time step + totgrcc => cnveg_carbonstate_inst%totc_grc , & ! Input: [real(r8) (:)] (gC/m2) total gridcell carbon, incl veg and cpool + nbp_grc => cnveg_carbonflux_inst%nbp_grc , & ! Input: [real(r8) (:) ] (gC/m2/s) net biome production (positive for sink) + cropprod1_grc => c_products_inst%cropprod1_grc , & ! Input: [real(r8) (:)] (gC/m2) carbon in crop products + tot_woodprod_grc => c_products_inst%tot_woodprod_grc , & ! Input: [real(r8) (:)] (gC/m2) total carbon in wood products + dwt_seedc_to_leaf_grc => cnveg_carbonflux_inst%dwt_seedc_to_leaf_grc , & ! Input: [real(r8) (:)] (gC/m2/s) seed source sent to leaf + dwt_seedc_to_deadstem_grc => cnveg_carbonflux_inst%dwt_seedc_to_deadstem_grc , & ! Input: [real(r8) (:)] (gC/m2/s) seed source sent to deadstem + col_begcb => this%begcb_col , & ! Input: [real(r8) (:) ] (gC/m2) carbon mass, beginning of time step + col_endcb => this%endcb_col , & ! Output: [real(r8) (:) ] (gC/m2) carbon mass, end of time step + wood_harvestc => cnveg_carbonflux_inst%wood_harvestc_col , & ! Input: [real(r8) (:) ] (gC/m2/s) wood harvest (to product pools) + grainc_to_cropprodc => cnveg_carbonflux_inst%grainc_to_cropprodc_col , & ! Input: [real(r8) (:) ] (gC/m2/s) grain C to 1-year crop product pool + gpp => cnveg_carbonflux_inst%gpp_col , & ! Input: [real(r8) (:) ] (gC/m2/s) gross primary production + er => cnveg_carbonflux_inst%er_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic + col_fire_closs => cnveg_carbonflux_inst%fire_closs_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total column-level fire C loss + col_hrv_xsmrpool_to_atm => cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool harvest mortality + col_xsmrpool_to_atm => cnveg_carbonflux_inst%xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool crop harvest loss to atm + som_c_leached => soilbiogeochem_carbonflux_inst%som_c_leached_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total SOM C loss from vertical transport + + totcolc => cnveg_carbonstate_inst%totc_col & ! Input: [real(r8) (:) ] (gC/m2) total column carbon, incl veg and cpool + ) + + ! set time steps + dt = get_step_size_real() + + err_found = .false. + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate the total column-level carbon storage, for mass conservation check + col_endcb(c) = totcolc(c) + + ! calculate total column-level inputs + col_cinputs = gpp(c) + + ! calculate total column-level outputs + ! er = ar + hr, col_fire_closs includes patch-level fire losses + col_coutputs = er(c) + col_fire_closs(c) + col_hrv_xsmrpool_to_atm(c) + & + col_xsmrpool_to_atm(c) + + ! Fluxes to product pools are included in column-level outputs: the product + ! pools are not included in totcolc, so are outside the system with respect to + ! these balance checks. (However, the dwt flux to product pools is NOT included, + ! since col_begcb is initialized after the dynamic area adjustments - i.e., + ! after the dwt term has already been taken out.) + col_coutputs = col_coutputs + & + wood_harvestc(c) + & + grainc_to_cropprodc(c) + + ! subtract leaching flux + col_coutputs = col_coutputs - som_c_leached(c) + + ! calculate the total column-level carbon balance error for this time step + col_errcb(c) = (col_cinputs - col_coutputs)*dt - & + (col_endcb(c) - col_begcb(c)) + + ! check for significant errors + if (abs(col_errcb(c)) > this%cerror) then + err_found = .true. + err_index = c + end if + if (abs(col_errcb(c)) > this%cwarning) then + write(iulog,*) 'cbalance warning at c =', c, col_errcb(c), col_endcb(c) + end if + + end do ! end of columns loop + + if (err_found) then + c = err_index + write(iulog,*)'column cbalance error = ', col_errcb(c), c + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) + write(iulog,*)'begcb = ',col_begcb(c) + write(iulog,*)'endcb = ',col_endcb(c) + write(iulog,*)'delta store = ',col_endcb(c)-col_begcb(c) + write(iulog,*)'--- Inputs ---' + write(iulog,*)'gpp = ',gpp(c)*dt + write(iulog,*)'--- Outputs ---' + write(iulog,*)'er = ',er(c)*dt + write(iulog,*)'col_fire_closs = ',col_fire_closs(c)*dt + write(iulog,*)'col_hrv_xsmrpool_to_atm = ',col_hrv_xsmrpool_to_atm(c)*dt + write(iulog,*)'col_xsmrpool_to_atm = ',col_xsmrpool_to_atm(c)*dt + write(iulog,*)'wood_harvestc = ',wood_harvestc(c)*dt + write(iulog,*)'grainc_to_cropprodc = ',grainc_to_cropprodc(c)*dt + write(iulog,*)'-1*som_c_leached = ',som_c_leached(c)*dt + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Repeat error check at the gridcell level + call c2g( bounds = bounds, & + carr = totcolc(bounds%begc:bounds%endc), & + garr = totgrcc(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + call c2g( bounds = bounds, & + carr = som_c_leached(bounds%begc:bounds%endc), & + garr = som_c_leached_grc(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + err_found = .false. + do g = bounds%begg, bounds%endg + ! calculate gridcell-level carbon storage for mass conservation check + ! Notes: + ! totgrcc = totcolc = totc_p2c_col(c) + soilbiogeochem_cwdc_col(c) + soilbiogeochem_totlitc_col(c) + soilbiogeochem_totsomc_col(c) + soilbiogeochem_ctrunc_col(c) + ! totc_p2c_col = totc_patch = totvegc_patch(p) + xsmrpool_patch(p) + ctrunc_patch(p) + cropseedc_deficit_patch(p) + ! Not including seedc_grc in grc_begcb and grc_endcb because + ! seedc_grc forms out of thin air, for now, and equals + ! -1 * (dwt_seedc_to_leaf_grc(g) + dwt_seedc_to_deadstem_grc(g)) + ! We account for the latter fluxes as inputs below; the same + ! fluxes have entered the pools earlier in the timestep. For true + ! conservation we would need to add a flux out of npp into seed. + call cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_dribbler%get_amount_left_to_dribble_end( & + bounds, hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg)) + call cnveg_carbonflux_inst%dwt_conv_cflux_dribbler%get_amount_left_to_dribble_end( & + bounds, dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg)) + grc_endcb(g) = totgrcc(g) + tot_woodprod_grc(g) + cropprod1_grc(g) + & + hrv_xsmrpool_amount_left_to_dribble(g) + & + dwt_conv_cflux_amount_left_to_dribble(g) + + ! calculate total gridcell-level inputs + ! slevis notes: + ! nbp_grc = nep_grc - fire_closs_grc - hrv_xsmrpool_to_atm_dribbled_grc - dwt_conv_cflux_dribbled_grc - product_closs_grc + grc_cinputs = nbp_grc(g) + & + dwt_seedc_to_leaf_grc(g) + dwt_seedc_to_deadstem_grc(g) + + ! calculate total gridcell-level outputs + grc_coutputs = - som_c_leached_grc(g) + + ! calculate the total gridcell-level carbon balance error + ! for this time step + grc_errcb(g) = (grc_cinputs - grc_coutputs) * dt - & + (grc_endcb(g) - grc_begcb(g)) + + ! check for significant errors + if (abs(grc_errcb(g)) > this%cerror) then + err_found = .true. + err_index = g + end if + if (abs(grc_errcb(g)) > this%cwarning) then + write(iulog,*) 'cbalance warning at g =', g, grc_errcb(g), grc_endcb(g) + end if + end do ! end of gridcell loop + + if (err_found) then + g = err_index + write(iulog,*)'gridcell cbalance error =', grc_errcb(g), g + write(iulog,*)'latdeg, londeg =', grc%latdeg(g), grc%londeg(g) + write(iulog,*)'begcb =', grc_begcb(g) + write(iulog,*)'endcb =', grc_endcb(g) + write(iulog,*)'delta store =', grc_endcb(g) - grc_begcb(g) + write(iulog,*)'--- Inputs ---' + write(iulog,*)'nbp_grc =', nbp_grc(g) * dt + write(iulog,*)'dwt_seedc_to_leaf_grc =', dwt_seedc_to_leaf_grc(g) * dt + write(iulog,*)'dwt_seedc_to_deadstem_grc =', dwt_seedc_to_deadstem_grc(g) * dt + write(iulog,*)'--- Outputs ---' + write(iulog,*)'-1*som_c_leached_grc = ', som_c_leached_grc(g) * dt + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end associate + + end subroutine CBalanceCheck + + !----------------------------------------------------------------------- + subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & + soilbiogeochem_nitrogenflux_inst, cnveg_nitrogenflux_inst, & + cnveg_nitrogenstate_inst, n_products_inst, atm2lnd_inst) + ! + ! !DESCRIPTION: + ! Perform nitrogen mass conservation check + ! + ! !USES: + use clm_varctl, only : use_crop + use subgridAveMod, only: c2g + use atm2lndType, only: atm2lnd_type + ! + ! !ARGUMENTS: + class(cn_balance_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc (:) ! filter for soil columns + type(soilbiogeochem_nitrogenflux_type) , intent(in) :: soilbiogeochem_nitrogenflux_inst + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cn_products_type) , intent(in) :: n_products_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + ! + ! !LOCAL VARIABLES: + integer :: c,err_index,j ! indices + integer :: g ! gridcell index + integer :: fc ! lake filter indices + logical :: err_found ! error flag + real(r8):: dt ! radiation time step (seconds) + real(r8):: col_ninputs(bounds%begc:bounds%endc) + real(r8):: col_noutputs(bounds%begc:bounds%endc) + real(r8):: col_errnb(bounds%begc:bounds%endc) + real(r8):: col_ninputs_partial(bounds%begc:bounds%endc) + real(r8):: col_noutputs_partial(bounds%begc:bounds%endc) + real(r8):: grc_ninputs_partial(bounds%begg:bounds%endg) + real(r8):: grc_noutputs_partial(bounds%begg:bounds%endg) + real(r8):: grc_ninputs(bounds%begg:bounds%endg) + real(r8):: grc_noutputs(bounds%begg:bounds%endg) + real(r8):: grc_errnb(bounds%begg:bounds%endg) + !----------------------------------------------------------------------- + + associate( & + grc_begnb => this%begnb_grc , & ! Input: [real(r8) (:) ] (gN/m2) gridcell nitrogen mass, beginning of time step + grc_endnb => this%endnb_grc , & ! Output: [real(r8) (:) ] (gN/m2) gridcell nitrogen mass, end of time step + totgrcn => cnveg_nitrogenstate_inst%totn_grc , & ! Input: [real(r8) (:) ] (gN/m2) total gridcell nitrogen, incl veg + cropprod1_grc => n_products_inst%cropprod1_grc , & ! Input: [real(r8) (:)] (gN/m2) nitrogen in crop products + product_loss_grc => n_products_inst%product_loss_grc , & ! Input: [real(r8) (:)] (gN/m2) losses from wood & crop products + tot_woodprod_grc => n_products_inst%tot_woodprod_grc , & ! Input: [real(r8) (:)] (gN/m2) total nitrogen in wood products + dwt_seedn_to_leaf_grc => cnveg_nitrogenflux_inst%dwt_seedn_to_leaf_grc , & ! Input: [real(r8) (:)] (gN/m2/s) seed source sent to leaf + dwt_seedn_to_deadstem_grc => cnveg_nitrogenflux_inst%dwt_seedn_to_deadstem_grc , & ! Input: [real(r8) (:)] (gN/m2/s) seed source sent to deadstem + dwt_conv_nflux_grc => cnveg_nitrogenflux_inst%dwt_conv_nflux_grc , & ! Input: [real(r8) (:)] (gN/m2/s) dwt_conv_nflux_patch summed to the gridcell-level + col_begnb => this%begnb_col , & ! Input: [real(r8) (:) ] (gN/m2) column nitrogen mass, beginning of time step + col_endnb => this%endnb_col , & ! Output: [real(r8) (:) ] (gN/m2) column nitrogen mass, end of time step + ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) atmospheric N deposition to soil mineral N + nfix_to_sminn => soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) symbiotic/asymbiotic N fixation to soil mineral N + ffix_to_sminn => soilbiogeochem_nitrogenflux_inst%ffix_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) free living N fixation to soil mineral N + fert_to_sminn => soilbiogeochem_nitrogenflux_inst%fert_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) + soyfixn_to_sminn => soilbiogeochem_nitrogenflux_inst%soyfixn_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) + supplement_to_sminn => soilbiogeochem_nitrogenflux_inst%supplement_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) supplemental N supply + denit => soilbiogeochem_nitrogenflux_inst%denit_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total rate of denitrification + sminn_leached => soilbiogeochem_nitrogenflux_inst%sminn_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral N pool loss to leaching + smin_no3_leached => soilbiogeochem_nitrogenflux_inst%smin_no3_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral NO3 pool loss to leaching + smin_no3_runoff => soilbiogeochem_nitrogenflux_inst%smin_no3_runoff_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral NO3 pool loss to runoff + f_n2o_nit => soilbiogeochem_nitrogenflux_inst%f_n2o_nit_col , & ! Input: [real(r8) (:) ] (gN/m2/s) flux of N2o from nitrification + som_n_leached => soilbiogeochem_nitrogenflux_inst%som_n_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total SOM N loss from vertical transport + + col_fire_nloss => cnveg_nitrogenflux_inst%fire_nloss_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total column-level fire N loss + wood_harvestn => cnveg_nitrogenflux_inst%wood_harvestn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) wood harvest (to product pools) + grainn_to_cropprodn => cnveg_nitrogenflux_inst%grainn_to_cropprodn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) grain N to 1-year crop product pool + + totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg + ) + + ! set time steps + dt = get_step_size_real() + + ! initialize local arrays + col_ninputs_partial(:) = 0._r8 + col_noutputs_partial(:) = 0._r8 + + err_found = .false. + do fc = 1,num_soilc + c=filter_soilc(fc) + + ! calculate the total column-level nitrogen storage, for mass conservation check + col_endnb(c) = totcoln(c) + + ! calculate total column-level inputs + col_ninputs(c) = ndep_to_sminn(c) + nfix_to_sminn(c) + supplement_to_sminn(c) + + if(use_fun)then + col_ninputs(c) = col_ninputs(c) + ffix_to_sminn(c) ! for FUN, free living fixation is a seprate flux. RF. + endif + + if (use_crop) then + col_ninputs(c) = col_ninputs(c) + fert_to_sminn(c) + soyfixn_to_sminn(c) + end if + + col_ninputs_partial(c) = col_ninputs(c) + + ! calculate total column-level outputs + col_noutputs(c) = denit(c) + col_fire_nloss(c) + + ! Fluxes to product pools are included in column-level outputs: the product + ! pools are not included in totcoln, so are outside the system with respect to + ! these balance checks. (However, the dwt flux to product pools is NOT included, + ! since col_begnb is initialized after the dynamic area adjustments - i.e., + ! after the dwt term has already been taken out.) + col_noutputs(c) = col_noutputs(c) + & + wood_harvestn(c) + & + grainn_to_cropprodn(c) + + if (.not. use_nitrif_denitrif) then + col_noutputs(c) = col_noutputs(c) + sminn_leached(c) + else + col_noutputs(c) = col_noutputs(c) + f_n2o_nit(c) + + col_noutputs(c) = col_noutputs(c) + smin_no3_leached(c) + smin_no3_runoff(c) + end if + + col_noutputs(c) = col_noutputs(c) - som_n_leached(c) + + col_noutputs_partial(c) = col_noutputs(c) - & + wood_harvestn(c) - & + grainn_to_cropprodn(c) + + ! calculate the total column-level nitrogen balance error for this time step + col_errnb(c) = (col_ninputs(c) - col_noutputs(c))*dt - & + (col_endnb(c) - col_begnb(c)) + + if (abs(col_errnb(c)) > this%nerror) then + err_found = .true. + err_index = c + end if + + if (abs(col_errnb(c)) > this%nwarning) then + write(iulog,*) 'nbalance warning at c =', c, col_errnb(c), col_endnb(c) + write(iulog,*)'inputs,ffix,nfix,ndep = ',ffix_to_sminn(c)*dt,nfix_to_sminn(c)*dt,ndep_to_sminn(c)*dt + write(iulog,*)'outputs,lch,roff,dnit = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt + end if + + end do ! end of columns loop + + if (err_found) then + c = err_index + write(iulog,*)'column nbalance error = ',col_errnb(c), c + write(iulog,*)'Latdeg,Londeg = ',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) + write(iulog,*)'begnb = ',col_begnb(c) + write(iulog,*)'endnb = ',col_endnb(c) + write(iulog,*)'delta store = ',col_endnb(c)-col_begnb(c) + write(iulog,*)'input mass = ',col_ninputs(c)*dt + write(iulog,*)'output mass = ',col_noutputs(c)*dt + write(iulog,*)'net flux = ',(col_ninputs(c)-col_noutputs(c))*dt + write(iulog,*)'inputs,ffix,nfix,ndep = ',ffix_to_sminn(c)*dt,nfix_to_sminn(c)*dt,ndep_to_sminn(c)*dt + write(iulog,*)'outputs,ffix,nfix,ndep = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt + + + + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Repeat error check at the gridcell level + call c2g( bounds = bounds, & + carr = totcoln(bounds%begc:bounds%endc), & + garr = totgrcn(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + call c2g( bounds = bounds, & + carr = col_ninputs_partial(bounds%begc:bounds%endc), & + garr = grc_ninputs_partial(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + call c2g( bounds = bounds, & + carr = col_noutputs_partial(bounds%begc:bounds%endc), & + garr = grc_noutputs_partial(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + err_found = .false. + do g = bounds%begg, bounds%endg + ! calculate the total gridcell-level nitrogen storage, for mass conservation check + ! Notes: + ! Not including seedn_grc in grc_begnb and grc_endnb because + ! seedn_grc forms out of thin air, for now, and equals + ! -1 * (dwt_seedn_to_leaf_grc(g) + dwt_seedn_to_deadstem_grc(g)) + ! We account for the latter fluxes as inputs below; the same + ! fluxes have entered the pools earlier in the timestep. For true + ! conservation we would need to add a flux out of nfix into seed. + grc_endnb(g) = totgrcn(g) + tot_woodprod_grc(g) + cropprod1_grc(g) + + ! calculate total gridcell-level inputs + grc_ninputs(g) = grc_ninputs_partial(g) + & + dwt_seedn_to_leaf_grc(g) + & + dwt_seedn_to_deadstem_grc(g) + + ! calculate total gridcell-level outputs + grc_noutputs(g) = grc_noutputs_partial(g) + & + dwt_conv_nflux_grc(g) + & + product_loss_grc(g) + + ! calculate the total gridcell-level nitrogen balance error for this time step + grc_errnb(g) = (grc_ninputs(g) - grc_noutputs(g)) * dt - & + (grc_endnb(g) - grc_begnb(g)) + + if (abs(grc_errnb(g)) > this%nerror) then + err_found = .true. + err_index = g + end if + + if (abs(grc_errnb(g)) > this%nwarning) then + write(iulog,*) 'nbalance warning at g =', g, grc_errnb(g), grc_endnb(g) + end if + end do + + if (err_found) then + g = err_index + write(iulog,*) 'gridcell nbalance error =', grc_errnb(g), g + write(iulog,*) 'latdeg, londeg =', grc%latdeg(g), grc%londeg(g) + write(iulog,*) 'begnb =', grc_begnb(g) + write(iulog,*) 'endnb =', grc_endnb(g) + write(iulog,*) 'delta store =', grc_endnb(g) - grc_begnb(g) + write(iulog,*) 'input mass =', grc_ninputs(g) * dt + write(iulog,*) 'output mass =', grc_noutputs(g) * dt + write(iulog,*) 'net flux =', (grc_ninputs(g) - grc_noutputs(g)) * dt + write(iulog,*) '--- Inputs ---' + write(iulog,*) 'grc_ninputs_partial =', grc_ninputs_partial(g) * dt + write(iulog,*) 'dwt_seedn_to_leaf_grc =', dwt_seedn_to_leaf_grc(g) * dt + write(iulog,*) 'dwt_seedn_to_deadstem_grc =', dwt_seedn_to_deadstem_grc(g) * dt + write(iulog,*) '--- Outputs ---' + write(iulog,*) 'grc_noutputs_partial =', grc_noutputs_partial(g) * dt + write(iulog,*) 'dwt_conv_nflux_grc =', dwt_conv_nflux_grc(g) * dt + write(iulog,*) 'product_loss_grc =', product_loss_grc(g) * dt + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end associate + + end subroutine NBalanceCheck + +end module CNBalanceCheckMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index f4d4d97cc..e97b05108 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -357,6 +357,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & rssun = photosyns_inst%rssun_patch rssha = photosyns_inst%rssha_patch + call PhotosynthesisTotal (fn, filterp, & + atm2lnd_inst, canopystate_inst, photosyns_inst) + np = 0 do nc = 1,nch ! catchment tile loop do nz = 1,num_zon ! CN zone loop diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 index 46bd13bc5..fc1ec296e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -19,6 +19,22 @@ module CNCLM_CNDVType ! !PUBLIC MEMBER FUNCTIONS: public :: init_dgvs_type + ! !PUBLIC DATA TYPES: + ! + ! DGVM-specific ecophysiological constants structure (patch-level) + type, public :: dgv_ecophyscon_type + real(r8), pointer :: crownarea_max(:) ! patch tree maximum crown area [m2] + real(r8), pointer :: tcmin(:) ! patch minimum coldest monthly mean temperature [units?] + real(r8), pointer :: tcmax(:) ! patch maximum coldest monthly mean temperature [units?] + real(r8), pointer :: gddmin(:) ! patch minimum growing degree days (at or above 5 C) + real(r8), pointer :: twmax(:) ! patch upper limit of temperature of the warmest month [units?] + real(r8), pointer :: reinickerp(:) ! patch parameter in allometric equation + real(r8), pointer :: allom1(:) ! patch parameter in allometric + real(r8), pointer :: allom2(:) ! patch parameter in allometric + real(r8), pointer :: allom3(:) ! patch parameter in allometric + end type dgv_ecophyscon_type + type(dgv_ecophyscon_type), public :: dgv_ecophyscon + ! DGVM state variables structure type, public :: dgvs_type real(r8), pointer, public :: agdd_patch (:) ! patch accumulated growing degree days above 5 @@ -45,6 +61,12 @@ module CNCLM_CNDVType !------------------------------------------------------ subroutine init_dgvs_type(bounds, this) + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : maxveg + use pftconMod , only : allom1s, allom2s, allom1, allom2, allom3, reinickerp + use pftconMod , only : nbrdlf_dcd_brl_shrub + use pftconMod , only : pftcon + ! !ARGUMENTS: implicit none !INPUT/OUTPUT @@ -73,6 +95,33 @@ subroutine init_dgvs_type(bounds, this) allocate(this%greffic_patch (begp:endp)) ; this%greffic_patch (:) = nan allocate(this%heatstress_patch (begp:endp)) ; this%heatstress_patch (:) = nan + + allocate(dgv_ecophyscon%crownarea_max (0:maxveg)) + allocate(dgv_ecophyscon%tcmin (0:maxveg)) + allocate(dgv_ecophyscon%tcmax (0:maxveg)) + allocate(dgv_ecophyscon%gddmin (0:maxveg)) + allocate(dgv_ecophyscon%twmax (0:maxveg)) + allocate(dgv_ecophyscon%reinickerp (0:maxveg)) + allocate(dgv_ecophyscon%allom1 (0:maxveg)) + allocate(dgv_ecophyscon%allom2 (0:maxveg)) + allocate(dgv_ecophyscon%allom3 (0:maxveg)) + + do m = 0,maxveg + dgv_ecophyscon%crownarea_max(m) = pftcon%pftpar20(m) + dgv_ecophyscon%tcmin(m) = pftcon%pftpar28(m) + dgv_ecophyscon%tcmax(m) = pftcon%pftpar29(m) + dgv_ecophyscon%gddmin(m) = pftcon%pftpar30(m) + dgv_ecophyscon%twmax(m) = pftcon%pftpar31(m) + dgv_ecophyscon%reinickerp(m) = reinickerp + dgv_ecophyscon%allom1(m) = allom1 + dgv_ecophyscon%allom2(m) = allom2 + dgv_ecophyscon%allom3(m) = allom3 + ! modification for shrubs by X.D.Z + if (pftcon%is_shrub(m)) then + dgv_ecophyscon%allom1(m) = allom1s + dgv_ecophyscon%allom2(m) = allom2s + end if + end do end subroutine init_dgvs_type end module CNCLM_CNDVType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index f7e90ca4f..1820cc5f0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -16,6 +16,8 @@ module CNCLM_CNVegCarbonFluxType use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight use clm_varcon , only : spval + use PatchType , only : patch + use AnnualFluxDribbler , only : annual_flux_dribbler_type, annual_flux_dribbler_gridcell ! !PUBLIC TYPES: implicit none @@ -457,10 +459,16 @@ module CNCLM_CNVegCarbonFluxType integer,pointer :: list_agmc (:) ! Indices of non-diagnoal entries in full sparse matrix Agm for C cycle integer,pointer :: list_afic (:) ! Indices of non-diagnoal entries in full sparse matrix Afi for C cycle + ! Objects that help convert once-per-year dynamic land cover changes into fluxes + ! that are dribbled throughout the year + type(annual_flux_dribbler_type) :: dwt_conv_cflux_dribbler + type(annual_flux_dribbler_type) :: hrv_xsmrpool_to_atm_dribbler + logical, private :: dribble_crophrv_xsmrpool_2atm + contains procedure , public :: SetValues - + procedure , public :: Summary => Summary_carbonflux end type cnveg_carbonflux_type @@ -469,7 +477,7 @@ module CNCLM_CNVegCarbonFluxType contains !--------------------------------------- - subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, this) + subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) ! !DESCRIPTION: ! Initialize CTSM carbon fluxes @@ -486,15 +494,28 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart - type(cnveg_carbonflux_type), intent(inout):: this + logical, optional, intent(in) :: cn5_cold_start + type(cnveg_carbonflux_type), intent(inout):: this ! LOCAL integer :: begp, endp integer :: begc, endc integer :: begg, endg integer :: np, nc, nz, p, nv, n + logical :: cold_start = .false. !-------------------------------------------------------- + ! check whether a cn5_cold_start option was set and change cold_start accordingly + if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + cold_start = .true. + end if + + ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + (size(cnpft,3).ne.var_pft))) + _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') + end if + this%ileafst_to_ileafxf_ph = 1 this%matrix_phtransfer_doner_patch(this%ileafst_to_ileafxf_ph) = ileaf_st this%matrix_phtransfer_receiver_patch(this%ileafst_to_ileafxf_ph) = ileaf_xf @@ -1054,6 +1075,7 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + ! "old" variables: CNCLM45 and before this%annsum_npp_patch (np) = cnpft(nc,nz,nv, 26) this%prev_frootc_to_litter_patch (np) = cnpft(nc,nz,nv, 41) this%prev_leafc_to_litter_patch (np) = cnpft(nc,nz,nv, 42) @@ -1061,7 +1083,19 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi this%xsmrpool_recover_patch (np) = cnpft(nc,nz,nv, 47) this%dwt_wood_productc_gain_patch(np) = 0. ! following CNCLM45 setting this%dwt_crop_productc_gain_patch(np) = 0. ! following CNCLM45 setting - + + + ! "new" variables: introduced in CNCLM50 + if (cold_start==.false.) then + this%annsum_litfall_patch(np) = cnpft(nc,nz,nv, 80) + this%tempsum_litfall_patch(np) = cnpft(nc,nz,nv, 81) + elseif (cold_start) then + this%annsum_litfall_patch(np) = spval + this%tempsum_litfall_patch(np) = spval + else + _ASSERT(.FALSE.,'missing CNCLM50_cold_start setting') + end if + end if end do !nv end do ! p @@ -1452,6 +1486,655 @@ subroutine SetValues ( this, nvegcpool, & end subroutine SetValues + !----------------------------------------------------------------------- + subroutine Summary_carbonflux(this, & + bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope, soilbiogeochem_hr_col, soilbiogeochem_lithr_col, & + soilbiogeochem_decomp_cascade_ctransfer_col, & + product_closs_grc) + ! + ! !DESCRIPTION: + ! Perform patch and column-level carbon summary calculations + ! + ! !USES: + use clm_time_manager , only: get_step_size_real + use clm_varcon , only: secspday + use clm_varctl , only: nfix_timeconst, carbon_resp_opt + use subgridAveMod , only: p2c, c2g + use SoilBiogeochemDecompCascadeConType , only: decomp_cascade_con + use CNSharedParamsMod , only: use_fun + ! + ! !ARGUMENTS: + class(cnveg_carbonflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + character(len=*) , intent(in) :: isotope + real(r8) , intent(in) :: soilbiogeochem_hr_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_lithr_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_decomp_cascade_ctransfer_col(bounds%begc:,1:) + real(r8) , intent(in) :: product_closs_grc(bounds%begg:) + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l,g ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: nfixlags, dtime ! temp variables for making lagged npp + real(r8) :: maxdepth ! depth to integrate soil variables + real(r8) :: nep_grc(bounds%begg:bounds%endg) ! nep_col averaged to gridcell + real(r8) :: fire_closs_grc(bounds%begg:bounds%endg) ! fire_closs_col averaged to gridcell + real(r8) :: hrv_xsmrpool_to_atm_grc(bounds%begg:bounds%endg) ! hrv_xsmrpool_to_atm_col averaged to gridcell (gC/m2/s) + real(r8) :: hrv_xsmrpool_to_atm_delta_grc(bounds%begg:bounds%endg) ! hrv_xsmrpool_to_atm_col averaged to gridcell, expressed as a delta (not a flux) (gC/m2) + real(r8) :: hrv_xsmrpool_to_atm_dribbled_grc(bounds%begg:bounds%endg) ! hrv_xsmrpool_to_atm, dribbled over the year (gC/m2/s) + real(r8) :: dwt_conv_cflux_delta_grc(bounds%begg:bounds%endg) ! dwt_conv_cflux_grc expressed as a total delta (not a flux) (gC/m2) + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(product_closs_grc) == (/bounds%endg/)), sourcefile, __LINE__) + + ! calculate patch-level summary carbon fluxes and states + + dtime = get_step_size_real() + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! maintenance respiration (MR) + if ( trim(isotope) == 'c13' .or. trim(isotope) == 'c14') then + this%leaf_mr_patch(p) = this%leaf_curmr_patch(p) + this%leaf_xsmr_patch(p) + this%froot_mr_patch(p) = this%froot_curmr_patch(p) + this%froot_xsmr_patch(p) + this%livestem_mr_patch(p) = this%livestem_curmr_patch(p) + this%livestem_xsmr_patch(p) + this%livecroot_mr_patch(p) = this%livecroot_curmr_patch(p) + this%livecroot_xsmr_patch(p) + endif + + this%mr_patch(p) = & + this%leaf_mr_patch(p) + & + this%froot_mr_patch(p) + & + this%livestem_mr_patch(p) + & + this%livecroot_mr_patch(p) + + if (carbon_resp_opt == 1) then + this%mr_patch(p) = & + this%cpool_to_resp_patch(p) + & + this%leaf_mr_patch(p) + & + this%froot_mr_patch(p) + & + this%livestem_mr_patch(p) + & + this%livecroot_mr_patch(p) + end if + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%mr_patch(p) = & + this%mr_patch(p) + & + this%grain_mr_patch(p) + end if + + ! growth respiration (GR) + + ! current GR is respired this time step for new growth displayed in this timestep + this%current_gr_patch(p) = & + this%cpool_leaf_gr_patch(p) + & + this%cpool_froot_gr_patch(p) + & + this%cpool_livestem_gr_patch(p) + & + this%cpool_deadstem_gr_patch(p) + & + this%cpool_livecroot_gr_patch(p) + & + this%cpool_deadcroot_gr_patch(p) + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%current_gr_patch(p) = this%current_gr_patch(p) + & + this%cpool_grain_gr_patch(p) + end if + + + ! transfer GR is respired this time step for transfer growth displayed in this timestep + this%transfer_gr_patch(p) = & + this%transfer_leaf_gr_patch(p) + & + this%transfer_froot_gr_patch(p) + & + this%transfer_livestem_gr_patch(p) + & + this%transfer_deadstem_gr_patch(p) + & + this%transfer_livecroot_gr_patch(p) + & + this%transfer_deadcroot_gr_patch(p) + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%transfer_gr_patch(p) = this%transfer_gr_patch(p) + & + this%transfer_grain_gr_patch(p) + end if + + ! storage GR is respired this time step for growth sent to storage for later display + this%storage_gr_patch(p) = & + this%cpool_leaf_storage_gr_patch(p) + & + this%cpool_froot_storage_gr_patch(p) + & + this%cpool_livestem_storage_gr_patch(p) + & + this%cpool_deadstem_storage_gr_patch(p) + & + this%cpool_livecroot_storage_gr_patch(p) + & + this%cpool_deadcroot_storage_gr_patch(p) + + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%storage_gr_patch(p) = this%storage_gr_patch(p) + & + this%cpool_grain_storage_gr_patch(p) + end if + + ! GR is the sum of current + transfer + storage GR + this%gr_patch(p) = & + this%current_gr_patch(p) + & + this%transfer_gr_patch(p) + & + this%storage_gr_patch(p) + + + ! autotrophic respiration (AR) adn + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%ar_patch(p) = & + this%mr_patch(p) + & + this%gr_patch(p) + if ( .not. this%dribble_crophrv_xsmrpool_2atm ) this%ar_patch(p) = this%ar_patch(p) + & + this%xsmrpool_to_atm_patch(p) ! xsmr... is -ve (slevis) + else + this%ar_patch(p) = & + this%mr_patch(p) + & + this%gr_patch(p) + end if + + if (use_fun) then + this%ar_patch(p) = this%ar_patch(p) + this%soilc_change_patch(p) + end if + + ! gross primary production (GPP) + this%gpp_patch(p) = & + this%psnsun_to_cpool_patch(p) + & + this%psnshade_to_cpool_patch(p) + + ! net primary production (NPP) + this%npp_patch(p) = & + this%gpp_patch(p) - & + this%ar_patch(p) + + + ! root respiration (RR) + this%rr_patch(p) = & + this%froot_mr_patch(p) + & + this%cpool_froot_gr_patch(p) + & + this%cpool_livecroot_gr_patch(p) + & + this%cpool_deadcroot_gr_patch(p) + & + this%transfer_froot_gr_patch(p) + & + this%transfer_livecroot_gr_patch(p) + & + this%transfer_deadcroot_gr_patch(p) + & + this%cpool_froot_storage_gr_patch(p) + & + this%cpool_livecroot_storage_gr_patch(p) + & + this%cpool_deadcroot_storage_gr_patch(p) + + ! update the annual NPP accumulator, for use in allocation code + if (trim(isotope) == 'bulk') then + this%tempsum_npp_patch(p) = & + this%tempsum_npp_patch(p) + & + this%npp_patch(p) + end if + + ! aboveground NPP: leaf, live stem, dead stem (AGNPP) + ! This is supposed to correspond as closely as possible to + ! field measurements of AGNPP, so it ignores the storage pools + ! and only treats the fluxes into displayed pools. + + this%agnpp_patch(p) = & + this%cpool_to_leafc_patch(p) + & + this%leafc_xfer_to_leafc_patch(p) + & + this%cpool_to_livestemc_patch(p) + & + this%livestemc_xfer_to_livestemc_patch(p) + & + this%cpool_to_deadstemc_patch(p) + & + this%deadstemc_xfer_to_deadstemc_patch(p) + + + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%agnpp_patch(p) = & + this%agnpp_patch(p) + & + this%cpool_to_grainc_patch(p) + & + this%grainc_xfer_to_grainc_patch(p) + end if + + ! belowground NPP: fine root, live coarse root, dead coarse root (BGNPP) + ! This is supposed to correspond as closely as possible to + ! field measurements of BGNPP, so it ignores the storage pools + ! and only treats the fluxes into displayed pools. + + this%bgnpp_patch(p) = & + this%cpool_to_frootc_patch(p) + & + this%frootc_xfer_to_frootc_patch(p) + & + this%cpool_to_livecrootc_patch(p) + & + this%livecrootc_xfer_to_livecrootc_patch(p) + & + this%cpool_to_deadcrootc_patch(p) + & + this%deadcrootc_xfer_to_deadcrootc_patch(p) + + ! litterfall (LITFALL) + + this%litfall_patch(p) = & + this%leafc_to_litter_patch(p) + & + this%frootc_to_litter_patch(p) + & + this%m_leafc_to_litter_patch(p) + & + this%m_leafc_storage_to_litter_patch(p) + & + this%m_leafc_xfer_to_litter_patch(p) + & + this%m_frootc_to_litter_patch(p) + & + this%m_frootc_storage_to_litter_patch(p) + & + this%m_frootc_xfer_to_litter_patch(p) + & + this%m_livestemc_to_litter_patch(p) + & + this%m_livestemc_storage_to_litter_patch(p) + & + this%m_livestemc_xfer_to_litter_patch(p) + & + this%m_deadstemc_to_litter_patch(p) + & + this%m_deadstemc_storage_to_litter_patch(p) + & + this%m_deadstemc_xfer_to_litter_patch(p) + & + this%m_livecrootc_to_litter_patch(p) + & + this%m_livecrootc_storage_to_litter_patch(p) + & + this%m_livecrootc_xfer_to_litter_patch(p) + & + this%m_deadcrootc_to_litter_patch(p) + & + this%m_deadcrootc_storage_to_litter_patch(p) + & + this%m_deadcrootc_xfer_to_litter_patch(p) + & + this%m_gresp_storage_to_litter_patch(p) + & + this%m_gresp_xfer_to_litter_patch(p) + & + + this%m_leafc_to_litter_fire_patch(p) + & + this%m_leafc_storage_to_litter_fire_patch(p) + & + this%m_leafc_xfer_to_litter_fire_patch(p) + & + this%m_livestemc_to_litter_fire_patch(p) + & + this%m_livestemc_storage_to_litter_fire_patch(p) + & + this%m_livestemc_xfer_to_litter_fire_patch(p) + & + this%m_deadstemc_to_litter_fire_patch(p) + & + this%m_deadstemc_storage_to_litter_fire_patch(p) + & + this%m_deadstemc_xfer_to_litter_fire_patch(p) + & + this%m_frootc_to_litter_fire_patch(p) + & + this%m_frootc_storage_to_litter_fire_patch(p) + & + this%m_frootc_xfer_to_litter_fire_patch(p) + & + this%m_livecrootc_to_litter_fire_patch(p) + & + this%m_livecrootc_storage_to_litter_fire_patch(p) + & + this%m_livecrootc_xfer_to_litter_fire_patch(p) + & + this%m_deadcrootc_to_litter_fire_patch(p) + & + this%m_deadcrootc_storage_to_litter_fire_patch(p) + & + this%m_deadcrootc_xfer_to_litter_fire_patch(p) + & + this%m_gresp_storage_to_litter_fire_patch(p) + & + this%m_gresp_xfer_to_litter_fire_patch(p) + & + + this%hrv_leafc_to_litter_patch(p) + & + this%hrv_leafc_storage_to_litter_patch(p) + & + this%hrv_leafc_xfer_to_litter_patch(p) + & + this%hrv_frootc_to_litter_patch(p) + & + this%hrv_frootc_storage_to_litter_patch(p) + & + this%hrv_frootc_xfer_to_litter_patch(p) + & + this%hrv_livestemc_to_litter_patch(p) + & + this%hrv_livestemc_storage_to_litter_patch(p) + & + this%hrv_livestemc_xfer_to_litter_patch(p) + & + this%hrv_deadstemc_storage_to_litter_patch(p) + & + this%hrv_deadstemc_xfer_to_litter_patch(p) + & + this%hrv_livecrootc_to_litter_patch(p) + & + this%hrv_livecrootc_storage_to_litter_patch(p) + & + this%hrv_livecrootc_xfer_to_litter_patch(p) + & + this%hrv_deadcrootc_to_litter_patch(p) + & + this%hrv_deadcrootc_storage_to_litter_patch(p) + & + this%hrv_deadcrootc_xfer_to_litter_patch(p) + & + this%hrv_gresp_storage_to_litter_patch(p) + & + this%hrv_gresp_xfer_to_litter_patch(p) + + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%litfall_patch(p) = & + this%litfall_patch(p) + & + this%livestemc_to_litter_patch(p) + + if (.not. use_grainproduct) then + this%litfall_patch(p) = & + this%litfall_patch(p) + & + this%grainc_to_food_patch(p) + end if + end if + + ! update the annual litfall accumulator, for use in mortality code + + if (use_cndv) then + this%tempsum_litfall_patch(p) = & + this%tempsum_litfall_patch(p) + & + this%leafc_to_litter_patch(p) + & + this%frootc_to_litter_patch(p) + end if + + ! patch-level carbon losses to fire changed by F. Li and S. Levis + + this%fire_closs_patch(p) = & + this%m_leafc_to_fire_patch(p) + & + this%m_leafc_storage_to_fire_patch(p) + & + this%m_leafc_xfer_to_fire_patch(p) + & + this%m_frootc_to_fire_patch(p) + & + this%m_frootc_storage_to_fire_patch(p) + & + this%m_frootc_xfer_to_fire_patch(p) + & + this%m_livestemc_to_fire_patch(p) + & + this%m_livestemc_storage_to_fire_patch(p) + & + this%m_livestemc_xfer_to_fire_patch(p) + & + this%m_deadstemc_to_fire_patch(p) + & + this%m_deadstemc_storage_to_fire_patch(p) + & + this%m_deadstemc_xfer_to_fire_patch(p) + & + this%m_livecrootc_to_fire_patch(p) + & + this%m_livecrootc_storage_to_fire_patch(p) + & + this%m_livecrootc_xfer_to_fire_patch(p) + & + this%m_deadcrootc_to_fire_patch(p) + & + this%m_deadcrootc_storage_to_fire_patch(p) + & + this%m_deadcrootc_xfer_to_fire_patch(p) + & + this%m_gresp_storage_to_fire_patch(p) + & + this%m_gresp_xfer_to_fire_patch(p) + + ! new summary variables for CLAMP + + ! (FROOTC_ALLOC) - fine root C allocation + this%frootc_alloc_patch(p) = & + this%frootc_xfer_to_frootc_patch(p) + & + this%cpool_to_frootc_patch(p) + + ! (FROOTC_LOSS) - fine root C loss changed by F. Li and S. Levis + this%frootc_loss_patch(p) = & + this%m_frootc_to_litter_patch(p) + & + this%m_frootc_to_fire_patch(p) + & + this%m_frootc_to_litter_fire_patch(p) + & + this%hrv_frootc_to_litter_patch(p) + & + this%frootc_to_litter_patch(p) + + ! (LEAFC_ALLOC) - leaf C allocation + this%leafc_alloc_patch(p) = & + this%leafc_xfer_to_leafc_patch(p) + & + this%cpool_to_leafc_patch(p) + + ! (LEAFC_LOSS) - leaf C loss changed by F. Li and S. Levis + this%leafc_loss_patch(p) = & + this%m_leafc_to_litter_patch(p) + & + this%m_leafc_to_fire_patch(p) + & + this%m_leafc_to_litter_fire_patch(p) + & + this%hrv_leafc_to_litter_patch(p) + & + this%leafc_to_litter_patch(p) + + ! (WOODC_ALLOC) - wood C allocation + this%woodc_alloc_patch(p) = & + this%livestemc_xfer_to_livestemc_patch(p) + & + this%deadstemc_xfer_to_deadstemc_patch(p) + & + this%livecrootc_xfer_to_livecrootc_patch(p) + & + this%deadcrootc_xfer_to_deadcrootc_patch(p) + & + this%cpool_to_livestemc_patch(p) + & + this%cpool_to_deadstemc_patch(p) + & + this%cpool_to_livecrootc_patch(p) + & + this%cpool_to_deadcrootc_patch(p) + + + + ! (WOODC_LOSS) - wood C loss + this%woodc_loss_patch(p) = & + this%m_livestemc_to_litter_patch(p) + & + this%m_deadstemc_to_litter_patch(p) + & + this%m_livecrootc_to_litter_patch(p) + & + this%m_deadcrootc_to_litter_patch(p) + & + this%m_livestemc_to_fire_patch(p) + & + this%m_deadstemc_to_fire_patch(p) + & + this%m_livecrootc_to_fire_patch(p) + & + this%m_deadcrootc_to_fire_patch(p) + & + this%hrv_livestemc_to_litter_patch(p) + & + this%hrv_livestemc_storage_to_litter_patch(p) + & + this%hrv_livestemc_xfer_to_litter_patch(p) + & + this%wood_harvestc_patch(p) + & + this%hrv_deadstemc_storage_to_litter_patch(p) + & + this%hrv_deadstemc_xfer_to_litter_patch(p) + & + this%hrv_livecrootc_to_litter_patch(p) + & + this%hrv_livecrootc_storage_to_litter_patch(p) + & + this%hrv_livecrootc_xfer_to_litter_patch(p) + & + this%hrv_deadcrootc_to_litter_patch(p) + & + this%hrv_deadcrootc_storage_to_litter_patch(p) + & + this%hrv_deadcrootc_xfer_to_litter_patch(p) + + + ! (Slash Harvest Flux) - Additional Wood Harvest Veg C Losses + this%slash_harvestc_patch(p) = & + this%hrv_leafc_to_litter_patch(p) + & + this%hrv_leafc_storage_to_litter_patch(p) + & + this%hrv_leafc_xfer_to_litter_patch(p) + & + this%hrv_frootc_to_litter_patch(p) + & + this%hrv_frootc_storage_to_litter_patch(p) + & + this%hrv_frootc_xfer_to_litter_patch(p) + & + this%hrv_livestemc_to_litter_patch(p) + & + this%hrv_livestemc_storage_to_litter_patch(p) + & + this%hrv_livestemc_xfer_to_litter_patch(p) + & + this%hrv_deadstemc_storage_to_litter_patch(p) + & + this%hrv_deadstemc_xfer_to_litter_patch(p) + & + this%hrv_livecrootc_to_litter_patch(p) + & + this%hrv_livecrootc_storage_to_litter_patch(p) + & + this%hrv_livecrootc_xfer_to_litter_patch(p) + & + this%hrv_deadcrootc_to_litter_patch(p) + & + this%hrv_deadcrootc_storage_to_litter_patch(p) + & + this%hrv_deadcrootc_xfer_to_litter_patch(p) + & + this%hrv_xsmrpool_to_atm_patch(p) + & + this%hrv_gresp_storage_to_litter_patch(p) + & + this%hrv_gresp_xfer_to_litter_patch(p) + + end do ! end of patches loop + + + !------------------------------------------------ + ! column variables + !------------------------------------------------ + + ! use p2c routine to get selected column-average patch-level fluxes and states + + call p2c(bounds, num_soilc, filter_soilc, & + this%hrv_xsmrpool_to_atm_patch(bounds%begp:bounds%endp), & + this%hrv_xsmrpool_to_atm_col(bounds%begc:bounds%endc)) + + if (use_crop .and. this%dribble_crophrv_xsmrpool_2atm) then + call p2c(bounds, num_soilc, filter_soilc, & + this%xsmrpool_to_atm_patch(bounds%begp:bounds%endp), & + this%xsmrpool_to_atm_col(bounds%begc:bounds%endc)) + + call c2g( bounds = bounds, & + carr = this%xsmrpool_to_atm_col(bounds%begc:bounds%endc), & + garr = this%xsmrpool_to_atm_grc(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + end if + + call p2c(bounds, num_soilc, filter_soilc, & + this%fire_closs_patch(bounds%begp:bounds%endp), & + this%fire_closs_p2c_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%npp_patch(bounds%begp:bounds%endp), & + this%npp_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%rr_patch(bounds%begp:bounds%endp), & + this%rr_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%ar_patch(bounds%begp:bounds%endp), & + this%ar_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%gpp_patch(bounds%begp:bounds%endp), & + this%gpp_col(bounds%begc:bounds%endc)) + + + ! this code is to calculate an exponentially-relaxed npp value for use in NDynamics code + + if ( trim(isotope) == 'bulk') then + if (nfix_timeconst > 0._r8 .and. nfix_timeconst < 500._r8 ) then + nfixlags = nfix_timeconst * secspday + do fc = 1,num_soilc + c = filter_soilc(fc) + if ( this%lag_npp_col(c) /= spval ) then + this%lag_npp_col(c) = & + this%lag_npp_col(c) * exp(-dtime/nfixlags) + & + this%npp_col(c) * (1._r8 - exp(-dtime/nfixlags)) + else + ! first timestep + this%lag_npp_col(c) = this%npp_col(c) + endif + end do + endif + endif + + + ! vertically integrate column-level carbon fire losses +! if(.not. use_soil_matrixcn)then + do l = 1, ndecomp_pools + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%m_decomp_cpools_to_fire_col(c,l) = & + this%m_decomp_cpools_to_fire_col(c,l) + & + this%m_decomp_cpools_to_fire_vr_col(c,j,l)*dzsoi_decomp(j) + end do + end do + end do +! end if !not use_soil_matrixcn + + + do fc = 1,num_soilc + c = filter_soilc(fc) + + g = col%gridcell(c) + + ! litter fire losses (LITFIRE) + this%litfire_col(c) = 0._r8 + + ! soil organic matter fire losses (SOMFIRE) + this%somfire_col(c) = 0._r8 + + ! total ecosystem fire losses (TOTFIRE) + this%totfire_col(c) = & + this%litfire_col(c) + & + this%somfire_col(c) + + ! carbon losses to fire, including patch losses + this%fire_closs_col(c) = this%fire_closs_p2c_col(c) + do l = 1, ndecomp_pools + this%fire_closs_col(c) = & + this%fire_closs_col(c) + & + this%m_decomp_cpools_to_fire_col(c,l) + end do + + ! total soil respiration, heterotrophic + root respiration (SR) + this%sr_col(c) = & + this%rr_col(c) + & + soilbiogeochem_hr_col(c) + + ! total ecosystem respiration, autotrophic + heterotrophic (ER) + this%er_col(c) = & + this%ar_col(c) + & + soilbiogeochem_hr_col(c) + + ! coarse woody debris heterotrophic respiration + this%cwdc_hr_col(c) = 0._r8 + ! net ecosystem production, excludes fire flux, landcover change, + ! and loss from wood products, positive for sink (NEP) + this%nep_col(c) = & + this%gpp_col(c) - & + this%er_col(c) + + end do + + call c2g( bounds = bounds, & + carr = this%nep_col(bounds%begc:bounds%endc), & + garr = nep_grc(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + call c2g( bounds = bounds, & + carr = this%fire_closs_col(bounds%begc:bounds%endc), & + garr = fire_closs_grc(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + call c2g( bounds = bounds, & + carr = this%hrv_xsmrpool_to_atm_col(bounds%begc:bounds%endc), & + garr = hrv_xsmrpool_to_atm_grc(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + hrv_xsmrpool_to_atm_delta_grc(bounds%begg:bounds%endg) = & + hrv_xsmrpool_to_atm_grc(bounds%begg:bounds%endg) * dtime + call this%hrv_xsmrpool_to_atm_dribbler%set_curr_delta(bounds, & + hrv_xsmrpool_to_atm_delta_grc(bounds%begg:bounds%endg)) + call this%hrv_xsmrpool_to_atm_dribbler%get_curr_flux(bounds, & + hrv_xsmrpool_to_atm_dribbled_grc(bounds%begg:bounds%endg)) + + + dwt_conv_cflux_delta_grc(bounds%begg:bounds%endg) = & + this%dwt_conv_cflux_grc(bounds%begg:bounds%endg) * dtime + call this%dwt_conv_cflux_dribbler%set_curr_delta(bounds, & + dwt_conv_cflux_delta_grc(bounds%begg:bounds%endg)) + call this%dwt_conv_cflux_dribbler%get_curr_flux(bounds, & + this%dwt_conv_cflux_dribbled_grc(bounds%begg:bounds%endg)) + + do g = bounds%begg, bounds%endg + ! net ecosystem exchange of carbon, includes fire flux and hrv_xsmrpool flux, + ! positive for source (NEE) + this%nee_grc(g) = & + -nep_grc(g) + & + fire_closs_grc(g) + & + hrv_xsmrpool_to_atm_dribbled_grc(g) + + this%landuseflux_grc(g) = & + this%dwt_conv_cflux_dribbled_grc(g) + & + product_closs_grc(g) + + ! net biome production of carbon, positive for sink + this%nbp_grc(g) = & + -this%nee_grc(g) - & + this%landuseflux_grc(g) + if ( this%dribble_crophrv_xsmrpool_2atm ) this%nbp_grc(g) = this%nbp_grc(g) - this%xsmrpool_to_atm_grc(g) + end do + + ! coarse woody debris C loss + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdc_loss_col(c) = 0._r8 + end do + associate(is_cwd => decomp_cascade_con%is_cwd) ! TRUE => pool is a cwd pool + do l = 1, ndecomp_pools + if ( is_cwd(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdc_loss_col(c) = & + this%cwdc_loss_col(c) + & + this%m_decomp_cpools_to_fire_col(c,l) + end do + end if + end do + do k = 1, ndecomp_cascade_transitions + if ( is_cwd(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdc_loss_col(c) = & + this%cwdc_loss_col(c) + & + soilbiogeochem_decomp_cascade_ctransfer_col(c,k) + end do + end if + end do + end associate + + + + ! litter C loss + do fc = 1,num_soilc + c = filter_soilc(fc) + this%litterc_loss_col(c) = soilbiogeochem_lithr_col(c) + end do + associate(is_litter => decomp_cascade_con%is_litter) ! TRUE => pool is a litter pool + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%litterc_loss_col(c) = & + this%litterc_loss_col(c) + & + this%m_decomp_cpools_to_fire_col(c,l) + end do + end if + end do + do k = 1, ndecomp_cascade_transitions + if ( is_litter(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%litterc_loss_col(c) = & + this%litterc_loss_col(c) + & + soilbiogeochem_decomp_cascade_ctransfer_col(c,k) + end do + end if + end do + end associate + + end subroutine Summary_carbonflux + end module CNCLM_CNVegCarbonFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index 3be118078..b8227e57b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -15,7 +15,9 @@ module CNCLM_CNVegNitrogenFluxType igrain,igrain_st,igrain_xf,ioutc use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight - use clm_varcon , only : spval + use clm_varcon , only : spval, ispval, dzsoi_decomp + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_matrixcn + use PatchType , only : patch ! !PUBLIC TYPES: implicit none @@ -23,7 +25,6 @@ module CNCLM_CNVegNitrogenFluxType ! ! !PUBLIC MEMBER FUNCTIONS: public :: init_cnveg_nitrogenflux_type - procedure , public :: SetValues type, public :: cnveg_nitrogenflux_type @@ -357,6 +358,7 @@ module CNCLM_CNVegNitrogenFluxType contains procedure , public :: SetValues + procedure , public :: Summary => Summary_nitrogenflux end type cnveg_nitrogenflux_type @@ -1237,4 +1239,93 @@ subroutine SetValues ( this,nvegnpool, & end subroutine SetValues + !----------------------------------------------------------------------- + subroutine Summary_nitrogenflux(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + ! + ! !USES: + use clm_varpar , only: nlevdecomp,ndecomp_cascade_transitions,ndecomp_pools + use clm_varctl , only: use_nitrif_denitrif + use subgridAveMod , only: p2c + ! + ! !ARGUMENTS: + class (cnveg_nitrogenflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! total N deployment (from sminn and retranslocated N pool) (NDEPLOY) + this%ndeploy_patch(p) = & + this%sminn_to_npool_patch(p) + & + this%retransn_to_npool_patch(p) + & + this%free_retransn_to_npool_patch(p) + + + ! total patch-level fire N losses + this%fire_nloss_patch(p) = & + this%m_leafn_to_fire_patch(p) + & + this%m_leafn_storage_to_fire_patch(p) + & + this%m_leafn_xfer_to_fire_patch(p) + & + this%m_frootn_to_fire_patch(p) + & + this%m_frootn_storage_to_fire_patch(p) + & + this%m_frootn_xfer_to_fire_patch(p) + & + this%m_livestemn_to_fire_patch(p) + & + this%m_livestemn_storage_to_fire_patch(p) + & + this%m_livestemn_xfer_to_fire_patch(p) + & + this%m_deadstemn_to_fire_patch(p) + & + this%m_deadstemn_storage_to_fire_patch(p) + & + this%m_deadstemn_xfer_to_fire_patch(p) + & + this%m_livecrootn_to_fire_patch(p) + & + this%m_livecrootn_storage_to_fire_patch(p) + & + this%m_livecrootn_xfer_to_fire_patch(p) + & + this%m_deadcrootn_to_fire_patch(p) + & + this%m_deadcrootn_storage_to_fire_patch(p) + & + this%m_deadcrootn_xfer_to_fire_patch(p) + & + this%m_retransn_to_fire_patch(p) + + end do + + call p2c(bounds, num_soilc, filter_soilc, & + this%fire_nloss_patch(bounds%begp:bounds%endp), & + this%fire_nloss_p2c_col(bounds%begc:bounds%endc)) + + + ! vertically integrate column-level fire N losses + do k = 1, ndecomp_pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%m_decomp_npools_to_fire_col(c,k) = & + this%m_decomp_npools_to_fire_col(c,k) + & + this%m_decomp_npools_to_fire_vr_col(c,j,k) * dzsoi_decomp(j) + end do + end do + end do + + ! total column-level fire N losses + do fc = 1,num_soilc + c = filter_soilc(fc) + this%fire_nloss_col(c) = this%fire_nloss_p2c_col(c) + end do + do k = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%fire_nloss_col(c) = & + this%fire_nloss_col(c) + & + this%m_decomp_npools_to_fire_col(c,k) + end do + end do + + end subroutine Summary_nitrogenflux + end module CNCLM_CNVegNitrogenFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 95d699374..40f74686b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -1,4 +1,4 @@ -module CNCLM_CanopyStateType +module CanopyStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varpar , only : nlevcan, nvegwcs, numpft, num_zon, num_veg, & @@ -155,7 +155,7 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn ! "new" variables: introduced in CNCLM50 if (cold_start==.false.) then do nw = 1,nvegwcs - this%vegwp_patch(np,nw) = cnpft(nc,nz,nv, 77+(nw-1)) + this%vegwp_patch(np,nw) = cnpft(nc,nz,nv, 76+(nw-1)) end do elseif (cold_start) then this%vegwp_patch(np,1:nvegwcs) = -2.5e4_r8 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 new file mode 100644 index 000000000..cc3ecf51a --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -0,0 +1,604 @@ +module CN_DriverMod + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use nanMod , only : nan + use CNVegetationFacade + use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight, + var_col, var_pft + use clm_varcon , only : grav, denh2o + + implicit none + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: CN_Driver + public :: CN_exit + public :: get_CN_LAI + +contains + +!--------------------------------- + subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& + rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& + abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& + fsnow,tg10d,t2m5d,sndzn5d, & + zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& + som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& + col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& + nfix_to_sminng,actual_immobg,fpgg,fpig,sminn_to_plantg,& + sminn_to_npoolg,ndep_to_sminng,totvegng,totlitng,totsomng,& + retransng,retransn_to_npoolg,fuelcg,totlitcg,cwdcg,rootcg) + + use CNCLM_decompMod, only : bounds + use CNCLM_filterMod, only : filter + use CNCLM_SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_inst + use CNCLM_SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_inst + use CNCLM_ActiveLayerMod + use CNCLM_GridcellType + use FireMethodType , only : fire_method_inst + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_inst + use CNCLM_WaterDiagnosticBulkType, only : waterdiagnosticbulk_inst + use CNCLM_atm2lndType , only : atm2lnd_inst + use Wateratm2lndBulkType , only : wateratm2lndbulk_inst + use CNCLM_CNVegStateType , only : cnveg_state_inst + use WaterStateBulkType , only : waterstatebulk_inst + + !ARGUMENTS + implicit none + + !INPUT + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction + real, dimension(nch), intent(in) :: ndep ! nitrogen deposition [g m^-2 s^-1] + real, dimension(nch), intent(in) :: tp1 ! soil temperatures [K] + real, dimension(nch), intent(in) :: tairm ! surface air temperature [K] averaged over CN interval + real, dimension(nch), intent(in) :: bee ! Clapp-Hornberger 'b' [-] + real, dimension(nch), intent(in) :: psis ! saturated matric potential [m] + real, dimension(nch), intent(in) :: dayl ! daylength [seconds] + real, dimension(nch,num_zon), intent(in) :: btran_fire + real, dimension(nch), intent(in) :: car1m ! fraction of tile that is saturated area + real, dimension(nch,num_zon), intent(in) :: rzm ! weighted root-zone moisture content as frac of WHC + real, dimension(nch,num_zon), intent(in) :: sfm ! weighted surface moisture content as frac of WHC + real, dimension(nch), intent(in) :: rhm ! relative humidity (%) + real, dimension(nch), intent(in) :: windm ! wind speed (m/s) + real, dimension(nch), intent(in) :: rainfm ! rainfall (convective + largescale) (kg/m2/s) + real, dimension(nch), intent(in) :: snowfm ! snowfall (kg/m2/s) + real, dimension(nch), intent(in) :: prec10d ! 10-day running mean of total precipitation (mm H2O/s) + real, dimension(nch), intent(in) :: prec60d ! 60-day running mean of total precipitation (mm H2O/s) + real, dimension(nch), intent(in) :: gdp ! Real GDP (K 1995US$/capita) + real, dimension(nch), intent(in) :: abm ! Peak month for agricultural fire, unitless + real, dimension(nch), intent(in) :: peatf ! Fraction of peatland, unitless (0-1) + real, dimension(nch), intent(in) :: hdm ! Human population density in 2010 (individual/km2) + real, dimension(nch), intent(in) :: lnfm ! Lightning frequency [Flashes/km^2/day] + real, dimension(nch), intent(in) :: poros ! porosity + real, dimension(nch), intent(in) :: rh30 ! 30-day running mean of relative humidity + real, dimension(nch), intent(in) :: totwat ! soil liquid water content [kg m^-2] + real, dimension(nch), intent(in) :: bflow ! baseflow + real, dimension(nch), intent(in) :: runsrf ! surface runoff [kg m^-2 s^-1] + real, dimension(nch), intent(in) :: sndzn ! snow height of snow covered area (m) + real, dimension(nch), intent(in) :: fsnow ! snow cover fraction [0-1] + real, dimension(nch), intent(in) :: tg10d ! 10-day running mean of ground temperature [K] + real, dimension(nch), intent(in) :: t2m5d ! 5-day running mean of daily minimum 2m temperature [K] + real, dimension(nch), intent(in) :: sndzn5d ! 5-day running mean of total snow depth + + ! OUTPUT + + real, dimension(nch,num_veg,num_zon), intent(out) :: zlai ! leaf-area index for tile (subject to burying by snow) + real, dimension(nch,num_veg,num_zon), intent(out) :: zsai ! stem-area index for tile + real, dimension(nch,num_veg,num_zon), intent(out) :: ztai ! leaf-area index for tile (not buried by snow) + + real, dimension(nch,num_zon), intent(out) :: colc ! column total carbon + real, dimension(nch), intent(out) :: nppg ! (gC/m2/s) net primary production [PFT] + real, dimension(nch), intent(out) :: gppg ! (gC/m2/s) gross primary production [PFT] + + real, dimension(nch), intent(out) :: srg ! (gC/m2/s) total soil respiration (HR + root resp) [column] + real, dimension(nch), intent(out) :: neeg ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, landuse, harvest, and hrv_xsmrpool flux, positive for source [column] + + real, dimension(nch), intent(out) :: burn ! burn rate / fractional area burned (/sec) + real, dimension(nch), intent(out) :: closs ! (gC/m2/s) total fire C loss + real, dimension(nch), intent(out) :: nfire ! fire counts (count/km2/s) + real, dimension(nch), intent(out) :: som_closs ! (gC/m2/s) carbon emissions due to peat burning + + real, dimension(nch), intent(out) :: root ! fine root carbon [gC/m2] + real, dimension(nch), intent(out) :: vegc ! (gC/m2) total vegetation carbon, excluding cpool + real, dimension(nch), intent(out) :: xsmr ! (gC/m2) abstract C pool to meet excess maintenance respiration (MR) demand + + real, dimension(nch), intent(out) :: ndeployg ! total N deployed to growth and storage (gN/m2/s) + real, dimension(nch), intent(out) :: denitg ! total rate of denitrification (gN/m2/s) + real, dimension(nch), intent(out) :: sminn_leachedg ! soil mineral N pool loss to leaching (gN/m2/s) + real, dimension(nch), intent(out) :: sminng ! (gN/m2) soil mineral N + real, dimension(nch), intent(out) :: col_fire_nlossg ! (gN/m2/s) total column-level fire N loss + real, dimension(nch), intent(out) :: leafng ! (gN/m2) leaf N + real, dimension(nch), intent(out) :: leafcg ! (gC/m2) leaf C + real, dimension(nch), intent(out) :: gross_nming ! gross rate of N mineralization (gN/m2/s) + real, dimension(nch), intent(out) :: net_nming ! vert-int (diagnostic) net rate of N mineralization (gN/m2/s) + real, dimension(nch), intent(out) :: nfix_to_sminng ! symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) + real, dimension(nch), intent(out) :: actual_immobg ! vert-int (diagnostic) actual N immobilization (gN/m2/s) + real, dimension(nch), intent(out) :: fpgg ! fraction of potential gpp (no units) + real, dimension(nch), intent(out) :: fpig ! fraction of potential immobilization (no units) + real, dimension(nch), intent(out) :: sminn_to_plantg ! vert-int (diagnostic) plant uptake of soil mineral N (gN/m2/s) + real, dimension(nch), intent(out) :: sminn_to_npoolg ! deployment of soil mineral N uptake (gN/m2/s) + real, dimension(nch), intent(out) :: ndep_to_sminng ! atmospheric N deposition to soil mineral N (gN/m2/s) + real, dimension(nch), intent(out) :: totvegng ! (gN/m2) total vegetation nitrogen + real, dimension(nch), intent(out) :: totlitng ! (gN/m2) total litter nitrogen + real, dimension(nch), intent(out) :: totsomng ! (gN/m2) total soil organic matter nitrogen + real, dimension(nch), intent(out) :: retransng ! (gN/m2) plant pool of retranslocated N + real, dimension(nch), intent(out) :: retransn_to_npoolg ! deployment of retranslocated N (gN/m2/s) + + !LOCAL + + ! jkolassa: not sure the below type declarations are necessary or whether use statements + ! above are enough + + type(bounds_type) :: bounds + type(clumpfilter_type) :: filter + type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst + type(gridcell_type) :: grc + type(cn_vegetation_type), public :: bgc_vegetation_inst + type(fire_method_type) :: cnfire_method + type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst + + logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions + logical, save :: first = .true. + integer :: n, p, nc, nz, np, nv + + !------------------------------- + + ! update CLM types with current states + + n = 0 + p = 0 + do nc = 1,nch ! catchment tile loop + + grc%dayl(nc) = dayl(nc) + wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) + atm2lnd_inst%forc_wind_grc(nc) = windm(nc) + cnfire_method%forc_hdm(nc) = hdm(nc) + cnfire_method%forc_lnfm(nc) = lnfm(nc) + + do nz = 1,num_zon ! CN zone loop + n = n + 1 + + temperature_inst%t_soisno_col(n,-nlevsno+1:nlevmaxurbgrnd) = tp1(nc) ! jkolassa: only one soil and no snow column at this point (may change in future) + temperature_inst%t_grnd_col(n) = temperature_inst%t_soisno_col(n) + temperature_inst%t_soi17cm_col(n) = temperature_inst%t_grnd_col(n) + soilstate_inst%soilpsi_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point + soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd) = poros(nc) + atm2lnd_inst%forc_t_downscaled_col(n) = tm(nc) + wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) + wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) + waterdiagnosticbulk_inst%wf_col(n) = sfm(nc,nz) + waterdiagnosticbulk_inst%wf2_col(n) = rzm(nc,nz) + waterdiagnosticbulk_inst%frac_sno_col(n) = fsnow(nc) + waterdiagnosticbulk_inst%snow_depth_col(n) = sndzn(nc) + waterdiagnosticbulk_inst%snow_5day_col(n) = sndzn5d(nc) + cnveg_state_inst%gdp_lf_col(n) = gdp(nc) + cnveg_state_inst%abm_lf_col(n) = abm(nc) + cnveg_state_inst%peatf_lf_col(n) = peatf(nc) + waterstatebulk_inst%h2osoi_liq_col(n,-nlevsno+1:nlevgrnd) = totwat(nc) + waterfluxbulk_inst%qflx_drain_col(n) = bflow(nc) + waterfluxbulk_inst%qflx_surf_col(n) = runsrf(nc) + + ! compute column-level saturated area fraction (water table at surface) + if(nz==1) then + saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,car1m(nc)/CN_zone_weight(nz)),1.) + elseif(nz==2) then + saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,(car1m(nc)-CN_zone_weight(1))/CN_zone_weight(nz)),1.) + elseif(nz==3) + saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,(car1m(nc)-CN_zone_weight(1)-CN_zone_weight(2))/CN_zone_weight(nz)),1.) + endif + + do np = 0,numpft ! PFT index loop + p = p + 1 + temperature_inst%t_ref2m_patch(p) = tairm(nc) + temperature_inst%soila10_patch(p) = tg10d(nc) + temperature_inst%t_a5min_patch(p) = t2m5d(nc) + cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 + wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) + wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) + wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) + frictionvel_inst%forc_hgt_u_patch(p) = 30. ! following CNCLM45 implementation, but this should be available from the GridComp + end do ! np + end do ! nz + end do ! nc + + + + ! call CLM routines that are needed prior to Ecosystem Dynamics call + + call active_layer_inst%alt_calc(num_soilc, filter_soilc, & + temperature_inst) + + call bgc_vegetation_inst%InitGridcellBalance(bounds, & + filter%num_allc, filter%allc, & + filter%num_soilc, filter%soilc, & + filter%num_soilp, filter%soilp, & + soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst) + + call bgc_vegetation_inst%InitColumnBalance(bounds, & + filter%num_allc, filter%allc, & + filter%num_soilc, filter%soilc, & + filter%num_soilp, filter%soilp, & + soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst) + + ! Ecosystem Dynamics calculations + ! jkolassa: This call contains most of the CLM ecosystem dynamics + ! calculations, including soil biogeochemistry, carbon/nitrogen state and + ! flux updates, fire, etc. + call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds, & + filter%num_soilc, filter%soilc, & + filter%num_soilp, filter%soilp, & + filter%num_actfirec, filter%actfirec, & + filter%num_actfirep, filter%actfirep, & + filter%num_pcropp, filter%pcropp, & + filter%num_exposedvegp, filter%exposedvegp, & + filter%num_noexposedvegp, filter%noexposedvegp, & + doalb, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + active_layer_inst, & + atm2lnd_inst, water_inst%waterstatebulk_inst, & + water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & + water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + soil_water_retention_curve, crop_inst, ch4_inst, & + photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & + nutrient_competition_method, fireemis_inst) + + + ! jkolassa: This call is mostly to compute the nitrogen leaching, summary states and fluxes + ! and the vegetation structural updates + call bgc_vegetation_inst%EcosystemDynamicsPostDrainage(bounds, & + filter%num_allc, filter%allc, & + filter%num_soilc, filter%soilc, & + filter%num_soilp, filter%soilp, & + filter%num_actfirec, filter%actfirec, & + filter%num_actfirep, filter%actfirep, & + doalb, crop_inst, & + soilstate_inst, soilbiogeochem_state_inst, & + water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & + water_inst%waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + + +! check carbon and nitrogen balances except on first time step + if(.not.first) then + call bgc_vegetation_inst%BalanceCheck( & + bounds, filter%num_soilc, filter%soilc, & + soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst, atm2lnd_inst ) + else + first = .false. + end if + + grc%prev_dayl = grc%dayl ! set previous day length for following time steps (dayl itself is computed in GridComp) + + +! map CLM outputs to Catchment space + + n = 0 + p = 0 + do nc = 1,nch ! catchment tile loop + + nppg(nc) = 0. + gppg(nc) = 0. + srg(nc) = 0. + burn(nc) = 0. + closs(nc) = 0. + som_closs(nc) = 0. + nfire(nc) = 0. + root(nc) = 0. + vegc(nc) = 0. + ndeployg(nc) = 0. + leafng(nc) = 0. + leafcg(nc) = 0. + sminn_to_npoolg(nc) = 0. + totvegng(nc) = 0. + retransng(nc) = 0. + retransn_to_npoolg(nc) = 0. + rootcg(nc) = 0. + denitg(nc) = 0. + sminn_leachedg(nc) = 0. + sminng(nc) = 0. + col_fire_nlossg(nc) = 0. + gross_nming(nc) = 0. + net_nming(nc) = 0. + nfix_to_sminng(nc) = 0. + actual_immobg(nc) = 0. + fpgg(nc) = 0. + fpig(nc) = 0. + sminn_to_plantg(nc) = 0. + ndep_to_sminng(nc) = 0. + totlitng(nc) = 0. + totsomng(nc) = 0. + fuelcg(nc) = 0. + totlitcg(nc) = 0. + cwdcg(nc) = 0. + + neeg(nc) = cnveg_carbonflux_inst%nee_grc(nc) + + do nz = 1,num_zon ! CN zone loop + n = n + 1 + + colc(nc,nz) = cnveg_carbonstate_inst%totc_col(n) + srg(nc) = srg(nc) + cnveg_carbonflux_inst%sr_col(n)*CN_zone_weight(nz) + burn(nc) = burn(nc) + cnveg_state_inst%farea_burned_col(n)*CN_zone_weight(nz) + closs(nc) = closs(nc) + cnveg_carbonflux_inst%fire_closs_col(n)*CN_zone_weight(nz) + som_closs(nc) = som_closs(nc) + soilbiogeochem_carbonflux_inst%somc_fire_col(n)*CN_zone_weight(nz) + nfire(nc) = nfire(nc) + cnveg_state_inst%nfire_col(n)*CN_zone_weight(nz) + denitg(nc) = denitg(nc) + soilbiogeochem_nitrogenflux_inst%denit_col(n)*CN_zone_weight(nz) + sminn_leachedg(nc) = sminn_leachedg(nc) + soilbiogeochem_nitrogenflux_inst%sminn_leached_col(n)*CN_zone_weight(nz) + sminng(nc) = sminng(nc) + soilbiogeochem_nitrogenstate_inst%sminn_col(n)*CN_zone_weight(nz) + col_fire_nlossg(nc) = col_fire_nlossg(nc) + cnveg_nitrogenflux_inst%fire_nloss_col(n)*CN_zone_weight(nz) + gross_nming(nc) = gross_nming(nc) + soilbiogeochem_nitrogenflux_inst%gross_nmin_col(n)*CN_zone_weight(nz) + net_nming(nc) = net_nming(nc) + soilbiogeochem_nitrogenflux_inst%net_nmin_col(n)*CN_zone_weight(nz) + nfix_to_sminng(nc) = nfix_to_sminng(nc) + soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col(n)*CN_zone_weight(nz) + actual_immobg(nc) = actual_immobg(nc) + soilbiogeochem_nitrogenflux_inst%actual_immob_col(n)*CN_zone_weight(nz) + fpgg(nc) = fpgg(nc) + soilbiogeochem_state_inst%fpg_col(n)*CN_zone_weight(nz) + fpig(nc) = fpig(nc) + soilbiogeochem_state_inst%fpi_col(n)*CN_zone_weight(nz) + sminn_to_plantg(nc) = sminn_to_plantg(nc) + soilbiogeochem_nitrogenflux_inst%sminn_to_plant_col(n)*CN_zone_weight(nz) + ndep_to_sminng(nc) = ndep_to_sminng(nc) + soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col(n)*CN_zone_weight(nz) + totlitng(nc) = totlitng(nc) + soilbiogeochem_nitrogenstate_inst%totlitn_col(n)*CN_zone_weight(nz) + totsomng(nc) = totsomng(nc) + soilbiogeochem_nitrogenstate_inst%totsomn_col(n)*CN_zone_weight(nz) + fuelcg(nc) = fuelcg(nc) + cnveg_carbonstate_inst%fuelc_col(n)*CN_zone_weight(nz) + totlitcg(nc) = totlitcg(nc) + soilbiogeochem_carbonstate_inst%totlitc_col(n)*CN_zone_weight(nz) + cwdcg(nc) = cwdcg(nc) + soilbiogeochem_carbonstate_inst%cwdc_col(n)*CN_zone_weight(nz) + + do np = 0,numpft ! PFT index loop + p = p + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + + zlai(nc,nv,nz) = canopystate_inst%elai_patch(p) + zsai(nc,nv,nz) = canopystate_inst%esai_patch(p) + ztai(nc,nv,nz) = canopystate_inst%tlai_patch(p) + + pwtgcell = fveg(nc,nv,nz)*wtzone(nc,nz) ! PFT weight in catchment tile + nppg(nc) = nppg(nc) + cnveg_carbonflux_inst%npp_patch(p)*pwtgcell + gppg(nc) = gppg(nc) + cnveg_carbonflux_inst%gpp_patch(p)*pwtgcell + root(nc) = root(nc) + (cnveg_carbonstate_inst%frootc_patch(p) & + + cnveg_carbonstate_inst%frootc_storage_patch(p) & + + cnveg_carbonstate_inst%frootc_xfer_patch(p) & + )*pwtgcell + vegc(nc) = vegc(nc) + cnveg_carbonstate_inst%totvegc_patch(p)*pwtgcell + ndeployg(nc) = ndeployg(nc) + cnveg_nitrogenflux_inst%ndeploy_patch(p)*pwtgcell + leafng(nc) = leafng(nc) + cnveg_nitrogenstate_inst%leafn_patch(p)*pwtgcell + leafcg(nc) = leafcg(nc) + cnveg_carbonstate_inst%leafc_patch(p)*pwtgcell + sminn_to_npoolg(nc) = sminn_to_npoolg(nc) + cnveg_nitrogenflux_inst%sminn_to_npool_patch(p)*pwtgcell + totvegng(nc) = totvegng(nc) + cnveg_nitrogenstate_inst%totvegn_patch(p)*pwtgcell + retransng(nc) = retransng(nc) + cnveg_nitrogenstate_inst%retransn_patch(p)*pwtgcell + retransn_to_npoolg(nc) = retransn_to_npoolg(nc) + cnveg_nitrogenflux_inst%retransn_to_npool_patch(p)*pwtgcell + rootcg(nc) = rootcg(nc) + (cnveg_carbonstate_inst%frootc_patch(p) & + + cnveg_carbonstate_inst%frootc_storage_patch(p) & + + cnveg_carbonstate_inst%frootc_xfer_patch(p) & + + cnveg_carbonstate_inst%livecrootc_patch(p) & + + cnveg_carbonstate_inst%livecrootc_storage_patch(p) & + + cnveg_carbonstate_inst%livecrootc_xfer_patch(p) & + + cnveg_carbonstate_inst%deadcrootc_patch(p) & + + cnveg_carbonstate_inst%deadcrootc_storage_patch(p) & + + cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) & + )*pwtgcell + + end if + end do ! nv + end do !np + end do ! nz + end do ! nc + + end subroutine CN_Driver + +!------------------------------------------------ + subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) + + ! INPUT + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction + + ! OUTPUT + real, dimension(nch,num_zon,var_col), intent(out) :: cncol ! column-level restart variables + real, dimension(nch,num_zon,num_veg,var_pft), intent(out) :: cnpft ! PFT-level restart variables + + ! LOCAL + integer :: n, p, nv, nc, nz, np, nd + integer, dimension(8) :: decomp_cpool_cncol_index = (/ 3, 4, 5, 2, 10, 11, 12, 13 /) + integer, dimension(8) :: decomp_npool_cncol_index = (/ 18, 19, 20, 17,25, 26, 27, 28 /) + !---------------- + + n = 0 + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,nzone ! CN zone loop + n = n + 1 + + cncol(nc,nz, 1) = soilbiogeochem_carbonstate_inst%ctrunc_vr_col(n,1) + + do nd = 1,ndecomp_pools + ! jkolassa: accounting for fact that pool order in CNCOL is different from CTSM + cncol(nc,nz,decomp_cpool_cncol_index(nd)) = soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col (n,1,nd) + cncol(nc,nz,decomp_npool_cncol_index(nd)) = soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col (n,1,nd) + end do + + cncol(nc,nz, 6) = cnveg_carbonstate_inst%totvegc_col (n) + ! jkolassa: variables below transitioned from being column-level to being gridcell-level in CLM; + ! assuming here that quantities are spread over zones according to zone weight + cncol(nc,nz, 7) = c_products_inst%prod100_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz, 8) = c_products_inst%prod100_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz, 9) = cnveg_carbonstate_inst%seedc_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz,14) = cnveg_carbonstate_inst%totc_col (n) + cncol(nc,nz,15) = soilbiogeochem_carbonstate_inst%totlitc_col (n) + cncol(nc,nz,16) = soilbiogeochem_nitrogenstate_inst%ntrunc_vr_col (n,1) + + + cncol(nc,nz,21) = n_products_inst%prod100_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz,22) = n_products_inst%prod100_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz,23) = cnveg_nitrogenstate_inst%seedn_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz,24) = soilbiogeochem_nitrogenstate_inst%sminn_vr_col (n,1) + cncol(nc,nz,29) = cnveg_nitrogenstate_inst%totn_col (n) + cncol(nc,nz,30) = soilbiogeochem_state_inst%fpg_col (n) + cncol(nc,nz,31) = cnveg_state_inst%annsum_counter_col (n) + cncol(nc,nz,32) = cnveg_state_inst%annavg_t2m_col (n) + cncol(nc,nz,33) = cnveg_carbonflux_inst%annsum_npp_col (n) + cncol(nc,nz,34) = cnveg_state_inst%farea_burned_col (n) + cncol(nc,nz,35) = soilbiogeochem_state_inst%fpi_col (n) + + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,nveg ! defined veg loop + + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + cnpft(nc,nz,nv, 1) = cnveg_carbonstate_inst%cpool_patch (np) + cnpft(nc,nz,nv, 2) = cnveg_carbonstate_inst%deadcrootc_patch (np) + cnpft(nc,nz,nv, 3) = cnveg_carbonstate_inst%deadcrootc_storage_patch (np) + cnpft(nc,nz,nv, 4) = cnveg_carbonstate_inst%deadcrootc_xfer_patch (np) + cnpft(nc,nz,nv, 5) = cnveg_carbonstate_inst%deadstemc_patch (np) + cnpft(nc,nz,nv, 6) = cnveg_carbonstate_inst%deadstemc_storage_patch (np) + cnpft(nc,nz,nv, 7) = cnveg_carbonstate_inst%deadstemc_xfer_patch (np) + cnpft(nc,nz,nv, 8) = cnveg_carbonstate_inst%frootc_patch (np) + cnpft(nc,nz,nv, 9) = cnveg_carbonstate_inst%frootc_storage_patch (np) + cnpft(nc,nz,nv, 10) = cnveg_carbonstate_inst%frootc_xfer_patch (np) + cnpft(nc,nz,nv, 11) = cnveg_carbonstate_inst%gresp_storage_patch (np) + cnpft(nc,nz,nv, 12) = cnveg_carbonstate_inst%gresp_xfer_patch (np) + cnpft(nc,nz,nv, 13) = cnveg_carbonstate_inst%leafc_patch (np) + cnpft(nc,nz,nv, 14) = cnveg_carbonstate_inst%leafc_storage_patch (np) + cnpft(nc,nz,nv, 15) = cnveg_carbonstate_inst%leafc_xfer_patch (np) + cnpft(nc,nz,nv, 16) = cnveg_carbonstate_inst%livecrootc_patch (np) + cnpft(nc,nz,nv, 17) = cnveg_carbonstate_inst%livecrootc_storage_patch (np) + cnpft(nc,nz,nv, 18) = cnveg_carbonstate_inst%livecrootc_xfer_patch (np) + cnpft(nc,nz,nv, 19) = cnveg_carbonstate_inst%livestemc_patch (np) + cnpft(nc,nz,nv, 20) = cnveg_carbonstate_inst%livestemc_storage_patch (np) + cnpft(nc,nz,nv, 21) = cnveg_carbonstate_inst%livestemc_xfer_patch (np) + cnpft(nc,nz,nv, 22) = cnveg_carbonstate_inst%ctrunc_patch (np) + cnpft(nc,nz,nv, 23) = cnveg_carbonstate_inst%xsmrpool_patch (np) + cnpft(nc,nz,nv, 24) = cnveg_state_inst%annavg_t2m_patch (np) + cnpft(nc,nz,nv, 25) = cnveg_state_inst%annmax_retransn_patch (np) + cnpft(nc,nz,nv, 26) = cnveg_carbonflux_inst%annsum_npp_patch (np) + cnpft(nc,nz,nv, 27) = cnveg_state_inst%annsum_potential_gpp_patch (np) + cnpft(nc,nz,nv, 28) = grc%dayl (np) + cnpft(nc,nz,nv, 29) = cnveg_state_inst%days_active_patch (np) + cnpft(nc,nz,nv, 30) = cnveg_state_inst%dormant_flag_patch (np) + cnpft(nc,nz,nv, 31) = cnveg_state_inst%offset_counter_patch (np) + cnpft(nc,nz,nv, 32) = cnveg_state_inst%offset_fdd_patch (np) + cnpft(nc,nz,nv, 33) = cnveg_state_inst%offset_flag_patch (np) + cnpft(nc,nz,nv, 34) = cnveg_state_inst%offset_swi_patch (np) + cnpft(nc,nz,nv, 35) = cnveg_state_inst%onset_counter_patch (np) + cnpft(nc,nz,nv, 36) = cnveg_state_inst%onset_fdd_patch (np) + cnpft(nc,nz,nv, 37) = cnveg_state_inst%onset_flag_patch (np) + cnpft(nc,nz,nv, 38) = cnveg_state_inst%onset_gdd_patch (np) + cnpft(nc,nz,nv, 39) = cnveg_state_inst%onset_gddflag_patch (np) + cnpft(nc,nz,nv, 40) = cnveg_state_inst%onset_swi_patch (np) + cnpft(nc,nz,nv, 41) = cnveg_carbonflux_inst%prev_frootc_to_litter_patch (np) + cnpft(nc,nz,nv, 42) = cnveg_carbonflux_inst%prev_leafc_to_litter_patch (np) + cnpft(nc,nz,nv, 43) = cnveg_state_inst%tempavg_t2m_patch (np) + cnpft(nc,nz,nv, 44) = cnveg_state_inst%tempmax_retransn_patch (np) + cnpft(nc,nz,nv, 45) = cnveg_carbonflux_inst%tempsum_npp_patch (np) + cnpft(nc,nz,nv, 46) = cnveg_state_inst%tempsum_potential_gpp_patch (np) + cnpft(nc,nz,nv, 47) = cnveg_carbonflux_inst%xsmrpool_recover_patch (np) + cnpft(nc,nz,nv, 48) = cnveg_nitrogenstate_inst%deadcrootn_patch (np) + cnpft(nc,nz,nv, 49) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch (np) + cnpft(nc,nz,nv, 50) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch (np) + cnpft(nc,nz,nv, 51) = cnveg_nitrogenstate_inst%deadstemn_patch (np) + cnpft(nc,nz,nv, 52) = cnveg_nitrogenstate_inst%deadstemn_storage_patch (np) + cnpft(nc,nz,nv, 53) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch (np) + cnpft(nc,nz,nv, 54) = cnveg_nitrogenstate_inst%frootn_patch (np) + cnpft(nc,nz,nv, 55) = cnveg_nitrogenstate_inst%frootn_storage_patch (np) + cnpft(nc,nz,nv, 56) = cnveg_nitrogenstate_inst%frootn_xfer_patch (np) + cnpft(nc,nz,nv, 57) = cnveg_nitrogenstate_inst%leafn_patch (np) + cnpft(nc,nz,nv, 58) = cnveg_nitrogenstate_inst%leafn_storage_patch (np) + cnpft(nc,nz,nv, 59) = cnveg_nitrogenstate_inst%leafn_xfer_patch (np) + cnpft(nc,nz,nv, 60) = cnveg_nitrogenstate_inst%livecrootn_patch (np) + cnpft(nc,nz,nv, 61) = cnveg_nitrogenstate_inst%livecrootn_storage_patch (np) + cnpft(nc,nz,nv, 62) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch (np) + cnpft(nc,nz,nv, 63) = cnveg_nitrogenstate_inst%livestemn_patch (np) + cnpft(nc,nz,nv, 64) = cnveg_nitrogenstate_inst%livestemn_storage_patch (np) + cnpft(nc,nz,nv, 65) = cnveg_nitrogenstate_inst%livestemn_xfer_patch (np) + cnpft(nc,nz,nv, 66) = cnveg_nitrogenstate_inst%npool_patch (np) + cnpft(nc,nz,nv, 67) = cnveg_nitrogenstate_inst%ntrunc_patch (np) + cnpft(nc,nz,nv, 68) = cnveg_nitrogenstate_inst%retransn_patch (np) + cnpft(nc,nz,nv, 69) = canopystate_inst%elai_patch (np) + cnpft(nc,nz,nv, 70) = canopystate_inst%esai_patch (np) + cnpft(nc,nz,nv, 71) = canopystate_inst%hbot_patch (np) + cnpft(nc,nz,nv, 72) = canopystate_inst%htop_patch (np) + cnpft(nc,nz,nv, 73) = canopystate_inst%tlai_patch (np) + cnpft(nc,nz,nv, 74) = canopystate_inst%tsai_patch (np) + cnpft(nc,nz,nv, 75) = cnveg_carbonflux_inst%plant_ndemand_patch (np) + cnpft(nc,nz,nv, 76) = canopystate_inst%vegwp_patch (np,1) + cnpft(nc,nz,nv, 77) = canopystate_inst%vegwp_patch (np,2) + cnpft(nc,nz,nv, 78) = canopystate_inst%vegwp_patch (np,3) + cnpft(nc,nz,nv, 79) = canopystate_inst%vegwp_patch (np,4) + cnpft(nc,nz,nv, 80) = cnveg_carbonflux_inst%annsum_litfall_patch (np) + cnpft(nc,nz,nv, 81) = cnveg_carbonflux_inst%tempsum_litfall_patch (np) + endif + + end do ! defined veg loop + end do ! PFT index loop + end do ! CN zone loop + end do ! catchment tile loop + + return + + end subroutine CN_exit + +!-------------------------- + subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) + + ! ARGUMENTS + + use CanopyStateType , only : canopystate_inst + + ! INPUT/OUTPUT + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction + real, dimension(nch,num_veg,num_zon), intent(out) :: elai ! exposed leaf-area index + real, dimension(nch,num_veg,num_zon), intent(out), optional :: esai ! exposed stem-area index + real, dimension(nch,num_veg,num_zon), intent(out), optional :: tlai ! total leaf-area index + real, dimension(nch,num_veg,num_zon), intent(out), optional :: tsai ! total stem-area index + + ! LOCAL + integer :: n, p, nv, nc, nz, np + !------------------------------ + elai = 0. + if(present(esai)) esai = 0. + if(present(tlai)) tlai = 0. + if(present(tsai)) tsai = 0. + + n = 0 + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,nzone ! CN zone loop + n = n + 1 + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,nveg ! defined veg loop + +! extract LAI & SAI from CN clmtype +! --------------------------------- + if(ityp(nc,nv,nz)==p .and. ityp(nc,nv,nz)>0 .and. fveg(nc,nv,nz)>1.e-4) then + elai(nc,nv,nz) = canopystate_inst%elai_patch(np) + if(present(esai)) esai(nc,nv,nz) = canopystate_inst%esai_patch(np) + if(present(tlai)) tlai(nc,nv,nz) = canopystate_inst%tlai_patch(np) + if(present(tsai)) tsai(nc,nv,nz) = canopystate_inst%tsai_patch(np) + endif + + end do ! defined veg loop + end do ! PFT index loop + end do ! CN zone loop + end do ! catchment tile loop + + + end subroutine get_CN_LAI +end module CN_DriverMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 new file mode 100755 index 000000000..3d3bb9452 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 @@ -0,0 +1,135 @@ +module FrictionVelocityMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Calculation of the friction velocity, relation for potential + ! temperature and humidity profiles of surface boundary layer. + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_const_mod , only : SHR_CONST_PI + use decompMod , only : bounds_type + use clm_varcon , only : spval + use clm_varctl , only : use_cn, use_luna + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use landunit_varcon , only : istsoil, istcrop, istice_mec, istwet + use ncdio_pio , only : file_desc_t + use paramUtilMod , only : readNcdioScalar + use atm2lndType , only : atm2lnd_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use CanopyStateType , only : canopystate_type + ! + ! !PUBLIC TYPES: + implicit none + private + save + + type, public :: frictionvel_type + private + + ! Scalar parameters + real(r8), public :: zetamaxstable = -999._r8 ! Max value zeta ("height" used in Monin-Obukhov theory) can go to under stable conditions + real(r8) :: zsno = -999._r8 ! Momentum roughness length for snow (m) + real(r8) :: zlnd = -999._r8 ! Momentum roughness length for soil, glacier, wetland (m) + + ! Roughness length/resistance for friction velocity calculation + + real(r8), pointer, public :: forc_hgt_u_patch (:) ! patch wind forcing height (10m+z0m+d) (m) + real(r8), pointer, public :: forc_hgt_t_patch (:) ! patch temperature forcing height (10m+z0m+d) (m) + real(r8), pointer, public :: forc_hgt_q_patch (:) ! patch specific humidity forcing height (10m+z0m+d) (m) + real(r8), pointer, public :: u10_patch (:) ! patch 10-m wind (m/s) (for dust model) + real(r8), pointer, public :: u10_clm_patch (:) ! patch 10-m wind (m/s) (for clm_map2gcell) + real(r8), pointer, public :: va_patch (:) ! patch atmospheric wind speed plus convective velocity (m/s) + real(r8), pointer, public :: vds_patch (:) ! patch deposition velocity term (m/s) (for dry dep SO4, NH4NO3) + real(r8), pointer, public :: fv_patch (:) ! patch friction velocity (m/s) (for dust model) + real(r8), pointer, public :: rb1_patch (:) ! patch aerodynamical resistance (s/m) (for dry deposition of chemical tracers) + real(r8), pointer, public :: rb10_patch (:) ! 10-day mean patch aerodynamical resistance (s/m) (for LUNA model) + real(r8), pointer, public :: ram1_patch (:) ! patch aerodynamical resistance (s/m) + real(r8), pointer, public :: z0mv_patch (:) ! patch roughness length over vegetation, momentum [m] + real(r8), pointer, public :: z0hv_patch (:) ! patch roughness length over vegetation, sensible heat [m] + real(r8), pointer, public :: z0qv_patch (:) ! patch roughness length over vegetation, latent heat [m] + real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m] + real(r8), pointer, public :: z0hg_col (:) ! col roughness length over ground, sensible heat [m] + real(r8), pointer, public :: z0qg_col (:) ! col roughness length over ground, latent heat [m] + ! variables to add history output from CanopyFluxesMod + real(r8), pointer, public :: rah1_patch (:) ! patch sensible heat flux resistance [s/m] + real(r8), pointer, public :: rah2_patch (:) ! patch below-canopy sensible heat flux resistance [s/m] + real(r8), pointer, public :: raw1_patch (:) ! patch moisture flux resistance [s/m] + real(r8), pointer, public :: raw2_patch (:) ! patch below-canopy moisture flux resistance [s/m] + real(r8), pointer, public :: ustar_patch (:) ! patch friction velocity [m/s] + real(r8), pointer, public :: um_patch (:) ! patch wind speed including the stablity effect [m/s] + real(r8), pointer, public :: uaf_patch (:) ! patch canopy air speed [m/s] + real(r8), pointer, public :: taf_patch (:) ! patch canopy air temperature [K] + real(r8), pointer, public :: qaf_patch (:) ! patch canopy humidity [kg/kg] + real(r8), pointer, public :: obu_patch (:) ! patch Monin-Obukhov length [m] + real(r8), pointer, public :: zeta_patch (:) ! patch dimensionless stability parameter + real(r8), pointer, public :: vpd_patch (:) ! patch vapor pressure deficit [Pa] + real(r8), pointer, public :: num_iter_patch (:) ! patch number of iterations + real(r8), pointer, public :: z0m_actual_patch (:) ! patch roughness length actually used in flux calculations, momentum [m] + + + end type frictionvel_type + type(frictionvel_type), public, target, save :: frictionvel_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine init_frictionvel_type( bounds, this) + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + + type(bounds_type), intent(in) :: bounds + type(frictionvel_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%forc_hgt_u_patch (begp:endp)) ; this%forc_hgt_u_patch (:) = nan + allocate(this%forc_hgt_t_patch (begp:endp)) ; this%forc_hgt_t_patch (:) = nan + allocate(this%forc_hgt_q_patch (begp:endp)) ; this%forc_hgt_q_patch (:) = nan + allocate(this%u10_patch (begp:endp)) ; this%u10_patch (:) = nan + allocate(this%u10_clm_patch (begp:endp)) ; this%u10_clm_patch (:) = nan + allocate(this%va_patch (begp:endp)) ; this%va_patch (:) = nan + allocate(this%vds_patch (begp:endp)) ; this%vds_patch (:) = nan + allocate(this%fv_patch (begp:endp)) ; this%fv_patch (:) = nan + allocate(this%rb1_patch (begp:endp)) ; this%rb1_patch (:) = nan + allocate(this%rb10_patch (begp:endp)) ; this%rb10_patch (:) = spval + allocate(this%ram1_patch (begp:endp)) ; this%ram1_patch (:) = nan + allocate(this%z0mv_patch (begp:endp)) ; this%z0mv_patch (:) = nan + allocate(this%z0hv_patch (begp:endp)) ; this%z0hv_patch (:) = nan + allocate(this%z0qv_patch (begp:endp)) ; this%z0qv_patch (:) = nan + allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = nan + allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = nan + allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = nan + allocate(this%rah1_patch (begp:endp)) ; this%rah1_patch (:) = nan + allocate(this%rah2_patch (begp:endp)) ; this%rah2_patch (:) = nan + allocate(this%raw1_patch (begp:endp)) ; this%raw1_patch (:) = nan + allocate(this%raw2_patch (begp:endp)) ; this%raw2_patch (:) = nan + allocate(this%um_patch (begp:endp)) ; this%um_patch (:) = nan + allocate(this%uaf_patch (begp:endp)) ; this%uaf_patch (:) = nan + allocate(this%taf_patch (begp:endp)) ; this%taf_patch (:) = nan + allocate(this%qaf_patch (begp:endp)) ; this%qaf_patch (:) = nan + allocate(this%ustar_patch (begp:endp)) ; this%ustar_patch (:) = nan + allocate(this%obu_patch (begp:endp)) ; this%obu_patch (:) = nan + allocate(this%zeta_patch (begp:endp)) ; this%zeta_patch (:) = nan + allocate(this%vpd_patch (begp:endp)) ; this%vpd_patch (:) = nan + allocate(this%num_iter_patch (begp:endp)) ; this%num_iter_patch (:) = nan + allocate(this%z0m_actual_patch (begp:endp)) ; this%z0m_actual_patch (:) = nan + + end subroutine init_frictionvel_type + + +end module FrictionVelocityMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 index f1ae2bd26..c424dc6d6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 @@ -319,8 +319,8 @@ subroutine init_photosyns_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_ photosyns_inst%alphapsnsun_patch(np) = 0._r8 photosyns_inst%alphapsnsha_patch(np) = 0._r8 else (cold_start=.false.) then - photosyns_inst%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 75) - photosyns_inst%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 76) + photosyns_inst%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 76) + photosyns_inst%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 77) end if end if ! ityp =p end do !nv diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index 5936f45c9..e3a3c3d9c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -5,8 +5,9 @@ module CNCLM_SoilBiogeochemCarbonFluxType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan, ndecomp_cascade_outtransitions use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp, nlevsoi, ndecomp_pools_vr use clm_varctl , only : use_fates, use_soil_matrixcn, use_vertsoilc - use clm_varcon , only : spval, ispval - use CNCLM_decompMod , only : bounds_type + use clm_varcon , only : spval, ispval, dzsoi_decomp + use decompMod , only : bounds_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con ! !PUBLIC TYPES: implicit none @@ -15,7 +16,6 @@ module CNCLM_SoilBiogeochemCarbonFluxType ! ! !PUBLIC MEMBER FUNCTIONS: public :: init_soilbiogeochem_carbonflux_type - procedure, public :: SetValues type, public :: soilbiogeochem_carbonflux_type @@ -73,6 +73,11 @@ module CNCLM_SoilBiogeochemCarbonFluxType ! ! type(vector_type) :: matrix_Cinput ! C input to different soil compartments (pools and layers) (gC/m3/step) + contains + + procedure , public :: SetValues + procedure , public :: Summary + end type soilbiogeochem_carbonflux_type type(soilbiogeochem_carbonflux_type), public, target, save :: soilbiogeochem_carbonflux_inst @@ -260,5 +265,118 @@ subroutine SetValues ( this, num_column, filter_column, value_column) end subroutine SetValues + !----------------------------------------------------------------------- + subroutine Summary(this, bounds, num_soilc, filter_soilc) + ! + ! !DESCRIPTION: + ! On the radiation time step, column-level carbon summary calculations + ! + ! !USES: + ! !ARGUMENTS: + class(soilbiogeochem_carbonflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l + integer :: fc + !----------------------------------------------------------------------- + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%som_c_leached_col(c) = 0._r8 + end do + + ! vertically integrate HR and decomposition cascade fluxes + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cascade_hr_col(c,k) = & + this%decomp_cascade_hr_col(c,k) + & + this%decomp_cascade_hr_vr_col(c,j,k) * dzsoi_decomp(j) + + this%decomp_cascade_ctransfer_col(c,k) = & + this%decomp_cascade_ctransfer_col(c,k) + & + this%decomp_cascade_ctransfer_vr_col(c,j,k) * dzsoi_decomp(j) + end do + end do + end do + + ! total heterotrophic respiration, vertically resolved (HR) + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%hr_vr_col(c,j) = 0._r8 + end do + end do + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%hr_vr_col(c,j) = & + this%hr_vr_col(c,j) + & + this%decomp_cascade_hr_vr_col(c,j,k) + end do + end do + end do + + ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these + do l = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_leached_col(c,l) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_leached_col(c,l) = this%decomp_cpools_leached_col(c,l) + & + this%decomp_cpools_transport_tendency_col(c,j,l) * dzsoi_decomp(j) + end do + end do + do fc = 1,num_soilc + c = filter_soilc(fc) + this%som_c_leached_col(c) = this%som_c_leached_col(c) + this%decomp_cpools_leached_col(c,l) + end do + end do + + + ! soil organic matter heterotrophic respiration + associate(is_soil => decomp_cascade_con%is_soil) ! TRUE => pool is a soil pool + do k = 1, ndecomp_cascade_transitions + if ( is_soil(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%somhr_col(c) = this%somhr_col(c) + this%decomp_cascade_hr_col(c,k) + end do + end if + end do + end associate + + ! litter heterotrophic respiration (LITHR) + associate(is_litter => decomp_cascade_con%is_litter) ! TRUE => pool is a litter pool + do k = 1, ndecomp_cascade_transitions + if ( is_litter(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%lithr_col(c) = this%lithr_col(c) + this%decomp_cascade_hr_col(c,k) + end do + end if + end do + end associate + + ! total heterotrophic respiration (HR) + do fc = 1,num_soilc + c = filter_soilc(fc) + + this%hr_col(c) = & + this%lithr_col(c) + & + this%somhr_col(c) + + end do + + end subroutine Summary + end module CNCLM_SoilBiogeochemCarbonFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index 16c137b45..933c1e889 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -4,7 +4,8 @@ module CNCLM_SoilBiogeochemCarbonStateType use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi - use clm_varctl , only : use_soil_matrixcn + use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi, zsoi, c3_r2 + use clm_varctl , only : iulog, use_vertsoilc, use_fates, use_soil_matrixcn use CNCLM_decompMod , only : bounds_type ! !PUBLIC TYPES: @@ -50,6 +51,12 @@ module CNCLM_SoilBiogeochemCarbonStateType ! type(sparse_matrix_type) :: AKXcacc ! (gC/m3/yr) accumulated N transfers from j to i (col,i,j) per year in dimension(col,nlev*npools,nlev*npools) in sparse matrix type ! type(vector_type) :: matrix_Cinter ! (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools in dimension(col,nlev*npools) in vector type + contains + + procedure , public :: Summary + procedure , public :: SetTotVgCThresh + + end type soilbiogeochem_carbonstate_type type(soilbiogeochem_carbonstate_type), public, target, save :: soilbiogeochem_carbonstate_inst @@ -152,4 +159,213 @@ subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) end init_soilbiogeochem_carbonstate_type + !----------------------------------------------------------------------- + subroutine Summary(this, bounds, num_allc, filter_allc) + ! + ! !DESCRIPTION: + ! Perform column-level carbon summary calculations + ! + ! !ARGUMENTS: + class(soilbiogeochem_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l ! indices + integer :: fc ! filter indices + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + ! vertically integrate each of the decomposing C pools + do l = 1, ndecomp_pools + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_cpools_col(c,l) = 0._r8 + if(use_soil_matrixcn)then + this%matrix_cap_decomp_cpools_col(c,l) = 0._r8 + end if + end do + end do + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_cpools_col(c,l) = & + this%decomp_cpools_col(c,l) + & + this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) + if(use_soil_matrixcn)then + this%matrix_cap_decomp_cpools_col(c,l) = & + this%matrix_cap_decomp_cpools_col(c,l) + & + this%matrix_cap_decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) + end if + end do + end do + end do + + if ( nlevdecomp > 1) then + + ! vertically integrate each of the decomposing C pools to 1 meter + maxdepth = 1._r8 + do l = 1, ndecomp_pools + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_cpools_1m_col(c,l) = 0._r8 + end do + end do + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + if ( zisoi(j) <= maxdepth ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_cpools_1m_col(c,l) = & + this%decomp_cpools_1m_col(c,l) + & + this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) + end do + elseif ( zisoi(j-1) < maxdepth ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_cpools_1m_col(c,l) = & + this%decomp_cpools_1m_col(c,l) + & + this%decomp_cpools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) + end do + endif + end do + end do + + endif + + ! Add soil carbon pools together to produce vertically-resolved decomposing total soil c pool + if ( nlevdecomp_full > 1 ) then + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_soilc_vr_col(c,j) = 0._r8 + end do + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_soilc_vr_col(c,j) = this%decomp_soilc_vr_col(c,j) + & + this%decomp_cpools_vr_col(c,j,l) + end do + end do + end if + end do + end if + + ! truncation carbon + do fc = 1,num_allc + c = filter_allc(fc) + this%ctrunc_col(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%ctrunc_col(c) = & + this%ctrunc_col(c) + & + this%ctrunc_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + ! total litter carbon in the top meter (TOTLITC_1m) + if ( nlevdecomp > 1) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totlitc_1m_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totlitc_1m_col(c) = this%totlitc_1m_col(c) + & + this%decomp_cpools_1m_col(c,l) + end do + endif + end do + end if + + ! total soil organic matter carbon in the top meter (TOTSOMC_1m) + if ( nlevdecomp > 1) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totsomc_1m_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totsomc_1m_col(c) = this%totsomc_1m_col(c) + this%decomp_cpools_1m_col(c,l) + end do + end if + end do + end if + + ! total litter carbon (TOTLITC) + do fc = 1,num_allc + c = filter_allc(fc) + this%totlitc_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totlitc_col(c) = this%totlitc_col(c) + this%decomp_cpools_col(c,l) + end do + endif + end do + + + ! total soil organic matter carbon (TOTSOMC) + do fc = 1,num_allc + c = filter_allc(fc) + this%totsomc_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totsomc_col(c) = this%totsomc_col(c) + this%decomp_cpools_col(c,l) + end do + end if + end do + + ! coarse woody debris carbon + if (.not. use_fates ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%cwdc_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_cwd(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%cwdc_col(c) = this%cwdc_col(c) + this%decomp_cpools_col(c,l) + end do + end if + end do + + end if + + end subroutine Summary + + !------------------------------------------------------------------------ + subroutine SetTotVgCThresh(this, totvegcthresh) + + class(soilbiogeochem_carbonstate_type) :: this + real(r8) , intent(in) :: totvegcthresh + + if ( totvegcthresh <= 0.0_r8 )then + call endrun(msg=' ERROR totvegcthresh is zero or negative and should be > 0'//& + errMsg(sourcefile, __LINE__)) + end if + this%totvegcthresh = totvegcthresh + + end subroutine SetTotVgCThresh + + + !----------------------------------------------------------------------- + end module CNCLM_SoilBiogeochemCarbonStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index b39575de5..268452a81 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -5,7 +5,8 @@ module CNCLM_SoilBiogeochemNitrogenFluxType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, ndecomp_cascade_outtransitions use clm_varpar , only : nlevdecomp_full, nlevdecomp, ndecomp_pools_vr use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_soil_matrixcn - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con ! !PUBLIC TYPES: implicit none @@ -14,7 +15,6 @@ module CNCLM_SoilBiogeochemNitrogenFluxType ! ! !PUBLIC MEMBER FUNCTIONS: public :: init_soilbiogeochem_nitrogenflux_type - procedure, public :: SetValues type, public :: SoilBiogeochem_nitrogenflux_type @@ -136,6 +136,11 @@ module CNCLM_SoilBiogeochemNitrogenFluxType integer,pointer,dimension(:) :: CI_na ! Column numbers of all entries from AKsoiln. Automatically generated by SetValueA ! type(vector_type) :: matrix_Ninput ! N input to different soil compartments (pools and layers) (gN/m3/step) + contains + + procedure , public :: SetValues + procedure , public :: Summary + end type soilbiogeochem_nitrogenflux_type type(soilbiogeochem_nitrogenflux_type), public, target, save :: soilbiogeochem_nitrogenflux_inst @@ -435,5 +440,180 @@ subroutine SetValues ( this, & end subroutine SetValues + !----------------------------------------------------------------------- + subroutine Summary(this, bounds, num_soilc, filter_soilc) + ! + ! !USES: + use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions,ndecomp_pools + use clm_varctl , only: use_nitrif_denitrif + ! + ! !ARGUMENTS: + class (soilbiogeochem_nitrogenflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l ! indices + integer :: fc ! filter indices + !----------------------------------------------------------------------- + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = 0._r8 + this%supplement_to_sminn_col(c) = 0._r8 + this%som_n_leached_col(c) = 0._r8 + end do + + ! vertically integrate decomposing N cascade fluxes and soil mineral N fluxes associated with decomposition cascade + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + this%decomp_cascade_ntransfer_col(c,k) = & + this%decomp_cascade_ntransfer_col(c,k) + & + this%decomp_cascade_ntransfer_vr_col(c,j,k) * dzsoi_decomp(j) + + this%decomp_cascade_sminn_flux_col(c,k) = & + this%decomp_cascade_sminn_flux_col(c,k) + & + this%decomp_cascade_sminn_flux_vr_col(c,j,k) * dzsoi_decomp(j) + end do + end do + end do + + if (.not. use_nitrif_denitrif) then + + ! vertically integrate each denitrification flux + do l = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%sminn_to_denit_decomp_cascade_col(c,l) = & + this%sminn_to_denit_decomp_cascade_col(c,l) + & + this%sminn_to_denit_decomp_cascade_vr_col(c,j,l) * dzsoi_decomp(j) + end do + end do + end do + + ! vertically integrate bulk denitrification and leaching flux + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%sminn_to_denit_excess_col(c) = & + this%sminn_to_denit_excess_col(c) + & + this%sminn_to_denit_excess_vr_col(c,j) * dzsoi_decomp(j) + + this%sminn_leached_col(c) = & + this%sminn_leached_col(c) + & + this%sminn_leached_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + + ! total N denitrification (DENIT) + do l = 1, ndecomp_cascade_transitions + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = & + this%denit_col(c) + & + this%sminn_to_denit_decomp_cascade_col(c,l) + end do + end do + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = & + this%denit_col(c) + & + this%sminn_to_denit_excess_col(c) + end do + + else + + + ! vertically integrate NO3 NH4 N2O fluxes and pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! nitrification and denitrification fluxes + this%f_nit_col(c) = & + this%f_nit_col(c) + & + this%f_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_denit_col(c) = & + this%f_denit_col(c) + & + this%f_denit_vr_col(c,j) * dzsoi_decomp(j) + + this%pot_f_nit_col(c) = & + this%pot_f_nit_col(c) + & + this%pot_f_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%pot_f_denit_col(c) = & + this%pot_f_denit_col(c) + & + this%pot_f_denit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_n2o_nit_col(c) = & + this%f_n2o_nit_col(c) + & + this%f_n2o_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_n2o_denit_col(c) = & + this%f_n2o_denit_col(c) + & + this%f_n2o_denit_vr_col(c,j) * dzsoi_decomp(j) + + ! leaching/runoff flux + this%smin_no3_leached_col(c) = & + this%smin_no3_leached_col(c) + & + this%smin_no3_leached_vr_col(c,j) * dzsoi_decomp(j) + + this%smin_no3_runoff_col(c) = & + this%smin_no3_runoff_col(c) + & + this%smin_no3_runoff_vr_col(c,j) * dzsoi_decomp(j) + + end do + end do + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = this%f_denit_col(c) + end do + + end if + + ! supplementary N supplement_to_sminn + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%supplement_to_sminn_col(c) = & + this%supplement_to_sminn_col(c) + & + this%supplement_to_sminn_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these + do l = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_leached_col(c,l) = 0._r8 + end do + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_leached_col(c,l) = & + this%decomp_npools_leached_col(c,l) + & + this%decomp_npools_transport_tendency_col(c,j,l) * dzsoi_decomp(j) + end do + end do + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%som_n_leached_col(c) = & + this%som_n_leached_col(c) + & + this%decomp_npools_leached_col(c,l) + end do + end do + + end subroutine Summary end module CNCLM_SoilBiogeochemNitrogenFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index 5dcc091f6..d6c249e86 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -4,8 +4,9 @@ module CNCLM_SoilBiogeochemNitrogenStateType use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi - use clm_varctl , only : use_soil_matrixcn - use CNCLM_decompMod , only : bounds_type + use clm_varcon , only : spval, dzsoi_decomp, zisoi + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp, use_soil_matrixcn + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none @@ -63,6 +64,10 @@ module CNCLM_SoilBiogeochemNitrogenStateType ! type(sparse_matrix_type) :: AKXnacc ! col (gN/m3/yr) accumulated N transfers from j to i (col,i,j) per year in dimension(col,nlev*npools,nlev*npools) in sparse matrix type ! type(vector_type) :: matrix_Ninter ! col (gN/m3) vertically-resolved decomposing (litter, cwd, soil) N pools in dimension(col,nlev*npools) in vector type + contains + + procedure, public :: Summary + end type soilbiogeochem_nitrogenstate_type type(soilbiogeochem_nitrogenstate_type), public, target, save :: soilbiogeochem_nitrogenstate_inst @@ -146,9 +151,9 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) do nz = 1,nzone ! CN zone loop n = n + 1 - this%ntrunc_vr_col (n) = cncol(nc,nz,16) + this%ntrunc_vr_col (n,1:nlevdecomp_full) = cncol(nc,nz,16) ! jkolassa May 2022: for now nlevdecomp_full = 1; will need to add loop if we introduce more soil layers - this%sminn_vr_col (n,1) = cncol(nc,nz,24) + this%sminn_vr_col (n,1:nlevdecomp_full) = cncol(nc,nz,24) this%sminn_col (n) = this%sminn_vr_col(n,1) do np = 1,ndecomp_pools @@ -163,4 +168,230 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) end subroutine init_soilbiogeochem_nitrogenstate_type + !----------------------------------------------------------------------- + subroutine Summary(this, bounds, num_allc, filter_allc) + ! + ! !ARGUMENTS: + class (soilbiogeochem_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l ! indices + integer :: fc ! lake filter indices + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + ! vertically integrate NO3 NH4 N2O pools + if (use_nitrif_denitrif) then + do fc = 1,num_allc + c = filter_allc(fc) + this%smin_no3_col(c) = 0._r8 + this%smin_nh4_col(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%smin_no3_col(c) = & + this%smin_no3_col(c) + & + this%smin_no3_vr_col(c,j) * dzsoi_decomp(j) + + this%smin_nh4_col(c) = & + this%smin_nh4_col(c) + & + this%smin_nh4_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + end if + + ! vertically integrate each of the decomposing N pools + do l = 1, ndecomp_pools + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_npools_col(c,l) = 0._r8 + if(use_soil_matrixcn)then + this%matrix_cap_decomp_npools_col(c,l) = 0._r8 + end if + end do + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_npools_col(c,l) = & + this%decomp_npools_col(c,l) + & + this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) + if(use_soil_matrixcn)then + this%matrix_cap_decomp_npools_col(c,l) = & + this%matrix_cap_decomp_npools_col(c,l) + & + this%matrix_cap_decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) + end if + end do + end do + end do + + ! for vertically-resolved soil biogeochemistry, calculate some diagnostics of carbon pools to a given depth + if ( nlevdecomp > 1) then + + do l = 1, ndecomp_pools + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_npools_1m_col(c,l) = 0._r8 + end do + end do + + + ! vertically integrate each of the decomposing n pools to 1 meter + maxdepth = 1._r8 + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + if ( zisoi(j) <= maxdepth ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_npools_1m_col(c,l) = & + this%decomp_npools_1m_col(c,l) + & + this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) + end do + elseif ( zisoi(j-1) < maxdepth ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_npools_1m_col(c,l) = & + this%decomp_npools_1m_col(c,l) + & + this%decomp_npools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) + end do + endif + end do + end do + + + ! Add soil nitrogen pools together to produce vertically-resolved decomposing total soil N pool + if ( nlevdecomp_full > 1 ) then + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_soiln_vr_col(c,j) = 0._r8 + end do + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%decomp_soiln_vr_col(c,j) = this%decomp_soiln_vr_col(c,j) + & + this%decomp_npools_vr_col(c,j,l) + end do + end do + end if + end do + end if + + ! total litter nitrogen to 1 meter (TOTLITN_1m) + do fc = 1,num_allc + c = filter_allc(fc) + this%totlitn_1m_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totlitn_1m_col(c) = & + this%totlitn_1m_col(c) + & + this%decomp_npools_1m_col(c,l) + end do + end if + end do + + + ! total soil organic matter nitrogen to 1 meter (TOTSOMN_1m) + do fc = 1,num_allc + c = filter_allc(fc) + this%totsomn_1m_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totsomn_1m_col(c) = this%totsomn_1m_col(c) + & + this%decomp_npools_1m_col(c,l) + end do + end if + end do + + endif + + ! total litter nitrogen (TOTLITN) + do fc = 1,num_allc + c = filter_allc(fc) + this%totlitn_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totlitn_col(c) = & + this%totlitn_col(c) + & + this%decomp_npools_col(c,l) + end do + end if + end do + + + ! total soil organic matter nitrogen (TOTSOMN) + do fc = 1,num_allc + c = filter_allc(fc) + this%totsomn_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%totsomn_col(c) = this%totsomn_col(c) + & + this%decomp_npools_col(c,l) + end do + end if + end do + + ! total cwdn + do fc = 1,num_allc + c = filter_allc(fc) + this%cwdn_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_cwd(l) ) then + do fc = 1,num_allc + c = filter_allc(fc) + this%cwdn_col(c) = this%cwdn_col(c) + & + this%decomp_npools_col(c,l) + end do + end if + end do + + + ! total sminn + do fc = 1,num_allc + c = filter_allc(fc) + this%sminn_col(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%sminn_col(c) = this%sminn_col(c) + & + this%sminn_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + ! total col_ntrunc + do fc = 1,num_allc + c = filter_allc(fc) + this%ntrunc_col(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_allc + c = filter_allc(fc) + this%ntrunc_col(c) = this%ntrunc_col(c) + & + this%ntrunc_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + end subroutine Summary + end CNCLM_SoilBiogeochemNitrogenStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 index 58967a136..605722f6a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 @@ -1,12 +1,13 @@ module CNCLM_VegCarbonStateType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use clm_varctl , only : use_matrixcn + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 + use clm_varctl , only : iulog, use_cndv, use_crop, use_matrixc use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight use nanMod , only : nan use CNCLM_decompMod , only : bounds_type - + use pftconMod , only : noveg, npcropmin, pftcon + use PatchType , only : patch ! !PUBLIC TYPES: implicit none @@ -192,6 +193,10 @@ module CNCLM_VegCarbonStateType real(r8), pointer :: deadcrootc_xfer_SASUsave_patch (:) ! (gC/m2) dead coarse root C transfer logical, private :: dribble_crophrv_xsmrpool_2atm + contains + + procedure , public :: Summary => Summary_carbonstate + end type cnveg_carbonstate_type type(cnveg_carbonstate_type), public, target, save :: cnveg_carbonstate_inst @@ -199,7 +204,7 @@ module CNCLM_VegCarbonStateType contains !---------------------------------------------- - subroutine init_cnveg_carbonstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) + subroutine init_cnveg_carbonstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this) ! !DESCRIPTION: ! Initialize CTSM carbon states @@ -217,31 +222,18 @@ subroutine init_cnveg_carbonstate_type(bounds, nch, ityp, fveg, cncol, cnpft, th real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart type(cnveg_carbonstate_type), intent(inout):: this - logical, optional, intent(in) :: cn5_cold_start ! LOCAL integer :: begp, endp integer :: begc, endc integer :: begg, endg integer :: np, nc, nz, p, nv, n - logical :: cold_start = .false. !-------------------------------------------------------- begp = bounds%begp ; endp = bounds%endp begg = bounds%begg ; endg = bounds%endg begc = bounds%begc ; endc = bounds%endc - ! check whether a cn5_cold_start option was set and change cold_start accordingly - if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then - cold_start = .true. - end if - - ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) - _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') - end if - allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan allocate(this%leafc_xfer_patch (begp:endp)) ; this%leafc_xfer_patch (:) = nan @@ -518,4 +510,143 @@ subroutine init_cnveg_carbonstate_type(bounds, nch, ityp, fveg, cncol, cnpft, th end subroutine init_cnveg_carbonstate_type + !----------------------------------------------------------------------- + subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_cwdc_col, soilbiogeochem_totlitc_col, soilbiogeochem_totsomc_col, & + soilbiogeochem_ctrunc_col) + ! + ! !USES: + use subgridAveMod, only : p2c + use clm_time_manager , only : get_nstep + + ! + ! !DESCRIPTION: + ! Perform patch and column-level carbon summary calculations + ! + ! !ARGUMENTS: + class(cnveg_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + real(r8) , intent(in) :: soilbiogeochem_cwdc_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_totlitc_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_totsomc_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_ctrunc_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_cwdc_col) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_totlitc_col) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_totsomc_col) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_ctrunc_col) == (/bounds%endc/)), sourcefile, __LINE__) + + ! calculate patch -level summary of carbon state + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed vegetation carbon, excluding storage and cpool (DISPVEGC) + this%dispvegc_patch(p) = & + this%leafc_patch(p) + & + this%frootc_patch(p) + & + this%livestemc_patch(p) + & + this%deadstemc_patch(p) + & + this%livecrootc_patch(p) + & + this%deadcrootc_patch(p) + + ! stored vegetation carbon, excluding cpool (STORVEGC) + this%storvegc_patch(p) = & + this%cpool_patch(p) + & + this%leafc_storage_patch(p) + & + this%frootc_storage_patch(p) + & + this%livestemc_storage_patch(p) + & + this%deadstemc_storage_patch(p) + & + this%livecrootc_storage_patch(p) + & + this%deadcrootc_storage_patch(p) + & + this%leafc_xfer_patch(p) + & + this%frootc_xfer_patch(p) + & + this%livestemc_xfer_patch(p) + & + this%deadstemc_xfer_patch(p) + & + this%livecrootc_xfer_patch(p) + & + this%deadcrootc_xfer_patch(p) + & + this%gresp_storage_patch(p) + & + this%gresp_xfer_patch(p) + + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%storvegc_patch(p) = & + this%storvegc_patch(p) + & + this%grainc_storage_patch(p) + & + this%grainc_xfer_patch(p) + + this%dispvegc_patch(p) = & + this%dispvegc_patch(p) + & + this%grainc_patch(p) + end if + + ! total vegetation carbon, excluding cpool (TOTVEGC) + this%totvegc_patch(p) = & + this%dispvegc_patch(p) + & + this%storvegc_patch(p) + + ! total patch-level carbon, including xsmrpool, ctrunc + this%totc_patch(p) = & + this%totvegc_patch(p) + & + this%xsmrpool_patch(p) + & + this%ctrunc_patch(p) + + if (use_crop) then + this%totc_patch(p) = this%totc_patch(p) + this%cropseedc_deficit_patch(p) + & + this%xsmrpool_loss_patch(p) + end if + + ! (WOODC) - wood C + this%woodc_patch(p) = & + this%deadstemc_patch(p) + & + this%livestemc_patch(p) + & + this%deadcrootc_patch(p) + & + this%livecrootc_patch(p) + + end do + + ! -------------------------------------------- + ! column level summary + ! -------------------------------------------- + + call p2c(bounds, num_soilc, filter_soilc, & + this%totvegc_patch(bounds%begp:bounds%endp), & + this%totvegc_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%totc_patch(bounds%begp:bounds%endp), & + this%totc_p2c_col(bounds%begc:bounds%endc)) + + do fc = 1,num_allc + c = filter_allc(fc) + + ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) + this%totecosysc_col(c) = & + soilbiogeochem_cwdc_col(c) + & + soilbiogeochem_totlitc_col(c) + & + soilbiogeochem_totsomc_col(c) + & + this%totvegc_col(c) + + ! total column carbon, including veg and cpool (TOTCOLC) + this%totc_col(c) = this%totc_p2c_col(c) + & + soilbiogeochem_cwdc_col(c) + & + soilbiogeochem_totlitc_col(c) + & + soilbiogeochem_totsomc_col(c) + & + soilbiogeochem_ctrunc_col(c) + + end do + + end subroutine Summary_carbonstate + end module CNCLM_VegCarbonStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 index 7bfcd15db..2e163b5e9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 @@ -3,10 +3,15 @@ module CNCLM_VegNitrogenStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use MAPL_ExceptionHandling use clm_varctl , only : use_matrixcn + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp use clm_varpar , only : NUM_ZON, NUM_VEG, VAR_COL, VAR_PFT, & numpft, CN_zone_weight + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan + use clm_varpar , only : nlevdecomp_full, nlevdecomp + use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type + use PatchType , only : patch ! !PUBLIC TYPES: implicit none @@ -198,13 +203,17 @@ module CNCLM_VegNitrogenStateType real(r8), pointer :: deadcrootn_storage_SASUsave_patch (:) ! (gC/m2) dead coarse root C storage real(r8), pointer :: deadcrootn_xfer_SASUsave_patch (:) ! (gC/m2) dead coarse root C transfer:wq + contains + + procedure , public :: Summary => Summary_nitrogenstate + end type cnveg_nitrogenstate_type type(cnveg_nitrogenstate_type), public, target, save :: cnveg_nitrogenstate_inst contains !------------------------------------------------------------- - subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) + subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this) ! !DESCRIPTION: ! Initialize CTSM nitrogen states @@ -222,31 +231,18 @@ subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart type(cnveg_nitrogenstate_type), intent(inout):: this - logical, optional, intent(in) :: cn5_cold_start ! LOCAL: integer :: begp, endp, begg, endgg, begc, endc integer :: np, nc, nz, p, nv, n - logical :: cold_start = .false. !--------------------------------------------------------------------- begp = bounds%begp ; endp = bounds%endp begg = bounds%begg ; endg = bounds%endg begc = bounds%begc ; endc = bounds%endc - ! check whether a cn5_cold_start option was set and change cold_start accordingly - if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then - cold_start = .true. - end if - - ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) - _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') - end if - allocate(this%grainn_patch (begp:endp)) ; this%grainn_patch (:) = nan allocate(this%grainn_storage_patch (begp:endp)) ; this%grainn_storage_patch (:) = nan allocate(this%grainn_xfer_patch (begp:endp)) ; this%grainn_xfer_patch (:) = nan @@ -473,9 +469,9 @@ subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this%livestemn_patch (np) = cnpft(nc,nz,nv, 63) this%livestemn_storage_patch (np) = cnpft(nc,nz,nv, 64) this%livestemn_xfer_patch (np) = cnpft(nc,nz,nv, 65) - this%npool_patch (np) = cncol(nc,nz,nv, 66) - this%ntrunc_patch (np) = cncol(nc,nz,nv, 67) - this%retransn_patch (np) = cncol(nc,nz,nv, 68) + this%npool_patch (np) = cnpft(nc,nz,nv, 66) + this%ntrunc_patch (np) = cnpft(nc,nz,nv, 67) + this%retransn_patch (np) = cnpft(nc,nz,nv, 68) end if end do !nv @@ -485,5 +481,125 @@ subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, end subroutine init_cnveg_nitrogenstate_type + !----------------------------------------------------------------------- + subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp,& + soilbiogeochem_nitrogenstate_inst) + ! + ! !USES: + use subgridAveMod, only : p2c + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + ! + ! !ARGUMENTS: + class(cnveg_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + ! -------------------------------------------- + ! patch level summary + ! -------------------------------------------- + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed vegetation nitrogen, excluding storage (DISPVEGN) + this%dispvegn_patch(p) = & + this%leafn_patch(p) + & + this%frootn_patch(p) + & + this%livestemn_patch(p) + & + this%deadstemn_patch(p) + & + this%livecrootn_patch(p) + & + this%deadcrootn_patch(p) + + ! stored vegetation nitrogen, including retranslocated N pool (STORVEGN) + this%storvegn_patch(p) = & + this%leafn_storage_patch(p) + & + this%frootn_storage_patch(p) + & + this%livestemn_storage_patch(p) + & + this%deadstemn_storage_patch(p) + & + this%livecrootn_storage_patch(p) + & + this%deadcrootn_storage_patch(p) + & + this%leafn_xfer_patch(p) + & + this%frootn_xfer_patch(p) + & + this%livestemn_xfer_patch(p) + & + this%deadstemn_xfer_patch(p) + & + this%livecrootn_xfer_patch(p) + & + this%deadcrootn_xfer_patch(p) + & + this%npool_patch(p) + & + this%retransn_patch(p) + + if ( use_crop .and. patch%itype(p) >= npcropmin )then + this%dispvegn_patch(p) = & + this%dispvegn_patch(p) + & + this%grainn_patch(p) + + this%storvegn_patch(p) = & + this%storvegn_patch(p) + & + this%grainn_storage_patch(p) + & + this%grainn_xfer_patch(p) + & + this%cropseedn_deficit_patch(p) + end if + + ! total vegetation nitrogen (TOTVEGN) + this%totvegn_patch(p) = & + this%dispvegn_patch(p) + & + this%storvegn_patch(p) + + ! total patch-level carbon (add ntrunc) + this%totn_patch(p) = & + this%totvegn_patch(p) + & + this%ntrunc_patch(p) + + end do + + ! -------------------------------------------- + ! column level summary + ! -------------------------------------------- + + call p2c(bounds, num_soilc, filter_soilc, & + this%totvegn_patch(bounds%begp:bounds%endp), & + this%totvegn_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%totn_patch(bounds%begp:bounds%endp), & + this%totn_p2c_col(bounds%begc:bounds%endc)) + + + do fc = 1,num_allc + c = filter_allc(fc) + + ! total ecosystem nitrogen, including veg (TOTECOSYSN) + this%totecosysn_col(c) = & + soilbiogeochem_nitrogenstate_inst%cwdn_col(c) + & + soilbiogeochem_nitrogenstate_inst%totlitn_col(c) + & + soilbiogeochem_nitrogenstate_inst%totsomn_col(c) + & + soilbiogeochem_nitrogenstate_inst%sminn_col(c) + & + this%totvegn_col(c) + + ! total column nitrogen, including patch (TOTCOLN) + + this%totn_col(c) = this%totn_p2c_col(c) + & + soilbiogeochem_nitrogenstate_inst%cwdn_col(c) + & + soilbiogeochem_nitrogenstate_inst%totlitn_col(c) + & + soilbiogeochem_nitrogenstate_inst%totsomn_col(c) + & + soilbiogeochem_nitrogenstate_inst%sminn_col(c) + & + soilbiogeochem_nitrogenstate_inst%ntrunc_col(c) + + end do + + end subroutine Summary_nitrogenstate + end module CNCLM_VegNitrogenStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index 3427aae27..41aa850ea 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -170,13 +170,18 @@ subroutine init_filter_type(bounds, nch, this_filter) this_filter%num_exposedvegp = 0 this_filter%num_noexposedvegp = 0 this_filter%num_nourbanp = 0 + this_filter%num_allc = 0 n = 0 do nc = 1,nch do nz = 1,nzone n = n + 1 + this_filter%num_soilc = this_filter%num_soilc + 1 this_filter%soilc(this%num_soilc) = n + this_filter%num_allc = this_filter%num_allc + 1 + this_filter%allc(this%num_allc) = n + do p = 0,numpft ! PFT index loop np = np + 1 do nv = 1,num_veg ! defined veg loop diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 new file mode 100755 index 000000000..f9d1a7370 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -0,0 +1,1153 @@ +module CNDriverMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Ecosystem dynamics: phenology, vegetation + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : use_c13, use_c14, use_fates, use_dynroot + use dynSubgridControlMod , only : get_do_harvest + use decompMod , only : bounds_type + use perf_mod , only : t_startf, t_stopf + use clm_varctl , only : use_century_decomp, use_nitrif_denitrif, use_nguardrail + use clm_varctl , only : use_crop + use clm_varctl , only : use_matrixcn,use_soil_matrixcn + use CNSharedParamsMod , only : use_fun + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNProductsMod , only : cn_products_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use CNDVType , only : dgvs_type + use CanopyStateType , only : canopystate_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use atm2lndType , only : atm2lnd_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use PhotosynthesisMod , only : photosyns_type + use ch4Mod , only : ch4_type + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use ActiveLayerMod , only : active_layer_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNDriverInit ! Ecosystem dynamics: initialization + public :: CNDriverNoLeaching ! Ecosystem dynamics: phenology, vegetation, before doing N leaching + public :: CNDriverLeaching ! Ecosystem dynamics: phenology, vegetation, doing N leaching + public :: CNDriverSummarizeStates + public :: CNDriverSummarizeFluxes + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNDriverInit(bounds, NLFilename, cnfire_method) + ! + ! !DESCRIPTION: + ! Initialzation of the CN Ecosystem dynamics. + ! + ! !USES: + use CNSharedParamsMod , only : use_fun + use CNPhenologyMod , only : CNPhenologyInit + use FireMethodType , only : fire_method_type + use SoilBiogeochemCompetitionMod, only : SoilBiogeochemCompetitionInit + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: NLFilename ! Namelist filename + class(fire_method_type) , intent(inout) :: cnfire_method + !----------------------------------------------------------------------- + call SoilBiogeochemCompetitionInit(bounds) + call CNPhenologyInit(bounds) + call cnfire_method%FireInit(bounds, NLFilename) + + end subroutine CNDriverInit + + !----------------------------------------------------------------------- + subroutine CNDriverNoLeaching(bounds, & + num_soilc, filter_soilc, num_soilp, filter_soilp, num_actfirec, filter_actfirec, & + num_actfirep, filter_actfirep, num_pcropp, filter_pcropp, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, doalb, & + cnveg_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + c_products_inst, c13_products_inst, c14_products_inst, n_products_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + active_layer_inst, & + atm2lnd_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, & + wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + soil_water_retention_curve, crop_inst, ch4_inst, & + dgvs_inst, photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & + nutrient_competition_method, cnfire_method, dribble_crophrv_xsmrpool_2atm) + ! + ! !DESCRIPTION: + ! The core CN code is executed here. Calculates fluxes for maintenance + ! respiration, decomposition, allocation, phenology, and growth respiration. + ! These routines happen on the radiation time step so that canopy structure + ! stays synchronized with albedo calculations. + ! + ! !USES: + use clm_varpar , only: nlevgrnd, nlevdecomp_full, nvegcpool, nvegnpool + use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use subgridAveMod , only: p2c + use CropType , only: crop_type + use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix,CNFreeLivingFixation + use CNMRespMod , only: CNMResp + use CNFUNMod , only: CNFUNInit !, CNFUN + use CNPhenologyMod , only: CNPhenology + use CNGRespMod , only: CNGResp + use FireMethodType , only: fire_method_type + use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 + use CNC14DecayMod , only: C14Decay + use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 + use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h + use CNCStateUpdate3Mod , only: CStateUpdate3 + use CNNStateUpdate1Mod , only: NStateUpdate1 + use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h + use CNGapMortalityMod , only: CNGapMortality + use CNSharedParamsMod , only: use_fun + use dynHarvestMod , only: CNHarvest + use SoilBiogeochemDecompCascadeBGCMod , only: decomp_rate_constants_bgc + use SoilBiogeochemDecompCascadeCNMod , only: decomp_rate_constants_cn + use SoilBiogeochemCompetitionMod , only: SoilBiogeochemCompetition + use SoilBiogeochemDecompMod , only: SoilBiogeochemDecomp + use SoilBiogeochemLittVertTranspMod , only: SoilBiogeochemLittVertTransp + use SoilBiogeochemPotentialMod , only: SoilBiogeochemPotential + use SoilBiogeochemVerticalProfileMod , only: SoilBiogeochemVerticalProfile + use SoilBiogeochemNitrifDenitrifMod , only: SoilBiogeochemNitrifDenitrif + use SoilBiogeochemNStateUpdate1Mod , only: SoilBiogeochemNStateUpdate1 + use NutrientCompetitionMethodMod , only: nutrient_competition_method_type + use CNRootDynMod , only: CNRootDyn + use CNPrecisionControlMod , only: CNPrecisionControl + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(out) :: num_actfirep ! number of soil patches on fire in filter + integer , intent(out) :: filter_actfirep(:) ! filter for soil patches on fire + integer , intent(out) :: num_actfirec ! number of soil columns on fire in filter + integer , intent(out) :: filter_actfirec(:) ! filter for soil columns on fire + integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter + integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + logical , intent(in) :: doalb ! true = surface albedo calculation time step + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cn_products_type) , intent(inout) :: c_products_inst + type(cn_products_type) , intent(inout) :: c13_products_inst + type(cn_products_type) , intent(inout) :: c14_products_inst + type(cn_products_type) , intent(inout) :: n_products_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(active_layer_type) , intent(in) :: active_layer_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + class(soil_water_retention_curve_type) , intent(in) :: soil_water_retention_curve + type(crop_type) , intent(inout) :: crop_inst + type(ch4_type) , intent(in) :: ch4_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + type(photosyns_type) , intent(in) :: photosyns_inst + type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst + type(energyflux_type) , intent(in) :: energyflux_inst + class(nutrient_competition_method_type) , intent(inout) :: nutrient_competition_method + class(fire_method_type) , intent(inout) :: cnfire_method + logical , intent(in) :: dribble_crophrv_xsmrpool_2atm + ! + ! !LOCAL VARIABLES: + real(r8):: cn_decomp_pools(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_pools) + real(r8):: p_decomp_cpool_loss(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_cascade_transitions) !potential C loss from one pool to another + real(r8):: pmnf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_cascade_transitions) !potential mineral N flux, from one pool to another + real(r8):: arepr(bounds%begp:bounds%endp) ! reproduction allocation coefficient (only used for use_crop) + real(r8):: aroot(bounds%begp:bounds%endp) ! root allocation coefficient (only used for use_crop) + integer :: begp,endp + integer :: begc,endc + + integer :: dummy_to_make_pgi_happy + !----------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + associate( & + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch , & ! Output: [integer (:) ] frac of vegetation not covered by snow [-] + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index, no burying by snow + elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow + htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m) + hbot => canopystate_inst%hbot_patch & ! Output: [real(r8) (:) ] canopy bottom (m) + ) + + ! -------------------------------------------------- + ! zero the column-level C and N fluxes + ! -------------------------------------------------- + + call t_startf('CNZero') + + ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) Without this, the filter is full of garbage + ! in some situations + call t_startf('CNZero-soilbgc-cflux') + dummy_to_make_pgi_happy = ubound(filter_soilc, 1) + call soilbiogeochem_carbonflux_inst%SetValues( & + num_soilc, filter_soilc, 0._r8) + if ( use_c13 ) then + call c13_soilbiogeochem_carbonflux_inst%SetValues( & + num_soilc, filter_soilc, 0._r8) + end if + if ( use_c14 ) then + call c14_soilbiogeochem_carbonflux_inst%SetValues( & + num_soilc, filter_soilc, 0._r8) + end if + call t_stopf('CNZero-soilbgc-cflux') + + call t_startf('CNZero-vegbgc-cflux') + call cnveg_carbonflux_inst%SetValues( & + nvegcpool,& + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + if ( use_c13 ) then + call c13_cnveg_carbonflux_inst%SetValues( & + nvegcpool,& + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + if ( use_c14 ) then + call c14_cnveg_carbonflux_inst%SetValues( & + nvegcpool,& + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + call t_stopf('CNZero-vegbgc-cflux') + + call t_startf('CNZero-vegbgc-nflux') + call cnveg_nitrogenflux_inst%SetValues( & + nvegnpool, & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + + call t_stopf('CNZero-vegbgc-nflux') + call t_startf('CNZero-soilbgc-nflux') + call soilbiogeochem_nitrogenflux_inst%SetValues( & + num_soilc, filter_soilc, 0._r8) + + call t_stopf('CNZero-soilbgc-nflux') + call t_stopf('CNZero') + + ! -------------------------------------------------- + ! Nitrogen Deposition, Fixation and Respiration + ! -------------------------------------------------- + + call t_startf('CNDeposition') + call CNNDeposition(bounds, & + atm2lnd_inst, soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNDeposition') + + if(use_fun)then + call t_startf('CNFLivFixation') + call CNFreeLivingFixation( num_soilc, filter_soilc, & + waterfluxbulk_inst, soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNFLivFixation') + else + call t_startf('CNFixation') + call CNNFixation( num_soilc, filter_soilc, & + cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNFixation') + end if + + + if (use_crop) then + call CNNFert(bounds, num_soilc,filter_soilc, & + cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) + + if (.not. use_fun) then ! if FUN is active, then soy fixation handled by FUN + call CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + waterdiagnosticbulk_inst, crop_inst, cnveg_state_inst, cnveg_nitrogenflux_inst , & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + end if + end if + + call t_startf('CNMResp') + call CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + canopystate_inst, soilstate_inst, temperature_inst, photosyns_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenstate_inst) + call t_stopf('CNMResp') + + !-------------------------------------------- + ! Soil Biogeochemistry + !-------------------------------------------- + + call t_startf('SoilBiogeochem') + if (use_century_decomp) then + call decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & + soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) + else + call decomp_rate_constants_cn(bounds, num_soilc, filter_soilc, & + soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) + end if + + ! calculate potential decomp rates and total immobilization demand (previously inlined in CNDecompAlloc) + call SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cn_decomp_pools=cn_decomp_pools(begc:endc,1:nlevdecomp,1:ndecomp_pools), & + p_decomp_cpool_loss=p_decomp_cpool_loss(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions), & + pmnf_decomp_cascade=pmnf_decomp_cascade(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions)) + + ! calculate vertical profiles for distributing soil and litter C and N (previously subroutine decomp_vertprofiles called from CNDecompAlloc) + call SoilBiogeochemVerticalProfile(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + active_layer_inst, soilstate_inst,soilbiogeochem_state_inst) + + ! calculate nitrification and denitrification rates (previously subroutine nitrif_denitrif called from CNDecompAlloc) + if (use_nitrif_denitrif) then + call SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & + soilstate_inst, waterstatebulk_inst, temperature_inst, ch4_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + end if + call t_stopf('SoilBiogeochem') + + !-------------------------------------------- + ! Resolve the competition between plants and soil heterotrophs + ! for available soil mineral N resource + !-------------------------------------------- + + call t_startf('CNDecompAlloc') + + ! Jinyun Tang: at this stage, the plant_nutrient_demand only calculates the plant ntirgeon demand. + ! Assume phosphorus dynamics will be included in the future. Also, I consider plant_nutrient_demand + ! as a generic interface to call actual nutrient calculation from different aboveground plantbgc. + ! Right now it is assumed the plant nutrient demand is summarized into columnwise demand, and the + ! nutrient redistribution after uptake is done by the plant bgc accordingly. + ! When nutrient competition is required to be done at cohort level both plant_nutrient_demand and + ! do_nutrient_competition should be modified, but that modification should not significantly change + ! the current interface. + + !RF: moved ths call to before nutrient_demand, so that croplive didn't change half way through crop N cycle. + if ( use_fun ) then + call t_startf('CNPhenology_phase1') + call CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, num_pcropp, filter_pcropp, & + doalb, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & + crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & + phase=1) + call t_stopf('CNPhenology_phase1') + + call t_startf('CNFUNInit') + call CNFUNInit(bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst) + call t_stopf('CNFUNInit') + + end if + + call t_startf('calc_plant_nutrient_demand') + call nutrient_competition_method%calc_plant_nutrient_demand ( & + bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot=aroot(begp:endp), arepr=arepr(begp:endp)) + + ! get the column-averaged plant_ndemand (needed for following call to SoilBiogeochemCompetition) + + call p2c(bounds, num_soilc, filter_soilc, & + cnveg_nitrogenflux_inst%plant_ndemand_patch(begp:endp), & + soilbiogeochem_state_inst%plant_ndemand_col(begc:endc)) + call t_stopf('calc_plant_nutrient_demand') + + ! resolve plant/heterotroph competition for mineral N + + + call t_startf('soilbiogeochemcompetition') + call SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, filter_soilp, waterstatebulk_inst, & + waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst, & + cnveg_carbonstate_inst ,& + cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst,& + soilbiogeochem_state_inst,soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst,canopystate_inst) + call t_stopf('soilbiogeochemcompetition') + + ! distribute the available N between the competing patches on the basis of + ! relative demand, and allocate C and N to new growth and storage + + call t_startf('calc_plant_nutrient_competition') + call nutrient_competition_method%calc_plant_nutrient_competition ( & + bounds, num_soilp, filter_soilp, & + cnveg_state_inst, crop_inst, canopystate_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot=aroot(begp:endp), & + arepr=arepr(begp:endp), & + fpg_col=soilbiogeochem_state_inst%fpg_col(begc:endc)) + call t_stopf('calc_plant_nutrient_competition') + + call t_stopf('CNDecompAlloc') + + !-------------------------------------------- + ! Calculate litter and soil decomposition rate + !-------------------------------------------- + + ! Calculation of actual immobilization and decomp rates, following + ! resolution of plant/heterotroph competition for mineral N (previously inlined in CNDecompAllocation in CNDecompMod) + + call t_startf('SoilBiogeochemDecomp') + + call SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cn_decomp_pools=cn_decomp_pools(begc:endc,1:nlevdecomp,1:ndecomp_pools), & + p_decomp_cpool_loss=p_decomp_cpool_loss(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions), & + pmnf_decomp_cascade=pmnf_decomp_cascade(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions)) + + call t_stopf('SoilBiogeochemDecomp') + + !-------------------------------------------- + ! Phenology + !-------------------------------------------- + + ! CNphenology needs to be called after above calls, since it depends on current + ! time-step fluxes to new growth on the lastlitterfall timestep in deciduous systems + + call t_startf('CNPhenology') + + if ( .not. use_fun ) then + call CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, num_pcropp, filter_pcropp, & + doalb, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & + crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & + phase=1) + end if + call CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, num_pcropp, filter_pcropp, & + doalb, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & + crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & + phase=2) + + call t_stopf('CNPhenology') + + !-------------------------------------------- + ! Growth respiration + !-------------------------------------------- + + call t_startf('CNGResp') + + call CNGResp(num_soilp, filter_soilp,& + cnveg_carbonflux_inst, canopystate_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + + call t_stopf('CNGResp') + + !-------------------------------------------- + ! Dynamic Roots + !-------------------------------------------- + + if( use_dynroot ) then + call t_startf('CNRootDyn') + + call CNRootDyn(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, & + cnveg_state_inst, crop_inst, soilstate_inst, soilbiogeochem_nitrogenstate_inst) + + call t_stopf('CNRootDyn') + end if + + !-------------------------------------------- + ! CNUpdate0 + !-------------------------------------------- + + call t_startf('CNUpdate0') + + call CStateUpdate0(num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst) + + if ( use_c13 ) then + call CStateUpdate0(num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst) + end if + + if ( use_c14 ) then + call CStateUpdate0(num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst) + end if + + call t_stopf('CNUpdate0') + + if ( use_nguardrail ) then + call t_startf('CNPrecisionControl') + call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + call t_stopf('CNPrecisionControl') + end if + !-------------------------------------------- + ! Update1 + !-------------------------------------------- + + call t_startf('CNUpdate1') + + ! Set the carbon isotopic flux variables (except for gap-phase mortality and fire fluxes) + if ( use_c13 ) then + + call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + isotope='c14') + end if + + ! Update all prognostic carbon state variables (except for gap-phase mortality and fire fluxes) + call CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & + crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm) + if ( use_c13 ) then + call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + crop_inst, c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm) + end if + if ( use_c14 ) then + call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + crop_inst, c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm) + end if + + ! Update all prognostic nitrogen state variables (except for gap-phase mortality and fire fluxes) + call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + + call t_stopf('CNUpdate1') + + if ( use_nguardrail ) then + call t_startf('CNPrecisionControl') + call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + call t_stopf('CNPrecisionControl') + end if + + call t_startf('SoilBiogeochemStateUpdate1') + call SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + call t_stopf('SoilBiogeochemStateUpdate1') + + + !-------------------------------------------- + ! Calculate vertical mixing of soil and litter pools + !-------------------------------------------- + + call t_startf('SoilBiogeochemLittVertTransp') + + call SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & + active_layer_inst, soilbiogeochem_state_inst, & + soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & + c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + + call t_stopf('SoilBiogeochemLittVertTransp') + + !-------------------------------------------- + ! Calculate the gap mortality carbon and nitrogen fluxes + !-------------------------------------------- + + call t_startf('CNGapMortality') + + call CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & + !cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & + croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & + stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full)) + + call t_stopf('CNGapMortality') + + !-------------------------------------------- + ! Update2 (gap mortality) + !-------------------------------------------- + + call t_startf('CNUpdate2') + + ! Set the carbon isotopic fluxes for gap mortality + if ( use_c13 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & + iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & + iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & + isotope='c14') + end if + + ! Update all the prognostic carbon state variables affected by gap-phase mortality fluxes + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + if ( use_c13 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst) + end if + if ( use_c14 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst) + end if + + ! Update all the prognostic nitrogen state variables affected by gap-phase mortality fluxes + call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst,soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + + !-------------------------------------------- + ! Update2h (harvest) + !-------------------------------------------- + + ! Set harvest mortality routine + if (get_do_harvest()) then + call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + end if + + if ( use_c13 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + isotope='c14') + end if + + call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + if ( use_c13 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst) + end if + if ( use_c14 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst) + end if + + call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNUpdate2') + + if ( use_nguardrail ) then + call t_startf('CNPrecisionControl') + call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + call t_stopf('CNPrecisionControl') + end if + !-------------------------------------------- + ! Calculate loss fluxes from wood products pools + ! and update product pool state variables + !-------------------------------------------- + + call t_startf('CNWoodProducts') + call c_products_inst%UpdateProducts(bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch = cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & + wood_harvest_patch = cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & + dwt_crop_product_gain_patch = cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & + grain_to_cropprod_patch = cnveg_carbonflux_inst%grainc_to_cropprodc_patch(begp:endp)) + call t_stopf('CNWoodProducts') + + if (use_c13) then + call c13_products_inst%UpdateProducts(bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch = c13_cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & + wood_harvest_patch = c13_cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & + dwt_crop_product_gain_patch = c13_cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & + grain_to_cropprod_patch = c13_cnveg_carbonflux_inst%grainc_to_cropprodc_patch(begp:endp)) + end if + + if (use_c14) then + call c14_products_inst%UpdateProducts(bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch = c14_cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & + wood_harvest_patch = c14_cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & + dwt_crop_product_gain_patch = c14_cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & + grain_to_cropprod_patch = c14_cnveg_carbonflux_inst%grainc_to_cropprodc_patch(begp:endp)) + end if + + call n_products_inst%UpdateProducts(bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch = cnveg_nitrogenflux_inst%dwt_wood_productn_gain_patch(begp:endp), & + wood_harvest_patch = cnveg_nitrogenflux_inst%wood_harvestn_patch(begp:endp), & + dwt_crop_product_gain_patch = cnveg_nitrogenflux_inst%dwt_crop_productn_gain_patch(begp:endp), & + grain_to_cropprod_patch = cnveg_nitrogenflux_inst%grainn_to_cropprodn_patch(begp:endp)) + + !-------------------------------------------- + ! Calculate fire area and fluxes + !-------------------------------------------- + + call t_startf('CNFire') + call cnfire_method%CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + cnveg_state_inst, cnveg_carbonstate_inst, & + totlitc_col=soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + t_soi17cm_col=temperature_inst%t_soi17cm_col(begc:endc)) + + call cnfire_method%CNFireFluxes(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & + dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & + croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & + stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full), & + totsomc_col=soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + decomp_npools_vr_col=soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + somc_fire_col=soilbiogeochem_carbonflux_inst%somc_fire_col(begc:endc)) + call t_stopf('CNFire') + + + !-------------------------------------------- + ! Update3 + !-------------------------------------------- + + call t_startf('CNUpdate3') + if ( use_c13 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + isotope='c14') + end if + + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + + if ( use_c13 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst) + end if + + if ( use_c14 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst) + + call C14Decay(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_soilbiogeochem_carbonflux_inst) + end if + call t_stopf('CNUpdate3') + + if ( use_nguardrail ) then + call t_startf('CNPrecisionControl') + call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + call t_stopf('CNPrecisionControl') + end if + + end associate + + end subroutine CNDriverNoLeaching + + !----------------------------------------------------------------------- + subroutine CNDriverLeaching(bounds, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, num_actfirep, filter_actfirep,& + waterstatebulk_inst, waterfluxbulk_inst, & + soilstate_inst, cnveg_state_inst, & + cnveg_carbonflux_inst,cnveg_carbonstate_inst,soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst,soilbiogeochem_state_inst, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + c13_cnveg_carbonstate_inst,c14_cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst,c14_cnveg_carbonflux_inst, & + c13_soilbiogeochem_carbonstate_inst,c14_soilbiogeochem_carbonstate_inst,& + c13_soilbiogeochem_carbonflux_inst,c14_soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! Update the nitrogen leaching rate as a function of soluble mineral N and total soil water outflow. + ! Also update nitrogen state variables + ! + ! !USES: + use SoilBiogeochemNLeachingMod, only: SoilBiogeochemNLeaching + use CNNStateUpdate3Mod , only: NStateUpdate3 + use CNVegMatrixMod , only: CNVegMatrix + use CNSoilMatrixMod , only: CNSoilMatrix + use clm_time_manager , only : is_first_step_of_this_run_segment,is_beg_curr_year,is_end_curr_year,get_curr_date + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_actfirec ! number of soil columns on fire in filter + integer , intent(in) :: filter_actfirec(:) ! filter for soil columns on fire + integer , intent(in) :: num_actfirep ! number of soil patches on fire in filter + integer , intent(in) :: filter_actfirep(:) ! filter for soil patches on fire + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + integer p,fp,yr,mon,day,sec + !----------------------------------------------------------------------- + + ! Mineral nitrogen dynamics (deposition, fixation, leaching) + + call t_startf('SoilBiogeochemNLeaching') + call SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & + waterstatebulk_inst, waterfluxbulk_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + call t_stopf('SoilBiogeochemNLeaching') + + ! Nitrogen state variable update, mortality fluxes. + + call t_startf('NUpdate3') + + call NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + + call t_stopf('NUpdate3') + if(use_matrixcn)then + call t_startf('CNVMatrix') + call CNVegMatrix(bounds,num_soilp,filter_soilp(1:num_soilp),num_actfirep,filter_actfirep,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst,& + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst,cnveg_state_inst,soilbiogeochem_nitrogenflux_inst,& + c13_cnveg_carbonstate_inst,c14_cnveg_carbonstate_inst,c13_cnveg_carbonflux_inst,& + c14_cnveg_carbonflux_inst) + call t_stopf('CNVMatrix') + end if + + if(use_soil_matrixcn)then + call t_startf('CNSoilMatrix') + call CNSoilMatrix(bounds,num_soilc, filter_soilc(1:num_soilc), num_actfirec, filter_actfirec, & + cnveg_carbonflux_inst,soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst,soilbiogeochem_state_inst, & + cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst,c13_soilbiogeochem_carbonstate_inst,& + c13_soilbiogeochem_carbonflux_inst,c14_soilbiogeochem_carbonstate_inst,& + c14_soilbiogeochem_carbonflux_inst) + call t_stopf('CNSoilMatrix') + end if + + end subroutine CNDriverLeaching + + !----------------------------------------------------------------------- + subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Call to all CN and SoilBiogeochem summary routines, for state variables + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: begc,endc + + character(len=*), parameter :: subname = 'CNDriverSummarizeStates' + !----------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + + call t_startf('CNsum') + + ! ---------------------------------------------- + ! soilbiogeochem carbon/nitrogen state summary + ! ---------------------------------------------- + + call soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc) + if ( use_c13 ) then + call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc) + end if + if ( use_c14 ) then + call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc) + end if + call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_allc, filter_allc) + + ! ---------------------------------------------- + ! cnveg carbon/nitrogen state summary + ! ---------------------------------------------- + + call cnveg_carbonstate_inst%Summary(bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_cwdc_col=soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & + soilbiogeochem_totlitc_col=soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + soilbiogeochem_totsomc_col=soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + soilbiogeochem_ctrunc_col=soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) + + if ( use_c13 ) then + call c13_cnveg_carbonstate_inst%Summary(bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_cwdc_col=c13_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & + soilbiogeochem_totlitc_col=c13_soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + soilbiogeochem_totsomc_col=c13_soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + soilbiogeochem_ctrunc_col=c13_soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) + end if + + if ( use_c14 ) then + call c14_cnveg_carbonstate_inst%Summary(bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_cwdc_col=c14_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & + soilbiogeochem_totlitc_col=c14_soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + soilbiogeochem_totsomc_col=c14_soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + soilbiogeochem_ctrunc_col=c14_soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) + end if + + call cnveg_nitrogenstate_inst%Summary(bounds, num_allc, filter_allc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_nitrogenstate_inst) + + call t_stopf('CNsum') + + end subroutine CNDriverSummarizeStates + + !----------------------------------------------------------------------- + subroutine CNDriverSummarizeFluxes(bounds, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenflux_inst, & + c_products_inst, c13_products_inst, c14_products_inst, & + soilbiogeochem_carbonflux_inst, & + c13_soilbiogeochem_carbonflux_inst, & + c14_soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Call to all CN and SoilBiogeochem summary routines, for state variables + ! + ! !USES: + use clm_varpar , only: ndecomp_cascade_transitions + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cn_products_type) , intent(in) :: c_products_inst + type(cn_products_type) , intent(in) :: c13_products_inst + type(cn_products_type) , intent(in) :: c14_products_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: begc,endc + integer :: begg,endg + + character(len=*), parameter :: subname = 'CNDriverSummarizeFluxes' + !----------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg = bounds%endg + + call t_startf('CNsum') + + ! ---------------------------------------------- + ! soilbiogeochem carbon/nitrogen flux summary + ! ---------------------------------------------- + + call soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) + if ( use_c13 ) then + call c13_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) + end if + if ( use_c14 ) then + call c14_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) + end if + call soilbiogeochem_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc) + + ! ---------------------------------------------- + ! cnveg carbon/nitrogen flux summary + ! ---------------------------------------------- + + call cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='bulk', & + soilbiogeochem_hr_col=soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_lithr_col=soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + soilbiogeochem_decomp_cascade_ctransfer_col=& + soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & + product_closs_grc=c_products_inst%product_loss_grc(begg:endg)) + + if ( use_c13 ) then + call c13_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='c13', & + soilbiogeochem_hr_col=c13_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_lithr_col=c13_soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + soilbiogeochem_decomp_cascade_ctransfer_col=& + c13_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & + product_closs_grc=c13_products_inst%product_loss_grc(begg:endg)) + end if + + if ( use_c14 ) then + call c14_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='c14', & + soilbiogeochem_hr_col=c14_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_lithr_col=c14_soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + soilbiogeochem_decomp_cascade_ctransfer_col=& + c14_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & + product_closs_grc=c14_products_inst%product_loss_grc(begg:endg)) + end if + + call cnveg_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + + call t_stopf('CNsum') + + end subroutine CNDriverSummarizeFluxes + +end module CNDriverMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate3Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate3Mod.F90 new file mode 100755 index 000000000..c0de9f890 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate3Mod.F90 @@ -0,0 +1,229 @@ +module CNNStateUpdate3Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable update, mortality fluxes. + ! Also, sminn leaching flux. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_varpar , only: nlevdecomp, ndecomp_pools + use clm_time_manager , only : get_step_size_real + use clm_varctl , only : iulog, use_nitrif_denitrif,use_matrixcn,use_soil_matrixcn + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate3 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables affected by gap-phase mortality fluxes. Also the Sminn leaching flux. + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability. + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf_veg => cnveg_nitrogenflux_inst , & ! Input + ns_veg => cnveg_nitrogenstate_inst , & ! Output + nf_soil => soilbiogeochem_nitrogenflux_inst , & ! Input + ns_soil => soilbiogeochem_nitrogenstate_inst & ! Output + ) + + ! set time steps + dt = get_step_size_real() + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_nitrif_denitrif) then + ! mineral N loss due to leaching + ns_soil%sminn_vr_col(c,j) = ns_soil%sminn_vr_col(c,j) - nf_soil%sminn_leached_vr_col(c,j) * dt + else + ! mineral N loss due to leaching and runoff + ns_soil%smin_no3_vr_col(c,j) = max( ns_soil%smin_no3_vr_col(c,j) - & + ( nf_soil%smin_no3_leached_vr_col(c,j) + nf_soil%smin_no3_runoff_vr_col(c,j) ) * dt, 0._r8) + + ns_soil%sminn_vr_col(c,j) = ns_soil%smin_no3_vr_col(c,j) + ns_soil%smin_nh4_vr_col(c,j) + end if + + ! column level nitrogen fluxes from fire + ! patch-level wood to column-level CWD (uncombusted wood) + if (.not. use_soil_matrixcn)then + ns_soil%decomp_npools_vr_col(c,j,i_cwd) = ns_soil%decomp_npools_vr_col(c,j,i_cwd) + & + nf_veg%fire_mortality_n_to_cwdn_col(c,j) * dt + + ! patch-level wood to column-level litter (uncombusted wood) + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) = ns_soil%decomp_npools_vr_col(c,j,i_met_lit) + & + nf_veg%m_n_to_litr_met_fire_col(c,j)* dt + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) = ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) + & + nf_veg%m_n_to_litr_cel_fire_col(c,j)* dt + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) = ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) + & + nf_veg%m_n_to_litr_lig_fire_col(c,j)* dt + else + nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + & + nf_veg%fire_mortality_n_to_cwdn_col(c,j) * dt + + ! patch-level wood to column-level litter (uncombusted wood) + nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + & + nf_veg%m_n_to_litr_met_fire_col(c,j)* dt + nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + & + nf_veg%m_n_to_litr_cel_fire_col(c,j)* dt + nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + & + nf_veg%m_n_to_litr_lig_fire_col(c,j)* dt + end if ! not use_soil_matrix + end do ! end of column loop + end do + + ! litter and CWD losses to fire + if(.not. use_soil_matrixcn)then + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns_soil%decomp_npools_vr_col(c,j,l) = ns_soil%decomp_npools_vr_col(c,j,l) - & + nf_veg%m_decomp_npools_to_fire_vr_col(c,j,l) * dt + end do + end do + end do + end if ! not use_soil_matrixcn + + ! patch-level nitrogen fluxes + + do fp = 1,num_soilp + p = filter_soilp(fp) + + if(.not. use_matrixcn)then + !from fire displayed pools + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - & + nf_veg%m_leafn_to_fire_patch(p) * dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - & + nf_veg%m_frootn_to_fire_patch(p) * dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - & + nf_veg%m_livestemn_to_fire_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) - & + nf_veg%m_deadstemn_to_fire_patch(p) * dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - & + nf_veg%m_livecrootn_to_fire_patch(p) * dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) - & + nf_veg%m_deadcrootn_to_fire_patch(p) * dt + + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - & + nf_veg%m_leafn_to_litter_fire_patch(p) * dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - & + nf_veg%m_frootn_to_litter_fire_patch(p) * dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - & + nf_veg%m_livestemn_to_litter_fire_patch(p) * dt - & + nf_veg%m_livestemn_to_deadstemn_fire_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) - & + nf_veg%m_deadstemn_to_litter_fire_patch(p) * dt + & + nf_veg%m_livestemn_to_deadstemn_fire_patch(p) * dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - & + nf_veg%m_livecrootn_to_litter_fire_patch(p) * dt - & + nf_veg%m_livecrootn_to_deadcrootn_fire_patch(p) * dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) - & + nf_veg%m_deadcrootn_to_litter_fire_patch(p) * dt + & + nf_veg%m_livecrootn_to_deadcrootn_fire_patch(p) * dt + + ! storage pools + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) - & + nf_veg%m_leafn_storage_to_fire_patch(p) * dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) - & + nf_veg%m_frootn_storage_to_fire_patch(p) * dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) - & + nf_veg%m_livestemn_storage_to_fire_patch(p) * dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) - & + nf_veg%m_deadstemn_storage_to_fire_patch(p) * dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) - & + nf_veg%m_livecrootn_storage_to_fire_patch(p) * dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) - & + nf_veg%m_deadcrootn_storage_to_fire_patch(p) * dt + + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) - & + nf_veg%m_leafn_storage_to_litter_fire_patch(p) * dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) - & + nf_veg%m_frootn_storage_to_litter_fire_patch(p) * dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) - & + nf_veg%m_livestemn_storage_to_litter_fire_patch(p) * dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) - & + nf_veg%m_deadstemn_storage_to_litter_fire_patch(p) * dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) - & + nf_veg%m_livecrootn_storage_to_litter_fire_patch(p) * dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) - & + nf_veg%m_deadcrootn_storage_to_litter_fire_patch(p) * dt + + + ! transfer pools + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) - & + nf_veg%m_leafn_xfer_to_fire_patch(p) * dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) - & + nf_veg%m_frootn_xfer_to_fire_patch(p) * dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) - & + nf_veg%m_livestemn_xfer_to_fire_patch(p) * dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) - & + nf_veg%m_deadstemn_xfer_to_fire_patch(p) * dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) - & + nf_veg%m_livecrootn_xfer_to_fire_patch(p) * dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) - & + nf_veg%m_deadcrootn_xfer_to_fire_patch(p) * dt + + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) - & + nf_veg%m_leafn_xfer_to_litter_fire_patch(p) * dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) - & + nf_veg%m_frootn_xfer_to_litter_fire_patch(p) * dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) - & + nf_veg%m_livestemn_xfer_to_litter_fire_patch(p) * dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) - & + nf_veg%m_deadstemn_xfer_to_litter_fire_patch(p) * dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) - & + nf_veg%m_livecrootn_xfer_to_litter_fire_patch(p) * dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) - & + nf_veg%m_deadcrootn_xfer_to_litter_fire_patch(p) * dt + + ! retranslocated N pool + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) - & + nf_veg%m_retransn_to_fire_patch(p) * dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) - & + nf_veg%m_retransn_to_litter_fire_patch(p) * dt + else + ! NOTE: The equivalent changes for matrix code are in CNFireBase and CNFireLi2014 codes EBK (11/26/2019) + end if !.not. use_matrixcn + end do + + end associate + + end subroutine NStateUpdate3 + +end module CNNStateUpdate3Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 9b701efb9..12046a037 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -1141,7 +1141,6 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & ! Should only be called if use_cn is true ! ! !USES: - use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause ! ! !ARGUMENTS: class(cn_vegetation_type) , intent(inout) :: this @@ -1153,17 +1152,10 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & type(atm2lnd_type) , intent(in) :: atm2lnd_inst ! ! !LOCAL VARIABLES: - integer :: DA_nstep ! time step number character(len=*), parameter :: subname = 'BalanceCheck' !----------------------------------------------------------------------- - DA_nstep = get_nstep_since_startup_or_lastDA_restart_or_pause() - if (DA_nstep <= skip_steps )then - if (masterproc) then - write(iulog,*) '--WARNING-- skipping CN balance check for first timesteps after startup or data assimilation' - end if - else call this%cn_balance_inst%CBalanceCheck( & bounds, num_soilc, filter_soilc, & @@ -1180,8 +1172,6 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & this%n_products_inst, & atm2lnd_inst) - end if - end subroutine BalanceCheck !----------------------------------------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 deleted file mode 100644 index a7c3a56d6..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_DriverMod.F90 +++ /dev/null @@ -1,162 +0,0 @@ -module CN_DriverMod - - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use nanMod , only : nan - use CNVegetationFacade - use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_zon, CN_zone_weight - use clm_varcon , only : grav, denh2o - - -contains - -!--------------------------------- - subroutine CN_Driver(nch,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& - rzm,sfm,tm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& - abm,peatf,hdm,lnfm,poros,rh30) - - use CNCLM_decompMod, only : bounds - use CNCLM_filterMod, only : filter - use CNCLM_SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type - use CNCLM_SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type - use CNCLM_ActiveLayerMod - use CNCLM_GridcellType - use FireMethodType , only : fire_method_type - use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type - use CNCLM_WaterDiagnosticBulkType, only : waterdiagnosticbulk_type - use CNCLM_atm2lndType , only : atm2lnd_type - use Wateratm2lndBulkType , only : wateratm2lndbulk_type - use CNCLM_CNVegStateType , only : cnveg_state_type - - !ARGUMENTS - implicit none - - !INPUT - integer, intent(in) :: nch ! number of tiles - real, dimension(nch), intent(in) :: ndep ! nitrogen deposition [g m^-2 s^-1] - real, dimension(nch), intent(in) :: tp1 ! soil temperatures [K] - real, dimension(nch), intent(in) :: tairm ! surface air temperature [K] averaged over CN interval - real, dimension(nch), intent(in) :: bee ! Clapp-Hornberger 'b' [-] - real, dimension(nch), intent(in) :: psis ! saturated matric potential [m] - real, dimension(nch), intent(in) :: dayl ! daylength [seconds] - real, dimension(nch,num_zon), intent(in) :: btran_fire - real, dimension(nch), intent(in) :: car1m ! fraction of tile that is saturated area - real, dimension(nch,num_zon), intent(in) :: rzm ! weighted root-zone moisture content as frac of WHC - real, dimension(nch,num_zon), intent(in) :: sfm ! weighted surface moisture content as frac of WHC - real, dimension(nch), intent(in) :: tm ! air temperature (K) - real, dimension(nch), intent(in) :: rhm ! relative humidity (%) - real, dimension(nch), intent(in) :: windm ! wind speed (m/s) - real, dimension(nch), intent(in) :: rainfm ! rainfall (convective + largescale) (kg/m2/s) - real, dimension(nch), intent(in) :: snowfm ! snowfall (kg/m2/s) - real, dimension(nch), intent(in) :: prec10d ! 10-day running mean of total precipitation (mm H2O/s) - real, dimension(nch), intent(in) :: prec60d ! 60-day running mean of total precipitation (mm H2O/s) - real, dimension(nch), intent(in) :: gdp ! Real GDP (K 1995US$/capita) - real, dimension(nch), intent(in) :: abm ! Peak month for agricultural fire, unitless - real, dimension(nch), intent(in) :: peatf ! Fraction of peatland, unitless (0-1) - real, dimension(nch), intent(in) :: hdm ! Human population density in 2010 (individual/km2) - real, dimension(nch), intent(in) :: lnfm ! Lightning frequency [Flashes/km^2/day] - real, dimension(nch), intent(in) :: poros ! porosity - real, dimension(nch), intent(in) :: rh30 ! 30-day running mean of relative humidity - - !LOCAL - - ! jkolassa: not sure the below type declarations are necessary or whether use statements - ! above are enough - - type(bounds_type) :: bounds - type(clumpfilter_type) :: filter - type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst - type(gridcell_type) :: grc - type(cn_vegetation_type), public :: bgc_vegetation_inst - type(fire_method_type) :: cnfire_method - type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst - - logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions - integer :: n, p, nc, nz, np - - !------------------------------- - - ! update CLM types with current states - - n = 0 - p = 0 - do nc = 1,nch ! catchment tile loop - - grc%dayl(nc) = dayl(nc) - wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) - atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - cnfire_method%forc_hdm(nc) = hdm(nc) - cnfire_method%forc_lnfm(nc) = lnfm(nc) - - do nz = 1,num_zon ! CN zone loop - n = n + 1 - - temperature_inst%t_soisno_col(n,-nlevsno+1:nlevmaxurbgrnd) = tp1(nc) ! jkolassa: only one soil and no snow column at this point (may change in future) - temperature_inst%t_grnd_col(n) = temperature_inst%t_soisno_col(n) - temperature_inst%t_soi17cm_col(n) = temperature_inst%t_grnd_col(n) - soilstate_inst%soilpsi_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point - soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd) = poros(nc) - atm2lnd_inst%forc_t_downscaled_col(n) = tm(nc) - wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) - wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) - waterdiagnosticbulk_inst%wf_col(n) = sfm(nc,nz) - waterdiagnosticbulk_inst%wf2_col(n) = rzm(nc,nz) - cnveg_state_inst%gdp_lf_col(n) = gdp(nc) - cnveg_state_inst%abm_lf_col(n) = abm(nc) - cnveg_state_inst%peatf_lf_col(n) = peatf(nc) - - ! compute column-level saturated area fraction (water table at surface) - if(nz==1) then - saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,car1m(nc)/CN_zone_weight(nz)),1.) - elseif(nz==2) then - saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,(car1m(nc)-CN_zone_weight(1))/CN_zone_weight(nz)),1.) - elseif(nz==3) - saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,(car1m(nc)-CN_zone_weight(1)-CN_zone_weight(2))/CN_zone_weight(nz)),1.) - endif - - do np = 0,numpft ! PFT index loop - p = p + 1 - temperature_inst%t_ref2m_patch(p) = tairm(nc) - cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 - wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) - wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) - wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) - end do ! np - end do ! nz - end do ! nc - - ! call CLM routines that are needed prior to Ecosystem Dynamics call - - call active_layer_inst%alt_calc(num_soilc, filter_soilc, & - temperature_inst) - - - ! Ecosystem Dynamics calculations - call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds, & - filter%num_soilc, filter%soilc, & - filter%num_soilp, filter%soilp, & - filter%num_actfirec, filter%actfirec, & - filter%num_actfirep, filter%actfirep, & - filter%num_pcropp, filter%pcropp, & - filter%num_exposedvegp, filter%exposedvegp, & - filter%num_noexposedvegp, filter%noexposedvegp, & - doalb, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - soilbiogeochem_state_inst, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - active_layer_inst, & - atm2lnd_inst, water_inst%waterstatebulk_inst, & - water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & - water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & - soil_water_retention_curve, crop_inst, ch4_inst, & - photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & - nutrient_competition_method, fireemis_inst) - - - - grc%prev_dayl = grc%dayl ! set previous day length for following time steps (dayl itself is computed in GridComp) - end subroutine CN_Driver - -end module CN_DriverMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index f6e249181..e4260a4bd 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -16,7 +16,6 @@ module CN_initMod use CNCLM_SolarAbsorbedType use CNCLM_SurfaceAlbedoType use CNCLM_OzoneBaseMod - use CNCLM_PhotosynsType use CNCLM_pftconMod use CNCLM_WaterFluxType use CNCLM_SoilBiogeochemCarbonStateType @@ -50,6 +49,7 @@ module CN_initMod use SaturatedExcessRunoffMod use WaterStateBulkType use WaterStateType + use FrictionVelocityMod use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn @@ -62,6 +62,7 @@ module CN_initMod use dynSubgridControlMod , only : dynSubgridControl_init use CNFireFactoryMod , only : CNFireReadNML, create_cnfire_method use FireMethodType , only : fire_method_type + use SoilBiogeochemNLeachingMod , only : readSoilBiogeochemNLeachingParams => readParams use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -128,6 +129,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(energyflux_type) :: energyflux_inst type(waterstatebulk_type) :: waterstatebulk_inst type(waterstate_type) :: waterstate_inst + type(frictionvel_type) :: frictionvel_inst character(300) :: paramfile @@ -176,9 +178,9 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) ! initialize states and fluxes - call init_cnveg_nitrogenstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenstate_inst, cn5_cold_start) + call init_cnveg_nitrogenstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenstate_inst) - call init_cnveg_carbonstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonstate_inst, cn5_cold_start) + call init_cnveg_carbonstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonstate_inst) call init_atm2lnd_type (bounds, atm2lnd_inst) @@ -200,7 +202,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_ozone_base_type (bounds, ozone_inst) - call init_photosyns_type (bounds, nch, ityp, fveg, cncol, cnpft, photosyns_inst, cn5_cold_start) + call photosyns_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, photosyns_inst, cn5_cold_start) call init_pftcon_type (pftcon) @@ -218,7 +220,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_cnveg_state_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_state_inst) - call init_cnveg_carbonflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonflux_inst) + call init_cnveg_carbonflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonflux_inst, cn5_cold_start) call init_cnveg_nitrogenflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenflux_inst) @@ -246,6 +248,12 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_waterstate_type (bounds, waterstate_inst) + call init_frictionvel_type (bounds, frictionvel_inst) + + call CNPhenologyInit (bounds) + + call bgc_vegetation_inst%cn_balance_inst%Init (bounds) + call create_cnfire_method(cnfire_method) call cnfire_method%FireInit(bounds) @@ -284,6 +292,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call readSoilBiogeochemLittVertTranspParams(ncid) call photosyns_inst%ReadParams( ncid ) call cnfire_method%CNFireReadParams( ncid ) + call readSoilBiogeochemNLeachingParams(ncid) call ncid%close(rc=status) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 297de73d0..fe1d03f5d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -17,11 +17,10 @@ module PhotosynthesisMod use clm_varctl , only : use_c13, use_c14, use_cn, use_cndv, use_fates, use_luna, use_hydrstress use clm_varctl , only : iulog use clm_varpar , only : nlevcan, nvegwcs, mxpft - use clm_varcon , only : namep, c14ratio, spval, isecspday + use clm_varcon , only : namep, spval, isecspday use decompMod , only : bounds_type use QuadraticMod , only : quadratic use CNCLM_pftconMod , only : pftcon - use CIsoAtmTimeseriesMod, only : C14BombSpike, use_c14_bombspike, C13TimeSeries, use_c13_timeseries, nsectors_c14 use atm2lndType , only : atm2lnd_type use CanopyStateType , only : canopystate_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type @@ -39,9 +38,7 @@ module PhotosynthesisMod private ! ! !PUBLIC MEMBER FUNCTIONS: - public :: Photosynthesis ! Leaf stomatal resistance and leaf photosynthesis public :: PhotosynthesisTotal ! Determine of total photosynthesis - public :: Fractionation ! C13 fractionation during photosynthesis ! For plant hydraulics approach public :: PhotosynthesisHydraulicStress ! Leaf stomatal resistance and leaf photosynthesis ! Simultaneous solution of sunlit/shaded per Pierre @@ -220,16 +217,7 @@ module PhotosynthesisMod ! Public procedures procedure, public :: Init - procedure, public :: Restart - procedure, public :: ReadNML procedure, public :: ReadParams - procedure, public :: TimeStepInit - procedure, public :: NewPatchInit - - ! Private procedures - procedure, private :: InitAllocate - procedure, private :: InitHistory - procedure, private :: InitCold end type photosyns_type @@ -240,32 +228,41 @@ module PhotosynthesisMod contains !------------------------------------------------------------------------ - subroutine Init(this, bounds) - - class(photosyns_type) :: this - type(bounds_type), intent(in) :: bounds - - call this%InitAllocate (bounds) - call this%InitHistory (bounds) - call this%InitCold (bounds) - - end subroutine Init - - !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds) + subroutine Init(bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,this) ! ! !ARGUMENTS: - class(photosyns_type) :: this type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction + real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array + real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array + logical, optional, intent(in) :: cn5_cold_start + class(photosyns_type) :: this + ! ! !LOCAL VARIABLES: integer :: begp, endp integer :: begc, endc + integer :: np, nc, nz, p, nv + logical :: cold_start = .false. !------------------------------------------------------------------------ begp = bounds%begp; endp= bounds%endp begc = bounds%begc; endc= bounds%endc + ! check whether a cn5_cold_start option was set and change cold_start accordingly + if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + cold_start = .true. + end if + + ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + (size(cnpft,3).ne.var_pft))) + _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') + end if + + allocate(this%c3flag_patch (begp:endp)) ; this%c3flag_patch (:) =.false. allocate(this%ac_phs_patch (begp:endp,2,1:nlevcan)) ; this%ac_phs_patch (:,:,:) = nan allocate(this%aj_phs_patch (begp:endp,2,1:nlevcan)) ; this%aj_phs_patch (:,:,:) = nan @@ -357,279 +354,39 @@ subroutine InitAllocate(this, bounds) allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 endif - end subroutine InitAllocate - - !----------------------------------------------------------------------- - subroutine InitHistory(this, bounds) - ! - ! !USES: - use histFileMod , only: hist_addfld1d, hist_addfld2d - ! - ! !ARGUMENTS: - class(photosyns_type) :: this - type(bounds_type), intent(in) :: bounds - real(r8), pointer :: ptr_1d(:) ! pointer to 1d patch array - ! - ! !LOCAL VARIABLES: - integer :: begp, endp - !--------------------------------------------------------------------- - - begp = bounds%begp; endp= bounds%endp - - this%rh_leaf_patch(begp:endp) = spval - call hist_addfld1d (fname='RH_LEAF', units='fraction', & - avgflag='A', long_name='fractional humidity at leaf surface', & - ptr_patch=this%rh_leaf_patch, set_spec=spval, default='inactive') - - this%vpd_can_patch(begp:endp) = spval - call hist_addfld1d (fname='VPD_CAN', units='kPa', & - avgflag='A', long_name='canopy vapor pressure deficit', & - ptr_patch=this%vpd_can_patch, set_spec=spval, default='active') - - - - this%lnca_patch(begp:endp) = spval - call hist_addfld1d (fname='LNC', units='gN leaf/m^2', & - avgflag='A', long_name='leaf N concentration', & - ptr_patch=this%lnca_patch, set_spec=spval) - - ! Don't output photosynthesis variables when FATES is on as they aren't calculated - if (.not. use_fates) then - this%fpsn_patch(begp:endp) = spval - call hist_addfld1d (fname='FPSN', units='umol m-2 s-1', & - avgflag='A', long_name='photosynthesis', & - ptr_patch=this%fpsn_patch, set_lake=0._r8, set_urb=0._r8) - - ! Don't by default output this rate limiting step as only makes sense if you are outputing - ! the others each time-step - this%fpsn_wc_patch(begp:endp) = spval - call hist_addfld1d (fname='FPSN_WC', units='umol m-2 s-1', & - avgflag='I', long_name='Rubisco-limited photosynthesis', & - ptr_patch=this%fpsn_wc_patch, set_lake=0._r8, set_urb=0._r8, & - default='inactive') - - ! Don't by default output this rate limiting step as only makes sense if you are outputing - ! the others each time-step - this%fpsn_wj_patch(begp:endp) = spval - call hist_addfld1d (fname='FPSN_WJ', units='umol m-2 s-1', & - avgflag='I', long_name='RuBP-limited photosynthesis', & - ptr_patch=this%fpsn_wj_patch, set_lake=0._r8, set_urb=0._r8, & - default='inactive') - - ! Don't by default output this rate limiting step as only makes sense if you are outputing - ! the others each time-step - this%fpsn_wp_patch(begp:endp) = spval - call hist_addfld1d (fname='FPSN_WP', units='umol m-2 s-1', & - avgflag='I', long_name='Product-limited photosynthesis', & - ptr_patch=this%fpsn_wp_patch, set_lake=0._r8, set_urb=0._r8, & - default='inactive') - end if - - if (use_cn) then - this%psnsun_patch(begp:endp) = spval - call hist_addfld1d (fname='PSNSUN', units='umolCO2/m^2/s', & - avgflag='A', long_name='sunlit leaf photosynthesis', & - ptr_patch=this%psnsun_patch) - - this%psnsha_patch(begp:endp) = spval - call hist_addfld1d (fname='PSNSHA', units='umolCO2/m^2/s', & - avgflag='A', long_name='shaded leaf photosynthesis', & - ptr_patch=this%psnsha_patch) - end if - - if ( use_c13 ) then - this%c13_psnsun_patch(begp:endp) = spval - call hist_addfld1d (fname='C13_PSNSUN', units='umolCO2/m^2/s', & - avgflag='A', long_name='C13 sunlit leaf photosynthesis', & - ptr_patch=this%c13_psnsun_patch, default='inactive') - - this%c13_psnsha_patch(begp:endp) = spval - call hist_addfld1d (fname='C13_PSNSHA', units='umolCO2/m^2/s', & - avgflag='A', long_name='C13 shaded leaf photosynthesis', & - ptr_patch=this%c13_psnsha_patch, default='inactive') - end if - - if ( use_c14 ) then - this%c14_psnsun_patch(begp:endp) = spval - call hist_addfld1d (fname='C14_PSNSUN', units='umolCO2/m^2/s', & - avgflag='A', long_name='C14 sunlit leaf photosynthesis', & - ptr_patch=this%c14_psnsun_patch, default='inactive') - - this%c14_psnsha_patch(begp:endp) = spval - call hist_addfld1d (fname='C14_PSNSHA', units='umolCO2/m^2/s', & - avgflag='A', long_name='C14 shaded leaf photosynthesis', & - ptr_patch=this%c14_psnsha_patch, default='inactive') - end if - - if ( use_c13 ) then - this%rc13_canair_patch(begp:endp) = spval - call hist_addfld1d (fname='RC13_CANAIR', units='proportion', & - avgflag='A', long_name='C13/C(12+13) for canopy air', & - ptr_patch=this%rc13_canair_patch, default='inactive') - - this%rc13_psnsun_patch(begp:endp) = spval - call hist_addfld1d (fname='RC13_PSNSUN', units='proportion', & - avgflag='A', long_name='C13/C(12+13) for sunlit photosynthesis', & - ptr_patch=this%rc13_psnsun_patch, default='inactive') - - this%rc13_psnsha_patch(begp:endp) = spval - call hist_addfld1d (fname='RC13_PSNSHA', units='proportion', & - avgflag='A', long_name='C13/C(12+13) for shaded photosynthesis', & - ptr_patch=this%rc13_psnsha_patch, default='inactive') - endif - - ! Canopy physiology - - if ( use_c13 ) then - this%alphapsnsun_patch(begp:endp) = spval - call hist_addfld1d (fname='ALPHAPSNSUN', units='proportion', & - avgflag='A', long_name='sunlit c13 fractionation', & - ptr_patch=this%alphapsnsun_patch, default='inactive') - - this%alphapsnsha_patch(begp:endp) = spval - call hist_addfld1d (fname='ALPHAPSNSHA', units='proportion', & - avgflag='A', long_name='shaded c13 fractionation', & - ptr_patch=this%alphapsnsha_patch, default='inactive') - endif - - this%rssun_patch(begp:endp) = spval - call hist_addfld1d (fname='RSSUN', units='s/m', & - avgflag='M', long_name='sunlit leaf stomatal resistance', & - ptr_patch=this%rssun_patch, l2g_scale_type='veg') - - this%rssha_patch(begp:endp) = spval - call hist_addfld1d (fname='RSSHA', units='s/m', & - avgflag='M', long_name='shaded leaf stomatal resistance', & - ptr_patch=this%rssha_patch, l2g_scale_type='veg') - - this%gs_mol_sun_patch(begp:endp,:) = spval - this%gs_mol_sha_patch(begp:endp,:) = spval - if (nlevcan>1) then - call hist_addfld2d (fname='GSSUN', units='umol H20/m2/s', type2d='nlevcan', & - avgflag='A', long_name='sunlit leaf stomatal conductance', & - ptr_patch=this%gs_mol_sun_patch, set_lake=spval, set_urb=spval) - - call hist_addfld2d (fname='GSSHA', units='umol H20/m2/s', type2d='nlevcan', & - avgflag='A', long_name='shaded leaf stomatal conductance', & - ptr_patch=this%gs_mol_sha_patch, set_lake=spval, set_urb=spval) - else - ptr_1d => this%gs_mol_sun_patch(begp:endp,1) - call hist_addfld1d (fname='GSSUN', units='umol H20/m2/s', & - avgflag='A', long_name='sunlit leaf stomatal conductance', & - ptr_patch=ptr_1d) - - ptr_1d => this%gs_mol_sha_patch(begp:endp,1) - call hist_addfld1d (fname='GSSHA', units='umol H20/m2/s', & - avgflag='A', long_name='shaded leaf stomatal conductance', & - ptr_patch=ptr_1d) - - endif - this%gs_mol_sun_ln_patch(begp:endp,:) = spval - this%gs_mol_sha_ln_patch(begp:endp,:) = spval - if (nlevcan>1) then - call hist_addfld2d (fname='GSSUNLN', units='umol H20/m2/s', type2d='nlevcan', & - avgflag='A', long_name='sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & - ptr_patch=this%gs_mol_sun_ln_patch, set_lake=spval, set_urb=spval) - - call hist_addfld2d (fname='GSSHALN', units='umol H20/m2/s', type2d='nlevcan', & - avgflag='A', long_name='shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & - ptr_patch=this%gs_mol_sha_ln_patch, set_lake=spval, set_urb=spval) - else - ptr_1d => this%gs_mol_sun_ln_patch(begp:endp,1) - call hist_addfld1d (fname='GSSUNLN', units='umol H20/m2/s', & - avgflag='A', long_name='sunlit leaf stomatal conductance at local noon', & - ptr_patch=ptr_1d) - - ptr_1d => this%gs_mol_sha_ln_patch(begp:endp,1) - call hist_addfld1d (fname='GSSHALN', units='umol H20/m2/s', & - avgflag='A', long_name='shaded leaf stomatal conductance at local noon', & - ptr_patch=ptr_1d) - - endif - if(use_luna)then - if(nlevcan>1)then - call hist_addfld2d (fname='Vcmx25Z', units='umol/m2/s', type2d='nlevcan', & - avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', & - ptr_patch=this%vcmx25_z_patch) - - call hist_addfld2d (fname='Jmx25Z', units='umol electrons/m2/s', type2d='nlevcan', & - avgflag='A', long_name='maximum rate of electron transport at 25 Celcius for canopy layers', & - ptr_patch=this%jmx25_z_patch) - - call hist_addfld2d (fname='PNLCZ', units='unitless', type2d='nlevcan', & - avgflag='A', long_name='Proportion of nitrogen allocated for light capture', & - ptr_patch=this%pnlc_z_patch,default='inactive') - else - ptr_1d => this%vcmx25_z_patch(:,1) - call hist_addfld1d (fname='Vcmx25Z', units='umol/m2/s',& - avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', & - ptr_patch=ptr_1d) - ptr_1d => this%jmx25_z_patch(:,1) - call hist_addfld1d (fname='Jmx25Z', units='umol electrons/m2/s',& - avgflag='A', long_name='maximum rate of electron transport at 25 Celcius for canopy layers', & - ptr_patch=ptr_1d) - ptr_1d => this%pnlc_z_patch(:,1) - call hist_addfld1d (fname='PNLCZ', units='unitless', & - avgflag='A', long_name='Proportion of nitrogen allocated for light capture', & - ptr_patch=ptr_1d,default='inactive') - - this%luvcmax25top_patch(begp:endp) = spval - call hist_addfld1d (fname='VCMX25T', units='umol/m2/s', & - avgflag='M', long_name='canopy profile of vcmax25', & - ptr_patch=this%luvcmax25top_patch, set_lake=spval, set_urb=spval) - - this%lujmax25top_patch(begp:endp) = spval - call hist_addfld1d (fname='JMX25T', units='umol/m2/s', & - avgflag='M', long_name='canopy profile of jmax', & - ptr_patch=this%lujmax25top_patch, set_lake=spval, set_urb=spval) - - this%lutpu25top_patch(begp:endp) = spval - call hist_addfld1d (fname='TPU25T', units='umol/m2/s', & - avgflag='M', long_name='canopy profile of tpu', & - ptr_patch=this%lutpu25top_patch, set_lake=spval, set_urb=spval) + this%rootstem_acc = .false. ! jkolassa, Jun 2022: Default for CTSM5.1 - endif - this%fpsn24_patch = spval - call hist_addfld1d (fname='FPSN24', units='umol CO2/m^2 ground/day',& - avgflag='A', long_name='24 hour accumulative patch photosynthesis starting from mid-night', & - ptr_patch=this%fpsn24_patch, default='inactive') - - endif + this%light_inhibit = .true. ! jkolassa, Feb 2022: This is the default value for CTSM5.1; we could in the future control this through resource files - end subroutine InitHistory + this%leafresp_method = 2 ! jkolassa, Feb 2022: Default for CTSM5.1 if use_cn is true (2 corresponds to Atkin et al., 2015) - !----------------------------------------------------------------------- - subroutine InitCold(this, bounds) - ! - ! !ARGUMENTS: - class(photosyns_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: p,l ! indices - !----------------------------------------------------------------------- + this%stomatalcond_mtd = 2 ! jkolassa, Feb 2022: Default for CTSM5.1, corresponds to Medlyn et al., 2011 - do p = bounds%begp,bounds%endp - l = patch%landunit(p) + this%modifyphoto_and_lmr_forcrop = .true. ! jkolassa, Feb 2022: Default for CLM50 and up - this%alphapsnsun_patch(p) = spval - this%alphapsnsha_patch(p) = spval + ! initialize types from restart file or through cold start values - if (lun%ifspecial(l)) then - this%psnsun_patch(p) = 0._r8 - this%psnsha_patch(p) = 0._r8 - if ( use_c13 ) then - this%c13_psnsun_patch(p) = 0._r8 - this%c13_psnsha_patch(p) = 0._r8 - endif - if ( use_c14 ) then - this%c14_psnsun_patch(p) = 0._r8 - this%c14_psnsha_patch(p) = 0._r8 - endif - end if - end do + np = 0 + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop + do p = 0,numpft ! PFT index loop + np = np + 1 + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + if (cold_start) then + photosyns_inst%alphapsnsun_patch(np) = 0._r8 + photosyns_inst%alphapsnsha_patch(np) = 0._r8 + else (cold_start=.false.) then + photosyns_inst%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 76) + photosyns_inst%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 77) + end if + end if ! ityp =p + end do !nv + end do ! p + end do ! nz + end do ! nc - end subroutine InitCold + end subroutine Init !----------------------------------------------------------------------- subroutine allocParams ( this ) @@ -1015,1035 +772,71 @@ subroutine TimeStepInit (this, bounds) end subroutine TimeStepInit !------------------------------------------------------------------------------ - subroutine NewPatchInit (this, p) - ! - ! For new run-time pft, modify state and flux variables to maintain - ! carbon and nitrogen balance with dynamic pft-weights. - ! Called from dyn_cnbal_patch - ! - ! !ARGUMENTS: - class(photosyns_type) :: this - integer, intent(in) :: p - !----------------------------------------------------------------------- - - if ( use_c13 ) then - this%alphapsnsun_patch(p) = 0._r8 - this%alphapsnsha_patch(p) = 0._r8 - this%rc13_canair_patch(p) = 0._r8 - this%rc13_psnsun_patch(p) = 0._r8 - this%rc13_psnsha_patch(p) = 0._r8 - endif - - this%psnsun_patch(p) = 0._r8 - this%psnsha_patch(p) = 0._r8 - - if (use_c13) then - this%c13_psnsun_patch(p) = 0._r8 - this%c13_psnsha_patch(p) = 0._r8 - end if - if ( use_c14 ) then - this%c14_psnsun_patch(p) = 0._r8 - this%c14_psnsha_patch(p) = 0._r8 - end if - - end subroutine NewPatchInit !------------------------------------------------------------------------------ - !------------------------------------------------------------------------------ - subroutine Photosynthesis ( bounds, fn, filterp, & - esat_tv, eair, oair, cair, rb, btran, & - dayl_factor, leafn, & - atm2lnd_inst, temperature_inst, surfalb_inst, solarabs_inst, & - canopystate_inst, ozone_inst, photosyns_inst, phase) - ! - ! !DESCRIPTION: - ! Leaf photosynthesis and stomatal conductance calculation as described by - ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to - ! a multi-layer canopy + subroutine PhotosynthesisTotal (fn, filterp, & + atm2lnd_inst, canopystate_inst, photosyns_inst) ! - ! !USES: - use clm_varcon , only : rgas, tfrz, spval - use GridcellType , only : grc - use clm_time_manager , only : get_step_size_real, is_near_local_noon - use clm_varctl , only : cnallocate_carbon_only - use clm_varctl , only : lnc_opt, reduce_dayl_factor, vcmax_opt - use pftconMod , only : nbrdlf_dcd_tmp_shrub, npcropmin - + ! Determine total photosynthesis ! ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds integer , intent(in) :: fn ! size of pft filter integer , intent(in) :: filterp(fn) ! patch filter - real(r8) , intent(in) :: esat_tv( bounds%begp: ) ! saturation vapor pressure at t_veg (Pa) [pft] - real(r8) , intent(in) :: eair( bounds%begp: ) ! vapor pressure of canopy air (Pa) [pft] - real(r8) , intent(in) :: oair( bounds%begp: ) ! Atmospheric O2 partial pressure (Pa) [pft] - real(r8) , intent(in) :: cair( bounds%begp: ) ! Atmospheric CO2 partial pressure (Pa) [pft] - real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) [pft] - real(r8) , intent(in) :: btran( bounds%begp: ) ! transpiration wetness factor (0 to 1) [pft] - real(r8) , intent(in) :: dayl_factor( bounds%begp: ) ! scalar (0-1) for daylength - real(r8) , intent(in) :: leafn( bounds%begp: ) ! leaf N (gN/m2) type(atm2lnd_type) , intent(in) :: atm2lnd_inst - type(temperature_type) , intent(in) :: temperature_inst - type(surfalb_type) , intent(in) :: surfalb_inst - type(solarabs_type) , intent(in) :: solarabs_inst type(canopystate_type) , intent(in) :: canopystate_inst - class(ozone_base_type) , intent(in) :: ozone_inst type(photosyns_type) , intent(inout) :: photosyns_inst - character(len=*) , intent(in) :: phase ! 'sun' or 'sha' - ! ! !LOCAL VARIABLES: - ! - ! Leaf photosynthesis parameters - real(r8) :: jmax_z(bounds%begp:bounds%endp,nlevcan) ! maximum electron transport rate (umol electrons/m**2/s) - !real(r8) :: lnc(bounds%begp:bounds%endp) ! leaf N concentration (gN leaf/m^2) - real(r8) :: bbbopt(bounds%begp:bounds%endp)! Ball-Berry minimum leaf conductance, unstressed (umol H2O/m**2/s) - real(r8) :: kn(bounds%begp:bounds%endp) ! leaf nitrogen decay coefficient - real(r8) :: vcmax25top ! canopy top: maximum rate of carboxylation at 25C (umol CO2/m**2/s) - real(r8) :: jmax25top ! canopy top: maximum electron transport rate at 25C (umol electrons/m**2/s) - real(r8) :: tpu25top ! canopy top: triose phosphate utilization rate at 25C (umol CO2/m**2/s) - real(r8) :: lmr25top ! canopy top: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) - real(r8) :: kp25top ! canopy top: initial slope of CO2 response curve (C4 plants) at 25C - - real(r8) :: vcmax25 ! leaf layer: maximum rate of carboxylation at 25C (umol CO2/m**2/s) - real(r8) :: jmax25 ! leaf layer: maximum electron transport rate at 25C (umol electrons/m**2/s) - real(r8) :: tpu25 ! leaf layer: triose phosphate utilization rate at 25C (umol CO2/m**2/s) - real(r8) :: lmr25 ! leaf layer: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) - real(r8) :: kp25 ! leaf layer: Initial slope of CO2 response curve (C4 plants) at 25C - real(r8) :: kc25 ! Michaelis-Menten constant for CO2 at 25C (Pa) - real(r8) :: ko25 ! Michaelis-Menten constant for O2 at 25C (Pa) - real(r8) :: cp25 ! CO2 compensation point at 25C (Pa) - - real(r8) :: vcmaxse ! entropy term for vcmax (J/mol/K) - real(r8) :: jmaxse ! entropy term for jmax (J/mol/K) - real(r8) :: tpuse ! entropy term for tpu (J/mol/K) - - real(r8) :: vcmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) - real(r8) :: jmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) - real(r8) :: tpuc ! scaling factor for high temperature inhibition (25 C = 1.0) - real(r8) :: lmrc ! scaling factor for high temperature inhibition (25 C = 1.0) - - ! Other - integer :: f,p,c,iv ! indices - real(r8) :: cf ! s m**2/umol -> s/m - real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] - real(r8) :: gb ! leaf boundary layer conductance (m/s) - real(r8) :: cs ! CO2 partial pressure at leaf surface (Pa) - real(r8) :: gs ! leaf stomatal conductance (m/s) - real(r8) :: hs ! fractional humidity at leaf surface (dimensionless) - real(r8) :: sco ! relative specificity of rubisco - real(r8) :: ft ! photosynthesis temperature response (statement function) - real(r8) :: fth ! photosynthesis temperature inhibition (statement function) - real(r8) :: fth25 ! ccaling factor for photosynthesis temperature inhibition (statement function) - real(r8) :: tl ! leaf temperature in photosynthesis temperature function (K) - real(r8) :: ha ! activation energy in photosynthesis temperature function (J/mol) - real(r8) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) - real(r8) :: se ! entropy term in photosynthesis temperature function (J/mol/K) - real(r8) :: scaleFactor ! scaling factor for high temperature inhibition (25 C = 1.0) - real(r8) :: ciold ! previous value of Ci for convergence check - real(r8) :: gs_mol_err ! gs_mol for error check - real(r8) :: je ! electron transport rate (umol electrons/m**2/s) - real(r8) :: qabs ! PAR absorbed by PS II (umol photons/m**2/s) - real(r8) :: aquad,bquad,cquad ! terms for quadratic equations - real(r8) :: r1,r2 ! roots of quadratic equation - real(r8) :: ceair ! vapor pressure of air, constrained (Pa) - integer :: niter ! iteration loop index - real(r8) :: nscaler ! leaf nitrogen scaling coefficient - - real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) - - real(r8) :: psn_wc_z(bounds%begp:bounds%endp,nlevcan) ! Rubisco-limited contribution to psn_z (umol CO2/m**2/s) - real(r8) :: psn_wj_z(bounds%begp:bounds%endp,nlevcan) ! RuBP-limited contribution to psn_z (umol CO2/m**2/s) - real(r8) :: psn_wp_z(bounds%begp:bounds%endp,nlevcan) ! product-limited contribution to psn_z (umol CO2/m**2/s) - - real(r8) :: psncan ! canopy sum of psn_z - real(r8) :: psncan_wc ! canopy sum of psn_wc_z - real(r8) :: psncan_wj ! canopy sum of psn_wj_z - real(r8) :: psncan_wp ! canopy sum of psn_wp_z - real(r8) :: lmrcan ! canopy sum of lmr_z - real(r8) :: gscan ! canopy sum of leaf conductance - real(r8) :: laican ! canopy sum of lai_z - real(r8) :: rh_can - real(r8) , pointer :: lai_z (:,:) - real(r8) , pointer :: par_z (:,:) - real(r8) , pointer :: vcmaxcint (:) - real(r8) , pointer :: alphapsn (:) - real(r8) , pointer :: psn (:) - real(r8) , pointer :: psn_wc (:) - real(r8) , pointer :: psn_wj (:) - real(r8) , pointer :: psn_wp (:) - real(r8) , pointer :: psn_z (:,:) - real(r8) , pointer :: lmr (:) - real(r8) , pointer :: lmr_z (:,:) - real(r8) , pointer :: rs (:) - real(r8) , pointer :: rs_z (:,:) - real(r8) , pointer :: ci_z (:,:) - real(r8) , pointer :: o3coefv (:) ! o3 coefficient used in photo calculation - real(r8) , pointer :: o3coefg (:) ! o3 coefficient used in rs calculation - real(r8) , pointer :: alphapsnsun (:) - real(r8) , pointer :: alphapsnsha (:) - - real(r8) :: sum_nscaler - real(r8) :: total_lai - integer :: nptreemax + integer :: f,fp,p,l,g ! indices - real(r8) :: dtime ! land model time step (sec) - integer :: g ! index - !------------------------------------------------------------------------------ + real(r8) :: rc14_atm(nsectors_c14), rc13_atm + integer :: sector_c14 + !----------------------------------------------------------------------- - ! Temperature and soil water response functions + associate( & + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area - ft(tl,ha) = exp( ha / (rgas*1.e-3_r8*(tfrz+25._r8)) * (1._r8 - (tfrz+25._r8)/tl) ) - fth(tl,hd,se,scaleFactor) = scaleFactor / ( 1._r8 + exp( (-hd+se*tl) / (rgas*1.e-3_r8*tl) ) ) - fth25(hd,se) = 1._r8 + exp( (-hd+se*(tfrz+25._r8)) / (rgas*1.e-3_r8*(tfrz+25._r8)) ) + psnsun => photosyns_inst%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_inst%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf photosynthesis (umol CO2 /m**2/ s) + rc13_canair => photosyns_inst%rc13_canair_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in canopy air + rc13_psnsun => photosyns_inst%rc13_psnsun_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in sunlit canopy psn flux + rc13_psnsha => photosyns_inst%rc13_psnsha_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in shaded canopy psn flux + alphapsnsun => photosyns_inst%alphapsnsun_patch , & ! Output: [real(r8) (:) ] fractionation factor in sunlit canopy psn flux + alphapsnsha => photosyns_inst%alphapsnsha_patch , & ! Output: [real(r8) (:) ] fractionation factor in shaded canopy psn flux + psnsun_wc => photosyns_inst%psnsun_wc_patch , & ! Output: [real(r8) (:) ] Rubsico-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsun_wj => photosyns_inst%psnsun_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsun_wp => photosyns_inst%psnsun_wp_patch , & ! Output: [real(r8) (:) ] product-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wc => photosyns_inst%psnsha_wc_patch , & ! Output: [real(r8) (:) ] Rubsico-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wj => photosyns_inst%psnsha_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wp => photosyns_inst%psnsha_wp_patch , & ! Output: [real(r8) (:) ] product-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_inst%c13_psnsun_patch , & ! Output: [real(r8) (:) ] sunlit leaf photosynthesis (umol 13CO2 /m**2/ s) + c13_psnsha => photosyns_inst%c13_psnsha_patch , & ! Output: [real(r8) (:) ] shaded leaf photosynthesis (umol 13CO2 /m**2/ s) + c14_psnsun => photosyns_inst%c14_psnsun_patch , & ! Output: [real(r8) (:) ] sunlit leaf photosynthesis (umol 14CO2 /m**2/ s) + c14_psnsha => photosyns_inst%c14_psnsha_patch , & ! Output: [real(r8) (:) ] shaded leaf photosynthesis (umol 14CO2 /m**2/ s) + fpsn => photosyns_inst%fpsn_patch , & ! Output: [real(r8) (:) ] photosynthesis (umol CO2 /m**2 /s) + fpsn_wc => photosyns_inst%fpsn_wc_patch , & ! Output: [real(r8) (:) ] Rubisco-limited photosynthesis (umol CO2 /m**2 /s) + fpsn_wj => photosyns_inst%fpsn_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited photosynthesis (umol CO2 /m**2 /s) + fpsn_wp => photosyns_inst%fpsn_wp_patch & ! Output: [real(r8) (:) ] product-limited photosynthesis (umol CO2 /m**2 /s) + ) - ! Enforce expected array sizes - SHR_ASSERT_ALL_FL((ubound(esat_tv) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(eair) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(oair) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(cair) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(rb) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(btran) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(dayl_factor) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(leafn) == (/bounds%endp/)), sourcefile, __LINE__) + do f = 1, fn + p = filterp(f) + g = patch%gridcell(p) - associate( & - c3psn => pftcon%c3psn , & ! Input: photosynthetic pathway: 0. = c4, 1. = c3 - crop => pftcon%crop , & ! Input: crop or not (0 =not crop and 1 = crop) - leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) - flnr => pftcon%flnr , & ! Input: fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) - fnitr => pftcon%fnitr , & ! Input: foliage nitrogen limitation factor (-) - slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis [m^2/gC] - dsladlai => pftcon%dsladlai , & ! Input: change in sla per unit lai - i_vcad => pftcon%i_vcad , & ! Input: [real(r8) (:) ] - s_vcad => pftcon%s_vcad , & ! Input: [real(r8) (:) ] - i_flnr => pftcon%i_flnr , & ! Input: [real(r8) (:) ] - s_flnr => pftcon%s_flnr , & ! Input: [real(r8) (:) ] - mbbopt => pftcon%mbbopt , & ! Input: [real(r8) (:) ] Ball-Berry slope of conduct/photosyn (umol H2O/umol CO2) - ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type - forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + if (.not. use_fates) then + fpsn(p) = psnsun(p) *laisun(p) + psnsha(p) *laisha(p) + fpsn_wc(p) = psnsun_wc(p)*laisun(p) + psnsha_wc(p)*laisha(p) + fpsn_wj(p) = psnsun_wj(p)*laisun(p) + psnsha_wj(p)*laisha(p) + fpsn_wp(p) = psnsun_wp(p)*laisun(p) + psnsha_wp(p)*laisha(p) + end if + end do - t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) - t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) - tgcm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] air temperature at agcm reference height (kelvin) - - nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] pft number of canopy layers, above snow for radiative transfer - tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] pft total leaf area index for canopy layer - tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8)(:) ] one-sided leaf area index, no burying by snow - c3flag => photosyns_inst%c3flag_patch , & ! Output: [logical (:) ] true if C3 and false if C4 - ac => photosyns_inst%ac_patch , & ! Output: [real(r8) (:,:) ] Rubisco-limited gross photosynthesis (umol CO2/m**2/s) - aj => photosyns_inst%aj_patch , & ! Output: [real(r8) (:,:) ] RuBP-limited gross photosynthesis (umol CO2/m**2/s) - ap => photosyns_inst%ap_patch , & ! Output: [real(r8) (:,:) ] product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) - ag => photosyns_inst%ag_patch , & ! Output: [real(r8) (:,:) ] co-limited gross leaf photosynthesis (umol CO2/m**2/s) - an => photosyns_inst%an_patch , & ! Output: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) - gb_mol => photosyns_inst%gb_mol_patch , & ! Output: [real(r8) (:) ] leaf boundary layer conductance (umol H2O/m**2/s) - gs_mol => photosyns_inst%gs_mol_patch , & ! Output: [real(r8) (:,:) ] leaf stomatal conductance (umol H2O/m**2/s) - gs_mol_sun_ln => photosyns_inst%gs_mol_sun_ln_patch , & ! Output: [real(r8) (:,:) ] sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) - gs_mol_sha_ln => photosyns_inst%gs_mol_sha_ln_patch , & ! Output: [real(r8) (:,:) ] shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) - vcmax_z => photosyns_inst%vcmax_z_patch , & ! Output: [real(r8) (:,:) ] maximum rate of carboxylation (umol co2/m**2/s) - cp => photosyns_inst%cp_patch , & ! Output: [real(r8) (:) ] CO2 compensation point (Pa) - kc => photosyns_inst%kc_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for CO2 (Pa) - ko => photosyns_inst%ko_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for O2 (Pa) - qe => photosyns_inst%qe_patch , & ! Output: [real(r8) (:) ] quantum efficiency, used only for C4 (mol CO2 / mol photons) - tpu_z => photosyns_inst%tpu_z_patch , & ! Output: [real(r8) (:,:) ] triose phosphate utilization rate (umol CO2/m**2/s) - kp_z => photosyns_inst%kp_z_patch , & ! Output: [real(r8) (:,:) ] initial slope of CO2 response curve (C4 plants) - bbb => photosyns_inst%bbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry minimum leaf conductance (umol H2O/m**2/s) - mbb => photosyns_inst%mbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry slope of conductance-photosynthesis relationship - rh_leaf => photosyns_inst%rh_leaf_patch , & ! Output: [real(r8) (:) ] fractional humidity at leaf surface (dimensionless) - vpd_can => photosyns_inst%vpd_can_patch , & ! Output: [real(r8) (:) ] canopy vapor pressure deficit (kPa) - lnc => photosyns_inst%lnca_patch , & ! Output: [real(r8) (:) ] top leaf layer leaf N concentration (gN leaf/m^2) - light_inhibit=> photosyns_inst%light_inhibit , & ! Input: [logical ] flag if light should inhibit respiration - leafresp_method=> photosyns_inst%leafresp_method , & ! Input: [integer ] method type to use for leaf-maint.-respiration at 25C canopy top - stomatalcond_mtd=> photosyns_inst%stomatalcond_mtd , & ! Input: [integer ] method type to use for stomatal conductance.GC.fnlprmsn15_r22845 - leaf_mr_vcm => canopystate_inst%leaf_mr_vcm & ! Input: [real(r8) ] scalar constant of leaf respiration with Vcmax - ) - - if (phase == 'sun') then - par_z => solarabs_inst%parsun_z_patch ! Input: [real(r8) (:,:) ] par absorbed per unit lai for canopy layer (w/m**2) - lai_z => canopystate_inst%laisun_z_patch ! Input: [real(r8) (:,:) ] leaf area index for canopy layer, sunlit or shaded - vcmaxcint => surfalb_inst%vcmaxcintsun_patch ! Input: [real(r8) (:) ] leaf to canopy scaling coefficient - alphapsn => photosyns_inst%alphapsnsun_patch ! Input: [real(r8) (:) ] 13C fractionation factor for PSN () - o3coefv => ozone_inst%o3coefvsun_patch ! Input: [real(r8) (:) ] O3 coefficient used in photosynthesis calculation - o3coefg => ozone_inst%o3coefgsun_patch ! Input: [real(r8) (:) ] O3 coefficient used in rs calculation - ci_z => photosyns_inst%cisun_z_patch ! Output: [real(r8) (:,:) ] intracellular leaf CO2 (Pa) - rs => photosyns_inst%rssun_patch ! Output: [real(r8) (:) ] leaf stomatal resistance (s/m) - rs_z => photosyns_inst%rssun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf stomatal resistance (s/m) - lmr => photosyns_inst%lmrsun_patch ! Output: [real(r8) (:) ] leaf maintenance respiration rate (umol CO2/m**2/s) - lmr_z => photosyns_inst%lmrsun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) - psn => photosyns_inst%psnsun_patch ! Output: [real(r8) (:) ] foliage photosynthesis (umol co2 /m**2/ s) [always +] - psn_z => photosyns_inst%psnsun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: foliage photosynthesis (umol co2 /m**2/ s) [always +] - psn_wc => photosyns_inst%psnsun_wc_patch ! Output: [real(r8) (:) ] Rubisco-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] - psn_wj => photosyns_inst%psnsun_wj_patch ! Output: [real(r8) (:) ] RuBP-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] - psn_wp => photosyns_inst%psnsun_wp_patch ! Output: [real(r8) (:) ] product-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] - else if (phase == 'sha') then - par_z => solarabs_inst%parsha_z_patch ! Input: [real(r8) (:,:) ] par absorbed per unit lai for canopy layer (w/m**2) - lai_z => canopystate_inst%laisha_z_patch ! Input: [real(r8) (:,:) ] leaf area index for canopy layer, sunlit or shaded - vcmaxcint => surfalb_inst%vcmaxcintsha_patch ! Input: [real(r8) (:) ] leaf to canopy scaling coefficient - alphapsn => photosyns_inst%alphapsnsha_patch ! Input: [real(r8) (:) ] 13C fractionation factor for PSN () - o3coefv => ozone_inst%o3coefvsha_patch ! Input: [real(r8) (:) ] O3 coefficient used in photosynthesis calculation - o3coefg => ozone_inst%o3coefgsha_patch ! Input: [real(r8) (:) ] O3 coefficient used in rs calculation - ci_z => photosyns_inst%cisha_z_patch ! Output: [real(r8) (:,:) ] intracellular leaf CO2 (Pa) - rs => photosyns_inst%rssha_patch ! Output: [real(r8) (:) ] leaf stomatal resistance (s/m) - rs_z => photosyns_inst%rssha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf stomatal resistance (s/m) - lmr => photosyns_inst%lmrsha_patch ! Output: [real(r8) (:) ] leaf maintenance respiration rate (umol CO2/m**2/s) - lmr_z => photosyns_inst%lmrsha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) - psn => photosyns_inst%psnsha_patch ! Output: [real(r8) (:) ] foliage photosynthesis (umol co2 /m**2/ s) [always +] - psn_z => photosyns_inst%psnsha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: foliage photosynthesis (umol co2 /m**2/ s) [always +] - psn_wc => photosyns_inst%psnsha_wc_patch ! Output: [real(r8) (:) ] Rubisco-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] - psn_wj => photosyns_inst%psnsha_wj_patch ! Output: [real(r8) (:) ] RuBP-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] - psn_wp => photosyns_inst%psnsha_wp_patch ! Output: [real(r8) (:) ] product-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] - end if - - !==============================================================================! - ! Photosynthesis and stomatal conductance parameters, from: - ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 - !==============================================================================! - - ! Determine seconds of current time step - - dtime = get_step_size_real() - - ! Activation energy, from: - ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 - ! Bernacchi et al (2003) Plant, Cell and Environment 26:1419-1430 - ! except TPU from: Harley et al (1992) Plant, Cell and Environment 15:271-282 - - ! High temperature deactivation, from: - ! Leuning (2002) Plant, Cell and Environment 25:1205-1210 - ! The factor "c" scales the deactivation to a value of 1.0 at 25C - - lmrc = fth25 (params_inst%lmrhd, params_inst%lmrse) - - ! Miscellaneous parameters, from Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 - - do f = 1, fn - p = filterp(f) - c = patch%column(p) - - ! C3 or C4 photosynthesis logical variable - - if (nint(c3psn(patch%itype(p))) == 1) then - c3flag(p) = .true. - else if (nint(c3psn(patch%itype(p))) == 0) then - c3flag(p) = .false. - end if - - ! C3 and C4 dependent parameters - - if (c3flag(p)) then - qe(p) = 0._r8 - bbbopt(p) = 10000._r8 - else - qe(p) = 0.05_r8 - bbbopt(p) = 40000._r8 - end if - - ! Soil water stress applied to Ball-Berry parameters - - bbb(p) = max (bbbopt(p)*btran(p), 1._r8) - mbb(p) = mbbopt(patch%itype(p)) - - ! kc, ko, cp, from: Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 - ! - ! kc25_coef = 404.9e-6 mol/mol - ! ko25_coef = 278.4e-3 mol/mol - ! cp25_yr2000 = 42.75e-6 mol/mol - ! - ! Derive sco from cp and O2 using present-day O2 (0.209 mol/mol) and re-calculate - ! cp to account for variation in O2 using cp = 0.5 O2 / sco - ! - - kc25 = params_inst%kc25_coef * forc_pbot(c) - ko25 = params_inst%ko25_coef * forc_pbot(c) - sco = 0.5_r8 * 0.209_r8 / params_inst%cp25_yr2000 - cp25 = 0.5_r8 * oair(p) / sco - - kc(p) = kc25 * ft(t_veg(p), params_inst%kcha) - ko(p) = ko25 * ft(t_veg(p), params_inst%koha) - cp(p) = cp25 * ft(t_veg(p), params_inst%cpha) - - end do - - ! Multi-layer parameters scaled by leaf nitrogen profile. - ! Loop through each canopy layer to calculate nitrogen profile using - ! cumulative lai at the midpoint of the layer - - do f = 1, fn - p = filterp(f) - - if (lnc_opt .eqv. .false.) then - ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) - - if ( (slatop(patch%itype(p)) *leafcn(patch%itype(p))) .le. 0.0_r8)then - call endrun( "ERROR: slatop or leafcn is zero" ) - end if - lnc(p) = 1._r8 / (slatop(patch%itype(p)) * leafcn(patch%itype(p))) - end if - - ! Using the actual nitrogen allocated to the leaf after - ! uptake rather than fixing leaf nitrogen based on SLA and CN - ! ratio - if (lnc_opt .eqv. .true.) then - ! nlevcan and nrad(p) look like the same variable ?? check this later - sum_nscaler = 0.0_r8 - laican = 0.0_r8 - total_lai = 0.0_r8 - - do iv = 1, nrad(p) - - if (iv == 1) then - laican = 0.5_r8 * tlai_z(p,iv) - total_lai = tlai_z(p,iv) - else - laican = laican + 0.5_r8 * (tlai_z(p,iv-1)+tlai_z(p,iv)) - total_lai = total_lai + tlai_z(p,iv) - end if - - ! Scale for leaf nitrogen profile. If multi-layer code, use explicit - ! profile. If sun/shade big leaf code, use canopy integrated factor. - if (nlevcan == 1) then - nscaler = 1.0_r8 - else if (nlevcan > 1) then - nscaler = exp(-kn(p) * laican) - end if - - sum_nscaler = sum_nscaler + nscaler - - end do - - if (tlai(p) > 0.0_r8 .AND. sum_nscaler > 0.0_r8) then - ! dividing by LAI to convert total leaf nitrogen - ! from m2 ground to m2 leaf; dividing by sum_nscaler to - ! convert total leaf N to leaf N at canopy top - lnc(p) = leafn(p) / (tlai(p) * sum_nscaler) - else - lnc(p) = 0.0_r8 - end if - - end if - - - ! reduce_dayl_factor .eqv. .false. - if (reduce_dayl_factor .eqv. .true.) then - if (dayl_factor(p) > 0.25_r8) then - ! dayl_factor(p) = 1.0_r8 - end if - end if - - - ! Default - if (vcmax_opt == 0) then - ! vcmax25 at canopy top, as in CN but using lnc at top of the canopy - vcmax25top = lnc(p) * flnr(patch%itype(p)) * params_inst%fnr * params_inst%act25 * dayl_factor(p) - if (.not. use_cn) then - vcmax25top = vcmax25top * fnitr(patch%itype(p)) - else - if ( CNAllocate_Carbon_only() ) vcmax25top = vcmax25top * fnitr(patch%itype(p)) - end if - else if (vcmax_opt == 3) then - vcmax25top = ( i_vcad(patch%itype(p)) + s_vcad(patch%itype(p)) * lnc(p) ) * dayl_factor(p) - else if (vcmax_opt == 4) then - nptreemax = 9 ! is this number correct? check later - if (patch%itype(p) >= nptreemax) then ! if not tree - ! for shrubs and herbs - vcmax25top = lnc(p) * ( i_flnr(patch%itype(p)) + s_flnr(patch%itype(p)) * lnc(p) ) * params_inst%fnr * params_inst%act25 * & - dayl_factor(p) - else - ! if tree - vcmax25top = lnc(p) * ( i_flnr(patch%itype(p)) * exp(s_flnr(patch%itype(p)) * lnc(p)) ) * params_inst%fnr * params_inst%act25 * & - dayl_factor(p) - ! for trees - end if - end if - - - ! Parameters derived from vcmax25top. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 - ! used jmax25 = 1.97 vcmax25, from Wullschleger (1993) Journal of Experimental Botany 44:907-920. - - jmax25top = ((2.59_r8 - 0.035_r8*min(max((t10(p)-tfrz),11._r8),35._r8)) * vcmax25top) * & - params_inst%jmax25top_sf - tpu25top = params_inst%tpu25ratio * vcmax25top - kp25top = params_inst%kp25ratio * vcmax25top - - ! Nitrogen scaling factor. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 used - ! kn = 0.11. Here, derive kn from vcmax25 as in Lloyd et al (2010) Biogeosciences, 7, 1833-1859 - ! Remove daylength factor from vcmax25 so that kn is based on maximum vcmax25 - ! But not used as defined here if using sun/shade big leaf code. Instead, - ! will use canopy integrated scaling factors from SurfaceAlbedo. - - if (dayl_factor(p) < 1.0e-12_r8) then - kn(p) = 0._r8 - else - kn(p) = exp(0.00963_r8 * vcmax25top/dayl_factor(p) - 2.43_r8) - end if - - if (use_cn) then - if ( leafresp_method == leafresp_mtd_ryan1991 ) then - ! Leaf maintenance respiration to match the base rate used in CN - ! but with the new temperature functions for C3 and C4 plants. - ! - ! Base rate for maintenance respiration is from: - ! M. Ryan, 1991. Effects of climate change on plant respiration. - ! Ecological Applications, 1(2), 157-167. - ! Original expression is br = 0.0106 molC/(molN h) - ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) - ! - ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 - ! - ! CN respiration has units: g C / g N [leaf] / s. This needs to be - ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s - ! - ! Then scale this value at the top of the canopy for canopy depth - - lmr25top = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) - lmr25top = lmr25top * lnc(p) / 12.e-06_r8 - - else if ( leafresp_method == leafresp_mtd_atkin2015 ) then - !using new form for respiration base rate from Atkin - !communication. - if ( lnc(p) > 0.0_r8 ) then - lmr25top = params_inst%lmr_intercept_atkin(ivt(p)) + (lnc(p) * 0.2061_r8) - (0.0402_r8 * (t10(p)-tfrz)) - else - lmr25top = 0.0_r8 - end if - end if - - else - ! Leaf maintenance respiration in proportion to vcmax25top - - if (c3flag(p)) then - lmr25top = vcmax25top * leaf_mr_vcm - else - lmr25top = vcmax25top * 0.025_r8 - end if - end if - - ! Loop through canopy layers (above snow). Respiration needs to be - ! calculated every timestep. Others are calculated only if daytime - - laican = 0._r8 - do iv = 1, nrad(p) - - ! Cumulative lai at middle of layer - - if (iv == 1) then - laican = 0.5_r8 * tlai_z(p,iv) - else - laican = laican + 0.5_r8 * (tlai_z(p,iv-1)+tlai_z(p,iv)) - end if - - ! Scale for leaf nitrogen profile. If multi-layer code, use explicit - ! profile. If sun/shade big leaf code, use canopy integrated factor. - - if (nlevcan == 1) then - nscaler = vcmaxcint(p) - else if (nlevcan > 1) then - nscaler = exp(-kn(p) * laican) - end if - - ! Maintenance respiration - - lmr25 = lmr25top * nscaler - - if(use_luna.and.c3flag(p).and.crop(patch%itype(p))== 0) then - if(.not.use_cn)then ! If CN is on, use leaf N to predict respiration (above). Otherwise, use Vcmax term from LUNA. RF - lmr25 = leaf_mr_vcm * photosyns_inst%vcmx25_z_patch(p,iv) - endif - endif - - if (c3flag(p)) then - lmr_z(p,iv) = lmr25 * ft(t_veg(p), params_inst%lmrha) * fth(t_veg(p), params_inst%lmrhd, & - params_inst%lmrse, lmrc) - else - lmr_z(p,iv) = lmr25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) - lmr_z(p,iv) = lmr_z(p,iv) / (1._r8 + exp( 1.3_r8*(t_veg(p)-(tfrz+55._r8)) )) - end if - - if (par_z(p,iv) <= 0._r8) then ! night time - - vcmax_z(p,iv) = 0._r8 - jmax_z(p,iv) = 0._r8 - tpu_z(p,iv) = 0._r8 - kp_z(p,iv) = 0._r8 - - if ( use_c13 ) then - alphapsn(p) = 1._r8 - end if - - else ! day time - - if(use_luna.and.c3flag(p).and.crop(patch%itype(p))== 0)then - vcmax25 = photosyns_inst%vcmx25_z_patch(p,iv) - jmax25 = photosyns_inst%jmx25_z_patch(p,iv) - tpu25 = params_inst%tpu25ratio * vcmax25 - !Implement scaling of Vcmax25 from sunlit average to shaded canopy average value. RF & GBB. 1 July 2016 - if(phase == 'sha'.and.surfalb_inst%vcmaxcintsun_patch(p).gt.0._r8.and.nlevcan==1) then - vcmax25 = vcmax25 * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) - jmax25 = jmax25 * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) - tpu25 = tpu25 * surfalb_inst%vcmaxcintsha_patch(p)/surfalb_inst%vcmaxcintsun_patch(p) - end if - - else - vcmax25 = vcmax25top * nscaler - jmax25 = jmax25top * nscaler - tpu25 = tpu25top * nscaler - endif - kp25 = kp25top * nscaler - - ! Adjust for temperature - - vcmaxse = (668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%vcmaxse_sf - jmaxse = (659.70_r8 - 0.75_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%jmaxse_sf - tpuse = (668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8)) * params_inst%tpuse_sf - vcmaxc = fth25 (params_inst%vcmaxhd, vcmaxse) - jmaxc = fth25 (params_inst%jmaxhd, jmaxse) - tpuc = fth25 (params_inst%tpuhd, tpuse) - vcmax_z(p,iv) = vcmax25 * ft(t_veg(p), params_inst%vcmaxha) * fth(t_veg(p), & - params_inst%vcmaxhd, vcmaxse, vcmaxc) - jmax_z(p,iv) = jmax25 * ft(t_veg(p), params_inst%jmaxha) * fth(t_veg(p), & - params_inst%jmaxhd, jmaxse, jmaxc) - tpu_z(p,iv) = tpu25 * ft(t_veg(p), params_inst%tpuha) * fth(t_veg(p), params_inst%tpuhd, tpuse, tpuc) - - if (.not. c3flag(p)) then - vcmax_z(p,iv) = vcmax25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) - vcmax_z(p,iv) = vcmax_z(p,iv) / (1._r8 + exp( 0.2_r8*((tfrz+15._r8)-t_veg(p)) )) - vcmax_z(p,iv) = vcmax_z(p,iv) / (1._r8 + exp( 0.3_r8*(t_veg(p)-(tfrz+40._r8)) )) - end if - - kp_z(p,iv) = kp25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) - - end if - - ! Adjust for soil water - - vcmax_z(p,iv) = vcmax_z(p,iv) * btran(p) - lmr_z(p,iv) = lmr_z(p,iv) * btran(p) - - ! Change to add in light inhibition of respiration. 0.67 from Lloyd et al. 2010, & Metcalfe et al. 2012 - ! Also pers. comm from Peter Reich (Nov 2015). Might potentially be updated pending findings of Atkin et al. (in prep) - ! review of light inhibition database. - if ( light_inhibit .and. par_z(p,1) > 0._r8) then ! are the lights on? - lmr_z(p,iv) = lmr_z(p,iv) * 0.67_r8 ! inhibit respiration accordingly. - end if - - end do ! canopy layer loop - end do ! patch loop - - !==============================================================================! - ! Leaf-level photosynthesis and stomatal conductance - !==============================================================================! - - rsmax0 = 2.e4_r8 - - do f = 1, fn - p = filterp(f) - c = patch%column(p) - g = patch%gridcell(p) - - ! Leaf boundary layer conductance, umol/m**2/s - - cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e06_r8 - gb = 1._r8/rb(p) - gb_mol(p) = gb * cf - - ! Loop through canopy layers (above snow). Only do calculations if daytime - - do iv = 1, nrad(p) - - if (par_z(p,iv) <= 0._r8) then ! night time - - ac(p,iv) = 0._r8 - aj(p,iv) = 0._r8 - ap(p,iv) = 0._r8 - ag(p,iv) = 0._r8 - an(p,iv) = ag(p,iv) - lmr_z(p,iv) - psn_z(p,iv) = 0._r8 - psn_wc_z(p,iv) = 0._r8 - psn_wj_z(p,iv) = 0._r8 - psn_wp_z(p,iv) = 0._r8 - rs_z(p,iv) = min(rsmax0, 1._r8/bbb(p) * cf) - ci_z(p,iv) = 0._r8 - rh_leaf(p) = 0._r8 - - else ! day time - - !now the constraint is no longer needed, Jinyun Tang - ceair = min( eair(p), esat_tv(p) ) - if ( stomatalcond_mtd == stomatalcond_mtd_bb1987 )then - rh_can = ceair / esat_tv(p) - else if ( stomatalcond_mtd == stomatalcond_mtd_medlyn2011 )then - ! Put some constraints on RH in the canopy when Medlyn stomatal conductance is being used - rh_can = max((esat_tv(p) - ceair), 50._r8) * 0.001_r8 - vpd_can(p) = rh_can - end if - - ! Electron transport rate for C3 plants. Convert par from W/m2 to - ! umol photons/m**2/s using the factor 4.6 - - qabs = 0.5_r8 * (1._r8 - params_inst%fnps) * par_z(p,iv) * 4.6_r8 - aquad = params_inst%theta_psii - bquad = -(qabs + jmax_z(p,iv)) - cquad = qabs * jmax_z(p,iv) - call quadratic (aquad, bquad, cquad, r1, r2) - je = min(r1,r2) - - ! Iterative loop for ci beginning with initial guess - - if (c3flag(p)) then - ci_z(p,iv) = 0.7_r8 * cair(p) - else - ci_z(p,iv) = 0.4_r8 * cair(p) - end if - - niter = 0 - - ! Increment iteration counter. Stop if too many iterations - - niter = niter + 1 - - ! Save old ci - - ciold = ci_z(p,iv) - - !find ci and stomatal conductance - call hybrid(ciold, p, iv, c, gb_mol(p), je, cair(p), oair(p), & - lmr_z(p,iv), par_z(p,iv), rh_can, gs_mol(p,iv), niter, & - atm2lnd_inst, photosyns_inst) - - ! End of ci iteration. Check for an < 0, in which case gs_mol = bbb - - if (an(p,iv) < 0._r8) gs_mol(p,iv) = bbb(p) - - ! Use time period 1 hour before and 1 hour after local noon inclusive (11AM-1PM) - if ( is_near_local_noon( grc%londeg(g), deltasec=3600 ) )then - if (phase == 'sun') then - gs_mol_sun_ln(p,iv) = gs_mol(p,iv) - else if (phase == 'sha') then - gs_mol_sha_ln(p,iv) = gs_mol(p,iv) - end if - else - if (phase == 'sun') then - gs_mol_sun_ln(p,iv) = spval - else if (phase == 'sha') then - gs_mol_sha_ln(p,iv) = spval - end if - end if - - ! Final estimates for cs and ci (needed for early exit of ci iteration when an < 0) - - cs = cair(p) - 1.4_r8/gb_mol(p) * an(p,iv) * forc_pbot(c) - cs = max(cs,1.e-06_r8) - ci_z(p,iv) = cair(p) - an(p,iv) * forc_pbot(c) * (1.4_r8*gs_mol(p,iv)+1.6_r8*gb_mol(p)) / (gb_mol(p)*gs_mol(p,iv)) - - ! Trap for values of ci_z less than 1.e-06. This is needed for - ! Megan (which can crash with negative values) - ci_z(p,iv) = max( ci_z(p,iv), 1.e-06_r8 ) - - ! Convert gs_mol (umol H2O/m**2/s) to gs (m/s) and then to rs (s/m) - - gs = gs_mol(p,iv) / cf - rs_z(p,iv) = min(1._r8/gs, rsmax0) - rs_z(p,iv) = rs_z(p,iv) / o3coefg(p) - - ! Photosynthesis. Save rate-limiting photosynthesis - - psn_z(p,iv) = ag(p,iv) - psn_z(p,iv) = psn_z(p,iv) * o3coefv(p) - - psn_wc_z(p,iv) = 0._r8 - psn_wj_z(p,iv) = 0._r8 - psn_wp_z(p,iv) = 0._r8 - - if (ac(p,iv) <= aj(p,iv) .and. ac(p,iv) <= ap(p,iv)) then - psn_wc_z(p,iv) = psn_z(p,iv) - else if (aj(p,iv) < ac(p,iv) .and. aj(p,iv) <= ap(p,iv)) then - psn_wj_z(p,iv) = psn_z(p,iv) - else if (ap(p,iv) < ac(p,iv) .and. ap(p,iv) < aj(p,iv)) then - psn_wp_z(p,iv) = psn_z(p,iv) - end if - - ! Make sure iterative solution is correct - - if (gs_mol(p,iv) < 0._r8) then - write (iulog,*)'Negative stomatal conductance:' - write (iulog,*)'p,iv,gs_mol= ',p,iv,gs_mol(p,iv) - call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) - end if - - ! Compare with Ball-Berry model: gs_mol = m * an * hs/cs p + b - - hs = (gb_mol(p)*ceair + gs_mol(p,iv)*esat_tv(p)) / ((gb_mol(p)+gs_mol(p,iv))*esat_tv(p)) - rh_leaf(p) = hs - gs_mol_err = mbb(p)*max(an(p,iv), 0._r8)*hs/cs*forc_pbot(c) + bbb(p) - - if (abs(gs_mol(p,iv)-gs_mol_err) > 1.e-01_r8) then - write (iulog,*) 'Ball-Berry error check - stomatal conductance error:' - write (iulog,*) gs_mol(p,iv), gs_mol_err - end if - - end if ! night or day if branch - end do ! canopy layer loop - end do ! patch loop - - !==============================================================================! - ! Canopy photosynthesis and stomatal conductance - !==============================================================================! - - ! Sum canopy layer fluxes and then derive effective leaf-level fluxes (per - ! unit leaf area), which are used in other parts of the model. Here, laican - ! sums to either laisun or laisha. - - do f = 1, fn - p = filterp(f) - - psncan = 0._r8 - psncan_wc = 0._r8 - psncan_wj = 0._r8 - psncan_wp = 0._r8 - lmrcan = 0._r8 - gscan = 0._r8 - laican = 0._r8 - do iv = 1, nrad(p) - psncan = psncan + psn_z(p,iv) * lai_z(p,iv) - psncan_wc = psncan_wc + psn_wc_z(p,iv) * lai_z(p,iv) - psncan_wj = psncan_wj + psn_wj_z(p,iv) * lai_z(p,iv) - psncan_wp = psncan_wp + psn_wp_z(p,iv) * lai_z(p,iv) - lmrcan = lmrcan + lmr_z(p,iv) * lai_z(p,iv) - gscan = gscan + lai_z(p,iv) / (rb(p)+rs_z(p,iv)) - laican = laican + lai_z(p,iv) - end do - if (laican > 0._r8) then - psn(p) = psncan / laican - psn_wc(p) = psncan_wc / laican - psn_wj(p) = psncan_wj / laican - psn_wp(p) = psncan_wp / laican - lmr(p) = lmrcan / laican - rs(p) = laican / gscan - rb(p) - else - psn(p) = 0._r8 - psn_wc(p) = 0._r8 - psn_wj(p) = 0._r8 - psn_wp(p) = 0._r8 - lmr(p) = 0._r8 - rs(p) = 0._r8 - end if - end do - - end associate - - end subroutine Photosynthesis - - !------------------------------------------------------------------------------ - subroutine PhotosynthesisTotal (fn, filterp, & - atm2lnd_inst, canopystate_inst, photosyns_inst) - ! - ! Determine total photosynthesis - ! - ! !ARGUMENTS: - integer , intent(in) :: fn ! size of pft filter - integer , intent(in) :: filterp(fn) ! patch filter - type(atm2lnd_type) , intent(in) :: atm2lnd_inst - type(canopystate_type) , intent(in) :: canopystate_inst - type(photosyns_type) , intent(inout) :: photosyns_inst - ! - ! !LOCAL VARIABLES: - integer :: f,fp,p,l,g ! indices - - real(r8) :: rc14_atm(nsectors_c14), rc13_atm - integer :: sector_c14 - !----------------------------------------------------------------------- - - associate( & - forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] partial pressure co2 (Pa) - forc_pc13o2 => atm2lnd_inst%forc_pc13o2_grc , & ! Input: [real(r8) (:) ] partial pressure c13o2 (Pa) - forc_po2 => atm2lnd_inst%forc_po2_grc , & ! Input: [real(r8) (:) ] partial pressure o2 (Pa) - - laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area - laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area - - psnsun => photosyns_inst%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf photosynthesis (umol CO2 /m**2/ s) - psnsha => photosyns_inst%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf photosynthesis (umol CO2 /m**2/ s) - rc13_canair => photosyns_inst%rc13_canair_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in canopy air - rc13_psnsun => photosyns_inst%rc13_psnsun_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in sunlit canopy psn flux - rc13_psnsha => photosyns_inst%rc13_psnsha_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in shaded canopy psn flux - alphapsnsun => photosyns_inst%alphapsnsun_patch , & ! Output: [real(r8) (:) ] fractionation factor in sunlit canopy psn flux - alphapsnsha => photosyns_inst%alphapsnsha_patch , & ! Output: [real(r8) (:) ] fractionation factor in shaded canopy psn flux - psnsun_wc => photosyns_inst%psnsun_wc_patch , & ! Output: [real(r8) (:) ] Rubsico-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) - psnsun_wj => photosyns_inst%psnsun_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) - psnsun_wp => photosyns_inst%psnsun_wp_patch , & ! Output: [real(r8) (:) ] product-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) - psnsha_wc => photosyns_inst%psnsha_wc_patch , & ! Output: [real(r8) (:) ] Rubsico-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) - psnsha_wj => photosyns_inst%psnsha_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) - psnsha_wp => photosyns_inst%psnsha_wp_patch , & ! Output: [real(r8) (:) ] product-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) - c13_psnsun => photosyns_inst%c13_psnsun_patch , & ! Output: [real(r8) (:) ] sunlit leaf photosynthesis (umol 13CO2 /m**2/ s) - c13_psnsha => photosyns_inst%c13_psnsha_patch , & ! Output: [real(r8) (:) ] shaded leaf photosynthesis (umol 13CO2 /m**2/ s) - c14_psnsun => photosyns_inst%c14_psnsun_patch , & ! Output: [real(r8) (:) ] sunlit leaf photosynthesis (umol 14CO2 /m**2/ s) - c14_psnsha => photosyns_inst%c14_psnsha_patch , & ! Output: [real(r8) (:) ] shaded leaf photosynthesis (umol 14CO2 /m**2/ s) - fpsn => photosyns_inst%fpsn_patch , & ! Output: [real(r8) (:) ] photosynthesis (umol CO2 /m**2 /s) - fpsn_wc => photosyns_inst%fpsn_wc_patch , & ! Output: [real(r8) (:) ] Rubisco-limited photosynthesis (umol CO2 /m**2 /s) - fpsn_wj => photosyns_inst%fpsn_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited photosynthesis (umol CO2 /m**2 /s) - fpsn_wp => photosyns_inst%fpsn_wp_patch & ! Output: [real(r8) (:) ] product-limited photosynthesis (umol CO2 /m**2 /s) - ) - - if ( use_c14 ) then - if (use_c14_bombspike) then - call C14BombSpike(rc14_atm) - else - rc14_atm(:) = c14ratio - end if - end if - - if ( use_c13 ) then - if (use_c13_timeseries) then - call C13TimeSeries(rc13_atm) - end if - end if - - do f = 1, fn - p = filterp(f) - g = patch%gridcell(p) - - if (.not. use_fates) then - fpsn(p) = psnsun(p) *laisun(p) + psnsha(p) *laisha(p) - fpsn_wc(p) = psnsun_wc(p)*laisun(p) + psnsha_wc(p)*laisha(p) - fpsn_wj(p) = psnsun_wj(p)*laisun(p) + psnsha_wj(p)*laisha(p) - fpsn_wp(p) = psnsun_wp(p)*laisun(p) + psnsha_wp(p)*laisha(p) - end if - - if (use_cn) then - if ( use_c13 ) then - if (use_c13_timeseries) then - rc13_canair(p) = rc13_atm - else - rc13_canair(p) = forc_pc13o2(g)/(forc_pco2(g) - forc_pc13o2(g)) - endif - rc13_psnsun(p) = rc13_canair(p)/alphapsnsun(p) - rc13_psnsha(p) = rc13_canair(p)/alphapsnsha(p) - c13_psnsun(p) = psnsun(p) * (rc13_psnsun(p)/(1._r8+rc13_psnsun(p))) - c13_psnsha(p) = psnsha(p) * (rc13_psnsha(p)/(1._r8+rc13_psnsha(p))) - - ! use fixed c13 ratio with del13C of -25 to test the overall c13 structure - ! c13_psnsun(p) = 0.01095627 * psnsun(p) - ! c13_psnsha(p) = 0.01095627 * psnsha(p) - endif - if ( use_c14 ) then - - ! determine latitute sector for radiocarbon bomb spike inputs - if ( grc%latdeg(g) .ge. 30._r8 ) then - sector_c14 = 1 - else if ( grc%latdeg(g) .ge. -30._r8 ) then - sector_c14 = 2 - else - sector_c14 = 3 - endif - - c14_psnsun(p) = rc14_atm(sector_c14) * psnsun(p) - c14_psnsha(p) = rc14_atm(sector_c14) * psnsha(p) - endif - end if - - end do - - end associate + end associate end subroutine PhotosynthesisTotal - !------------------------------------------------------------------------------ - subroutine Fractionation(bounds, fn, filterp, downreg, & - atm2lnd_inst, canopystate_inst, solarabs_inst, surfalb_inst, photosyns_inst, & - phase) - ! - ! !DESCRIPTION: - ! C13 fractionation during photosynthesis is calculated here after the nitrogen - ! limitation is taken into account in the CNAllocation module. - ! - ! As of CLM5, nutrient downregulation occurs prior to photosynthesis via leafcn, so we may - ! ignore the downregulation term in this and assume that the Ci/Ca used in the photosynthesis - ! calculation is consistent with that in the isotope calculation - ! - !!USES: - use clm_varctl , only : use_hydrstress - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: fn ! size of pft filter - integer , intent(in) :: filterp(fn) ! patch filter - real(r8) , intent(in) :: downreg( bounds%begp: ) ! fractional reduction in GPP due to N limitation (dimensionless) - type(atm2lnd_type) , intent(in) :: atm2lnd_inst - type(canopystate_type) , intent(in) :: canopystate_inst - type(solarabs_type) , intent(in) :: solarabs_inst - type(surfalb_type) , intent(in) :: surfalb_inst - type(photosyns_type) , intent(in) :: photosyns_inst - character(len=*) , intent(in) :: phase ! 'sun' or 'sha' - ! - ! !LOCAL VARIABLES: - real(r8) , pointer :: par_z (:,:) ! needed for backwards compatiblity - real(r8) , pointer :: alphapsn (:) ! needed for backwards compatiblity - real(r8) , pointer :: gs_mol(:,:) ! leaf stomatal conductance (umol H2O/m**2/s) - real(r8) , pointer :: an(:,:) ! net leaf photosynthesis (umol CO2/m**2/s) - integer :: f,p,c,g,iv ! indices - real(r8) :: co2(bounds%begp:bounds%endp) ! atmospheric co2 partial pressure (pa) - real(r8) :: ci - !------------------------------------------------------------------------------ - - SHR_ASSERT_ALL_FL((ubound(downreg) == (/bounds%endp/)), sourcefile, __LINE__) - - associate( & - forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) - forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] partial pressure co2 (Pa) - - c3psn => pftcon%c3psn , & ! Input: photosynthetic pathway: 0. = c4, 1. = c3 - - nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer - - gb_mol => photosyns_inst%gb_mol_patch & ! Input: [real(r8) (:) ] leaf boundary layer conductance (umol H2O/m**2/s) - ) - - if (phase == 'sun') then - par_z => solarabs_inst%parsun_z_patch ! Input : [real(r8) (:,:)] par absorbed per unit lai for canopy layer (w/m**2) - alphapsn => photosyns_inst%alphapsnsun_patch ! Output: [real(r8) (:)] - if (use_hydrstress) then - gs_mol => photosyns_inst%gs_mol_sun_patch ! Input: [real(r8) (:,:) ] sunlit leaf stomatal conductance (umol H2O/m**2/s) - an => photosyns_inst%an_sun_patch ! Input: [real(r8) (:,:) ] net sunlit leaf photosynthesis (umol CO2/m**2/s) - else - gs_mol => photosyns_inst%gs_mol_patch ! Input: [real(r8) (:,:) ] leaf stomatal conductance (umol H2O/m**2/s) - an => photosyns_inst%an_patch ! Input: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) - end if - else if (phase == 'sha') then - par_z => solarabs_inst%parsha_z_patch ! Input : [real(r8) (:,:)] par absorbed per unit lai for canopy layer (w/m**2) - alphapsn => photosyns_inst%alphapsnsha_patch ! Output: [real(r8) (:)] - if (use_hydrstress) then - gs_mol => photosyns_inst%gs_mol_sha_patch ! Input: [real(r8) (:,:) ] shaded leaf stomatal conductance (umol H2O/m**2/s) - an => photosyns_inst%an_sha_patch ! Input: [real(r8) (:,:) ] net shaded leaf photosynthesis (umol CO2/m**2/s) - else - gs_mol => photosyns_inst%gs_mol_patch ! Input: [real(r8) (:,:) ] leaf stomatal conductance (umol H2O/m**2/s) - an => photosyns_inst%an_patch ! Input: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) - end if - end if - - do f = 1, fn - p = filterp(f) - c= patch%column(p) - g= patch%gridcell(p) - - co2(p) = forc_pco2(g) - do iv = 1,nrad(p) - if (par_z(p,iv) <= 0._r8) then ! night time - alphapsn(p) = 1._r8 - else ! day time - ci = co2(p) - (an(p,iv) * & - forc_pbot(c) * & - (1.4_r8*gs_mol(p,iv)+1.6_r8*gb_mol(p)) / (gb_mol(p)*gs_mol(p,iv))) - alphapsn(p) = 1._r8 + (((c3psn(patch%itype(p)) * & - (4.4_r8 + (22.6_r8*(ci/co2(p))))) + & - ((1._r8 - c3psn(patch%itype(p))) * 4.4_r8))/1000._r8) - end if - end do - end do - - end associate - - end subroutine Fractionation !------------------------------------------------------------------------------- subroutine hybrid(x0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNLeachingMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNLeachingMod.F90 new file mode 100755 index 000000000..7e8d847b5 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNLeachingMod.F90 @@ -0,0 +1,289 @@ +module SoilBiogeochemNLeachingMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for mineral nitrogen dynamics (deposition, fixation, leaching) + ! for coupled carbon-nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varcon , only : dzsoi_decomp, zisoi + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: SoilBiogeochemNLeaching + ! + ! !PRIVATE DATA: + type, private :: params_type + real(r8):: sf ! soluble fraction of mineral N (unitless) + real(r8):: sf_no3 ! soluble fraction of NO3 (unitless) + end type params_type + + type(params_type), private :: params_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read in parameters + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNNDynamicsParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='sf_minn' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%sf=tempr + + tString='sf_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%sf_no3=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & + waterstatebulk_inst, waterfluxbulk_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen leaching rate + ! as a function of soluble mineral N and total soil water outflow. + ! + ! !USES: + use clm_varpar , only : nlevdecomp, nlevsoi + use clm_time_manager , only : get_step_size_real + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c,fc ! indices + real(r8) :: dt ! radiation time step (seconds) + real(r8) :: sf ! soluble fraction of mineral N (unitless) + real(r8) :: sf_no3 ! soluble fraction of NO3 (unitless) + real(r8) :: disn_conc ! dissolved mineral N concentration (gN/kg water) + real(r8) :: tot_water(bounds%begc:bounds%endc) ! total column liquid water (kg water/m2) + real(r8) :: surface_water(bounds%begc:bounds%endc) ! liquid water to shallow surface depth (kg water/m2) + real(r8) :: drain_tot(bounds%begc:bounds%endc) ! total drainage flux (mm H2O /s) + real(r8), parameter :: depth_runoff_Nloss = 0.05 ! (m) depth over which runoff mixes with soil water for N loss to runoff + !----------------------------------------------------------------------- + + associate( & + h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + + qflx_drain => waterfluxbulk_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_surf => waterfluxbulk_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] total surface runoff (mm H2O /s) + + sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N + smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ] + + sminn_leached_vr => soilbiogeochem_nitrogenflux_inst%sminn_leached_vr_col , & ! Output: [real(r8) (:,:) ] rate of mineral N leaching (gN/m3/s) + smin_no3_leached_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_leached_vr_col , & ! Output: [real(r8) (:,:) ] rate of mineral NO3 leaching (gN/m3/s) + smin_no3_runoff_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_runoff_vr_col & ! Output: [real(r8) (:,:) ] rate of mineral NO3 loss with runoff (gN/m3/s) + ) + + ! set time steps + dt = get_step_size_real() + + if (.not. use_nitrif_denitrif) then + ! set constant sf + sf = params_inst%sf + else + ! Assume that 100% of the soil NO3 is in a soluble form + sf_no3 = params_inst%sf_no3 + end if + + ! calculate the total soil water + tot_water(bounds%begc:bounds%endc) = 0._r8 + do j = 1,nlevsoi + do fc = 1,num_soilc + c = filter_soilc(fc) + tot_water(c) = tot_water(c) + h2osoi_liq(c,j) + end do + end do + + ! for runoff calculation; calculate total water to a given depth + surface_water(bounds%begc:bounds%endc) = 0._r8 + do j = 1,nlevsoi + if ( zisoi(j) <= depth_runoff_Nloss) then + do fc = 1,num_soilc + c = filter_soilc(fc) + surface_water(c) = surface_water(c) + h2osoi_liq(c,j) + end do + elseif ( zisoi(j-1) < depth_runoff_Nloss) then + do fc = 1,num_soilc + c = filter_soilc(fc) + surface_water(c) = surface_water(c) + h2osoi_liq(c,j) * ( (depth_runoff_Nloss - zisoi(j-1)) / col%dz(c,j)) + end do + endif + end do + + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + drain_tot(c) = qflx_drain(c) + end do + + + if (.not. use_nitrif_denitrif) then + + !---------------------------------------- + ! --------- NITRIF_NITRIF OFF------------ + !---------------------------------------- + + do j = 1,nlevdecomp + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_vertsoilc) then + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (tot_water(c) > 0._r8) then + disn_conc = (sf * sminn_vr(c,j) ) / tot_water(c) + end if + + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + sminn_leached_vr(c,j) = disn_conc * drain_tot(c) + else + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (h2osoi_liq(c,j) > 0._r8) then + disn_conc = (sf * sminn_vr(c,j) * col%dz(c,j) )/(h2osoi_liq(c,j) ) + end if + + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + sminn_leached_vr(c,j) = disn_conc * drain_tot(c) * h2osoi_liq(c,j) / ( tot_water(c) * col%dz(c,j) ) + + end if + + ! limit the flux based on current sminn state + ! only let at most the assumed soluble fraction + ! of sminn be leached on any given timestep + sminn_leached_vr(c,j) = min(sminn_leached_vr(c,j), (sf * sminn_vr(c,j))/dt) + + ! limit the flux to a positive value + sminn_leached_vr(c,j) = max(sminn_leached_vr(c,j), 0._r8) + + end do + end do + + else + + !---------------------------------------- + ! --------- NITRIF_NITRIF ON------------- + !---------------------------------------- + + do j = 1,nlevdecomp + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_vertsoilc) then + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (tot_water(c) > 0._r8) then + disn_conc = (sf_no3 * smin_no3_vr(c,j) )/tot_water(c) + end if + + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + smin_no3_leached_vr(c,j) = disn_conc * drain_tot(c) + else + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (h2osoi_liq(c,j) > 0._r8) then + disn_conc = (sf_no3 * smin_no3_vr(c,j) * col%dz(c,j) )/(h2osoi_liq(c,j) ) + end if + ! + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + smin_no3_leached_vr(c,j) = disn_conc * drain_tot(c) * h2osoi_liq(c,j) / ( tot_water(c) * col%dz(c,j) ) + ! + ! ensure that leaching rate isn't larger than soil N pool + smin_no3_leached_vr(c,j) = min(smin_no3_leached_vr(c,j), smin_no3_vr(c,j) / dt ) + ! + ! limit the leaching flux to a positive value + smin_no3_leached_vr(c,j) = max(smin_no3_leached_vr(c,j), 0._r8) + ! + ! + ! calculate the N loss from surface runoff, assuming a shallow mixing of surface waters into soil and removal based on runoff + if ( zisoi(j) <= depth_runoff_Nloss ) then + smin_no3_runoff_vr(c,j) = disn_conc * qflx_surf(c) * & + h2osoi_liq(c,j) / ( surface_water(c) * col%dz(c,j) ) + elseif ( zisoi(j-1) < depth_runoff_Nloss ) then + smin_no3_runoff_vr(c,j) = disn_conc * qflx_surf(c) * & + h2osoi_liq(c,j) * ((depth_runoff_Nloss - zisoi(j-1)) / & + col%dz(c,j)) / ( surface_water(c) * (depth_runoff_Nloss-zisoi(j-1) )) + else + smin_no3_runoff_vr(c,j) = 0._r8 + endif + ! + ! ensure that runoff rate isn't larger than soil N pool + smin_no3_runoff_vr(c,j) = min(smin_no3_runoff_vr(c,j), smin_no3_vr(c,j) / dt - smin_no3_leached_vr(c,j)) + ! + ! limit the flux to a positive value + smin_no3_runoff_vr(c,j) = max(smin_no3_runoff_vr(c,j), 0._r8) + + + endif + ! limit the flux based on current smin_no3 state + ! only let at most the assumed soluble fraction + ! of smin_no3 be leached on any given timestep + smin_no3_leached_vr(c,j) = min(smin_no3_leached_vr(c,j), (sf_no3 * smin_no3_vr(c,j))/dt) + + ! limit the flux to a positive value + smin_no3_leached_vr(c,j) = max(smin_no3_leached_vr(c,j), 0._r8) + + end do + end do + endif + + end associate + + end subroutine SoilBiogeochemNLeaching + +end module SoilBiogeochemNLeachingMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemPrecisionControlMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemPrecisionControlMod.F90 new file mode 100755 index 000000000..3740700ab --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemPrecisionControlMod.F90 @@ -0,0 +1,196 @@ +module SoilBiogeochemPrecisionControlMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! controls on very low values in critical state variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varpar , only : ndecomp_pools + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: SoilBiogeochemPrecisionControlInit ! Initialization + public:: SoilBiogeochemPrecisionControl ! Apply precision control to soil biogeochemistry carbon and nitrogen states + + ! !PUBLIC DATA: + real(r8), public :: ccrit ! critical carbon state value for truncation (gC/m2) + real(r8), public :: ncrit ! critical nitrogen state value for truncation (gN/m2) + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemPrecisionControlInit( soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst) + + ! + ! !DESCRIPTION: + ! Initialization of soil biogeochemistry precision control + ! + ! !USES: + use clm_varctl , only : use_c13, use_c14 + ! + ! !ARGUMENTS: + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: totvegcthresh = 1.0_r8 ! Total vegetation carbon threshold to zero out decomposition pools + !----------------------------------------------------------------------- + ccrit = 1.e-8_r8 ! critical carbon state value for truncation (gC/m2) + ncrit = 1.e-8_r8 ! critical nitrogen state value for truncation (gN/m2) + + call soilbiogeochem_carbonstate_inst%setTotVgCThresh( totvegcthresh ) + if ( use_c13 )then + call c13_soilbiogeochem_carbonstate_inst%setTotVgCThresh( totvegcthresh ) + end if + if ( use_c14 )then + call c14_soilbiogeochem_carbonstate_inst%setTotVgCThresh( totvegcthresh ) + end if + call soilbiogeochem_nitrogenstate_inst%setTotVgCThresh( totvegcthresh ) + + end subroutine SoilBiogeochemPrecisionControlInit + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & + soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst) + + ! + ! !DESCRIPTION: + ! On the radiation time step, force leaf and deadstem c and n to 0 if + ! they get too small. + ! + ! !USES: + use clm_varctl , only : iulog, use_c13, use_c14, use_nitrif_denitrif, use_cn + use clm_varpar , only : nlevdecomp + use CNSharedParamsMod, only: use_fun + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,j,k ! indices + integer :: fc ! filter indices + real(r8):: cc,cn ! truncation terms for column-level corrections + real(r8):: cc13 ! truncation terms for column-level corrections + real(r8):: cc14 ! truncation terms for column-level corrections + !----------------------------------------------------------------------- + + ! soilbiogeochem_carbonstate_inst%ctrunc_vr_col Output: [real(r8) (:,:) ] (gC/m3) column-level sink for C truncation + ! soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col Output: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + + ! soilbiogeochem_nitrogenstate_inst%ntrunc_vr_col Output: [real(r8) (:,:) ] (gN/m3) column-level sink for N truncation + ! soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col Output: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + ! soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col Output: [real(r8) (:,:) ] (gN/m3) soil mineral NH4 + ! soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col Output: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 + + associate(& + cs => soilbiogeochem_carbonstate_inst , & + ns => soilbiogeochem_nitrogenstate_inst , & + c13cs => c13_soilbiogeochem_carbonstate_inst , & + c14cs => c14_soilbiogeochem_carbonstate_inst & + ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + do j = 1,nlevdecomp + ! initialize the column-level C and N truncation terms + cc = 0._r8 + if ( use_c13 ) cc13 = 0._r8 + if ( use_c14 ) cc14 = 0._r8 + cn = 0._r8 + + ! do tests on state variables for precision control + ! for linked C-N state variables, perform precision test on + ! the C component, but truncate both C and N components + + + ! all decomposing pools C and N + do k = 1, ndecomp_pools + + if (abs(cs%decomp_cpools_vr_col(c,j,k)) < ccrit) then + cc = cc + cs%decomp_cpools_vr_col(c,j,k) + cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + + if (use_cn) then + cn = cn + ns%decomp_npools_vr_col(c,j,k) + ns%decomp_npools_vr_col(c,j,k) = 0._r8 + endif + + if ( use_c13 ) then + cc13 = cc13 + c13cs%decomp_cpools_vr_col(c,j,k) + c13cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + endif + if ( use_c14 ) then + cc14 = cc14 + c14cs%decomp_cpools_vr_col(c,j,k) + c14cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + endif + end if + + end do + + ! not doing precision control on soil mineral N, since it will + ! be getting the N truncation flux anyway. + + cs%ctrunc_vr_col(c,j) = cs%ctrunc_vr_col(c,j) + cc + + if (use_cn) then + ns%ntrunc_vr_col(c,j) = ns%ntrunc_vr_col(c,j) + cn + endif + if ( use_c13 ) then + c13cs%ctrunc_vr_col(c,j) = c13cs%ctrunc_vr_col(c,j) + cc13 + endif + if ( use_c14 ) then + c14cs%ctrunc_vr_col(c,j) = c14cs%ctrunc_vr_col(c,j) + cc14 + endif + end do + + end do ! end of column loop + + if(.not.use_fun)then + if (use_nitrif_denitrif) then + ! remove small negative perturbations for stability purposes, if any should arise. + + do fc = 1,num_soilc + c = filter_soilc(fc) + do j = 1,nlevdecomp + if (abs(ns%smin_no3_vr_col(c,j)) < ncrit/1e4_r8) then + if ( ns%smin_no3_vr_col(c,j) < 0._r8 ) then + !write(iulog, *) '-10^-12 < smin_no3 < 0. resetting to zero.' + !write(iulog, *) 'smin_no3_vr_col(c,j), c, j: ', ns%smin_no3_vr_col(c,j), c, j + ns%smin_no3_vr_col(c,j) = 0._r8 + endif + end if + if (abs(ns%smin_nh4_vr_col(c,j)) < ncrit/1e4_r8) then + if ( ns%smin_nh4_vr_col(c,j) < 0._r8 ) then + !write(iulog, *) '-10^-12 < smin_nh4 < 0. resetting to zero.' + !write(iulog, *) 'smin_nh4_vr_col(c,j), c, j: ', ns%smin_nh4_vr_col(c,j), c, j + ns%smin_nh4_vr_col(c,j) = 0._r8 + endif + end if + end do + end do + endif + endif + + end associate + + end subroutine SoilBiogeochemPrecisionControl + +end module SoilBiogeochemPrecisionControlMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index c8e8fad30..2fcfcf021 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -48,7 +48,7 @@ module clm_varpar integer, parameter, PUBLIC :: NUM_ZON=3 ! number of CN hydrology zones per tile integer, parameter, PUBLIC :: NUM_VEG=4 ! number of CN PFTs per zone integer, parameter, PUBLIC :: VAR_COL=35 ! number of CN column restart variables - integer, parameter, PUBLIC :: VAR_PFT=75 ! number of CN PFT variables per column + integer, parameter, PUBLIC :: VAR_PFT=81 ! number of CN PFT restart variables real, parameter, PUBLIC, dimension(NUM_ZON) :: CN_zone_weight = (/0.10,0.45,0.45/) ! gkw: tunable; must sum to 1 ! constants for decomposition cascade diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/filterColMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/filterColMod.F90 new file mode 100755 index 000000000..345108588 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/filterColMod.F90 @@ -0,0 +1,443 @@ +module filterColMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines a type to hold column-level filters, along with factory methods to help create + ! a column-level filter + ! + ! To loop over the filter, use code like this: + ! do fc = 1, myfilter%num + ! c = myfilter%indices(fc) + ! ... + ! end do + ! + ! !USES: +#include "shr_assert.h" + use decompMod , only : bounds_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use clm_varcon , only : ispval + use clm_varctl , only : iulog + + ! !PUBLIC TYPES: + implicit none + private + save + + type, public :: filter_col_type + integer :: num ! number of points in the filter + integer, allocatable :: indices(:) ! column indices included in the filter + contains + procedure :: equals_filter + generic :: operator(==) => equals_filter + end type filter_col_type + + ! !PUBLIC ROUTINES: + + ! Create an empty filter + public :: col_filter_empty + + ! Create a filter from an array of indices. This is mainly useful for unit testing. + public :: col_filter_from_index_array + + ! Create a filter from a column-level logical array + public :: col_filter_from_logical_array + + ! Create a filter from a column-level logical array, but including only active points + public :: col_filter_from_logical_array_active_only + + ! Create a filter that contains one or more landunit type(s) of interest + public :: col_filter_from_ltypes + + ! Create a filter from a landunit-level logical array + public :: col_filter_from_lunflags + + ! Create a filter from a gridcell-level logical array and an array of landunit type(s) + ! of interest + public :: col_filter_from_grcflags_ltypes + + ! Create a filter from another filter subset by a column-level logical array + public :: col_filter_from_filter_and_logical_array + + ! !PRIVATE ROUTINES: + + ! Whether a given column should be included in the filter based on the active flag + private :: include_based_on_active + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + ! TODO(wjs, 2016-04-07) If repeated reallocation of the indices arrays (every time a + ! filter is recreated - each time through the run loop) is a performance issue, then we + ! could rewrite the creation functions to instead be subroutines that act on an existing + ! filter object: I think this would involve replacing calls to col_filter_empty with + ! something like filter%reset_filter; this would only allocate the indices array if it + ! is not already allocated. + + !----------------------------------------------------------------------- + function col_filter_empty(bounds) result(filter) + ! + ! !DESCRIPTION: + ! Initialize a filter object + ! + ! !ARGUMENTS: + type(filter_col_type) :: filter ! function result + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'col_filter_empty' + !----------------------------------------------------------------------- + + filter%num = 0 + allocate(filter%indices(bounds%endc - bounds%begc + 1)) + + end function col_filter_empty + + !----------------------------------------------------------------------- + function col_filter_from_index_array(bounds, indices_col) result(filter) + ! + ! !DESCRIPTION: + ! Create a filter from an array of indices. + ! + ! This is mainly useful for unit testing. + ! + ! !ARGUMENTS: + type(filter_col_type) :: filter ! function result + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: indices_col(:) ! column-level array of indices to include in filter + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'col_filter_from_index_array' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL(indices_col >= bounds%begc, sourcefile, __LINE__) + SHR_ASSERT_ALL_FL(indices_col <= bounds%endc, sourcefile, __LINE__) + + filter = col_filter_empty(bounds) + + filter%num = size(indices_col) + filter%indices(1:filter%num) = indices_col + + end function col_filter_from_index_array + + + !----------------------------------------------------------------------- + function col_filter_from_logical_array(bounds, logical_col) result(filter) + ! + ! !DESCRIPTION: + ! Create a column-level filter from a column-level logical array. + ! + ! This version does not consider whether a column is active: it simply includes any + ! column 'c' for which logical_col(c) is .true. + ! + ! !ARGUMENTS: + type(filter_col_type) :: filter ! function result + type(bounds_type), intent(in) :: bounds + logical, intent(in) :: logical_col(bounds%begc:) ! column-level logical array + ! + ! !LOCAL VARIABLES: + integer :: c + + character(len=*), parameter :: subname = 'col_filter_from_logical_array' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(logical_col) == (/bounds%endc/)), sourcefile, __LINE__) + + filter = col_filter_empty(bounds) + + do c = bounds%begc, bounds%endc + if (logical_col(c)) then + filter%num = filter%num + 1 + filter%indices(filter%num) = c + end if + end do + + end function col_filter_from_logical_array + + !----------------------------------------------------------------------- + function col_filter_from_logical_array_active_only(bounds, logical_col) result(filter) + ! + ! !DESCRIPTION: + ! Create a column-level filter from a column-level logical array. Only include active + ! points in the filter: even if the logical array is true for a given column, that + ! column is excluded if it is inactive. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(filter_col_type) :: filter ! function result + type(bounds_type), intent(in) :: bounds + logical, intent(in) :: logical_col(bounds%begc:) ! column-level logical array + ! + ! !LOCAL VARIABLES: + integer :: c + + character(len=*), parameter :: subname = 'col_filter_from_logical_array_active_only' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(logical_col) == (/bounds%endc/)), sourcefile, __LINE__) + + filter = col_filter_empty(bounds) + + do c = bounds%begc, bounds%endc + if (col%active(c)) then + if (logical_col(c)) then + filter%num = filter%num + 1 + filter%indices(filter%num) = c + end if + end if + end do + + end function col_filter_from_logical_array_active_only + + + !----------------------------------------------------------------------- + function col_filter_from_ltypes(bounds, ltypes, include_inactive) & + result(filter) + ! + ! !DESCRIPTION: + ! Create a column-level filter that includes one or more landunit type(s) of interest + ! + ! !USES: + ! + ! !ARGUMENTS: + type(filter_col_type) :: filter ! function result + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: ltypes(:) ! landunit type(s) of interest + logical, intent(in) :: include_inactive ! whether inactive points should be included in the filter + ! + ! !LOCAL VARIABLES: + integer :: c + integer :: l + + character(len=*), parameter :: subname = 'col_filter_from_ltypes' + !----------------------------------------------------------------------- + + filter = col_filter_empty(bounds) + + do c = bounds%begc, bounds%endc + if (include_based_on_active(c, include_inactive)) then + l = col%landunit(c) + if (any(ltypes(:) == lun%itype(l))) then + filter%num = filter%num + 1 + filter%indices(filter%num) = c + end if + end if + end do + + end function col_filter_from_ltypes + + !----------------------------------------------------------------------- + function col_filter_from_lunflags(bounds, lunflags, include_inactive) & + result(filter) + ! + ! !DESCRIPTION: + ! Create a column-level filter from a landunit-level logical array. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(filter_col_type) :: filter ! function result + type(bounds_type), intent(in) :: bounds + logical, intent(in) :: lunflags(bounds%begl:) ! landunit-level logical array + logical, intent(in) :: include_inactive ! whether inactive points should be included in the filter + ! + ! !LOCAL VARIABLES: + integer :: c + integer :: l + + character(len=*), parameter :: subname = 'col_filter_from_lunflags' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(lunflags) == (/bounds%endl/)), sourcefile, __LINE__) + + filter = col_filter_empty(bounds) + + do c = bounds%begc, bounds%endc + if (include_based_on_active(c, include_inactive)) then + l = col%landunit(c) + if (lunflags(l)) then + filter%num = filter%num + 1 + filter%indices(filter%num) = c + end if + end if + end do + + end function col_filter_from_lunflags + + + !----------------------------------------------------------------------- + function col_filter_from_grcflags_ltypes(bounds, grcflags, ltypes, include_inactive) & + result(filter) + ! + ! !DESCRIPTION: + ! Create a column-level filter from a gridcell-level logical array and an array of + ! landunit type(s) of interest. The filter will contain all columns for which (a) + ! grcflags is true for the gridcell containing this column, and (b) the landunit type + ! for the landunit containing this column is one of the types in ltypes. + ! + ! !ARGUMENTS: + type(filter_col_type) :: filter ! function result + type(bounds_type), intent(in) :: bounds + logical, intent(in) :: grcflags(bounds%begg:) ! gridcell-level logical array + integer, intent(in) :: ltypes(:) ! landunit type(s) of interest + logical, intent(in) :: include_inactive ! whether inactive points should be included in the filter + ! + ! !LOCAL VARIABLES: + integer :: g ! gridcell index + integer :: l ! landunit index + integer :: c ! column index + integer :: i ! array index + integer :: ltype ! landunit type + + character(len=*), parameter :: subname = 'col_filter_from_grcflags_ltypes' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(grcflags) == (/bounds%endg/)), sourcefile, __LINE__) + + filter = col_filter_empty(bounds) + + ! This loops over g then l then c rather than just looping over all columns, because + ! this is likely more efficient for sparse filters (e.g., sparse grcflags or uncommon + ! ltypes). + do g = bounds%begg, bounds%endg + if (grcflags(g)) then + do i = 1, size(ltypes) + ltype = ltypes(i) + l = grc%landunit_indices(ltype, g) + if (l == ispval) then + cycle + end if + + do c = lun%coli(l), lun%colf(l) + if (include_based_on_active(c, include_inactive)) then + filter%num = filter%num + 1 + filter%indices(filter%num) = c + end if + end do ! c + end do ! i = 1, size(ltypes) + end if ! grcflags(g) + end do ! g + + end function col_filter_from_grcflags_ltypes + + !----------------------------------------------------------------------- + function col_filter_from_filter_and_logical_array(bounds, num_orig, filter_orig, logical_col) & + result(filter) + ! + ! !DESCRIPTION: + ! Create a filter from another filter subset by a column-level logical array + ! + ! !ARGUMENTS: + type(filter_col_type) :: filter ! function result + + ! Accepts separate num & indices arguments rather than a filter of filter_col_type so + ! that this function can be called with old-style filters, where these were stored + ! separately rather than being bundled together. + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_orig ! number of points in original filter + integer, intent(in) :: filter_orig(:) ! column indices in original filter + logical, intent(in) :: logical_col(bounds%begc:) ! column-level logical array + ! + ! !LOCAL VARIABLES: + integer :: fc, c + + character(len=*), parameter :: subname = 'col_filter_from_filter_and_logical_array' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(logical_col) == (/bounds%endc/)), sourcefile, __LINE__) + + filter = col_filter_empty(bounds) + + do fc = 1, num_orig + c = filter_orig(fc) + if (logical_col(c)) then + filter%num = filter%num + 1 + filter%indices(filter%num) = c + end if + end do + + end function col_filter_from_filter_and_logical_array + + + !----------------------------------------------------------------------- + pure function include_based_on_active(c, include_inactive) result(include_point) + ! + ! !DESCRIPTION: + ! Returns true if the given column should be included in a filter based on its active + ! flag + ! + ! !ARGUMENTS: + logical :: include_point ! function result + integer, intent(in) :: c ! column index + logical, intent(in) :: include_inactive ! whether inactive points are included in this filter + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'include_based_on_active' + !----------------------------------------------------------------------- + + ! This code is written to avoid the check of col%active if include_inactive is true. + ! This is needed in the case of filters that are created in initialization, before + ! the active flags are set. + if (include_inactive) then + include_point = .true. + else if (col%active(c)) then + include_point = .true. + else + include_point = .false. + end if + + end function include_based_on_active + + + !----------------------------------------------------------------------- + function equals_filter(this, other) result(equal) + ! + ! !DESCRIPTION: + ! Returns true if the two filters are equal. + ! + ! If they differ, prints some information about how they differ. + ! + ! !USES: + ! + ! !ARGUMENTS: + logical :: equal ! function result + class(filter_col_type), intent(in) :: this + class(filter_col_type), intent(in) :: other + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'equals_filter' + !----------------------------------------------------------------------- + + equal = .true. + + if (this%num /= other%num) then + equal = .false. + write(iulog,*) ' ' + write(iulog,'(a, i0, a, i0)') 'equals_filter false: Sizes differ: ', & + this%num, ' /= ', other%num + else + do i = 1, this%num + if (this%indices(i) /= other%indices(i)) then + equal = .false. + write(iulog,*) ' ' + write(iulog,'(a, i0, a, i0, a, i0)') & + 'equals_filter false: Values differ; first difference at ', & + i, ': ', this%indices(i), ' /= ', other%indices(i) + exit + end if + end do + end if + + end function equals_filter + + +end module filterColMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/perf_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/perf_mod.F90 new file mode 100644 index 000000000..4a94de41e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/perf_mod.F90 @@ -0,0 +1,98 @@ +module perf_mod + +!----------------------------------------------------------------------- +! +! Purpose: This module is responsible for controlling the performance +! timer logic. +! +! Author: P. Worley, January 2007 +! +! $Id$ +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!- Uses ---------------------------------------------------------------- +!----------------------------------------------------------------------- + + use shr_sys_mod, only: shr_sys_abort + use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CM, SHR_KIND_CX, & + SHR_KIND_R8, SHR_KIND_I8 + +!----------------------------------------------------------------------- +!- module boilerplate -------------------------------------------------- +!----------------------------------------------------------------------- + implicit none + private ! Make the default access private + save + +!----------------------------------------------------------------------- +! Public interfaces ---------------------------------------------------- +!----------------------------------------------------------------------- + public t_startf + public t_stopf + +!======================================================================= +contains +!======================================================================= +!======================================================================== +! + subroutine t_startf(event, handle) +!----------------------------------------------------------------------- +! Purpose: Start an event timer +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + ! performance timer event name + character(len=*), intent(in) :: event +! +!---------------------------Input/Output arguments---------------------- +! + ! GPTL event handle + integer, optional :: handle +! +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return + integer str_length, i ! support for adding + ! detail prefix + character(len=2) cdetail ! char variable for detail +! +!----------------------------------------------------------------------- +! + + return + end subroutine t_startf +! +!======================================================================== +! + subroutine t_stopf(event, handle) +!----------------------------------------------------------------------- +! Purpose: Stop an event timer +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + ! performance timer event name + character(len=*), intent(in) :: event +! +!---------------------------Input/Output arguments---------------------- +! + ! GPTL event handle + integer, optional :: handle +! +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return + integer str_length, i ! support for adding + ! detail prefix + character(len=2) cdetail ! char variable for detail +! +!----------------------------------------------------------------------- +! + + return + end subroutine t_stopf +! +end module perf_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/quadraticMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/quadraticMod.F90 new file mode 100755 index 000000000..87bb25094 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/quadraticMod.F90 @@ -0,0 +1,76 @@ +module quadraticMod + + use abortutils , only: endrun + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_log_mod , only: errMsg => shr_log_errMsg + use clm_varctl , only: iulog + + implicit none + + public :: quadratic + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + subroutine quadratic (a, b, c, r1, r2) + ! + ! !DESCRIPTION: + !==============================================================================! + !----------------- Solve quadratic equation for its two roots -----------------! + !==============================================================================! + ! Solution from Press et al (1986) Numerical Recipes: The Art of Scientific + ! Computing (Cambridge University Press, Cambridge), pp. 145. + ! + ! !REVISION HISTORY: + ! 4/5/10: Adapted from /home/bonan/ecm/psn/An_gs_iterative.f90 by Keith Oleson + ! + ! !USES: + implicit none + ! + ! !ARGUMENTS: + real(r8), intent(in) :: a,b,c ! Terms for quadratic equation + real(r8), intent(out) :: r1,r2 ! Roots of quadratic equation + ! + ! !LOCAL VARIABLES: + real(r8) :: q ! Temporary term for quadratic solution + real(r8) :: root ! Term that will have a square root taken + character(len=*), parameter :: subname = 'quadratic' + !------------------------------------------------------------------------------ + + if (a == 0._r8) then + write (iulog,*) subname//' ERROR: Quadratic solution error: a = ',a + write (iulog,*) errmsg(sourcefile, __LINE__) + call endrun(msg=subname//' ERROR: Quadratic solution error' ) + return + end if + + root = b*b - 4._r8*a*c + if ( root < 0.0 )then + if ( -root < 3.0_r8*epsilon(b) )then + root = 0.0_r8 + else + write (iulog,*) subname//' ERROR: Quadratic solution error: b^2 - 4ac is negative = ', root + write (iulog,*) errmsg(sourcefile, __LINE__) + call endrun( msg=subname//' ERROR: Quadratic solution error: b^2 - 4ac is negative' ) + return + end if + end if + + if (b >= 0._r8) then + q = -0.5_r8 * (b + sqrt(root)) + else + q = -0.5_r8 * (b - sqrt(root)) + end if + + r1 = q / a + if (q /= 0._r8) then + r2 = c / q + else + r2 = 1.e36_r8 + end if + + end subroutine quadratic + +end module quadraticMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h new file mode 100755 index 000000000..b09e0d127 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h @@ -0,0 +1,22 @@ +#ifdef NDEBUG +#define SHR_ASSERT(assert, msg) +#define SHR_ASSERT_FL(assert, file, line) +#define SHR_ASSERT_MFL(assert, msg, file, line) +#define SHR_ASSERT_ALL(assert, msg) +#define SHR_ASSERT_ALL_FL(assert, file, line) +#define SHR_ASSERT_ALL_MFL(assert, msg, file, line) +#define SHR_ASSERT_ANY(assert, msg) +#define SHR_ASSERT_ANY_FL(assert, file, line) +#define SHR_ASSERT_ANY_MFL(assert, msg, file, line) +#else +#define SHR_ASSERT(assert, my_msg) call shr_assert(assert, msg=my_msg) +#define SHR_ASSERT_FL(assert, my_file, my_line) call shr_assert(assert, file=my_file, line=my_line) +#define SHR_ASSERT_MFL(assert, my_msg, my_file, my_line) call shr_assert(assert, msg=my_msg, file=my_file, line=my_line) +#define SHR_ASSERT_ALL(assert, my_msg) call shr_assert_all(assert, msg=my_msg) +#define SHR_ASSERT_ALL_FL(assert, my_file, my_line) call shr_assert_all(assert, file=my_file, line=my_line) +#define SHR_ASSERT_ALL_MFL(assert, my_msg, my_file, my_line) call shr_assert_all(assert, msg=my_msg, file=my_file, line=my_line) +#define SHR_ASSERT_ANY(assert, my_msg) call shr_assert_any(assert, msg=my_msg) +#define SHR_ASSERT_ANY_FL(assert, my_file, my_line) call shr_assert_any(assert, file=my_file, line=my_line) +#define SHR_ASSERT_ANY_MFL(assert, my_msg, my_file, my_line) call shr_assert_any(assert, msg=my_msg, file=my_file, line=my_line) +#endif +use shr_assert_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in new file mode 100755 index 000000000..b47494050 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in @@ -0,0 +1,438 @@ +module shr_assert_mod + +! Assert subroutines for common debugging operations. + +use shr_kind_mod, only: & + r4 => shr_kind_r4, & + r8 => shr_kind_r8, & + i4 => shr_kind_i4, & + i8 => shr_kind_i8 + +use shr_sys_mod, only: & + shr_sys_abort + +use shr_log_mod, only: & + shr_log_Unit + +use shr_infnan_mod, only: shr_infnan_isnan + +!use shr_strconvert_mod, only: toString + +implicit none +private +save + +! Assert that a logical is true. +public :: shr_assert +public :: shr_assert_all +public :: shr_assert_any + +! Assert that a numerical value satisfies certain constraints. +public :: shr_assert_in_domain + +interface shr_assert_all + module procedure shr_assert + ! DIMS 1,2,3,4,5,6,7 + module procedure shr_assert_all_{DIMS}d +end interface + +interface shr_assert_any + module procedure shr_assert + ! DIMS 1,2,3,4,5,6,7 + module procedure shr_assert_any_{DIMS}d +end interface + +interface shr_assert_in_domain + ! TYPE double,real,int,long + ! DIMS 0,1,2,3,4,5,6,7 + module procedure shr_assert_in_domain_{DIMS}d_{TYPE} +end interface + +! Private utilities. + +interface print_bad_loc + ! TYPE double,real,int,long + ! DIMS 0,1,2,3,4,5,6,7 + module procedure print_bad_loc_{DIMS}d_{TYPE} +end interface + +interface find_first_loc + ! DIMS 0,1,2,3,4,5,6,7 + module procedure find_first_loc_{DIMS}d +end interface + +interface within_tolerance + ! TYPE double,real,int,long + module procedure within_tolerance_{TYPE} +end interface + +contains + +subroutine shr_assert(var, msg, file, line) + + ! Logical being asserted + logical, intent(in) :: var + ! Optional error message if assert fails + character(len=*), intent(in), optional :: msg + ! Optional file and line of the caller, written out if given + ! (line is ignored if file is absent) + character(len=*), intent(in), optional :: file + integer , intent(in), optional :: line + + character(len=40) :: line_str + character(len=:), allocatable :: full_msg + + full_msg = '' + if (.not. var) then + full_msg = 'ERROR' + if (present(file)) then + full_msg = full_msg // ' in ' // trim(file) + if (present(line)) then + write(line_str, '(i40)') line + full_msg = full_msg // ' at line ' // trim(line_str) + end if + end if + if (present(msg)) then + full_msg = full_msg // ': ' // msg + end if + call shr_sys_abort(full_msg) + end if + +end subroutine shr_assert + +! DIMS 1,2,3,4,5,6,7 +subroutine shr_assert_all_{DIMS}d(var, msg, file, line) + + ! Logical being asserted + logical, intent(in) :: var{DIMSTR} + ! Optional error message if assert fails + character(len=*), intent(in), optional :: msg + ! Optional file and line of the caller, written out if given + ! (line is ignored if file is absent) + character(len=*), intent(in), optional :: file + integer , intent(in), optional :: line + + call shr_assert(all(var), msg=msg, file=file, line=line) + +end subroutine shr_assert_all_{DIMS}d + +! DIMS 1,2,3,4,5,6,7 +subroutine shr_assert_any_{DIMS}d(var, msg, file, line) + + ! Logical being asserted + logical, intent(in) :: var{DIMSTR} + ! Optional error message if assert fails + character(len=*), intent(in), optional :: msg + ! Optional file and line of the caller, written out if given + ! (line is ignored if file is absent) + character(len=*), intent(in), optional :: file + integer , intent(in), optional :: line + + call shr_assert(any(var), msg=msg, file=file, line=line) + +end subroutine shr_assert_any_{DIMS}d + +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- + +! TYPE double,real,int,long +! DIMS 0,1,2,3,4,5,6,7 +subroutine shr_assert_in_domain_{DIMS}d_{TYPE}(var, varname, msg, & + is_nan, lt, gt, le, ge, eq, ne, abs_tol) + +!----------------------------- +! BEGIN defining local macros +!----------------------------- + +! Flag for floating point types. + +#if ({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE) +#define TYPEFP +#else +#undef TYPEFP +#endif + +! "Generalized" macro functions allow transformational intrinsic functions +! to handle both scalars and arrays. + +#if ({DIMS} != 0) +! When given an array, use the intrinsics. +#define GEN_SIZE(x) size(x) +#define GEN_ALL(x) all(x) +#else + +! Scalar extensions: +! GEN_SIZE always returns 1 for a scalar. +! GEN_ALL (logical reduction) is a no-op for a scalar. +! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. +#define GEN_SIZE(x) 1 +#define GEN_ALL(x) x + +#endif + +!----------------------------- +! END macro section +!----------------------------- + + ! Variable being checked. + {VTYPE}, intent(in) :: var{DIMSTR} + ! Variable name to be used in error messages. + character(len=*), intent(in), optional :: varname + ! Optional error message if assert fails. + character(len=*), intent(in), optional :: msg + ! Assert that the variable is not (or is) NaN. + logical, intent(in), optional :: is_nan + ! Limits for (in)equalities. + {VTYPE}, intent(in), optional :: lt + {VTYPE}, intent(in), optional :: gt + {VTYPE}, intent(in), optional :: le + {VTYPE}, intent(in), optional :: ge + {VTYPE}, intent(in), optional :: eq + {VTYPE}, intent(in), optional :: ne + {VTYPE}, intent(in), optional :: abs_tol + + ! Note that the following array is size 0 for scalars. + integer :: loc_vec({DIMS}) + + logical :: is_nan_passed + logical :: lt_passed + logical :: gt_passed + logical :: le_passed + logical :: ge_passed + logical :: eq_passed + logical :: ne_passed + + {VTYPE} :: abs_tol_loc + + ! Handling of abs_tol makes a couple of fairly safe assumptions. + ! 1. It is not the most negative integer. + ! 2. It is finite (not a floating point infinity or NaN). + if (present(abs_tol)) then + abs_tol_loc = abs(abs_tol) + else + abs_tol_loc = 0_i4 + end if + + is_nan_passed = .true. + lt_passed = .true. + gt_passed = .true. + le_passed = .true. + ge_passed = .true. + eq_passed = .true. + ne_passed = .true. + + ! Do one pass just to find out if we can return with no problem. + +#ifdef TYPEFP + ! Only floating-point values can actually be Inf/NaN. + if (present(is_nan)) & + is_nan_passed = GEN_ALL(shr_infnan_isnan(var) .eqv. is_nan) +#else + if (present(is_nan)) & + is_nan_passed = .not. is_nan .or. GEN_SIZE(var) == 0 +#endif + + if (present(lt)) & + lt_passed = GEN_ALL(var < lt) + + if (present(gt)) & + gt_passed = GEN_ALL(var > gt) + + if (present(le)) & + le_passed = GEN_ALL(var <= le) + + if (present(ge)) & + ge_passed = GEN_ALL(var >= ge) + + if (present(eq)) then + eq_passed = GEN_ALL(within_tolerance(eq, var, abs_tol_loc)) + end if + + if (present(ne)) then + ne_passed = GEN_ALL(.not. within_tolerance(ne, var, abs_tol_loc)) + end if + + if ( is_nan_passed .and. & + lt_passed .and. & + gt_passed .and. & + le_passed .and. & + ge_passed .and. & + eq_passed .and. & + ne_passed) & + return + + ! If we got here, assert will fail, so find out where so that we + ! can try to print something useful. + + if (.not. is_nan_passed) then +#ifdef TYPEFP + loc_vec = find_first_loc(shr_infnan_isnan(var) .neqv. is_nan) + call print_bad_loc(var, loc_vec, varname) + if (is_nan) then + write(shr_log_Unit,*) "Expected value to be NaN." + else + write(shr_log_Unit,*) "Expected value to be a number." + end if +#else + loc_vec = spread(1,1,{DIMS}) + call print_bad_loc(var, loc_vec, varname) + if (is_nan) then + write(shr_log_Unit,*) & + "Asserted NaN, but the variable is not floating-point!" + end if +#endif + end if + + if (.not. lt_passed) then + loc_vec = find_first_loc(var >= lt) + call print_bad_loc(var, loc_vec, varname) + write(shr_log_Unit,*) "Expected value to be less than ",lt + end if + + if (.not. gt_passed) then + loc_vec = find_first_loc(var <= gt) + call print_bad_loc(var, loc_vec, varname) + write(shr_log_Unit,*) "Expected value to be greater than ",gt + end if + + if (.not. le_passed) then + loc_vec = find_first_loc(var > le) + call print_bad_loc(var, loc_vec, varname) + write(shr_log_Unit,*) "Expected value to be less than or & + &equal to ",le + end if + + if (.not. ge_passed) then + loc_vec = find_first_loc(var < ge) + call print_bad_loc(var, loc_vec, varname) + write(shr_log_Unit,*) "Expected value to be greater than or & + &equal to ",ge + end if + + if (.not. eq_passed) then + loc_vec = find_first_loc(.not. within_tolerance(eq, var, abs_tol_loc)) + call print_bad_loc(var, loc_vec, varname) + write(shr_log_Unit,*) "Expected value to be equal to ",eq + if (abs_tol_loc > 0) & + write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc + end if + + if (.not. ne_passed) then + loc_vec = find_first_loc(within_tolerance(ne, var, abs_tol_loc)) + call print_bad_loc(var, loc_vec, varname) + write(shr_log_Unit,*) "Expected value to never be equal to ",ne + if (abs_tol_loc > 0) & + write(shr_log_Unit,*) "Asserted with tolerance ", abs_tol_loc + end if + + call shr_sys_abort(msg) + +! Undefine local macros. +#undef TYPEFP +#undef GEN_SIZE +#undef GEN_ALL + +end subroutine shr_assert_in_domain_{DIMS}d_{TYPE} + +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- + +! TYPE double,real,int,long +! DIMS 0,1,2,3,4,5,6,7 +subroutine print_bad_loc_{DIMS}d_{TYPE}(var, loc_vec, varname) + ! Print information about a bad location in an variable. + ! For scalars, just print value. + + {VTYPE}, intent(in) :: var{DIMSTR} + integer, intent(in) :: loc_vec({DIMS}) + + character(len=*), intent(in), optional :: varname + + character(len=:), allocatable :: varname_to_write + + if (present(varname)) then + allocate(varname_to_write, source=varname) + else + allocate(varname_to_write, source="input variable") + end if + + write(shr_log_Unit,*) & + "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & + " has invalid value ", & +#if ({DIMS} != 0) + var({REPEAT:loc_vec(#)}), & + " at location: ",loc_vec +#else + var + + ! Kill compiler spam for unused loc_vec. + if (.false.) write(*,*) loc_vec +#endif + +end subroutine print_bad_loc_{DIMS}d_{TYPE} + +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- + +! DIMS 0,1,2,3,4,5,6,7 +pure function find_first_loc_{DIMS}d(mask) result (loc_vec) + ! Inefficient but simple subroutine for finding the location of + ! the first .true. value in an array. + ! If no true values, returns first value. + + logical, intent(in) :: mask{DIMSTR} + integer :: loc_vec({DIMS}) + +#if ({DIMS} != 0) + integer :: flags({REPEAT:size(mask,#)}) + + where (mask) + flags = 1 + elsewhere + flags = 0 + end where + + loc_vec = maxloc(flags) +#else + +! Remove compiler warnings (statement will be optimized out). + +#if (! defined CPRPGI && ! defined CPRCRAY) + if (.false. .and. mask) loc_vec = loc_vec +#endif + +#endif + +end function find_first_loc_{DIMS}d + +! TYPE double,real,int,long +elemental function within_tolerance_{TYPE}(expected, actual, tolerance) & + result(is_in_tol) + ! Precondition: tolerance must be >= 0. + {VTYPE}, intent(in) :: expected + {VTYPE}, intent(in) :: actual + {VTYPE}, intent(in) :: tolerance + logical :: is_in_tol + + ! The following conditionals are to ensure that we don't overflow. + + ! This takes care of two identical infinities. + if (actual == expected) then + is_in_tol = .true. + else if (actual > expected) then + if (expected >= 0) then + is_in_tol = (actual - expected) <= tolerance + else + is_in_tol = actual <= (expected + tolerance) + end if + else + if (expected < 0) then + is_in_tol = (expected - actual) <= tolerance + else + is_in_tol = actual >= (expected - tolerance) + end if + end if + +end function within_tolerance_{TYPE} + +end module shr_assert_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in new file mode 100755 index 000000000..992c46fc9 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in @@ -0,0 +1,406 @@ +! Flag representing compiler support of Fortran 2003's +! ieee_arithmetic intrinsic module. +#if defined CPRIBM || defined CPRPGI || defined CPRINTEL || defined CPRCRAY || defined CPRNAG +#define HAVE_IEEE_ARITHMETIC +#endif + +module shr_infnan_mod +!--------------------------------------------------------------------- +! Module to test for IEEE Inf and NaN values, which also provides a +! method of setting +/-Inf and signaling or quiet NaN. +! +! All functions are elemental, and thus work on arrays. +!--------------------------------------------------------------------- +! To test for these values, just call the corresponding function, e.g: +! +! var_is_nan = shr_infnan_isnan(x) +! +! You can also use it on arrays: +! +! array_contains_nan = any(shr_infnan_isnan(my_array)) +! +!--------------------------------------------------------------------- +! To generate these values, assign one of the provided derived-type +! variables to a real: +! +! use shr_infnan_mod, only: nan => shr_infnan_nan, & +! inf => shr_infnan_inf, & +! assignment(=) +! real(r4) :: my_nan +! real(r8) :: my_inf_array(2,2) +! my_nan = nan +! my_inf_array = inf +! +! Keep in mind that "shr_infnan_nan" and "shr_infnan_inf" cannot be +! passed to functions that expect real arguments. To pass a real +! NaN, you will have to use shr_infnan_nan to set a local real of +! the correct kind. +!--------------------------------------------------------------------- + +use shr_kind_mod, only: & + r4 => SHR_KIND_R4, & + r8 => SHR_KIND_R8 + +#ifdef HAVE_IEEE_ARITHMETIC + +! If we have IEEE_ARITHMETIC, the NaN test is provided for us. +use, intrinsic :: ieee_arithmetic, only: & + shr_infnan_isnan => ieee_is_nan + +#else + +! Integers of correct size for bit patterns below. +use shr_kind_mod, only: i4 => shr_kind_i4, i8 => shr_kind_i8 + +#endif + +implicit none +private +save + +! Test functions for NaN/Inf values. +public :: shr_infnan_isnan +public :: shr_infnan_isinf +public :: shr_infnan_isposinf +public :: shr_infnan_isneginf + +! Locally defined isnan. +#ifndef HAVE_IEEE_ARITHMETIC +interface shr_infnan_isnan + ! TYPE double,real + module procedure shr_infnan_isnan_{TYPE} +end interface +#endif + +interface shr_infnan_isinf + ! TYPE double,real + module procedure shr_infnan_isinf_{TYPE} +end interface + +interface shr_infnan_isposinf + ! TYPE double,real + module procedure shr_infnan_isposinf_{TYPE} +end interface + +interface shr_infnan_isneginf + ! TYPE double,real + module procedure shr_infnan_isneginf_{TYPE} +end interface + +! Derived types for generation of NaN/Inf +! Even though there's no reason to "use" the types directly, some compilers +! might have trouble with an object being used without its type. +public :: shr_infnan_nan_type +public :: shr_infnan_inf_type +public :: assignment(=) +public :: shr_infnan_to_r4 +public :: shr_infnan_to_r8 + +! Type representing Not A Number. +type :: shr_infnan_nan_type + logical :: quiet = .false. +end type shr_infnan_nan_type + +! Type representing +/-Infinity. +type :: shr_infnan_inf_type + logical :: positive = .true. +end type shr_infnan_inf_type + +! Allow assigning reals to NaN or Inf. +interface assignment(=) + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 + module procedure set_nan_{DIMS}d_{TYPE} + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 + module procedure set_inf_{DIMS}d_{TYPE} +end interface + +! Conversion functions. +interface shr_infnan_to_r8 + module procedure nan_r8 + module procedure inf_r8 +end interface + +interface shr_infnan_to_r4 + module procedure nan_r4 + module procedure inf_r4 +end interface + +! Initialize objects of NaN/Inf type for other modules to use. + +! Default NaN is signaling, but also provide snan and qnan to choose +! explicitly. +type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & + shr_infnan_nan_type(.false.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & + shr_infnan_nan_type(.false.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & + shr_infnan_nan_type(.true.) + +! Default Inf is positive, but provide posinf to go with neginf. +type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & + shr_infnan_inf_type(.true.) +type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & + shr_infnan_inf_type(.true.) +type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & + shr_infnan_inf_type(.false.) + +! Bit patterns for implementation without ieee_arithmetic. +! Note that in order to satisfy gfortran's range check, we have to use +! ibset to set the sign bit from a BOZ pattern. +#ifndef HAVE_IEEE_ARITHMETIC +! Single precision. +integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) +integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) +integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) +integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) +! Double precision. +integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) +integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) +integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) +integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) +#endif + +contains + +!--------------------------------------------------------------------- +! TEST FUNCTIONS +!--------------------------------------------------------------------- +! The "isinf" function simply calls "isposinf" and "isneginf". +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) + {VTYPE}, intent(in) :: x + logical :: isinf + + isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) + +end function shr_infnan_isinf_{TYPE} + +#ifdef HAVE_IEEE_ARITHMETIC + +!--------------------------------------------------------------------- +! The "isposinf" and "isneginf" functions get the IEEE class of a +! real, and test to see if the class is equal to ieee_positive_inf +! or ieee_negative_inf. +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) + use, intrinsic :: ieee_arithmetic, only: & + ieee_class, & + ieee_positive_inf, & + operator(==) + {VTYPE}, intent(in) :: x + logical :: isposinf + + isposinf = (ieee_positive_inf == ieee_class(x)) + +end function shr_infnan_isposinf_{TYPE} + +! TYPE double,real +elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) + use, intrinsic :: ieee_arithmetic, only: & + ieee_class, & + ieee_negative_inf, & + operator(==) + {VTYPE}, intent(in) :: x + logical :: isneginf + + isneginf = (ieee_negative_inf == ieee_class(x)) + +end function shr_infnan_isneginf_{TYPE} + +#else +! Don't have ieee_arithmetic. + +#ifdef CPRGNU +! NaN testing on gfortran. +! TYPE double,real +elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) + {VTYPE}, intent(in) :: x + logical :: is_nan + + is_nan = isnan(x) + +end function shr_infnan_isnan_{TYPE} +! End GNU section. +#endif + +!--------------------------------------------------------------------- +! The "isposinf" and "isneginf" functions just test against a known +! bit pattern if we don't have ieee_arithmetic. +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) + {VTYPE}, intent(in) :: x + logical :: isposinf +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: posinf_pat = sposinf_pat +#else + integer(i8), parameter :: posinf_pat = dposinf_pat +#endif + + isposinf = (x == transfer(posinf_pat,x)) + +end function shr_infnan_isposinf_{TYPE} + +! TYPE double,real +elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) + {VTYPE}, intent(in) :: x + logical :: isneginf +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: neginf_pat = sneginf_pat +#else + integer(i8), parameter :: neginf_pat = dneginf_pat +#endif + + isneginf = (x == transfer(neginf_pat,x)) + +end function shr_infnan_isneginf_{TYPE} + +! End ieee_arithmetic conditional. +#endif + +!--------------------------------------------------------------------- +! GENERATION FUNCTIONS +!--------------------------------------------------------------------- +! Two approaches for generation of NaN and Inf values: +! 1. With Fortran 2003, use the ieee_value intrinsic to get a value +! from the corresponding class. These are: +! - ieee_signaling_nan +! - ieee_quiet_nan +! - ieee_positive_inf +! - ieee_negative_inf +! 2. Without Fortran 2003, set the IEEE bit patterns directly. +! Use BOZ literals to get an integer with the correct bit +! pattern, then use "transfer" to transfer those bits into a +! real. +!--------------------------------------------------------------------- + +! TYPE double,real +! DIMS 0,1,2,3,4,5,6,7 +pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) +#ifdef HAVE_IEEE_ARITHMETIC + use, intrinsic :: ieee_arithmetic, only: & + ieee_signaling_nan, & + ieee_quiet_nan, & + ieee_value +#else +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: snan_pat = ssnan_pat + integer(i4), parameter :: qnan_pat = sqnan_pat +#else + integer(i8), parameter :: snan_pat = dsnan_pat + integer(i8), parameter :: qnan_pat = dqnan_pat +#endif +#endif + {VTYPE}, intent(out) :: output{DIMSTR} + type(shr_infnan_nan_type), intent(in) :: nan + + ! Use scalar temporary for performance reasons, to reduce the cost of + ! the ieee_value call. + {VTYPE} :: tmp + +#ifdef HAVE_IEEE_ARITHMETIC + if (nan%quiet) then + tmp = ieee_value(tmp, ieee_quiet_nan) + else + tmp = ieee_value(tmp, ieee_signaling_nan) + end if +#else + if (nan%quiet) then + tmp = transfer(qnan_pat, tmp) + else + tmp = transfer(snan_pat, tmp) + end if +#endif + + output = tmp + +end subroutine set_nan_{DIMS}d_{TYPE} + +! TYPE double,real +! DIMS 0,1,2,3,4,5,6,7 +pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) +#ifdef HAVE_IEEE_ARITHMETIC + use, intrinsic :: ieee_arithmetic, only: & + ieee_positive_inf, & + ieee_negative_inf, & + ieee_value +#else +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: posinf_pat = sposinf_pat + integer(i4), parameter :: neginf_pat = sneginf_pat +#else + integer(i8), parameter :: posinf_pat = dposinf_pat + integer(i8), parameter :: neginf_pat = dneginf_pat +#endif +#endif + {VTYPE}, intent(out) :: output{DIMSTR} + type(shr_infnan_inf_type), intent(in) :: inf + + ! Use scalar temporary for performance reasons, to reduce the cost of + ! the ieee_value call. + {VTYPE} :: tmp + +#ifdef HAVE_IEEE_ARITHMETIC + if (inf%positive) then + tmp = ieee_value(tmp,ieee_positive_inf) + else + tmp = ieee_value(tmp,ieee_negative_inf) + end if +#else + if (inf%positive) then + tmp = transfer(posinf_pat, tmp) + else + tmp = transfer(neginf_pat, tmp) + end if +#endif + + output = tmp + +end subroutine set_inf_{DIMS}d_{TYPE} + +!--------------------------------------------------------------------- +! CONVERSION INTERFACES. +!--------------------------------------------------------------------- +! Function methods to get reals from nan/inf types. +!--------------------------------------------------------------------- + +pure function nan_r8(nan) result(output) + class(shr_infnan_nan_type), intent(in) :: nan + real(r8) :: output + + output = nan + +end function nan_r8 + +pure function nan_r4(nan) result(output) + class(shr_infnan_nan_type), intent(in) :: nan + real(r4) :: output + + output = nan + +end function nan_r4 + +pure function inf_r8(inf) result(output) + class(shr_infnan_inf_type), intent(in) :: inf + real(r8) :: output + + output = inf + +end function inf_r8 + +pure function inf_r4(inf) result(output) + class(shr_infnan_inf_type), intent(in) :: inf + real(r4) :: output + + output = inf + +end function inf_r4 + +end module shr_infnan_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 index 6bac019c1..6012cccb2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 @@ -51,10 +51,10 @@ module subgridAveMod ! module procedure c2l_1d ! module procedure c2l_2d ! end interface -! interface c2g -! module procedure c2g_1d -! module procedure c2g_2d -! end interface + interface c2g + module procedure c2g_1d + module procedure c2g_2d + end interface ! interface l2g ! module procedure l2g_1d ! module procedure l2g_2d @@ -941,209 +941,209 @@ end subroutine p2c_2d_filter ! end subroutine c2l_2d ! ! !----------------------------------------------------------------------- -! subroutine c2g_1d(bounds, carr, garr, c2l_scale_type, l2g_scale_type) -! ! -! ! !DESCRIPTION: -! ! Perfrom subgrid-average from columns to gridcells. -! ! Averaging is only done for points that are not equal to "spval". -! ! -! ! !ARGUMENTS: -! type(bounds_type), intent(in) :: bounds -! real(r8), intent(in) :: carr( bounds%begc: ) ! input column array -! real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array -! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) -! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging -! ! -! ! !LOCAL VARIABLES: -! integer :: c,l,g,index ! indices -! logical :: found ! temporary for error check -! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor -! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor -! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights -! !------------------------------------------------------------------------ -! -! ! Enforce expected array sizes -! SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc/)), sourcefile, __LINE__) -! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg/)), sourcefile, __LINE__) -! -! call build_scale_l2g(bounds, l2g_scale_type, & -! scale_l2g(bounds%begl:bounds%endl)) -! -! if (c2l_scale_type == 'unity') then -! do c = bounds%begc,bounds%endc -! scale_c2l(c) = 1.0_r8 -! end do -! else if (c2l_scale_type == 'urbanf') then -! do c = bounds%begc,bounds%endc -! l = col%landunit(c) -! if (lun%urbpoi(l)) then -! if (col%itype(c) == icol_sunwall) then -! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) -! else if (col%itype(c) == icol_shadewall) then -! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) -! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then -! scale_c2l(c) = 3.0_r8 -! else if (col%itype(c) == icol_roof) then -! scale_c2l(c) = 1.0_r8 -! end if -! else -! scale_c2l(c) = 1.0_r8 -! end if -! end do -! else if (c2l_scale_type == 'urbans') then -! do c = bounds%begc,bounds%endc -! l = col%landunit(c) -! if (lun%urbpoi(l)) then -! if (col%itype(c) == icol_sunwall) then -! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_shadewall) then -! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then -! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_roof) then -! scale_c2l(c) = 1.0_r8 -! end if -! else -! scale_c2l(c) = 1.0_r8 -! end if -! end do -! else -! write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported' -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if -! -! garr(bounds%begg : bounds%endg) = spval -! sumwt(bounds%begg : bounds%endg) = 0._r8 -! do c = bounds%begc,bounds%endc -! if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then -! l = col%landunit(c) -! if (carr(c) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then -! g = col%gridcell(c) -! if (sumwt(g) == 0._r8) garr(g) = 0._r8 -! garr(g) = garr(g) + carr(c) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c) -! sumwt(g) = sumwt(g) + col%wtgcell(c) -! end if -! end if -! end do -! found = .false. -! do g = bounds%begg, bounds%endg -! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then -! found = .true. -! index = g -! else if (sumwt(g) /= 0._r8) then -! garr(g) = garr(g)/sumwt(g) -! end if -! end do -! if (found) then -! write(iulog,*)'c2g_1d error: sumwt is greater than 1.0 at g= ',index -! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) -! end if -! -! end subroutine c2g_1d -! -! !----------------------------------------------------------------------- -! subroutine c2g_2d(bounds, num2d, carr, garr, c2l_scale_type, l2g_scale_type) -! ! -! ! !DESCRIPTION: -! ! Perfrom subgrid-average from columns to gridcells. -! ! Averaging is only done for points that are not equal to "spval". -! ! -! ! !ARGUMENTS: -! type(bounds_type), intent(in) :: bounds -! integer , intent(in) :: num2d ! size of second dimension -! real(r8), intent(in) :: carr( bounds%begc: , 1: ) ! input column array -! real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array -! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) -! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging -! ! -! ! !LOCAL VARIABLES: -! integer :: j,c,g,l,index ! indices -! logical :: found ! temporary for error check -! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor -! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor -! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights -! !------------------------------------------------------------------------ -! -! ! Enforce expected array sizes -! SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc, num2d/)), sourcefile, __LINE__) -! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg, num2d/)), sourcefile, __LINE__) -! -! call build_scale_l2g(bounds, l2g_scale_type, & -! scale_l2g(bounds%begl:bounds%endl)) -! -! if (c2l_scale_type == 'unity') then -! do c = bounds%begc,bounds%endc -! scale_c2l(c) = 1.0_r8 -! end do -! else if (c2l_scale_type == 'urbanf') then -! do c = bounds%begc,bounds%endc -! l = col%landunit(c) -! if (lun%urbpoi(l)) then -! if (col%itype(c) == icol_sunwall) then -! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) -! else if (col%itype(c) == icol_shadewall) then -! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) -! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then -! scale_c2l(c) = 3.0_r8 -! else if (col%itype(c) == icol_roof) then -! scale_c2l(c) = 1.0_r8 -! end if -! else -! scale_c2l(c) = 1.0_r8 -! end if -! end do -! else if (c2l_scale_type == 'urbans') then -! do c = bounds%begc,bounds%endc -! l = col%landunit(c) -! if (lun%urbpoi(l)) then -! if (col%itype(c) == icol_sunwall) then -! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_shadewall) then -! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then -! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_roof) then -! scale_c2l(c) = 1.0_r8 -! end if -! else -! scale_c2l(c) = 1.0_r8 -! end if -! end do -! else -! write(iulog,*)'c2g_2d error: scale type ',c2l_scale_type,' not supported' -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if -! -! garr(bounds%begg : bounds%endg,:) = spval -! do j = 1,num2d -! sumwt(bounds%begg : bounds%endg) = 0._r8 -! do c = bounds%begc,bounds%endc -! if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then -! l = col%landunit(c) -! if (carr(c,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then -! g = col%gridcell(c) -! if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 -! garr(g,j) = garr(g,j) + carr(c,j) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c) -! sumwt(g) = sumwt(g) + col%wtgcell(c) -! end if -! end if -! end do -! found = .false. -! do g = bounds%begg, bounds%endg -! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then -! found = .true. -! index = g -! else if (sumwt(g) /= 0._r8) then -! garr(g,j) = garr(g,j)/sumwt(g) -! end if -! end do -! if (found) then -! write(iulog,*)'c2g_2d error: sumwt is greater than 1.0 at g= ',index -! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) -! end if -! end do -! -! end subroutine c2g_2d + subroutine c2g_1d(bounds, carr, garr, c2l_scale_type, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from columns to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: carr( bounds%begc: ) ! input column array + real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: c,l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg/)), sourcefile, __LINE__) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + garr(bounds%begg : bounds%endg) = spval + sumwt(bounds%begg : bounds%endg) = 0._r8 + do c = bounds%begc,bounds%endc + if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then + l = col%landunit(c) + if (carr(c) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = col%gridcell(c) + if (sumwt(g) == 0._r8) garr(g) = 0._r8 + garr(g) = garr(g) + carr(c) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c) + sumwt(g) = sumwt(g) + col%wtgcell(c) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g) = garr(g)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'c2g_1d error: sumwt is greater than 1.0 at g= ',index + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) + end if + + end subroutine c2g_1d + + !----------------------------------------------------------------------- + subroutine c2g_2d(bounds, num2d, carr, garr, c2l_scale_type, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from columns to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: carr( bounds%begc: , 1: ) ! input column array + real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: j,c,g,l,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(carr) == (/bounds%endc, num2d/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg, num2d/)), sourcefile, __LINE__) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + garr(bounds%begg : bounds%endg,:) = spval + do j = 1,num2d + sumwt(bounds%begg : bounds%endg) = 0._r8 + do c = bounds%begc,bounds%endc + if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then + l = col%landunit(c) + if (carr(c,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = col%gridcell(c) + if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 + garr(g,j) = garr(g,j) + carr(c,j) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c) + sumwt(g) = sumwt(g) + col%wtgcell(c) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g,j) = garr(g,j)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'c2g_2d error: sumwt is greater than 1.0 at g= ',index + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) + end if + end do + + end subroutine c2g_2d ! ! !----------------------------------------------------------------------- ! subroutine l2g_1d(bounds, larr, garr, l2g_scale_type) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 2998aef4f..6be76ee9f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -1846,6 +1846,16 @@ subroutine SetServices ( GC, RC ) RESTART = MAPL_RestartOptional ,& RC=STATUS ) VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = '5-day running mean of CN sum for snow depth',& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZM5D' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for area snow cover',& @@ -1866,6 +1876,37 @@ subroutine SetServices ( GC, RC ) RESTART = MAPL_RestartOptional ,& RC=STATUS ) VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = '10-day running mean of ground temperature',& + UNITS = 'K' ,& + SHORT_NAME = 'TG10D' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = '5-day running mean of daily minimum 2-m temperature',& + UNITS = 'K' ,& + SHORT_NAME = 'T2MMIN5D' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = '30-day running mean of surface relative humidity',& + UNITS = '%' ,& + SHORT_NAME = 'RH30D' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddInternalSpec(GC ,& LONG_NAME = '10-day running mean of total precipitation',& @@ -4186,8 +4227,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start=.true.) - call get_CN_LAI(nt,nveg,nzone,ityp,fveg,elai,esai=esai) + call CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start=.true.) + call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif @@ -4201,8 +4242,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! obtain LAI from previous time step (from CN model) ! -------------------------------------------------- - call get_CN_LAI(nt,nveg,nzone,ityp,fveg,elai,esai=esai,tlai=tlai) - + call get_CN_LAI(nt,ityp,fveg,elai,esai=esai,tlai=tlai) + lai1 = 0. wght = 0. do nz = 1,nzone @@ -4673,8 +4714,6 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: ar1m real, dimension(:), pointer :: tpm real, dimension(:), pointer :: cnsum - real, dimension(:,:,:), pointer :: psnsunm - real, dimension(:,:,:), pointer :: psnsham real, dimension(:), pointer :: sndzm real, dimension(:), pointer :: asnowm real, dimension(:,:), pointer :: RDU001 @@ -4695,6 +4734,9 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: CLMPF real, dimension(:), pointer :: CLMSF real, dimension(:), pointer :: T2M10D + real, dimension(:), pointer :: TG10D + real, dimension(:), pointer :: T2MMIN5D + real, dimension(:), pointer :: RH30D real, dimension(:), pointer :: TPREC10D real, dimension(:), pointer :: TPREC60D @@ -5042,7 +5084,6 @@ subroutine Driver ( RC ) real, allocatable, dimension(:) :: fpg, fpi, sminn_to_plant, sminn_to_npool, ndep_to_sminn real, allocatable, dimension(:) :: totvegn, totlitn, totsomn, retransn, retransn_to_npool real, allocatable, dimension(:) :: fuelc, totlitc, cwdc, rootc - real, allocatable, dimension(:) :: lats_degree, lons_degree ! *************************************************************************************************************************************************************** ! Begin Carbon Tracker variables @@ -5116,7 +5157,10 @@ subroutine Driver ( RC ) integer :: ntile, nv, dpy, ierr, iok, ndt integer, save :: year_prev = -9999 + integer, save :: n1d ! number of land model steps in a 1-day period + integer, save :: n5d ! number of land model steps in a 5-day period integer, save :: n10d ! number of land model steps in a 10-day period + integer, save :: n30d ! number of land model steps in a 30-day period integer, save :: n60d ! number of land model steps in a 60-day period ! For accumulated fields @@ -5127,7 +5171,9 @@ subroutine Driver ( RC ) integer, save :: istep ! model time step index integer :: accper ! number of time steps accumulated in a period of XX days, increases from 1 to nXXd in the first XX days, ! and remains as nXXd thereafter - + integer :: ta_count = 0 + real :: TA_MIN = 1000. + integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_MI, AGCM_S, AGCM_HH, dofyr, AGCM_S_ofday logical, save :: first = .true. integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline @@ -5355,8 +5401,12 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,PSNSUNM ,'PSNSUNM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,PSNSHAM ,'PSNSHAM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,SNDZM ,'SNDZM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SNDZM ,'SNDZM5D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,ASNOWM ,'ASNOWM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,T2M10D ,'T2M10D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,T2M10D ,'TG10D' ,RC=STATUS); VERIFY_(STATUS + call MAPL_GetPointer(INTERNAL,T2M10D ,'T2MMIN5D' ,RC=STATUS); VERIFY_(STATUS + call MAPL_GetPointer(INTERNAL,RH30D ,'RH30D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC10D ,'TPREC10D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC60D ,'TPREC60D' ,RC=STATUS); VERIFY_(STATUS) @@ -5554,13 +5604,16 @@ subroutine Driver ( RC ) ! set number of time steps within a XX-day/hour period for 2m temperature XX-day/hour "running mean" ! -------------------------------------------------------------------------------------------------- + n1d = 86400/dt + n5d = 5*86400/dt n10d = 10*86400/dt + n30d = 30*86400/dt n60d = 60*86400/dt ! fzeng: this is done in such way to exclude istep in the restart file if(init_accum) then istep = 0 ! set model time step index to 0 when begin to accumulate the cumulative variables, fzeng, 21 Apr 2017 else - istep = maxval((/n10d,n60d/)) ! otherwise, set model time step index to the maximum of these nXX + istep = maxval((/n10d,n30d,n60d/)) ! otherwise, set model time step index to the maximum of these nXX end if ! variables used for summing CN inputs over multiple land model calls; not saved on restart @@ -6182,9 +6235,11 @@ subroutine Driver ( RC ) ! gkw: start on main CN block allocate( btran(ntiles,nveg,nzone) ) + allocate( btran_fire(ntiles,nzone) ) allocate( wgt(ntiles) ) allocate( wpp(ntiles) ) allocate( fwet(ntiles) ) + allocate( bt(ntiles,fsat:fwlt)) allocate( sm(ntiles,fsat:fwlt)) allocate( SWSRF1(ntiles) ) allocate( SWSRF2(ntiles) ) @@ -6243,8 +6298,6 @@ subroutine Driver ( RC ) allocate( totlitc(ntiles) ) allocate( cwdc(ntiles) ) allocate( rootc(ntiles) ) - allocate( lats_degree(ntiles) ) - allocate( lons_degree(ntiles) ) allocate( lnfm(ntiles) ) allocate( tgw(ntiles,nzone) ) @@ -6357,6 +6410,12 @@ subroutine Driver ( RC ) sm(n,fwlt) = min(sm(n,fwlt),wpwet(n)-1.e-7) end do + bt(:,fsat) = 1.0 + bt(:,ftrns) = sm(:,ftrns)**(-bee) + wpp = wpwet ** (-bee) + bt(:,ftrns) = (bt(:,ftrns)-wpp)/(1.-wpp) + bt(:,fwlt) = 0. + do n = 1,ntiles ax1 = car1(n) @@ -6415,6 +6474,7 @@ subroutine Driver ( RC ) endif do nz = 1,nzone + btran_fire(n,nz) = (f1(nz)*bt(n,fsat) + f2(nz)*bt(n,ftrn) + f4(nz)*bt(n,fwlt) )/wtzone(n,nz) tgw(n,nz) = (f1(nz)*tg(n,fsat) + f2(nz)*tg(n,ftrn) + f4(nz)*tg(n,fwlt))/wtzone(n,nz) tcx(n,nz) = (f1(nz)*tc(n,fsat) + f2(nz)*tc(n,ftrn) + f4(nz)*tc(n,fwlt))/wtzone(n,nz) qcx(n,nz) = (f1(nz)*qc(n,fsat) + f2(nz)*qc(n,ftrn) + f4(nz)*qc(n,fwlt))/wtzone(n,nz) @@ -6459,6 +6519,15 @@ subroutine Driver ( RC ) bflow(n) = min(cond(n),bflow(n)) end do +! compute relative humidity (%) used in CNFireMod +! ----------------------------------------------- + do n = 1,ntiles + Qair_sat = MAPL_EQsat(TA(n), PS(n) ) + Qair_relative(n) = QA(n) / Qair_sat * 100. + end do + + Qair_relative(:) = min(max(0., Qair_relative(:)), 100.) + ! compute accumulated fields, fzeng ! following the methods in accFldsMod.F90 and accumulMod.F90 in CLM4.5 ! -------------------------------------------------------------------- @@ -6473,23 +6542,61 @@ subroutine Driver ( RC ) ! --------------------------------------------------------------------------------- if(init_accum) then + ! (1) 5-day running mean of snow depth + accper = min(istep,n5d) + SNDZM5D = ((accper-1)*SNDZM5D + SNDZM) / accper + ! (1) 10-day running mean of 2-m temperature (K) and total precipitation (mm H2O/s) accper = min(istep,n10d) T2M10D = ((accper-1)*T2M10D + TA) / accper TPREC10D = ((accper-1)*TPREC10D + PCU + PLS + SNO) / accper - + TG10D = ((accper-1)*TG10D + TG) / accper + + ! (2) 30-day running mean of relative humidity [%] + accper = min(istep,n30d) + RH30D = ((accper-1)*RH30D + Qair_relative) / accper + + ! (2) 60-day running mean of total precipitation (mm H2O/s) accper = min(istep,n60d) - TPREC60D = ((accper-1)*TPREC60D + PCU + PLS + SNO) / accper + TPREC60D = ((accper-1)*TPREC60D + PCU + PLS + SNO) / accper + + + ! jkolassa: for T2MMIN5D compute minimum T2M once per day, then use that value to compute new 5-day running mean of minimum T2M + + ta_count = ta_count + 1 + TA_MIN = min(TA_MIN,TA) + + if (ta_count == n1d) then + T2MMIN5D = ((accper-1)*T2MMIN5D + TA_MIN) / accper + TA_MIN = 1000. + ta_count = 0 + end if else + SNDZM5D = ((n5d-1)*SNDZM5D + SNDZM) / n5d T2M10D = ((n10d-1)*T2M10D + TA) / n10d + TG10D = ((n10d-1)*TG10D + TG) / n10d TPREC10D = ((n10d-1)*TPREC10D + PCU + PLS + SNO) / n10d + RH30D = ((n30d-1)*RH30D + Qair_relative) / n30d TPREC60D = ((n60d-1)*TPREC60D + PCU + PLS + SNO) / n60d + + ! jkolassa: for T2MMIN5D compute minimum T2M once per day, then use that value to compute new 5-day running mean of minimum T2M + + ta_count = ta_count + 1 + TA_MIN = min(TA_MIN,TA) + + if (ta_count == n1d) then + T2MMIN5D = ((n5d-1)*T2MMIN5D + TA_MIN) / n5d + TA_MIN = 1000. + ta_count = 0 + end if + endif + ! get CO2 ! ------- @@ -6729,15 +6836,6 @@ subroutine Driver ( RC ) year_prev = AGCM_YY endif -! compute relative humidity (%) used in CNFireMod -! ----------------------------------------------- - do n = 1,ntiles - Qair_sat = MAPL_EQsat(TA(n), PS(n) ) - Qair_relative(n) = QA(n) / Qair_sat * 100. - end do - - Qair_relative(:) = min(max(0., Qair_relative(:)), 100.) - ! CN time step over 4 hours may fail; limit to 4 hours; verify that DTCN is a multiple of DT ! ------------------------------------------------------------------------------------------ dtcn = min(dtcn,14400.) @@ -6762,10 +6860,6 @@ subroutine Driver ( RC ) snowfm = snowfm + SNO runsrfm = runsrfm + runsrf ar1m = ar1m + car1 - psnsunm = psnsunm + psnsun*laisun - psnsham = psnsham + psnsha*laisha - lmrsunm = lmrsunm + lmrsun*laisun - lmrsham = lmrsham + lmrsha*laisha do n = 1,N_snow sndzm(:) = sndzm(:) + sndzn(n,:) end do @@ -6787,12 +6881,6 @@ subroutine Driver ( RC ) tgwm(:,nz) = tgwm(:,nz) / cnsum(:) rzmm(:,nz) = rzmm(:,nz) / cnsum(:) sfmm(:,nz) = sfmm(:,nz) / cnsum(:) - do nv = 1,nveg - psnsunm(:,nv,nz) = psnsunm(:,nv,nz) / cnsum(:) - psnsham(:,nv,nz) = psnsham(:,nv,nz) / cnsum(:) - lmrsunm(:,nv,nz) = lmrsunm(:,nv,nz) / cnsum(:) - lmrsham(:,nv,nz) = lmrsham(:,nv,nz) / cnsum(:) - end do end do tpm = tpm / cnsum bflowm = bflowm / cnsum @@ -6807,27 +6895,24 @@ subroutine Driver ( RC ) sndzm = sndzm / cnsum asnowm = asnowm / cnsum - laisun = 1. - laisha = 1. - - lats_degree = lats / MAPL_PI * 180. - lons_degree = lons / MAPL_PI * 180. - - call CN_Driver(istep_cn,ntiles,nveg,nzone,dayl, & - tgwm,tpm,tp2,tp3,tp4,tp5,tp6,sfmm,rzmm,wpwet, & - psis,bee,poros,vgwmax,bflowm,totwatm,runsrfm, & - tairm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,T2M10D, & - psnsunm,psnsham,lmrsunm,lmrsham,laisun,laisha, & - ar1m,btran_fire_rz,btran_fire_sf,lats_degree,lons_degree, & - ityp,fveg,wtzone,sndzm,asnowm,ndep,abm,peatf,gdp,hdm,fieldcap,lnfm, & - elai,esai,tlai,totcolc,cat_id,cli_t2m, & - npp,gpp,sr,nee,frootc,padd,vegc,xsmr,burn,closs, & - nfire,som_closs,ndeploy,denit,sminn_leached,sminn,fire_nloss, & - leafn,leafc,gross_nmin,net_nmin,nfix_to_sminn,actual_immob, & - fpg,fpi,sminn_to_plant,sminn_to_npool,ndep_to_sminn,totvegn,totlitn,totsomn, & - retransn,retransn_to_npool,fuelc,totlitc,cwdc,rootc) - + call CN_Driver(ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& + rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& + abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& + asnowm,TG10D,T2MMIN5D,SNDZM5D, & + elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& + som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& + fire_nloss,leafn,leafc,gross_nmin,net_nmin,& + nfix_to_sminn,actual_immob,fpg,fpi,sminn_to_plant,& + sminn_to_npool,ndep_to_sminn,totvegn,totlitn,totsomn,& + retransn,retransn_to_npool,fuelc,totlitc,cwdc,rootc) + + ! jkolassa: padd is a correction term that we may no longer need; + ! I am setting it to zero here in order to avoid having to change + ! the restart file for now + + padd(:) = 0. + ! save scaled CN diagnostics ! -------------------------- if(associated(CNLAI)) then @@ -6911,10 +6996,6 @@ subroutine Driver ( RC ) snowfm = 0. runsrfm = 0. ar1m = 0. - psnsunm = 0. - psnsham = 0. - lmrsunm = 0. - lmrsham = 0. sndzm = 0. asnowm = 0. cnsum = 0. @@ -6974,7 +7055,7 @@ subroutine Driver ( RC ) ! ------------------------------------------ if(NextTime == StopTime) then - call CN_exit(ntiles,nveg,nzone,ityp,fveg,cncol,var_col,cnpft,var_pft) + call CN_exit(ntile,ityp,fveg,cncol,cnpft) i = 1 do iv = 1,VAR_PFT do nv = 1,NUM_VEG @@ -7829,8 +7910,6 @@ subroutine Driver ( RC ) deallocate( totlitc ) deallocate( cwdc ) deallocate( rootc ) - deallocate( lats_degree ) - deallocate( lons_degree ) deallocate( lnfm ) deallocate( tgw ) @@ -7841,14 +7920,8 @@ subroutine Driver ( RC ) deallocate( totcolc ) deallocate( wtzone ) deallocate( sfm ) - deallocate( bt1_sf ) - deallocate( bt2_sf ) - deallocate( bt4_sf ) - deallocate( btran1_sf ) - deallocate( btran2_sf ) - deallocate( btran3_sf ) - deallocate( btran_fire_rz ) - deallocate( btran_fire_sf ) + deallocate( bt ) + deallocate( btran_fire ) deallocate( psnsunx ) deallocate( psnshax ) deallocate( sifsunx ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 0ec4d1692..657f6277c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -290,6 +290,7 @@ subroutine write_nc4(this, filename, rc) call MAPL_VarWrite(formatter,"RUNSRFM", var) call MAPL_VarWrite(formatter,"AR1M", var) call MAPL_VarWrite(formatter,"T2M10D", var) + call MAPL_VarWrite(formatter,"RH30D", var) call MAPL_VarWrite(formatter,"TPREC10D",var) call MAPL_VarWrite(formatter,"TPREC60D",var) else diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index cd2bce354..e410d778f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -849,6 +849,7 @@ subroutine writecatchcn_nc4 (catch,formatter,cfg) call MAPL_VarWrite(formatter,"RUNSRFM", var) call MAPL_VarWrite(formatter,"AR1M", var) call MAPL_VarWrite(formatter,"T2M10D", var) + call MAPL_VarWrite(formatter,"RH30D", var) call MAPL_VarWrite(formatter,"TPREC10D",var) call MAPL_VarWrite(formatter,"TPREC60D",var) else diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 index da979d04b..16d380b3d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 @@ -2495,6 +2495,7 @@ SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC10D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC60D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'T2M10D' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RH30D' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) else STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'SFMCM'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) endif From 26b21f78a60aa17498f89db0eeaac77fdcc56f3d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 18 Oct 2022 15:32:32 -0400 Subject: [PATCH 007/589] changes to mk_restart utilities to account for additional restart variables in CatchCNCLM51 --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 126 ++++++++++++-- .../Utils/mk_restarts/Scale_CatchCN.F90 | 80 ++++++++- .../Utils/mk_restarts/mk_GEOSldasRestarts.F90 | 157 +++++++++++++++++- 3 files changed, 341 insertions(+), 22 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 657f6277c..3a338588e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -18,14 +18,18 @@ module CatchmentCNRstMod integer, parameter :: VAR_PFT_CLM40 = 74 ! number of CN PFT variables per column integer, parameter :: npft = 19 integer, parameter :: npft_clm45 = 19 + integer, parameter :: npft_clm51 = 15 integer, parameter :: VAR_COL_CLM45 = 35 ! number of CN column restart variables integer, parameter :: VAR_PFT_CLM45 = 75 ! number of CN PFT variables per column + integer, parameter :: VAR_COL_CLM51 = 35 ! number of CN column restart variables + integer, parameter :: VAR_PFT_CLM51 = 81 ! number of CN PFT variables per column real, parameter :: nan = O'17760000000' real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) type, extends(CatchmentRst) :: CatchmentCNRst logical :: isCLM45 + logical :: isCLM51 integer :: VAR_COL integer :: VAR_PFT real, allocatable :: cnity(:,:) @@ -56,19 +60,23 @@ module CatchmentCNRstMod !real, allocatable :: cnsum(:) !real, allocatable :: sndzm(:) !real, allocatable :: asnowm(:) - !real, allocatable :: ar1m(:) - !real, allocatable :: rainfm(:) - !real, allocatable :: rhm(:) - !real, allocatable :: runsrfm(:) - !real, allocatable :: snowfm(:) - !real, allocatable :: windm(:) - !real, allocatable :: tprec10d(:) - !real, allocatable :: tprec60d(:) - !real, allocatable :: t2m10d(:) + real, allocatable :: ar1m(:) + real, allocatable :: rainfm(:) + real, allocatable :: rhm(:) + real, allocatable :: runsrfm(:) + real, allocatable :: snowfm(:) + real, allocatable :: windm(:) + real, allocatable :: tprec10d(:) + real, allocatable :: tprec60d(:) + real, allocatable :: t2m10d(:) !real, allocatable :: sfmcm(:) !real, allocatable :: psnsunm(:,:,:) !real, allocatable :: psnsham(:,:,:) - + real, allocatable :: rh30d(:) + real, allocatable :: tg10d(:) + real, allocatable :: t2mmin5d(:) + real, allocatable :: sndzm5d(:) + contains procedure :: write_nc4 procedure :: allocate_cn @@ -105,6 +113,7 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) catch%isCLM45 = .false. + catch%isCLM51 = .false. call formatter%open(filename, pFIO_READ, __RC__) meta = formatter%read(__RC__) ntiles = meta%get_dimension('tile', __RC__) @@ -120,6 +129,11 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) catch%VAR_PFT = VAR_PFT_CLM45 catch%isCLM45 = .true. endif + if (index(cnclm, '51') /=0) then + catch%VAR_COL = VAR_COL_CLM51 + catch%VAR_PFT = VAR_PFT_CLM51 + catch%isCLM51 = .true. + endif if (myid == 0) then call catch%allocate_cn(__RC__) @@ -152,6 +166,26 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) call MAPL_VarRead(formatter,"GDP", catch%GDP , __RC__) call MAPL_VarRead(formatter,"PEATF", catch%PEATF , __RC__) endif + if( catch%isCLM51) then + call MAPL_VarRead(formatter,"ABM", catch%ABM, __RC__) + call MAPL_VarRead(formatter,"FIELDCAP",catch%FIELDCAP, __RC__) + call MAPL_VarRead(formatter,"HDM", catch%HDM , __RC__) + call MAPL_VarRead(formatter,"GDP", catch%GDP , __RC__) + call MAPL_VarRead(formatter,"PEATF", catch%PEATF , __RC__) + call MAPL_VarRead(formatter,"RHM", catch%RHM , __RC__) + call MAPL_VarRead(formatter,"WINDM", catch%WINDM , __RC__) + call MAPL_VarRead(formatter,"RAINFM", catch%RAINFM , __RC__) + call MAPL_VarRead(formatter,"SNOWFM", catch%SNOWFM , __RC__) + call MAPL_VarRead(formatter,"RUNSRFM", catch%RUNSURFM, __RC__) + call MAPL_VarRead(formatter,"AR1M", catch%AR1M , __RC__) + call MAPL_VarRead(formatter,"SNDZM5D", catch%SNDZM5D , __RC__) + call MAPL_VarRead(formatter,"T2M10D", catch%T2M10D , __RC__) + call MAPL_VarRead(formatter,"T2MMIN5D",catch%T2MMIN5D, __RC__) + call MAPL_VarRead(formatter,"TG10D", catch%TG10D , __RC__) + call MAPL_VarRead(formatter,"RH30D", catch%RH30D , __RC__) + call MAPL_VarRead(formatter,"TPREC10D",catch%TPREC10D, __RC__) + call MAPL_VarRead(formatter,"TPREC60D",catch%TPREC60D, __RC__) + endif do j=1,dim1 call MAPL_VarRead(formatter,"CNCOL",catch%CNCOL(:,j),offset1=j, __RC__) enddo @@ -185,6 +219,7 @@ function CatchmentCNRst_empty(meta, cnclm, time, rc) result (catch) character(len=256) :: Iam = "CatchmentCNRst_empty" catch%isCLM45 = .false. + catch%isCLM51 = .false. catch%ntiles = meta%get_dimension('tile', __RC__) catch%time = time catch%meta = meta @@ -197,6 +232,11 @@ function CatchmentCNRst_empty(meta, cnclm, time, rc) result (catch) catch%VAR_PFT = VAR_PFT_CLM45 catch%isCLM45 = .true. endif + if (index(cnclm, '51') /=0) then + catch%VAR_COL = VAR_COL_CLM51 + catch%VAR_PFT = VAR_PFT_CLM51 + catch%isCLM51 = .true. + endif call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) if (myid ==0) call catch%allocate_cn(__RC__) @@ -293,6 +333,29 @@ subroutine write_nc4(this, filename, rc) call MAPL_VarWrite(formatter,"RH30D", var) call MAPL_VarWrite(formatter,"TPREC10D",var) call MAPL_VarWrite(formatter,"TPREC60D",var) + elseif (this%isCLM51) then + do j=1,dim1 + call MAPL_VarWrite(formatter,"SFMM", var,offset1=j) + enddo + + call MAPL_VarWrite(formatter,"ABM", this%ABM, rc =rc ) + call MAPL_VarWrite(formatter,"FIELDCAP",this%FIELDCAP) + call MAPL_VarWrite(formatter,"HDM", this%HDM ) + call MAPL_VarWrite(formatter,"GDP", this%GDP ) + call MAPL_VarWrite(formatter,"PEATF", this%PEATF ) + call MAPL_VarWrite(formatter,"RHM", this%RHM) + call MAPL_VarWrite(formatter,"WINDM", this%WINDM) + call MAPL_VarWrite(formatter,"RAINFM", this%RAINFM) + call MAPL_VarWrite(formatter,"SNOWFM", this%SNOWFM) + call MAPL_VarWrite(formatter,"RUNSRFM", this%RUNSURFM) + call MAPL_VarWrite(formatter,"AR1M", this%AR1M) + call MAPL_VarWrite(formatter,"SNDZM5D", this%SNDZM5D) + call MAPL_VarWrite(formatter,"T2M10D", this%T2M10D) + call MAPL_VarWrite(formatter,"T2MMIN5D",this%T2MMIN5D) + call MAPL_VarWrite(formatter,"TG10D", this%TG10D) + call MAPL_VarWrite(formatter,"RH30D", this%RH30D) + call MAPL_VarWrite(formatter,"TPREC10D",this%TPREC10D) + call MAPL_VarWrite(formatter,"TPREC60D",this%TPREC60D) else call MAPL_VarWrite(formatter,"SFMCM", var) endif @@ -344,6 +407,19 @@ subroutine allocate_cn(this,rc) allocate(this%HDM(ntiles)) allocate(this%GDP(ntiles)) allocate(this%PEATF(ntiles)) + allocate(this%RHM(ntiles)) + allocate(this%WINDM(ntiles)) + allocate(this%RAINFM(ntiles)) + allocate(this%SNOWFM(ntiles)) + allocate(this%RUNSURFM(ntiles)) + allocate(this%AR1M(ntiles)) + allocate(this%RH30D(ntiles)) + allocate(this%TG10D(ntiles)) + allocate(this%T2M10D(ntiles)) + allocate(this%T2MMIN5D(ntiles)) + allocate(this%TPREC10D(ntiles)) + allocate(this%TPREC60D(ntiles)) + allocate(this%SNDZM5D(ntiles)) _RETURN(_SUCCESS) end subroutine allocate_cn @@ -428,6 +504,16 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) end do CLOSE (unit30, STATUS = 'KEEP') endif + + if (this%isCLM51 ) then + + open(newunit=unit32, file=trim(OutBcsDir)//'/clsm/CLM5.1_abm_peatf_gdp_hdm_fc' ,form='formatted') + do n=1,ntiles + read (unit32, *) i, j, abm(n), peatf(n), & + gdp(n), hdm(n), fc(n) + end do + CLOSE (unit32, STATUS = 'KEEP') + endif do n=1,ntiles BVISDR(n) = amax1(1.e-6, BVISDR(n)) @@ -516,7 +602,7 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) this%BGALBNR = BNIRDR this%BGALBNF = BNIRDF - if (this%isCLM45) then + if ((this%isCLM45) .or. (this%isCLM51))then this%abm = real(abm) this%fieldcap = fc this%hdm = hdm @@ -978,6 +1064,14 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & var_pft_out(n, nz,nv,73) = max(var_pft_out(n, nz,nv,73),0.) var_pft_out(n, nz,nv,74) = max(var_pft_out(n, nz,nv,74),0.) if(this%isCLM45) var_pft_out(n, nz,nv,75) = max(var_pft_out(n, nz,nv,75),0.) + if(this%isCLM51) then + var_pft_out(n, nz,nv,76) = max(var_pft_out(n, nz,nv,76),0.) + var_pft_out(n, nz,nv,77) = max(var_pft_out(n, nz,nv,77),0.) + var_pft_out(n, nz,nv,78) = max(var_pft_out(n, nz,nv,78),0.) + var_pft_out(n, nz,nv,79) = max(var_pft_out(n, nz,nv,79),0.) + var_pft_out(n, nz,nv,80) = max(var_pft_out(n, nz,nv,80),0.) + var_pft_out(n, nz,nv,81) = max(var_pft_out(n, nz,nv,81),0.) + end if endif end do NVLOOP3 ! end veg loop endif ! end carbon check @@ -1189,6 +1283,16 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & end do end do end do + elseif(this%isclm51) then + do iv = 1,VAR_PFT + do nv = 1,nveg + do nz = 1,nzone + this%cnpft(:,i) = var_pft_out(:, nz,nv,iv) + !STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNPFT'), (/1,i/), (/NTILES,1 /),var_pft_out(:, nz,nv,iv)) ; VERIFY_(STATUS) + i = i + 1 + end do + end do + end do else do iv = 1,VAR_PFT do nv = 1,nveg diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index e410d778f..a7f300a0a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -33,14 +33,18 @@ program Scale_CatchCN integer, parameter :: nveg = 4 integer, parameter :: nzone = 3 integer :: VAR_COL, VAR_PFT - integer, parameter :: VAR_COL_CLM40 = 40 ! number of CN column restart variables - integer, parameter :: VAR_PFT_CLM40 = 74 ! number of CN PFT variables per column + integer, parameter :: VAR_COL_CLM40 = 40 ! number of CN column restart variables in CatchCNCLM40 + integer, parameter :: VAR_PFT_CLM40 = 74 ! number of CN PFT variables per column in CatchCNCLM40 integer, parameter :: npft = 19 - integer, parameter :: VAR_COL_CLM45 = 35 ! number of CN column restart variables - integer, parameter :: VAR_PFT_CLM45 = 75 ! number of CN PFT variables per column - + integer, parameter :: VAR_COL_CLM45 = 35 ! number of CN column restart variables in CatchCNCLM45 + integer, parameter :: VAR_PFT_CLM45 = 75 ! number of CN PFT variables per column in CatchCNCLM45 + integer, parameter :: npft_51 = 15 + integer, parameter :: VAR_COL_CLM51 = 35 ! number of CN column restart variables in CatchCNCLM51 + integer, parameter :: VAR_PFT_CLM51 = 81 ! number of CN PFT variables per column in CatchCNCLM51 + logical :: clm45 = .false. - integer :: un_dim3 + logical :: clm51 = .false. + integer :: un_dim3, un_dim4 type catch_rst real, pointer :: bf1(:) @@ -116,6 +120,19 @@ program Scale_CatchCN real, pointer :: HDM (:) real, pointer :: GDP (:) real, pointer :: PEATF (:) + real, pointer :: RHM (:) + real, pointer :: RH30D (:) + real, pointer :: WINDM (:) + real, pointer :: RAINFM (:) + real, pointer :: SNOWFM (:) + real, pointer :: RUNSURFM(:) + real, pointer :: AR1M (:) + real, pointer :: TG10D (:) + real, pointer :: T2M10D (:) + real, pointer :: T2MMIN5D(:) + real, pointer :: TPREC10D(:) + real, pointer :: TPREC60D(:) + real, pointer :: SNDZM5D (:) endtype catch_rst type(catch_rst) catch(3) @@ -185,11 +202,17 @@ program Scale_CatchCN ntiles = cfg(1)%get_dimension('tile', __RC__) un_dim3 = cfg(1)%get_dimension('unknown_dim3', __RC__) - if(un_dim3 == 105) then + un_dim4 = cfg(1)%get_dimension('unknown_dim4', __RC__) + if((un_dim3 == 105).and.(un_dim4 == 900)) then clm45 = .true. VAR_COL = VAR_COL_CLM45 VAR_PFT = VAR_PFT_CLM45 print *, 'Processing CLM45 restarts : ', VAR_COL, VAR_PFT, clm45 + elseif((un_dim3 == 105).and.(un_dim4 == 972)) then + clm51 = .true. + VAR_COL = VAR_COL_CLM51 + VAR_PFT = VAR_PFT_CLM51 + print *, 'Processing CLM51 restarts : ', VAR_COL, VAR_PFT, clm51 else print *, 'Processing CLM40 restarts : ', VAR_COL, VAR_PFT, clm45 endif @@ -608,6 +631,25 @@ subroutine readcatchcn_nc4 (catch,formatter,cfg, rc) call MAPL_VarRead(formatter,"HDM", catch%HDM , __RC__) call MAPL_VarRead(formatter,"GDP", catch%GDP , __RC__) call MAPL_VarRead(formatter,"PEATF", catch%PEATF , __RC__) + elseif(clm51) then + call MAPL_VarRead(formatter,"ABM", catch%ABM , __RC__) + call MAPL_VarRead(formatter,"FIELDCAP",catch%FIELDCAP, __RC__) + call MAPL_VarRead(formatter,"HDM", catch%HDM , __RC__) + call MAPL_VarRead(formatter,"GDP", catch%GDP , __RC__) + call MAPL_VarRead(formatter,"PEATF", catch%PEATF , __RC__) + call MAPL_VarRead(formatter,"RHM", catch%RHM , __RC__) + call MAPL_VarRead(formatter,"WINDM", catch%WINDM , __RC__) + call MAPL_VarRead(formatter,"RAINFM", catch%RAINFM , __RC__) + call MAPL_VarRead(formatter,"SNOWFM", catch%SNOWFM , __RC__) + call MAPL_VarRead(formatter,"RUNSRFM", catch%RUNSURFM, __RC__) + call MAPL_VarRead(formatter,"AR1M", catch%AR1M , __RC__) + call MAPL_VarRead(formatter,"SNDZM5D", catch%SNDZM5D , __RC__) + call MAPL_VarRead(formatter,"T2M10D", catch%T2M10D , __RC__) + call MAPL_VarRead(formatter,"T2MMIN5D",catch%T2MMIN5D, __RC__) + call MAPL_VarRead(formatter,"TG10D", catch%TG10D , __RC__) + call MAPL_VarRead(formatter,"RH30D", catch%RH30D , __RC__) + call MAPL_VarRead(formatter,"TPREC10D",catch%TPREC10D, __RC__) + call MAPL_VarRead(formatter,"TPREC60D",catch%TPREC60D, __RC__) endif do j=1,dim1 call MAPL_VarRead(formatter,"CNCOL",catch%CNCOL(:,j),offset1=j, __RC__) @@ -849,7 +891,29 @@ subroutine writecatchcn_nc4 (catch,formatter,cfg) call MAPL_VarWrite(formatter,"RUNSRFM", var) call MAPL_VarWrite(formatter,"AR1M", var) call MAPL_VarWrite(formatter,"T2M10D", var) - call MAPL_VarWrite(formatter,"RH30D", var) + call MAPL_VarWrite(formatter,"TPREC10D",var) + call MAPL_VarWrite(formatter,"TPREC60D",var) + elseif (clm51) then + do j=1,dim1 + call MAPL_VarWrite(formatter,"SFMM", var,offset1=j) + enddo + + call MAPL_VarWrite(formatter,"ABM", catch%ABM, rc =rc ) + call MAPL_VarWrite(formatter,"FIELDCAP",catch%FIELDCAP) + call MAPL_VarWrite(formatter,"HDM", catch%HDM ) + call MAPL_VarWrite(formatter,"GDP", catch%GDP ) + call MAPL_VarWrite(formatter,"PEATF", catch%PEATF ) + call MAPL_VarWrite(formatter,"RHM", var) + call MAPL_VarWrite(formatter,"WINDM", var) + call MAPL_VarWrite(formatter,"RAINFM", var) + call MAPL_VarWrite(formatter,"SNOWFM", var) + call MAPL_VarWrite(formatter,"RUNSRFM", var) + call MAPL_VarWrite(formatter,"AR1M", var) + call MAPL_VarWrite(formatter,"SNDZM5D", var) + call MAPL_VarWrite(formatter,"T2M10D", var) + call MAPL_VarWrite(formatter,"T2MMIN5D",var) + call MAPL_VarWrite(formatter,"TG10D", var) + call MAPL_VarWrite(formatter,"RH30D", var) call MAPL_VarWrite(formatter,"TPREC10D",var) call MAPL_VarWrite(formatter,"TPREC60D",var) else diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 index 16d380b3d..b8ffe31be 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 @@ -51,8 +51,11 @@ PROGRAM mk_GEOSldasRestarts integer, parameter :: VAR_PFT_CLM40 = 74 ! number of CN PFT variables per column integer, parameter :: npft = 19 integer, parameter :: npft_clm45 = 19 + integer, parameter :: npft_clm51 = 15 integer, parameter :: VAR_COL_CLM45 = 35 ! number of CN column restart variables integer, parameter :: VAR_PFT_CLM45 = 75 ! number of CN PFT variables per column + integer, parameter :: VAR_COL_CLM51 = 35 ! number of CN column restart variables + integer, parameter :: VAR_PFT_CLM51 = 81 ! number of CN PFT variables per column real, parameter :: nan = O'17760000000' real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value @@ -115,6 +118,7 @@ PROGRAM mk_GEOSldasRestarts CHARACTER( * ), PARAMETER :: LOWER_CASE = 'abcdefghijklmnopqrstuvwxyz' CHARACTER( * ), PARAMETER :: UPPER_CASE = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' logical :: clm45 = .false. + logical :: clm51 = .false. logical :: second_visit integer :: zoom, k, n, infos character*100 :: InRestart @@ -160,7 +164,7 @@ PROGRAM mk_GEOSldasRestarts print *,'(1) to create an initial catch(cn)_internal_rst file ready for an offline experiment :' print *,'--------------------------------------------------------------------------------------' print *,'(1.1) mpirun -np 1 bin/mk_GEOSldasRestarts.x -a SPONSORCODE -b BCSDIR -m MODEL -s SURFLAY(20/50)' - print *,'where MODEL : catch, catchcnclm40, catchcnclm45' + print *,'where MODEL : catch, catchcnclm40, catchcnclm45, catchcnclm51' print *,'(1.2) sbatch mkLDAS.j' print *,' ' print *,'(2) to reorder an LDASsa restart file to the order of the BCs for use in an GCM experiment :' @@ -206,6 +210,12 @@ PROGRAM mk_GEOSldasRestarts VAR_COL = VAR_COL_CLM45 VAR_PFT = VAR_PFT_CLM45 endif + + if (index(model,'51') /=0) then + clm51 = .true. + VAR_COL = VAR_COL_CLM51 + VAR_PFT = VAR_PFT_CLM51 + endif catch_scaler = 'Scale_CatchCN' else catch_scaler = 'Scale_Catch' @@ -378,11 +388,18 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MOD call ldFmt%open(trim(rst_file) , pFIO_READ,__RC__) meta_data = ldFmt%read(__RC__) call ldFmt%close(__RC__) - if(meta_data%get_dimension('unknown_dim3',rc=status) == 105) then + if((meta_data%get_dimension('unknown_dim3',rc=status) == 105) .and. & + (meta_data%get_dimension('unknown_dim4',rc=status) == 900)) then clm45 = .true. VAR_COL = VAR_COL_CLM45 VAR_PFT = VAR_PFT_CLM45 if (root_proc) print *, 'Processing CLM45 restarts : ', VAR_COL, VAR_PFT, clm45 + elseif((meta_data%get_dimension('unknown_dim3',rc=status) == 105) .and. & + (meta_data%get_dimension('unknown_dim4',rc=status) == 972)) then + clm51 = .true. + VAR_COL = VAR_COL_CLM51 + VAR_PFT = VAR_PFT_CLM51 + if (root_proc) print *, 'Processing CLM51 restarts : ', VAR_COL, VAR_PFT, clm45 else if (root_proc) print *, 'Processing CLM40 restarts : ', VAR_COL, VAR_PFT, clm45 endif @@ -767,6 +784,11 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI VAR_PFT = VAR_PFT_CLM45 if ( .not. clm45) stop ' ERROR: Given clm45 restart, but the model is not clm45' if (root_proc) print *, 'Processing CLM45 restarts : ', VAR_COL, VAR_PFT, clm45 + elseif(meta_data%get_dimension('unknown_dim4',rc=status) == 972) then + VAR_COL = VAR_COL_CLM51 + VAR_PFT = VAR_PFT_CLM51 + if ( .not. clm51) stop ' ERROR: Given clm51 restart, but the model is not clm51' + if (root_proc) print *, 'Processing CLM51 restarts : ', VAR_COL, VAR_PFT, clm45 else if (root_proc) print *, 'Processing CLM40 restarts : ', VAR_COL, VAR_PFT, clm45 endif @@ -1312,6 +1334,8 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) real, allocatable :: CLMC_pt1(:), CLMC_pt2(:), CLMC_st1(:), CLMC_st2(:) real, allocatable :: CLMC45_pf1(:), CLMC45_pf2(:), CLMC45_sf1(:), CLMC45_sf2(:) real, allocatable :: CLMC45_pt1(:), CLMC45_pt2(:), CLMC45_st1(:), CLMC45_st2(:) + real, allocatable :: CLMC51_pf1(:), CLMC51_pf2(:), CLMC51_sf1(:), CLMC51_sf2(:) + real, allocatable :: CLMC51_pt1(:), CLMC51_pt2(:), CLMC51_st1(:), CLMC51_st2(:) real, allocatable :: BF1(:), BF2(:), BF3(:), VGWMAX(:) real, allocatable :: CDCR1(:), CDCR2(:), PSIS(:), BEE(:) real, allocatable :: POROS(:), WPWET(:), COND(:), GNU(:) @@ -1348,8 +1372,11 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) allocate (CLMC_sf2(ntiles), CLMC_pt1(ntiles), CLMC_pt2(ntiles)) allocate (CLMC45_pf1(ntiles), CLMC45_pf2(ntiles), CLMC45_sf1(ntiles)) allocate (CLMC45_sf2(ntiles), CLMC45_pt1(ntiles), CLMC45_pt2(ntiles)) + allocate (CLMC51_pf1(ntiles), CLMC51_pf2(ntiles), CLMC51_sf1(ntiles)) + allocate (CLMC51_sf2(ntiles), CLMC51_pt1(ntiles), CLMC51_pt2(ntiles)) allocate (CLMC_st1(ntiles), CLMC_st2(ntiles)) allocate (CLMC45_st1(ntiles), CLMC45_st2(ntiles)) + allocate (CLMC51_st1(ntiles), CLMC51_st2(ntiles)) allocate (hdm(ntiles), fc(ntiles), gdp(ntiles)) allocate (peatf(ntiles), abm(ntiles), var1(ntiles), RITY(ntiles)) @@ -1426,6 +1453,14 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) end do CLOSE (30, STATUS = 'KEEP') endif + if(clm51) then + open(unit=30, file=trim(DataDir)//'CLM5.1_abm_peatf_gdp_hdm_fc' ,form='formatted') + do n=1,ntiles + read (32, *) i, j, abm(n), peatf(n), & + gdp(n), hdm(n), fc(n) + end do + CLOSE (32, STATUS = 'KEEP') + endif endif @@ -1444,6 +1479,10 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) open(unit=29, file=trim(DataDir)//'CLM4.5_veg_typs_fracs',form='formatted') open(unit=30, file=trim(DataDir)//'CLM4.5_abm_peatf_gdp_hdm_fc' ,form='formatted') endif + if(clm51) then + open(unit=31, file=trim(DataDir)//'CLM5.1_veg_typs_fracs',form='formatted') + open(unit=32, file=trim(DataDir)//'CLM5.1_abm_peatf_gdp_hdm_fc' ,form='formatted') + endif endif do n=1,ntiles @@ -1481,6 +1520,14 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) read (30, *) i, j, abm(n), peatf(n), & gdp(n), hdm(n), fc(n) endif + + if(clm51) then + read (31, *) i,j, CLMC51_pt1(n), CLMC51_pt2(n), CLMC51_st1(n), CLMC51_st2(n), & + CLMC51_pf1(n), CLMC51_pf2(n), CLMC51_sf1(n), CLMC51_sf2(n) + + read (32, *) i, j, abm(n), peatf(n), & + gdp(n), hdm(n), fc(n) + endif endif end do @@ -1498,6 +1545,10 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) CLOSE (29, STATUS = 'KEEP') CLOSE (30, STATUS = 'KEEP') endif + if(clm51) then + CLOSE (31, STATUS = 'KEEP') + CLOSE (32, STATUS = 'KEEP') + endif endif endif @@ -1586,6 +1637,36 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) CLMC45_sf1(n) = fvg(3) CLMC45_sf2(n) = fvg(4) endif + + if(CLM51) then + ! CLM 51 + + CLMC51_pf1(n) = CLMC51_pf1(n) / 100. + CLMC51_pf2(n) = CLMC45_pf2(n) / 100. + CLMC51_sf1(n) = CLMC51_sf1(n) / 100. + CLMC51_sf2(n) = CLMC51_sf2(n) / 100. + + fvg(1) = CLMC51_pf1(n) + fvg(2) = CLMC51_pf2(n) + fvg(3) = CLMC51_sf1(n) + fvg(4) = CLMC51_sf2(n) + + BARE = 1. + + DO NV = 1, NVEG + BARE = BARE - FVG(NV)! subtract vegetated fractions + END DO + + if (BARE /= 0.) THEN + IB = MAXLOC(FVG(:),1) + FVG (IB) = FVG(IB) + BARE ! This also corrects all cases sum ne 0. + ENDIF + + CLMC51_pf1(n) = fvg(1) + CLMC51_pf2(n) = fvg(2) + CLMC51_sf1(n) = fvg(3) + CLMC51_sf2(n) = fvg(4) + endif endif enddo @@ -1670,6 +1751,45 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) CLMC45_sf2(n) = 0. endif endif + + if (clm51) then + ! CLM51 + if(CLMC51_pf1(n) <= 1.e-4) then + CLMC51_pf2(n) = CLMC51_pf2(n) + CLMC51_pf1(n) + CLMC51_pf1(n) = 0. + endif + + if(CLMC51_pf2(n) <= 1.e-4) then + CLMC51_pf1(n) = CLMC51_pf1(n) + CLMC51_pf2(n) + CLMC51_pf2(n) = 0. + endif + + if(CLMC51_sf1(n) <= 1.e-4) then + if(CLMC51_sf2(n) > 1.e-4) then + CLMC51_sf2(n) = CLMC51_sf2(n) + CLMC51_sf1(n) + else if(CLMC51_pf2(n) > 1.e-4) then + CLMC51_pf2(n) = CLMC51_pf2(n) + CLMC51_sf1(n) + else if(CLMC51_pf1(n) > 1.e-4) then + CLMC51_pf1(n) = CLMC51_pf1(n) + CLMC51_sf1(n) + else + stop 'fveg3' + endif + CLMC51_sf1(n) = 0. + endif + + if(CLMC51_sf2(n) <= 1.e-4) then + if(CLMC51_sf1(n) > 1.e-4) then + CLMC51_sf1(n) = CLMC51_sf1(n) + CLMC51_sf2(n) + else if(CLMC51_pf2(n) > 1.e-4) then + CLMC51_pf2(n) = CLMC51_pf2(n) + CLMC51_sf2(n) + else if(CLMC51_pf1(n) > 1.e-4) then + CLMC51_pf1(n) = CLMC51_pf1(n) + CLMC51_sf2(n) + else + stop 'fveg4' + endif + CLMC51_sf2(n) = 0. + endif + endif end do endif @@ -1740,7 +1860,7 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BGALBNR'), (/1/), (/NTILES/),BNIRDR) STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'BGALBNF'), (/1/), (/NTILES/),BNIRDF) - if(CLM45) then + if((CLM45) .or. (CLM51)) then STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'ABM' ), (/1/), (/NTILES/),real(ABM)) STATUS = NF_PUT_VARA_REAL(NCFID,VarID(NCFID,'FIELDCAP'), (/1/), (/NTILES/),FC) @@ -2255,6 +2375,14 @@ SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & var_pft_out(n, nz,nv,73) = max(var_pft_out(n, nz,nv,73),0.) var_pft_out(n, nz,nv,74) = max(var_pft_out(n, nz,nv,74),0.) if(clm45) var_pft_out(n, nz,nv,75) = max(var_pft_out(n, nz,nv,75),0.) + if(this%isCLM51) then + var_pft_out(n, nz,nv,76) = max(var_pft_out(n, nz,nv,76),0.) + var_pft_out(n, nz,nv,77) = max(var_pft_out(n, nz,nv,77),0.) + var_pft_out(n, nz,nv,78) = max(var_pft_out(n, nz,nv,78),0.) + var_pft_out(n, nz,nv,79) = max(var_pft_out(n, nz,nv,79),0.) + var_pft_out(n, nz,nv,80) = max(var_pft_out(n, nz,nv,80),0.) + var_pft_out(n, nz,nv,81) = max(var_pft_out(n, nz,nv,81),0.) + end if endif end do NVLOOP3 ! end veg loop endif ! end carbon check @@ -2458,6 +2586,16 @@ SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & end do end do end do + elseif(clm51) then + do iv = 1,VAR_PFT + do nv = 1,nveg + do nz = 1,nzone + this%cnpft(:,i) = var_pft_out(:, nz,nv,iv) + !STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNPFT'), (/1,i/), (/NTILES,1 /),var_pft_out(:, nz,nv,iv)) ; VERIFY_(STATUS) + i = i + 1 + end do + end do + end do else do iv = 1,VAR_PFT do nv = 1,nveg @@ -2495,7 +2633,20 @@ SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC10D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC60D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'T2M10D' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + if(clm51) then + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'AR1M' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RAINFM' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RHM' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RUNSRFM' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'SNOWFM' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'WINDM' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC10D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC60D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'T2M10D' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RH30D' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TG10D' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'T2MMIN5D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'SNDZM5D' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) else STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'SFMCM'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) endif From fe08c89b0e44edb38d43a6c6998db583e14e81f1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 19 Oct 2022 09:37:16 -0400 Subject: [PATCH 008/589] updates to CMakeLists and clean-up --- .../CLM51/CMakeLists.txt | 115 ++++++- .../CLM51/CNCLM51_Photosynthesis.F90 | 31 +- .../CLM51/CNCLM_ActiveLayerMod.F90 | 4 +- .../CLM51/CNCLM_CNDVType.F90 | 4 +- .../CLM51/CNCLM_CNProductsMod.F90 | 4 +- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 5 +- ...ype.F90 => CNCLM_CNVegCarbonStateType.F90} | 4 +- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 4 +- ...e.F90 => CNCLM_CNVegNitrogenStateType.F90} | 4 +- .../CLM51/CNCLM_CNVegStateType.F90 | 4 +- .../CLM51/CNCLM_CanopyStateType.F90 | 2 +- .../CLM51/CNCLM_ColumnType.F90 | 4 +- .../CLM51/CNCLM_CropType.F90 | 4 +- .../CLM51/CNCLM_GridcellType.F90 | 4 +- .../CLM51/CNCLM_NamelistParameters.F90 | 5 - .../CLM51/CNCLM_OzoneBaseMod.F90 | 4 +- .../CLM51/CNCLM_PatchType.F90 | 4 +- .../CNCLM_SoilBiogeochemCarbonFluxType.F90 | 4 +- .../CNCLM_SoilBiogeochemCarbonStateType.F90 | 4 +- ...CLM_SoilBiogeochemDecompCascadeConType.F90 | 4 +- .../CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 4 +- .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 4 +- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 4 +- .../CLM51/CNCLM_SoilStateType.F90 | 4 +- .../CLM51/CNCLM_SolarAbsorbedType.F90 | 4 +- .../CLM51/CNCLM_SurfaceAlbedoType.F90 | 4 +- .../CLM51/CNCLM_TemperatureType.F90 | 4 +- .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 4 +- .../CLM51/CNCLM_WaterFluxBulkType.F90 | 4 +- .../CLM51/CNCLM_WaterFluxType.F90 | 4 +- .../CLM51/CNCLM_atm2lndType.F90 | 4 +- .../CLM51/CNCLM_ch4Mod.F90 | 4 +- .../CLM51/CNCLM_decompMod.F90 | 4 +- .../CLM51/CNCLM_filterMod.F90 | 4 +- .../CLM51/CNCLM_pftconMod.F90 | 4 +- .../CLM51/CN_init_mod.F90 | 67 ++-- .../CLM51/clm_varcon_old.F90 | 317 ------------------ .../GEOScatchCNCLM51_GridComp/CMakeLists.txt | 19 ++ .../GEOS_CatchCNCLM51GridComp.F90 | 2 +- 39 files changed, 248 insertions(+), 435 deletions(-) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/{CNCLM_VegCarbonStateType.F90 => CNCLM_CNVegCarbonStateType.F90} (99%) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/{CNCLM_VegNitrogenStateType.F90 => CNCLM_CNVegNitrogenStateType.F90} (99%) delete mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_NamelistParameters.F90 delete mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon_old.F90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CMakeLists.txt diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 904cd9cbf..adf6e0f24 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -2,8 +2,121 @@ esma_set_this () string (REPLACE GEOScatchCN_GridComp_ "" is_openmp ${this}) set (srcs - CNCLM_Photosynthesis.F90 + abortutils.F90 + AnnualFluxDribbler.F90 + clm_time_manager.F90 + clm_varcon.F90 + clm_varctl.F90 + clm_varpar.F90 + CNAnnualUpdateMod.F90 + CNBalanceCheckMod.F90 + CNCLM51_Photosynthesis.F90 + CNCLM_ActiveLayerMod.F90 + CNCLM_atm2lndType.F90 + CNCLM_CanopyStateType.F90 + CNCLM_ch4Mod.F90 + CNCLM_CNDVType.F90 + CNCLM_CNFireBaseMod.F90 + CNCLM_CNProductsMod.F90 + CNCLM_CNVegCarbonFluxType.F90 + CNCLM_CNVegCarbonStateType.F90 + CNCLM_CNVegNitrogenFluxType.F90 + CNCLM_CNVegNitrogenStateType.F90 + CNCLM_CNVegStateType.F90 + CNCLM_ColumnType.F90 + CNCLM_CropType.F90 + CNCLM_decompMod.F90 + CNCLM_DriverMod.F90 + CNCLM_dynSubgridControlMod.F90 + CNCLM_EnergyFluxType.F90 + CNCLM_filterMod.F90 + CNCLM_FireDataBaseType.F90 + CNCLM_FrictionVelocityMod.F90 + CNCLM_GridcellType.F90 + CNCLM_initVerticalMod.F90 + CNCLM_LandunitType.F90 + CNCLM_OzoneBaseMod.F90 + CNCLM_PatchType.F90 + CNCLM_pftconMod.F90 + CNCLM_SaturatedExcessRunoffMod.F90 + CNCLM_SoilBiogeochemCarbonFluxType.F90 + CNCLM_SoilBiogeochemCarbonStateType.F90 + CNCLM_SoilBiogeochemDecompCascadeConType.F90 + CNCLM_SoilBiogeochemNitrogenFluxType.F90 + CNCLM_SoilBiogeochemNitrogenStateType.F90 + CNCLM_SoilBiogeochemStateType.F90 + CNCLM_SoilStateType.F90 + CNCLM_SolarAbsorbedType.F90 + CNCLM_SurfaceAlbedoType.F90 + CNCLM_TemperatureType.F90 + CNCLM_Wateratm2lndBulkType.F90 + CNCLM_Wateratm2lndType.F90 + CNCLM_WaterDiagnosticBulkType.F90 + CNCLM_WaterFluxBulkType.F90 + CNCLM_WaterFluxType.F90 + CNCLM_WaterStateBulkType.F90 + CNCLM_WaterStateType.F90 + CNCStateUpdate1Mod.F90 + CNCStateUpdate2Mod.F90 + CNCStateUpdate3Mod.F90 + CNDriverMod.F90 + CNFireEmissionsMod.F90 + CNFireFactoryMod.F90 + CNFireLi2014Mod.F90 + CNFireLi2016Mod.F90 + CNFireLi2021Mod.F90 + CNGapMortalityMod.F90 + CNGRespMod.F90 + CN_init_mod.F90 + CNMRespMod.F90 + CNNDynamicsMod.F90 + CNNStateUpdate1Mod.F90 + CNNStateUpdate2Mod.F90 + CNNStateUpdate3Mod.F90 + CNPhenologyMod.F90 + CNPrecisionControlMod.F90 + CNRootDynMod.F90 + CNSharedParamsMod.F90 + CNVegetationFacade.F90 + column_varcon.F90 + fileutils.F90 + filterColMod.F90 + FireMethodType.F90 + initSubgridMod.F90 + landunit_varcon.F90 + ncdio_pio.F90.in + NutrientCompetitionCLM45defaultMod.F90 + NutrientCompetitionFactoryMod.F90 + NutrientCompetitionFlexibleCNMod.F90 + NutrientCompetitionMethodMod.F90 + paramUtilMod.F90 + perf_mod.F90 PhotosynthesisMod.F90 + quadraticMod.F90 + RootBiophysMod.F90 + shr_abort_mod.F90 + shr_assert.h + shr_assert_mod.F90.in + shr_const_mod.F90 + shr_file_mod.F90 + shr_infnan_mod.F90.in + shr_kind_mod.F90 + shr_log_mod.F90 + shr_mpi_mod.F90 + shr_nl_mod.F90 + shr_sys_mod.F90 + SoilBiogeochemDecompCascadeBGCMod.F90 + SoilBiogeochemDecompCascadeCNMod.F90 + SoilBiogeochemLittVertTranspMod.F90 + SoilBiogeochemNLeachingMod.F90 + SoilBiogeochemNStateUpdate1Mod.F90 + SoilBiogeochemPrecisionControlMod.F90 + SoilWaterRetentionCurveMod.F90 + spmdMod.F90 + subgridAveMod.F90 + SurfaceAlbedoMod.F90 + SurfaceRadiationMod.F90 + TridiagonalMod.F90 ) esma_add_library (${this} diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index e97b05108..5d7197532 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -2,24 +2,24 @@ module CNCLM_Photosynthesis use MAPL_ConstantsMod use clm_varpar, only : numpft, numrad, num_veg, num_zon - use CNCLM_decompMod, only : bounds_type + use decompMod, only : bounds_type use PatchType, only : patch use clm_varcon only : rair - use CNCLM_VegNitrogenstateType - use CNCLM_VegCarbonstateType - use CNCLM_atm2lndType - use CNCLM_TemperatureType - use CNCLM_SoilStateType - use CNCLM_pftconMod - use CNCLM_WaterDiagnosticBulkType - use CNCLM_SurfaceAlbedoType - use CNCLM_SolarAbsorbedType - use CNCLM_CanopyStateType - use CNCLM_OzoneBaseMod - use CNCLM_PhotosynsType - use CNCLM_WaterFluxBulkType - use CNCLM_filterMod, only: filter + use CNVegNitrogenstateType + use CNVegCarbonstateType + use atm2lndType + use TemperatureType + use SoilStateType + use pftconMod + use WaterDiagnosticBulkType + use SurfaceAlbedoType + use SolarAbsorbedType + use CanopyStateType + use OzoneBaseMod + use PhotosynsType + use WaterFluxBulkType + use filterMod, only: filter implicit none @@ -418,6 +418,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & end do ! nz end do ! nc + end associate end subroutine catchcn_calc_rc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 index 2e36fbb69..5c35345b3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 @@ -1,4 +1,4 @@ -module CNCLM_ActiveLayerMod +module ActiveLayerMod !----------------------------------------------------------------------- ! !DESCRIPTION: @@ -198,4 +198,4 @@ subroutine alt_calc(this, num_soilc, filter_soilc, & end subroutine alt_calc -end module CNCLM_ActiveLayerMod +end module ActiveLayerMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 index fc1ec296e..3ae4dca21 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -1,4 +1,4 @@ -module CNCLM_CNDVType +module CNDVType !----------------------------------------------------------------------- ! !DESCRIPTION: @@ -124,4 +124,4 @@ subroutine init_dgvs_type(bounds, this) end do end subroutine init_dgvs_type -end module CNCLM_CNDVType +end module CNDVType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index 8871ee946..faa4d877e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -1,4 +1,4 @@ -module CNCLM_CNProductsMod +module CNProductsMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use MAPL_ExceptionHandling @@ -456,4 +456,4 @@ subroutine ComputeSummaryVars(this, bounds) end subroutine ComputeSummaryVars -end module CNCLM_CNProductsMod +end module CNProductsMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 1820cc5f0..79a29fc88 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1,4 +1,4 @@ -module CNCLM_CNVegCarbonFluxType +module CNVegCarbonFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -2136,5 +2136,6 @@ subroutine Summary_carbonflux(this, & end subroutine Summary_carbonflux -end module CNCLM_CNVegCarbonFluxType +end module CNVegCarbonFluxType + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 similarity index 99% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 605722f6a..6a7bda7d0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -1,4 +1,4 @@ -module CNCLM_VegCarbonStateType +module CNVegCarbonStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varctl , only : iulog, use_cndv, use_crop, use_matrixc @@ -649,4 +649,4 @@ subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & end subroutine Summary_carbonstate -end module CNCLM_VegCarbonStateType +end module CNVegCarbonStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index b8227e57b..f72b35244 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -1,4 +1,4 @@ -module CNCLM_CNVegNitrogenFluxType +module CNVegNitrogenFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -1328,4 +1328,4 @@ subroutine Summary_nitrogenflux(this, bounds, num_soilc, filter_soilc, num_soilp end subroutine Summary_nitrogenflux -end module CNCLM_CNVegNitrogenFluxType +end module CNVegNitrogenFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 similarity index 99% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index 2e163b5e9..00a919924 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_VegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -1,4 +1,4 @@ -module CNCLM_VegNitrogenStateType +module CNVegNitrogenStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use MAPL_ExceptionHandling @@ -601,5 +601,5 @@ subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & end subroutine Summary_nitrogenstate -end module CNCLM_VegNitrogenStateType +end module CNVegNitrogenStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index b9afcf3c0..ef69ad461 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -1,4 +1,4 @@ -module CNCLM_CNVegStateType +module CNVegStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -248,4 +248,4 @@ subroutine init_cnveg_state_type(bounds, nch, ityp, fveg, cncol, cnpft, this) end subroutine init_cnveg_state_type -end module CNCLM_CNVegStateType +end module CNVegStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 40f74686b..833d1443d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -180,4 +180,4 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn end subroutine init_canopystate_type -end module CNCLM_CanopyStateType +end module CanopyStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index 7d6e0e1c1..d237dd36e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -1,4 +1,4 @@ -module CNCLM_ColumnType +module ColumnType !----------------------------------------------------------------------- ! !DESCRIPTION: @@ -166,4 +166,4 @@ subroutine init_column_type(bounds, this) end do ! nc end subroutine init_column_type -end module CNCLM_ColumnType +end module ColumnType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 index 53bed1dc3..6928d1e33 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 @@ -1,4 +1,4 @@ -module CNCLM_CropType +module CropType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varcon , only : spval @@ -67,4 +67,4 @@ subroutine init_crop_type(bounds, this) end subroutine init_crop_type -end module CNCLM_CropType +end module CropType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index b6e25f369..3261e03a4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -1,4 +1,4 @@ -module CNCLM_GridcellType +module GridcellType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4, MAPL_PI use nanMod , only : nan @@ -100,4 +100,4 @@ subroutine init_gridcell_type(bounds, nch, cnpft, lats, lons, this) end do ! nc end subroutine init_gridcell_type -end module CNCLM_GridcellType +end module GridcellType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_NamelistParameters.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_NamelistParameters.F90 deleted file mode 100644 index 0aff1f827..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_NamelistParameters.F90 +++ /dev/null @@ -1,5 +0,0 @@ -module CNCLM_NamelistParameters - - - -end module CNCLM_NamelistParameters diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 index 9225f3e17..a59da717b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 @@ -1,4 +1,4 @@ -module CNCLM_OzoneBaseMod +module OzoneBaseMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -58,4 +58,4 @@ subroutine init_ozone_base_type(bounds, this) end subroutine init_ozone_base_type -end module CNCLM_OzoneBaseMod +end module OzoneBaseMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index cd6589fb1..523c99027 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -1,4 +1,4 @@ -module CNCLM_PatchType +module PatchType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -131,4 +131,4 @@ subroutine init_patch_type(bounds, nch, ityp, fveg, this) end do ! nz end do ! nc end subroutine init_patch_type -end module CNCLM_PatchType +end module PatchType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index e3a3c3d9c..08f680172 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SoilBiogeochemCarbonFluxType +module SoilBiogeochemCarbonFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -378,5 +378,5 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) end subroutine Summary -end module CNCLM_SoilBiogeochemCarbonFluxType +end module SoilBiogeochemCarbonFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index 933c1e889..e11d75f47 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SoilBiogeochemCarbonStateType +module SoilBiogeochemCarbonStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -368,4 +368,4 @@ end subroutine SetTotVgCThresh !----------------------------------------------------------------------- -end module CNCLM_SoilBiogeochemCarbonStateType +end module SoilBiogeochemCarbonStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 index 950a6f875..b20d955a0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SoilBiogeochemDecompCascadeConType +module SoilBiogeochemDecompCascadeConType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan @@ -144,4 +144,4 @@ subroutine init_decomp_cascade_constants( use_century_decomp ) end if end subroutine init_decomp_cascade_constants -end module CNCLM_SoilBiogeochemDecompCascadeConType +end module SoilBiogeochemDecompCascadeConType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index 268452a81..78d1f2667 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SoilBiogeochemNitrogenFluxType +module SoilBiogeochemNitrogenFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -616,4 +616,4 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) end subroutine Summary -end module CNCLM_SoilBiogeochemNitrogenFluxType +end module SoilBiogeochemNitrogenFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index d6c249e86..07177c206 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -1,4 +1,4 @@ - module CNCLM_SoilBiogeochemNitrogenStateType + module SoilBiogeochemNitrogenStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -394,4 +394,4 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end subroutine Summary -end CNCLM_SoilBiogeochemNitrogenStateType +end module SoilBiogeochemNitrogenStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index e09a7c7ab..c5ab731e6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SoilBiogeochemStateType +module SoilBiogeochemStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -123,4 +123,4 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, t end do ! nc end subroutine init_soilbiogeochem_state_type -end module CNCLM_SoilBiogeochemStateType +end module SoilBiogeochemStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index 5b6babec2..0f9d4c192 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SoilStateType +module SoilStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use clm_varpar , only : nlevsoi, nlevgrnd, nlevmaxurbgrnd, & @@ -155,4 +155,4 @@ subroutine init_soilstate_type(bounds, this) end subroutine init_soilstate_type -end module CNCLM_SoilStateType +end module SoilStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 index 24e95d9f4..4f309a7ac 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SolarAbsorbedType +module SolarAbsorbedType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use clm_varcon , only : spval @@ -142,4 +142,4 @@ subroutine init_solarabs_type(bounds, this) end subroutine init_solarabs_type -end module CNCLM_SolarAbsorbedType +end module SolarAbsorbedType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index 97e1009ac..cf7643298 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -1,4 +1,4 @@ -module CNCLM_SurfaceAlbedoType +module SurfaceAlbedoType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -161,4 +161,4 @@ subroutine init_surfalb_type(bounds, nch, cncol, cnpft, this) end subroutine init_surfalb_type -end module CNCLM_SurfaceAlbedoType +end module SurfaceAlbedoType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 index f3e993091..42bcd719e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 @@ -1,4 +1,4 @@ -module CNCLM_TemperatureType +module TemperatureType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevurb, nlevmaxurbgrnd @@ -237,4 +237,4 @@ subroutine init_temperature_type(bounds, this) end subroutine init_temperature_type -end module CNCLM_TemperatureType +end module TemperatureType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index 8b8dfb403..d5ab827da 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -1,4 +1,4 @@ -module CNCLM_WaterDiagnosticBulkType +module WaterDiagnosticBulkType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use clm_varpar , only : nlevgrnd, nlevsno, nlevcan @@ -131,4 +131,4 @@ subroutine init_waterdiagnosticbulk_type(bounds, this) end subroutine init_waterdiagnosticbulk_type -end module CNCLM_WaterDiagnosticBulkType +end module WaterDiagnosticBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 index 3ca03c0a1..0b5a21032 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -1,4 +1,4 @@ -module CNCLM_WaterFluxBulkType +module WaterFluxBulkType use MAPL_ConstantsMod , ONLY : r8 => MAPL_R4 use nanMod , only : nan @@ -102,4 +102,4 @@ subroutine init_waterfluxbulk_type(bounds, this) allocate(this%AnnET (begc:endc)) ; this%AnnET (:) = nan end subroutine init_waterfluxbulk_type -end module CNCLM_WaterFluxBulkType +end module WaterFluxBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index d9315bb46..ade1b75a9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -1,4 +1,4 @@ -module CNCLM_WaterFluxType +module WaterFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -177,4 +177,4 @@ subroutine init_waterflux_type(bounds, this) end subroutine init_waterflux_type -end module CNCLM_WaterFluxType +end module WaterFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 index 87316e00a..d691426a8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 @@ -1,4 +1,4 @@ -module CNCLM_atm2lndType +module atm2lndType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use clm_varpar , only : numrad @@ -142,4 +142,4 @@ subroutine init_atm2lnd_type(bounds, this) end subroutine init_atm2lnd_type -end module CNCLM_atm2lndType +end module atm2lndType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 index df026e5ae..d0eee2a67 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 @@ -1,4 +1,4 @@ -module CNCLM_ch4Mod +module ch4Mod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -219,4 +219,4 @@ subroutine init_ch4_type(bounds, this) end subroutine init_ch4_type -end module CNCLM_ch4Mod +end module ch4Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 index 7b4d174ab..0b4fa0dce 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 @@ -1,4 +1,4 @@ -module CNCLM_decompMod +module decompMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use clm_varpar , only: NUM_ZON, NUM_VEG, numpft @@ -42,4 +42,4 @@ subroutine init_bounds(nch, this) this%begp = 1 ; this%endp = nch*NUM_ZON*(numpft+1) end subroutine init_bounds -end module CNCLM_decompMod +end module decompMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index 41aa850ea..0a79eda8f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -1,4 +1,4 @@ -module CNCLM_filterMod +module filterMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -218,4 +218,4 @@ subroutine init_filter_type(bounds, nch, this_filter) end do !nc end subroutine init_filter_type -end module CNCLM_filterMod +end module filterMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index baa33aeb6..095ae9ea6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -1,4 +1,4 @@ -module CNCLM_pftconMod +module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -848,4 +848,4 @@ subroutine init_pftcon_type(this) end subroutine init_pftcon_type -end module CNCLM_pftconMod +end module pftconMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index e4260a4bd..f1f72b75b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -5,45 +5,45 @@ module CN_initMod use clm_varcon , only : clm_varcon_init use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init use clm_varctl , only : use_century_decomp - use CNCLM_decompMod - use CNCLM_VegNitrogenStateType - use CNCLM_CarbonStateType - use CNCLM_atm2lndType - use CNCLM_TemperatureType - use CNCLM_SoilStateType - use CNCLM_WaterDiagnosticBulkType - use CNCLM_CanopyStateType - use CNCLM_SolarAbsorbedType - use CNCLM_SurfaceAlbedoType - use CNCLM_OzoneBaseMod - use CNCLM_pftconMod - use CNCLM_WaterFluxType - use CNCLM_SoilBiogeochemCarbonStateType - use CNCLM_SoilBiogeochemNitrogenStateType - use CNCLM_CNProductsMod - use CNCLM_SoilBiogeochemStateType - use CNCLM_CNVegStateType - use CNCLM_CNVegCarbonFluxType - use CNCLM_CNVegNitrogenFluxType - use CNCLM_GridcellType - use CNCLM_WaterFluxBulkType - use CNCLM_filterMod - use CNCLM_SoilBiogeochemCarbonFluxType - use CNCLM_SoilBiogeochemNitrogenFluxType - use CNCLM_PatchType - use CNCLM_ColumnType - use CNCLM_ch4Mod - use CNCLM_SoilBiogeochemDecompCascadeConType - use CNCLM_ActiveLayerMod - use CNCLM_CropType - use CNCLM_CNDVType + use decompMod + use CNVegNitrogenStateType + use CNCarbonStateType + use atm2lndType + use TemperatureType + use SoilStateType + use WaterDiagnosticBulkType + use CanopyStateType + use SolarAbsorbedType + use SurfaceAlbedoType + use OzoneBaseMod + use pftconMod + use WaterFluxType + use SoilBiogeochemCarbonStateType + use SoilBiogeochemNitrogenStateType + use CNProductsMod + use SoilBiogeochemStateType + use CNVegStateType + use CNVegCarbonFluxType + use CNVegNitrogenFluxType + use GridcellType + use WaterFluxBulkType + use filterMod + use SoilBiogeochemCarbonFluxType + use SoilBiogeochemNitrogenFluxType + use PatchType + use ColumnType + use ch4Mod + use SoilBiogeochemDecompCascadeConType + use ActiveLayerMod + use CropType + use CNDVType use LandunitType use RootBiophysMod use CNMRespMod , only : readCNMRespParams => readParams use CNSharedParamsMod , only : CNParamsReadShared use spmdMod use Wateratm2lndBulkType - use CNCLM_WaterDiagnosticBulkType + use WaterDiagnosticBulkType use Wateratm2lndType use EnergyFluxType use SaturatedExcessRunoffMod @@ -133,6 +133,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) character(300) :: paramfile + character(300) :: NLFilename type(Netcdf4_fileformatter) :: ncid integer :: rc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon_old.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon_old.F90 deleted file mode 100644 index 9f66d335a..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon_old.F90 +++ /dev/null @@ -1,317 +0,0 @@ -module clm_varcon - - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! Module containing various model constants. - ! - ! !USES: - use shr_kind_mod , only: r8 => shr_kind_r8 - use shr_const_mod, only: SHR_CONST_G,SHR_CONST_STEBOL,SHR_CONST_KARMAN, & - SHR_CONST_RWV,SHR_CONST_RDAIR,SHR_CONST_CPFW, & - SHR_CONST_CPICE,SHR_CONST_CPDAIR,SHR_CONST_LATVAP, & - SHR_CONST_LATSUB,SHR_CONST_LATICE,SHR_CONST_RHOFW, & - SHR_CONST_RHOICE,SHR_CONST_TKFRZ,SHR_CONST_REARTH, & - SHR_CONST_PDB, SHR_CONST_PI, SHR_CONST_CDAY, & - SHR_CONST_RGAS, SHR_CONST_PSTD, & - SHR_CONST_MWDAIR, SHR_CONST_MWWV, SHR_CONST_CPFW - use clm_varpar , only: numrad, nlevgrnd, nlevlak, nlevdecomp_full - use clm_varpar , only: ngases - use clm_varpar , only: nlayer - - ! - ! !PUBLIC TYPES: - implicit none - save - private - !----------------------------------------------------------------------- - ! - ! !PUBLIC MEMBER FUNCTIONS: - public :: clm_varcon_init ! initialize constants in clm_varcon - public :: clm_varcon_clean ! deallocate variables allocated by clm_varcon_init - ! - ! !REVISION HISTORY: - ! Created by Mariana Vertenstein - ! 27 February 2008: Keith Oleson; Add forcing height and aerodynamic parameters - !----------------------------------------------------------------------- - - !------------------------------------------------------------------ - ! Initialize mathmatical constants - !------------------------------------------------------------------ - - real(r8), public :: rpi = SHR_CONST_PI - - !------------------------------------------------------------------ - ! Initialize physical constants - !------------------------------------------------------------------ - - real(r8), public, parameter :: pc = 0.4 ! threshold probability - real(r8), public, parameter :: mu = 0.13889 ! connectivity exponent - real(r8), public, parameter :: secsphr = 3600._r8 ! Seconds in an hour - integer, public, parameter :: isecsphr = int(secsphr) ! Integer seconds in an hour - integer, public, parameter :: isecspmin= 60 ! Integer seconds in a minute - real(r8), public :: grav = SHR_CONST_G ! gravity constant [m/s2] - real(r8), public :: sb = SHR_CONST_STEBOL ! stefan-boltzmann constant [W/m2/K4] - real(r8), public :: vkc = SHR_CONST_KARMAN ! von Karman constant [-] - real(r8), public :: rwat = SHR_CONST_RWV ! gas constant for water vapor [J/(kg K)] - real(r8), public :: rair = SHR_CONST_RDAIR ! gas constant for dry air [J/kg/K] - real(r8), public :: roverg = SHR_CONST_RWV/SHR_CONST_G*1000._r8 ! Rw/g constant = (8.3144/0.018)/(9.80616)*1000. mm/K - real(r8), public :: cpliq = SHR_CONST_CPFW ! Specific heat of water [J/kg-K] - real(r8), public :: cpice = SHR_CONST_CPICE ! Specific heat of ice [J/kg-K] - real(r8), public :: cpair = SHR_CONST_CPDAIR ! specific heat of dry air [J/kg/K] - real(r8), public :: hvap = SHR_CONST_LATVAP ! Latent heat of evap for water [J/kg] - real(r8), public :: hsub = SHR_CONST_LATSUB ! Latent heat of sublimation [J/kg] - real(r8), public :: hfus = SHR_CONST_LATICE ! Latent heat of fusion for ice [J/kg] - real(r8), public :: denh2o = SHR_CONST_RHOFW ! density of liquid water [kg/m3] - real(r8), public :: denice = SHR_CONST_RHOICE ! density of ice [kg/m3] - real(r8), public :: rgas = SHR_CONST_RGAS ! universal gas constant [J/K/kmole] - real(r8), public :: pstd = SHR_CONST_PSTD ! standard pressure [Pa] - - ! TODO(wjs, 2016-04-08) The following should be used in place of hard-coded constants - ! of 0.622 and 0.378 (which is 1 - 0.622) in various places in the code: - real(r8), public, parameter :: wv_to_dair_weight_ratio = SHR_CONST_MWWV/SHR_CONST_MWDAIR ! ratio of molecular weight of water vapor to that of dry air [-] - - real(r8), public :: tkair = 0.023_r8 ! thermal conductivity of air [W/m/K] - real(r8), public :: tkice = 2.290_r8 ! thermal conductivity of ice [W/m/K] - real(r8), public :: tkwat = 0.57_r8 ! thermal conductivity of water [W/m/K] - real(r8), public, parameter :: tfrz = SHR_CONST_TKFRZ ! freezing temperature [K] - real(r8), public, parameter :: tcrit = 2.5_r8 ! critical temperature to determine rain or snow - real(r8), public :: o2_molar_const = 0.209_r8 ! constant atmospheric O2 molar ratio (mol/mol) - real(r8), public :: oneatm = 1.01325e5_r8 ! one standard atmospheric pressure [Pa] - real(r8), public :: bdsno = 250._r8 ! bulk density snow (kg/m**3) - real(r8), public :: alpha_aero = 1.0_r8 ! constant for aerodynamic parameter weighting - real(r8), public :: tlsai_crit = 2.0_r8 ! critical value of elai+esai for which aerodynamic parameters are maximum - real(r8), public :: watmin = 0.01_r8 ! minimum soil moisture (mm) - real(r8), public :: c_water = SHR_CONST_CPFW ! specific heat of water [J/kg/K] - real(r8), public :: c_dry_biomass = 1400_r8 ! specific heat of dry biomass - - real(r8), public :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) - - real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second - real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day - integer, public, parameter :: isecspday= secspday ! Integer seconds per day - - integer, public, parameter :: fun_period = 1 ! A FUN parameter, and probably needs to be changed for testing - real(r8),public, parameter :: smallValue = 1.e-12_r8 ! A small values used by FUN - - ! ------------------------------------------------------------------------ - ! Special value flags - ! ------------------------------------------------------------------------ - - ! NOTE(wjs, 2015-11-23) The presence / absence of spval should be static in time for - ! multi-level fields. i.e., if a given level & column has spval at initialization, it - ! should remain spval throughout the run (e.g., indicating that this level is not valid - ! for this column type); similarly, if it starts as a valid value, it should never - ! become spval. This is needed for init_interp to work correctly on multi-level fields. - ! For more details, see the note near the top of initInterpMultilevelInterp. - real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data - - ! Keep this negative to avoid conflicts with possible valid values - integer , public, parameter :: ispval = -9999 ! special value for int data - - ! ------------------------------------------------------------------------ - ! These are tunable constants from clm2_3 - ! ------------------------------------------------------------------------ - - real(r8), public :: capr = 0.34_r8 ! Tuning factor to turn first layer T into surface T - real(r8), public :: cnfac = 0.5_r8 ! Crank Nicholson factor between 0 and 1 - real(r8), public :: pondmx = 0.0_r8 ! Ponding depth (mm) - real(r8), public :: pondmx_urban = 1.0_r8 ! Ponding depth for urban roof and impervious road (mm) - - real(r8), public :: thk_bedrock = 3.0_r8 ! thermal conductivity of 'typical' saturated granitic rock - ! (Clauser and Huenges, 1995)(W/m/K) - real(r8), public :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000) - real(r8), public, parameter :: zmin_bedrock = 0.4_r8 ! minimum soil depth [m] - - real(r8), public, parameter :: aquifer_water_baseline = 5000._r8 ! baseline value for water in the unconfined aquifer [mm] - real(r8), public, parameter :: c_to_b = 2.0_r8 ! conversion between mass carbon and total biomass (g biomass /g C) - - !!! C13 - real(r8), public, parameter :: preind_atm_del13c = -6.0 ! preindustrial value for atmospheric del13C - real(r8), public, parameter :: preind_atm_ratio = SHR_CONST_PDB + (preind_atm_del13c * SHR_CONST_PDB)/1000.0 ! 13C/12C - real(r8), public :: c13ratio = preind_atm_ratio/(1.0+preind_atm_ratio) ! 13C/(12+13)C preind atmosphere - - ! typical del13C for C3 photosynthesis (permil, relative to PDB) - real(r8), public, parameter :: c3_del13c = -28._r8 - - ! typical del13C for C4 photosynthesis (permil, relative to PDB) - real(r8), public, parameter :: c4_del13c = -13._r8 - - ! isotope ratio (13c/12c) for C3 photosynthesis - real(r8), public, parameter :: c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8) - - ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis - real(r8), public, parameter :: c3_r2 = c3_r1/(1._r8 + c3_r1) - - ! isotope ratio (13c/12c) for C4 photosynthesis - real(r8), public, parameter :: c4_r1 = SHR_CONST_PDB + ((c4_del13c*SHR_CONST_PDB)/1000._r8) - - ! isotope ratio (13c/[12c+13c]) for C4 photosynthesis - real(r8), public, parameter :: c4_r2 = c4_r1/(1._r8 + c4_r1) - - !!! C14 - real(r8), public :: c14ratio = 1.e-12_r8 - ! real(r8) :: c14ratio = 1._r8 ! debug lets set to 1 to try to avoid numerical errors - - !------------------------------------------------------------------ - ! Urban building temperature constants - !------------------------------------------------------------------ - real(r8), public :: ht_wasteheat_factor = 0.2_r8 ! wasteheat factor for urban heating (-) - real(r8), public :: ac_wasteheat_factor = 0.6_r8 ! wasteheat factor for urban air conditioning (-) - real(r8), public :: em_roof_int = 0.9_r8 ! emissivity of interior surface of roof (Bueno et al. 2012, GMD) - real(r8), public :: em_sunw_int = 0.9_r8 ! emissivity of interior surface of sunwall (Bueno et al. 2012, GMD) - real(r8), public :: em_shdw_int = 0.9_r8 ! emissivity of interior surface of shadewall Bueno et al. 2012, GMD) - real(r8), public :: em_floor_int = 0.9_r8 ! emissivity of interior surface of floor (Bueno et al. 2012, GMD) - real(r8), public :: hcv_roof = 0.948_r8 ! interior convective heat transfer coefficient for roof (Bueno et al. 2012, GMD) (W m-2 K-1) - real(r8), public :: hcv_roof_enhanced = 4.040_r8 ! enhanced (t_roof_int <= t_room) interior convective heat transfer coefficient for roof (Bueno et al. 2012, GMD) !(W m-2 K-1) - real(r8), public :: hcv_floor = 0.948_r8 ! interior convective heat transfer coefficient for floor (Bueno et al. 2012, GMD) (W m-2 K-1) - real(r8), public :: hcv_floor_enhanced = 4.040_r8 ! enhanced (t_floor_int >= t_room) interior convective heat transfer coefficient for floor (Bueno et al. !2012, GMD) (W m-2 K-1) - real(r8), public :: hcv_sunw = 3.076_r8 ! interior convective heat transfer coefficient for sunwall (Bueno et al. 2012, GMD) (W m-2 K-1) - real(r8), public :: hcv_shdw = 3.076_r8 ! interior convective heat transfer coefficient for shadewall (Bueno et al. 2012, GMD) (W m-2 K-1) - real(r8), public :: dz_floor = 0.1_r8 ! floor thickness - concrete (Salmanca et al. 2010, TAC) (m) - real(r8), public, parameter :: dens_floor = 2.35e3_r8 ! density of floor - concrete (Salmanca et al. 2010, TAC) (kg m-3) - real(r8), public, parameter :: sh_floor = 880._r8 ! specific heat of floor - concrete (Salmanca et al. 2010, TAC) (J kg-1 K-1) - real(r8), public :: cp_floor = dens_floor*sh_floor ! volumetric heat capacity of floor - concrete (Salmanca et al. 2010, TAC) (J m-3 K-1) - real(r8), public :: vent_ach = 0.3 ! ventilation rate (air exchanges per hour) - - real(r8), public :: wasteheat_limit = 100._r8 ! limit on wasteheat (W/m2) - - !------------------------------------------------------------------ - - real(r8), public :: h2osno_max = -999.0_r8 ! max allowed snow thickness (mm H2O) - - integer, private :: i ! loop index - - !real(r8), parameter :: nitrif_n2o_loss_frac = 0.02_r8 ! fraction of N lost as N2O in nitrification (Parton et al., 2001) - real(r8), public, parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000) - real(r8), public, parameter :: frac_minrlztn_to_no3 = 0.2_r8 ! fraction of N mineralized that is dieverted to the nitrification stream (Parton et al., 2001) - - !------------------------------------------------------------------ - ! Set subgrid names - !------------------------------------------------------------------ - - character(len=16), public, parameter :: grlnd = 'lndgrid' ! name of lndgrid - character(len=16), public, parameter :: namea = 'gridcellatm' ! name of atmgrid - character(len=16), public, parameter :: nameg = 'gridcell' ! name of gridcells - character(len=16), public, parameter :: namel = 'landunit' ! name of landunits - character(len=16), public, parameter :: namec = 'column' ! name of columns - character(len=16), public, parameter :: namep = 'pft' ! name of patches - character(len=16), public, parameter :: nameCohort = 'cohort' ! name of cohorts (ED specific) - - !------------------------------------------------------------------ - ! Initialize miscellaneous radiation constants - !------------------------------------------------------------------ - - real(r8), public :: betads = 0.5_r8 ! two-stream parameter betad for snow - real(r8), public :: betais = 0.5_r8 ! two-stream parameter betai for snow - real(r8), public :: omegas(numrad) ! two-stream parameter omega for snow by band - data (omegas(i),i=1,numrad) /0.8_r8, 0.4_r8/ - - ! Lake Model Constants will be defined in LakeCon. - - !------------------------------------------------------------------ - ! Soil depths are constants for now; lake depths can vary by gridcell - ! zlak and dzlak correspond to the default 50 m lake depth. - ! The values for the following arrays are set in routine iniTimeConst - !------------------------------------------------------------------ - - real(r8), public, allocatable :: zlak(:) !lake z (layers) - real(r8), public, allocatable :: dzlak(:) !lake dz (thickness) - real(r8), public, allocatable :: zsoi(:) !soil z (layers) - real(r8), public, allocatable :: dzsoi(:) !soil dz (thickness) - real(r8), public, allocatable :: zisoi(:) !soil zi (interfaces) - real(r8), public, allocatable :: dzsoi_decomp(:) !soil dz (thickness) - integer , public, allocatable :: nlvic(:) !number of CLM layers in each VIC layer (#) - real(r8), public, allocatable :: dzvic(:) !soil dz (thickness) of each VIC layer - - !------------------------------------------------------------------ - ! (Non-tunable) Constants for the CH4 submodel (Tuneable constants in ch4varcon) - !------------------------------------------------------------------ - ! Note some of these constants are also used in CNNitrifDenitrifMod - - real(r8), public, parameter :: catomw = 12.011_r8 ! molar mass of C atoms (g/mol) - - real(r8), public :: s_con(ngases,4) ! Schmidt # calculation constants (spp, #) - data (s_con(1,i),i=1,4) /1898_r8, -110.1_r8, 2.834_r8, -0.02791_r8/ ! CH4 - data (s_con(2,i),i=1,4) /1801_r8, -120.1_r8, 3.7818_r8, -0.047608_r8/ ! O2 - data (s_con(3,i),i=1,4) /1911_r8, -113.7_r8, 2.967_r8, -0.02943_r8/ ! CO2 - - real(r8), public :: d_con_w(ngases,3) ! water diffusivity constants (spp, #) (mult. by 10^-4) - data (d_con_w(1,i),i=1,3) /0.9798_r8, 0.02986_r8, 0.0004381_r8/ ! CH4 - data (d_con_w(2,i),i=1,3) /1.172_r8, 0.03443_r8, 0.0005048_r8/ ! O2 - data (d_con_w(3,i),i=1,3) /0.939_r8, 0.02671_r8, 0.0004095_r8/ ! CO2 - - real(r8), public :: d_con_g(ngases,2) ! gas diffusivity constants (spp, #) (cm^2/s) (mult. by 10^-9) - data (d_con_g(1,i),i=1,2) /0.1875_r8, 0.0013_r8/ ! CH4 - data (d_con_g(2,i),i=1,2) /0.1759_r8, 0.00117_r8/ ! O2 - data (d_con_g(3,i),i=1,2) /0.1325_r8, 0.0009_r8/ ! CO2 - - real(r8), public :: c_h_inv(ngases) ! constant (K) for Henry's law (4.12, Wania) - data c_h_inv(1:3) /1600._r8, 1500._r8, 2400._r8/ ! CH4, O2, CO2 - - real(r8), public :: kh_theta(ngases) ! Henry's constant (L.atm/mol) at standard temperature (298K) - data kh_theta(1:3) /714.29_r8, 769.23_r8, 29.4_r8/ ! CH4, O2, CO2 - - real(r8), public :: kh_tbase = 298._r8 ! base temperature for calculation of Henry's constant (K) - !----------------------------------------------------------------------- - -contains - - !------------------------------------------------------------------------------ - subroutine clm_varcon_init( is_simple_buildtemp ) - ! - ! !DESCRIPTION: - ! This subroutine initializes constant arrays in clm_varcon. - ! MUST be called after clm_varpar_init. - ! - ! !USES: - use clm_varpar, only: nlevgrnd, nlevlak, nlevdecomp_full, nlayer - ! - ! !ARGUMENTS: - implicit none - logical, intent(in) :: is_simple_buildtemp ! If simple building temp method is being used - ! - ! !REVISION HISTORY: - ! Created by E. Kluzek -!------------------------------------------------------------------------------ - - allocate( zlak(1:nlevlak )) - allocate( dzlak(1:nlevlak )) - allocate( zsoi(1:nlevgrnd )) - allocate( dzsoi(1:nlevgrnd )) - allocate( zisoi(0:nlevgrnd )) - allocate( dzsoi_decomp(1:nlevdecomp_full )) - allocate( nlvic(1:nlayer )) - allocate( dzvic(1:nlayer )) - - ! Zero out wastheat factors for simpler building temperature method (introduced in CLM4.5) - if ( is_simple_buildtemp )then - ht_wasteheat_factor = 0.0_r8 - ac_wasteheat_factor = 0.0_r8 - end if - - end subroutine clm_varcon_init - - !----------------------------------------------------------------------- - subroutine clm_varcon_clean() - ! - ! !DESCRIPTION: - ! Deallocate variables allocated by clm_varcon_init - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'clm_varcon_clean' - !----------------------------------------------------------------------- - - deallocate(zlak) - deallocate(dzlak) - deallocate(zsoi) - deallocate(dzsoi) - deallocate(zisoi) - deallocate(dzsoi_decomp) - deallocate(nlvic) - deallocate(dzvic) - - end subroutine clm_varcon_clean - - -end module clm_varcon diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CMakeLists.txt new file mode 100644 index 000000000..c212ee058 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CMakeLists.txt @@ -0,0 +1,19 @@ +esma_set_this () + +string (REPLACE GEOScatchCNCLM51_GridComp_ "" is_openmp ${this}) + +esma_add_subdirectories (CLM51) + +set (srcs + GEOS_CatchCNCLM51GridComp.F90 + ) + +esma_add_library (${this} + SRCS ${srcs} + DEPENDENCIES MAPL GEOS_Shared GEOS_LandShared CLM51 GEOS_CatchCNShared esmf NetCDF::NetCDF_Fortran + TYPE SHARED) + +if (is_openmp) + target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) +endif () + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 6be76ee9f..c7aa2af7b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -34,7 +34,7 @@ module GEOS_CatchCNCLM51GridCompMod use GEOS_UtilsMod use DragCoefficientsMod use CATCHMENT_CN_MODEL - use CN_DriverMod + use CNCLM_DriverMod use CN_initMod USE STIEGLITZSNOW, ONLY : & snow_albedo, StieglitzSnow_calc_tpsnow, N_CONSTIT, & From 724a91610e5ae3210d9732875d69c59f2470eddc Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 19 Oct 2022 13:08:39 -0400 Subject: [PATCH 009/589] use same peat boundary conditions file for CNCLM45 and CNCLM51 --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 3a338588e..539fc4c4f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -495,7 +495,7 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) endif - if (this%isCLM45 ) then + if ((this%isCLM45) .or. (this%isCLM51)) then open(newunit=unit30, file=trim(OutBcsDir)//'/clsm/CLM4.5_abm_peatf_gdp_hdm_fc' ,form='formatted') do n=1,ntiles @@ -504,16 +504,6 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) end do CLOSE (unit30, STATUS = 'KEEP') endif - - if (this%isCLM51 ) then - - open(newunit=unit32, file=trim(OutBcsDir)//'/clsm/CLM5.1_abm_peatf_gdp_hdm_fc' ,form='formatted') - do n=1,ntiles - read (unit32, *) i, j, abm(n), peatf(n), & - gdp(n), hdm(n), fc(n) - end do - CLOSE (unit32, STATUS = 'KEEP') - endif do n=1,ntiles BVISDR(n) = amax1(1.e-6, BVISDR(n)) From 289b3d7288a9af3c644f569a17eb99c5b707af2a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 19 Oct 2022 14:04:45 -0400 Subject: [PATCH 010/589] correcting typo in CNVLM51 variable read --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 539fc4c4f..1c7702876 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -347,7 +347,7 @@ subroutine write_nc4(this, filename, rc) call MAPL_VarWrite(formatter,"WINDM", this%WINDM) call MAPL_VarWrite(formatter,"RAINFM", this%RAINFM) call MAPL_VarWrite(formatter,"SNOWFM", this%SNOWFM) - call MAPL_VarWrite(formatter,"RUNSRFM", this%RUNSURFM) + call MAPL_VarWrite(formatter,"RUNSRFM", this%RUNSRFM) call MAPL_VarWrite(formatter,"AR1M", this%AR1M) call MAPL_VarWrite(formatter,"SNDZM5D", this%SNDZM5D) call MAPL_VarWrite(formatter,"T2M10D", this%T2M10D) From 5b84ba9e6b471fd6e823dab9dc4c930a1b128d6c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 19 Oct 2022 14:25:08 -0400 Subject: [PATCH 011/589] correcting typo in CNVLM51 variable read --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 1c7702876..278c159e3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -176,7 +176,7 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) call MAPL_VarRead(formatter,"WINDM", catch%WINDM , __RC__) call MAPL_VarRead(formatter,"RAINFM", catch%RAINFM , __RC__) call MAPL_VarRead(formatter,"SNOWFM", catch%SNOWFM , __RC__) - call MAPL_VarRead(formatter,"RUNSRFM", catch%RUNSURFM, __RC__) + call MAPL_VarRead(formatter,"RUNSRFM", catch%RUNSRFM, __RC__) call MAPL_VarRead(formatter,"AR1M", catch%AR1M , __RC__) call MAPL_VarRead(formatter,"SNDZM5D", catch%SNDZM5D , __RC__) call MAPL_VarRead(formatter,"T2M10D", catch%T2M10D , __RC__) @@ -411,7 +411,7 @@ subroutine allocate_cn(this,rc) allocate(this%WINDM(ntiles)) allocate(this%RAINFM(ntiles)) allocate(this%SNOWFM(ntiles)) - allocate(this%RUNSURFM(ntiles)) + allocate(this%RUNSRFM(ntiles)) allocate(this%AR1M(ntiles)) allocate(this%RH30D(ntiles)) allocate(this%TG10D(ntiles)) From 11033ac1438013abec74cccb4f881196ded69c73 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 19 Oct 2022 15:10:29 -0400 Subject: [PATCH 012/589] fixing open if-block --- .../Utils/mk_restarts/mk_GEOSldasRestarts.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 index b8ffe31be..e8af9addc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 @@ -2633,7 +2633,7 @@ SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC10D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'TPREC60D'), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'T2M10D' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) - if(clm51) then + elseif(clm51) then STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'AR1M' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RAINFM' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) STATUS = NF_PUT_VARA_REAL(OutID,VarID(OUTID,'RHM' ), (/1/), (/NTILES/),VAR_DUM(:)) ; VERIFY_(STATUS) From 7e807e1f2ce018bd667e121d1b952509d45c8bc5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 19 Oct 2022 15:36:14 -0400 Subject: [PATCH 013/589] fixing CNCLM51 logical name and data assigment statement --- .../Utils/mk_restarts/mk_GEOSldasRestarts.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 index e8af9addc..1921347c2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 @@ -2375,7 +2375,7 @@ SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & var_pft_out(n, nz,nv,73) = max(var_pft_out(n, nz,nv,73),0.) var_pft_out(n, nz,nv,74) = max(var_pft_out(n, nz,nv,74),0.) if(clm45) var_pft_out(n, nz,nv,75) = max(var_pft_out(n, nz,nv,75),0.) - if(this%isCLM51) then + if(clm51) then var_pft_out(n, nz,nv,76) = max(var_pft_out(n, nz,nv,76),0.) var_pft_out(n, nz,nv,77) = max(var_pft_out(n, nz,nv,77),0.) var_pft_out(n, nz,nv,78) = max(var_pft_out(n, nz,nv,78),0.) @@ -2590,8 +2590,7 @@ SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & do iv = 1,VAR_PFT do nv = 1,nveg do nz = 1,nzone - this%cnpft(:,i) = var_pft_out(:, nz,nv,iv) - !STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNPFT'), (/1,i/), (/NTILES,1 /),var_pft_out(:, nz,nv,iv)) ; VERIFY_(STATUS) + STATUS = NF_PUT_VARA_REAL(OutID,VarID(OutID,'CNPFT'), (/1,i/), (/NTILES,1 /),var_pft_out(:, nz,nv,iv)) ; VERIFY_(STATUS) i = i + 1 end do end do From def1d05cc887ca0d52d9a40a31e8ddefa7552770 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 19 Oct 2022 16:06:37 -0400 Subject: [PATCH 014/589] fix to CMake and correction of CNCLM51 name in GridComps --- .../GEOScatchCN_GridComp/CMakeLists.txt | 1 + .../GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 | 5 ++++- .../GEOS_CatchCNCLM51GridComp.F90 | 12 ++++++------ 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/CMakeLists.txt index 3634805ab..43cdd1704 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/CMakeLists.txt @@ -2,6 +2,7 @@ esma_set_this () add_subdirectory (GEOScatchCNCLM40_GridComp) add_subdirectory (GEOScatchCNCLM45_GridComp) +add_subdirectory (GEOScatchCNCLM51_GridComp) esma_add_library (${this} SRCS GEOS_CatchCNGridComp.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 677fc266a..64ce75cb1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -91,8 +91,11 @@ subroutine SetServices ( GC, RC ) else if ( LSM_CHOICE == 3 ) then CATCHCN = MAPL_AddChild('CATCHCNCLM45'//trim(tmp), 'setservices_', parentGC=GC, sharedObj='libGEOScatchCNCLM45_GridComp.so', RC=STATUS) VERIFY_(STATUS) + else if ( LSM_CHOICE == 4 ) then + CATCHCN = MAPL_AddChild('CATCHCNCLM51'//trim(tmp), 'setservices_', parentGC=GC, sharedObj='libGEOScatchCNCLM51_GridComp.so', RC=STATUS) + VERIFY_(STATUS) else - _ASSERT( .false., " LSM_CHOICE should equal 2 (CLM40) or 3 (CLM45)") + _ASSERT( .false., " LSM_CHOICE should equal 2 (CLM40) or 3 (CLM45) or 4 (CLM51)") endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index c7aa2af7b..cd1ebd4a4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -3741,7 +3741,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="RUN2" ,RC=STATUS) VERIFY_(STATUS) - call MAPL_TimerAdd(GC, name="-CATCHCNCLM45" ,RC=STATUS) + call MAPL_TimerAdd(GC, name="-CATCHCNCLM51" ,RC=STATUS) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="-ALBEDO" ,RC=STATUS) VERIFY_(STATUS) @@ -7214,7 +7214,7 @@ subroutine Driver ( RC ) VERIFY_(STATUS) if (UNIT_i == 0) then - unit_i = GETFILE( "catchcnclm45_inputs.data", form="unformatted", RC=STATUS ) + unit_i = GETFILE( "catchcnclm51_inputs.data", form="unformatted", RC=STATUS ) VERIFY_(STATUS) endif unit = unit_i @@ -7297,7 +7297,7 @@ subroutine Driver ( RC ) ! params if (firsttime) then firsttime = .false. - unit = GETFILE( "catchcnclm45_params.data", form="unformatted", RC=STATUS ) + unit = GETFILE( "catchcnclm51_params.data", form="unformatted", RC=STATUS ) VERIFY_(STATUS) call WRITE_PARALLEL(NT_GLOBAL, UNIT) @@ -7344,7 +7344,7 @@ subroutine Driver ( RC ) VERIFY_(STATUS) ! Updates - unit = GETFILE( "catchcnclm45_updates.data", form="unformatted", RC=STATUS ) + unit = GETFILE( "catchcnclm51_updates.data", form="unformatted", RC=STATUS ) VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, TG(:,FSAT), mask=mask, rc=status); VERIFY_(STATUS) @@ -8426,11 +8426,11 @@ subroutine RUN0(gc, import, export, clock, rc) end subroutine RUN0 -end module GEOS_CatchCNCLM45GridCompMod +end module GEOS_CatchCNCLM51GridCompMod subroutine SetServices(gc, rc) use ESMF - use GEOS_CatchCNCLM45GridCompMod, only : mySetservices=>SetServices + use GEOS_CatchCNCLM51GridCompMod, only : mySetservices=>SetServices type(ESMF_GridComp) :: gc integer, intent(out) :: rc call mySetServices(gc, rc=rc) From e54c5a5a410bb390fe098c34935e4a113add3b86 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 08:03:24 -0400 Subject: [PATCH 015/589] fixing position of implicit none --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 3d087a816..68fb29340 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -12,9 +12,10 @@ module clm_varctl use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 ! ! !PUBLIC MEMBER FUNCTIONS: - public init_clm_varctl ! set parameters implicit none + public init_clm_varctl ! set parameters + logical, public :: use_nguardrail = .true. ! true => use precision control logical, public :: use_luna = .false. ! true => use LUNA From 0dd4721bc70264205abda79fff310f0d03e0fdb9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 08:43:38 -0400 Subject: [PATCH 016/589] add missing use statement and missing logical --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 68fb29340..0a71c676b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -35,7 +35,7 @@ module clm_varctl logical, public :: use_grainproduct = .false. logical, public :: use_dynroot = .false. logical, public :: use_bedrock = .false. ! true => use spatially variable soil depth - + logical, public :: use_extralakelayers = .false. logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index 2fcfcf021..65281c913 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -123,6 +123,8 @@ subroutine clm_varpar_init() ! !DESCRIPTION: ! This subroutine initializes parameters in clm_varpar ! + use clm_varctl, only : use_vertsoilc, use_extralakelayers, use_fates, & + use_century_decomp, use_crop ! ! !ARGUMENTS: implicit none From 373beb5c0f553c3443cb375c0b4bc24bcc5c2107 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 09:46:51 -0400 Subject: [PATCH 017/589] correcting module names in use statements --- .../CLM51/CNCLM_CNProductsMod.F90 | 2 +- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 2 +- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 2 +- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 2 +- .../CLM51/CNCLM_CNVegStateType.F90 | 2 +- .../CLM51/CNCLM_CanopyStateType.F90 | 2 +- .../CLM51/CNCLM_ColumnType.F90 | 2 +- .../CLM51/CNCLM_CropType.F90 | 2 +- .../CLM51/CNCLM_DriverMod.F90 | 20 +- .../CLM51/CNCLM_GridcellType.F90 | 2 +- .../CLM51/CNCLM_OzoneBaseMod.F90 | 2 +- .../CLM51/CNCLM_PatchType.F90 | 6 +- .../CLM51/CNCLM_PhotosynsType.F90 | 553 ------------------ .../CNCLM_SoilBiogeochemCarbonStateType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 2 +- .../CLM51/CNCLM_SoilStateType.F90 | 2 +- .../CLM51/CNCLM_SolarAbsorbedType.F90 | 2 +- .../CLM51/CNCLM_SurfaceAlbedoType.F90 | 3 +- .../CLM51/CNCLM_TemperatureType.F90 | 2 +- .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 2 +- .../CLM51/CNCLM_WaterFluxBulkType.F90 | 6 +- .../CLM51/CNCLM_WaterFluxType.F90 | 2 +- .../CLM51/CNCLM_atm2lndType.F90 | 2 +- .../CLM51/CNCLM_ch4Mod.F90 | 2 +- .../CLM51/CNCLM_filterMod.F90 | 2 +- 25 files changed, 39 insertions(+), 589 deletions(-) delete mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index faa4d877e..754658948 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -3,7 +3,7 @@ module CNProductsMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use MAPL_ExceptionHandling use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type use clm_varpar , only : num_zon, var_col, cn_zone_weight ! !PUBLIC TYPES: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 79a29fc88..98d3f90be 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -2,7 +2,7 @@ module CNVegCarbonFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools,& nvegcpool,ncphtrans,ncgmtrans,ncfitrans,& ncphouttrans,ncgmouttrans,ncfiouttrans diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 6a7bda7d0..3013b2dce 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -5,7 +5,7 @@ module CNVegCarbonStateType use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type use pftconMod , only : noveg, npcropmin, pftcon use PatchType , only : patch diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index f72b35244..e35ea77a2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -2,7 +2,7 @@ module CNVegNitrogenFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools,& nvegcpool,ncphtrans,ncgmtrans,ncfitrans,& ncphouttrans,ncgmouttrans,ncfiouttrans diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index ef69ad461..9ab30befa 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -4,7 +4,7 @@ module CNVegStateType use nanMod , only : nan use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoi use clm_varcon , only : spval, ispval - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 833d1443d..5693b6d55 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -5,7 +5,7 @@ module CanopyStateType var_col, var_pft use clm_varcon , only : spval use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index d237dd36e..e7c666bf1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -21,7 +21,7 @@ module ColumnType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type use clm_varcon , only : zsoi, dzsoi, zisoi, dzsoi_decomp, spval, ispval use clm_varctl , only : use_fates use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevmaxurbgrnd,nlevurb, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 index 6928d1e33..943a5ab1f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 @@ -3,7 +3,7 @@ module CropType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varcon , only : spval use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none save diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index cc3ecf51a..c086a6c48 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -1,4 +1,4 @@ -module CN_DriverMod +module CNCLM_DriverMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan @@ -29,18 +29,18 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m sminn_to_npoolg,ndep_to_sminng,totvegng,totlitng,totsomng,& retransng,retransn_to_npoolg,fuelcg,totlitcg,cwdcg,rootcg) - use CNCLM_decompMod, only : bounds - use CNCLM_filterMod, only : filter - use CNCLM_SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_inst - use CNCLM_SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_inst - use CNCLM_ActiveLayerMod - use CNCLM_GridcellType + use decompMod, only : bounds + use filterMod, only : filter + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_inst + use SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_inst + use ActiveLayerMod + use GridcellType use FireMethodType , only : fire_method_inst use SaturatedExcessRunoffMod , only : saturated_excess_runoff_inst - use CNCLM_WaterDiagnosticBulkType, only : waterdiagnosticbulk_inst - use CNCLM_atm2lndType , only : atm2lnd_inst + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_inst + use atm2lndType , only : atm2lnd_inst use Wateratm2lndBulkType , only : wateratm2lndbulk_inst - use CNCLM_CNVegStateType , only : cnveg_state_inst + use CNVegStateType , only : cnveg_state_inst use WaterStateBulkType , only : waterstatebulk_inst !ARGUMENTS diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index 3261e03a4..4f1bd3126 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -2,7 +2,7 @@ module GridcellType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4, MAPL_PI use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type use clm_varcon , only : ispval use clm_varpar , only : numpft, num_zon, num_veg, var_pft diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 index a59da717b..d1afbb6cf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 @@ -2,7 +2,7 @@ module OzoneBaseMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 523c99027..a0fd5b52e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -2,9 +2,9 @@ module PatchType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type - use clm_varcon , only : ispval - use clm_varctl , only : use_fates + use decompMod , only : bounds_type + use clm_varcon , only : ispval + use clm_varctl , only : use_fates !----------------------------------------------------------------------- ! !DESCRIPTION: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 deleted file mode 100644 index c424dc6d6..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PhotosynsType.F90 +++ /dev/null @@ -1,553 +0,0 @@ -module CNCLM_PhotosynsType - - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use clm_varctl , only : use_luna - use clm_varpar , only : numpft, num_zon, num_veg, & - var_col, var_pft - use nanMod , only : nan - use CNCLM_pftconMod , only : pftcon - use CNCLM_decompMod , only : bounds_type - - ! !PUBLIC TYPES: - implicit none - save - - ! !PUBLIC VARIABLES: - - type :: photo_params_type - real(r8) :: act25 ! Rubisco activity at 25 C (umol CO2/gRubisco/s) - real(r8) :: fnr ! Mass ratio of total Rubisco molecular mass to nitrogen in Rubisco (gRubisco/gN in Rubisco) - real(r8) :: cp25_yr2000 ! CO2 compensation point at 25°C at present day O2 (mol/mol) - real(r8) :: kc25_coef ! Michaelis-Menten const. at 25°C for CO2 (unitless) - real(r8) :: ko25_coef ! Michaelis-Menten const. at 25°C for O2 (unitless) - real(r8) :: fnps ! Fraction of light absorbed by non-photosynthetic pigment (unitless) - real(r8) :: theta_psii ! Empirical curvature parameter for electron transport rate (unitless) - real(r8) :: theta_ip ! Empirical curvature parameter for ap photosynthesis co-limitation (unitless) - real(r8) :: vcmaxha ! Activation energy for vcmax (J/mol) - real(r8) :: jmaxha ! Activation energy for jmax (J/mol) - real(r8) :: tpuha ! Activation energy for tpu (J/mol) - real(r8) :: lmrha ! Activation energy for lmr (J/mol) - real(r8) :: kcha ! Activation energy for kc (J/mol) - real(r8) :: koha ! Activation energy for ko (J/mol) - real(r8) :: cpha ! Activation energy for cp (J/mol) - real(r8) :: vcmaxhd ! Deactivation energy for vcmax (J/mol) - real(r8) :: jmaxhd ! Deactivation energy for jmax (J/mol) - real(r8) :: tpuhd ! Deactivation energy for tpu (J/mol) - real(r8) :: lmrhd ! Deactivation energy for lmr (J/mol) - real(r8) :: lmrse ! Entropy term for lmr (J/mol/K) - real(r8) :: tpu25ratio ! Ratio of tpu25top to vcmax25top (unitless) - real(r8) :: kp25ratio ! Ratio of kp25top to vcmax25top (unitless) - real(r8) :: vcmaxse_sf ! Scale factor for vcmaxse (unitless) - real(r8) :: jmaxse_sf ! Scale factor for jmaxse (unitless) - real(r8) :: tpuse_sf ! Scale factor for tpuse (unitless) - real(r8) :: jmax25top_sf ! Scale factor for jmax25top (unitless) - real(r8), allocatable, public :: krmax (:) - real(r8), allocatable, private :: kmax (:,:) - real(r8), allocatable, private :: psi50 (:,:) - real(r8), allocatable, private :: ck (:,:) - real(r8), allocatable, private :: lmr_intercept_atkin(:) - real(r8), allocatable, private :: theta_cj (:) ! Empirical curvature parameter for ac, aj photosynthesis co-limitation (unitless) - contains - procedure, private :: allocParams - end type photo_params_type - ! - type(photo_params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod - - -! -! !PUBLIC MEMBER FUNCTIONS: - public :: init_photosyns_type - - type, public :: photosyns_type - - logical , pointer, private :: c3flag_patch (:) ! patch true if C3 and false if C4 - ! Plant hydraulic stress specific variables - real(r8), pointer, private :: ac_phs_patch (:,:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: aj_phs_patch (:,:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: ap_phs_patch (:,:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: ag_phs_patch (:,:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: an_sun_patch (:,:) ! patch sunlit net leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: an_sha_patch (:,:) ! patch shaded net leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: vcmax_z_phs_patch (:,:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s) - real(r8), pointer, private :: kp_z_phs_patch (:,:,:) ! patch initial slope of CO2 response curve (C4 plants) - real(r8), pointer, private :: tpu_z_phs_patch (:,:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s) - real(r8), pointer, public :: gs_mol_sun_patch (:,:) ! patch sunlit leaf stomatal conductance (umol H2O/m**2/s) - real(r8), pointer, public :: gs_mol_sha_patch (:,:) ! patch shaded leaf stomatal conductance (umol H2O/m**2/s) - real(r8), pointer, private :: gs_mol_sun_ln_patch (:,:) ! patch sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) - real(r8), pointer, private :: gs_mol_sha_ln_patch (:,:) ! patch shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon (umol H2O/m**2/s) - real(r8), pointer, private :: ac_patch (:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: aj_patch (:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: ap_patch (:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: ag_patch (:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: an_patch (:,:) ! patch net leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: vcmax_z_patch (:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s) - real(r8), pointer, private :: cp_patch (:) ! patch CO2 compensation point (Pa) - real(r8), pointer, private :: kc_patch (:) ! patch Michaelis-Menten constant for CO2 (Pa) - real(r8), pointer, private :: ko_patch (:) ! patch Michaelis-Menten constant for O2 (Pa) - real(r8), pointer, private :: qe_patch (:) ! patch quantum efficiency, used only for C4 (mol CO2 / mol photons) - real(r8), pointer, private :: tpu_z_patch (:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s) - real(r8), pointer, private :: kp_z_patch (:,:) ! patch initial slope of CO2 response curve (C4 plants) - real(r8), pointer, private :: bbb_patch (:) ! patch Ball-Berry minimum leaf conductance (umol H2O/m**2/s) - real(r8), pointer, private :: mbb_patch (:) ! patch Ball-Berry slope of conductance-photosynthesis relationship - real(r8), pointer, private :: gs_mol_patch (:,:) ! patch leaf stomatal conductance (umol H2O/m**2/s) - real(r8), pointer, private :: gb_mol_patch (:) ! patch leaf boundary layer conductance (umol H2O/m**2/s) - real(r8), pointer, private :: rh_leaf_patch (:) ! patch fractional humidity at leaf surface (dimensionless) - real(r8), pointer, private :: vpd_can_patch (:) ! patch canopy vapor pressure deficit (kPa) - real(r8), pointer, private :: alphapsnsun_patch (:) ! patch sunlit 13c fractionation ([]) - real(r8), pointer, private :: alphapsnsha_patch (:) ! patch shaded 13c fractionation ([]) - - real(r8), pointer, public :: rc13_canair_patch (:) ! patch C13O2/C12O2 in canopy air - real(r8), pointer, public :: rc13_psnsun_patch (:) ! patch C13O2/C12O2 in sunlit canopy psn flux - real(r8), pointer, public :: rc13_psnsha_patch (:) ! patch C13O2/C12O2 in shaded canopy psn flux - - real(r8), pointer, public :: psnsun_patch (:) ! patch sunlit leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, public :: psnsha_patch (:) ! patch shaded leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, public :: c13_psnsun_patch (:) ! patch c13 sunlit leaf photosynthesis (umol 13CO2/m**2/s) - real(r8), pointer, public :: c13_psnsha_patch (:) ! patch c13 shaded leaf photosynthesis (umol 13CO2/m**2/s) - real(r8), pointer, public :: c14_psnsun_patch (:) ! patch c14 sunlit leaf photosynthesis (umol 14CO2/m**2/s) - real(r8), pointer, public :: c14_psnsha_patch (:) ! patch c14 shaded leaf photosynthesis (umol 14CO2/m**2/s) - - real(r8), pointer, private :: psnsun_z_patch (:,:) ! patch canopy layer: sunlit leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: psnsha_z_patch (:,:) ! patch canopy layer: shaded leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: psnsun_wc_patch (:) ! patch Rubsico-limited sunlit leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: psnsha_wc_patch (:) ! patch Rubsico-limited shaded leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: psnsun_wj_patch (:) ! patch RuBP-limited sunlit leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: psnsha_wj_patch (:) ! patch RuBP-limited shaded leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: psnsun_wp_patch (:) ! patch product-limited sunlit leaf photosynthesis (umol CO2/m**2/s) - real(r8), pointer, private :: psnsha_wp_patch (:) ! patch product-limited shaded leaf photosynthesis (umol CO2/m**2/s) - - real(r8), pointer, public :: fpsn_patch (:) ! patch photosynthesis (umol CO2/m**2 ground/s) - real(r8), pointer, private :: fpsn_wc_patch (:) ! patch Rubisco-limited photosynthesis (umol CO2/m**2 ground/s) - real(r8), pointer, private :: fpsn_wj_patch (:) ! patch RuBP-limited photosynthesis (umol CO2/m**2 ground/s) - real(r8), pointer, private :: fpsn_wp_patch (:) ! patch product-limited photosynthesis (umol CO2/m**2 ground/s) - - real(r8), pointer, public :: lnca_patch (:) ! top leaf layer leaf N concentration (gN leaf/m^2) - - real(r8), pointer, public :: lmrsun_patch (:) ! patch sunlit leaf maintenance respiration rate (umol CO2/m**2/s) - real(r8), pointer, public :: lmrsha_patch (:) ! patch shaded leaf maintenance respiration rate (umol CO2/m**2/s) - real(r8), pointer, private :: lmrsun_z_patch (:,:) ! patch canopy layer: sunlit leaf maintenance respiration rate (umol CO2/m**2/s) - real(r8), pointer, private :: lmrsha_z_patch (:,:) ! patch canopy layer: shaded leaf maintenance respiration rate (umol CO2/m**2/s) - - real(r8), pointer, public :: cisun_z_patch (:,:) ! patch intracellular sunlit leaf CO2 (Pa) - real(r8), pointer, public :: cisha_z_patch (:,:) ! patch intracellular shaded leaf CO2 (Pa) - - real(r8), pointer, private :: rssun_z_patch (:,:) ! patch canopy layer: sunlit leaf stomatal resistance (s/m) - real(r8), pointer, private :: rssha_z_patch (:,:) ! patch canopy layer: shaded leaf stomatal resistance (s/m) - real(r8), pointer, public :: rssun_patch (:) ! patch sunlit stomatal resistance (s/m) - real(r8), pointer, public :: rssha_patch (:) ! patch shaded stomatal resistance (s/m) - real(r8), pointer, public :: luvcmax25top_patch (:) ! vcmax25 ! (umol/m2/s) - real(r8), pointer, public :: lujmax25top_patch (:) ! vcmax25 (umol/m2/s) - real(r8), pointer, public :: lutpu25top_patch (:) ! vcmax25 (umol/m2/s) -!! - - - ! LUNA specific variables - real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer - real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer - real(r8), pointer, public :: vcmx25_z_last_valid_patch (:,:) ! patch leaf Vc,max25 at the end of the growing season for the previous year - real(r8), pointer, public :: jmx25_z_last_valid_patch (:,:) ! patch leaf Jmax25 at the end of the growing season for the previous year - real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer - real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress - real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day) - - ! Logical switches for different options - logical, public :: rootstem_acc ! Respiratory acclimation for roots and stems - logical, private :: light_inhibit ! If light should inhibit respiration - integer, private :: leafresp_method ! leaf maintencence respiration at 25C for canopy top method to use - integer, private :: stomatalcond_mtd ! Stomatal conduction method type - logical, private :: modifyphoto_and_lmr_forcrop ! Modify photosynthesis and LMR for crop - - end type photosyns_type - type(photosyns_type), public, target, save :: photosyns_inst - -contains - -!------------------------------------------------------------- - subroutine init_photosyns_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) - - ! !DESCRIPTION: - ! Initialize CTSM photosynthesis type needed for calling CTSM routines - ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made - ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect - ! - ! !ARGUMENTS: - implicit none - ! INPUT/OUTPUT - type(bounds_type), intent(in) :: bounds - integer, intent(in) :: nch ! number of Catchment tiles - integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index - real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction - real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array - real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array - logical, optional, intent(in) :: cn5_cold_start - type(photosyns_type), intent(inout):: this - - ! LOCAL - integer :: begp, endp ! patch-level beginning and end index - integer :: begc, endc ! column-level beginning and end index - integer :: np, nc, nz, p, nv - logical :: cold_start = .false. - !------------------------------ - - begp = bounds%begp ; endp = bounds%endp - begc = bounds%begc ; endc = bounds%endc - - ! check whether a cn5_cold_start option was set and change cold_start accordingly - if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then - cold_start = .true. - end if - - ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) - _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') - end if - - - allocate(this%c3flag_patch (begp:endp)) ; this%c3flag_patch (:) =.false. - allocate(this%ac_phs_patch (begp:endp,2,1:nlevcan)) ; this%ac_phs_patch (:,:,:) = nan - allocate(this%aj_phs_patch (begp:endp,2,1:nlevcan)) ; this%aj_phs_patch (:,:,:) = nan - allocate(this%ap_phs_patch (begp:endp,2,1:nlevcan)) ; this%ap_phs_patch (:,:,:) = nan - allocate(this%ag_phs_patch (begp:endp,2,1:nlevcan)) ; this%ag_phs_patch (:,:,:) = nan - allocate(this%an_sun_patch (begp:endp,1:nlevcan)) ; this%an_sun_patch (:,:) = nan - allocate(this%an_sha_patch (begp:endp,1:nlevcan)) ; this%an_sha_patch (:,:) = nan - allocate(this%vcmax_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%vcmax_z_phs_patch (:,:,:) = nan - allocate(this%tpu_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%tpu_z_phs_patch (:,:,:) = nan - allocate(this%kp_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%kp_z_phs_patch (:,:,:) = nan - allocate(this%gs_mol_sun_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sun_patch (:,:) = nan - allocate(this%gs_mol_sha_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sha_patch (:,:) = nan - allocate(this%gs_mol_sun_ln_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sun_ln_patch (:,:) = nan - allocate(this%gs_mol_sha_ln_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sha_ln_patch (:,:) = nan - allocate(this%ac_patch (begp:endp,1:nlevcan)) ; this%ac_patch (:,:) = nan - allocate(this%aj_patch (begp:endp,1:nlevcan)) ; this%aj_patch (:,:) = nan - allocate(this%ap_patch (begp:endp,1:nlevcan)) ; this%ap_patch (:,:) = nan - allocate(this%ag_patch (begp:endp,1:nlevcan)) ; this%ag_patch (:,:) = nan - allocate(this%an_patch (begp:endp,1:nlevcan)) ; this%an_patch (:,:) = nan - allocate(this%vcmax_z_patch (begp:endp,1:nlevcan)) ; this%vcmax_z_patch (:,:) = nan - allocate(this%tpu_z_patch (begp:endp,1:nlevcan)) ; this%tpu_z_patch (:,:) = nan - allocate(this%kp_z_patch (begp:endp,1:nlevcan)) ; this%kp_z_patch (:,:) = nan - allocate(this%gs_mol_patch (begp:endp,1:nlevcan)) ; this%gs_mol_patch (:,:) = nan - allocate(this%cp_patch (begp:endp)) ; this%cp_patch (:) = nan - allocate(this%kc_patch (begp:endp)) ; this%kc_patch (:) = nan - allocate(this%ko_patch (begp:endp)) ; this%ko_patch (:) = nan - allocate(this%qe_patch (begp:endp)) ; this%qe_patch (:) = nan - allocate(this%bbb_patch (begp:endp)) ; this%bbb_patch (:) = nan - allocate(this%mbb_patch (begp:endp)) ; this%mbb_patch (:) = nan - allocate(this%gb_mol_patch (begp:endp)) ; this%gb_mol_patch (:) = nan - allocate(this%rh_leaf_patch (begp:endp)) ; this%rh_leaf_patch (:) = nan - allocate(this%vpd_can_patch (begp:endp)) ; this%vpd_can_patch (:) = nan - allocate(this%psnsun_patch (begp:endp)) ; this%psnsun_patch (:) = nan - allocate(this%psnsha_patch (begp:endp)) ; this%psnsha_patch (:) = nan - allocate(this%c13_psnsun_patch (begp:endp)) ; this%c13_psnsun_patch (:) = nan - allocate(this%c13_psnsha_patch (begp:endp)) ; this%c13_psnsha_patch (:) = nan - allocate(this%c14_psnsun_patch (begp:endp)) ; this%c14_psnsun_patch (:) = nan - allocate(this%c14_psnsha_patch (begp:endp)) ; this%c14_psnsha_patch (:) = nan - - allocate(this%psnsun_z_patch (begp:endp,1:nlevcan)) ; this%psnsun_z_patch (:,:) = nan - allocate(this%psnsha_z_patch (begp:endp,1:nlevcan)) ; this%psnsha_z_patch (:,:) = nan - allocate(this%psnsun_wc_patch (begp:endp)) ; this%psnsun_wc_patch (:) = nan - allocate(this%psnsha_wc_patch (begp:endp)) ; this%psnsha_wc_patch (:) = nan - allocate(this%psnsun_wj_patch (begp:endp)) ; this%psnsun_wj_patch (:) = nan - allocate(this%psnsha_wj_patch (begp:endp)) ; this%psnsha_wj_patch (:) = nan - allocate(this%psnsun_wp_patch (begp:endp)) ; this%psnsun_wp_patch (:) = nan - allocate(this%psnsha_wp_patch (begp:endp)) ; this%psnsha_wp_patch (:) = nan - allocate(this%fpsn_patch (begp:endp)) ; this%fpsn_patch (:) = nan - allocate(this%fpsn_wc_patch (begp:endp)) ; this%fpsn_wc_patch (:) = nan - allocate(this%fpsn_wj_patch (begp:endp)) ; this%fpsn_wj_patch (:) = nan - allocate(this%fpsn_wp_patch (begp:endp)) ; this%fpsn_wp_patch (:) = nan - - allocate(this%lnca_patch (begp:endp)) ; this%lnca_patch (:) = nan - - allocate(this%lmrsun_z_patch (begp:endp,1:nlevcan)) ; this%lmrsun_z_patch (:,:) = nan - allocate(this%lmrsha_z_patch (begp:endp,1:nlevcan)) ; this%lmrsha_z_patch (:,:) = nan - allocate(this%lmrsun_patch (begp:endp)) ; this%lmrsun_patch (:) = nan - allocate(this%lmrsha_patch (begp:endp)) ; this%lmrsha_patch (:) = nan - - allocate(this%alphapsnsun_patch (begp:endp)) ; this%alphapsnsun_patch (:) = nan - allocate(this%alphapsnsha_patch (begp:endp)) ; this%alphapsnsha_patch (:) = nan - allocate(this%rc13_canair_patch (begp:endp)) ; this%rc13_canair_patch (:) = nan - allocate(this%rc13_psnsun_patch (begp:endp)) ; this%rc13_psnsun_patch (:) = nan - allocate(this%rc13_psnsha_patch (begp:endp)) ; this%rc13_psnsha_patch (:) = nan - - allocate(this%cisun_z_patch (begp:endp,1:nlevcan)) ; this%cisun_z_patch (:,:) = nan - allocate(this%cisha_z_patch (begp:endp,1:nlevcan)) ; this%cisha_z_patch (:,:) = nan - - allocate(this%rssun_z_patch (begp:endp,1:nlevcan)) ; this%rssun_z_patch (:,:) = nan - allocate(this%rssha_z_patch (begp:endp,1:nlevcan)) ; this%rssha_z_patch (:,:) = nan - allocate(this%rssun_patch (begp:endp)) ; this%rssun_patch (:) = nan - allocate(this%rssha_patch (begp:endp)) ; this%rssha_patch (:) = nan - allocate(this%luvcmax25top_patch(begp:endp)) ; this%luvcmax25top_patch(:) = nan - allocate(this%lujmax25top_patch (begp:endp)) ; this%lujmax25top_patch(:) = nan - allocate(this%lutpu25top_patch (begp:endp)) ; this%lutpu25top_patch(:) = nan -!! -! allocate(this%psncanopy_patch (begp:endp)) ; this%psncanopy_patch (:) = nan -! allocate(this%lmrcanopy_patch (begp:endp)) ; this%lmrcanopy_patch (:) = nan - if(use_luna)then - ! NOTE(bja, 2015-09) because these variables are only allocated - ! when luna is turned on, they can not be placed into associate - ! statements. - allocate(this%vcmx25_z_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_patch (:,:) = 30._r8 - allocate(this%jmx25_z_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_patch (:,:) = 60._r8 - allocate(this%vcmx25_z_last_valid_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_last_valid_patch (:,:) = 30._r8 - allocate(this%jmx25_z_last_valid_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_last_valid_patch (:,:) = 60._r8 - allocate(this%pnlc_z_patch (begp:endp,1:nlevcan)) ; this%pnlc_z_patch (:,:) = 0.01_r8 - allocate(this%fpsn24_patch (begp:endp)) ; this%fpsn24_patch (:) = nan - allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 - endif - - this%rootstem_acc = .false. ! jkolassa, Jun 2022: Default for CTSM5.1 - - this%light_inhibit = .true. ! jkolassa, Feb 2022: This is the default value for CTSM5.1; we could in the future control this through resource files - - this%leafresp_method = 2 ! jkolassa, Feb 2022: Default for CTSM5.1 if use_cn is true (2 corresponds to Atkin et al., 2015) - - this%stomatalcond_mtd = 2 ! jkolassa, Feb 2022: Default for CTSM5.1, corresponds to Medlyn et al., 2011 - - this%modifyphoto_and_lmr_forcrop = .true. ! jkolassa, Feb 2022: Default for CLM50 and up - - - ! initialize types from restart file or through cold start values - - np = 0 - do nc = 1,nch ! catchment tile loop - do nz = 1,num_zon ! CN zone loop - do p = 0,numpft ! PFT index loop - np = np + 1 - do nv = 1,num_veg ! defined veg loop - if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then - if (cold_start) then - photosyns_inst%alphapsnsun_patch(np) = 0._r8 - photosyns_inst%alphapsnsha_patch(np) = 0._r8 - else (cold_start=.false.) then - photosyns_inst%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 76) - photosyns_inst%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 77) - end if - end if ! ityp =p - end do !nv - end do ! p - end do ! nz - end do ! nc - - end subroutine init_photosyns_type - - !----------------------------------------------------------------------- - subroutine allocParams ( this ) - ! - implicit none - - ! !ARGUMENTS: - class(photo_params_type) :: this - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'allocParams' - !----------------------------------------------------------------------- - - ! allocate parameters - - allocate( this%krmax (0:mxpft) ) ; this%krmax(:) = nan - allocate( this%theta_cj (0:mxpft) ) ; this%theta_cj(:) = nan - allocate( this%kmax (0:mxpft,nvegwcs) ) ; this%kmax(:,:) = nan - allocate( this%psi50 (0:mxpft,nvegwcs) ) ; this%psi50(:,:) = nan - allocate( this%ck (0:mxpft,nvegwcs) ) ; this%ck(:,:) = nan - - if ( use_hydrstress .and. nvegwcs /= 4 )then - call endrun(msg='Error:: the Plant Hydraulics Stress methodology is for the spacA function is hardcoded for nvegwcs==4' & - //errMsg(__FILE__, __LINE__)) - end if - - end subroutine allocParams - - !----------------------------------------------------------------------- - !----------------------------------------------------------------------- - subroutine readParams ( this, ncid ) - ! - ! !USES: - use ncdio_pio , only : file_desc_t,ncd_io - use paramUtilMod, only: readNcdioScalar - implicit none - - ! !ARGUMENTS: - class(photosyns_type) :: this - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'readParams' - character(len=100) :: errCode = '-Error reading in parameters file:' - logical :: readv ! has variable been read in or not - real(r8) :: temp1d(0:mxpft) ! temporary to read in parameter - real(r8) :: temp2d(0:mxpft,nvegwcs) ! temporary to read in parameter - real(r8) :: tempr ! temporary to read in parameter - character(len=100) :: tString ! temp. var for reading - !----------------------------------------------------------------------- - - ! read in parameters - - - call params_inst%allocParams() - - tString = "krmax" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%krmax=temp1d - tString = "lmr_intercept_atkin" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%lmr_intercept_atkin=temp1d - tString = "theta_cj" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%theta_cj=temp1d - tString = "kmax" - call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%kmax=temp2d - tString = "psi50" - call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%psi50=temp2d - tString = "ck" - call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%ck=temp2d - - ! read in the scalar parameters - - ! Michaelis-Menten constant at 25°C for O2 (unitless) - tString = "ko25_coef" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%ko25_coef=tempr - ! Michaelis-Menten constant at 25°C for CO2 (unitless) - tString = "kc25_coef" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%kc25_coef=tempr - ! CO2 compensation point at 25°C at present day O2 levels - tString = "cp25_yr2000" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%cp25_yr2000=tempr - ! Rubisco activity at 25 C (umol CO2/gRubisco/s) - tString = "act25" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%act25=tempr - ! Mass ratio of total Rubisco molecular mass to nitrogen in Rubisco (gRubisco/gN(Rubisco)) - tString = "fnr" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%fnr=tempr - ! Fraction of light absorbed by non-photosynthetic pigment (unitless) - tString = "fnps" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%fnps=tempr - ! Empirical curvature parameter for electron transport rate (unitless) - tString = "theta_psii" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%theta_psii=tempr - ! Empirical curvature parameter for ap photosynthesis co-limitation (unitless) - tString = "theta_ip" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%theta_ip=tempr - ! Activation energy for vcmax (J/mol) - tString = "vcmaxha" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%vcmaxha=tempr - ! Activation energy for jmax (J/mol) - tString = "jmaxha" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%jmaxha=tempr - ! Activation energy for tpu (J/mol) - tString = "tpuha" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%tpuha=tempr - ! Activation energy for lmr (J/mol) - tString = "lmrha" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%lmrha=tempr - ! Activation energy for kc (J/mol) - tString = "kcha" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%kcha=tempr - ! Activation energy for ko (J/mol) - tString = "koha" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%koha=tempr - ! Activation energy for cp (J/mol) - tString = "cpha" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%cpha=tempr - ! Deactivation energy for vcmax (J/mol) - tString = "vcmaxhd" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%vcmaxhd=tempr - ! Deactivation energy for jmax (J/mol) - tString = "jmaxhd" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%jmaxhd=tempr - ! Deactivation energy for tpu (J/mol) - tString = "tpuhd" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%tpuhd=tempr - ! Deactivation energy for lmr (J/mol) - tString = "lmrhd" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%lmrhd=tempr - ! Entropy term for lmr (J/mol/K) - tString = "lmrse" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%lmrse=tempr - ! Ratio of tpu25top to vcmax25top (unitless) - tString = "tpu25ratio" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%tpu25ratio=tempr - ! Ratio of kp25top to vcmax25top (unitless) - tString = "kp25ratio" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%kp25ratio=tempr - ! Scale factor for vcmaxse (unitless) - tString = "vcmaxse_sf" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%vcmaxse_sf=tempr - ! Scale factor for jmaxse (unitless) - tString = "jmaxse_sf" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%jmaxse_sf=tempr - ! Scale factor for tpuse (unitless) - tString = "tpuse_sf" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%tpuse_sf=tempr - ! Scale factor for jmax25top (unitless) - tString = "jmax25top_sf" - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%jmax25top_sf=tempr - - end subroutine readParams - - - !------------------------------------------------------------------------ - - - -end module CNCLM_PhotosynsType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index e11d75f47..bbacd0867 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -6,7 +6,7 @@ module SoilBiogeochemCarbonStateType use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi, zsoi, c3_r2 use clm_varctl , only : iulog, use_vertsoilc, use_fates, use_soil_matrixcn - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index c5ab731e6..3cfa688e1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -7,7 +7,7 @@ module SoilBiogeochemStateType use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi use clm_varctl , only : use_cn use clm_varcon , only : spval - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index 0f9d4c192..af64885ac 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -5,7 +5,7 @@ module SoilStateType nlayer, nlevsno use clm_varcon , only : spval use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 index 4f309a7ac..083c23985 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -5,7 +5,7 @@ module SolarAbsorbedType use clm_varpar , only : nlevcan, numrad use clm_varctl , only : use_luna use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none save diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index cf7643298..6f3374ad7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -5,7 +5,8 @@ module SurfaceAlbedoType use clm_varpar , only : numrad, nlevcan, nlevsno, numpft, num_zon, num_veg, & var_col, var_pft use clm_varcon , only : spval, ispval - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type + ! !PUBLIC TYPES: implicit none save diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 index 42bcd719e..2348255d4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 @@ -5,7 +5,7 @@ module TemperatureType use clm_varctl , only : use_fates, use_luna use clm_varcon , only : spval, ispval use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index d5ab827da..6e4b57a07 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -4,7 +4,7 @@ module WaterDiagnosticBulkType use clm_varpar , only : nlevgrnd, nlevsno, nlevcan use clm_varcon , only : spval use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 index 0b5a21032..81770d4f6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -5,8 +5,10 @@ module WaterFluxBulkType use clm_varpar , only : nlevsno, nlevsoi use clm_varcon , only : spval use MAPL_ExceptionHandling - use CNCLM_WaterFluxType , only : waterflux_type - use CNCLM_decompMod , only : bounds_type + use WaterFluxType , only : waterflux_type + use decompMod , only : bounds_type + + implicit none ! !PUBLIC TYPES: type, extends(waterflux_type), public :: waterfluxbulk_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index ade1b75a9..bdcd72c40 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -6,7 +6,7 @@ module WaterFluxType use clm_varcon , only : spval use netcdf use MAPL_ExceptionHandling - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 index d691426a8..0262f207e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 @@ -4,7 +4,7 @@ module atm2lndType use clm_varpar , only : numrad use clm_varctl , only : use_fates, use_luna use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 index d0eee2a67..972c76862 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 @@ -2,7 +2,7 @@ module ch4Mod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type use clm_varcon , only : spval use clm_varpar , only : nlevgrnd, ngases diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index 0a79eda8f..a72ba7e5c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -2,7 +2,7 @@ module filterMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan - use CNCLM_decompMod , only : bounds_type + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none From f991d0fbfeefa7d0a408f5b93f722b8e17bc795e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 10:13:27 -0400 Subject: [PATCH 018/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 index 14d91e22d..c3121534a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_nl_mod.F90 @@ -99,6 +99,8 @@ end subroutine shr_nl_find_group_name ! !INTERFACE: ------------------------------------------------------------------ function shr_string_toLower(str) + use shr_kind_mod ! F90 kinds + implicit none ! !INPUT/OUTPUT PARAMETERS: From 883c365019986539a361cf3bc1bbb46ee34d5503 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 10:45:24 -0400 Subject: [PATCH 019/589] moving variable initializations to init routine --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index 65281c913..0ead38a83 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -109,11 +109,7 @@ module clm_varpar ! For CH4 code integer, parameter :: ngases = 3 ! CH4, O2, & CO2 - nlevmaxurbgrnd = max0(nlevurb,nlevgrnd) - nlevmaxurbgrnd = nlevgrnd ! jkolassa: set this here, since we are not modelling urban tiles for now - - - integer, public :: max_patch_per_col = maxsoil_patches ! since we don't have CFTs or urban patches + integer, public :: max_patch_per_col contains @@ -131,6 +127,10 @@ subroutine clm_varpar_init() !---------------------------- + nlevmaxurbgrnd = max0(nlevurb,nlevgrnd) + nlevmaxurbgrnd = nlevgrnd ! jkolassa: set this here, since we are not modelling urban tiles for now + max_patch_per_col = maxsoil_patches ! since we don't have CFTs or urban patches + ! here is a switch to set the number of soil levels for the biogeochemistry calculations. ! currently it works on either a single level or on nlevsoi and nlevgrnd levels if (use_vertsoilc) then From ec84e5b5e8b168c9a1ad3060db9e1805b8a22459 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 10:59:20 -0400 Subject: [PATCH 020/589] add module needed for CLM time manager --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/update_model_para4cn.F90 | 48 +++++++++++++++++++ 2 files changed, 49 insertions(+) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index adf6e0f24..cb1ec77da 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -117,6 +117,7 @@ set (srcs SurfaceAlbedoMod.F90 SurfaceRadiationMod.F90 TridiagonalMod.F90 + update_model_para4cn.F90 ) esma_add_library (${this} diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 new file mode 100644 index 000000000..570596ea5 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 @@ -0,0 +1,48 @@ +MODULE update_model_para4cn + + implicit none + + private + INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: LocalTileID + INTEGER, PUBLIC :: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec + + SAVE curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec, LocalTileID + + public :: upd_curr_date_time, upd_tileid + + contains + + ! --------------------------------------- + + subroutine upd_tileid (tileid) + + implicit none + integer :: NT + integer, intent (in) :: tileid (:) + + NT = size (tileid) + allocate (LocalTileID(1:NT)) + LocalTileID = tileid + + end subroutine upd_tileid + + ! --------------------------------------- + + subroutine upd_curr_date_time( year,month,day,dofyr,hour,min,sec ) + + ! Return the current date_time. + + implicit none + integer, intent(in) :: year,month,day,dofyr,hour,min,sec + + curr_year = year + curr_month = month + curr_day = day + curr_dofyr = dofyr + curr_hour = hour + curr_min = min + curr_sec = sec + + end subroutine upd_curr_date_time + + end MODULE update_model_para4cn From 9bab8014f5ec7798a2cf920878e0e80dfd1ab29e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 11:26:59 -0400 Subject: [PATCH 021/589] corrections to ESMF_VmGet calls --- .../CLM51/CN_init_mod.F90 | 3 +-- .../CLM51/spmdMod.F90 | 18 +++++++++++------- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index f1f72b75b..96a4f919c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -137,13 +137,12 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(Netcdf4_fileformatter) :: ncid integer :: rc - type (ESMF_VM) :: VM !----------------------------------------- ! initialize CN model ! ------------------- - call spmd_init(VM) + call spmd_init() call clm_varpar_init() diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 index 4f6d2dec1..1862a3d97 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 @@ -64,7 +64,7 @@ module spmdMod ! !IROUTINE: spmd_init( clm_mpicom ) ! ! !INTERFACE: - subroutine spmd_init(vm) + subroutine spmd_init() ! ! !DESCRIPTION: ! MPI initialization (number of cpus, processes, tids, etc) @@ -73,7 +73,8 @@ subroutine spmd_init(vm) ! ! !ARGUMENTS: implicit none - type(ESMF_VM), intent(in) :: vm + type(ESMF_VM) :: vm + integer, optional, intent( out) :: RC ! Error code ! integer, intent(in) :: clm_mpicom ! integer, intent(in) :: LNDID ! @@ -83,18 +84,21 @@ subroutine spmd_init(vm) ! ! !LOCAL VARIABLES: !EOP - integer :: i,j ! indices - integer :: npes - type (MaplGrid ),pointer :: MYGRID + integer :: i ! indices + integer :: npes ! MPI size + integer :: MYID ! MPI Rank !----------------------------------------------------------------------- + call ESMF_VmGetCurrent(VM, rc=status) + VERIFY_(STATUS) + ! Get MPI communicator call ESMF_VmGet(VM, mpicommunicator=mpicom, __RC__) ! Get my processor id and number of processors - call ESMF_VmGet(VM, localPet=MYGRID%MYID, petCount=npes, __RC__) + call ESMF_VmGet(VM, localPet=MYID, petCount=npes, __RC__) ! determine master process if (MAPL_Am_I_Root(vm)) then @@ -108,7 +112,7 @@ subroutine spmd_init(vm) write(iulog,200) write(iulog,220) do i=0,npes-1 - write(iulog,250)i,MYGRID%MYID + write(iulog,250)i,MYID end do endif From bb663825c1ab5f8e4e70567fa7c3d484a75c3aeb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 11:41:53 -0400 Subject: [PATCH 022/589] adding missing use statement and fixing typo --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 3dd3d8ae7..fee095bae 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -1,5 +1,6 @@ module clm_time_manager + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec use clm_varctl , only: iulog @@ -28,7 +29,7 @@ module clm_time_manager get_days_per_year, &! return the days per year for current year is_end_curr_day, &! return true on last timestep in current day - is_restart ! return true if this is a restart run + is_restart, ! return true if this is a restart run is_first_step ! dummy function here, because it is loaded, but not used contains From d5e681ee54d6aa52caa13cf2ce3f9755322a9dcc Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 12:04:57 -0400 Subject: [PATCH 023/589] fixing typo --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index fee095bae..ea7987452 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -29,7 +29,7 @@ module clm_time_manager get_days_per_year, &! return the days per year for current year is_end_curr_day, &! return true on last timestep in current day - is_restart, ! return true if this is a restart run + is_restart, &! return true if this is a restart run is_first_step ! dummy function here, because it is loaded, but not used contains From ee245fbac447f7cd063507ec6a2eba0a11b6551c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 13:38:55 -0400 Subject: [PATCH 024/589] add missing variable declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index ea7987452..ab68ab529 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -231,7 +231,9 @@ end function is_end_curr_day !========================================================================================= function is_first_step( ) - + + ! Return value + logical :: is_first_step end function is_first_step From 67f221b246e654c5082b06474d3f2b0380aa5595 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 13:39:19 -0400 Subject: [PATCH 025/589] change status output --- .../GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 index 1862a3d97..3dc9132c6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 @@ -90,15 +90,14 @@ subroutine spmd_init() !----------------------------------------------------------------------- call ESMF_VmGetCurrent(VM, rc=status) - VERIFY_(STATUS) ! Get MPI communicator - call ESMF_VmGet(VM, mpicommunicator=mpicom, __RC__) + call ESMF_VmGet(VM, mpicommunicator=mpicom, RC=status) ! Get my processor id and number of processors - call ESMF_VmGet(VM, localPet=MYID, petCount=npes, __RC__) + call ESMF_VmGet(VM, localPet=MYID, petCount=npes, RC=status) ! determine master process if (MAPL_Am_I_Root(vm)) then From 16a14d87f6610ffba3f66025aec9b8fb9e138af0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 13:59:41 -0400 Subject: [PATCH 026/589] adding soil depth variable declarations --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index dc43db540..af3d5be16 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -48,6 +48,16 @@ module clm_varcon real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data integer , public, parameter :: ispval = -9999 ! special value for int data + !------------------------------------------------------------------ + ! Soil depths + !------------------------------------------------------------------ + + real(r8), pointer :: zsoi(:) !soil z (layers) + real(r8), pointer :: dzsoi(:) !soil dz (thickness) + real(r8), pointer :: zisoi(:) !soil zi (interfaces) + real(r8), pointer :: dzsoi_decomp(:) !soil dz (thickness) + + !------------------------------------------------------------------ ! Set subgrid names !------------------------------------------------------------------ From 726bcfa7d312dd004cd62e23688cf987adea7977 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 14:27:15 -0400 Subject: [PATCH 027/589] declaring missing logical for read statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 095ae9ea6..019ea085b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -5,6 +5,7 @@ module pftconMod use clm_varpar , only : mxpft, numrad use clm_varctl , only : use_flexibleCN use netcdf + use shr_log_mod , only : errMsg => shr_log_errMsg use MAPL_ExceptionHandling @@ -224,6 +225,8 @@ module pftconMod real(r8), public, parameter :: root_density = 0.31e06_r8 !(g biomass / m3 root) real(r8), public, parameter :: root_radius = 0.29e-03_r8 !(m) + character(len=*), parameter, private :: sourcefile = & + __FILE__ contains @@ -241,11 +244,13 @@ subroutine init_pftcon_type(this) !LOCAL character(300) :: paramfile integer :: ierr, clm_varid, ncid + logical :: readv ! has variable been read in or not real(r8), allocatable, dimension(:) :: read_tmp_1 real(r8), allocatable, dimension(:,:) :: read_tmp_2 integer , allocatable, dimension(:) :: read_tmp_3 + !--------------------------------------------------------- allocate( read_tmp_1 (0:78)) From 6c4783ad5eceb5fa4d9e5e9ed6fdf0833ffbdac8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 14:43:32 -0400 Subject: [PATCH 028/589] fix to RC declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 index 3dc9132c6..952cb85aa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 @@ -74,7 +74,7 @@ subroutine spmd_init() ! !ARGUMENTS: implicit none type(ESMF_VM) :: vm - integer, optional, intent( out) :: RC ! Error code + integer :: RC ! Error code ! integer, intent(in) :: clm_mpicom ! integer, intent(in) :: LNDID ! From 9e82ca46e33492383a8b04b7633443204fdede54 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 20 Oct 2022 14:55:16 -0400 Subject: [PATCH 029/589] fix to status declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 index 952cb85aa..948066e84 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/spmdMod.F90 @@ -74,7 +74,7 @@ subroutine spmd_init() ! !ARGUMENTS: implicit none type(ESMF_VM) :: vm - integer :: RC ! Error code + integer :: status ! Error code ! integer, intent(in) :: clm_mpicom ! integer, intent(in) :: LNDID ! From 99804a7836adc2643406089c3d0fb6d3237b304b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 1 Nov 2022 09:27:15 -0400 Subject: [PATCH 030/589] fixing bugs in netcdf read statements --- .../CLM51/CNCLM_pftconMod.F90 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 019ea085b..f854452bd 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -2,7 +2,7 @@ module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan - use clm_varpar , only : mxpft, numrad + use clm_varpar , only : mxpft, numrad,nvariants use clm_varctl , only : use_flexibleCN use netcdf use shr_log_mod , only : errMsg => shr_log_errMsg @@ -11,6 +11,8 @@ module pftconMod ! !PUBLIC TYPES: implicit none + + INCLUDE 'netcdf.inc' save ! ! !PUBLIC MEMBER FUNCTIONS: @@ -35,7 +37,7 @@ module pftconMod integer, public :: nc3_nonarctic_grass = 13 ! Cool c3 grass [moisture + deciduous] integer, public :: nc4_grass = 14 ! Warm c4 grass [moisture + deciduous] integer, public :: nc3crop = 15 ! C3_crop [moisture + deciduous] - integer, public :: npcropmin = nc3crop ! value for first crop functional type (not including the more generic C3 crop PFT) + integer, public :: npcropmin ! value for first crop functional type (not including the more generic C3 crop PFT) ! type, public :: pftcon_type @@ -235,7 +237,8 @@ subroutine init_pftcon_type(this) ! !DESCRIPTION: ! Initialize CTSM PFT constants -! +! + use ncdio_pio , only : ncd_io ! !ARGUMENTS: implicit none !INPUT/OUTPUT @@ -243,8 +246,9 @@ subroutine init_pftcon_type(this) !LOCAL character(300) :: paramfile - integer :: ierr, clm_varid, ncid + integer :: ierr, clm_varid, ncid, status logical :: readv ! has variable been read in or not + type(Netcdf4_fileformatter) :: ncid real(r8), allocatable, dimension(:) :: read_tmp_1 real(r8), allocatable, dimension(:,:) :: read_tmp_2 @@ -252,6 +256,7 @@ subroutine init_pftcon_type(this) !--------------------------------------------------------- + ncropmin = nc3crop allocate( read_tmp_1 (0:78)) allocate( read_tmp_2 (0:78,nvariants)) @@ -403,7 +408,7 @@ subroutine init_pftcon_type(this) ! TO DO: pass parameter file through rc files rather than hardcoding name here paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' - call ncid%open(trim(paramfile),pFIO_READ, __RC__) + call ncid%open(trim(paramfile),pFIO_READ, RC=status) call ncd_io('pftname',pftname, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) From e4ddef9013a1125468c503024c090b4adcfae143 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 1 Nov 2022 12:19:33 -0400 Subject: [PATCH 031/589] added inclusion of netcdf module for Fortran --- .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index cb1ec77da..358f91da9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -84,7 +84,7 @@ set (srcs FireMethodType.F90 initSubgridMod.F90 landunit_varcon.F90 - ncdio_pio.F90.in + ncdio_pio.F90 NutrientCompetitionCLM45defaultMod.F90 NutrientCompetitionFactoryMod.F90 NutrientCompetitionFlexibleCNMod.F90 @@ -122,7 +122,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} - DEPENDENCIES MAPL GEOS_LandShared GEOS_CatchCNShared + DEPENDENCIES MAPL GEOS_LandShared GEOS_CatchCNShared esmf NetCDF::NetCDF_Fortran TYPE SHARED) target_include_directories (${this} PUBLIC ${INC_ESMF} ${INC_NETCDF}) From 58a2913c49487564eb38fa24facbbb6381245830 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 1 Nov 2022 15:04:14 -0400 Subject: [PATCH 032/589] corrections to use of netcdf module --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 5 ++--- .../CLM51/{ncdio_pio.F90.in => ncdio_pio.F90} | 0 2 files changed, 2 insertions(+), 3 deletions(-) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/{ncdio_pio.F90.in => ncdio_pio.F90} (100%) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index f854452bd..bfcd4cd5d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -1,7 +1,7 @@ module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use nanMod , only : nan + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varpar , only : mxpft, numrad,nvariants use clm_varctl , only : use_flexibleCN use netcdf @@ -37,7 +37,7 @@ module pftconMod integer, public :: nc3_nonarctic_grass = 13 ! Cool c3 grass [moisture + deciduous] integer, public :: nc4_grass = 14 ! Warm c4 grass [moisture + deciduous] integer, public :: nc3crop = 15 ! C3_crop [moisture + deciduous] - integer, public :: npcropmin ! value for first crop functional type (not including the more generic C3 crop PFT) + integer, public :: npcropmin = 15 ! value for first crop functional type (not including the more generic C3 crop PFT) ! type, public :: pftcon_type @@ -256,7 +256,6 @@ subroutine init_pftcon_type(this) !--------------------------------------------------------- - ncropmin = nc3crop allocate( read_tmp_1 (0:78)) allocate( read_tmp_2 (0:78,nvariants)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 From f852485192d2ec2315a58297bb4d5b8577009a86 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 1 Nov 2022 15:43:51 -0400 Subject: [PATCH 033/589] adding missing include MAPL_Generic statement --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 38e600470..9469c5135 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -1,3 +1,5 @@ +#include "MAPL_Generic.h" + module shr_abort_mod ! This module defines procedures that can be used to abort the model cleanly in a ! system-specific manner @@ -66,7 +68,7 @@ subroutine shr_abort_abort(string,rc) if (present(rc)) then _ASSERT(.FALSE.,trim(local_string),rc) else - _ASSERT(.FALSE.,trim(local_string),) + _ASSERT(.FALSE.,trim(local_string)) endif ! A compiler's abort method may print a backtrace or do other nice From 5a768d2561197c62539f40dd2acca1e337afdee9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 1 Nov 2022 16:29:44 -0400 Subject: [PATCH 034/589] fix _ASSERT call --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 9469c5135..fe06af559 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -50,7 +50,7 @@ subroutine shr_abort_abort(string,rc) ! Local version of the string. ! (Gets a default value if string is not present.) - character(len=shr_kind_cx) :: local_string + character(len=shr_kind_cx) :: local_string, tmp_str, errCode_str !------------------------------------------------------------------------------- if (present(string)) then @@ -66,7 +66,9 @@ subroutine shr_abort_abort(string,rc) ! call shr_mpi_initialized(flag) if (present(rc)) then - _ASSERT(.FALSE.,trim(local_string),rc) + write(errCode_str, '(i40)') rc + tmp_str = trim(local_string) // ' error code: ' // errCode_str + _ASSERT(.FALSE.,trim(tmp_str)) else _ASSERT(.FALSE.,trim(local_string)) endif From 805d73049c384199781b20a9c8e7789a3ecb6c30 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 1 Nov 2022 16:51:09 -0400 Subject: [PATCH 035/589] fix _ASSERT call --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index fe06af559..8302cafa7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -50,7 +50,7 @@ subroutine shr_abort_abort(string,rc) ! Local version of the string. ! (Gets a default value if string is not present.) - character(len=shr_kind_cx) :: local_string, tmp_str, errCode_str + character(len=shr_kind_cx) :: local_string !------------------------------------------------------------------------------- if (present(string)) then @@ -66,9 +66,7 @@ subroutine shr_abort_abort(string,rc) ! call shr_mpi_initialized(flag) if (present(rc)) then - write(errCode_str, '(i40)') rc - tmp_str = trim(local_string) // ' error code: ' // errCode_str - _ASSERT(.FALSE.,trim(tmp_str)) + _ASSERT(.FALSE.,trim(local_string)) else _ASSERT(.FALSE.,trim(local_string)) endif From 2e3699c319f514aecf979acf2e60596fb53e86cc Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 4 Nov 2022 08:55:17 -0400 Subject: [PATCH 036/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 8302cafa7..428faad69 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -33,17 +33,17 @@ module shr_abort_mod ! (shr_sys_abort, shr_sys_backtrace). (This is for consistency with older code, from ! when these routines were defined in shr_sys_mod.) public :: shr_abort_abort ! abort a program - public :: shr_abort_backtrace ! print a backtrace, if possible + ! public :: shr_abort_backtrace ! print a backtrace, if possible contains !=============================================================================== - subroutine shr_abort_abort(string,rc) + subroutine shr_abort_abort(string,ec) ! Consistent stopping mechanism !----- arguments ----- character(len=*) , intent(in), optional :: string ! error message string - integer(shr_kind_in), intent(in), optional :: rc ! error code + integer(shr_kind_in), intent(in), optional :: ec ! error code !----- local ----- logical :: flag From 696bc6fcd476327a7323968dee3f9e75b235c852 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 4 Nov 2022 09:22:26 -0400 Subject: [PATCH 037/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 428faad69..338a7ecf8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -1,4 +1,4 @@ -#include "MAPL_Generic.h" +!#include "MAPL_Generic.h" module shr_abort_mod ! This module defines procedures that can be used to abort the model cleanly in a @@ -65,7 +65,7 @@ subroutine shr_abort_abort(string,ec) ! call shr_mpi_initialized(flag) - if (present(rc)) then + if (present(ec)) then _ASSERT(.FALSE.,trim(local_string)) else _ASSERT(.FALSE.,trim(local_string)) From 506cada002c3e2ae262751c74a634f104f878866 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 4 Nov 2022 11:07:06 -0400 Subject: [PATCH 038/589] added back MAPL_Generic --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 338a7ecf8..7d056b01c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -1,4 +1,4 @@ -!#include "MAPL_Generic.h" +#include "MAPL_Generic.h" module shr_abort_mod ! This module defines procedures that can be used to abort the model cleanly in a From dc86063e6924c20dc187d78df983187bf54cfccb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 09:26:14 -0500 Subject: [PATCH 039/589] fix to shr_abort --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 old mode 100644 new mode 100755 index 7d056b01c..4975d013b --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -38,13 +38,13 @@ module shr_abort_mod contains !=============================================================================== - subroutine shr_abort_abort(string,ec) + suIbroutine shr_abort_abort(string,rc) ! Consistent stopping mechanism !----- arguments ----- character(len=*) , intent(in), optional :: string ! error message string - integer(shr_kind_in), intent(in), optional :: ec ! error code - + integer(shr_kind_in), intent(in), optional :: rc ! error code + !----- local ----- logical :: flag @@ -65,7 +65,7 @@ subroutine shr_abort_abort(string,ec) ! call shr_mpi_initialized(flag) - if (present(ec)) then + if (present(rc)) then _ASSERT(.FALSE.,trim(local_string)) else _ASSERT(.FALSE.,trim(local_string)) From 603e280957024fd7408933489a4d4a63f1cd2add Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 09:45:19 -0500 Subject: [PATCH 040/589] fix to shr_abort --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 4975d013b..d031c4c97 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -38,7 +38,7 @@ module shr_abort_mod contains !=============================================================================== - suIbroutine shr_abort_abort(string,rc) + subroutine shr_abort_abort(string,rc) ! Consistent stopping mechanism !----- arguments ----- From 0c58d6edf0ad8beb1443a945e356478f598e646a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 10:24:05 -0500 Subject: [PATCH 041/589] fix to shr_abort --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index d031c4c97..072254265 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -38,12 +38,13 @@ module shr_abort_mod contains !=============================================================================== - subroutine shr_abort_abort(string,rc) + subroutine shr_abort_abort(string,ec,rc) ! Consistent stopping mechanism !----- arguments ----- - character(len=*) , intent(in), optional :: string ! error message string - integer(shr_kind_in), intent(in), optional :: rc ! error code + character(len=*) , intent(in) , optional :: string ! error message string + integer(shr_kind_in), intent(in) , optional :: ec ! error code + integer(shr_kind_in), intent(out), optional :: rc ! error code !----- local ----- logical :: flag @@ -65,7 +66,7 @@ subroutine shr_abort_abort(string,rc) ! call shr_mpi_initialized(flag) - if (present(rc)) then + if (present(ec)) then _ASSERT(.FALSE.,trim(local_string)) else _ASSERT(.FALSE.,trim(local_string)) From 53ab46f49dccf807f5803495da792eee960cbe0e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 10:25:54 -0500 Subject: [PATCH 042/589] add missing = --- .../CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 old mode 100644 new mode 100755 index 07177c206..d7612668e --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -161,7 +161,7 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) this%decomp_npools_col (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) this%decomp_npools_col_1m (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) ! jkolassa May 2022: loop has to be added below if we add more biogeochemical (or soil) layers - this%decomp_npools_vr_col (n,1,np) cncol(nc,nz,decomp_npool_cncol_index(np)) + this%decomp_npools_vr_col (n,1,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) end do !np end do !nz end do From e753f1058adb82053e01c23723b87f56e94811c9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 10:56:16 -0500 Subject: [PATCH 043/589] bug fix in ColumnType initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 | 7 ++++--- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index e7c666bf1..6b08b5c0e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -25,7 +25,7 @@ module ColumnType use clm_varcon , only : zsoi, dzsoi, zisoi, dzsoi_decomp, spval, ispval use clm_varctl , only : use_fates use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevmaxurbgrnd,nlevurb, & - CN_zone_weight, numpft + CN_zone_weight, numpft, num_zon ! !PUBLIC TYPES: @@ -89,19 +89,20 @@ module ColumnType contains !----------------------------------------------------- - subroutine init_column_type(bounds, this) + subroutine init_column_type(bounds,nch, this) ! !ARGUMENTS: implicit none ! INPUT: type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles type(column_type), intent(inout) :: this ! LOCAL: integer :: begc, endc - integer :: nc, nz, n + integer :: nc, nz, n, nc !---------------------------- begc = bounds%begc ; endc = bounds%endc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 96a4f919c..6396a8f57 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -156,7 +156,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call init_patch_type (bound, nch, ityp, fveg, patch) - call init_column_type (bounds, col) + call init_column_type (bounds, nch, col) call init_landunit_type (bounds, lun) From 1177fdaace86e70343025855aa258ef203e4922b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 11:49:07 -0500 Subject: [PATCH 044/589] change order in PSNSUNM and PSNSHAM allocuation --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 366f359a0..919adecb2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -71,14 +71,13 @@ module CatchmentCNRstMod real, allocatable :: tprec10d(:) real, allocatable :: tprec60d(:) real, allocatable :: t2m10d(:) + real, allocatable :: sfmcm(:) + real, allocatable :: psnsunm(:,:,:) + real, allocatable :: psnsham(:,:,:) real, allocatable :: rh30d(:) real, allocatable :: tg10d(:) real, allocatable :: t2mmin5d(:) real, allocatable :: sndzm5d(:) - - real, allocatable :: sfmcm(:) - real, allocatable :: psnsunm(:,:,:) - real, allocatable :: psnsham(:,:,:) contains procedure :: write_nc4 From b76b1e53f0f67426c9a3f3d03733d5dae9f51c44 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 12:34:00 -0500 Subject: [PATCH 045/589] add loop variable --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index 6b08b5c0e..108d89a93 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -102,7 +102,7 @@ subroutine init_column_type(bounds,nch, this) ! LOCAL: integer :: begc, endc - integer :: nc, nz, n, nc + integer :: nc, nz, n, c !---------------------------- begc = bounds%begc ; endc = bounds%endc From 41941d00242a0696da8bca293cc5c5fd74c7471c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 13:02:34 -0500 Subject: [PATCH 046/589] ammend use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index 9ab30befa..ea95eb701 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -1,8 +1,9 @@ module CNVegStateType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan - use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoi + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoi, & + num_zon, num_veg, var_col, var_pft use clm_varcon , only : spval, ispval use decompMod , only : bounds_type From 39ce7ed7b06ff577a40ccbdf60cffee8e0003dbd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 13:27:43 -0500 Subject: [PATCH 047/589] change variable name --- .../CLM51/CNCLM_CNVegStateType.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index ea95eb701..75483d50a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -3,9 +3,10 @@ module CNVegStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoi, & - num_zon, num_veg, var_col, var_pft + num_zon, num_veg, var_col, var_pft, numpft use clm_varcon , only : spval, ispval use decompMod , only : bounds_type + use AnnualFluxDribbler, only : annual_flux_dribbler_type, annual_flux_dribbler_patch ! !PUBLIC TYPES: @@ -209,8 +210,8 @@ subroutine init_cnveg_state_type(bounds, nch, ityp, fveg, cncol, cnpft, this) ! initialize variables from restart file or set to cold start value n = 0 np = 0 - do nc = 1,nch ! catchment tile loop - do nz = 1,nzone ! CN zone loop + do nc = 1,nch ! catchment tile loop + do nz = 1,num_zon ! CN zone loop n = n + 1 this%annsum_counter_col (n) = cncol(nc,nz, 31) this%annavg_t2m_col (n) = cncol(nc,nz, 32) @@ -218,7 +219,7 @@ subroutine init_cnveg_state_type(bounds, nch, ityp, fveg, cncol, cnpft, this) do p = 0,numpft ! PFT index loop np = np + 1 - do nv = 1,nveg ! defined veg loop + do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then this%annavg_t2m_patch (np) = cnpft(nc,nz,nv, 24) From c9dfafee4aac86985b12b3029ea5b5a7b71a14d3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 14:10:19 -0500 Subject: [PATCH 048/589] add max_lunit variable --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index 4f1bd3126..d90df226f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -3,7 +3,7 @@ module GridcellType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4, MAPL_PI use nanMod , only : nan use decompMod , only : bounds_type - use clm_varcon , only : ispval + use clm_varcon , only : ispval, max_lunit use clm_varpar , only : numpft, num_zon, num_veg, var_pft ! !PUBLIC TYPES: From 48ad14b72255310dc1e3537137ab49439b740a66 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 7 Nov 2022 14:10:42 -0500 Subject: [PATCH 049/589] add max_lunit variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index af3d5be16..a45729767 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -70,6 +70,8 @@ module clm_varcon character(len=16), public, parameter :: namep = 'pft' ! name of patches character(len=16), public, parameter :: nameCohort = 'cohort' ! name of cohorts (ED specific) + integer, parameter, public :: max_lunit = 9 !maximum value that lun%itype can have + ! !PUBLIC MEMBER FUNCTIONS: public clm_varcon_init ! Initialze constants that need to be initialized From 27818cd73ad7220fd2ec54a7c3a02c00fb0cce04 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 8 Nov 2022 08:13:56 -0500 Subject: [PATCH 050/589] changing include paths for shr_ifnan_mod --- .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 358f91da9..36ceeb50f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -99,7 +99,7 @@ set (srcs shr_assert_mod.F90.in shr_const_mod.F90 shr_file_mod.F90 - shr_infnan_mod.F90.in + shr_infnan_mod.F90 shr_kind_mod.F90 shr_log_mod.F90 shr_mpi_mod.F90 From 308f39140bd60147fcf8f95522a827941fc10425 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 8 Nov 2022 08:14:24 -0500 Subject: [PATCH 051/589] adding missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index 46e7ccf61..aad63ec42 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -19,6 +19,7 @@ module LandunitType use shr_kind_mod , only : r8 => shr_kind_r8 use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varcon , only : ispval + use decompMod , only : bounds_type ! !PUBLIC TYPES: implicit none From 366731a4783de2d4b31e33469f473c2d3a341605 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 8 Nov 2022 08:14:42 -0500 Subject: [PATCH 052/589] name change --- .../CLM51/shr_infnan_mod.F90.in | 406 ------------------ 1 file changed, 406 deletions(-) delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in deleted file mode 100755 index 992c46fc9..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in +++ /dev/null @@ -1,406 +0,0 @@ -! Flag representing compiler support of Fortran 2003's -! ieee_arithmetic intrinsic module. -#if defined CPRIBM || defined CPRPGI || defined CPRINTEL || defined CPRCRAY || defined CPRNAG -#define HAVE_IEEE_ARITHMETIC -#endif - -module shr_infnan_mod -!--------------------------------------------------------------------- -! Module to test for IEEE Inf and NaN values, which also provides a -! method of setting +/-Inf and signaling or quiet NaN. -! -! All functions are elemental, and thus work on arrays. -!--------------------------------------------------------------------- -! To test for these values, just call the corresponding function, e.g: -! -! var_is_nan = shr_infnan_isnan(x) -! -! You can also use it on arrays: -! -! array_contains_nan = any(shr_infnan_isnan(my_array)) -! -!--------------------------------------------------------------------- -! To generate these values, assign one of the provided derived-type -! variables to a real: -! -! use shr_infnan_mod, only: nan => shr_infnan_nan, & -! inf => shr_infnan_inf, & -! assignment(=) -! real(r4) :: my_nan -! real(r8) :: my_inf_array(2,2) -! my_nan = nan -! my_inf_array = inf -! -! Keep in mind that "shr_infnan_nan" and "shr_infnan_inf" cannot be -! passed to functions that expect real arguments. To pass a real -! NaN, you will have to use shr_infnan_nan to set a local real of -! the correct kind. -!--------------------------------------------------------------------- - -use shr_kind_mod, only: & - r4 => SHR_KIND_R4, & - r8 => SHR_KIND_R8 - -#ifdef HAVE_IEEE_ARITHMETIC - -! If we have IEEE_ARITHMETIC, the NaN test is provided for us. -use, intrinsic :: ieee_arithmetic, only: & - shr_infnan_isnan => ieee_is_nan - -#else - -! Integers of correct size for bit patterns below. -use shr_kind_mod, only: i4 => shr_kind_i4, i8 => shr_kind_i8 - -#endif - -implicit none -private -save - -! Test functions for NaN/Inf values. -public :: shr_infnan_isnan -public :: shr_infnan_isinf -public :: shr_infnan_isposinf -public :: shr_infnan_isneginf - -! Locally defined isnan. -#ifndef HAVE_IEEE_ARITHMETIC -interface shr_infnan_isnan - ! TYPE double,real - module procedure shr_infnan_isnan_{TYPE} -end interface -#endif - -interface shr_infnan_isinf - ! TYPE double,real - module procedure shr_infnan_isinf_{TYPE} -end interface - -interface shr_infnan_isposinf - ! TYPE double,real - module procedure shr_infnan_isposinf_{TYPE} -end interface - -interface shr_infnan_isneginf - ! TYPE double,real - module procedure shr_infnan_isneginf_{TYPE} -end interface - -! Derived types for generation of NaN/Inf -! Even though there's no reason to "use" the types directly, some compilers -! might have trouble with an object being used without its type. -public :: shr_infnan_nan_type -public :: shr_infnan_inf_type -public :: assignment(=) -public :: shr_infnan_to_r4 -public :: shr_infnan_to_r8 - -! Type representing Not A Number. -type :: shr_infnan_nan_type - logical :: quiet = .false. -end type shr_infnan_nan_type - -! Type representing +/-Infinity. -type :: shr_infnan_inf_type - logical :: positive = .true. -end type shr_infnan_inf_type - -! Allow assigning reals to NaN or Inf. -interface assignment(=) - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_{DIMS}d_{TYPE} - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_{DIMS}d_{TYPE} -end interface - -! Conversion functions. -interface shr_infnan_to_r8 - module procedure nan_r8 - module procedure inf_r8 -end interface - -interface shr_infnan_to_r4 - module procedure nan_r4 - module procedure inf_r4 -end interface - -! Initialize objects of NaN/Inf type for other modules to use. - -! Default NaN is signaling, but also provide snan and qnan to choose -! explicitly. -type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & - shr_infnan_nan_type(.false.) -type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & - shr_infnan_nan_type(.false.) -type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & - shr_infnan_nan_type(.true.) - -! Default Inf is positive, but provide posinf to go with neginf. -type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & - shr_infnan_inf_type(.true.) -type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & - shr_infnan_inf_type(.true.) -type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & - shr_infnan_inf_type(.false.) - -! Bit patterns for implementation without ieee_arithmetic. -! Note that in order to satisfy gfortran's range check, we have to use -! ibset to set the sign bit from a BOZ pattern. -#ifndef HAVE_IEEE_ARITHMETIC -! Single precision. -integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) -integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) -integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) -integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) -! Double precision. -integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) -integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) -integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) -integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) -#endif - -contains - -!--------------------------------------------------------------------- -! TEST FUNCTIONS -!--------------------------------------------------------------------- -! The "isinf" function simply calls "isposinf" and "isneginf". -!--------------------------------------------------------------------- - -! TYPE double,real -elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) - {VTYPE}, intent(in) :: x - logical :: isinf - - isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) - -end function shr_infnan_isinf_{TYPE} - -#ifdef HAVE_IEEE_ARITHMETIC - -!--------------------------------------------------------------------- -! The "isposinf" and "isneginf" functions get the IEEE class of a -! real, and test to see if the class is equal to ieee_positive_inf -! or ieee_negative_inf. -!--------------------------------------------------------------------- - -! TYPE double,real -elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) - use, intrinsic :: ieee_arithmetic, only: & - ieee_class, & - ieee_positive_inf, & - operator(==) - {VTYPE}, intent(in) :: x - logical :: isposinf - - isposinf = (ieee_positive_inf == ieee_class(x)) - -end function shr_infnan_isposinf_{TYPE} - -! TYPE double,real -elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) - use, intrinsic :: ieee_arithmetic, only: & - ieee_class, & - ieee_negative_inf, & - operator(==) - {VTYPE}, intent(in) :: x - logical :: isneginf - - isneginf = (ieee_negative_inf == ieee_class(x)) - -end function shr_infnan_isneginf_{TYPE} - -#else -! Don't have ieee_arithmetic. - -#ifdef CPRGNU -! NaN testing on gfortran. -! TYPE double,real -elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) - {VTYPE}, intent(in) :: x - logical :: is_nan - - is_nan = isnan(x) - -end function shr_infnan_isnan_{TYPE} -! End GNU section. -#endif - -!--------------------------------------------------------------------- -! The "isposinf" and "isneginf" functions just test against a known -! bit pattern if we don't have ieee_arithmetic. -!--------------------------------------------------------------------- - -! TYPE double,real -elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) - {VTYPE}, intent(in) :: x - logical :: isposinf -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat -#endif - - isposinf = (x == transfer(posinf_pat,x)) - -end function shr_infnan_isposinf_{TYPE} - -! TYPE double,real -elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) - {VTYPE}, intent(in) :: x - logical :: isneginf -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif - - isneginf = (x == transfer(neginf_pat,x)) - -end function shr_infnan_isneginf_{TYPE} - -! End ieee_arithmetic conditional. -#endif - -!--------------------------------------------------------------------- -! GENERATION FUNCTIONS -!--------------------------------------------------------------------- -! Two approaches for generation of NaN and Inf values: -! 1. With Fortran 2003, use the ieee_value intrinsic to get a value -! from the corresponding class. These are: -! - ieee_signaling_nan -! - ieee_quiet_nan -! - ieee_positive_inf -! - ieee_negative_inf -! 2. Without Fortran 2003, set the IEEE bit patterns directly. -! Use BOZ literals to get an integer with the correct bit -! pattern, then use "transfer" to transfer those bits into a -! real. -!--------------------------------------------------------------------- - -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - {VTYPE}, intent(out) :: output{DIMSTR} - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - {VTYPE} :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -end subroutine set_nan_{DIMS}d_{TYPE} - -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - {VTYPE}, intent(out) :: output{DIMSTR} - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - {VTYPE} :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -end subroutine set_inf_{DIMS}d_{TYPE} - -!--------------------------------------------------------------------- -! CONVERSION INTERFACES. -!--------------------------------------------------------------------- -! Function methods to get reals from nan/inf types. -!--------------------------------------------------------------------- - -pure function nan_r8(nan) result(output) - class(shr_infnan_nan_type), intent(in) :: nan - real(r8) :: output - - output = nan - -end function nan_r8 - -pure function nan_r4(nan) result(output) - class(shr_infnan_nan_type), intent(in) :: nan - real(r4) :: output - - output = nan - -end function nan_r4 - -pure function inf_r8(inf) result(output) - class(shr_infnan_inf_type), intent(in) :: inf - real(r8) :: output - - output = inf - -end function inf_r8 - -pure function inf_r4(inf) result(output) - class(shr_infnan_inf_type), intent(in) :: inf - real(r4) :: output - - output = inf - -end function inf_r4 - -end module shr_infnan_mod From a461cef295a9072f35fded7e3d221d1028cf8a75 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 8 Nov 2022 10:54:44 -0500 Subject: [PATCH 053/589] add shr_ifnan module --- .../CLM51/shr_infnan_mod.F90 | 406 ++++++++++++++++++ 1 file changed, 406 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 new file mode 100755 index 000000000..992c46fc9 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -0,0 +1,406 @@ +! Flag representing compiler support of Fortran 2003's +! ieee_arithmetic intrinsic module. +#if defined CPRIBM || defined CPRPGI || defined CPRINTEL || defined CPRCRAY || defined CPRNAG +#define HAVE_IEEE_ARITHMETIC +#endif + +module shr_infnan_mod +!--------------------------------------------------------------------- +! Module to test for IEEE Inf and NaN values, which also provides a +! method of setting +/-Inf and signaling or quiet NaN. +! +! All functions are elemental, and thus work on arrays. +!--------------------------------------------------------------------- +! To test for these values, just call the corresponding function, e.g: +! +! var_is_nan = shr_infnan_isnan(x) +! +! You can also use it on arrays: +! +! array_contains_nan = any(shr_infnan_isnan(my_array)) +! +!--------------------------------------------------------------------- +! To generate these values, assign one of the provided derived-type +! variables to a real: +! +! use shr_infnan_mod, only: nan => shr_infnan_nan, & +! inf => shr_infnan_inf, & +! assignment(=) +! real(r4) :: my_nan +! real(r8) :: my_inf_array(2,2) +! my_nan = nan +! my_inf_array = inf +! +! Keep in mind that "shr_infnan_nan" and "shr_infnan_inf" cannot be +! passed to functions that expect real arguments. To pass a real +! NaN, you will have to use shr_infnan_nan to set a local real of +! the correct kind. +!--------------------------------------------------------------------- + +use shr_kind_mod, only: & + r4 => SHR_KIND_R4, & + r8 => SHR_KIND_R8 + +#ifdef HAVE_IEEE_ARITHMETIC + +! If we have IEEE_ARITHMETIC, the NaN test is provided for us. +use, intrinsic :: ieee_arithmetic, only: & + shr_infnan_isnan => ieee_is_nan + +#else + +! Integers of correct size for bit patterns below. +use shr_kind_mod, only: i4 => shr_kind_i4, i8 => shr_kind_i8 + +#endif + +implicit none +private +save + +! Test functions for NaN/Inf values. +public :: shr_infnan_isnan +public :: shr_infnan_isinf +public :: shr_infnan_isposinf +public :: shr_infnan_isneginf + +! Locally defined isnan. +#ifndef HAVE_IEEE_ARITHMETIC +interface shr_infnan_isnan + ! TYPE double,real + module procedure shr_infnan_isnan_{TYPE} +end interface +#endif + +interface shr_infnan_isinf + ! TYPE double,real + module procedure shr_infnan_isinf_{TYPE} +end interface + +interface shr_infnan_isposinf + ! TYPE double,real + module procedure shr_infnan_isposinf_{TYPE} +end interface + +interface shr_infnan_isneginf + ! TYPE double,real + module procedure shr_infnan_isneginf_{TYPE} +end interface + +! Derived types for generation of NaN/Inf +! Even though there's no reason to "use" the types directly, some compilers +! might have trouble with an object being used without its type. +public :: shr_infnan_nan_type +public :: shr_infnan_inf_type +public :: assignment(=) +public :: shr_infnan_to_r4 +public :: shr_infnan_to_r8 + +! Type representing Not A Number. +type :: shr_infnan_nan_type + logical :: quiet = .false. +end type shr_infnan_nan_type + +! Type representing +/-Infinity. +type :: shr_infnan_inf_type + logical :: positive = .true. +end type shr_infnan_inf_type + +! Allow assigning reals to NaN or Inf. +interface assignment(=) + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 + module procedure set_nan_{DIMS}d_{TYPE} + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 + module procedure set_inf_{DIMS}d_{TYPE} +end interface + +! Conversion functions. +interface shr_infnan_to_r8 + module procedure nan_r8 + module procedure inf_r8 +end interface + +interface shr_infnan_to_r4 + module procedure nan_r4 + module procedure inf_r4 +end interface + +! Initialize objects of NaN/Inf type for other modules to use. + +! Default NaN is signaling, but also provide snan and qnan to choose +! explicitly. +type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & + shr_infnan_nan_type(.false.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & + shr_infnan_nan_type(.false.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & + shr_infnan_nan_type(.true.) + +! Default Inf is positive, but provide posinf to go with neginf. +type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & + shr_infnan_inf_type(.true.) +type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & + shr_infnan_inf_type(.true.) +type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & + shr_infnan_inf_type(.false.) + +! Bit patterns for implementation without ieee_arithmetic. +! Note that in order to satisfy gfortran's range check, we have to use +! ibset to set the sign bit from a BOZ pattern. +#ifndef HAVE_IEEE_ARITHMETIC +! Single precision. +integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) +integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) +integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) +integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) +! Double precision. +integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) +integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) +integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) +integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) +#endif + +contains + +!--------------------------------------------------------------------- +! TEST FUNCTIONS +!--------------------------------------------------------------------- +! The "isinf" function simply calls "isposinf" and "isneginf". +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) + {VTYPE}, intent(in) :: x + logical :: isinf + + isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) + +end function shr_infnan_isinf_{TYPE} + +#ifdef HAVE_IEEE_ARITHMETIC + +!--------------------------------------------------------------------- +! The "isposinf" and "isneginf" functions get the IEEE class of a +! real, and test to see if the class is equal to ieee_positive_inf +! or ieee_negative_inf. +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) + use, intrinsic :: ieee_arithmetic, only: & + ieee_class, & + ieee_positive_inf, & + operator(==) + {VTYPE}, intent(in) :: x + logical :: isposinf + + isposinf = (ieee_positive_inf == ieee_class(x)) + +end function shr_infnan_isposinf_{TYPE} + +! TYPE double,real +elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) + use, intrinsic :: ieee_arithmetic, only: & + ieee_class, & + ieee_negative_inf, & + operator(==) + {VTYPE}, intent(in) :: x + logical :: isneginf + + isneginf = (ieee_negative_inf == ieee_class(x)) + +end function shr_infnan_isneginf_{TYPE} + +#else +! Don't have ieee_arithmetic. + +#ifdef CPRGNU +! NaN testing on gfortran. +! TYPE double,real +elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) + {VTYPE}, intent(in) :: x + logical :: is_nan + + is_nan = isnan(x) + +end function shr_infnan_isnan_{TYPE} +! End GNU section. +#endif + +!--------------------------------------------------------------------- +! The "isposinf" and "isneginf" functions just test against a known +! bit pattern if we don't have ieee_arithmetic. +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) + {VTYPE}, intent(in) :: x + logical :: isposinf +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: posinf_pat = sposinf_pat +#else + integer(i8), parameter :: posinf_pat = dposinf_pat +#endif + + isposinf = (x == transfer(posinf_pat,x)) + +end function shr_infnan_isposinf_{TYPE} + +! TYPE double,real +elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) + {VTYPE}, intent(in) :: x + logical :: isneginf +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: neginf_pat = sneginf_pat +#else + integer(i8), parameter :: neginf_pat = dneginf_pat +#endif + + isneginf = (x == transfer(neginf_pat,x)) + +end function shr_infnan_isneginf_{TYPE} + +! End ieee_arithmetic conditional. +#endif + +!--------------------------------------------------------------------- +! GENERATION FUNCTIONS +!--------------------------------------------------------------------- +! Two approaches for generation of NaN and Inf values: +! 1. With Fortran 2003, use the ieee_value intrinsic to get a value +! from the corresponding class. These are: +! - ieee_signaling_nan +! - ieee_quiet_nan +! - ieee_positive_inf +! - ieee_negative_inf +! 2. Without Fortran 2003, set the IEEE bit patterns directly. +! Use BOZ literals to get an integer with the correct bit +! pattern, then use "transfer" to transfer those bits into a +! real. +!--------------------------------------------------------------------- + +! TYPE double,real +! DIMS 0,1,2,3,4,5,6,7 +pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) +#ifdef HAVE_IEEE_ARITHMETIC + use, intrinsic :: ieee_arithmetic, only: & + ieee_signaling_nan, & + ieee_quiet_nan, & + ieee_value +#else +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: snan_pat = ssnan_pat + integer(i4), parameter :: qnan_pat = sqnan_pat +#else + integer(i8), parameter :: snan_pat = dsnan_pat + integer(i8), parameter :: qnan_pat = dqnan_pat +#endif +#endif + {VTYPE}, intent(out) :: output{DIMSTR} + type(shr_infnan_nan_type), intent(in) :: nan + + ! Use scalar temporary for performance reasons, to reduce the cost of + ! the ieee_value call. + {VTYPE} :: tmp + +#ifdef HAVE_IEEE_ARITHMETIC + if (nan%quiet) then + tmp = ieee_value(tmp, ieee_quiet_nan) + else + tmp = ieee_value(tmp, ieee_signaling_nan) + end if +#else + if (nan%quiet) then + tmp = transfer(qnan_pat, tmp) + else + tmp = transfer(snan_pat, tmp) + end if +#endif + + output = tmp + +end subroutine set_nan_{DIMS}d_{TYPE} + +! TYPE double,real +! DIMS 0,1,2,3,4,5,6,7 +pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) +#ifdef HAVE_IEEE_ARITHMETIC + use, intrinsic :: ieee_arithmetic, only: & + ieee_positive_inf, & + ieee_negative_inf, & + ieee_value +#else +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: posinf_pat = sposinf_pat + integer(i4), parameter :: neginf_pat = sneginf_pat +#else + integer(i8), parameter :: posinf_pat = dposinf_pat + integer(i8), parameter :: neginf_pat = dneginf_pat +#endif +#endif + {VTYPE}, intent(out) :: output{DIMSTR} + type(shr_infnan_inf_type), intent(in) :: inf + + ! Use scalar temporary for performance reasons, to reduce the cost of + ! the ieee_value call. + {VTYPE} :: tmp + +#ifdef HAVE_IEEE_ARITHMETIC + if (inf%positive) then + tmp = ieee_value(tmp,ieee_positive_inf) + else + tmp = ieee_value(tmp,ieee_negative_inf) + end if +#else + if (inf%positive) then + tmp = transfer(posinf_pat, tmp) + else + tmp = transfer(neginf_pat, tmp) + end if +#endif + + output = tmp + +end subroutine set_inf_{DIMS}d_{TYPE} + +!--------------------------------------------------------------------- +! CONVERSION INTERFACES. +!--------------------------------------------------------------------- +! Function methods to get reals from nan/inf types. +!--------------------------------------------------------------------- + +pure function nan_r8(nan) result(output) + class(shr_infnan_nan_type), intent(in) :: nan + real(r8) :: output + + output = nan + +end function nan_r8 + +pure function nan_r4(nan) result(output) + class(shr_infnan_nan_type), intent(in) :: nan + real(r4) :: output + + output = nan + +end function nan_r4 + +pure function inf_r8(inf) result(output) + class(shr_infnan_inf_type), intent(in) :: inf + real(r8) :: output + + output = inf + +end function inf_r8 + +pure function inf_r4(inf) result(output) + class(shr_infnan_inf_type), intent(in) :: inf + real(r4) :: output + + output = inf + +end function inf_r4 + +end module shr_infnan_mod From 0b2ad3c1330e1e7a86e210d3f62c25e41b04b222 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 8 Nov 2022 13:37:48 -0500 Subject: [PATCH 054/589] simplify shr_ifnan_mid --- .../CLM51/shr_infnan_mod.F90 | 686 +++++++++--------- 1 file changed, 343 insertions(+), 343 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index 992c46fc9..159428b92 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -59,348 +59,348 @@ module shr_infnan_mod save ! Test functions for NaN/Inf values. -public :: shr_infnan_isnan -public :: shr_infnan_isinf -public :: shr_infnan_isposinf -public :: shr_infnan_isneginf - -! Locally defined isnan. -#ifndef HAVE_IEEE_ARITHMETIC -interface shr_infnan_isnan - ! TYPE double,real - module procedure shr_infnan_isnan_{TYPE} -end interface -#endif - -interface shr_infnan_isinf - ! TYPE double,real - module procedure shr_infnan_isinf_{TYPE} -end interface - -interface shr_infnan_isposinf - ! TYPE double,real - module procedure shr_infnan_isposinf_{TYPE} -end interface - -interface shr_infnan_isneginf - ! TYPE double,real - module procedure shr_infnan_isneginf_{TYPE} -end interface - -! Derived types for generation of NaN/Inf -! Even though there's no reason to "use" the types directly, some compilers -! might have trouble with an object being used without its type. -public :: shr_infnan_nan_type -public :: shr_infnan_inf_type -public :: assignment(=) -public :: shr_infnan_to_r4 -public :: shr_infnan_to_r8 - -! Type representing Not A Number. -type :: shr_infnan_nan_type - logical :: quiet = .false. -end type shr_infnan_nan_type - -! Type representing +/-Infinity. -type :: shr_infnan_inf_type - logical :: positive = .true. -end type shr_infnan_inf_type - -! Allow assigning reals to NaN or Inf. -interface assignment(=) - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_{DIMS}d_{TYPE} - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_inf_{DIMS}d_{TYPE} -end interface - -! Conversion functions. -interface shr_infnan_to_r8 - module procedure nan_r8 - module procedure inf_r8 -end interface - -interface shr_infnan_to_r4 - module procedure nan_r4 - module procedure inf_r4 -end interface - -! Initialize objects of NaN/Inf type for other modules to use. - -! Default NaN is signaling, but also provide snan and qnan to choose -! explicitly. -type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & - shr_infnan_nan_type(.false.) -type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & - shr_infnan_nan_type(.false.) -type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & - shr_infnan_nan_type(.true.) - -! Default Inf is positive, but provide posinf to go with neginf. -type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & - shr_infnan_inf_type(.true.) -type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & - shr_infnan_inf_type(.true.) -type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & - shr_infnan_inf_type(.false.) - -! Bit patterns for implementation without ieee_arithmetic. -! Note that in order to satisfy gfortran's range check, we have to use -! ibset to set the sign bit from a BOZ pattern. -#ifndef HAVE_IEEE_ARITHMETIC -! Single precision. -integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) -integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) -integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) -integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) -! Double precision. -integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) -integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) -integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) -integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) -#endif - -contains - -!--------------------------------------------------------------------- -! TEST FUNCTIONS -!--------------------------------------------------------------------- -! The "isinf" function simply calls "isposinf" and "isneginf". -!--------------------------------------------------------------------- - -! TYPE double,real -elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) - {VTYPE}, intent(in) :: x - logical :: isinf - - isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) - -end function shr_infnan_isinf_{TYPE} - -#ifdef HAVE_IEEE_ARITHMETIC - -!--------------------------------------------------------------------- -! The "isposinf" and "isneginf" functions get the IEEE class of a -! real, and test to see if the class is equal to ieee_positive_inf -! or ieee_negative_inf. -!--------------------------------------------------------------------- - -! TYPE double,real -elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) - use, intrinsic :: ieee_arithmetic, only: & - ieee_class, & - ieee_positive_inf, & - operator(==) - {VTYPE}, intent(in) :: x - logical :: isposinf - - isposinf = (ieee_positive_inf == ieee_class(x)) - -end function shr_infnan_isposinf_{TYPE} - -! TYPE double,real -elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) - use, intrinsic :: ieee_arithmetic, only: & - ieee_class, & - ieee_negative_inf, & - operator(==) - {VTYPE}, intent(in) :: x - logical :: isneginf - - isneginf = (ieee_negative_inf == ieee_class(x)) - -end function shr_infnan_isneginf_{TYPE} - -#else -! Don't have ieee_arithmetic. - -#ifdef CPRGNU -! NaN testing on gfortran. -! TYPE double,real -elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) - {VTYPE}, intent(in) :: x - logical :: is_nan - - is_nan = isnan(x) - -end function shr_infnan_isnan_{TYPE} -! End GNU section. -#endif - -!--------------------------------------------------------------------- -! The "isposinf" and "isneginf" functions just test against a known -! bit pattern if we don't have ieee_arithmetic. -!--------------------------------------------------------------------- - -! TYPE double,real -elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) - {VTYPE}, intent(in) :: x - logical :: isposinf -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat -#endif - - isposinf = (x == transfer(posinf_pat,x)) - -end function shr_infnan_isposinf_{TYPE} - -! TYPE double,real -elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) - {VTYPE}, intent(in) :: x - logical :: isneginf -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif - - isneginf = (x == transfer(neginf_pat,x)) - -end function shr_infnan_isneginf_{TYPE} - -! End ieee_arithmetic conditional. -#endif - -!--------------------------------------------------------------------- -! GENERATION FUNCTIONS -!--------------------------------------------------------------------- -! Two approaches for generation of NaN and Inf values: -! 1. With Fortran 2003, use the ieee_value intrinsic to get a value -! from the corresponding class. These are: -! - ieee_signaling_nan -! - ieee_quiet_nan -! - ieee_positive_inf -! - ieee_negative_inf -! 2. Without Fortran 2003, set the IEEE bit patterns directly. -! Use BOZ literals to get an integer with the correct bit -! pattern, then use "transfer" to transfer those bits into a -! real. -!--------------------------------------------------------------------- - -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#else -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif -#endif - {VTYPE}, intent(out) :: output{DIMSTR} - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - {VTYPE} :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if -#endif - - output = tmp - -end subroutine set_nan_{DIMS}d_{TYPE} - -! TYPE double,real -! DIMS 0,1,2,3,4,5,6,7 -pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_positive_inf, & - ieee_negative_inf, & - ieee_value -#else -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: posinf_pat = sposinf_pat - integer(i4), parameter :: neginf_pat = sneginf_pat -#else - integer(i8), parameter :: posinf_pat = dposinf_pat - integer(i8), parameter :: neginf_pat = dneginf_pat -#endif -#endif - {VTYPE}, intent(out) :: output{DIMSTR} - type(shr_infnan_inf_type), intent(in) :: inf - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - {VTYPE} :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (inf%positive) then - tmp = ieee_value(tmp,ieee_positive_inf) - else - tmp = ieee_value(tmp,ieee_negative_inf) - end if -#else - if (inf%positive) then - tmp = transfer(posinf_pat, tmp) - else - tmp = transfer(neginf_pat, tmp) - end if -#endif - - output = tmp - -end subroutine set_inf_{DIMS}d_{TYPE} - -!--------------------------------------------------------------------- -! CONVERSION INTERFACES. -!--------------------------------------------------------------------- -! Function methods to get reals from nan/inf types. -!--------------------------------------------------------------------- - -pure function nan_r8(nan) result(output) - class(shr_infnan_nan_type), intent(in) :: nan - real(r8) :: output - - output = nan - -end function nan_r8 - -pure function nan_r4(nan) result(output) - class(shr_infnan_nan_type), intent(in) :: nan - real(r4) :: output - - output = nan - -end function nan_r4 - -pure function inf_r8(inf) result(output) - class(shr_infnan_inf_type), intent(in) :: inf - real(r8) :: output - - output = inf - -end function inf_r8 - -pure function inf_r4(inf) result(output) - class(shr_infnan_inf_type), intent(in) :: inf - real(r4) :: output - - output = inf - -end function inf_r4 +!public :: shr_infnan_isnan +!public :: shr_infnan_isinf +!public :: shr_infnan_isposinf +!public :: shr_infnan_isneginf +! +!! Locally defined isnan. +!#ifndef HAVE_IEEE_ARITHMETIC +!interface shr_infnan_isnan +! ! TYPE double,real +! module procedure shr_infnan_isnan_{TYPE} +!end interface +!#endif +! +!interface shr_infnan_isinf +! ! TYPE double,real +! module procedure shr_infnan_isinf_{TYPE} +!end interface +! +!interface shr_infnan_isposinf +! ! TYPE double,real +! module procedure shr_infnan_isposinf_{TYPE} +!end interface +! +!interface shr_infnan_isneginf +! ! TYPE double,real +! module procedure shr_infnan_isneginf_{TYPE} +!end interface +! +!! Derived types for generation of NaN/Inf +!! Even though there's no reason to "use" the types directly, some compilers +!! might have trouble with an object being used without its type. +!public :: shr_infnan_nan_type +!public :: shr_infnan_inf_type +!public :: assignment(=) +!public :: shr_infnan_to_r4 +!public :: shr_infnan_to_r8 +! +!! Type representing Not A Number. +!type :: shr_infnan_nan_type +! logical :: quiet = .false. +!end type shr_infnan_nan_type +! +!! Type representing +/-Infinity. +!type :: shr_infnan_inf_type +! logical :: positive = .true. +!end type shr_infnan_inf_type +! +!! Allow assigning reals to NaN or Inf. +!interface assignment(=) +! ! TYPE double,real +! ! DIMS 0,1,2,3,4,5,6,7 +! module procedure set_nan_{DIMS}d_{TYPE} +! ! TYPE double,real +! ! DIMS 0,1,2,3,4,5,6,7 +! module procedure set_inf_{DIMS}d_{TYPE} +!end interface +! +!! Conversion functions. +!interface shr_infnan_to_r8 +! module procedure nan_r8 +! module procedure inf_r8 +!end interface +! +!interface shr_infnan_to_r4 +! module procedure nan_r4 +! module procedure inf_r4 +!end interface +! +!! Initialize objects of NaN/Inf type for other modules to use. +! +!! Default NaN is signaling, but also provide snan and qnan to choose +!! explicitly. +!type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & +! shr_infnan_nan_type(.false.) +!type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & +! shr_infnan_nan_type(.false.) +!type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & +! shr_infnan_nan_type(.true.) +! +!! Default Inf is positive, but provide posinf to go with neginf. +!type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & +! shr_infnan_inf_type(.true.) +!type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & +! shr_infnan_inf_type(.true.) +!type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & +! shr_infnan_inf_type(.false.) +! +!! Bit patterns for implementation without ieee_arithmetic. +!! Note that in order to satisfy gfortran's range check, we have to use +!! ibset to set the sign bit from a BOZ pattern. +!#ifndef HAVE_IEEE_ARITHMETIC +!! Single precision. +!integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) +!integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) +!integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) +!integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) +!! Double precision. +!integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) +!integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) +!integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) +!integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) +!#endif +! +!contains +! +!!--------------------------------------------------------------------- +!! TEST FUNCTIONS +!!--------------------------------------------------------------------- +!! The "isinf" function simply calls "isposinf" and "isneginf". +!!--------------------------------------------------------------------- +! +!! TYPE double,real +!elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) +! {VTYPE}, intent(in) :: x +! logical :: isinf +! +! isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) +! +!end function shr_infnan_isinf_{TYPE} +! +!#ifdef HAVE_IEEE_ARITHMETIC +! +!!--------------------------------------------------------------------- +!! The "isposinf" and "isneginf" functions get the IEEE class of a +!! real, and test to see if the class is equal to ieee_positive_inf +!! or ieee_negative_inf. +!!--------------------------------------------------------------------- +! +!! TYPE double,real +!elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) +! use, intrinsic :: ieee_arithmetic, only: & +! ieee_class, & +! ieee_positive_inf, & +! operator(==) +! {VTYPE}, intent(in) :: x +! logical :: isposinf +! +! isposinf = (ieee_positive_inf == ieee_class(x)) +! +!end function shr_infnan_isposinf_{TYPE} +! +!! TYPE double,real +!elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) +! use, intrinsic :: ieee_arithmetic, only: & +! ieee_class, & +! ieee_negative_inf, & +! operator(==) +! {VTYPE}, intent(in) :: x +! logical :: isneginf +! +! isneginf = (ieee_negative_inf == ieee_class(x)) +! +!end function shr_infnan_isneginf_{TYPE} +! +!#else +!! Don't have ieee_arithmetic. +! +!#ifdef CPRGNU +!! NaN testing on gfortran. +!! TYPE double,real +!elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) +! {VTYPE}, intent(in) :: x +! logical :: is_nan +! +! is_nan = isnan(x) +! +!end function shr_infnan_isnan_{TYPE} +!! End GNU section. +!#endif +! +!!--------------------------------------------------------------------- +!! The "isposinf" and "isneginf" functions just test against a known +!! bit pattern if we don't have ieee_arithmetic. +!!--------------------------------------------------------------------- +! +!! TYPE double,real +!elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) +! {VTYPE}, intent(in) :: x +! logical :: isposinf +!#if ({ITYPE} == TYPEREAL) +! integer(i4), parameter :: posinf_pat = sposinf_pat +!#else +! integer(i8), parameter :: posinf_pat = dposinf_pat +!#endif +! +! isposinf = (x == transfer(posinf_pat,x)) +! +!end function shr_infnan_isposinf_{TYPE} +! +!! TYPE double,real +!elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) +! {VTYPE}, intent(in) :: x +! logical :: isneginf +!#if ({ITYPE} == TYPEREAL) +! integer(i4), parameter :: neginf_pat = sneginf_pat +!#else +! integer(i8), parameter :: neginf_pat = dneginf_pat +!#endif +! +! isneginf = (x == transfer(neginf_pat,x)) +! +!end function shr_infnan_isneginf_{TYPE} +! +!! End ieee_arithmetic conditional. +!#endif +! +!!--------------------------------------------------------------------- +!! GENERATION FUNCTIONS +!!--------------------------------------------------------------------- +!! Two approaches for generation of NaN and Inf values: +!! 1. With Fortran 2003, use the ieee_value intrinsic to get a value +!! from the corresponding class. These are: +!! - ieee_signaling_nan +!! - ieee_quiet_nan +!! - ieee_positive_inf +!! - ieee_negative_inf +!! 2. Without Fortran 2003, set the IEEE bit patterns directly. +!! Use BOZ literals to get an integer with the correct bit +!! pattern, then use "transfer" to transfer those bits into a +!! real. +!!--------------------------------------------------------------------- +! +!! TYPE double,real +!! DIMS 0,1,2,3,4,5,6,7 +!pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) +!#ifdef HAVE_IEEE_ARITHMETIC +! use, intrinsic :: ieee_arithmetic, only: & +! ieee_signaling_nan, & +! ieee_quiet_nan, & +! ieee_value +!#else +!#if ({ITYPE} == TYPEREAL) +! integer(i4), parameter :: snan_pat = ssnan_pat +! integer(i4), parameter :: qnan_pat = sqnan_pat +!#else +! integer(i8), parameter :: snan_pat = dsnan_pat +! integer(i8), parameter :: qnan_pat = dqnan_pat +!#endif +!#endif +! {VTYPE}, intent(out) :: output{DIMSTR} +! type(shr_infnan_nan_type), intent(in) :: nan +! +! ! Use scalar temporary for performance reasons, to reduce the cost of +! ! the ieee_value call. +! {VTYPE} :: tmp +! +!#ifdef HAVE_IEEE_ARITHMETIC +! if (nan%quiet) then +! tmp = ieee_value(tmp, ieee_quiet_nan) +! else +! tmp = ieee_value(tmp, ieee_signaling_nan) +! end if +!#else +! if (nan%quiet) then +! tmp = transfer(qnan_pat, tmp) +! else +! tmp = transfer(snan_pat, tmp) +! end if +!#endif +! +! output = tmp +! +!end subroutine set_nan_{DIMS}d_{TYPE} +! +!! TYPE double,real +!! DIMS 0,1,2,3,4,5,6,7 +!pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) +!#ifdef HAVE_IEEE_ARITHMETIC +! use, intrinsic :: ieee_arithmetic, only: & +! ieee_positive_inf, & +! ieee_negative_inf, & +! ieee_value +!#else +!#if ({ITYPE} == TYPEREAL) +! integer(i4), parameter :: posinf_pat = sposinf_pat +! integer(i4), parameter :: neginf_pat = sneginf_pat +!#else +! integer(i8), parameter :: posinf_pat = dposinf_pat +! integer(i8), parameter :: neginf_pat = dneginf_pat +!#endif +!#endif +! {VTYPE}, intent(out) :: output{DIMSTR} +! type(shr_infnan_inf_type), intent(in) :: inf +! +! ! Use scalar temporary for performance reasons, to reduce the cost of +! ! the ieee_value call. +! {VTYPE} :: tmp +! +!#ifdef HAVE_IEEE_ARITHMETIC +! if (inf%positive) then +! tmp = ieee_value(tmp,ieee_positive_inf) +! else +! tmp = ieee_value(tmp,ieee_negative_inf) +! end if +!#else +! if (inf%positive) then +! tmp = transfer(posinf_pat, tmp) +! else +! tmp = transfer(neginf_pat, tmp) +! end if +!#endif +! +! output = tmp +! +!end subroutine set_inf_{DIMS}d_{TYPE} +! +!!--------------------------------------------------------------------- +!! CONVERSION INTERFACES. +!!--------------------------------------------------------------------- +!! Function methods to get reals from nan/inf types. +!!--------------------------------------------------------------------- +! +!pure function nan_r8(nan) result(output) +! class(shr_infnan_nan_type), intent(in) :: nan +! real(r8) :: output +! +! output = nan +! +!end function nan_r8 +! +!pure function nan_r4(nan) result(output) +! class(shr_infnan_nan_type), intent(in) :: nan +! real(r4) :: output +! +! output = nan +! +!end function nan_r4 +! +!pure function inf_r8(inf) result(output) +! class(shr_infnan_inf_type), intent(in) :: inf +! real(r8) :: output +! +! output = inf +! +!end function inf_r8 +! +!pure function inf_r4(inf) result(output) +! class(shr_infnan_inf_type), intent(in) :: inf +! real(r4) :: output +! +! output = inf +! +!end function inf_r4 end module shr_infnan_mod From 229d22c29f21344ad4c781fedbb2f88ef879fe84 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 8 Nov 2022 14:05:00 -0500 Subject: [PATCH 055/589] add missing variable imports --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 3cfa688e1..39a00a9b8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -4,7 +4,8 @@ module SoilBiogeochemStateType use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan, & nlevsno, nlevgrnd, nlevlak, nlevsoifl - use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi + use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi, & + VAR_COL, VAR_PFT, num_zon use clm_varctl , only : use_cn use clm_varcon , only : spval use decompMod , only : bounds_type From 1d3a31710e91ea8660e9a3e64d391f264828bfdd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 8 Nov 2022 14:30:04 -0500 Subject: [PATCH 056/589] remove unnecessary restart soil biogeochem restart variables --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 19 ++----------------- 1 file changed, 2 insertions(+), 17 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 39a00a9b8..400f0e0bf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -9,6 +9,7 @@ module SoilBiogeochemStateType use clm_varctl , only : use_cn use clm_varcon , only : spval use decompMod , only : bounds_type + use MAPL_ExceptionHandling ! !PUBLIC TYPES: implicit none @@ -69,8 +70,7 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, t end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col)) _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if @@ -102,21 +102,6 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, t this%fpg_col(n) = cncol(nc,nz, 30) this%fpi_col(n) = cncol(nc,nz, 35) - - ! "new" variables: introduced in CNCLM50 - if (cold_start==.false.) then - do nw = 1,nlevdecomp_full - this%nfixation_prof_col(n,nw) = cnpft(nc,nz,nv, XXX+(nw-1)) - this%ndep_prof_col(n,nw) = cnpft(nc,nz,nv, XXX+(nw-1)) - end do - elseif (cold_start) then - this%nfixation_prof_col(n,1:nlevdecomp_full) = 0._r8 - this%ndep_prof_col(n,1:nlevdecomp_full) = 0._r8 - else - _ASSERT(.FALSE.,'missing CNCLM50_cold_start setting') - end if - - do np = 1,nlevdecomp_full this%fpi_vr_col(n,np) = cncol(nc,nz, 35) end do From ef699bd60bae18de3c0513ee17ab7c60ff209484 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 9 Nov 2022 08:06:03 -0500 Subject: [PATCH 057/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index a0fd5b52e..dcc02856b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -5,6 +5,7 @@ module PatchType use decompMod , only : bounds_type use clm_varcon , only : ispval use clm_varctl , only : use_fates + use clm_varpar , only : numpft, NUM_ZON, NUM_VEG !----------------------------------------------------------------------- ! !DESCRIPTION: From e9b95821a6f0097d6accc2200975d7e8b15b9385 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 9 Nov 2022 12:58:57 -0500 Subject: [PATCH 058/589] typo fix --- .../CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index 78d1f2667..f9a724355 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -353,7 +353,7 @@ subroutine SetValues ( this, & do fi = 1,num_column i = filter_column(fi) - tndep_to_sminn_colhis%(i) = value_column + this%ndep_to_sminn_col%(i) = value_column this%nfix_to_sminn_col(i) = value_column this%ffix_to_sminn_col(i) = value_column this%fert_to_sminn_col(i) = value_column From 58eb28db0e457f10b36ba1f5557c55977dad6f20 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 9 Nov 2022 14:09:01 -0500 Subject: [PATCH 059/589] bug fixes --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 400f0e0bf..71768ec52 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -3,7 +3,7 @@ module SoilBiogeochemStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan, & - nlevsno, nlevgrnd, nlevlak, nlevsoifl + nlevsno, nlevgrnd, nlevlak use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi, & VAR_COL, VAR_PFT, num_zon use clm_varctl , only : use_cn @@ -57,7 +57,7 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, t ! !LOCAL VARIABLES: integer :: begp, endp integer :: begc,endc - integer :: n, nc, nz, n, np + integer :: n, nc, nz, np logical :: cold_start = .false. !----------------------------------- @@ -70,7 +70,7 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, t end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col)) + if ((cold_start==.false.) .and. (size(cncol,3).ne.var_col)) _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if From 1ecad9c9c0d1a26143ee5fbec12669f2c8987f52 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 9 Nov 2022 15:37:37 -0500 Subject: [PATCH 060/589] bug fix in if-statement --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 71768ec52..f78758d9d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -70,7 +70,7 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, t end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. (size(cncol,3).ne.var_col)) + if ((cold_start==.false.) .and. (size(cncol,3).ne.var_col)) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if From 8df4dc50794175207c8146f61bc83d5e72c1b3ee Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 08:04:35 -0500 Subject: [PATCH 061/589] adding output argument rc for _ASSERT call --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index f78758d9d..e4d140592 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -43,7 +43,7 @@ module SoilBiogeochemStateType contains !--------------------------------------- - subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, this) + subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, this, rc) ! ! !ARGUMENTS: @@ -53,6 +53,7 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, t real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart logical, optional, intent(in) :: cn5_cold_start type(soilbiogeochem_state_type), intent(inout) :: this + integer, optional, intent(out) :: rc ! ! !LOCAL VARIABLES: integer :: begp, endp From a452b81248ddaacd780a2a9365401bbfa2de7cc4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 09:18:27 -0500 Subject: [PATCH 062/589] add missing include MAPL_Generic statement --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index e4d140592..b4e260a4f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -1,3 +1,5 @@ +#include "MAPL_Generic.h" + module SoilBiogeochemStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 From 103c49d52a928c5d3169155a947ff23b8f725d4d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 10:02:35 -0500 Subject: [PATCH 063/589] remove unnecessary entries --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h index b09e0d127..24d92d0b0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h @@ -1,14 +1,3 @@ -#ifdef NDEBUG -#define SHR_ASSERT(assert, msg) -#define SHR_ASSERT_FL(assert, file, line) -#define SHR_ASSERT_MFL(assert, msg, file, line) -#define SHR_ASSERT_ALL(assert, msg) -#define SHR_ASSERT_ALL_FL(assert, file, line) -#define SHR_ASSERT_ALL_MFL(assert, msg, file, line) -#define SHR_ASSERT_ANY(assert, msg) -#define SHR_ASSERT_ANY_FL(assert, file, line) -#define SHR_ASSERT_ANY_MFL(assert, msg, file, line) -#else #define SHR_ASSERT(assert, my_msg) call shr_assert(assert, msg=my_msg) #define SHR_ASSERT_FL(assert, my_file, my_line) call shr_assert(assert, file=my_file, line=my_line) #define SHR_ASSERT_MFL(assert, my_msg, my_file, my_line) call shr_assert(assert, msg=my_msg, file=my_file, line=my_line) @@ -18,5 +7,5 @@ #define SHR_ASSERT_ANY(assert, my_msg) call shr_assert_any(assert, msg=my_msg) #define SHR_ASSERT_ANY_FL(assert, my_file, my_line) call shr_assert_any(assert, file=my_file, line=my_line) #define SHR_ASSERT_ANY_MFL(assert, my_msg, my_file, my_line) call shr_assert_any(assert, msg=my_msg, file=my_file, line=my_line) -#endif + use shr_assert_mod From 935f736ed654411bbe327f131a96c9a2b32e3588 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 10:02:57 -0500 Subject: [PATCH 064/589] add assignment function --- .../CLM51/shr_infnan_mod.F90 | 132 +++++++++--------- 1 file changed, 66 insertions(+), 66 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index 159428b92..f3cbbf9f5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -59,18 +59,18 @@ module shr_infnan_mod save ! Test functions for NaN/Inf values. -!public :: shr_infnan_isnan +public :: shr_infnan_isnan !public :: shr_infnan_isinf !public :: shr_infnan_isposinf !public :: shr_infnan_isneginf ! !! Locally defined isnan. -!#ifndef HAVE_IEEE_ARITHMETIC -!interface shr_infnan_isnan -! ! TYPE double,real -! module procedure shr_infnan_isnan_{TYPE} -!end interface -!#endif +#ifndef HAVE_IEEE_ARITHMETIC +interface shr_infnan_isnan + TYPE double,real + module procedure shr_infnan_isnan_{TYPE} +end interface +#endif ! !interface shr_infnan_isinf ! ! TYPE double,real @@ -107,14 +107,14 @@ module shr_infnan_mod !end type shr_infnan_inf_type ! !! Allow assigning reals to NaN or Inf. -!interface assignment(=) -! ! TYPE double,real -! ! DIMS 0,1,2,3,4,5,6,7 -! module procedure set_nan_{DIMS}d_{TYPE} -! ! TYPE double,real -! ! DIMS 0,1,2,3,4,5,6,7 -! module procedure set_inf_{DIMS}d_{TYPE} -!end interface +interface assignment(=) + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 + module procedure set_nan_{DIMS}d_{TYPE} + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 + ! module procedure set_inf_{DIMS}d_{TYPE} +end interface ! !! Conversion functions. !interface shr_infnan_to_r8 @@ -216,18 +216,18 @@ module shr_infnan_mod !#else !! Don't have ieee_arithmetic. ! -!#ifdef CPRGNU -!! NaN testing on gfortran. -!! TYPE double,real -!elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) -! {VTYPE}, intent(in) :: x -! logical :: is_nan -! -! is_nan = isnan(x) -! -!end function shr_infnan_isnan_{TYPE} -!! End GNU section. -!#endif +#ifdef CPRGNU +! NaN testing on gfortran. +! TYPE double,real +elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) + {VTYPE}, intent(in) :: x + logical :: is_nan + + is_nan = isnan(x) + +end function shr_infnan_isnan_{TYPE} +! End GNU section. +#endif ! !!--------------------------------------------------------------------- !! The "isposinf" and "isneginf" functions just test against a known @@ -283,45 +283,45 @@ module shr_infnan_mod ! !! TYPE double,real !! DIMS 0,1,2,3,4,5,6,7 -!pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) -!#ifdef HAVE_IEEE_ARITHMETIC -! use, intrinsic :: ieee_arithmetic, only: & -! ieee_signaling_nan, & -! ieee_quiet_nan, & -! ieee_value -!#else -!#if ({ITYPE} == TYPEREAL) -! integer(i4), parameter :: snan_pat = ssnan_pat -! integer(i4), parameter :: qnan_pat = sqnan_pat -!#else -! integer(i8), parameter :: snan_pat = dsnan_pat -! integer(i8), parameter :: qnan_pat = dqnan_pat -!#endif -!#endif -! {VTYPE}, intent(out) :: output{DIMSTR} -! type(shr_infnan_nan_type), intent(in) :: nan -! -! ! Use scalar temporary for performance reasons, to reduce the cost of -! ! the ieee_value call. -! {VTYPE} :: tmp -! -!#ifdef HAVE_IEEE_ARITHMETIC -! if (nan%quiet) then -! tmp = ieee_value(tmp, ieee_quiet_nan) -! else -! tmp = ieee_value(tmp, ieee_signaling_nan) -! end if -!#else -! if (nan%quiet) then -! tmp = transfer(qnan_pat, tmp) -! else -! tmp = transfer(snan_pat, tmp) -! end if -!#endif -! -! output = tmp -! -!end subroutine set_nan_{DIMS}d_{TYPE} +pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) +#ifdef HAVE_IEEE_ARITHMETIC + use, intrinsic :: ieee_arithmetic, only: & + ieee_signaling_nan, & + ieee_quiet_nan, & + ieee_value +#else +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: snan_pat = ssnan_pat + integer(i4), parameter :: qnan_pat = sqnan_pat +#else + integer(i8), parameter :: snan_pat = dsnan_pat + integer(i8), parameter :: qnan_pat = dqnan_pat +#endif +#endif + {VTYPE}, intent(out) :: output{DIMSTR} + type(shr_infnan_nan_type), intent(in) :: nan + + ! Use scalar temporary for performance reasons, to reduce the cost of + ! the ieee_value call. + {VTYPE} :: tmp + +#ifdef HAVE_IEEE_ARITHMETIC + if (nan%quiet) then + tmp = ieee_value(tmp, ieee_quiet_nan) + else + tmp = ieee_value(tmp, ieee_signaling_nan) + end if +#else + if (nan%quiet) then + tmp = transfer(qnan_pat, tmp) + else + tmp = transfer(snan_pat, tmp) + end if +#endif + + output = tmp + +end subroutine set_nan_{DIMS}d_{TYPE} ! !! TYPE double,real !! DIMS 0,1,2,3,4,5,6,7 From bc4e65d0c1d74fcb879b5193e4a7e171417aa073 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 10:50:42 -0500 Subject: [PATCH 065/589] simplifying if-statements --- .../CLM51/shr_infnan_mod.F90 | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index f3cbbf9f5..49001e43f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -289,14 +289,6 @@ pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) ieee_signaling_nan, & ieee_quiet_nan, & ieee_value -#else -#if ({ITYPE} == TYPEREAL) - integer(i4), parameter :: snan_pat = ssnan_pat - integer(i4), parameter :: qnan_pat = sqnan_pat -#else - integer(i8), parameter :: snan_pat = dsnan_pat - integer(i8), parameter :: qnan_pat = dqnan_pat -#endif #endif {VTYPE}, intent(out) :: output{DIMSTR} type(shr_infnan_nan_type), intent(in) :: nan @@ -311,12 +303,6 @@ pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) else tmp = ieee_value(tmp, ieee_signaling_nan) end if -#else - if (nan%quiet) then - tmp = transfer(qnan_pat, tmp) - else - tmp = transfer(snan_pat, tmp) - end if #endif output = tmp From 3dd88fa8605b69ef7f53381ff7cd660a19349408 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 11:14:34 -0500 Subject: [PATCH 066/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index 49001e43f..ffcb3d52e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -67,7 +67,7 @@ module shr_infnan_mod !! Locally defined isnan. #ifndef HAVE_IEEE_ARITHMETIC interface shr_infnan_isnan - TYPE double,real + TYPE double,real module procedure shr_infnan_isnan_{TYPE} end interface #endif @@ -108,8 +108,8 @@ module shr_infnan_mod ! !! Allow assigning reals to NaN or Inf. interface assignment(=) - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 + TYPE double,real + DIMS 0,1,2,3,4,5,6,7 module procedure set_nan_{DIMS}d_{TYPE} ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 From 8c870b55512ec8adaab67246587d643c07091a30 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 13:40:02 -0500 Subject: [PATCH 067/589] bug fix --- .../CLM51/shr_infnan_mod.F90 | 85 ++++++++++--------- 1 file changed, 43 insertions(+), 42 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index ffcb3d52e..532e35cf7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -1,3 +1,4 @@ +#define CPRINTEL 1 ! Flag representing compiler support of Fortran 2003's ! ieee_arithmetic intrinsic module. #if defined CPRIBM || defined CPRPGI || defined CPRINTEL || defined CPRCRAY || defined CPRNAG @@ -67,7 +68,7 @@ module shr_infnan_mod !! Locally defined isnan. #ifndef HAVE_IEEE_ARITHMETIC interface shr_infnan_isnan - TYPE double,real + ! TYPE double,real module procedure shr_infnan_isnan_{TYPE} end interface #endif @@ -90,16 +91,16 @@ module shr_infnan_mod !! Derived types for generation of NaN/Inf !! Even though there's no reason to "use" the types directly, some compilers !! might have trouble with an object being used without its type. -!public :: shr_infnan_nan_type +public :: shr_infnan_nan_type !public :: shr_infnan_inf_type -!public :: assignment(=) +public :: assignment(=) !public :: shr_infnan_to_r4 !public :: shr_infnan_to_r8 ! !! Type representing Not A Number. -!type :: shr_infnan_nan_type -! logical :: quiet = .false. -!end type shr_infnan_nan_type +type :: shr_infnan_nan_type + logical :: quiet = .false. +end type shr_infnan_nan_type ! !! Type representing +/-Infinity. !type :: shr_infnan_inf_type @@ -108,8 +109,8 @@ module shr_infnan_mod ! !! Allow assigning reals to NaN or Inf. interface assignment(=) - TYPE double,real - DIMS 0,1,2,3,4,5,6,7 + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 module procedure set_nan_{DIMS}d_{TYPE} ! TYPE double,real ! DIMS 0,1,2,3,4,5,6,7 @@ -131,12 +132,12 @@ module shr_infnan_mod ! !! Default NaN is signaling, but also provide snan and qnan to choose !! explicitly. -!type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & -! shr_infnan_nan_type(.false.) -!type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & -! shr_infnan_nan_type(.false.) -!type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & -! shr_infnan_nan_type(.true.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & + shr_infnan_nan_type(.false.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & + shr_infnan_nan_type(.false.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & + shr_infnan_nan_type(.true.) ! !! Default Inf is positive, but provide posinf to go with neginf. !type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & @@ -149,20 +150,20 @@ module shr_infnan_mod !! Bit patterns for implementation without ieee_arithmetic. !! Note that in order to satisfy gfortran's range check, we have to use !! ibset to set the sign bit from a BOZ pattern. -!#ifndef HAVE_IEEE_ARITHMETIC -!! Single precision. -!integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) -!integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) -!integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) -!integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) -!! Double precision. -!integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) -!integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) -!integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) -!integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) -!#endif +#ifndef HAVE_IEEE_ARITHMETIC +! Single precision. +integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) +integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) +integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) +integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) +! Double precision. +integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) +integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) +integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) +integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) +#endif ! -!contains +contains ! !!--------------------------------------------------------------------- !! TEST FUNCTIONS @@ -357,21 +358,21 @@ end subroutine set_nan_{DIMS}d_{TYPE} !! Function methods to get reals from nan/inf types. !!--------------------------------------------------------------------- ! -!pure function nan_r8(nan) result(output) -! class(shr_infnan_nan_type), intent(in) :: nan -! real(r8) :: output -! -! output = nan -! -!end function nan_r8 -! -!pure function nan_r4(nan) result(output) -! class(shr_infnan_nan_type), intent(in) :: nan -! real(r4) :: output -! -! output = nan -! -!end function nan_r4 +pure function nan_r8(nan) result(output) + class(shr_infnan_nan_type), intent(in) :: nan + real(r8) :: output + + output = nan + +end function nan_r8 + +pure function nan_r4(nan) result(output) + class(shr_infnan_nan_type), intent(in) :: nan + real(r4) :: output + + output = nan + +end function nan_r4 ! !pure function inf_r8(inf) result(output) ! class(shr_infnan_inf_type), intent(in) :: inf From aac7ae90041a824ce7838b1afbe2d00334bce7dd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 14:09:01 -0500 Subject: [PATCH 068/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index 532e35cf7..24ff4cdf4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -1,9 +1,6 @@ -#define CPRINTEL 1 ! Flag representing compiler support of Fortran 2003's ! ieee_arithmetic intrinsic module. -#if defined CPRIBM || defined CPRPGI || defined CPRINTEL || defined CPRCRAY || defined CPRNAG #define HAVE_IEEE_ARITHMETIC -#endif module shr_infnan_mod !--------------------------------------------------------------------- From d280343b17baae9f96888e255f33626b9a24b748 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 15:06:20 -0500 Subject: [PATCH 069/589] bug fix --- .../CLM51/shr_infnan_mod.F90 | 79 ++++++++++--------- 1 file changed, 42 insertions(+), 37 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index 24ff4cdf4..773771c02 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -90,7 +90,7 @@ module shr_infnan_mod !! might have trouble with an object being used without its type. public :: shr_infnan_nan_type !public :: shr_infnan_inf_type -public :: assignment(=) +!public :: assignment(=) !public :: shr_infnan_to_r4 !public :: shr_infnan_to_r8 ! @@ -105,14 +105,14 @@ module shr_infnan_mod !end type shr_infnan_inf_type ! !! Allow assigning reals to NaN or Inf. -interface assignment(=) - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - module procedure set_nan_{DIMS}d_{TYPE} - ! TYPE double,real - ! DIMS 0,1,2,3,4,5,6,7 - ! module procedure set_inf_{DIMS}d_{TYPE} -end interface +!interface assignment(=) +! ! TYPE double,real +! ! DIMS 0,1,2,3,4,5,6,7 +! module procedure set_nan_new +! ! TYPE double,real +! ! DIMS 0,1,2,3,4,5,6,7 +! ! module procedure set_inf_{DIMS}d_{TYPE} +!end interface ! !! Conversion functions. !interface shr_infnan_to_r8 @@ -214,7 +214,6 @@ module shr_infnan_mod !#else !! Don't have ieee_arithmetic. ! -#ifdef CPRGNU ! NaN testing on gfortran. ! TYPE double,real elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) @@ -225,8 +224,6 @@ elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) end function shr_infnan_isnan_{TYPE} ! End GNU section. -#endif -! !!--------------------------------------------------------------------- !! The "isposinf" and "isneginf" functions just test against a known !! bit pattern if we don't have ieee_arithmetic. @@ -281,31 +278,39 @@ end function shr_infnan_isnan_{TYPE} ! !! TYPE double,real !! DIMS 0,1,2,3,4,5,6,7 -pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) -#ifdef HAVE_IEEE_ARITHMETIC - use, intrinsic :: ieee_arithmetic, only: & - ieee_signaling_nan, & - ieee_quiet_nan, & - ieee_value -#endif - {VTYPE}, intent(out) :: output{DIMSTR} - type(shr_infnan_nan_type), intent(in) :: nan - - ! Use scalar temporary for performance reasons, to reduce the cost of - ! the ieee_value call. - {VTYPE} :: tmp - -#ifdef HAVE_IEEE_ARITHMETIC - if (nan%quiet) then - tmp = ieee_value(tmp, ieee_quiet_nan) - else - tmp = ieee_value(tmp, ieee_signaling_nan) - end if -#endif - - output = tmp - -end subroutine set_nan_{DIMS}d_{TYPE} +!subroutine set_nan_new +!#ifdef HAVE_IEEE_ARITHMETIC +! use, intrinsic :: ieee_arithmetic, only: & +! ieee_signaling_nan, & +! ieee_quiet_nan, & +! ieee_value +!#endif +! public :: inf, nan, bigint +!! signaling nan +! real*8, parameter :: inf8 = O'0777600000000000000000' +! real*8, parameter :: nan8 = O'0777610000000000000000' +! real*4, parameter :: inf4 = O'17740000000' +! real*4, parameter :: nan4 = O'17760000000' +! real, parameter :: inf = inf4 +! real, parameter :: nan = nan4 +! integer, parameter :: bigint = O'17777777777' +! type(shr_infnan_nan_type), intent(in) :: nan +! +! ! Use scalar temporary for performance reasons, to reduce the cost of +! ! the ieee_value call. +! {VTYPE} :: tmp +! +!#ifdef HAVE_IEEE_ARITHMETIC +! if (nan%quiet) then +! tmp = ieee_value(tmp, ieee_quiet_nan) +! else +! tmp = ieee_value(tmp, ieee_signaling_nan) +! end if +!#endif +! +! output = tmp +! +!end subroutine set_nan_new ! !! TYPE double,real !! DIMS 0,1,2,3,4,5,6,7 From 1f3619c8a9e303ef46bdb5d7c15ede7e3d8a7208 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 15:16:03 -0500 Subject: [PATCH 070/589] changing use statement for shr_infnan_mod --- .../GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 | 2 +- .../CLM51/CNCLM_FrictionVelocityMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 2 +- .../CLM51/CNCLM_SaturatedExcessRunoffMod.F90 | 2 +- .../CLM51/CNCLM_Wateratm2lndBulkType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 2 +- .../CLM51/NutrientCompetitionFlexibleCNMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 | 2 +- 17 files changed, 17 insertions(+), 17 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 index cc7aa660d..c41ac2bc5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 @@ -6,7 +6,7 @@ module CNBalanceCheckMod ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 index 3ae4dca21..97c1ab9ba 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -61,7 +61,7 @@ module CNDVType !------------------------------------------------------ subroutine init_dgvs_type(bounds, this) - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use nanMod , only : nan use clm_varpar , only : maxveg use pftconMod , only : allom1s, allom2s, allom1, allom2, allom3, reinickerp use pftconMod , only : nbrdlf_dcd_brl_shrub diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 index 57da84d30..905fbec61 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -145,7 +145,7 @@ end subroutine CNFireInit subroutine InitAllocate( this, bounds ) ! ! Initiaze memory allocate's - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan ! ! !ARGUMENTS: class(cnfire_base_type) :: this diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 index 8d10e3133..0188c4c23 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 @@ -82,7 +82,7 @@ subroutine BaseFireInit( this, bounds ) ! !DESCRIPTION: ! Initialize CN Fire module ! !USES: - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use nanMod , only : nan ! ! !ARGUMENTS: class(fire_base_type) :: this diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 index 3d3bb9452..d118def30 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 @@ -84,7 +84,7 @@ module FrictionVelocityMod !------------------------------------------------------------------------ subroutine init_frictionvel_type( bounds, this) - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan type(bounds_type), intent(in) :: bounds type(frictionvel_type), intent(inout) :: this diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index aad63ec42..b4ef72007 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -17,7 +17,7 @@ module LandunitType ! 9 => (isturb_md) urban md ! use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan use clm_varcon , only : ispval use decompMod , only : bounds_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 index 8e01660d0..d0f1a2833 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 @@ -44,7 +44,7 @@ module SaturatedExcessRunoffMod subroutine init_saturated_excess_runoff_type(bounds, this) ! !USES: - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan ! ! !ARGUMENTS: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 index 4159b567f..85edb533e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 @@ -49,7 +49,7 @@ subroutine init_wateratm2lndbulk_type(bounds, this) ! Initialize module data structure ! ! !USES: - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use nanMod , only : nan ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 index 930c5c843..083a3deb3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 @@ -44,7 +44,7 @@ subroutine init_wateratm2lnd_type(bounds,this) ! !DESCRIPTION: ! ! !USES: - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use nanMod , only : nan ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 index e536ddfda..2fab9c2a7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 @@ -7,7 +7,7 @@ module initVerticalMod ! Initialize vertical components of column datatype ! use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan use shr_log_mod , only : errMsg => shr_log_errMsg use shr_sys_mod , only : shr_sys_abort use decompMod , only : bounds_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index bfcd4cd5d..e556f17f0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -1,7 +1,7 @@ module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan use clm_varpar , only : mxpft, numrad,nvariants use clm_varctl , only : use_flexibleCN use netcdf diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 index 5046ce5f4..11e280f2c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 @@ -43,7 +43,7 @@ module CNFireEmissionsMod subroutine init_fireemis_type(bounds, this) ! ! Allocate memory for module datatypes - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use nanMod , only : nan use clm_varcon , only : spval ! !ARGUMENTS: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 12046a037..ad6356297 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -40,7 +40,7 @@ module CNVegetationFacade ! !USES: #include "shr_assert.h" use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan use shr_log_mod , only : errMsg => shr_log_errMsg use perf_mod , only : t_startf, t_stopf use decompMod , only : bounds_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 index bd6608bcb..1e9e77ae3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 @@ -92,7 +92,7 @@ subroutine InitAllocate(this, bounds) ! Allocate memory for the class data ! ! !USES: - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan ! !ARGUMENTS: class(nutrient_competition_FlexibleCN_type) :: this type(bounds_type), intent(in) :: bounds diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index fe1d03f5d..d4a2c2742 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -12,7 +12,7 @@ module PhotosynthesisMod use shr_sys_mod , only : shr_sys_flush use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan use abortutils , only : endrun use clm_varctl , only : use_c13, use_c14, use_cn, use_cndv, use_fates, use_luna, use_hydrstress use clm_varctl , only : iulog diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 index e14c31dc6..7000cdaca 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 @@ -102,7 +102,7 @@ end subroutine Init subroutine InitAllocate(this, bounds) ! ! !USES: - use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use shr_infnan_mod, only : nan => shr_infnan_nan ! ! !ARGUMENTS: class(surfrad_type) :: this diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 203ef73ca..2da7f2e16 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -10,7 +10,7 @@ module ncdio_pio ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8, i4=>shr_kind_i4, shr_kind_cl, r4 => shr_kind_r4 - use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan, assignment(=) + use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : errMsg => shr_log_errMsg use MAPL , only : file_desc_t => NetCDF4_FileFormatter From a40368e55882038768b5d309d5e246872da08c4d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 15:51:30 -0500 Subject: [PATCH 071/589] removing everything but nan definition --- .../CLM51/shr_infnan_mod.F90 | 646 +++++++++--------- 1 file changed, 323 insertions(+), 323 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index 773771c02..7bb8959b5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -57,339 +57,339 @@ module shr_infnan_mod save ! Test functions for NaN/Inf values. -public :: shr_infnan_isnan -!public :: shr_infnan_isinf -!public :: shr_infnan_isposinf -!public :: shr_infnan_isneginf -! -!! Locally defined isnan. -#ifndef HAVE_IEEE_ARITHMETIC -interface shr_infnan_isnan - ! TYPE double,real - module procedure shr_infnan_isnan_{TYPE} -end interface -#endif -! -!interface shr_infnan_isinf -! ! TYPE double,real -! module procedure shr_infnan_isinf_{TYPE} -!end interface -! -!interface shr_infnan_isposinf -! ! TYPE double,real -! module procedure shr_infnan_isposinf_{TYPE} -!end interface -! -!interface shr_infnan_isneginf -! ! TYPE double,real -! module procedure shr_infnan_isneginf_{TYPE} -!end interface -! -!! Derived types for generation of NaN/Inf -!! Even though there's no reason to "use" the types directly, some compilers -!! might have trouble with an object being used without its type. -public :: shr_infnan_nan_type -!public :: shr_infnan_inf_type -!public :: assignment(=) -!public :: shr_infnan_to_r4 -!public :: shr_infnan_to_r8 -! -!! Type representing Not A Number. -type :: shr_infnan_nan_type - logical :: quiet = .false. -end type shr_infnan_nan_type -! -!! Type representing +/-Infinity. -!type :: shr_infnan_inf_type -! logical :: positive = .true. -!end type shr_infnan_inf_type -! -!! Allow assigning reals to NaN or Inf. -!interface assignment(=) -! ! TYPE double,real -! ! DIMS 0,1,2,3,4,5,6,7 -! module procedure set_nan_new +!public :: shr_infnan_isnan +!!public :: shr_infnan_isinf +!!public :: shr_infnan_isposinf +!!public :: shr_infnan_isneginf +!! +!!! Locally defined isnan. +!#ifndef HAVE_IEEE_ARITHMETIC +!interface shr_infnan_isnan ! ! TYPE double,real -! ! DIMS 0,1,2,3,4,5,6,7 -! ! module procedure set_inf_{DIMS}d_{TYPE} +! module procedure shr_infnan_isnan_{TYPE} !end interface -! -!! Conversion functions. -!interface shr_infnan_to_r8 -! module procedure nan_r8 -! module procedure inf_r8 -!end interface -! -!interface shr_infnan_to_r4 -! module procedure nan_r4 -! module procedure inf_r4 -!end interface -! -!! Initialize objects of NaN/Inf type for other modules to use. -! -!! Default NaN is signaling, but also provide snan and qnan to choose -!! explicitly. -type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & - shr_infnan_nan_type(.false.) -type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & - shr_infnan_nan_type(.false.) -type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & - shr_infnan_nan_type(.true.) -! -!! Default Inf is positive, but provide posinf to go with neginf. -!type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & -! shr_infnan_inf_type(.true.) -!type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & -! shr_infnan_inf_type(.true.) -!type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & -! shr_infnan_inf_type(.false.) -! -!! Bit patterns for implementation without ieee_arithmetic. -!! Note that in order to satisfy gfortran's range check, we have to use -!! ibset to set the sign bit from a BOZ pattern. -#ifndef HAVE_IEEE_ARITHMETIC -! Single precision. -integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) -integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) -integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) -integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) -! Double precision. -integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) -integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) -integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) -integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) -#endif -! -contains -! -!!--------------------------------------------------------------------- -!! TEST FUNCTIONS -!!--------------------------------------------------------------------- -!! The "isinf" function simply calls "isposinf" and "isneginf". -!!--------------------------------------------------------------------- -! -!! TYPE double,real -!elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) -! {VTYPE}, intent(in) :: x -! logical :: isinf -! -! isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) -! -!end function shr_infnan_isinf_{TYPE} -! -!#ifdef HAVE_IEEE_ARITHMETIC -! -!!--------------------------------------------------------------------- -!! The "isposinf" and "isneginf" functions get the IEEE class of a -!! real, and test to see if the class is equal to ieee_positive_inf -!! or ieee_negative_inf. -!!--------------------------------------------------------------------- -! -!! TYPE double,real -!elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) -! use, intrinsic :: ieee_arithmetic, only: & -! ieee_class, & -! ieee_positive_inf, & -! operator(==) -! {VTYPE}, intent(in) :: x -! logical :: isposinf -! -! isposinf = (ieee_positive_inf == ieee_class(x)) -! -!end function shr_infnan_isposinf_{TYPE} -! -!! TYPE double,real -!elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) -! use, intrinsic :: ieee_arithmetic, only: & -! ieee_class, & -! ieee_negative_inf, & -! operator(==) -! {VTYPE}, intent(in) :: x -! logical :: isneginf -! -! isneginf = (ieee_negative_inf == ieee_class(x)) -! -!end function shr_infnan_isneginf_{TYPE} -! -!#else -!! Don't have ieee_arithmetic. -! -! NaN testing on gfortran. -! TYPE double,real -elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) - {VTYPE}, intent(in) :: x - logical :: is_nan - - is_nan = isnan(x) - -end function shr_infnan_isnan_{TYPE} -! End GNU section. -!!--------------------------------------------------------------------- -!! The "isposinf" and "isneginf" functions just test against a known -!! bit pattern if we don't have ieee_arithmetic. -!!--------------------------------------------------------------------- -! -!! TYPE double,real -!elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) -! {VTYPE}, intent(in) :: x -! logical :: isposinf -!#if ({ITYPE} == TYPEREAL) -! integer(i4), parameter :: posinf_pat = sposinf_pat -!#else -! integer(i8), parameter :: posinf_pat = dposinf_pat -!#endif -! -! isposinf = (x == transfer(posinf_pat,x)) -! -!end function shr_infnan_isposinf_{TYPE} -! -!! TYPE double,real -!elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) -! {VTYPE}, intent(in) :: x -! logical :: isneginf -!#if ({ITYPE} == TYPEREAL) -! integer(i4), parameter :: neginf_pat = sneginf_pat -!#else -! integer(i8), parameter :: neginf_pat = dneginf_pat !#endif -! -! isneginf = (x == transfer(neginf_pat,x)) -! -!end function shr_infnan_isneginf_{TYPE} -! -!! End ieee_arithmetic conditional. +!! +!!interface shr_infnan_isinf +!! ! TYPE double,real +!! module procedure shr_infnan_isinf_{TYPE} +!!end interface +!! +!!interface shr_infnan_isposinf +!! ! TYPE double,real +!! module procedure shr_infnan_isposinf_{TYPE} +!!end interface +!! +!!interface shr_infnan_isneginf +!! ! TYPE double,real +!! module procedure shr_infnan_isneginf_{TYPE} +!!end interface +!! +!!! Derived types for generation of NaN/Inf +!!! Even though there's no reason to "use" the types directly, some compilers +!!! might have trouble with an object being used without its type. +!public :: shr_infnan_nan_type +!!public :: shr_infnan_inf_type +!!public :: assignment(=) +!!public :: shr_infnan_to_r4 +!!public :: shr_infnan_to_r8 +!! +!!! Type representing Not A Number. +!type :: shr_infnan_nan_type +! logical :: quiet = .false. +!end type shr_infnan_nan_type +!! +!!! Type representing +/-Infinity. +!!type :: shr_infnan_inf_type +!! logical :: positive = .true. +!!end type shr_infnan_inf_type +!! +!!! Allow assigning reals to NaN or Inf. +!!interface assignment(=) +!! ! TYPE double,real +!! ! DIMS 0,1,2,3,4,5,6,7 +!! module procedure set_nan_new +!! ! TYPE double,real +!! ! DIMS 0,1,2,3,4,5,6,7 +!! ! module procedure set_inf_{DIMS}d_{TYPE} +!!end interface +!! +!!! Conversion functions. +!!interface shr_infnan_to_r8 +!! module procedure nan_r8 +!! module procedure inf_r8 +!!end interface +!! +!!interface shr_infnan_to_r4 +!! module procedure nan_r4 +!! module procedure inf_r4 +!!end interface +!! +!!! Initialize objects of NaN/Inf type for other modules to use. +!! +!!! Default NaN is signaling, but also provide snan and qnan to choose +!!! explicitly. +!type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & +! shr_infnan_nan_type(.false.) +!type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & +! shr_infnan_nan_type(.false.) +!type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & +! shr_infnan_nan_type(.true.) +!! +!!! Default Inf is positive, but provide posinf to go with neginf. +!!type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & +!! shr_infnan_inf_type(.true.) +!!type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & +!! shr_infnan_inf_type(.true.) +!!type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & +!! shr_infnan_inf_type(.false.) +!! +!!! Bit patterns for implementation without ieee_arithmetic. +!!! Note that in order to satisfy gfortran's range check, we have to use +!!! ibset to set the sign bit from a BOZ pattern. +!#ifndef HAVE_IEEE_ARITHMETIC +!! Single precision. +!integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) +!integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) +!integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) +!integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) +!! Double precision. +!integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) +!integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) +!integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) +!integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) !#endif -! -!!--------------------------------------------------------------------- -!! GENERATION FUNCTIONS -!!--------------------------------------------------------------------- -!! Two approaches for generation of NaN and Inf values: -!! 1. With Fortran 2003, use the ieee_value intrinsic to get a value -!! from the corresponding class. These are: -!! - ieee_signaling_nan -!! - ieee_quiet_nan -!! - ieee_positive_inf -!! - ieee_negative_inf -!! 2. Without Fortran 2003, set the IEEE bit patterns directly. -!! Use BOZ literals to get an integer with the correct bit -!! pattern, then use "transfer" to transfer those bits into a -!! real. -!!--------------------------------------------------------------------- -! +!! +!contains +!! +!!!--------------------------------------------------------------------- +!!! TEST FUNCTIONS +!!!--------------------------------------------------------------------- +!!! The "isinf" function simply calls "isposinf" and "isneginf". +!!!--------------------------------------------------------------------- +!! +!!! TYPE double,real +!!elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) +!! {VTYPE}, intent(in) :: x +!! logical :: isinf +!! +!! isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) +!! +!!end function shr_infnan_isinf_{TYPE} +!! +!!#ifdef HAVE_IEEE_ARITHMETIC +!! +!!!--------------------------------------------------------------------- +!!! The "isposinf" and "isneginf" functions get the IEEE class of a +!!! real, and test to see if the class is equal to ieee_positive_inf +!!! or ieee_negative_inf. +!!!--------------------------------------------------------------------- +!! +!!! TYPE double,real +!!elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) +!! use, intrinsic :: ieee_arithmetic, only: & +!! ieee_class, & +!! ieee_positive_inf, & +!! operator(==) +!! {VTYPE}, intent(in) :: x +!! logical :: isposinf +!! +!! isposinf = (ieee_positive_inf == ieee_class(x)) +!! +!!end function shr_infnan_isposinf_{TYPE} +!! +!!! TYPE double,real +!!elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) +!! use, intrinsic :: ieee_arithmetic, only: & +!! ieee_class, & +!! ieee_negative_inf, & +!! operator(==) +!! {VTYPE}, intent(in) :: x +!! logical :: isneginf +!! +!! isneginf = (ieee_negative_inf == ieee_class(x)) +!! +!!end function shr_infnan_isneginf_{TYPE} +!! +!!#else +!!! Don't have ieee_arithmetic. +!! +!! NaN testing on gfortran. !! TYPE double,real -!! DIMS 0,1,2,3,4,5,6,7 -!subroutine set_nan_new -!#ifdef HAVE_IEEE_ARITHMETIC -! use, intrinsic :: ieee_arithmetic, only: & -! ieee_signaling_nan, & -! ieee_quiet_nan, & -! ieee_value -!#endif -! public :: inf, nan, bigint -!! signaling nan -! real*8, parameter :: inf8 = O'0777600000000000000000' -! real*8, parameter :: nan8 = O'0777610000000000000000' -! real*4, parameter :: inf4 = O'17740000000' -! real*4, parameter :: nan4 = O'17760000000' -! real, parameter :: inf = inf4 -! real, parameter :: nan = nan4 -! integer, parameter :: bigint = O'17777777777' -! type(shr_infnan_nan_type), intent(in) :: nan -! -! ! Use scalar temporary for performance reasons, to reduce the cost of -! ! the ieee_value call. -! {VTYPE} :: tmp -! -!#ifdef HAVE_IEEE_ARITHMETIC -! if (nan%quiet) then -! tmp = ieee_value(tmp, ieee_quiet_nan) -! else -! tmp = ieee_value(tmp, ieee_signaling_nan) -! end if -!#endif -! -! output = tmp -! -!end subroutine set_nan_new -! -!! TYPE double,real -!! DIMS 0,1,2,3,4,5,6,7 -!pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) -!#ifdef HAVE_IEEE_ARITHMETIC -! use, intrinsic :: ieee_arithmetic, only: & -! ieee_positive_inf, & -! ieee_negative_inf, & -! ieee_value -!#else -!#if ({ITYPE} == TYPEREAL) -! integer(i4), parameter :: posinf_pat = sposinf_pat -! integer(i4), parameter :: neginf_pat = sneginf_pat -!#else -! integer(i8), parameter :: posinf_pat = dposinf_pat -! integer(i8), parameter :: neginf_pat = dneginf_pat -!#endif -!#endif -! {VTYPE}, intent(out) :: output{DIMSTR} -! type(shr_infnan_inf_type), intent(in) :: inf -! -! ! Use scalar temporary for performance reasons, to reduce the cost of -! ! the ieee_value call. -! {VTYPE} :: tmp -! -!#ifdef HAVE_IEEE_ARITHMETIC -! if (inf%positive) then -! tmp = ieee_value(tmp,ieee_positive_inf) -! else -! tmp = ieee_value(tmp,ieee_negative_inf) -! end if -!#else -! if (inf%positive) then -! tmp = transfer(posinf_pat, tmp) -! else -! tmp = transfer(neginf_pat, tmp) -! end if -!#endif -! -! output = tmp -! -!end subroutine set_inf_{DIMS}d_{TYPE} -! -!!--------------------------------------------------------------------- -!! CONVERSION INTERFACES. -!!--------------------------------------------------------------------- -!! Function methods to get reals from nan/inf types. -!!--------------------------------------------------------------------- -! -pure function nan_r8(nan) result(output) - class(shr_infnan_nan_type), intent(in) :: nan - real(r8) :: output - - output = nan - -end function nan_r8 - -pure function nan_r4(nan) result(output) - class(shr_infnan_nan_type), intent(in) :: nan - real(r4) :: output - - output = nan - -end function nan_r4 -! -!pure function inf_r8(inf) result(output) -! class(shr_infnan_inf_type), intent(in) :: inf +!elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) +! {VTYPE}, intent(in) :: x +! logical :: is_nan +! +! is_nan = isnan(x) +! +!end function shr_infnan_isnan_{TYPE} +!! End GNU section. +!!!--------------------------------------------------------------------- +!!! The "isposinf" and "isneginf" functions just test against a known +!!! bit pattern if we don't have ieee_arithmetic. +!!!--------------------------------------------------------------------- +!! +!!! TYPE double,real +!!elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) +!! {VTYPE}, intent(in) :: x +!! logical :: isposinf +!!#if ({ITYPE} == TYPEREAL) +!! integer(i4), parameter :: posinf_pat = sposinf_pat +!!#else +!! integer(i8), parameter :: posinf_pat = dposinf_pat +!!#endif +!! +!! isposinf = (x == transfer(posinf_pat,x)) +!! +!!end function shr_infnan_isposinf_{TYPE} +!! +!!! TYPE double,real +!!elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) +!! {VTYPE}, intent(in) :: x +!! logical :: isneginf +!!#if ({ITYPE} == TYPEREAL) +!! integer(i4), parameter :: neginf_pat = sneginf_pat +!!#else +!! integer(i8), parameter :: neginf_pat = dneginf_pat +!!#endif +!! +!! isneginf = (x == transfer(neginf_pat,x)) +!! +!!end function shr_infnan_isneginf_{TYPE} +!! +!!! End ieee_arithmetic conditional. +!!#endif +!! +!!!--------------------------------------------------------------------- +!!! GENERATION FUNCTIONS +!!!--------------------------------------------------------------------- +!!! Two approaches for generation of NaN and Inf values: +!!! 1. With Fortran 2003, use the ieee_value intrinsic to get a value +!!! from the corresponding class. These are: +!!! - ieee_signaling_nan +!!! - ieee_quiet_nan +!!! - ieee_positive_inf +!!! - ieee_negative_inf +!!! 2. Without Fortran 2003, set the IEEE bit patterns directly. +!!! Use BOZ literals to get an integer with the correct bit +!!! pattern, then use "transfer" to transfer those bits into a +!!! real. +!!!--------------------------------------------------------------------- +!! +!!! TYPE double,real +!!! DIMS 0,1,2,3,4,5,6,7 +!!subroutine set_nan_new +!!#ifdef HAVE_IEEE_ARITHMETIC +!! use, intrinsic :: ieee_arithmetic, only: & +!! ieee_signaling_nan, & +!! ieee_quiet_nan, & +!! ieee_value +!!#endif +!! public :: inf, nan, bigint +!!! signaling nan +!! real*8, parameter :: inf8 = O'0777600000000000000000' +!! real*8, parameter :: nan8 = O'0777610000000000000000' +!! real*4, parameter :: inf4 = O'17740000000' +!! real*4, parameter :: nan4 = O'17760000000' +!! real, parameter :: inf = inf4 +!! real, parameter :: nan = nan4 +!! integer, parameter :: bigint = O'17777777777' +!! type(shr_infnan_nan_type), intent(in) :: nan +!! +!! ! Use scalar temporary for performance reasons, to reduce the cost of +!! ! the ieee_value call. +!! {VTYPE} :: tmp +!! +!!#ifdef HAVE_IEEE_ARITHMETIC +!! if (nan%quiet) then +!! tmp = ieee_value(tmp, ieee_quiet_nan) +!! else +!! tmp = ieee_value(tmp, ieee_signaling_nan) +!! end if +!!#endif +!! +!! output = tmp +!! +!!end subroutine set_nan_new +!! +!!! TYPE double,real +!!! DIMS 0,1,2,3,4,5,6,7 +!!pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) +!!#ifdef HAVE_IEEE_ARITHMETIC +!! use, intrinsic :: ieee_arithmetic, only: & +!! ieee_positive_inf, & +!! ieee_negative_inf, & +!! ieee_value +!!#else +!!#if ({ITYPE} == TYPEREAL) +!! integer(i4), parameter :: posinf_pat = sposinf_pat +!! integer(i4), parameter :: neginf_pat = sneginf_pat +!!#else +!! integer(i8), parameter :: posinf_pat = dposinf_pat +!! integer(i8), parameter :: neginf_pat = dneginf_pat +!!#endif +!!#endif +!! {VTYPE}, intent(out) :: output{DIMSTR} +!! type(shr_infnan_inf_type), intent(in) :: inf +!! +!! ! Use scalar temporary for performance reasons, to reduce the cost of +!! ! the ieee_value call. +!! {VTYPE} :: tmp +!! +!!#ifdef HAVE_IEEE_ARITHMETIC +!! if (inf%positive) then +!! tmp = ieee_value(tmp,ieee_positive_inf) +!! else +!! tmp = ieee_value(tmp,ieee_negative_inf) +!! end if +!!#else +!! if (inf%positive) then +!! tmp = transfer(posinf_pat, tmp) +!! else +!! tmp = transfer(neginf_pat, tmp) +!! end if +!!#endif +!! +!! output = tmp +!! +!!end subroutine set_inf_{DIMS}d_{TYPE} +!! +!!!--------------------------------------------------------------------- +!!! CONVERSION INTERFACES. +!!!--------------------------------------------------------------------- +!!! Function methods to get reals from nan/inf types. +!!!--------------------------------------------------------------------- +!! +!pure function nan_r8(nan) result(output) +! class(shr_infnan_nan_type), intent(in) :: nan ! real(r8) :: output ! -! output = inf +! output = nan ! -!end function inf_r8 +!end function nan_r8 ! -!pure function inf_r4(inf) result(output) -! class(shr_infnan_inf_type), intent(in) :: inf +!pure function nan_r4(nan) result(output) +! class(shr_infnan_nan_type), intent(in) :: nan ! real(r4) :: output ! -! output = inf -! -!end function inf_r4 +! output = nan +! +!end function nan_r4 +!! +!!pure function inf_r8(inf) result(output) +!! class(shr_infnan_inf_type), intent(in) :: inf +!! real(r8) :: output +!! +!! output = inf +!! +!!end function inf_r8 +!! +!!pure function inf_r4(inf) result(output) +!! class(shr_infnan_inf_type), intent(in) :: inf +!! real(r4) :: output +!! +!! output = inf +!! +!!end function inf_r4 end module shr_infnan_mod From 48b19a74f8bf17600f846f05c37c4d133559dfc6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 16:25:16 -0500 Subject: [PATCH 072/589] change nan --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index b4ef72007..8a1a2f0ba 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -17,7 +17,7 @@ module LandunitType ! 9 => (isturb_md) urban md ! use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan + use nanMod , only : nan use clm_varcon , only : ispval use decompMod , only : bounds_type From 6b056854bd02fd9228504f92dbf7ba98e3ffbb3a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 14 Nov 2022 16:26:34 -0500 Subject: [PATCH 073/589] assume ieee_arithmetic is defined --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 | 9 --------- 1 file changed, 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 index 7bb8959b5..6d9ce27e2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 @@ -1,7 +1,3 @@ -! Flag representing compiler support of Fortran 2003's -! ieee_arithmetic intrinsic module. -#define HAVE_IEEE_ARITHMETIC - module shr_infnan_mod !--------------------------------------------------------------------- ! Module to test for IEEE Inf and NaN values, which also provides a @@ -39,18 +35,13 @@ module shr_infnan_mod r4 => SHR_KIND_R4, & r8 => SHR_KIND_R8 -#ifdef HAVE_IEEE_ARITHMETIC - ! If we have IEEE_ARITHMETIC, the NaN test is provided for us. use, intrinsic :: ieee_arithmetic, only: & shr_infnan_isnan => ieee_is_nan -#else - ! Integers of correct size for bit patterns below. use shr_kind_mod, only: i4 => shr_kind_i4, i8 => shr_kind_i8 -#endif implicit none private From e5f927cf140fee51bf1b23d9627a242b89d14ec6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 08:13:32 -0500 Subject: [PATCH 074/589] adding missing variables and use statements --- .../CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index d7612668e..efd6f4bc6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -3,10 +3,12 @@ module SoilBiogeochemNitrogenStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan - use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi + use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi, & + NUM_ZON, VAR_COL use clm_varcon , only : spval, dzsoi_decomp, zisoi use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp, use_soil_matrixcn use decompMod , only : bounds_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con ! !PUBLIC TYPES: implicit none @@ -86,6 +88,7 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) ! ! !LOCAL VARIABLES: integer :: begc,endc + integer :: n, nc, nz, np integer, dimension(8) :: decomp_npool_cncol_index = (/ 18, 19, 20, 17,25, 26, 27, 28 /) !----------------------------------- @@ -138,8 +141,8 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) this%exit_nacc(:,:,:)= nan allocate(this%hori_tran_nacc(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) this%hori_tran_nacc(:,:,:)= nan - call this%AKXnacc%InitSM(ndecomp_pools*nlevdecomp,begc,endc,decomp_cascade_con%n_all_entries) - call this%matrix_Ninter%InitV (ndecomp_pools*nlevdecomp,begc,endc) + !call this%AKXnacc%InitSM(ndecomp_pools*nlevdecomp,begc,endc,decomp_cascade_con%n_all_entries) + !call this%matrix_Ninter%InitV (ndecomp_pools*nlevdecomp,begc,endc) end if allocate(this%decomp_soiln_vr_col(begc:endc,1:nlevdecomp_full)) this%decomp_soiln_vr_col(:,:)= nan @@ -148,7 +151,7 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) ! initialize variables from restart file or set to cold start value n = 0 do nc = 1,nch ! catchment tile loop - do nz = 1,nzone ! CN zone loop + do nz = 1,num_zon ! CN zone loop n = n + 1 this%ntrunc_vr_col (n,1:nlevdecomp_full) = cncol(nc,nz,16) @@ -159,7 +162,7 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) do np = 1,ndecomp_pools ! jkolassa May 2022: accounting for fact that pool order in CNCOL is different from CTSM this%decomp_npools_col (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) - this%decomp_npools_col_1m (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) + this%decomp_npools_1m_col (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) ! jkolassa May 2022: loop has to be added below if we add more biogeochemical (or soil) layers this%decomp_npools_vr_col (n,1,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) end do !np From 30a8c98c788c82203a282d6edcab299efc6cff5b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 08:34:39 -0500 Subject: [PATCH 075/589] commenting call to matrix function --- .../CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index 08f680172..6f482c3cc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -229,7 +229,7 @@ subroutine SetValues ( this, num_column, filter_column, value_column) end do end do end do - call this%matrix_Cinput%SetValueV_scaler(num_column,filter_column(1:num_column),value_column) + ! call this%matrix_Cinput%SetValueV_scaler(num_column,filter_column(1:num_column),value_column) ! IMPORTANT NOTE: Although it looks like the following if appears to be ! backwards (it should be 'if use_versoilc'), fixing it causes Carbon ! balance checks to fail. EBK 10/21/2019 From d2db9f77e9960b6b623eaef6a8c14acca2c4afab Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 08:51:37 -0500 Subject: [PATCH 076/589] remove typo --- .../CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index f9a724355..30ff2d4f4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -353,7 +353,7 @@ subroutine SetValues ( this, & do fi = 1,num_column i = filter_column(fi) - this%ndep_to_sminn_col%(i) = value_column + this%ndep_to_sminn_col(i) = value_column this%nfix_to_sminn_col(i) = value_column this%ffix_to_sminn_col(i) = value_column this%fert_to_sminn_col(i) = value_column From 7fd0b59b2482a2f42157bc80670aef267cd341dd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 09:23:41 -0500 Subject: [PATCH 077/589] add missing variables --- .../CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index 30ff2d4f4..b7eed3583 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -5,6 +5,7 @@ module SoilBiogeochemNitrogenFluxType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, ndecomp_cascade_outtransitions use clm_varpar , only : nlevdecomp_full, nlevdecomp, ndecomp_pools_vr use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_soil_matrixcn + use clm_varcon , only : spval use decompMod , only : bounds_type use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con @@ -59,6 +60,7 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: pot_f_nit_col (:) ! col (gN/m2/s) potential soil nitrification flux real(r8), pointer :: pot_f_denit_col (:) ! col (gN/m2/s) potential soil denitrification flux real(r8), pointer :: n2_n2o_ratio_denit_vr_col (:,:) ! col ratio of N2 to N2O production by denitrification [gN/gN] + real(r8), pointer :: f_n2o_denit_vr_col (:,:) ! col flux of N2o from denitrification [gN/m^3/s] real(r8), pointer :: f_n2o_denit_col (:) ! col flux of N2o from denitrification [gN/m^2/s] real(r8), pointer :: f_n2o_nit_vr_col (:,:) ! col flux of N2o from nitrification [gN/m^3/s] real(r8), pointer :: f_n2o_nit_col (:) ! col flux of N2o from nitrification [gN/m^2/s] From 83a8ad33b81b7437443255269a0d897363c9f160 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 09:49:03 -0500 Subject: [PATCH 078/589] add missing variables --- .../CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index b7eed3583..db1e080d0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -5,7 +5,7 @@ module SoilBiogeochemNitrogenFluxType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, ndecomp_cascade_outtransitions use clm_varpar , only : nlevdecomp_full, nlevdecomp, ndecomp_pools_vr use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_soil_matrixcn - use clm_varcon , only : spval + use clm_varcon , only : spval, dzsoi_decomp use decompMod , only : bounds_type use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con From f198434e75a57526b3764fcb817fbab90036c3b5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 11:37:53 -0500 Subject: [PATCH 079/589] correcting indexing and adding missing use statements --- .../CLM51/CNCLM_CanopyStateType.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 5693b6d55..0655b5613 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -1,3 +1,5 @@ +#include "MAPL_Generic.h" + module CanopyStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 @@ -6,6 +8,7 @@ module CanopyStateType use clm_varcon , only : spval use nanMod , only : nan use decompMod , only : bounds_type + use MAPL_ExceptionHandling ! !PUBLIC TYPES: implicit none @@ -57,7 +60,7 @@ module CanopyStateType contains !-------------------------------------------------------------- - subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) + subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start, rc) ! !DESCRIPTION: ! Initialize CTSM canopy state type needed for calling CTSM routines @@ -75,6 +78,7 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array logical, optional, intent(in) :: cn5_cold_start type(canopystate_type), intent(inout):: this + integer, optional, intent(out) :: rc ! LOCAL integer :: begp, endp @@ -95,7 +99,7 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) + (size(cnpft,3).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if @@ -165,8 +169,8 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn ! jkolassa Mar 2022: these two quantites are computed in Photosynthesis, ! so maybe the do not need to be initialized here - this%vegwp_ln_patch(np) = -2.5e4_r8 - this%vegwp_pd_patch(np) = -2.5e4_r8 + this%vegwp_ln_patch(np,1:nvegwcs) = -2.5e4_r8 + this%vegwp_pd_patch(np,1:nvegwcs) = -2.5e4_r8 ! jkolassa May 2022: we do not model vegetation on snow, so the variable below is 1 always this%frac_veg_nosno_patch(np) = 1 From 3471d5ac164be09cbe368d2b3ba5152f8c015d40 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 11:38:08 -0500 Subject: [PATCH 080/589] correct typo --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index a72ba7e5c..a6200ba32 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -14,8 +14,7 @@ module filterMod -decomp_cpools_vr_col -endumpfilter + type clumpfilter integer, pointer :: allc(:) ! all columns integer :: num_allc ! number of points in allc filter From 6d734256e0c911bbb9925ced66bab15638a8b100 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 12:36:27 -0500 Subject: [PATCH 081/589] add missing variables and allocate filter --- .../CLM51/CNCLM_filterMod.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index a6200ba32..fd51de7f3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -111,10 +111,17 @@ subroutine init_filter_type(bounds, nch, this_filter) ! INPUT/OUTPUT type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of Catchment tiles - type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate + type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate + + ! LOCAL: + integer :: n, nc ,nz !-------------------------------------- + if( .not. allocated(this_filter)) then + allocate(this_filter(1)) + end if + allocate(this_filter%allc(bounds%endc-bounds%begc+1)) allocate(this_filter%lakep(bounds%endp-bounds%begp+1)) @@ -173,7 +180,7 @@ subroutine init_filter_type(bounds, nch, this_filter) n = 0 do nc = 1,nch - do nz = 1,nzone + do nz = 1,num_zon n = n + 1 this_filter%num_soilc = this_filter%num_soilc + 1 From f6681058304ea6c1b5c2265d18e0b63a8656419e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 13:33:27 -0500 Subject: [PATCH 082/589] correct filter allocation and fix typos --- .../CLM51/CNCLM_filterMod.F90 | 63 ++++++++++--------- 1 file changed, 32 insertions(+), 31 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index fd51de7f3..95b5138f5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -3,6 +3,7 @@ module filterMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan use decompMod , only : bounds_type + use clm_varcon , only : NUM_ZON ! !PUBLIC TYPES: implicit none @@ -122,48 +123,48 @@ subroutine init_filter_type(bounds, nch, this_filter) allocate(this_filter(1)) end if - allocate(this_filter%allc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%allc(bounds%endc-bounds%begc+1)) - allocate(this_filter%lakep(bounds%endp-bounds%begp+1)) - allocate(this_filter%nolakep(bounds%endp-bounds%begp+1)) - allocate(this_filter%nolakeurbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%lakep(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%nolakep(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%nolakeurbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter%lakec(bounds%endc-bounds%begc+1)) - allocate(this_filter%nolakec(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%lakec(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%nolakec(bounds%endc-bounds%begc+1)) - allocate(this_filter%soilc(bounds%endc-bounds%begc+1)) - allocate(this_filter%soilp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%soilc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%soilp(bounds%endp-bounds%begp+1)) - allocate(this_filter%snowc(bounds%endc-bounds%begc+1)) - allocate(this_filter%nosnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%snowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%nosnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter%lakesnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter%lakenosnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%lakesnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%lakenosnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter%exposedvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter%noexposedvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%exposedvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%noexposedvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter%natvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%natvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter%hydrologyc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%hydrologyc(bounds%endc-bounds%begc+1)) - allocate(this_filter%urbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter%nourbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%urbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%nourbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter%urbanc(bounds%endc-bounds%begc+1)) - allocate(this_filter%nourbanc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%urbanc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%nourbanc(bounds%endc-bounds%begc+1)) - allocate(this_filter%urbanl(bounds%endl-bounds%begl+1)) - allocate(this_filter%nourbanl(bounds%endl-bounds%begl+1)) + allocate(this_filter(1)%urbanl(bounds%endl-bounds%begl+1)) + allocate(this_filter(1)%nourbanl(bounds%endl-bounds%begl+1)) - allocate(this_filter%pcropp(bounds%endp-bounds%begp+1)) - allocate(this_filter%soilnopcropp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%pcropp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%soilnopcropp(bounds%endp-bounds%begp+1)) - allocate(this_filter%icemecc(bounds%endc-bounds%begc+1)) - allocate(this_filter%do_smb_c(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%icemecc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%do_smb_c(bounds%endc-bounds%begc+1)) - allocate(this_filter%actfirec(bounds%endc-bounds%begc+1)) - allocate(this_filter%actfirep(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%actfirec(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%actfirep(bounds%endp-bounds%begp+1)) this_filter%num_actfirep = 1 this_filter%num_actfirec = 1 @@ -184,9 +185,9 @@ subroutine init_filter_type(bounds, nch, this_filter) n = n + 1 this_filter%num_soilc = this_filter%num_soilc + 1 - this_filter%soilc(this%num_soilc) = n + this_filter%soilc(this_filter%num_soilc) = n this_filter%num_allc = this_filter%num_allc + 1 - this_filter%allc(this%num_allc) = n + this_filter%allc(this_filter%num_allc) = n do p = 0,numpft ! PFT index loop np = np + 1 @@ -194,7 +195,7 @@ subroutine init_filter_type(bounds, nch, this_filter) if(ityp(nc,nv,nz)==p) then this_filter%num_nourbanp = this_filter%num_nourbanp + 1 - this_filter%nourbanp(num_nourbanp) = np + this_filter%nourbanp(this_filter%num_nourbanp) = np this_filter%num_soilp = this_filter%num_soilp + 1 this_filter%soilp(this_filter%num_soilp) = np From fdb8c3cacfd780c3bc99d33980255072665c2aec Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 14:17:48 -0500 Subject: [PATCH 083/589] correct array initialization --- .../CLM51/CNCLM_filterMod.F90 | 20 ++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index 95b5138f5..efeb0267e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -3,7 +3,7 @@ module filterMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan use decompMod , only : bounds_type - use clm_varcon , only : NUM_ZON + use clm_varpar , only : NUM_ZON, NUM_VEG, numpft ! !PUBLIC TYPES: implicit none @@ -100,7 +100,7 @@ module filterMod contains !-------------------------------------------------------------- - subroutine init_filter_type(bounds, nch, this_filter) + subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) ! !DESCRIPTION: ! Initialize CTSM filters @@ -112,6 +112,8 @@ subroutine init_filter_type(bounds, nch, this_filter) ! INPUT/OUTPUT type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of Catchment tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate ! LOCAL: @@ -185,9 +187,9 @@ subroutine init_filter_type(bounds, nch, this_filter) n = n + 1 this_filter%num_soilc = this_filter%num_soilc + 1 - this_filter%soilc(this_filter%num_soilc) = n + this_filter(1)%soilc(this_filter%num_soilc) = n this_filter%num_allc = this_filter%num_allc + 1 - this_filter%allc(this_filter%num_allc) = n + this_filter(1)%allc(this_filter%num_allc) = n do p = 0,numpft ! PFT index loop np = np + 1 @@ -195,27 +197,27 @@ subroutine init_filter_type(bounds, nch, this_filter) if(ityp(nc,nv,nz)==p) then this_filter%num_nourbanp = this_filter%num_nourbanp + 1 - this_filter%nourbanp(this_filter%num_nourbanp) = np + this_filter(1)%nourbanp(this_filter%num_nourbanp) = np this_filter%num_soilp = this_filter%num_soilp + 1 - this_filter%soilp(this_filter%num_soilp) = np + this_filter(1)%soilp(this_filter%num_soilp) = np ! jkolassa: not sure this is needed, since we do not use prognostic crop information if(ityp(nc,nv,nz) >= npcropmin) then this_filter%num_pcropp = this_filternum_pcropp + 1 - this_filter%pcropp(this_filter%num_pcropp) = np + this_filter(1)%pcropp(this_filter%num_pcropp) = np endif if (fveg(nc,nv,nz)>1.e-4) then this_filter%num_exposedvegp = this_filter%num_exposedvegp + 1 - this_filter%exposedvegp(this_filter%num_exposedvegp) = np + this_filter(1)%exposedvegp(this_filter%num_exposedvegp) = np elseif (fveg(nc,nv,nz)<=1.e-4) then this_filter%num_noexposedvegp = this_filter%num_noexposedvegp + 1 - this_filter%noexposedvegp(this_filter%num_noexposedvegp) = np + this_filter(1)%noexposedvegp(this_filter%num_noexposedvegp) = np end if end if From 2831062d471ba8fc3cc16a9d7fc0fbd390ca1a2d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 14:18:25 -0500 Subject: [PATCH 084/589] update filter initialization call --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 6396a8f57..cb839cdf3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -118,7 +118,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst type(gridcell_type) :: grc - type(clumpfilter_type) :: filter type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst type(ch4_type) :: ch4_inst @@ -168,7 +167,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) ! initialize filters - call init_filter_type (bounds, nch, filter) + call init_filter_type (bounds, nch, ityp, fveg, filter) ! read parameters and configurations from namelist file From a05882365c83137d8898764d09d592b8eb1f6eed Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 14:40:55 -0500 Subject: [PATCH 085/589] add missing variable declaration statements --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index efeb0267e..f15b8ce65 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -117,7 +117,7 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate ! LOCAL: - integer :: n, nc ,nz + integer :: n, nc ,nz, p, np, nv !-------------------------------------- @@ -204,7 +204,7 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) ! jkolassa: not sure this is needed, since we do not use prognostic crop information if(ityp(nc,nv,nz) >= npcropmin) then - this_filter%num_pcropp = this_filternum_pcropp + 1 + this_filter%num_pcropp = this_filter%num_pcropp + 1 this_filter(1)%pcropp(this_filter%num_pcropp) = np endif From a83dea3d33cc2e63ad49976a4c2cd1bd7e832fa8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 14:59:29 -0500 Subject: [PATCH 086/589] add missing npcropmin import --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index f15b8ce65..32e603c9e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -4,6 +4,7 @@ module filterMod use nanMod , only : nan use decompMod , only : bounds_type use clm_varpar , only : NUM_ZON, NUM_VEG, numpft + use pftconMod , only : npcropmin ! !PUBLIC TYPES: implicit none From 8e1ef6372aca62934c1844139cfd5c4fa510f3f8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 15:23:29 -0500 Subject: [PATCH 087/589] add missing use statement and fix variable declaration --- .../CLM51/CNCLM_SolarAbsorbedType.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 index 083c23985..c07a1eb08 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -2,10 +2,11 @@ module SolarAbsorbedType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use clm_varcon , only : spval - use clm_varpar , only : nlevcan, numrad + use clm_varpar , only : nlevcan, numrad, nlevsno use clm_varctl , only : use_luna use nanMod , only : nan use decompMod , only : bounds_type + ! !PUBLIC TYPES: implicit none save @@ -86,9 +87,9 @@ subroutine init_solarabs_type(bounds, this) type(solarabs_type), intent(inout):: this !LOCAL - integer, intent(in) :: begp, endp - integer, intent(in) :: begc, endc - integer, intent(in) :: begl, endl + integer, intent :: begp, endp + integer, intent :: begc, endc + integer, intent :: begl, endl !--------------------------------- begp = bounds%begp ; endp = bounds%endp From a67368b52102d999e434955bf99fee10a2b77a73 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 16:18:23 -0500 Subject: [PATCH 088/589] fix local variable declaration --- .../CLM51/CNCLM_SolarAbsorbedType.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 index c07a1eb08..fc9cd988c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -87,9 +87,9 @@ subroutine init_solarabs_type(bounds, this) type(solarabs_type), intent(inout):: this !LOCAL - integer, intent :: begp, endp - integer, intent :: begc, endc - integer, intent :: begl, endl + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl !--------------------------------- begp = bounds%begp ; endp = bounds%endp From 752b6314a91be94e3cb36a63d35dcf3f84f6468f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 16:51:31 -0500 Subject: [PATCH 089/589] correct variable names in loop --- .../CLM51/CNCLM_SurfaceAlbedoType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index 6f3374ad7..5deabade3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -144,13 +144,13 @@ subroutine init_surfalb_type(bounds, nch, cncol, cnpft, this) np = 0 do nc = 1,nch ! catchment tile loop - do nz = 1,nzone ! CN zone loop + do nz = 1,num_zon ! CN zone loop do p = 0,numpft ! PFT index loop np = np + 1 this%nrad_patch(np) = 1 - do nv = 1,nveg ! defined veg loop + do nv = 1,num_veg ! defined veg loop do n = 1,nlevcan this%tlai_z_patch(np,n) = cnpft(nc,nz,nv, 73) this%tsai_z_patch(np,n) = cnpft(nc,nz,nv, 74) From aa8d673a7f02fd52ee0fe33267b5c16647ae84e8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 15 Nov 2022 18:15:33 -0500 Subject: [PATCH 090/589] adding missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index bdcd72c40..fc247d3ec 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -7,7 +7,7 @@ module WaterFluxType use netcdf use MAPL_ExceptionHandling use decompMod , only : bounds_type - + use AnnualFluxDribbler, only : annual_flux_dribbler_type ! !PUBLIC TYPES: implicit none From 946d40d791e02e7d86383dd33a954b7abf2f4c4d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 08:16:59 -0500 Subject: [PATCH 091/589] adding missing use statements --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 index 5c35345b3..c64e02089 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 @@ -10,6 +10,9 @@ module ActiveLayerMod use shr_const_mod , only : SHR_CONST_TKFRZ use clm_varctl , only : iulog, use_cn use clm_varcon , only : spval + use TemperatureType , only : temperature_type + use ColumnType , only : col + use GridcellType , only : grc ! !PUBLIC TYPES: implicit none From f1a925f421d802af57aae048d5fb337e022a0ec0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 08:46:00 -0500 Subject: [PATCH 092/589] syntax change --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h | 1 - 1 file changed, 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h index 24d92d0b0..18806a468 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h @@ -7,5 +7,4 @@ #define SHR_ASSERT_ANY(assert, my_msg) call shr_assert_any(assert, msg=my_msg) #define SHR_ASSERT_ANY_FL(assert, my_file, my_line) call shr_assert_any(assert, file=my_file, line=my_line) #define SHR_ASSERT_ANY_MFL(assert, my_msg, my_file, my_line) call shr_assert_any(assert, msg=my_msg, file=my_file, line=my_line) - use shr_assert_mod From 8a102b266407e25b2bac9d8c886e12e609dc06e0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 09:06:28 -0500 Subject: [PATCH 093/589] syntax change --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h index 18806a468..4595e98e4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert.h @@ -1,3 +1,4 @@ +use shr_assert_mod #define SHR_ASSERT(assert, my_msg) call shr_assert(assert, msg=my_msg) #define SHR_ASSERT_FL(assert, my_file, my_line) call shr_assert(assert, file=my_file, line=my_line) #define SHR_ASSERT_MFL(assert, my_msg, my_file, my_line) call shr_assert(assert, msg=my_msg, file=my_file, line=my_line) @@ -7,4 +8,3 @@ #define SHR_ASSERT_ANY(assert, my_msg) call shr_assert_any(assert, msg=my_msg) #define SHR_ASSERT_ANY_FL(assert, my_file, my_line) call shr_assert_any(assert, file=my_file, line=my_line) #define SHR_ASSERT_ANY_MFL(assert, my_msg, my_file, my_line) call shr_assert_any(assert, msg=my_msg, file=my_file, line=my_line) -use shr_assert_mod From 13b5803083c2a2c72fa3cb9e76b5d0c82f93f2bc Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 12:52:38 -0500 Subject: [PATCH 094/589] update file name --- .circleci/config.yml | 0 .github/CODEOWNERS | 0 .github/PULL_REQUEST_TEMPLATE/auto_pr_to_mapl3.md | 0 .github/workflows/push-to-develop.yml | 0 .github/workflows/workflow.yml | 0 .gitignore | 0 CMakeLists.txt | 0 CODE_OF_CONDUCT.md | 0 CONTRIBUTING.md | 0 COPYRIGHT | 0 GCM_Preamble.tex | 0 GEOS_GcmGridComp.F90 | 0 GEOSagcm_GridComp/CMakeLists.txt | 0 GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 | 0 GEOSagcm_GridComp/GEOSphysics_GridComp/.gitignore | 0 GEOSagcm_GridComp/GEOSphysics_GridComp/CMakeLists.txt | 0 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/CMakeLists.txt | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/GEOS_GwdGridComp.F90 | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/gw_drag.F90 | 0 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gwdc.f | 0 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gwdps.f | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/machine.F90 | 0 .../GEOSgwd_GridComp/ncar_gwd/cesm_const_mod.F90 | 0 .../GEOSgwd_GridComp/ncar_gwd/coords_1d.F90 | 0 .../GEOSgwd_GridComp/ncar_gwd/gw_common.F90 | 0 .../GEOSgwd_GridComp/ncar_gwd/gw_convect.F90 | 0 .../GEOSgwd_GridComp/ncar_gwd/gw_diffusion.F90 | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_drag.F90 | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_oro.F90 | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_utils.F90 | 0 .../GEOSgwd_GridComp/ncar_gwd/interpolate_data.F90 | 0 .../GEOSgwd_GridComp/ncar_gwd/linear_1d_operators.F90 | 0 .../GEOSgwd_GridComp/ncar_gwd/vdiff_lu_solver.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/CLDPARAMS.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt | 0 .../GEOSmoist_GridComp/ConvPar_GF_GEOS5.F90 | 0 .../GEOSmoist_GridComp/GEOS_MoistGridComp.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/RASPARAMS.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/SHLWPARAMS.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/WSUB_ExtData.rc | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/WSUB_ExtData.yaml | 0 .../GEOSmoist_GridComp/aer_actv_single_moment.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/aer_cloud.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/cldmacro.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/cldwat2m_micro.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/cloudnew.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/ddf.F90 | 0 .../GEOSmoist_GridComp/gfdl_cloud_microphys.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/isccp_call.code | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/isccp_decls.code | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/micro_mg3_0.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/micro_mg_utils.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/module_gate.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/partition_pdf.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/qsat.h | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/ras.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/rascnvv2_v.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/uwshcu.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/wv_saturation.F90 | 0 .../GEOSphysics_GridComp/GEOSsurface_GridComp/CMakeLists.txt | 0 .../GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 | 0 .../GEOSsurface_GridComp/GEOSlake_GridComp/CMakeLists.txt | 0 .../GEOSlake_GridComp/GEOS_LakeGridComp.F90 | 0 .../GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt | 0 .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 0 .../GEOSland_GridComp/GEOScatchCN_GridComp/CMakeLists.txt | 0 .../GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 | 0 .../GEOScatchCNCLM40_GridComp/CLM40/CMakeLists.txt | 0 .../GEOScatchCNCLM40_GridComp/CMakeLists.txt | 0 .../GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CMakeLists.txt | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNAllocationMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNAnnualUpdateMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNBalanceCheckMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate1Mod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate2Mod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate3Mod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNDecompCascadeMod_BGC.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNDecompMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNEcosystemDynMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNGRespMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNGapMortalityMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNMRespMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNNDynamicsMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate1Mod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate2Mod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate3Mod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNNitrifDenitrifMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNPhenologyMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNPrecisionControlMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNSetValueMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNSoilLittVertTranspMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNSummaryMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNVegStructUpdateMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNVerticalProfileMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNWoodProductsMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/CNiniTimeVar.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/TridiagonalMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/clm_time_manager.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/clm_varcon.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/clm_varctl.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/clmtype.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/clmtypeInitMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/compute_rc.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/getco2.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/pftvarcon.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/shr_const_mod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/subgridAveMod.F90 | 0 .../GEOScatchCNCLM45_GridComp/CLM45/update_model_para4cn.F90 | 0 .../GEOScatchCNCLM45_GridComp/CMakeLists.txt | 0 .../GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 | 0 .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 0 .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 0 .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 0 .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 0 .../CLM51/CNCLM_SaturatedExcessRunoffMod.F90 | 0 .../CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 | 0 .../CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 | 0 .../CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 | 0 .../CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 0 .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 | 0 .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 0 .../CLM51/CNCLM_WaterStateBulkType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 | 0 .../CLM51/CNCLM_Wateratm2lndBulkType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/perf_mod.F90 | 0 .../CLM51/{shr_assert_mod.F90.in => shr_assert_mod.F90} | 0 .../GEOScatchCNCLM51_GridComp/CLM51/shr_const_mod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/shr_kind_mod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/shr_log_mod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/shr_sys_mod.F90 | 0 .../GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 | 0 .../GEOScatchCNCLM51_GridComp/CMakeLists.txt | 0 .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 0 .../GEOScatchCN_GridComp/Shared/CMakeLists.txt | 0 .../GEOScatchCN_GridComp/Shared/catchcn_iau.F90 | 0 .../GEOScatchCN_GridComp/utils/dbg_cnlsm_offline.F90 | 0 .../GEOSland_GridComp/GEOScatch_GridComp/CMakeLists.txt | 0 .../GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 0 .../GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 | 0 .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 0 .../GEOSland_GridComp/GEOScatch_GridComp/dbg_clsm_offline.F90 | 0 .../GEOSland_GridComp/GEOScatch_GridComp/m_dbg_routines.F90 | 0 .../GEOSland_GridComp/GEOSroute_GridComp/CMakeLists.txt | 0 .../GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 | 0 .../GEOSland_GridComp/GEOSroute_GridComp/build_rivernetwork.py | 0 .../GEOSland_GridComp/GEOSroute_GridComp/routing_model.F90 | 0 .../GEOSland_GridComp/GEOSvegdyn_GridComp/CMakeLists.txt | 0 .../GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 | 0 .../GEOSland_GridComp/Shared/CMakeLists.txt | 0 .../GEOSland_GridComp/Shared/catch_constants.f90 | 0 .../GEOSland_GridComp/Shared/lsm_routines.F90 | 0 .../GEOSland_GridComp/Shared/sibalb_coeff.f90 | 0 .../GEOSland_GridComp/Shared/update_model_paras.F90 | 0 .../GEOSsurface_GridComp/GEOSlandice_GridComp/CMakeLists.txt | 0 .../GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 | 0 .../GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking.h | 0 .../GEOSsaltwater_GridComp/BufferPacking_RUN1.h | 0 .../GEOSsaltwater_GridComp/BufferUnpacking.h | 0 .../GEOSsaltwater_GridComp/BufferUnpacking_RUN1.h | 0 .../GEOSsurface_GridComp/GEOSsaltwater_GridComp/CMakeLists.txt | 0 .../GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 | 0 .../GEOSsaltwater_GridComp/GEOS_ObioGridComp.F90 | 0 .../GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 | 0 .../GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 | 0 .../GEOSsaltwater_GridComp/GEOS_SimpleSeaiceGridComp.F90 | 0 .../GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr.h | 0 .../GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr_RUN1.h | 0 .../GEOSsurface_GridComp/Shared/CMakeLists.txt | 0 .../GEOSsurface_GridComp/Shared/OASIMalbedoMod.f | 0 .../GEOSsurface_GridComp/Shared/StieglitzSnow.F90 | 0 .../GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 | 0 .../GEOSsurface_GridComp/Utils/CMakeLists.txt | 0 .../GEOSsurface_GridComp/Utils/Raster/CMakeLists.txt | 0 .../GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/CubedSphere_GridMod.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/Raster.h | 0 .../GEOSsurface_GridComp/Utils/Raster/asia_tiles.pro | 0 .../GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/compare_bcs.pro | 0 .../GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/date_time_util.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/easeV1_conv.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/easeV2_conv.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/findloc.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/leap_year.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 | 0 .../GEOSsurface_GridComp/Utils/Raster/loss_surf_5cm_gensoil.f90 | 0 .../Utils/Raster/m_loss_during_routines.f90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara_v2.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/modis_scale_factor.pro | 0 .../Utils/Raster/mosaic_classes_on_tiles.pro | 0 .../GEOSsurface_GridComp/Utils/Raster/plot_curves.csh | 0 .../GEOSsurface_GridComp/Utils/Raster/plot_curves.pro | 0 .../GEOSsurface_GridComp/Utils/Raster/plot_geos5_grid.pro | 0 .../GEOSsurface_GridComp/Utils/Raster/rasterize.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/rasterize.H | 0 .../GEOSsurface_GridComp/Utils/Raster/read_riveroutlet.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/soil_types_on_tiles.pro | 0 .../GEOSsurface_GridComp/Utils/Raster/util.c | 0 .../GEOSsurface_GridComp/Utils/Raster/zip.c | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/.gitignore | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/README | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90 | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 | 0 .../Utils/mk_restarts/mk_GEOSldasRestarts.F90 | 0 .../Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 | 0 .../GEOSsurface_GridComp/Utils/mk_restarts/mk_RouteRestarts.F90 | 0 .../Utils/mk_restarts/mk_catchANDcnRestarts.F90 | 0 .../Utils/mk_restarts/obsolete/newcatch.F90 | 0 .../Utils/mk_restarts/obsolete/newvegdyn.f90 | 0 .../Utils/mk_restarts/obsolete/replace_params.F90 | 0 .../Utils/mk_restarts/obsolete/strip_vegdyn.F90 | 0 .../GEOSphysics_GridComp/GEOSturbulence_GridComp/CMakeLists.txt | 0 .../GEOSturbulence_GridComp/GEOS_TurbulenceGridComp.F90 | 0 .../GEOSturbulence_GridComp/LockEntrain.F90 | 0 .../GEOSphysics_GridComp/GEOSturbulence_GridComp/edmf.F90 | 0 .../GEOSphysics_GridComp/GEOSturbulence_GridComp/edmfparams.F90 | 0 .../GEOSphysics_GridComp/GEOSturbulence_GridComp/idl/vis.pro | 0 .../GEOSphysics_GridComp/GEOSturbulence_GridComp/idl/zosea.pro | 0 .../GEOSturbulence_GridComp/scm_surface.F90 | 0 .../GEOSphysics_GridComp/GEOSturbulence_GridComp/shoc.F90 | 0 .../GEOSphysics_GridComp/GEOSturbulence_GridComp/shocparams.F90 | 0 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/.gitignore | 0 .../ARIESg3_GridComp/ARIESg3_GridCompMod.F90 | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/CMakeLists.txt | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/FVdycore_arch.mk | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/dynamics_vars.F90 | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/fft99.F90 | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dycore.F | 0 .../ARIESg3_GridComp/g3_dynamics_lattice_module.F | 0 .../ARIESg3_GridComp/g3_dynamics_state_module.F | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_gcmutil.F | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_grids.F | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mpi_util.F | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mymalloc.F | 0 .../ARIESg3_GridComp/g3_mymalloc_interface | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_wrapper.F | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/gmap.F90 | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/par_xsum.F90 | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/pft_module.F90 | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/remap.F90 | 0 .../GEOSsuperdyn_GridComp/ARIESg3_GridComp/shr_kind_mod.F90 | 0 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/BlendingMod.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/CMakeLists.txt | 0 .../FVdycore_GridComp/FVdycore_GridCompMod.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_arch.mk | 0 .../FVdycore_GridComp/FVdycore_wrapper.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/FVperf_module.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/G3_AVRX.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/benergy.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/cd_core.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/diag_module.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/dynamics_vars.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/epvd.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/fft99.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/fill_module.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/geopk.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/glosum.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/gmap.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/mapz_module.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/par_vecsum.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/par_xsum.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/pft_module.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/pkez.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/pmaxmin.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/remap.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/shr_kind_mod.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/sw_core.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/te_map.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/tp_core.F90 | 0 .../GEOSsuperdyn_GridComp/FVdycore_GridComp/trac2d.F90 | 0 .../GEOSsuperdyn_GridComp/GEOS_SuperdynGridComp.F90 | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/CMakeLists.txt | 0 .../GEOSdatmodyn_GridComp/GEOS_DatmoDynGridComp.F90 | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/NeuralNet.F90 | 0 .../GEOSdatmodyn_GridComp/bomex_reader.F90 | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/cfmip_ic.F90 | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/cptread.F90 | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/gate_reader.F90 | 0 .../GEOSdatmodyn_GridComp/idl/cleanunder.pro | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/int2d.pro | 0 .../GEOSdatmodyn_GridComp/idl/make_bcs_ics.pro | 0 .../GEOSdatmodyn_GridComp/idl/make_land_files.pro | 0 .../GEOSdatmodyn_GridComp/idl/makeup_sstfiles.pro | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/mktile.pro | 0 .../GEOSdatmodyn_GridComp/idl/read_catch_internal.pro | 0 .../GEOSdatmodyn_GridComp/idl/read_fv_internal.pro | 0 .../GEOSdatmodyn_GridComp/idl/read_land_bcs.pro | 0 .../GEOSdatmodyn_GridComp/idl/read_lnd_albedos.pro | 0 .../GEOSdatmodyn_GridComp/idl/read_sst.pro | 0 .../GEOSdatmodyn_GridComp/idl/read_topo.pro | 0 .../GEOSdatmodyn_GridComp/idl/read_vegdyn_internal.pro | 0 .../GEOSdatmodyn_GridComp/idl/readlaigrn.pro | 0 .../GEOSdatmodyn_GridComp/idl/readtilefile.pro | 0 .../GEOSdatmodyn_GridComp/idl/rewrite_fv_internal.pro | 0 .../GEOSdatmodyn_GridComp/idl/rewrite_moist_internal.pro | 0 .../GEOSdatmodyn_GridComp/idl/rewrite_sstfiles.pro | 0 .../GEOSdatmodyn_GridComp/idl/rewrite_topofiles.pro | 0 .../GEOSdatmodyn_GridComp/idl/write_datmodyn_internal.pro | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/ppm.F90 | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/reader.F90 | 0 .../GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/stratus_ic.F90 | 0 GEOSdataatm_GridComp/CMakeLists.txt | 0 GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 | 0 GEOSdataatm_GridComp/cube_sphere.F90 | 0 GEOSdataatm_GridComp/ncar_ocean_fluxes.F90 | 0 GEOSmkiau_GridComp/CMakeLists.txt | 0 GEOSmkiau_GridComp/DFI_GridComp.F90 | 0 GEOSmkiau_GridComp/DynVec_GridComp.F90 | 0 GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 | 0 GEOSmkiau_GridComp/IAU_GridCompMod.F90 | 0 GEOSogcm_GridComp/.gitignore | 0 GEOSogcm_GridComp/CMakeLists.txt | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/CMakeLists.txt | 0 .../GEOS_OceanbiogeochemGridComp.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/carbon.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/co2calc_SWS.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/daysetbio.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/definebio.h | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/definetab.h | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/drtsafe.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/kloop.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ppco2.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ptend.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/setbio.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/sink.F90 | 0 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ta_iter_SWS.F90 | 0 GEOSogcm_GridComp/GEOS_OgcmGridComp.F90 | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/CMakeLists.txt | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/GEOS_OradBioGridComp.F90 | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/aasack.F90 | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/comlte.h | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/daysetrad.F90 | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/definebio.h | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/edeu.F90 | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/glight.F90 | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/lidata.F90 | 0 GEOSogcm_GridComp/GEOS_OradBioGridComp/setlte.F90 | 0 GEOSogcm_GridComp/GEOS_OradGridComp/CMakeLists.txt | 0 GEOSogcm_GridComp/GEOS_OradGridComp/GEOS_OradGridComp.F90 | 0 GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/.gitignore | 0 GEOSogcm_GridComp/GEOSseaice_GridComp/CMakeLists.txt | 0 .../GEOSseaice_GridComp/GEOSCICEDyna_GridComp/CMakeLists.txt | 0 GEOSogcm_GridComp/GEOSseaice_GridComp/GEOS_SeaIceGridComp.F90 | 0 .../GEOSseaice_GridComp/GEOSdataseaice_GridComp/CMakeLists.txt | 0 .../GEOSdataseaice_GridComp/GEOS_DataSeaIceGridComp.F90 | 0 LICENSE | 0 LICENSE-NOSA | 0 README.md | 0 416 files changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 .circleci/config.yml mode change 100644 => 100755 .github/CODEOWNERS mode change 100644 => 100755 .github/PULL_REQUEST_TEMPLATE/auto_pr_to_mapl3.md mode change 100644 => 100755 .github/workflows/push-to-develop.yml mode change 100644 => 100755 .github/workflows/workflow.yml mode change 100644 => 100755 .gitignore mode change 100644 => 100755 CMakeLists.txt mode change 100644 => 100755 CODE_OF_CONDUCT.md mode change 100644 => 100755 CONTRIBUTING.md mode change 100644 => 100755 COPYRIGHT mode change 100644 => 100755 GCM_Preamble.tex mode change 100644 => 100755 GEOS_GcmGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/.gitignore mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GEOS_GwdGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gw_drag.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gwdc.f mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gwdps.f mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/machine.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/cesm_const_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/coords_1d.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_common.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_convect.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_diffusion.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_drag.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_oro.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_utils.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/interpolate_data.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/linear_1d_operators.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/vdiff_lu_solver.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CLDPARAMS.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF_GEOS5.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MoistGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/RASPARAMS.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/SHLWPARAMS.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/WSUB_ExtData.rc mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/WSUB_ExtData.yaml mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/aer_actv_single_moment.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/aer_cloud.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cldmacro.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cldwat2m_micro.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cloudnew.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ddf.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/gfdl_cloud_microphys.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/isccp_call.code mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/isccp_decls.code mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/micro_mg3_0.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/micro_mg_utils.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/module_gate.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/partition_pdf.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/qsat.h mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ras.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/rascnvv2_v.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/uwshcu.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/wv_saturation.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/GEOS_LakeGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNAllocationMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNAnnualUpdateMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNBalanceCheckMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate1Mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate2Mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate3Mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNDecompCascadeMod_BGC.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNDecompMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNEcosystemDynMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNGRespMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNGapMortalityMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNMRespMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNDynamicsMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate1Mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate2Mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate3Mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNitrifDenitrifMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNPhenologyMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNPrecisionControlMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSetValueMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSoilLittVertTranspMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSummaryMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNVegStructUpdateMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNVerticalProfileMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNWoodProductsMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNiniTimeVar.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/TridiagonalMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_time_manager.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varcon.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varctl.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clmtype.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clmtypeInitMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/compute_rc.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/getco2.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/pftvarcon.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/shr_const_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/subgridAveMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/update_model_para4cn.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/perf_mod.F90 rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/{shr_assert_mod.F90.in => shr_assert_mod.F90} (100%) mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_const_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_kind_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_log_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_sys_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/utils/dbg_cnlsm_offline.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/dbg_clsm_offline.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/m_dbg_routines.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/build_rivernetwork.py mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/routing_model.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/sibalb_coeff.f90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/update_model_paras.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking.h mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking_RUN1.h mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking.h mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking_RUN1.h mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_ObioGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SimpleSeaiceGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr.h mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr_RUN1.h mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/OASIMalbedoMod.f mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/StieglitzSnow.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CubedSphere_GridMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/Raster.h mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/asia_tiles.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/compare_bcs.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/date_time_util.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/easeV1_conv.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/easeV2_conv.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/findloc.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/leap_year.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_surf_5cm_gensoil.f90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/m_loss_during_routines.f90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara_v2.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/modis_scale_factor.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mosaic_classes_on_tiles.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.csh mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_geos5_grid.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.H mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/read_riveroutlet.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/soil_types_on_tiles.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/util.c mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/zip.c mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/.gitignore mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/README mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_RouteRestarts.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/newcatch.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/newvegdyn.f90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/replace_params.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/strip_vegdyn.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/GEOS_TurbulenceGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/LockEntrain.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmf.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmfparams.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/idl/vis.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/idl/zosea.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/scm_surface.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shoc.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shocparams.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/.gitignore mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/ARIESg3_GridCompMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/FVdycore_arch.mk mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/dynamics_vars.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/fft99.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dycore.F mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dynamics_lattice_module.F mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dynamics_state_module.F mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_gcmutil.F mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_grids.F mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mpi_util.F mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mymalloc.F mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mymalloc_interface mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_wrapper.F mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/gmap.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/par_xsum.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/pft_module.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/remap.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/shr_kind_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/BlendingMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_GridCompMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_arch.mk mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_wrapper.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVperf_module.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/G3_AVRX.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/benergy.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/cd_core.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/diag_module.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/dynamics_vars.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/epvd.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/fft99.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/fill_module.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/geopk.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/glosum.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/gmap.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/mapz_module.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/par_vecsum.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/par_xsum.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pft_module.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pkez.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pmaxmin.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/remap.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/shr_kind_mod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/sw_core.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/te_map.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/tp_core.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/trac2d.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOS_SuperdynGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/GEOS_DatmoDynGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/NeuralNet.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/bomex_reader.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/cfmip_ic.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/cptread.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/gate_reader.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/cleanunder.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/int2d.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/make_bcs_ics.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/make_land_files.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/makeup_sstfiles.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/mktile.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_catch_internal.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_fv_internal.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_land_bcs.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_lnd_albedos.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_sst.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_topo.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_vegdyn_internal.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/readlaigrn.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/readtilefile.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_fv_internal.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_moist_internal.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_sstfiles.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_topofiles.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/write_datmodyn_internal.pro mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/ppm.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/reader.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/stratus_ic.F90 mode change 100644 => 100755 GEOSdataatm_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 mode change 100644 => 100755 GEOSdataatm_GridComp/cube_sphere.F90 mode change 100644 => 100755 GEOSdataatm_GridComp/ncar_ocean_fluxes.F90 mode change 100644 => 100755 GEOSmkiau_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSmkiau_GridComp/DFI_GridComp.F90 mode change 100644 => 100755 GEOSmkiau_GridComp/DynVec_GridComp.F90 mode change 100644 => 100755 GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 mode change 100644 => 100755 GEOSmkiau_GridComp/IAU_GridCompMod.F90 mode change 100644 => 100755 GEOSogcm_GridComp/.gitignore mode change 100644 => 100755 GEOSogcm_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/CMakeLists.txt mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/GEOS_OceanbiogeochemGridComp.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/carbon.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/co2calc_SWS.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/daysetbio.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/definebio.h mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/definetab.h mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/drtsafe.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/kloop.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ppco2.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ptend.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/setbio.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/sink.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ta_iter_SWS.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OgcmGridComp.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/CMakeLists.txt mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/GEOS_OradBioGridComp.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/aasack.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/comlte.h mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/daysetrad.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/definebio.h mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/edeu.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/glight.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/lidata.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradBioGridComp/setlte.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradGridComp/CMakeLists.txt mode change 100644 => 100755 GEOSogcm_GridComp/GEOS_OradGridComp/GEOS_OradGridComp.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/.gitignore mode change 100644 => 100755 GEOSogcm_GridComp/GEOSseaice_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSCICEDyna_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSogcm_GridComp/GEOSseaice_GridComp/GEOS_SeaIceGridComp.F90 mode change 100644 => 100755 GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/GEOS_DataSeaIceGridComp.F90 mode change 100644 => 100755 LICENSE mode change 100644 => 100755 LICENSE-NOSA mode change 100644 => 100755 README.md diff --git a/.circleci/config.yml b/.circleci/config.yml old mode 100644 new mode 100755 diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS old mode 100644 new mode 100755 diff --git a/.github/PULL_REQUEST_TEMPLATE/auto_pr_to_mapl3.md b/.github/PULL_REQUEST_TEMPLATE/auto_pr_to_mapl3.md old mode 100644 new mode 100755 diff --git a/.github/workflows/push-to-develop.yml b/.github/workflows/push-to-develop.yml old mode 100644 new mode 100755 diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml old mode 100644 new mode 100755 diff --git a/.gitignore b/.gitignore old mode 100644 new mode 100755 diff --git a/CMakeLists.txt b/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md old mode 100644 new mode 100755 diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md old mode 100644 new mode 100755 diff --git a/COPYRIGHT b/COPYRIGHT old mode 100644 new mode 100755 diff --git a/GCM_Preamble.tex b/GCM_Preamble.tex old mode 100644 new mode 100755 diff --git a/GEOS_GcmGridComp.F90 b/GEOS_GcmGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/.gitignore b/GEOSagcm_GridComp/GEOSphysics_GridComp/.gitignore old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GEOS_GwdGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GEOS_GwdGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gw_drag.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gw_drag.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gwdc.f b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gwdc.f old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gwdps.f b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/gwdps.f old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/machine.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/machine.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/cesm_const_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/cesm_const_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/coords_1d.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/coords_1d.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_common.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_common.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_convect.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_convect.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_diffusion.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_diffusion.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_drag.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_drag.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_oro.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_oro.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_utils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_utils.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/interpolate_data.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/interpolate_data.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/linear_1d_operators.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/linear_1d_operators.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/vdiff_lu_solver.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/vdiff_lu_solver.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CLDPARAMS.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CLDPARAMS.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF_GEOS5.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF_GEOS5.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MoistGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MoistGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/RASPARAMS.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/RASPARAMS.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/SHLWPARAMS.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/SHLWPARAMS.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/WSUB_ExtData.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/WSUB_ExtData.rc old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/WSUB_ExtData.yaml b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/WSUB_ExtData.yaml old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/aer_actv_single_moment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/aer_actv_single_moment.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/aer_cloud.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/aer_cloud.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cldmacro.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cldmacro.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cldwat2m_micro.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cldwat2m_micro.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cloudnew.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/cloudnew.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ddf.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ddf.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/gfdl_cloud_microphys.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/gfdl_cloud_microphys.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/isccp_call.code b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/isccp_call.code old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/isccp_decls.code b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/isccp_decls.code old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/micro_mg3_0.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/micro_mg3_0.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/micro_mg_utils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/micro_mg_utils.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/module_gate.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/module_gate.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/partition_pdf.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/partition_pdf.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/qsat.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/qsat.h old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ras.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ras.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/rascnvv2_v.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/rascnvv2_v.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/uwshcu.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/uwshcu.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/wv_saturation.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/wv_saturation.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/GEOS_LakeGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/GEOS_LakeGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNAllocationMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNAllocationMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNAnnualUpdateMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNAnnualUpdateMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNBalanceCheckMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNBalanceCheckMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate1Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate1Mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate2Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate2Mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate3Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNCStateUpdate3Mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNDecompCascadeMod_BGC.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNDecompCascadeMod_BGC.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNDecompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNDecompMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNEcosystemDynMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNEcosystemDynMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNGRespMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNGRespMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNGapMortalityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNGapMortalityMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNMRespMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNMRespMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNDynamicsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNDynamicsMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate1Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate1Mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate2Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate2Mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate3Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNStateUpdate3Mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNitrifDenitrifMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNNitrifDenitrifMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNPhenologyMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNPhenologyMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNPrecisionControlMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNPrecisionControlMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSetValueMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSetValueMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSoilLittVertTranspMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSoilLittVertTranspMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSummaryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNSummaryMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNVegStructUpdateMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNVegStructUpdateMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNVerticalProfileMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNVerticalProfileMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNWoodProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNWoodProductsMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNiniTimeVar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CNiniTimeVar.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/TridiagonalMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/TridiagonalMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_time_manager.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varcon.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varctl.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clmtype.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clmtype.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clmtypeInitMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clmtypeInitMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/compute_rc.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/compute_rc.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/getco2.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/getco2.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/pftvarcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/pftvarcon.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/shr_const_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/shr_const_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/subgridAveMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/subgridAveMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/update_model_para4cn.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/update_model_para4cn.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt old mode 100644 new mode 100755 index 36ceeb50f..c0a4b51da --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -96,7 +96,7 @@ set (srcs RootBiophysMod.F90 shr_abort_mod.F90 shr_assert.h - shr_assert_mod.F90.in + shr_assert_mod.F90 shr_const_mod.F90 shr_file_mod.F90 shr_infnan_mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/perf_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/perf_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_const_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_const_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_kind_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_kind_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_log_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_log_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_sys_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_sys_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/utils/dbg_cnlsm_offline.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/utils/dbg_cnlsm_offline.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/dbg_clsm_offline.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/dbg_clsm_offline.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/m_dbg_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/m_dbg_routines.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/build_rivernetwork.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/build_rivernetwork.py old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/routing_model.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/routing_model.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/sibalb_coeff.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/sibalb_coeff.f90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/update_model_paras.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/update_model_paras.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking.h old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking_RUN1.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking_RUN1.h old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking.h old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking_RUN1.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking_RUN1.h old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_ObioGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_ObioGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SimpleSeaiceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SimpleSeaiceGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr.h old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr_RUN1.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr_RUN1.h old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/OASIMalbedoMod.f b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/OASIMalbedoMod.f old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/StieglitzSnow.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/StieglitzSnow.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CubedSphere_GridMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CubedSphere_GridMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/Raster.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/Raster.h old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/asia_tiles.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/asia_tiles.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/compare_bcs.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/compare_bcs.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/date_time_util.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/date_time_util.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/easeV1_conv.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/easeV1_conv.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/easeV2_conv.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/easeV2_conv.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/findloc.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/findloc.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/leap_year.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/leap_year.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_surf_5cm_gensoil.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_surf_5cm_gensoil.f90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/m_loss_during_routines.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/m_loss_during_routines.f90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara_v2.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara_v2.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/modis_scale_factor.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/modis_scale_factor.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mosaic_classes_on_tiles.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mosaic_classes_on_tiles.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.csh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.csh old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_curves.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_geos5_grid.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/plot_geos5_grid.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.H b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rasterize.H old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/read_riveroutlet.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/read_riveroutlet.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/soil_types_on_tiles.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/soil_types_on_tiles.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/util.c b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/util.c old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/zip.c b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/zip.c old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/.gitignore b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/.gitignore old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/README b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/README old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CICERestart.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_RouteRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_RouteRestarts.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/newcatch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/newcatch.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/newvegdyn.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/newvegdyn.f90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/replace_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/replace_params.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/strip_vegdyn.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/obsolete/strip_vegdyn.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/GEOS_TurbulenceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/GEOS_TurbulenceGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/LockEntrain.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/LockEntrain.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmf.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmf.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmfparams.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmfparams.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/idl/vis.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/idl/vis.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/idl/zosea.pro b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/idl/zosea.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/scm_surface.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/scm_surface.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shoc.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shoc.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shocparams.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shocparams.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/.gitignore b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/.gitignore old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/ARIESg3_GridCompMod.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/ARIESg3_GridCompMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/FVdycore_arch.mk b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/FVdycore_arch.mk old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/dynamics_vars.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/dynamics_vars.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/fft99.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/fft99.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dycore.F b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dycore.F old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dynamics_lattice_module.F b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dynamics_lattice_module.F old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dynamics_state_module.F b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_dynamics_state_module.F old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_gcmutil.F b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_gcmutil.F old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_grids.F b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_grids.F old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mpi_util.F b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mpi_util.F old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mymalloc.F b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mymalloc.F old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mymalloc_interface b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_mymalloc_interface old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_wrapper.F b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/g3_wrapper.F old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/gmap.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/gmap.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/par_xsum.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/par_xsum.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/pft_module.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/pft_module.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/remap.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/remap.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/shr_kind_mod.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/ARIESg3_GridComp/shr_kind_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/BlendingMod.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/BlendingMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_GridCompMod.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_GridCompMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_arch.mk b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_arch.mk old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_wrapper.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVdycore_wrapper.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVperf_module.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/FVperf_module.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/G3_AVRX.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/G3_AVRX.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/benergy.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/benergy.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/cd_core.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/cd_core.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/diag_module.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/diag_module.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/dynamics_vars.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/dynamics_vars.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/epvd.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/epvd.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/fft99.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/fft99.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/fill_module.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/fill_module.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/geopk.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/geopk.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/glosum.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/glosum.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/gmap.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/gmap.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/mapz_module.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/mapz_module.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/par_vecsum.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/par_vecsum.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/par_xsum.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/par_xsum.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pft_module.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pft_module.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pkez.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pkez.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pmaxmin.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/pmaxmin.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/remap.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/remap.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/shr_kind_mod.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/shr_kind_mod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/sw_core.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/sw_core.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/te_map.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/te_map.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/tp_core.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/tp_core.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/trac2d.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/FVdycore_GridComp/trac2d.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOS_SuperdynGridComp.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOS_SuperdynGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/GEOS_DatmoDynGridComp.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/GEOS_DatmoDynGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/NeuralNet.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/NeuralNet.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/bomex_reader.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/bomex_reader.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/cfmip_ic.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/cfmip_ic.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/cptread.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/cptread.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/gate_reader.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/gate_reader.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/cleanunder.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/cleanunder.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/int2d.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/int2d.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/make_bcs_ics.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/make_bcs_ics.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/make_land_files.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/make_land_files.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/makeup_sstfiles.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/makeup_sstfiles.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/mktile.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/mktile.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_catch_internal.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_catch_internal.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_fv_internal.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_fv_internal.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_land_bcs.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_land_bcs.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_lnd_albedos.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_lnd_albedos.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_sst.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_sst.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_topo.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_topo.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_vegdyn_internal.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/read_vegdyn_internal.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/readlaigrn.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/readlaigrn.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/readtilefile.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/readtilefile.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_fv_internal.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_fv_internal.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_moist_internal.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_moist_internal.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_sstfiles.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_sstfiles.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_topofiles.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/rewrite_topofiles.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/write_datmodyn_internal.pro b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/idl/write_datmodyn_internal.pro old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/ppm.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/ppm.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/reader.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/reader.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/stratus_ic.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOSdatmodyn_GridComp/stratus_ic.F90 old mode 100644 new mode 100755 diff --git a/GEOSdataatm_GridComp/CMakeLists.txt b/GEOSdataatm_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 b/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSdataatm_GridComp/cube_sphere.F90 b/GEOSdataatm_GridComp/cube_sphere.F90 old mode 100644 new mode 100755 diff --git a/GEOSdataatm_GridComp/ncar_ocean_fluxes.F90 b/GEOSdataatm_GridComp/ncar_ocean_fluxes.F90 old mode 100644 new mode 100755 diff --git a/GEOSmkiau_GridComp/CMakeLists.txt b/GEOSmkiau_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSmkiau_GridComp/DFI_GridComp.F90 b/GEOSmkiau_GridComp/DFI_GridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSmkiau_GridComp/DynVec_GridComp.F90 b/GEOSmkiau_GridComp/DynVec_GridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 b/GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSmkiau_GridComp/IAU_GridCompMod.F90 b/GEOSmkiau_GridComp/IAU_GridCompMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/.gitignore b/GEOSogcm_GridComp/.gitignore old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/CMakeLists.txt b/GEOSogcm_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/CMakeLists.txt b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/GEOS_OceanbiogeochemGridComp.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/GEOS_OceanbiogeochemGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/carbon.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/carbon.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/co2calc_SWS.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/co2calc_SWS.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/daysetbio.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/daysetbio.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/definebio.h b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/definebio.h old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/definetab.h b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/definetab.h old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/drtsafe.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/drtsafe.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/kloop.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/kloop.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ppco2.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ppco2.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ptend.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ptend.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/setbio.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/setbio.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/sink.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/sink.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ta_iter_SWS.F90 b/GEOSogcm_GridComp/GEOS_OceanBioGeoChemGridComp/ta_iter_SWS.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OgcmGridComp.F90 b/GEOSogcm_GridComp/GEOS_OgcmGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/CMakeLists.txt b/GEOSogcm_GridComp/GEOS_OradBioGridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/GEOS_OradBioGridComp.F90 b/GEOSogcm_GridComp/GEOS_OradBioGridComp/GEOS_OradBioGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/aasack.F90 b/GEOSogcm_GridComp/GEOS_OradBioGridComp/aasack.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/comlte.h b/GEOSogcm_GridComp/GEOS_OradBioGridComp/comlte.h old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/daysetrad.F90 b/GEOSogcm_GridComp/GEOS_OradBioGridComp/daysetrad.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/definebio.h b/GEOSogcm_GridComp/GEOS_OradBioGridComp/definebio.h old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/edeu.F90 b/GEOSogcm_GridComp/GEOS_OradBioGridComp/edeu.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/glight.F90 b/GEOSogcm_GridComp/GEOS_OradBioGridComp/glight.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/lidata.F90 b/GEOSogcm_GridComp/GEOS_OradBioGridComp/lidata.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradBioGridComp/setlte.F90 b/GEOSogcm_GridComp/GEOS_OradBioGridComp/setlte.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradGridComp/CMakeLists.txt b/GEOSogcm_GridComp/GEOS_OradGridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOS_OradGridComp/GEOS_OradGridComp.F90 b/GEOSogcm_GridComp/GEOS_OradGridComp/GEOS_OradGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/.gitignore b/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/.gitignore old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/CMakeLists.txt b/GEOSogcm_GridComp/GEOSseaice_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSCICEDyna_GridComp/CMakeLists.txt b/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSCICEDyna_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOS_SeaIceGridComp.F90 b/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOS_SeaIceGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/CMakeLists.txt b/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/GEOS_DataSeaIceGridComp.F90 b/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/GEOS_DataSeaIceGridComp.F90 old mode 100644 new mode 100755 diff --git a/LICENSE b/LICENSE old mode 100644 new mode 100755 diff --git a/LICENSE-NOSA b/LICENSE-NOSA old mode 100644 new mode 100755 diff --git a/README.md b/README.md old mode 100644 new mode 100755 From b894ffd368d2a8247556e9dfca19308a8132374f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 13:39:30 -0500 Subject: [PATCH 095/589] fixing variable declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 index 943a5ab1f..107186ecb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 @@ -48,7 +48,7 @@ subroutine init_crop_type(bounds, this) type(crop_type), intent(inout):: this !LOCAL - integer, intent(in) :: begp, endp + integer :: begp, endp !--------------------------------- From 0071e6e9cd8b4564de6c105bfc58fd6cc29464a0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 14:12:23 -0500 Subject: [PATCH 096/589] multiple bug fixes --- .../CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index bbacd0867..65fcb9ed5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -75,7 +75,7 @@ subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) ! ! !LOCAL VARIABLES: integer :: begc,endc - integer :: n, nc, nz, n + integer :: n, nc, nz, np integer, dimension(8) :: decomp_cpool_cncol_index = (/ 3, 4, 5, 2, 10, 11, 12, 13 /) !----------------------------------- @@ -140,15 +140,15 @@ subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) do nz = 1,num_zon ! CN zone loop n = n + 1 - this%ctrunc_vr_col (n) = cncol(nc,nz,1) + this%ctrunc_vr_col (n,1:nlevdecomp_full) = cncol(nc,nz,1) this%totlitc_col (n) = cncol(nc,nz,15) do np = 1,ndecomp_pools ! jkolassa May 2022: accounting for fact that pool order in CNCOL is different from CTSM this%decomp_cpools_col (n,np) = cncol(nc,nz,decomp_cpool_cncol_index(np)) - this%decomp_cpools_col_1m (n,np) = cncol(nc,nz,decomp_cpool_cncol_index(np)) + this%decomp_cpools_1m_col (n,np) = cncol(nc,nz,decomp_cpool_cncol_index(np)) ! jkolassa May 2022: loop has to be added below if we add more biogeochemical (or soil) layers - this%decomp_cpools_vr_col (n,1,np) cncol(nc,nz,decomp_cpool_cncol_index(np)) + this%decomp_cpools_vr_col (n,1,np) = cncol(nc,nz,decomp_cpool_cncol_index(np)) end do !np ! sum soil carbon pools @@ -157,7 +157,7 @@ subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) end do !nz end do ! nc - end init_soilbiogeochem_carbonstate_type + end subroutine init_soilbiogeochem_carbonstate_type !----------------------------------------------------------------------- subroutine Summary(this, bounds, num_allc, filter_allc) From 2173eea9d115b73c484e16202e40afe02f4055d2 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 14:12:43 -0500 Subject: [PATCH 097/589] add missing constants --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index a45729767..c24c4d1a5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -72,6 +72,18 @@ module clm_varcon integer, parameter, public :: max_lunit = 9 !maximum value that lun%itype can have + ! typical del13C for C3 photosynthesis (permil, relative to PDB) + real(r8), public, parameter :: c3_del13c = -28._r8 + + ! typical del13C for C4 photosynthesis (permil, relative to PDB) + real(r8), public, parameter :: c4_del13c = -13._r8 + + ! isotope ratio (13c/12c) for C3 photosynthesis + real(r8), public, parameter :: c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8) + + ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis + real(r8), public, parameter :: c3_r2 = c3_r1/(1._r8 + c3_r1) + ! !PUBLIC MEMBER FUNCTIONS: public clm_varcon_init ! Initialze constants that need to be initialized From 9c5008db4b1566a7e54797d38edd0c8a72330325 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 14:49:59 -0500 Subject: [PATCH 098/589] add missing use statements and variable imports --- .../CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index 65fcb9ed5..6ec94af7c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -1,12 +1,16 @@ module SoilBiogeochemCarbonStateType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan - use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi + use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi, & + NUM_ZON, VAR_COL use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi, zsoi, c3_r2 use clm_varctl , only : iulog, use_vertsoilc, use_fates, use_soil_matrixcn use decompMod , only : bounds_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con ! !PUBLIC TYPES: implicit none @@ -60,6 +64,10 @@ module SoilBiogeochemCarbonStateType end type soilbiogeochem_carbonstate_type type(soilbiogeochem_carbonstate_type), public, target, save :: soilbiogeochem_carbonstate_inst + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + contains !------------------------------------------- From d3fc5e74e4fa2e3d8bb5b6b7a842baad2f2cfdc9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 15:14:44 -0500 Subject: [PATCH 099/589] only keep endrun_vanilla option --- .../CLM51/abortutils.F90 | 80 +++++++++---------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 index eb276ca04..815b7f840 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 @@ -14,7 +14,7 @@ module abortutils interface endrun module procedure endrun_vanilla - module procedure endrun_globalindex + ! module procedure endrun_globalindex end interface CONTAINS @@ -52,44 +52,44 @@ subroutine endrun_vanilla(msg, additional_msg) end subroutine endrun_vanilla !----------------------------------------------------------------------- - subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) - - !----------------------------------------------------------------------- - ! Description: - ! Abort the model for abnormal termination - ! - use shr_sys_mod , only: shr_sys_abort - use clm_varctl , only: iulog - use GetGlobalValuesMod, only: GetGlobalWrite - ! - ! Arguments: - implicit none - integer , intent(in) :: decomp_index - character(len=*) , intent(in) :: clmlevel - - ! Generally you want to at least provide msg. The main reason to separate msg from - ! additional_msg is to supported expected-exception unit testing: you can put - ! volatile stuff in additional_msg, as in: - ! call endrun(msg='Informative message', additional_msg=errmsg(__FILE__, __LINE__)) - ! and then just assert against msg. - character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort - character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort - ! - ! Local Variables: - integer :: igrc, ilun, icol - !----------------------------------------------------------------------- - - write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) - call GetGlobalWrite(decomp_index, clmlevel) - - if (present (additional_msg)) then - write(iulog,*)'ENDRUN: ', additional_msg - else - write(iulog,*)'ENDRUN:' - end if - - call shr_sys_abort(msg) - - end subroutine endrun_globalindex +! subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) +! +! !----------------------------------------------------------------------- +! ! Description: +! ! Abort the model for abnormal termination +! ! +! use shr_sys_mod , only: shr_sys_abort +! use clm_varctl , only: iulog +! use GetGlobalValuesMod, only: GetGlobalWrite +! ! +! ! Arguments: +! implicit none +! integer , intent(in) :: decomp_index +! character(len=*) , intent(in) :: clmlevel +! +! ! Generally you want to at least provide msg. The main reason to separate msg from +! ! additional_msg is to supported expected-exception unit testing: you can put +! ! volatile stuff in additional_msg, as in: +! ! call endrun(msg='Informative message', additional_msg=errmsg(__FILE__, __LINE__)) +! ! and then just assert against msg. +! character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort +! character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort +! ! +! ! Local Variables: +! integer :: igrc, ilun, icol +! !----------------------------------------------------------------------- +! +! write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) +! call GetGlobalWrite(decomp_index, clmlevel) +! +! if (present (additional_msg)) then +! write(iulog,*)'ENDRUN: ', additional_msg +! else +! write(iulog,*)'ENDRUN:' +! end if +! +! call shr_sys_abort(msg) +! +! end subroutine endrun_globalindex end module abortutils From 136c85de2656e6bbd847060daef2e0c8c13bdceb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 16 Nov 2022 15:37:21 -0500 Subject: [PATCH 100/589] fix syntax in if-statements --- .../CLM51/ncdio_pio.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 2da7f2e16..1ddff075e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -59,7 +59,7 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -80,7 +80,7 @@ subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -101,7 +101,7 @@ subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -122,7 +122,7 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -143,7 +143,7 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -165,7 +165,7 @@ subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -187,7 +187,7 @@ subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -209,7 +209,7 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -229,7 +229,7 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -249,7 +249,7 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -269,7 +269,7 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. @@ -289,7 +289,7 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv) logical, intent(out) :: readv !------------------------------------- - if flag == 'read' + if (flag == 'read') then readv = .false. call ncid%get_var(varname, data, rc=status) if (status ==0) readv = .true. From 3b26f1a0a0ec174860f68024f18180a244a12794 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 17 Nov 2022 08:24:55 -0500 Subject: [PATCH 101/589] correct error handling syntax --- .../CLM51/ncdio_pio.F90 | 70 +++++++++++++++++-- 1 file changed, 66 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 1ddff075e..c62ed5753 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -1,3 +1,5 @@ +#include "MAPL_Generic.h" + module ncdio_pio !----------------------------------------------------------------------- @@ -28,8 +30,8 @@ module ncdio_pio public :: ncd_pio_closefile ! close a file public :: ncd_io ! write local data + public file_desc_t ! - contains interface ncd_io @@ -47,6 +49,9 @@ module ncdio_pio module procedure ncd_io_i4_4d end interface ncd_io + + contains + !---------------------------------------------------- subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) @@ -78,6 +83,10 @@ subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status !------------------------------------- if (flag == 'read') then @@ -99,6 +108,11 @@ subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -120,6 +134,11 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -141,6 +160,11 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -163,6 +187,11 @@ subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -185,6 +214,11 @@ subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -207,6 +241,11 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -227,6 +266,11 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -247,6 +291,11 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -267,6 +316,11 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -287,6 +341,11 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -308,14 +367,17 @@ subroutine ncd_pio_openfile(file, fname, mode) class(file_desc_t) , intent(inout) :: file ! Output PIO file handle character(len=*) , intent(in) :: fname ! Input filename to open integer , intent(in) :: mode ! file mode + + ! LOCAL: + + integer :: status + ! - ! !LOCAL VARIABLES: - integer :: rc !----------------------------------------------------------------------- if (mode==0) then - call file%open(trim(fname),pFIO_READ, __RC__) + call file%open(trim(fname),pFIO_READ, rc=status) else _ASSERT(status==0, "Unrecognized netcdf opening mode") end if From 7ae287e3921d057501b5ba4c040411619044a75d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 17 Nov 2022 08:53:46 -0500 Subject: [PATCH 102/589] correct interface syntax --- .../GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index c62ed5753..96b21fbd9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -48,7 +48,7 @@ module ncdio_pio module procedure ncd_io_i4_3d module procedure ncd_io_i4_4d - end interface ncd_io + end interface contains From 953450893d72a2497c7e61c5099ea96473ddb863 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 17 Nov 2022 09:30:47 -0500 Subject: [PATCH 103/589] syntax corrections, adding missing use statements, adding missing files --- .../CLM51/ncdio_pio.F90 | 34 +++++++++++++++---- 1 file changed, 28 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 96b21fbd9..b87a8bfbd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -12,7 +12,8 @@ module ncdio_pio ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8, i4=>shr_kind_i4, shr_kind_cl, r4 => shr_kind_r4 - use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan + !use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan + use nanMod , only : nan use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : errMsg => shr_log_errMsg use MAPL , only : file_desc_t => NetCDF4_FileFormatter @@ -62,6 +63,11 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + + ! LOCAL: + + integer :: status + !------------------------------------- if (flag == 'read') then @@ -262,7 +268,7 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv) ! ARGUMENTS: !------------- type(file_desc_t), intent(inout) :: ncid ! netcdf file id - real(i4), intent(inout) :: data(:) + integer(i4), intent(inout) :: data(:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv @@ -287,7 +293,7 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv) ! ARGUMENTS: !------------- type(file_desc_t), intent(inout) :: ncid ! netcdf file id - real(i4), intent(inout) :: data(:,:) + integer(i4), intent(inout) :: data(:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv @@ -312,7 +318,7 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv) ! ARGUMENTS: !------------- type(file_desc_t), intent(inout) :: ncid ! netcdf file id - real(i4), intent(inout) :: data(:,:,:) + integer(i4), intent(inout) :: data(:,:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv @@ -337,7 +343,7 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv) ! ARGUMENTS: !------------- type(file_desc_t), intent(inout) :: ncid ! netcdf file id - real(i4), intent(inout) :: data(:,:,:,:) + integer(i4), intent(inout) :: data(:,:,:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv @@ -358,7 +364,7 @@ end subroutine ncd_io_i4_4d !----------------------------------------------------------------------- - subroutine ncd_pio_openfile(file, fname, mode) + subroutine ncd_pio_openfile(file, fname, mode, rc) ! ! !DESCRIPTION: ! Open a NetCDF PIO file @@ -367,6 +373,7 @@ subroutine ncd_pio_openfile(file, fname, mode) class(file_desc_t) , intent(inout) :: file ! Output PIO file handle character(len=*) , intent(in) :: fname ! Input filename to open integer , intent(in) :: mode ! file mode + integer, optional , intent(out) :: rc ! LOCAL: @@ -383,4 +390,19 @@ subroutine ncd_pio_openfile(file, fname, mode) end if end subroutine ncd_pio_openfile + + !----------------------------------------------------------------------- + subroutine ncd_pio_closefile(file) + ! + ! !DESCRIPTION: + ! Close a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: file ! PIO file handle to close + !----------------------------------------------------------------------- + + call file%close() + + end subroutine ncd_pio_closefile + end module ncdio_pio From f714e6a7d605579b88ddada8847129a0d62dc8f9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 17 Nov 2022 09:51:29 -0500 Subject: [PATCH 104/589] use MAPL read functions --- .../GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index b87a8bfbd..b33f9b478 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -72,7 +72,8 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + ! call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data, rc=status) if (status ==0) readv = .true. endif From de4f7851349fa3ffbe667d52a83523ad3eb5637a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 17 Nov 2022 11:36:55 -0500 Subject: [PATCH 105/589] syntax fix --- .../GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index b33f9b478..ec182da24 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -73,7 +73,7 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif From 21f3f75fa4da4a3e443399ba7ee3481bb61a2b5f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 17 Nov 2022 11:45:47 -0500 Subject: [PATCH 106/589] add optional rc output argument --- .../GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index ec182da24..4480a5191 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -54,7 +54,7 @@ module ncdio_pio contains !---------------------------------------------------- - subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) + subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -63,6 +63,7 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer,optional, intent(out) :: rc ! LOCAL: @@ -73,7 +74,7 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call MAPL_VarRead(ncid,varname,data,rc=status) if (status ==0) readv = .true. endif From 4da494219508f5123fe35731883e4996b82caee0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 17 Nov 2022 14:20:39 -0500 Subject: [PATCH 107/589] adding missing variable import from MAPL --- .../CLM51/ncdio_pio.F90 | 70 ++++++++++++------- 1 file changed, 46 insertions(+), 24 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 4480a5191..c59b1ed75 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -16,7 +16,7 @@ module ncdio_pio use nanMod , only : nan use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : errMsg => shr_log_errMsg - use MAPL , only : file_desc_t => NetCDF4_FileFormatter + use MAPL , only : file_desc_t => NetCDF4_FileFormatter, pFIO_READ use MAPL_ExceptionHandling ! @@ -74,7 +74,7 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv, rc) if (flag == 'read') then readv = .false. ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif @@ -82,7 +82,7 @@ end subroutine ncd_io_r4_1d !----------------------------------------------------------------------- - subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv) + subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -91,6 +91,7 @@ subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -99,7 +100,8 @@ subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + ! call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif @@ -107,7 +109,7 @@ end subroutine ncd_io_r4_2d !----------------------------------------------------------------------- - subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv) + subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -116,6 +118,7 @@ subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -125,7 +128,8 @@ subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif @@ -133,7 +137,7 @@ end subroutine ncd_io_r4_3d !----------------------------------------------------------------------- - subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv) + subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -142,6 +146,7 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -151,7 +156,8 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + ! call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif @@ -159,7 +165,7 @@ end subroutine ncd_io_r4_4d !----------------------------------------------------------------------- - subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv) + subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -168,6 +174,7 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -177,7 +184,8 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif @@ -186,7 +194,7 @@ end subroutine ncd_io_r8_1d !----------------------------------------------------------------------- - subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv) + subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -195,6 +203,7 @@ subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -204,7 +213,8 @@ subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + ! call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif @@ -213,7 +223,7 @@ end subroutine ncd_io_r8_2d !----------------------------------------------------------------------- - subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv) + subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -222,6 +232,7 @@ subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -231,7 +242,8 @@ subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif @@ -240,7 +252,7 @@ end subroutine ncd_io_r8_3d !----------------------------------------------------------------------- - subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv) + subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -249,6 +261,7 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -258,14 +271,15 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif end subroutine ncd_io_r8_4d !----------------------------------------------------------------------- - subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv) + subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -274,6 +288,7 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -283,14 +298,15 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif end subroutine ncd_io_i4_1d !----------------------------------------------------------------------- - subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv) + subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -299,6 +315,7 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -308,14 +325,15 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif end subroutine ncd_io_i4_2d !----------------------------------------------------------------------- - subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv) + subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -324,6 +342,7 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -333,14 +352,15 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif end subroutine ncd_io_i4_3d !----------------------------------------------------------------------- - subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv) + subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv, rc) ! ARGUMENTS: !------------- @@ -349,6 +369,7 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readv + integer, optional, intent(out) :: rc ! LOCAL: @@ -358,7 +379,8 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv) if (flag == 'read') then readv = .false. - call ncid%get_var(varname, data, rc=status) + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readv = .true. endif From 01d7ff3f58a28d867c94f550f099942d7595fec7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 17 Nov 2022 14:21:08 -0500 Subject: [PATCH 108/589] changing syntax on macro statements --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 index b47494050..b9761adae 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 @@ -146,7 +146,7 @@ subroutine shr_assert_in_domain_{DIMS}d_{TYPE}(var, varname, msg, & ! Flag for floating point types. -#if ({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE) +#if (({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE)) then #define TYPEFP #else #undef TYPEFP @@ -155,7 +155,7 @@ subroutine shr_assert_in_domain_{DIMS}d_{TYPE}(var, varname, msg, & ! "Generalized" macro functions allow transformational intrinsic functions ! to handle both scalars and arrays. -#if ({DIMS} != 0) +#if ({DIMS} != 0) then ! When given an array, use the intrinsics. #define GEN_SIZE(x) size(x) #define GEN_ALL(x) all(x) @@ -359,7 +359,7 @@ subroutine print_bad_loc_{DIMS}d_{TYPE}(var, loc_vec, varname) write(shr_log_Unit,*) & "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & " has invalid value ", & -#if ({DIMS} != 0) +#if ({DIMS} != 0) then var({REPEAT:loc_vec(#)}), & " at location: ",loc_vec #else @@ -383,7 +383,7 @@ pure function find_first_loc_{DIMS}d(mask) result (loc_vec) logical, intent(in) :: mask{DIMSTR} integer :: loc_vec({DIMS}) -#if ({DIMS} != 0) +#if ({DIMS} != 0) then integer :: flags({REPEAT:size(mask,#)}) where (mask) @@ -397,7 +397,7 @@ pure function find_first_loc_{DIMS}d(mask) result (loc_vec) ! Remove compiler warnings (statement will be optimized out). -#if (! defined CPRPGI && ! defined CPRCRAY) +#if (! defined CPRPGI && ! defined CPRCRAY) then if (.false. .and. mask) loc_vec = loc_vec #endif From 510660761406020a9434ff627967f90febd6fcc4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 25 Nov 2022 14:36:37 -0500 Subject: [PATCH 109/589] remove statements with syntax error --- .../CLM51/shr_assert_mod.F90 | 94 +++++++++---------- 1 file changed, 47 insertions(+), 47 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 index b9761adae..b308c26e5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 @@ -146,29 +146,29 @@ subroutine shr_assert_in_domain_{DIMS}d_{TYPE}(var, varname, msg, & ! Flag for floating point types. -#if (({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE)) then -#define TYPEFP -#else -#undef TYPEFP -#endif +!#if (({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE)) +!#define TYPEFP +!#else +!#undef TYPEFP +!#endif ! "Generalized" macro functions allow transformational intrinsic functions ! to handle both scalars and arrays. -#if ({DIMS} != 0) then -! When given an array, use the intrinsics. -#define GEN_SIZE(x) size(x) -#define GEN_ALL(x) all(x) -#else - -! Scalar extensions: -! GEN_SIZE always returns 1 for a scalar. -! GEN_ALL (logical reduction) is a no-op for a scalar. -! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -#define GEN_SIZE(x) 1 -#define GEN_ALL(x) x - -#endif +!#if ({DIMS} != 0) +!! When given an array, use the intrinsics. +!#define GEN_SIZE(x) size(x) +!#define GEN_ALL(x) all(x) +!#else +! +!! Scalar extensions: +!! GEN_SIZE always returns 1 for a scalar. +!! GEN_ALL (logical reduction) is a no-op for a scalar. +!! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. +!#define GEN_SIZE(x) 1 +!#define GEN_ALL(x) x +! +!#endif !----------------------------- ! END macro section @@ -359,15 +359,15 @@ subroutine print_bad_loc_{DIMS}d_{TYPE}(var, loc_vec, varname) write(shr_log_Unit,*) & "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & " has invalid value ", & -#if ({DIMS} != 0) then - var({REPEAT:loc_vec(#)}), & - " at location: ",loc_vec -#else - var - - ! Kill compiler spam for unused loc_vec. - if (.false.) write(*,*) loc_vec -#endif +!#if ({DIMS} != 0) +! var({REPEAT:loc_vec(#)}), & +! " at location: ",loc_vec +!#else +! var +! +! ! Kill compiler spam for unused loc_vec. +! if (.false.) write(*,*) loc_vec +!#endif end subroutine print_bad_loc_{DIMS}d_{TYPE} @@ -383,25 +383,25 @@ pure function find_first_loc_{DIMS}d(mask) result (loc_vec) logical, intent(in) :: mask{DIMSTR} integer :: loc_vec({DIMS}) -#if ({DIMS} != 0) then - integer :: flags({REPEAT:size(mask,#)}) - - where (mask) - flags = 1 - elsewhere - flags = 0 - end where - - loc_vec = maxloc(flags) -#else - -! Remove compiler warnings (statement will be optimized out). - -#if (! defined CPRPGI && ! defined CPRCRAY) then - if (.false. .and. mask) loc_vec = loc_vec -#endif - -#endif +!#if ({DIMS} != 0) +! integer :: flags({REPEAT:size(mask,#)}) +! +! where (mask) +! flags = 1 +! elsewhere +! flags = 0 +! end where +! +! loc_vec = maxloc(flags) +!#else +! +!! Remove compiler warnings (statement will be optimized out). +! +!#if (! defined CPRPGI && ! defined CPRCRAY) +! if (.false. .and. mask) loc_vec = loc_vec +!#endif +! +!#endif end function find_first_loc_{DIMS}d From cf5d430b10b5776e9bf3e61650430c39838b284f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 28 Nov 2022 15:26:41 -0500 Subject: [PATCH 110/589] reinstating macro statements --- .../CLM51/shr_assert_mod.F90 | 94 +++++++++---------- 1 file changed, 47 insertions(+), 47 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 index b308c26e5..6cf057dde 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 @@ -146,29 +146,29 @@ subroutine shr_assert_in_domain_{DIMS}d_{TYPE}(var, varname, msg, & ! Flag for floating point types. -!#if (({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE)) -!#define TYPEFP -!#else -!#undef TYPEFP -!#endif +#if (({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE)) +#define TYPEFP +#else +#undef TYPEFP +#endif ! "Generalized" macro functions allow transformational intrinsic functions ! to handle both scalars and arrays. -!#if ({DIMS} != 0) -!! When given an array, use the intrinsics. -!#define GEN_SIZE(x) size(x) -!#define GEN_ALL(x) all(x) -!#else -! -!! Scalar extensions: -!! GEN_SIZE always returns 1 for a scalar. -!! GEN_ALL (logical reduction) is a no-op for a scalar. -!! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. -!#define GEN_SIZE(x) 1 -!#define GEN_ALL(x) x -! -!#endif +#if ({DIMS} != 0) +! When given an array, use the intrinsics. +#define GEN_SIZE(x) size(x) +#define GEN_ALL(x) all(x) +#else + +! Scalar extensions: +! GEN_SIZE always returns 1 for a scalar. +! GEN_ALL (logical reduction) is a no-op for a scalar. +! GEN_[MAX,MIN]LOC should return a 1D, size 0 (empty), integer array. +#define GEN_SIZE(x) 1 +#define GEN_ALL(x) x + +#endif !----------------------------- ! END macro section @@ -359,15 +359,15 @@ subroutine print_bad_loc_{DIMS}d_{TYPE}(var, loc_vec, varname) write(shr_log_Unit,*) & "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & " has invalid value ", & -!#if ({DIMS} != 0) -! var({REPEAT:loc_vec(#)}), & -! " at location: ",loc_vec -!#else -! var -! -! ! Kill compiler spam for unused loc_vec. -! if (.false.) write(*,*) loc_vec -!#endif +#if ({DIMS} != 0) + var({REPEAT:loc_vec(#)}), & + " at location: ",loc_vec +#else + var + + ! Kill compiler spam for unused loc_vec. + if (.false.) write(*,*) loc_vec +#endif end subroutine print_bad_loc_{DIMS}d_{TYPE} @@ -383,25 +383,25 @@ pure function find_first_loc_{DIMS}d(mask) result (loc_vec) logical, intent(in) :: mask{DIMSTR} integer :: loc_vec({DIMS}) -!#if ({DIMS} != 0) -! integer :: flags({REPEAT:size(mask,#)}) -! -! where (mask) -! flags = 1 -! elsewhere -! flags = 0 -! end where -! -! loc_vec = maxloc(flags) -!#else -! -!! Remove compiler warnings (statement will be optimized out). -! -!#if (! defined CPRPGI && ! defined CPRCRAY) -! if (.false. .and. mask) loc_vec = loc_vec -!#endif -! -!#endif +#if ({DIMS} != 0) + integer :: flags({REPEAT:size(mask,#)}) + + where (mask) + flags = 1 + elsewhere + flags = 0 + end where + + loc_vec = maxloc(flags) +#else + +! Remove compiler warnings (statement will be optimized out). + +#if (! defined CPRPGI && ! defined CPRCRAY) + if (.false. .and. mask) loc_vec = loc_vec +#endif + +#endif end function find_first_loc_{DIMS}d From 7595ddc2a7b39d96e81d813b269f203d1fc078d1 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 28 Nov 2022 17:27:32 -0500 Subject: [PATCH 111/589] add cmake and pl file --- .../CLM51/CMakeLists.txt | 15 +- .../CLM51/cmake/genf90_utils.cmake | 91 ++++ .../GEOScatchCNCLM51_GridComp/CLM51/genf90.pl | 387 +++++++++++++++++ ...r_assert_mod.F90 => shr_assert_mod.F90.in} | 17 +- .../CLM51/shr_infnan_mod.F90 | 386 ----------------- .../CLM51/shr_infnan_mod.F90.in | 406 ++++++++++++++++++ 6 files changed, 904 insertions(+), 398 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/cmake/genf90_utils.cmake create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/genf90.pl rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/{shr_assert_mod.F90 => shr_assert_mod.F90.in} (97%) delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index c0a4b51da..e8fb1090f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -1,6 +1,16 @@ esma_set_this () string (REPLACE GEOScatchCN_GridComp_ "" is_openmp ${this}) +list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/cmake") +include(genf90_utils) + +find_program(GENF90 genf90.pl PATHS ${CMAKE_CURRENT_LIST_DIR}) + +set(genf90_files shr_infnan_mod.F90.in shr_assert_mod.F90.in) + +process_genf90_source_list("${genf90_files}" ${CMAKE_CURRENT_BINARY_DIR} + share_genf90_sources) + set (srcs abortutils.F90 AnnualFluxDribbler.F90 @@ -96,10 +106,8 @@ set (srcs RootBiophysMod.F90 shr_abort_mod.F90 shr_assert.h - shr_assert_mod.F90 shr_const_mod.F90 shr_file_mod.F90 - shr_infnan_mod.F90 shr_kind_mod.F90 shr_log_mod.F90 shr_mpi_mod.F90 @@ -120,6 +128,9 @@ set (srcs update_model_para4cn.F90 ) +list(APPEND srcs + ${share_genf90_sources}) + esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL GEOS_LandShared GEOS_CatchCNShared esmf NetCDF::NetCDF_Fortran diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/cmake/genf90_utils.cmake b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/cmake/genf90_utils.cmake new file mode 100755 index 000000000..870cf4e43 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/cmake/genf90_utils.cmake @@ -0,0 +1,91 @@ +# Utility for invoking genf90 on a template file. +# +# If ENABLE_GENF90 is set to a true value, the functions here will behave +# as described below. In this case, the variable GENF90 must be defined and +# contain the genf90.pl command. +# +# If ENABLE_GENF90 is not true, no source code generation or other side +# effects will occur, but output variables will be set as if the generation +# had occurred. +# +#========================================================================== +# +# process_genf90_source_list +# +# Arguments: +# genf90_file_list - A list of template files to process. +# output_directory - Directory where generated sources will be placed. +# fortran_list_name - The name of a list used as output. +# +# Produces generated sources for each of the input templates. Then +# this function *appends* the location of each generated file to the output +# list. +# +# As a side effect, this function will add a target for each generated +# file. For a generated file named "foo.F90", the target will be named +# "generate_foo". +# +# Limitations: +# This function adds targets to work around a deficiency in CMake (see +# "declare_generated_dependencies" in Sourcelist_utils). Unfortunately, +# this means that you cannot use this function to generate two files +# with the same name in a single project. +# +#========================================================================== + +#========================================================================== +# Copyright (c) 2013-2014, University Corporation for Atmospheric Research +# +# This software is distributed under a two-clause BSD license, with no +# warranties, express or implied. See the accompanying LICENSE file for +# details. +#========================================================================== + +#if(ENABLE_GENF90) +if(TRUE) + + # Notify CMake that a Fortran file can be generated from a genf90 + # template. + function(preprocess_genf90_template genf90_file fortran_file) + + add_custom_command(OUTPUT ${fortran_file} + COMMAND ${GENF90} ${genf90_file} >${fortran_file} + MAIN_DEPENDENCY ${genf90_file}) + + get_filename_component(stripped_name ${fortran_file} NAME_WE) + + add_custom_target(generate_${stripped_name} DEPENDS ${fortran_file}) + + endfunction(preprocess_genf90_template) + +else() + + # Stub if genf90 is off. + function(preprocess_genf90_template) + endfunction() + +endif() + +# Auto-generate source names. +function(process_genf90_source_list genf90_file_list output_directory + fortran_list_name) + + foreach(genf90_file IN LISTS genf90_file_list) + + # If a file is a relative path, expand it (relative to current source + # directory. + get_filename_component(genf90_file "${genf90_file}" ABSOLUTE) + + # Get extensionless base name from input. + get_filename_component(genf90_file_stripped "${genf90_file}" NAME_WE) + + # Add generated file to the test list. + set(fortran_file ${output_directory}/${genf90_file_stripped}.F90) + preprocess_genf90_template(${genf90_file} ${fortran_file}) + list(APPEND ${fortran_list_name} ${fortran_file}) + endforeach() + + # Export ${fortran_list_name} to the caller. + set(${fortran_list_name} "${${fortran_list_name}}" PARENT_SCOPE) + +endfunction(process_genf90_source_list) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/genf90.pl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/genf90.pl new file mode 100755 index 000000000..5d35112e9 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/genf90.pl @@ -0,0 +1,387 @@ +#!/usr/bin/env perl +use strict; +my $outfile; +# Beginning with F90, Fortran has strict typing of variables based on "TKR" +# (type, kind, and rank). In many cases we want to write subroutines that +# provide the same functionality for different variable types and ranks. In +# order to do this without cut-and-paste duplication of code, we create a +# template file with the extension ".F90.in", which can be parsed by this script +# to generate F90 code for all of the desired specific types. +# +# Keywords are delimited by curly brackets: {} +# +# {TYPE} and {DIMS} are used to generate the specific subroutine names from the +# generic template +# {TYPE} : Variable type name; implemented types are character, 4 or 8 byte real, +# and 4 or 8 byte integer. +# allowed values: text, real, double, int, long, logical +# default values: text, real, double, int +# {VTYPE} : Used to generate variable declarations to match the specific type. +# if {TYPE}=double then {VTYPE} is "real(r8)" +# {ITYPE}, {ITYPENAME} : Used to generate CPP statements for the specific type. +# {MPITYPE} : Used to generate MPI types corresponding to the specific type. +# +# {DIMS} : Rank of arrays, "0" for scalar. +# allowed values: 0-7 +# default values : 0-5 +# {DIMSTR} : Generates the parenthesis and colons used for a variable +# declaration of {DIMS} dimensions. +# if {DIMS}=3 then {DIMSTR} is (:,:,:) +# {REPEAT} : Repeats an expression for each number from 1 to {DIMS}, with each +# iteration separated by commas. +# {REPEAT: foo(#, bar)} +# expands to this: +# foo(1, bar), foo(2, bar), foo(3, bar), ... + +# defaults +my @types = qw(text real double int); +my $vtype = {'text' => 'character(len=*)', + 'real' => 'real(r4)', + 'double' => 'real(r8)', + 'int' => 'integer(i4)', + 'long' => 'integer(i8)', + 'logical' => 'logical' }; +my $itype = {'text' => 100, + 'real' => 101, + 'double' => 102, + 'int' => 103, + 'long' => 104, + 'logical' => 105}; +my $itypename = {'text' => 'TYPETEXT', + 'real' => 'TYPEREAL', + 'double' => 'TYPEDOUBLE', + 'int' => 'TYPEINT', + 'long' => 'TYPELONG', + 'logical' => 'TYPELOGICAL'}; +my $mpitype = {'text' => 'MPI_CHARACTER', + 'real' => 'MPI_REAL4', + 'double' => 'MPI_REAL8', + 'int' => 'MPI_INTEGER'}; +# Netcdf C datatypes +my $nctype = {'text' => 'text', + 'real' => 'float', + 'double' => 'double', + 'int' => 'int'}; +# C interoperability types +my $ctype = {'text' => 'character(C_CHAR)', + 'real' => 'real(C_FLOAT)', + 'double' => 'real(C_DOUBLE)', + 'int' => 'integer(C_INT)'}; + + + +my @dims =(0..5); + +my $write_dtypes = "no"; +# begin + +foreach(@ARGV){ + my $infile = $_; + usage() unless($infile =~ /(.*.F90).in/); + $outfile = $1; + open(F,"$infile") || die "$0 Could not open $infile to read"; + my @parsetext; + my $cnt=0; + foreach(){ + $cnt++; + if(/^\s*contains/i){ + push(@parsetext,"# $cnt \"$infile\"\n"); + } + if(/^\s*interface/i){ + push(@parsetext,"# $cnt \"$infile\"\n"); + } + if(/^[^!]*subroutine/i){ + push(@parsetext,"# $cnt \"$infile\"\n"); + } + if(/^[^!]*function/i){ + push(@parsetext,"# $cnt \"$infile\"\n"); + } + + push(@parsetext,$_); + } + + close(F); + + my $end; + my $contains=0; + my $in_type_block=0; + my @unit; + my $unitcnt=0; + my $date = localtime(); + my $preamble = +"!=================================================== +! DO NOT EDIT THIS FILE, it was generated using $0 +! Any changes you make to this file may be lost +!===================================================\n"; + my @output ; + push(@output,$preamble); + + my $line; + my $dimmodifier; + my $typemodifier; + my $itypeflag; + my $block; + my $block_type; + my $cppunit; + foreach $line (@parsetext){ +# skip parser comments + next if($line =~ /\s*!pl/); + + $itypeflag=1 if($line =~ /{ITYPE}/); + $itypeflag=1 if($line =~ /TYPETEXT/); + $itypeflag=1 if($line =~ /TYPEREAL/); + $itypeflag=1 if($line =~ /TYPEDOUBLE/); + $itypeflag=1 if($line =~ /TYPEINT/); + $itypeflag=1 if($line =~ /TYPELONG/); + + + if($contains==0){ + if($line=~/\s*!\s*DIMS\s+[\d,]+!*/){ + $dimmodifier=$line; + next; + } + if($line=~/\s*!\s*TYPE\s+[^!]+!*$/){ + $typemodifier=$line; + next; + } + if ((defined $typemodifier or defined $dimmodifier) + and not defined $block and $line=~/^\s*#[^{]*$/) { + push(@output, $line); + next; + } + # Figure out the bounds of a type statement. + # Type blocks start with "type," "type foo" or "type::" but not + # "type(". + $in_type_block=1 if($line=~/^\s*type\s*[,:[:alpha:]]/i); + $in_type_block=0 if($line=~/^\s*end\s*type/i); + if(not defined $block) { + if ($line=~/^\s*type[^[:alnum:]_].*(\{TYPE\}|\{DIMS\})/i or + $line=~/^[^!]*(function|subroutine).*(\{TYPE\}|\{DIMS\})/i) { + $block=$line; + next; + } + if ($line=~/^\s*interface.*(\{TYPE\}|\{DIMS\})/i) { + $block_type="interface"; + $block=$line; + next; + } + } + if(not defined $block_type and + ($line=~/^\s*end\s+type\s+.*(\{TYPE\}|\{DIMS\})/i or + $line=~/^\s*end\s+(function|subroutine)\s+.*(\{TYPE\}|\{DIMS\})/i)){ + + $line = $block.$line; + undef $block; + } + if ($line=~/^\s*end\s*interface/i and + defined $block) { + $line = $block.$line; + undef $block; + undef $block_type; + } + if(defined $block){ + $block = $block.$line; + next; + } + if(defined $dimmodifier){ + $line = $dimmodifier.$line; + undef $dimmodifier; + } + if(defined $typemodifier){ + $line = $typemodifier.$line; + undef $typemodifier; + } + + push(@output, buildout($line)); + if(($line =~ /^\s*contains\s*!*/i && ! $in_type_block) or + ($line =~ /^\s*!\s*Not a module/i)){ + $contains=1; + next; + } + } + if($line=~/^\s*end module\s*/){ + $end = $line; + last; + } + + if($contains==1){ + # first parse into functions or subroutines + if($cppunit || !(defined($unit[$unitcnt]))){ + # Make cpp lines and blanks between routines units. + if($line =~ /^\s*\#(?!\s[[:digit:]]+)/ || $line =~/^\s*$/ || $line=~/^\s*!(?!\s*(TYPE|DIMS))/){ + push(@{$unit[$unitcnt]},$line); + $cppunit=1; + next; + } else { + $cppunit=0; + $unitcnt++; + } + } + + + push(@{$unit[$unitcnt]},$line); + if ($line=~/^\s*interface/i) { + $block_type="interface"; + $block=$line; + } + if ($line=~/^\s*end\s*interface/i) { + undef $block_type; + undef $block; + } + unless(defined $block){ + if($line =~ /\s*end function/i or $line =~ /\s*end subroutine/i){ + $unitcnt++; + } + } + } + } + my $i; + + + for($i=0;$i<$unitcnt;$i++){ + if(defined($unit[$i])){ + my $func = join('',@{$unit[$i]}); + push(@output, buildout($func)); + } + } + push(@output,@{$unit[$#unit]}) if($unitcnt==$#unit); + push(@output, $end); + if($itypeflag==1){ + my $str; + $str.="#include \"dtypes.h\"\n"; + $write_dtypes = "yes"; + print $str; + } + print @output; + writedtypes() if(!(-e "dtypes.h") && $write_dtypes == "yes"); + + +} + + +sub usage{ + die("$0 Expected input filename of the form .*.F90.in"); +} + +sub build_repeatstr{ + my($dims) = @_; + # Create regex to repeat expression DIMS times. + my $repeatstr; + for(my $i=1;$i<=$dims;$i++){ + $repeatstr .="\$\{1\}$i\$\{2\},&\n"; + } + if(defined $repeatstr){ + $repeatstr="\"$repeatstr"; + chop $repeatstr; + chop $repeatstr; + chop $repeatstr; + $repeatstr.="\""; + }else{ + $repeatstr=''; + } +} + +sub writedtypes{ + open(F,">dtypes.h"); + print F +"#define TYPETEXT 100 +#define TYPEREAL 101 +#define TYPEDOUBLE 102 +#define TYPEINT 103 +#define TYPELONG 104 +#define TYPELOGICAL 105 +"; + close(F); +} + +sub buildout{ + my ($func) = @_; + + my $outstr; + my(@ldims, @ltypes); + + if($func=~/\s*!\s*DIMS\s+([\d,]+)\s*/){ + @ldims = split(/,/,$1); + }else{ + @ldims = @dims; + } + if($func=~/\s*!\s*TYPE\s+([^!\s]+)\s*/){ + @ltypes = split(/,/,$1); +# print ">$func<>@ltypes<\n"; + }else{ + @ltypes = @types; + } + + + if(($func =~ /{TYPE}/ && $func =~ /{DIMS}/) ){ + my ($type, $dims); + foreach $type (@ltypes){ + foreach $dims (@ldims){ + my $dimstr; + for(my $i=1;$i<=$dims;$i++){ + $dimstr .=':,'; + } + if(defined $dimstr){ + $dimstr="($dimstr"; + chop $dimstr; + $dimstr.=')'; + }else{ + $dimstr=''; + } + + my $repeatstr = build_repeatstr($dims); + + my $str = $func; + $str =~ s/{TYPE}/$type/g; + $str =~ s/{VTYPE}/$vtype->{$type}/g; + $str =~ s/{ITYPE}/$itype->{$type}/g; + $str =~ s/{MPITYPE}/$mpitype->{$type}/g; + $str =~ s/{NCTYPE}/$nctype->{$type}/g; + $str =~ s/{CTYPE}/$ctype->{$type}/g; + $str =~ s/{DIMS}/$dims/g; + $str =~ s/{DIMSTR}/$dimstr/g; + $str =~ s/{REPEAT:([^#}]*)#([^#}]*)}/$repeatstr/eeg; + $outstr .= $str; + } + } + }elsif($func =~ /{DIMS}/){ + my $dims; + foreach $dims (@ldims){ + my $dimstr; + for(my $i=1;$i<=$dims;$i++){ + $dimstr .=':,'; + } + if(defined $dimstr){ + $dimstr="($dimstr"; + chop $dimstr; + $dimstr.=')'; + }else{ + $dimstr=''; + } + + my $repeatstr = build_repeatstr($dims); + + my $str = $func; + $str =~ s/{DIMS}/$dims/g; + $str =~ s/{DIMSTR}/$dimstr/g; + $str =~ s/{REPEAT:([^#}]*)#([^#}]*)}/$repeatstr/eeg; + $outstr .= $str; + } + }elsif($func =~ /{TYPE}/){ + my ($type); + foreach $type (@ltypes){ + my $str = $func; + $str =~ s/{TYPE}/$type/g; + $str =~ s/{VTYPE}/$vtype->{$type}/g; + $str =~ s/{ITYPE}/$itype->{$type}/g; + $str =~ s/{MPITYPE}/$mpitype->{$type}/g; + $str =~ s/{NCTYPE}/$nctype->{$type}/g; + $str =~ s/{CTYPE}/$ctype->{$type}/g; + $outstr.=$str; + } + }else{ + $outstr=$func; + } + + return $outstr; +} diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in similarity index 97% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in index 6cf057dde..fc62d64ba 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in @@ -16,7 +16,7 @@ module shr_assert_mod use shr_infnan_mod, only: shr_infnan_isnan -!use shr_strconvert_mod, only: toString +use shr_strconvert_mod, only: toString implicit none private @@ -79,17 +79,14 @@ subroutine shr_assert(var, msg, file, line) character(len=*), intent(in), optional :: file integer , intent(in), optional :: line - character(len=40) :: line_str character(len=:), allocatable :: full_msg - - full_msg = '' + if (.not. var) then full_msg = 'ERROR' if (present(file)) then full_msg = full_msg // ' in ' // trim(file) if (present(line)) then - write(line_str, '(i40)') line - full_msg = full_msg // ' at line ' // trim(line_str) + full_msg = full_msg // ' at line ' // toString(line) end if end if if (present(msg)) then @@ -146,7 +143,7 @@ subroutine shr_assert_in_domain_{DIMS}d_{TYPE}(var, varname, msg, & ! Flag for floating point types. -#if (({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE)) +#if ({ITYPE} == TYPEREAL) || ({ITYPE} == TYPEDOUBLE) #define TYPEFP #else #undef TYPEFP @@ -155,7 +152,7 @@ subroutine shr_assert_in_domain_{DIMS}d_{TYPE}(var, varname, msg, & ! "Generalized" macro functions allow transformational intrinsic functions ! to handle both scalars and arrays. -#if ({DIMS} != 0) +#if ({DIMS} != 0) ! When given an array, use the intrinsics. #define GEN_SIZE(x) size(x) #define GEN_ALL(x) all(x) @@ -359,7 +356,7 @@ subroutine print_bad_loc_{DIMS}d_{TYPE}(var, loc_vec, varname) write(shr_log_Unit,*) & "ERROR: shr_assert_in_domain: ",trim(varname_to_write), & " has invalid value ", & -#if ({DIMS} != 0) +#if ({DIMS} != 0) var({REPEAT:loc_vec(#)}), & " at location: ",loc_vec #else @@ -383,7 +380,7 @@ pure function find_first_loc_{DIMS}d(mask) result (loc_vec) logical, intent(in) :: mask{DIMSTR} integer :: loc_vec({DIMS}) -#if ({DIMS} != 0) +#if ({DIMS} != 0) integer :: flags({REPEAT:size(mask,#)}) where (mask) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 deleted file mode 100755 index 6d9ce27e2..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90 +++ /dev/null @@ -1,386 +0,0 @@ -module shr_infnan_mod -!--------------------------------------------------------------------- -! Module to test for IEEE Inf and NaN values, which also provides a -! method of setting +/-Inf and signaling or quiet NaN. -! -! All functions are elemental, and thus work on arrays. -!--------------------------------------------------------------------- -! To test for these values, just call the corresponding function, e.g: -! -! var_is_nan = shr_infnan_isnan(x) -! -! You can also use it on arrays: -! -! array_contains_nan = any(shr_infnan_isnan(my_array)) -! -!--------------------------------------------------------------------- -! To generate these values, assign one of the provided derived-type -! variables to a real: -! -! use shr_infnan_mod, only: nan => shr_infnan_nan, & -! inf => shr_infnan_inf, & -! assignment(=) -! real(r4) :: my_nan -! real(r8) :: my_inf_array(2,2) -! my_nan = nan -! my_inf_array = inf -! -! Keep in mind that "shr_infnan_nan" and "shr_infnan_inf" cannot be -! passed to functions that expect real arguments. To pass a real -! NaN, you will have to use shr_infnan_nan to set a local real of -! the correct kind. -!--------------------------------------------------------------------- - -use shr_kind_mod, only: & - r4 => SHR_KIND_R4, & - r8 => SHR_KIND_R8 - -! If we have IEEE_ARITHMETIC, the NaN test is provided for us. -use, intrinsic :: ieee_arithmetic, only: & - shr_infnan_isnan => ieee_is_nan - -! Integers of correct size for bit patterns below. -use shr_kind_mod, only: i4 => shr_kind_i4, i8 => shr_kind_i8 - - -implicit none -private -save - -! Test functions for NaN/Inf values. -!public :: shr_infnan_isnan -!!public :: shr_infnan_isinf -!!public :: shr_infnan_isposinf -!!public :: shr_infnan_isneginf -!! -!!! Locally defined isnan. -!#ifndef HAVE_IEEE_ARITHMETIC -!interface shr_infnan_isnan -! ! TYPE double,real -! module procedure shr_infnan_isnan_{TYPE} -!end interface -!#endif -!! -!!interface shr_infnan_isinf -!! ! TYPE double,real -!! module procedure shr_infnan_isinf_{TYPE} -!!end interface -!! -!!interface shr_infnan_isposinf -!! ! TYPE double,real -!! module procedure shr_infnan_isposinf_{TYPE} -!!end interface -!! -!!interface shr_infnan_isneginf -!! ! TYPE double,real -!! module procedure shr_infnan_isneginf_{TYPE} -!!end interface -!! -!!! Derived types for generation of NaN/Inf -!!! Even though there's no reason to "use" the types directly, some compilers -!!! might have trouble with an object being used without its type. -!public :: shr_infnan_nan_type -!!public :: shr_infnan_inf_type -!!public :: assignment(=) -!!public :: shr_infnan_to_r4 -!!public :: shr_infnan_to_r8 -!! -!!! Type representing Not A Number. -!type :: shr_infnan_nan_type -! logical :: quiet = .false. -!end type shr_infnan_nan_type -!! -!!! Type representing +/-Infinity. -!!type :: shr_infnan_inf_type -!! logical :: positive = .true. -!!end type shr_infnan_inf_type -!! -!!! Allow assigning reals to NaN or Inf. -!!interface assignment(=) -!! ! TYPE double,real -!! ! DIMS 0,1,2,3,4,5,6,7 -!! module procedure set_nan_new -!! ! TYPE double,real -!! ! DIMS 0,1,2,3,4,5,6,7 -!! ! module procedure set_inf_{DIMS}d_{TYPE} -!!end interface -!! -!!! Conversion functions. -!!interface shr_infnan_to_r8 -!! module procedure nan_r8 -!! module procedure inf_r8 -!!end interface -!! -!!interface shr_infnan_to_r4 -!! module procedure nan_r4 -!! module procedure inf_r4 -!!end interface -!! -!!! Initialize objects of NaN/Inf type for other modules to use. -!! -!!! Default NaN is signaling, but also provide snan and qnan to choose -!!! explicitly. -!type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & -! shr_infnan_nan_type(.false.) -!type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & -! shr_infnan_nan_type(.false.) -!type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & -! shr_infnan_nan_type(.true.) -!! -!!! Default Inf is positive, but provide posinf to go with neginf. -!!type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & -!! shr_infnan_inf_type(.true.) -!!type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & -!! shr_infnan_inf_type(.true.) -!!type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & -!! shr_infnan_inf_type(.false.) -!! -!!! Bit patterns for implementation without ieee_arithmetic. -!!! Note that in order to satisfy gfortran's range check, we have to use -!!! ibset to set the sign bit from a BOZ pattern. -!#ifndef HAVE_IEEE_ARITHMETIC -!! Single precision. -!integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) -!integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) -!integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) -!integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) -!! Double precision. -!integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) -!integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) -!integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) -!integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) -!#endif -!! -!contains -!! -!!!--------------------------------------------------------------------- -!!! TEST FUNCTIONS -!!!--------------------------------------------------------------------- -!!! The "isinf" function simply calls "isposinf" and "isneginf". -!!!--------------------------------------------------------------------- -!! -!!! TYPE double,real -!!elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) -!! {VTYPE}, intent(in) :: x -!! logical :: isinf -!! -!! isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) -!! -!!end function shr_infnan_isinf_{TYPE} -!! -!!#ifdef HAVE_IEEE_ARITHMETIC -!! -!!!--------------------------------------------------------------------- -!!! The "isposinf" and "isneginf" functions get the IEEE class of a -!!! real, and test to see if the class is equal to ieee_positive_inf -!!! or ieee_negative_inf. -!!!--------------------------------------------------------------------- -!! -!!! TYPE double,real -!!elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) -!! use, intrinsic :: ieee_arithmetic, only: & -!! ieee_class, & -!! ieee_positive_inf, & -!! operator(==) -!! {VTYPE}, intent(in) :: x -!! logical :: isposinf -!! -!! isposinf = (ieee_positive_inf == ieee_class(x)) -!! -!!end function shr_infnan_isposinf_{TYPE} -!! -!!! TYPE double,real -!!elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) -!! use, intrinsic :: ieee_arithmetic, only: & -!! ieee_class, & -!! ieee_negative_inf, & -!! operator(==) -!! {VTYPE}, intent(in) :: x -!! logical :: isneginf -!! -!! isneginf = (ieee_negative_inf == ieee_class(x)) -!! -!!end function shr_infnan_isneginf_{TYPE} -!! -!!#else -!!! Don't have ieee_arithmetic. -!! -!! NaN testing on gfortran. -!! TYPE double,real -!elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) -! {VTYPE}, intent(in) :: x -! logical :: is_nan -! -! is_nan = isnan(x) -! -!end function shr_infnan_isnan_{TYPE} -!! End GNU section. -!!!--------------------------------------------------------------------- -!!! The "isposinf" and "isneginf" functions just test against a known -!!! bit pattern if we don't have ieee_arithmetic. -!!!--------------------------------------------------------------------- -!! -!!! TYPE double,real -!!elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) -!! {VTYPE}, intent(in) :: x -!! logical :: isposinf -!!#if ({ITYPE} == TYPEREAL) -!! integer(i4), parameter :: posinf_pat = sposinf_pat -!!#else -!! integer(i8), parameter :: posinf_pat = dposinf_pat -!!#endif -!! -!! isposinf = (x == transfer(posinf_pat,x)) -!! -!!end function shr_infnan_isposinf_{TYPE} -!! -!!! TYPE double,real -!!elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) -!! {VTYPE}, intent(in) :: x -!! logical :: isneginf -!!#if ({ITYPE} == TYPEREAL) -!! integer(i4), parameter :: neginf_pat = sneginf_pat -!!#else -!! integer(i8), parameter :: neginf_pat = dneginf_pat -!!#endif -!! -!! isneginf = (x == transfer(neginf_pat,x)) -!! -!!end function shr_infnan_isneginf_{TYPE} -!! -!!! End ieee_arithmetic conditional. -!!#endif -!! -!!!--------------------------------------------------------------------- -!!! GENERATION FUNCTIONS -!!!--------------------------------------------------------------------- -!!! Two approaches for generation of NaN and Inf values: -!!! 1. With Fortran 2003, use the ieee_value intrinsic to get a value -!!! from the corresponding class. These are: -!!! - ieee_signaling_nan -!!! - ieee_quiet_nan -!!! - ieee_positive_inf -!!! - ieee_negative_inf -!!! 2. Without Fortran 2003, set the IEEE bit patterns directly. -!!! Use BOZ literals to get an integer with the correct bit -!!! pattern, then use "transfer" to transfer those bits into a -!!! real. -!!!--------------------------------------------------------------------- -!! -!!! TYPE double,real -!!! DIMS 0,1,2,3,4,5,6,7 -!!subroutine set_nan_new -!!#ifdef HAVE_IEEE_ARITHMETIC -!! use, intrinsic :: ieee_arithmetic, only: & -!! ieee_signaling_nan, & -!! ieee_quiet_nan, & -!! ieee_value -!!#endif -!! public :: inf, nan, bigint -!!! signaling nan -!! real*8, parameter :: inf8 = O'0777600000000000000000' -!! real*8, parameter :: nan8 = O'0777610000000000000000' -!! real*4, parameter :: inf4 = O'17740000000' -!! real*4, parameter :: nan4 = O'17760000000' -!! real, parameter :: inf = inf4 -!! real, parameter :: nan = nan4 -!! integer, parameter :: bigint = O'17777777777' -!! type(shr_infnan_nan_type), intent(in) :: nan -!! -!! ! Use scalar temporary for performance reasons, to reduce the cost of -!! ! the ieee_value call. -!! {VTYPE} :: tmp -!! -!!#ifdef HAVE_IEEE_ARITHMETIC -!! if (nan%quiet) then -!! tmp = ieee_value(tmp, ieee_quiet_nan) -!! else -!! tmp = ieee_value(tmp, ieee_signaling_nan) -!! end if -!!#endif -!! -!! output = tmp -!! -!!end subroutine set_nan_new -!! -!!! TYPE double,real -!!! DIMS 0,1,2,3,4,5,6,7 -!!pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) -!!#ifdef HAVE_IEEE_ARITHMETIC -!! use, intrinsic :: ieee_arithmetic, only: & -!! ieee_positive_inf, & -!! ieee_negative_inf, & -!! ieee_value -!!#else -!!#if ({ITYPE} == TYPEREAL) -!! integer(i4), parameter :: posinf_pat = sposinf_pat -!! integer(i4), parameter :: neginf_pat = sneginf_pat -!!#else -!! integer(i8), parameter :: posinf_pat = dposinf_pat -!! integer(i8), parameter :: neginf_pat = dneginf_pat -!!#endif -!!#endif -!! {VTYPE}, intent(out) :: output{DIMSTR} -!! type(shr_infnan_inf_type), intent(in) :: inf -!! -!! ! Use scalar temporary for performance reasons, to reduce the cost of -!! ! the ieee_value call. -!! {VTYPE} :: tmp -!! -!!#ifdef HAVE_IEEE_ARITHMETIC -!! if (inf%positive) then -!! tmp = ieee_value(tmp,ieee_positive_inf) -!! else -!! tmp = ieee_value(tmp,ieee_negative_inf) -!! end if -!!#else -!! if (inf%positive) then -!! tmp = transfer(posinf_pat, tmp) -!! else -!! tmp = transfer(neginf_pat, tmp) -!! end if -!!#endif -!! -!! output = tmp -!! -!!end subroutine set_inf_{DIMS}d_{TYPE} -!! -!!!--------------------------------------------------------------------- -!!! CONVERSION INTERFACES. -!!!--------------------------------------------------------------------- -!!! Function methods to get reals from nan/inf types. -!!!--------------------------------------------------------------------- -!! -!pure function nan_r8(nan) result(output) -! class(shr_infnan_nan_type), intent(in) :: nan -! real(r8) :: output -! -! output = nan -! -!end function nan_r8 -! -!pure function nan_r4(nan) result(output) -! class(shr_infnan_nan_type), intent(in) :: nan -! real(r4) :: output -! -! output = nan -! -!end function nan_r4 -!! -!!pure function inf_r8(inf) result(output) -!! class(shr_infnan_inf_type), intent(in) :: inf -!! real(r8) :: output -!! -!! output = inf -!! -!!end function inf_r8 -!! -!!pure function inf_r4(inf) result(output) -!! class(shr_infnan_inf_type), intent(in) :: inf -!! real(r4) :: output -!! -!! output = inf -!! -!!end function inf_r4 - -end module shr_infnan_mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in new file mode 100755 index 000000000..eef3e607d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_infnan_mod.F90.in @@ -0,0 +1,406 @@ +! Flag representing compiler support of Fortran 2003's +! ieee_arithmetic intrinsic module. +!if defined CPRIBM || defined CPRPGI || defined CPRINTEL || defined CPRCRAY || defined CPRNAG +#define HAVE_IEEE_ARITHMETIC +!endif + +module shr_infnan_mod +!--------------------------------------------------------------------- +! Module to test for IEEE Inf and NaN values, which also provides a +! method of setting +/-Inf and signaling or quiet NaN. +! +! All functions are elemental, and thus work on arrays. +!--------------------------------------------------------------------- +! To test for these values, just call the corresponding function, e.g: +! +! var_is_nan = shr_infnan_isnan(x) +! +! You can also use it on arrays: +! +! array_contains_nan = any(shr_infnan_isnan(my_array)) +! +!--------------------------------------------------------------------- +! To generate these values, assign one of the provided derived-type +! variables to a real: +! +! use shr_infnan_mod, only: nan => shr_infnan_nan, & +! inf => shr_infnan_inf, & +! assignment(=) +! real(r4) :: my_nan +! real(r8) :: my_inf_array(2,2) +! my_nan = nan +! my_inf_array = inf +! +! Keep in mind that "shr_infnan_nan" and "shr_infnan_inf" cannot be +! passed to functions that expect real arguments. To pass a real +! NaN, you will have to use shr_infnan_nan to set a local real of +! the correct kind. +!--------------------------------------------------------------------- + +use shr_kind_mod, only: & + r4 => SHR_KIND_R4, & + r8 => SHR_KIND_R8 + +#ifdef HAVE_IEEE_ARITHMETIC + +! If we have IEEE_ARITHMETIC, the NaN test is provided for us. +use, intrinsic :: ieee_arithmetic, only: & + shr_infnan_isnan => ieee_is_nan + +#else + +! Integers of correct size for bit patterns below. +use shr_kind_mod, only: i4 => shr_kind_i4, i8 => shr_kind_i8 + +#endif + +implicit none +private +save + +! Test functions for NaN/Inf values. +public :: shr_infnan_isnan +public :: shr_infnan_isinf +public :: shr_infnan_isposinf +public :: shr_infnan_isneginf + +! Locally defined isnan. +#ifndef HAVE_IEEE_ARITHMETIC +interface shr_infnan_isnan + ! TYPE double,real + module procedure shr_infnan_isnan_{TYPE} +end interface +#endif + +interface shr_infnan_isinf + ! TYPE double,real + module procedure shr_infnan_isinf_{TYPE} +end interface + +interface shr_infnan_isposinf + ! TYPE double,real + module procedure shr_infnan_isposinf_{TYPE} +end interface + +interface shr_infnan_isneginf + ! TYPE double,real + module procedure shr_infnan_isneginf_{TYPE} +end interface + +! Derived types for generation of NaN/Inf +! Even though there's no reason to "use" the types directly, some compilers +! might have trouble with an object being used without its type. +public :: shr_infnan_nan_type +public :: shr_infnan_inf_type +public :: assignment(=) +public :: shr_infnan_to_r4 +public :: shr_infnan_to_r8 + +! Type representing Not A Number. +type :: shr_infnan_nan_type + logical :: quiet = .false. +end type shr_infnan_nan_type + +! Type representing +/-Infinity. +type :: shr_infnan_inf_type + logical :: positive = .true. +end type shr_infnan_inf_type + +! Allow assigning reals to NaN or Inf. +interface assignment(=) + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 + module procedure set_nan_{DIMS}d_{TYPE} + ! TYPE double,real + ! DIMS 0,1,2,3,4,5,6,7 + module procedure set_inf_{DIMS}d_{TYPE} +end interface + +! Conversion functions. +interface shr_infnan_to_r8 + module procedure nan_r8 + module procedure inf_r8 +end interface + +interface shr_infnan_to_r4 + module procedure nan_r4 + module procedure inf_r4 +end interface + +! Initialize objects of NaN/Inf type for other modules to use. + +! Default NaN is signaling, but also provide snan and qnan to choose +! explicitly. +type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = & + shr_infnan_nan_type(.false.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = & + shr_infnan_nan_type(.false.) +type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = & + shr_infnan_nan_type(.true.) + +! Default Inf is positive, but provide posinf to go with neginf. +type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = & + shr_infnan_inf_type(.true.) +type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = & + shr_infnan_inf_type(.true.) +type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = & + shr_infnan_inf_type(.false.) + +! Bit patterns for implementation without ieee_arithmetic. +! Note that in order to satisfy gfortran's range check, we have to use +! ibset to set the sign bit from a BOZ pattern. +#ifndef HAVE_IEEE_ARITHMETIC +! Single precision. +integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4) +integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4) +integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4) +integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1) +! Double precision. +integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8) +integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8) +integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8) +integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1) +#endif + +contains + +!--------------------------------------------------------------------- +! TEST FUNCTIONS +!--------------------------------------------------------------------- +! The "isinf" function simply calls "isposinf" and "isneginf". +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isinf_{TYPE}(x) result(isinf) + {VTYPE}, intent(in) :: x + logical :: isinf + + isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x) + +end function shr_infnan_isinf_{TYPE} + +#ifdef HAVE_IEEE_ARITHMETIC + +!--------------------------------------------------------------------- +! The "isposinf" and "isneginf" functions get the IEEE class of a +! real, and test to see if the class is equal to ieee_positive_inf +! or ieee_negative_inf. +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) + use, intrinsic :: ieee_arithmetic, only: & + ieee_class, & + ieee_positive_inf, & + operator(==) + {VTYPE}, intent(in) :: x + logical :: isposinf + + isposinf = (ieee_positive_inf == ieee_class(x)) + +end function shr_infnan_isposinf_{TYPE} + +! TYPE double,real +elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) + use, intrinsic :: ieee_arithmetic, only: & + ieee_class, & + ieee_negative_inf, & + operator(==) + {VTYPE}, intent(in) :: x + logical :: isneginf + + isneginf = (ieee_negative_inf == ieee_class(x)) + +end function shr_infnan_isneginf_{TYPE} + +#else +! Don't have ieee_arithmetic. + +#ifdef CPRGNU +! NaN testing on gfortran. +! TYPE double,real +elemental function shr_infnan_isnan_{TYPE}(x) result(is_nan) + {VTYPE}, intent(in) :: x + logical :: is_nan + + is_nan = isnan(x) + +end function shr_infnan_isnan_{TYPE} +! End GNU section. +#endif + +!--------------------------------------------------------------------- +! The "isposinf" and "isneginf" functions just test against a known +! bit pattern if we don't have ieee_arithmetic. +!--------------------------------------------------------------------- + +! TYPE double,real +elemental function shr_infnan_isposinf_{TYPE}(x) result(isposinf) + {VTYPE}, intent(in) :: x + logical :: isposinf +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: posinf_pat = sposinf_pat +#else + integer(i8), parameter :: posinf_pat = dposinf_pat +#endif + + isposinf = (x == transfer(posinf_pat,x)) + +end function shr_infnan_isposinf_{TYPE} + +! TYPE double,real +elemental function shr_infnan_isneginf_{TYPE}(x) result(isneginf) + {VTYPE}, intent(in) :: x + logical :: isneginf +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: neginf_pat = sneginf_pat +#else + integer(i8), parameter :: neginf_pat = dneginf_pat +#endif + + isneginf = (x == transfer(neginf_pat,x)) + +end function shr_infnan_isneginf_{TYPE} + +! End ieee_arithmetic conditional. +#endif + +!--------------------------------------------------------------------- +! GENERATION FUNCTIONS +!--------------------------------------------------------------------- +! Two approaches for generation of NaN and Inf values: +! 1. With Fortran 2003, use the ieee_value intrinsic to get a value +! from the corresponding class. These are: +! - ieee_signaling_nan +! - ieee_quiet_nan +! - ieee_positive_inf +! - ieee_negative_inf +! 2. Without Fortran 2003, set the IEEE bit patterns directly. +! Use BOZ literals to get an integer with the correct bit +! pattern, then use "transfer" to transfer those bits into a +! real. +!--------------------------------------------------------------------- + +! TYPE double,real +! DIMS 0,1,2,3,4,5,6,7 +pure subroutine set_nan_{DIMS}d_{TYPE}(output, nan) +#ifdef HAVE_IEEE_ARITHMETIC + use, intrinsic :: ieee_arithmetic, only: & + ieee_signaling_nan, & + ieee_quiet_nan, & + ieee_value +#else +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: snan_pat = ssnan_pat + integer(i4), parameter :: qnan_pat = sqnan_pat +#else + integer(i8), parameter :: snan_pat = dsnan_pat + integer(i8), parameter :: qnan_pat = dqnan_pat +#endif +#endif + {VTYPE}, intent(out) :: output{DIMSTR} + type(shr_infnan_nan_type), intent(in) :: nan + + ! Use scalar temporary for performance reasons, to reduce the cost of + ! the ieee_value call. + {VTYPE} :: tmp + +#ifdef HAVE_IEEE_ARITHMETIC + if (nan%quiet) then + tmp = ieee_value(tmp, ieee_quiet_nan) + else + tmp = ieee_value(tmp, ieee_signaling_nan) + end if +#else + if (nan%quiet) then + tmp = transfer(qnan_pat, tmp) + else + tmp = transfer(snan_pat, tmp) + end if +#endif + + output = tmp + +end subroutine set_nan_{DIMS}d_{TYPE} + +! TYPE double,real +! DIMS 0,1,2,3,4,5,6,7 +pure subroutine set_inf_{DIMS}d_{TYPE}(output, inf) +#ifdef HAVE_IEEE_ARITHMETIC + use, intrinsic :: ieee_arithmetic, only: & + ieee_positive_inf, & + ieee_negative_inf, & + ieee_value +#else +#if ({ITYPE} == TYPEREAL) + integer(i4), parameter :: posinf_pat = sposinf_pat + integer(i4), parameter :: neginf_pat = sneginf_pat +#else + integer(i8), parameter :: posinf_pat = dposinf_pat + integer(i8), parameter :: neginf_pat = dneginf_pat +#endif +#endif + {VTYPE}, intent(out) :: output{DIMSTR} + type(shr_infnan_inf_type), intent(in) :: inf + + ! Use scalar temporary for performance reasons, to reduce the cost of + ! the ieee_value call. + {VTYPE} :: tmp + +#ifdef HAVE_IEEE_ARITHMETIC + if (inf%positive) then + tmp = ieee_value(tmp,ieee_positive_inf) + else + tmp = ieee_value(tmp,ieee_negative_inf) + end if +#else + if (inf%positive) then + tmp = transfer(posinf_pat, tmp) + else + tmp = transfer(neginf_pat, tmp) + end if +#endif + + output = tmp + +end subroutine set_inf_{DIMS}d_{TYPE} + +!--------------------------------------------------------------------- +! CONVERSION INTERFACES. +!--------------------------------------------------------------------- +! Function methods to get reals from nan/inf types. +!--------------------------------------------------------------------- + +pure function nan_r8(nan) result(output) + class(shr_infnan_nan_type), intent(in) :: nan + real(r8) :: output + + output = nan + +end function nan_r8 + +pure function nan_r4(nan) result(output) + class(shr_infnan_nan_type), intent(in) :: nan + real(r4) :: output + + output = nan + +end function nan_r4 + +pure function inf_r8(inf) result(output) + class(shr_infnan_inf_type), intent(in) :: inf + real(r8) :: output + + output = inf + +end function inf_r8 + +pure function inf_r4(inf) result(output) + class(shr_infnan_inf_type), intent(in) :: inf + real(r4) :: output + + output = inf + +end function inf_r4 + +end module shr_infnan_mod From 44c6e06c1be511b05d911c4f2b7c84ae430da401 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 28 Nov 2022 19:52:22 -0500 Subject: [PATCH 112/589] replace toString function --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in index fc62d64ba..d683193dc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_assert_mod.F90.in @@ -16,7 +16,7 @@ use shr_log_mod, only: & use shr_infnan_mod, only: shr_infnan_isnan -use shr_strconvert_mod, only: toString +!use shr_strconvert_mod, only: toString implicit none private @@ -79,6 +79,7 @@ subroutine shr_assert(var, msg, file, line) character(len=*), intent(in), optional :: file integer , intent(in), optional :: line + character(len=40) :: line_str character(len=:), allocatable :: full_msg if (.not. var) then @@ -86,7 +87,8 @@ subroutine shr_assert(var, msg, file, line) if (present(file)) then full_msg = full_msg // ' in ' // trim(file) if (present(line)) then - full_msg = full_msg // ' at line ' // toString(line) + write(line_str, '(i40)') line + full_msg = full_msg // ' at line ' // trim(line_str) end if end if if (present(msg)) then From fa415cf2c3af10925392095809c097549dcb8c54 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 28 Nov 2022 20:35:15 -0500 Subject: [PATCH 113/589] commenting out unnecessary functions --- .../CLM51/paramUtilMod.F90 | 308 +++++++++--------- 1 file changed, 154 insertions(+), 154 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 index ac6845fc0..3efe0a175 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 @@ -11,21 +11,21 @@ module paramUtilMod module procedure readNcdioScalar module procedure readNcdioArray1d module procedure readNcdioArray2d - module procedure readNcdioScalarCheckDimensions - module procedure readNcdioArray1dCheckDimensions - module procedure readNcdioArray2dCheckDimensions +! module procedure readNcdioScalarCheckDimensions +! module procedure readNcdioArray1dCheckDimensions +! module procedure readNcdioArray2dCheckDimensions end interface public :: readNcdioScalar public :: readNcdioArray1d public :: readNcdioArray2d - public :: readNcdioScalarCheckDimensions - public :: readNcdioArray1dCheckDimensions - public :: readNcdioArray2dCheckDimensions +! public :: readNcdioScalarCheckDimensions +! public :: readNcdioArray1dCheckDimensions +! public :: readNcdioArray2dCheckDimensions public :: readNcdio - private :: checkDimensions +! private :: checkDimensions contains !----------------------------------------------------------------------- @@ -139,153 +139,153 @@ end subroutine readNcdioArray2d !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- - subroutine readNcdioScalarCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & - callingName, retVal) - ! - ! read the netcdf file...generic, could be used for any parameter read - ! - use abortutils , only : endrun - use ncdio_pio , only : file_desc_t - - implicit none - - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - character(len=*), intent(in) :: varName ! variable we are reading - integer, intent(in) :: expected_numDims - character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name - character(len=*), intent(in) :: callingName ! calling routine - real(r8), intent(inout) :: retVal - - ! local vars - character(len=32) :: subname = 'readNcdio::' - character(len=100) :: errCode = ' - Error reading. Var: ' - - ! - ! netcdf read here - ! - call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) - call readNcdio(ncid, varName, callingName, retVal) - - end subroutine readNcdioScalarCheckDimensions - !----------------------------------------------------------------------- - - !----------------------------------------------------------------------- - ! - !----------------------------------------------------------------------- - subroutine readNcdioArray1dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & - callingName, retVal) - ! - ! read the netcdf file...generic, could be used for any parameter read - ! - use abortutils , only : endrun - use ncdio_pio , only : file_desc_t - - implicit none - - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - character(len=*), intent(in) :: varName ! variable we are reading - integer, intent(in) :: expected_numDims - character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name - character(len=*), intent(in) :: callingName ! calling routine - real(r8), intent(inout) :: retVal( 1: ) - - ! local vars - character(len=32) :: subname = 'readNcdio::' - character(len=100) :: errCode = ' - Error reading. Var: ' - ! - ! netcdf read here - ! - call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) - call readNcdio(ncid, varName, callingName, retVal) - - end subroutine readNcdioArray1dCheckDimensions - !----------------------------------------------------------------------- - - !----------------------------------------------------------------------- - ! - !----------------------------------------------------------------------- - subroutine readNcdioArray2dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & - callingName, retVal) - ! - ! read the netcdf file...generic, could be used for any parameter read - ! - use abortutils , only : endrun - use ncdio_pio , only : file_desc_t - - implicit none - - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - character(len=*), intent(in) :: varName ! variable we are reading - integer, intent(in) :: expected_numDims - character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name - character(len=*), intent(in) :: callingName ! calling routine - real(r8), intent(inout) :: retVal(1:, : ) - - ! local vars - character(len=32) :: subname = 'readNcdio::' - character(len=100) :: errCode = ' - Error reading. Var: ' - ! - ! netcdf read here - ! - call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) - call readNcdio(ncid, varName, callingName, retVal) - - end subroutine readNcdioArray2dCheckDimensions - !----------------------------------------------------------------------- - - !----------------------------------------------------------------------- - ! - !----------------------------------------------------------------------- - subroutine checkDimensions(ncid, varName, expected_numDims, expected_dimNames, callingName) - ! - ! Assert that the expected number of dimensions and dimension - ! names for a variable match the actual names on the file. - ! - use abortutils , only : endrun - use ncdio_pio , only : file_desc_t, var_desc_t, check_var, ncd_inqvdname, ncd_inqvdims - - implicit none - - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - character(len=*), intent(in) :: varName ! variable we are reading - integer, intent(in) :: expected_numDims ! number of expected dimensions on the variable - character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension names - character(len=*), intent(in) :: callingName ! calling routine - integer :: error_num - - ! local vars - character(len=32) :: subname = 'checkDimensions::' - type(Var_desc_t) :: var_desc ! variable descriptor - logical :: readvar ! whether the variable was found - character(len=100) :: received_dimName - integer :: d, num_dims - character(len=256) :: msg - - call check_var(ncid, varName, readvar, vardesc=var_desc) - if (readvar) then - call ncd_inqvdims(ncid, num_dims, var_desc) - if (num_dims /= expected_numDims) then - write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: expected number of dimensions = ", & - expected_numDims, " num dimensions received from file = ", num_dims - call endrun(msg) - end if - do d = 1, num_dims - received_dimName = '' - call ncd_inqvdname(ncid, varname=trim(varName), dimnum=d, dname=received_dimName, err_code=error_num) - if (trim(expected_dimNames(d)) /= trim(received_dimName)) then - write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: dimension ", d, & - " expected dimension name '"//trim(expected_dimNames(d))//& - "' dimension name received from file '"//trim(received_dimName)//"'." - call endrun(msg) - end if - end do - end if - - end subroutine checkDimensions +! subroutine readNcdioScalarCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & +! callingName, retVal) +! ! +! ! read the netcdf file...generic, could be used for any parameter read +! ! +! use abortutils , only : endrun +! use ncdio_pio , only : file_desc_t +! +! implicit none +! +! ! arguments +! type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id +! character(len=*), intent(in) :: varName ! variable we are reading +! integer, intent(in) :: expected_numDims +! character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name +! character(len=*), intent(in) :: callingName ! calling routine +! real(r8), intent(inout) :: retVal +! +! ! local vars +! character(len=32) :: subname = 'readNcdio::' +! character(len=100) :: errCode = ' - Error reading. Var: ' +! +! ! +! ! netcdf read here +! ! +! call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) +! call readNcdio(ncid, varName, callingName, retVal) +! +! end subroutine readNcdioScalarCheckDimensions +! !----------------------------------------------------------------------- +! +! !----------------------------------------------------------------------- +! ! +! !----------------------------------------------------------------------- +! subroutine readNcdioArray1dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & +! callingName, retVal) +! ! +! ! read the netcdf file...generic, could be used for any parameter read +! ! +! use abortutils , only : endrun +! use ncdio_pio , only : file_desc_t +! +! implicit none +! +! ! arguments +! type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id +! character(len=*), intent(in) :: varName ! variable we are reading +! integer, intent(in) :: expected_numDims +! character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name +! character(len=*), intent(in) :: callingName ! calling routine +! real(r8), intent(inout) :: retVal( 1: ) +! +! ! local vars +! character(len=32) :: subname = 'readNcdio::' +! character(len=100) :: errCode = ' - Error reading. Var: ' +! ! +! ! netcdf read here +! ! +! call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) +! call readNcdio(ncid, varName, callingName, retVal) +! +! end subroutine readNcdioArray1dCheckDimensions +! !----------------------------------------------------------------------- +! +! !----------------------------------------------------------------------- +! ! +! !----------------------------------------------------------------------- +! subroutine readNcdioArray2dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & +! callingName, retVal) +! ! +! ! read the netcdf file...generic, could be used for any parameter read +! ! +! use abortutils , only : endrun +! use ncdio_pio , only : file_desc_t +! +! implicit none +! +! ! arguments +! type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id +! character(len=*), intent(in) :: varName ! variable we are reading +! integer, intent(in) :: expected_numDims +! character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name +! character(len=*), intent(in) :: callingName ! calling routine +! real(r8), intent(inout) :: retVal(1:, : ) +! +! ! local vars +! character(len=32) :: subname = 'readNcdio::' +! character(len=100) :: errCode = ' - Error reading. Var: ' +! ! +! ! netcdf read here +! ! +! call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) +! call readNcdio(ncid, varName, callingName, retVal) +! +! end subroutine readNcdioArray2dCheckDimensions +! !----------------------------------------------------------------------- +! +! !----------------------------------------------------------------------- +! ! +! !----------------------------------------------------------------------- +! subroutine checkDimensions(ncid, varName, expected_numDims, expected_dimNames, callingName) +! ! +! ! Assert that the expected number of dimensions and dimension +! ! names for a variable match the actual names on the file. +! ! +! use abortutils , only : endrun +! use ncdio_pio , only : file_desc_t, var_desc_t, check_var, ncd_inqvdname, ncd_inqvdims +! +! implicit none +! +! ! arguments +! type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id +! character(len=*), intent(in) :: varName ! variable we are reading +! integer, intent(in) :: expected_numDims ! number of expected dimensions on the variable +! character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension names +! character(len=*), intent(in) :: callingName ! calling routine +! integer :: error_num +! +! ! local vars +! character(len=32) :: subname = 'checkDimensions::' +! type(Var_desc_t) :: var_desc ! variable descriptor +! logical :: readvar ! whether the variable was found +! character(len=100) :: received_dimName +! integer :: d, num_dims +! character(len=256) :: msg +! +! call check_var(ncid, varName, readvar, vardesc=var_desc) +! if (readvar) then +! call ncd_inqvdims(ncid, num_dims, var_desc) +! if (num_dims /= expected_numDims) then +! write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: expected number of dimensions = ", & +! expected_numDims, " num dimensions received from file = ", num_dims +! call endrun(msg) +! end if +! do d = 1, num_dims +! received_dimName = '' +! call ncd_inqvdname(ncid, varname=trim(varName), dimnum=d, dname=received_dimName, err_code=error_num) +! if (trim(expected_dimNames(d)) /= trim(received_dimName)) then +! write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: dimension ", d, & +! " expected dimension name '"//trim(expected_dimNames(d))//& +! "' dimension name received from file '"//trim(received_dimName)//"'." +! call endrun(msg) +! end if +! end do +! end if +! +! end subroutine checkDimensions !----------------------------------------------------------------------- end module paramUtilMod From fbcd4f70e683ab6655d32f800eadff74b2a0b784 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 28 Nov 2022 21:07:18 -0500 Subject: [PATCH 114/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 index 3efe0a175..4fbca843b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 @@ -36,7 +36,7 @@ subroutine readNcdioScalar(ncid, varName, callingName, retVal) ! read the netcdf file...generic, could be used for any parameter read ! use abortutils , only : endrun - use ncdio_pio , only : file_desc_t,ncd_io + use ncdio_pio , only : file_desc_t, ncd_io implicit none @@ -72,7 +72,7 @@ subroutine readNcdioArray1d(ncid, varName, callingName, retVal) ! read the netcdf file...generic, could be used for any parameter read ! use abortutils , only : endrun - use ncdio_pio , only : file_desc_t,ncd_io + use ncdio_pio , only : file_desc_t, ncd_io implicit none @@ -108,7 +108,7 @@ subroutine readNcdioArray2d(ncid, varName, callingName, retVal) ! read the netcdf file...generic, could be used for any parameter read ! use abortutils , only : endrun - use ncdio_pio , only : file_desc_t,ncd_io + use ncdio_pio , only : file_desc_t, ncd_io implicit none From 4375044c404bd031a5e6972a88ab2b9edb322741 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 28 Nov 2022 21:30:44 -0500 Subject: [PATCH 115/589] adding ncdio use statement at beginning of routine --- .../GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 index 4fbca843b..5d87a8888 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 @@ -3,6 +3,7 @@ module paramUtilMod ! module that deals with reading parameter files ! use shr_kind_mod , only: r8 => shr_kind_r8 + use ncdio_pio , only : file_desc_t, ncd_io implicit none save private From 8914a1a72d1688e246402d43b23698e63c519c92 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 29 Nov 2022 08:37:38 -0500 Subject: [PATCH 116/589] add missing use statements --- .../CLM51/subgridAveMod.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 index 6012cccb2..976a51208 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 @@ -9,14 +9,14 @@ module subgridAveMod ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg -! use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall -! use column_varcon , only : icol_road_perv , icol_road_imperv -! use clm_varcon , only : grlnd, nameg, namel, namec, namep,spval + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_perv , icol_road_imperv + use clm_varcon , only : grlnd, nameg, namel, namec, namep,spval use clm_varcon , only : namec, spval use clm_varctl , only : iulog use abortutils , only : endrun use decompMod , only : bounds_type -! use LandunitType , only : lun + use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch ! @@ -27,11 +27,11 @@ module subgridAveMod ! ! !PUBLIC MEMBER FUNCTIONS: public :: p2c ! Perform an average patches to columns - public :: p2l ! Perform an average patches to landunits - public :: p2g ! Perform an average patches to gridcells - public :: c2l ! Perform an average columns to landunits + ! public :: p2l ! Perform an average patches to landunits + ! public :: p2g ! Perform an average patches to gridcells + ! public :: c2l ! Perform an average columns to landunits public :: c2g ! Perform an average columns to gridcells - public :: l2g ! Perform an average landunits to gridcells + ! public :: l2g ! Perform an average landunits to gridcells interface p2c module procedure p2c_1d @@ -61,8 +61,8 @@ module subgridAveMod ! end interface ! ! !PRIVATE MEMBER FUNCTIONS: - private :: build_scale_l2g - private :: create_scale_l2g_lookup +! private :: build_scale_l2g +! private :: create_scale_l2g_lookup ! Note about the urban scaling types used for c2l_scale_type (urbanf / urbans), from ! Bill Sacks and Keith Oleson: These names originally meant to distinguish between From c060ea2dde1ca5ff137826ecb02774a01b081025 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 29 Nov 2022 09:04:26 -0500 Subject: [PATCH 117/589] move ncd_io use statement to beginning of module --- .../GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 index d0f623435..68709ee5f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -4,6 +4,7 @@ module CNSharedParamsMod ! ! !USES: use shr_kind_mod , only: r8 => shr_kind_r8 + use ncdio_pio , only : file_desc_t, ncd_io implicit none ! CNParamsShareInst. PGI wants the type decl. public but the instance From fc9b5c6d888ab14997dcd09e4ee3bb61d53d09f4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 29 Nov 2022 09:34:21 -0500 Subject: [PATCH 118/589] adding ndcio_pio to pre-processing --- .../CLM51/{ncdio_pio.F90 => ncdio_pio.F90.in} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/{ncdio_pio.F90 => ncdio_pio.F90.in} (100%) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in From bce6712ffe00d56a14795e76980ae96d49b6f92f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 29 Nov 2022 10:12:33 -0500 Subject: [PATCH 119/589] adding ndcio_pio.F90.in to pre-processing --- .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index e8fb1090f..2cbea953b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -6,7 +6,7 @@ include(genf90_utils) find_program(GENF90 genf90.pl PATHS ${CMAKE_CURRENT_LIST_DIR}) -set(genf90_files shr_infnan_mod.F90.in shr_assert_mod.F90.in) +set(genf90_files shr_infnan_mod.F90.in shr_assert_mod.F90.in ncdio_pio.F90.in) process_genf90_source_list("${genf90_files}" ${CMAKE_CURRENT_BINARY_DIR} share_genf90_sources) @@ -94,7 +94,6 @@ set (srcs FireMethodType.F90 initSubgridMod.F90 landunit_varcon.F90 - ncdio_pio.F90 NutrientCompetitionCLM45defaultMod.F90 NutrientCompetitionFactoryMod.F90 NutrientCompetitionFlexibleCNMod.F90 From 32fbede1ddd9b406d9aa091610324d8a1d313e72 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 29 Nov 2022 11:04:43 -0500 Subject: [PATCH 120/589] add include statement needed for Netcdf_fileformatter --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 2 ++ .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 +++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index e556f17f0..6d0e84ced 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -1,3 +1,5 @@ +#include "MAPL_Generic.h" + module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index cb839cdf3..e4738335a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -1,4 +1,6 @@ - module CN_initMod +#include "MAPL_Generic.h" + +module CN_initMod use ESMF From a2b350e12723bdec6c20d53eb9864816b8f51f7a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 29 Nov 2022 13:50:46 -0500 Subject: [PATCH 121/589] ncdio_pio moved out of preprocessing --- .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 3 ++- .../GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 | 1 + .../CLM51/{ncdio_pio.F90.in => ncdio_pio.F90} | 0 3 files changed, 3 insertions(+), 1 deletion(-) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/{ncdio_pio.F90.in => ncdio_pio.F90} (100%) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 2cbea953b..e8fb1090f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -6,7 +6,7 @@ include(genf90_utils) find_program(GENF90 genf90.pl PATHS ${CMAKE_CURRENT_LIST_DIR}) -set(genf90_files shr_infnan_mod.F90.in shr_assert_mod.F90.in ncdio_pio.F90.in) +set(genf90_files shr_infnan_mod.F90.in shr_assert_mod.F90.in) process_genf90_source_list("${genf90_files}" ${CMAKE_CURRENT_BINARY_DIR} share_genf90_sources) @@ -94,6 +94,7 @@ set (srcs FireMethodType.F90 initSubgridMod.F90 landunit_varcon.F90 + ncdio_pio.F90 NutrientCompetitionCLM45defaultMod.F90 NutrientCompetitionFactoryMod.F90 NutrientCompetitionFlexibleCNMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 index 68709ee5f..fa8579fb5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -5,6 +5,7 @@ module CNSharedParamsMod ! !USES: use shr_kind_mod , only: r8 => shr_kind_r8 use ncdio_pio , only : file_desc_t, ncd_io + implicit none ! CNParamsShareInst. PGI wants the type decl. public but the instance diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90.in rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 From 86219c66306265df33a777e468126056b4245804 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 29 Nov 2022 14:20:20 -0500 Subject: [PATCH 122/589] rename paremeters --- .../CLM51/CNCLM_EnergyFluxType.F90 | 1 + .../CLM51/ncdio_pio.F90 | 96 +++++++++---------- 2 files changed, 49 insertions(+), 48 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 index 251ff43cc..a2f552c11 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 @@ -7,6 +7,7 @@ module EnergyFluxType ! use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg + use nanMod , only : nan use clm_varcon , only : spval use clm_varctl , only : use_biomass_heat_storage use decompMod , only : bounds_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index c59b1ed75..87ccb4451 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -54,7 +54,7 @@ module ncdio_pio contains !---------------------------------------------------- - subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -62,7 +62,7 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv, rc) real(r4), intent(inout) :: data(:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer,optional, intent(out) :: rc ! LOCAL: @@ -72,17 +72,17 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. ! call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_r4_1d !----------------------------------------------------------------------- - subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -90,7 +90,7 @@ subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv, rc) real(r4), intent(inout) :: data(:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -99,17 +99,17 @@ subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. ! call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_r4_2d !----------------------------------------------------------------------- - subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -117,7 +117,7 @@ subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv, rc) real(r4), intent(inout) :: data(:,:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -127,17 +127,17 @@ subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. !call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_r4_3d !----------------------------------------------------------------------- - subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -145,7 +145,7 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv, rc) real(r4), intent(inout) :: data(:,:,:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -155,17 +155,17 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. ! call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_r4_4d !----------------------------------------------------------------------- - subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -173,7 +173,7 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv, rc) real(r8), intent(inout) :: data(:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -183,10 +183,10 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. !call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_r8_1d @@ -194,7 +194,7 @@ end subroutine ncd_io_r8_1d !----------------------------------------------------------------------- - subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -202,7 +202,7 @@ subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv, rc) real(r8), intent(inout) :: data(:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -212,10 +212,10 @@ subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. ! call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_r8_2d @@ -223,7 +223,7 @@ end subroutine ncd_io_r8_2d !----------------------------------------------------------------------- - subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -231,7 +231,7 @@ subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv, rc) real(r8), intent(inout) :: data(:,:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -241,10 +241,10 @@ subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. !call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_r8_3d @@ -252,7 +252,7 @@ end subroutine ncd_io_r8_3d !----------------------------------------------------------------------- - subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -260,7 +260,7 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv, rc) real(r8), intent(inout) :: data(:,:,:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -270,16 +270,16 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. !call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_r8_4d !----------------------------------------------------------------------- - subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -287,7 +287,7 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv, rc) integer(i4), intent(inout) :: data(:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -297,16 +297,16 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. !call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_i4_1d !----------------------------------------------------------------------- - subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -314,7 +314,7 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv, rc) integer(i4), intent(inout) :: data(:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -324,16 +324,16 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. !call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_i4_2d !----------------------------------------------------------------------- - subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -341,7 +341,7 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv, rc) integer(i4), intent(inout) :: data(:,:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -351,16 +351,16 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. !call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_i4_3d !----------------------------------------------------------------------- - subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv, rc) + subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: !------------- @@ -368,7 +368,7 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv, rc) integer(i4), intent(inout) :: data(:,:,:,:) character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readv + logical, intent(out) :: readvar integer, optional, intent(out) :: rc ! LOCAL: @@ -378,10 +378,10 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readv, rc) !------------------------------------- if (flag == 'read') then - readv = .false. + readvar = .false. !call ncid%get_var(varname, data, rc=status) call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readv = .true. + if (status ==0) readvar = .true. endif end subroutine ncd_io_i4_4d From 3bf3b3450fa52c9ec9db8f0862dbeb28fd9ea9cf Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 29 Nov 2022 16:11:38 -0500 Subject: [PATCH 123/589] splitting use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 index fa8579fb5..c8c71d388 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -4,7 +4,8 @@ module CNSharedParamsMod ! ! !USES: use shr_kind_mod , only: r8 => shr_kind_r8 - use ncdio_pio , only : file_desc_t, ncd_io + use ncdio_pio , only : file_desc_t + use ncdio_pio , only : ncd_io implicit none @@ -51,7 +52,7 @@ end subroutine CNParamsReadShared !----------------------------------------------------------------------- subroutine CNParamsReadShared_netcdf(ncid) ! - use ncdio_pio , only : file_desc_t, ncd_io + ! use ncdio_pio , only : file_desc_t, ncd_io use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg ! From b443d632e73c8ed7ef8b4ecb83cf8ec563b51f50 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 29 Nov 2022 16:51:37 -0500 Subject: [PATCH 124/589] fixing bug in use statements for ncdio_pio --- .../GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 index 5d87a8888..76ca91c60 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/paramUtilMod.F90 @@ -3,7 +3,8 @@ module paramUtilMod ! module that deals with reading parameter files ! use shr_kind_mod , only: r8 => shr_kind_r8 - use ncdio_pio , only : file_desc_t, ncd_io + use ncdio_pio , only : file_desc_t + use ncdio_pio , only : ncd_io implicit none save private From eb70021d5bfc0bda5d08e2591ee564a01d68c0cd Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 30 Nov 2022 09:46:31 -0500 Subject: [PATCH 125/589] add reading scalar --- .../CLM51/ncdio_pio.F90 | 96 ++++++++++++++++++- 1 file changed, 91 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 87ccb4451..c2f327a29 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -36,14 +36,17 @@ module ncdio_pio interface ncd_io + module procedure ncd_io_r4_0d module procedure ncd_io_r4_1d module procedure ncd_io_r4_2d module procedure ncd_io_r4_3d module procedure ncd_io_r4_4d + module procedure ncd_io_r8_0d module procedure ncd_io_r8_1d module procedure ncd_io_r8_2d module procedure ncd_io_r8_3d module procedure ncd_io_r8_4d + module procedure ncd_io_i4_0d module procedure ncd_io_i4_1d module procedure ncd_io_i4_2d module procedure ncd_io_i4_3d @@ -53,6 +56,33 @@ module ncdio_pio contains +!---------------------------------------------------- + subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r4), intent(inout) :: data + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readvar + integer,optional, intent(out) :: rc + + ! LOCAL: + + integer :: status + + !------------------------------------- + + if (flag == 'read') then + readvar = .false. + ! call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) + if (status ==0) readvar = .true. + endif + + end subroutine ncd_io_r4_0d + !---------------------------------------------------- subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readvar, rc) @@ -163,7 +193,35 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_r4_4d - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + + subroutine ncd_io_r8_0d ( varname, data, flag, ncid, readvar, rc) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + real(r8), intent(inout) :: data + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readvar + integer, optional, intent(out) :: rc + + ! LOCAL: + + integer :: status + + !------------------------------------- + + if (flag == 'read') then + readvar = .false. + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) + if (status ==0) readvar = .true. + endif + + end subroutine ncd_io_r8_0d + + !----------------------------------------------------------------------- subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readvar, rc) @@ -191,8 +249,7 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_r8_1d - !----------------------------------------------------------------------- - + !----------------------------------------------------------------------- subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readvar, rc) @@ -278,7 +335,35 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_r8_4d - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine ncd_io_i4_0d ( varname, data, flag, ncid, readvar, rc) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + integer(i4), intent(inout) :: data + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readvar + integer, optional, intent(out) :: rc + + ! LOCAL: + + integer :: status + + !------------------------------------- + + if (flag == 'read') then + readvar = .false. + !call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) + if (status ==0) readvar = .true. + endif + + end subroutine ncd_io_i4_0d + + !----------------------------------------------------------------------- + subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: @@ -305,7 +390,8 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_i4_1d - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readvar, rc) ! ARGUMENTS: From 2bd6a46151c92c157a6723a9bc3772a61db3f7f0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 30 Nov 2022 14:08:29 -0500 Subject: [PATCH 126/589] add use statement to import NetCDF4_FileFormatter --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 3 ++- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 6d0e84ced..18d737ce8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -3,11 +3,12 @@ module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use shr_infnan_mod , only : nan => shr_infnan_nan + use nanMod , only : nan use clm_varpar , only : mxpft, numrad,nvariants use clm_varctl , only : use_flexibleCN use netcdf use shr_log_mod , only : errMsg => shr_log_errMsg + use MAPL , only : NetCDF4_FileFormatter use MAPL_ExceptionHandling diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index e4738335a..8c33b7656 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -69,6 +69,8 @@ module CN_initMod use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi + use MAPL , only : NetCDF4_FileFormatter + implicit none private From e5df3cfd24e14eb2e79a83d75472f8d65dc903b3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 30 Nov 2022 15:22:20 -0500 Subject: [PATCH 127/589] add missing variable declarations --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 18d737ce8..f6575c8c6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -249,7 +249,7 @@ subroutine init_pftcon_type(this) !LOCAL character(300) :: paramfile - integer :: ierr, clm_varid, ncid, status + integer :: ierr, clm_varid, status logical :: readv ! has variable been read in or not type(Netcdf4_fileformatter) :: ncid @@ -257,6 +257,7 @@ subroutine init_pftcon_type(this) real(r8), allocatable, dimension(:,:) :: read_tmp_2 integer , allocatable, dimension(:) :: read_tmp_3 + character(len=512) :: msg !--------------------------------------------------------- From a1abd422001e96a4bcab43d09ea3ca9511162630 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 30 Nov 2022 15:22:49 -0500 Subject: [PATCH 128/589] add routine for reading strings --- .../CLM51/ncdio_pio.F90 | 27 +++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index c2f327a29..e123bd092 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -36,6 +36,7 @@ module ncdio_pio interface ncd_io + module procedure ncd_io_char module procedure ncd_io_r4_0d module procedure ncd_io_r4_1d module procedure ncd_io_r4_2d @@ -56,6 +57,32 @@ module ncdio_pio contains + subroutine ncd_io_char ( varname, data, flag, ncid, readvar, rc) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(inout) :: data + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readvar + integer,optional, intent(out) :: rc + + ! LOCAL: + + integer :: status + + !------------------------------------- + + if (flag == 'read') then + readvar = .false. + ! call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) + if (status ==0) readvar = .true. + endif + + end subroutine ncd_io_char + !---------------------------------------------------- subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc) From 4f8c8db679ba88e77d69f6be3972cba50af028c1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 12:51:04 -0500 Subject: [PATCH 129/589] add missing variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 0a71c676b..b4f026abd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -60,6 +60,14 @@ module clm_varctl logical, public :: CNratio_floating = .false. integer, public :: CN_evergreen_phenology_opt = 0 + !---------------------------------------------------------- + ! BGC logic and datasets + !---------------------------------------------------------- + + ! true => anoxia is applied to heterotrophic respiration also considered in CH4 model + ! default value reset in controlMod + logical, public :: anoxia = .true. + ! State of the model for the accelerated decomposition (AD) spinup. ! 0 (default) = normal model; 1 = AD SPINUP integer, public :: spinup_state = 0 From dd05dce45243c4272f313f173a34ab2ebfe07821 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 12:51:29 -0500 Subject: [PATCH 130/589] comment out soil matrix calculations --- .../SoilBiogeochemDecompCascadeBGCMod.F90 | 54 +++++++++---------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 index bed9493f7..3ca6871c9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 @@ -17,7 +17,7 @@ module SoilBiogeochemDecompCascadeBGCMod use spmdMod , only : masterproc use abortutils , only : endrun use CNSharedParamsMod , only : CNParamsShareInst, nlev_soildecomp_standard - use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con, InitSoilTransfer + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use SoilBiogeochemStateType , only : soilbiogeochem_state_type use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type use SoilStateType , only : soilstate_type @@ -670,7 +670,7 @@ subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_i end if end if - if(use_soil_matrixcn) call InitSoilTransfer() + ! if(use_soil_matrixcn) call InitSoilTransfer() deallocate(rf_s1s2) deallocate(rf_s1s3) @@ -755,7 +755,7 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) - Ksoil => soilbiogeochem_carbonflux_inst%Ksoil , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ! Ksoil => soilbiogeochem_carbonflux_inst%Ksoil , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) spinup_factor => decomp_cascade_con%spinup_factor & ! Input: [real(r8) (:) ] factor for AD spinup associated with each pool ! matrix_decomp_k => soilbiogeochem_carbonflux_inst%matrix_decomp_k_col & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) ) @@ -1064,14 +1064,14 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & * spinup_geogterm_s2(c) decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) & * spinup_geogterm_s3(c) - if(use_soil_matrixcn)then - Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l1(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s1(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s2(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s3(c) * dt - end if !use_soil_matrixcn +! if(use_soil_matrixcn)then +! Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l1(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s1(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s2(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s3(c) * dt +! end if !use_soil_matrixcn end do end do else @@ -1084,14 +1084,14 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s1(c) decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s2(c) decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s3(c) - if(use_soil_matrixcn)then - Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l1(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s1(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s2(c) * dt - Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s3(c) * dt - end if !use_soil_matrixcn +! if(use_soil_matrixcn)then +! Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l1(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l23(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s1(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s2(c) * dt +! Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_s3(c) * dt +! end if !use_soil_matrixcn end do end do end if @@ -1104,10 +1104,10 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & c = filter_soilc(fc) decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * & o_scalar(c,j) * spinup_geogterm_cwd(c) - if(use_soil_matrixcn)then - Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * & - o_scalar(c,j) * spinup_geogterm_cwd(c) * dt - end if !use_soil_matrixcn +! if(use_soil_matrixcn)then +! Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * & +! o_scalar(c,j) * spinup_geogterm_cwd(c) * dt +! end if !use_soil_matrixcn end do end do else @@ -1116,10 +1116,10 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & c = filter_soilc(fc) decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * & o_scalar(c,j) * spinup_geogterm_cwd(c) - if(use_soil_matrixcn)then - Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * & - o_scalar(c,j) * spinup_geogterm_cwd(c) * dt - end if !use_soil_matrixcn +! if(use_soil_matrixcn)then +! Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * & +! o_scalar(c,j) * spinup_geogterm_cwd(c) * dt +! end if !use_soil_matrixcn end do end do end if From 024b69eca56475e7b2c4c87acf5ea5657fadd1d1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 12:51:39 -0500 Subject: [PATCH 131/589] comment out soil matrix calculations --- .../SoilBiogeochemDecompCascadeCNMod.F90 | 58 +++++++++---------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 index 6e8ef1074..c70650ce5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 @@ -16,7 +16,7 @@ module SoilBiogeochemDecompCascadeCNMod use decompMod , only : bounds_type use abortutils , only : endrun use CNSharedParamsMod , only : CNParamsShareInst, nlev_soildecomp_standard - use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con, InitSoilTransfer + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use SoilBiogeochemStateType , only : soilbiogeochem_state_type use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type use SoilStateType , only : soilstate_type @@ -576,7 +576,7 @@ subroutine init_decompcascade_cn(bounds, soilbiogeochem_state_inst) end if end if - if(use_soil_matrixcn)call InitSoilTransfer() + !if(use_soil_matrixcn)call InitSoilTransfer() end associate @@ -663,7 +663,7 @@ subroutine decomp_rate_constants_cn(bounds, & w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) - Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ! Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) ) mino2lim = CNParamsShareInst%mino2lim @@ -927,15 +927,15 @@ subroutine decomp_rate_constants_cn(bounds, & decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt decomp_k(c,j,i_soil4) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt - if(use_soil_matrixcn)then - Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_soil4-1)) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) - end if +! if(use_soil_matrixcn)then +! Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_soil4-1)) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) +! end if end do end do else @@ -949,15 +949,15 @@ subroutine decomp_rate_constants_cn(bounds, & decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt decomp_k(c,j,i_soil4) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt - if(use_soil_matrixcn)then - Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) - Ksoil%DM(c,j+nlevdecomp*(i_soil4-1)) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) - end if +! if(use_soil_matrixcn)then +! Ksoil%DM(c,j+nlevdecomp*(i_litr1-1)) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_litr2-1)) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_litr3-1)) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_soil1-1)) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_soil2-1)) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_soil3-1)) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) +! Ksoil%DM(c,j+nlevdecomp*(i_soil4-1)) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) +! end if end do end do end if @@ -969,10 +969,10 @@ subroutine decomp_rate_constants_cn(bounds, & do fc = 1,num_soilc c = filter_soilc(fc) decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt - if(use_soil_matrixcn)then - Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * & - o_scalar(c,j) - end if +! if(use_soil_matrixcn)then +! Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * & +! o_scalar(c,j) +! end if end do end do else @@ -980,10 +980,10 @@ subroutine decomp_rate_constants_cn(bounds, & do fc = 1,num_soilc c = filter_soilc(fc) decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt - if(use_soil_matrixcn)then - Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * & - o_scalar(c,j) - end if +! if(use_soil_matrixcn)then +! Ksoil%DM(c,j+nlevdecomp*(i_cwd-1)) = k_frag * t_scalar(c,j) * w_scalar(c,j) * & +! o_scalar(c,j) +! end if end do end do end if From e8e588fcca9ab7c9c4f3650df2869fb8a6dc4313 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 13:25:42 -0500 Subject: [PATCH 132/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index f6575c8c6..14b74f29a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -242,6 +242,7 @@ subroutine init_pftcon_type(this) ! Initialize CTSM PFT constants ! use ncdio_pio , only : ncd_io + use abortutils , only : endrun ! !ARGUMENTS: implicit none !INPUT/OUTPUT From c7ba4d659eb110d783c09fcdd17b26527c1b3c57 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 13:52:42 -0500 Subject: [PATCH 133/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 index a2f552c11..2cc7fb485 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 @@ -14,6 +14,7 @@ module EnergyFluxType use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch + use clm_varpar , only: nlevgrnd ! implicit none From bfc54bea4b02d75f9e7f5f9a0fa42114719bf403 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 13:53:09 -0500 Subject: [PATCH 134/589] move use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 14b74f29a..740ec67be 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -10,7 +10,7 @@ module pftconMod use shr_log_mod , only : errMsg => shr_log_errMsg use MAPL , only : NetCDF4_FileFormatter use MAPL_ExceptionHandling - + use ncdio_pio , only : ncd_io ! !PUBLIC TYPES: implicit none From 938c962250dc093418947300e9b2e41e7a134765 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 13:53:28 -0500 Subject: [PATCH 135/589] add missing variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index b4f026abd..2aa7ee836 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -36,6 +36,7 @@ module clm_varctl logical, public :: use_dynroot = .false. logical, public :: use_bedrock = .false. ! true => use spatially variable soil depth logical, public :: use_extralakelayers = .false. + logical, public :: use_biomass_heat_storage = .false. logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model From eebcabfd2fe277de5900e1e421935607af1726b0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 14:28:44 -0500 Subject: [PATCH 136/589] adding missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 740ec67be..9d2704a23 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -8,7 +8,7 @@ module pftconMod use clm_varctl , only : use_flexibleCN use netcdf use shr_log_mod , only : errMsg => shr_log_errMsg - use MAPL , only : NetCDF4_FileFormatter + use MAPL , only : NetCDF4_FileFormatter, pFIO_READ use MAPL_ExceptionHandling use ncdio_pio , only : ncd_io @@ -241,8 +241,8 @@ subroutine init_pftcon_type(this) ! !DESCRIPTION: ! Initialize CTSM PFT constants ! - use ncdio_pio , only : ncd_io use abortutils , only : endrun + ! !ARGUMENTS: implicit none !INPUT/OUTPUT From f96ee15353f6120db804de7b9ccb02454e5531ef Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 14:29:18 -0500 Subject: [PATCH 137/589] adding logical 1D read routine --- .../CLM51/ncdio_pio.F90 | 27 +++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index e123bd092..29bce6ea6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -37,6 +37,7 @@ module ncdio_pio interface ncd_io module procedure ncd_io_char + module procedure ncd_io_log_1d module procedure ncd_io_r4_0d module procedure ncd_io_r4_1d module procedure ncd_io_r4_2d @@ -83,6 +84,32 @@ subroutine ncd_io_char ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_char + subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + logical, intent(inout) :: data(:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readvar + integer,optional, intent(out) :: rc + + ! LOCAL: + + integer :: status + + !------------------------------------- + + if (flag == 'read') then + readvar = .false. + ! call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) + if (status ==0) readvar = .true. + endif + + end subroutine ncd_io_log_1d + !---------------------------------------------------- subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc) From 7891ea588385f65a45992bb0b7f8bf29f38a2ecd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 15:03:58 -0500 Subject: [PATCH 138/589] adjusting nan value that is used for some variables --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 9d2704a23..eaf9d7e05 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -3,7 +3,7 @@ module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use nanMod , only : nan + use nanMod , only : nan, nan8 use clm_varpar , only : mxpft, numrad,nvariants use clm_varctl , only : use_flexibleCN use netcdf @@ -283,7 +283,7 @@ subroutine init_pftcon_type(this) allocate( this%roota_par (0:mxpft) ); this%roota_par(:) = nan allocate( this%rootb_par (0:mxpft) ); this%rootb_par(:) = nan allocate( this%crop (0:mxpft) ); this%crop (:) = nan !# - allocate( this%mergetoclmpft (0:mxpft) ); this%mergetoclmpft (:) = nan !# + allocate( this%mergetoclmpft (0:mxpft) ); this%mergetoclmpft (:) = nan8 !# allocate( this%is_pft_known_to_model (0:mxpft) ); this%is_pft_known_to_model(:) = nan !# allocate( this%irrigated (0:mxpft) ); this%irrigated (:) = nan !# allocate( this%smpso (0:mxpft) ); this%smpso (:) = nan !# @@ -323,7 +323,7 @@ subroutine init_pftcon_type(this) allocate( this%mbbopt (0:mxpft) ); this%mbbopt (:) = nan !# allocate( this%medlynslope (0:mxpft) ); this%medlynslope (:) = nan !# allocate( this%medlynintercept(0:mxpft) ); this%medlynintercept = nan !# - allocate( this%mxmat (0:mxpft) ); this%mxmat (:) = nan + allocate( this%mxmat (0:mxpft) ); this%mxmat (:) = nan8 allocate( this%mnNHplantdate (0:mxpft) ); this%mnNHplantdate (:) = huge(1) allocate( this%mxNHplantdate (0:mxpft) ); this%mxNHplantdate (:) = huge(1) allocate( this%mnSHplantdate (0:mxpft) ); this%mnSHplantdate (:) = huge(1) From dc8df6d6ce6a52b8ea787407c17bc6d99b19fc4a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 5 Dec 2022 15:32:43 -0500 Subject: [PATCH 139/589] bug fix for nan issue --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index eaf9d7e05..f6012b567 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -3,7 +3,7 @@ module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 - use nanMod , only : nan, nan8 + use nanMod , only : nan, bigint use clm_varpar , only : mxpft, numrad,nvariants use clm_varctl , only : use_flexibleCN use netcdf @@ -283,7 +283,7 @@ subroutine init_pftcon_type(this) allocate( this%roota_par (0:mxpft) ); this%roota_par(:) = nan allocate( this%rootb_par (0:mxpft) ); this%rootb_par(:) = nan allocate( this%crop (0:mxpft) ); this%crop (:) = nan !# - allocate( this%mergetoclmpft (0:mxpft) ); this%mergetoclmpft (:) = nan8 !# + allocate( this%mergetoclmpft (0:mxpft) ); this%mergetoclmpft (:) = bigint !# allocate( this%is_pft_known_to_model (0:mxpft) ); this%is_pft_known_to_model(:) = nan !# allocate( this%irrigated (0:mxpft) ); this%irrigated (:) = nan !# allocate( this%smpso (0:mxpft) ); this%smpso (:) = nan !# @@ -323,7 +323,7 @@ subroutine init_pftcon_type(this) allocate( this%mbbopt (0:mxpft) ); this%mbbopt (:) = nan !# allocate( this%medlynslope (0:mxpft) ); this%medlynslope (:) = nan !# allocate( this%medlynintercept(0:mxpft) ); this%medlynintercept = nan !# - allocate( this%mxmat (0:mxpft) ); this%mxmat (:) = nan8 + allocate( this%mxmat (0:mxpft) ); this%mxmat (:) = bigint allocate( this%mnNHplantdate (0:mxpft) ); this%mnNHplantdate (:) = huge(1) allocate( this%mxNHplantdate (0:mxpft) ); this%mxNHplantdate (:) = huge(1) allocate( this%mnSHplantdate (0:mxpft) ); this%mnSHplantdate (:) = huge(1) From 226bd723f7bb08d25fc436d2d4c57ef068b35a72 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 11:35:43 -0500 Subject: [PATCH 140/589] adding optional inputs to ncd_io routine --- .../CLM51/ncdio_pio.F90 | 66 ++++++++++++++----- 1 file changed, 49 insertions(+), 17 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 29bce6ea6..b370a5288 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -58,7 +58,7 @@ module ncdio_pio contains - subroutine ncd_io_char ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_char ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -68,6 +68,8 @@ subroutine ncd_io_char ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer,optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -84,7 +86,7 @@ subroutine ncd_io_char ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_char - subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -94,6 +96,8 @@ subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer,optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -111,7 +115,7 @@ subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_log_1d !---------------------------------------------------- - subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -121,6 +125,8 @@ subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer,optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -138,7 +144,7 @@ subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_r4_0d !---------------------------------------------------- - subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -148,6 +154,8 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer,optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -166,7 +174,7 @@ end subroutine ncd_io_r4_1d !----------------------------------------------------------------------- - subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -176,6 +184,8 @@ subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -193,7 +203,7 @@ end subroutine ncd_io_r4_2d !----------------------------------------------------------------------- - subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -203,6 +213,8 @@ subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -221,7 +233,7 @@ end subroutine ncd_io_r4_3d !----------------------------------------------------------------------- - subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -231,6 +243,8 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -249,7 +263,7 @@ end subroutine ncd_io_r4_4d !----------------------------------------------------------------------- - subroutine ncd_io_r8_0d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r8_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -259,6 +273,8 @@ subroutine ncd_io_r8_0d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -277,7 +293,7 @@ end subroutine ncd_io_r8_0d !----------------------------------------------------------------------- - subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -287,6 +303,8 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -305,7 +323,7 @@ end subroutine ncd_io_r8_1d !----------------------------------------------------------------------- - subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -315,6 +333,8 @@ subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -334,7 +354,7 @@ end subroutine ncd_io_r8_2d !----------------------------------------------------------------------- - subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -344,6 +364,8 @@ subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -363,7 +385,7 @@ end subroutine ncd_io_r8_3d !----------------------------------------------------------------------- - subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -373,6 +395,8 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -390,7 +414,7 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_r8_4d !----------------------------------------------------------------------- - subroutine ncd_io_i4_0d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_i4_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -400,6 +424,8 @@ subroutine ncd_io_i4_0d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -418,7 +444,7 @@ end subroutine ncd_io_i4_0d !----------------------------------------------------------------------- - subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -428,6 +454,8 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -446,7 +474,7 @@ end subroutine ncd_io_i4_1d !----------------------------------------------------------------------- - subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -456,6 +484,8 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -473,7 +503,7 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_i4_2d !----------------------------------------------------------------------- - subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -483,6 +513,8 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readvar, rc) character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: @@ -500,7 +532,7 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readvar, rc) end subroutine ncd_io_i4_3d !----------------------------------------------------------------------- - subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readvar, rc) + subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- From fe3a514455549897530bcfc20717087824c54c2a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 11:59:55 -0500 Subject: [PATCH 141/589] adding missing variable declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index b370a5288..fd2aa307b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -542,6 +542,8 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi character(len=*), intent(in) :: varname ! variable name logical, intent(out) :: readvar integer, optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! LOCAL: From 869479994494da4e65ebb97b65c3a3567bc7129f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 12:43:13 -0500 Subject: [PATCH 142/589] add read routine for character arrays --- .../CLM51/ncdio_pio.F90 | 35 +++++++++++++++++-- 1 file changed, 32 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index fd2aa307b..68903b565 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -36,7 +36,8 @@ module ncdio_pio interface ncd_io - module procedure ncd_io_char + module procedure ncd_io_char_0d + module procedure ncd_io_char_1d module procedure ncd_io_log_1d module procedure ncd_io_r4_0d module procedure ncd_io_r4_1d @@ -58,7 +59,7 @@ module ncdio_pio contains - subroutine ncd_io_char ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) + subroutine ncd_io_char_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) ! ARGUMENTS: !------------- @@ -84,7 +85,35 @@ subroutine ncd_io_char ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfil if (status ==0) readvar = .true. endif - end subroutine ncd_io_char + end subroutine ncd_io_char_0d + + subroutine ncd_io_char_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) + + ! ARGUMENTS: + !------------- + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(inout) :: data(:) + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + logical, intent(out) :: readvar + integer,optional, intent(out) :: rc + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + + ! LOCAL: + + integer :: status + + !------------------------------------- + + if (flag == 'read') then + readvar = .false. + ! call ncid%get_var(varname, data, rc=status) + call MAPL_VarRead(ncid,varname,data,status) + if (status ==0) readvar = .true. + endif + + end subroutine ncd_io_char_1d subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) From d6949f482fb28de18c93faaaf9969caab2f4852d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 12:43:42 -0500 Subject: [PATCH 143/589] add visible and NIR indices --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index 0ead38a83..179b28607 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -42,6 +42,8 @@ module clm_varpar integer, public, parameter :: nvariants = 2 ! number of variants of PFT constants integer, public, parameter :: numrad = 2 ! number of solar radiation bands: vis, nir + integer, public, parameter :: ivis = 1 ! index for visible band + integer, public, parameter :: inir = 2 ! index for near-infrared band integer, public, parameter :: nlevcan = 1 ! number of leaf layers in canopy layer integer, public, parameter :: nvegwcs = 4 ! number of vegetation water conductance segments From 4d03551cf1dd8fda3e140d387af25065b83a9357 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 12:45:08 -0500 Subject: [PATCH 144/589] add missing use statements and variable declarations --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index f6012b567..bcc8b2d25 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -4,8 +4,8 @@ module pftconMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use nanMod , only : nan, bigint - use clm_varpar , only : mxpft, numrad,nvariants - use clm_varctl , only : use_flexibleCN + use clm_varpar , only : mxpft, numrad,nvariants, ivis, inir + use clm_varctl , only : use_flexibleCN, use_cndv use netcdf use shr_log_mod , only : errMsg => shr_log_errMsg use MAPL , only : NetCDF4_FileFormatter, pFIO_READ @@ -250,7 +250,7 @@ subroutine init_pftcon_type(this) !LOCAL character(300) :: paramfile - integer :: ierr, clm_varid, status + integer :: ierr, clm_varid, status, m logical :: readv ! has variable been read in or not type(Netcdf4_fileformatter) :: ncid From c3de8714f51bacb245db90a477b938fc45eb9443 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 14:03:21 -0500 Subject: [PATCH 145/589] replace nan-module used --- .../CLM51/CNCLM_SaturatedExcessRunoffMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 index d0f1a2833..74bcc7603 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 @@ -13,6 +13,7 @@ module SaturatedExcessRunoffMod use decompMod , only : bounds_type use abortutils , only : endrun use clm_varcon , only : spval + use nanMod , only : nan implicit none save @@ -44,7 +45,6 @@ module SaturatedExcessRunoffMod subroutine init_saturated_excess_runoff_type(bounds, this) ! !USES: - use shr_infnan_mod , only : nan => shr_infnan_nan ! ! !ARGUMENTS: implicit none From 2d3da9237089ab114a965fd46e0ee855fac97c9f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 14:37:00 -0500 Subject: [PATCH 146/589] add nan module and correct typos --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 index 51f51e169..b87e65471 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 @@ -16,6 +16,7 @@ module WaterStateType use clm_varcon , only : spval use LandunitType , only : lun use ColumnType , only : col + use nanMod , only : nan implicit none save @@ -79,8 +80,8 @@ subroutine init_waterstate_type(bounds, this) allocate(this%h2osoi_vol_col(begc:endc,1:nlevmaxurbgrnd)) ; this%h2osoi_vol_col(begc:endc, 1:) = spval allocate(this%h2osoi_vol_prs_grc(begg:endg,1:nlevgrnd)) ; this%h2osoi_vol_prs_grc(begg:endg, 1:) = spval - allocate(this%h2osoi_liq_col(begc:endc,-nlevsno+1nlevmaxurbgrnd)) ; this%h2osoi_liq_col(begc:endc,-nlevsno+1:) = spval - allocate(this%h2osoi_ice_col(begc:endc,-nlevsno+1nlevmaxurbgrnd)) ; this%h2osoi_ice_col(bounds%begc:bounds%endc,-nlevsno+1:) = spval + allocate(this%h2osoi_liq_col(begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%h2osoi_liq_col(begc:endc,-nlevsno+1:) = spval + allocate(this%h2osoi_ice_col(begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%h2osoi_ice_col(bounds%begc:bounds%endc,-nlevsno+1:) = spval allocate( this%wa_col (begc:endc)) ; this%wa_col(begc:endc) = spval allocate( this%h2osno_no_layers_col (begc:endc)) ; this%h2osno_no_layers_col(begc:endc) = nan From 4eae3d5d008ffbca8b2c2e85196f6a71fddde26c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 15:35:36 -0500 Subject: [PATCH 147/589] removing unused functions --- .../CLM51/AnnualFluxDribbler.F90 | 656 +++++++++--------- 1 file changed, 328 insertions(+), 328 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 index aa1e3bbcd..d84780a3a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -61,11 +61,11 @@ module AnnualFluxDribbler use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use shr_kind_mod , only : r8 => shr_kind_r8 - use decompMod , only : bounds_type, get_beg, get_end - use decompMod , only : BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_PATCH + use decompMod , only : bounds_type +! use decompMod , only : BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_PATCH use clm_varcon , only : secspday, nameg, namep - use clm_time_manager , only : get_days_per_year, get_step_size_real, is_beg_curr_year - use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac, get_prev_date + use clm_time_manager , only : get_days_per_year, get_step_size_real + ! use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac, get_prev_date use clm_time_manager , only : is_first_step ! implicit none @@ -104,20 +104,20 @@ module AnnualFluxDribbler real(r8), pointer :: amount_from_this_timestep(:) contains ! Public infrastructure methods - procedure, public :: Restart - procedure, public :: Clean + ! procedure, public :: Restart + ! procedure, public :: Clean ! Public science methods - procedure, public :: set_curr_delta ! Set the delta state for this time step - procedure, public :: get_curr_flux ! Get the current flux for this time step - procedure, public :: get_dribbled_delta ! Similar to get_curr_flux, but gets result as a delta rather than a per-second flux - procedure, public :: get_amount_left_to_dribble_beg ! Get the pseudo-state representing the amount that still needs to be dribbled in this and future time steps - procedure, public :: get_amount_left_to_dribble_end ! Get the pseudo-state representing the amount that still needs to be dribbled in just future time steps + ! procedure, public :: set_curr_delta ! Set the delta state for this time step + ! procedure, public :: get_curr_flux ! Get the current flux for this time step + ! procedure, public :: get_dribbled_delta ! Similar to get_curr_flux, but gets result as a delta rather than a per-second flux + ! procedure, public :: get_amount_left_to_dribble_beg ! Get the pseudo-state representing the amount that still needs to be dribbled in this and future time steps + ! procedure, public :: get_amount_left_to_dribble_end ! Get the pseudo-state representing the amount that still needs to be dribbled in just future time steps ! Private methods procedure, private :: allocate_and_initialize_data procedure, private :: set_metadata - procedure, private :: get_amount_left_to_dribble + ! procedure, private :: get_amount_left_to_dribble end type annual_flux_dribbler_type public :: annual_flux_dribbler_gridcell ! Creates an annual_flux_dribbler_type object at the gridcell-level @@ -217,284 +217,284 @@ end function annual_flux_dribbler_patch ! ======================================================================== !----------------------------------------------------------------------- - subroutine set_curr_delta(this, bounds, delta) - ! - ! !DESCRIPTION: - ! Sets the delta state for this time step. Note that the delta is specified just as - ! the change in state - NOT as a flux (per-second) quantity. - ! - ! This must be called every timestep, even if the deltas are currently 0, in order to - ! zero out any existing stored delta. This can (and generally should) even be called - ! when it isn't the first timestep of the year. For deltas that are non-zero at times - ! other than the first timestep of the year, they will simply be passed on to the - ! output flux in get_curr_flux, making for easier handling by the client. (i.e., this - ! class handles the addition of the dribbled flux and the current flux for you.) - ! - ! !USES: - ! - ! !ARGUMENTS: - class(annual_flux_dribbler_type), intent(inout) :: this - type(bounds_type), intent(in) :: bounds - real(r8), intent(in) :: delta( get_beg(bounds, this%bounds_subgrid_level) : ) - ! - ! !LOCAL VARIABLES: - integer :: beg_index, end_index - integer :: i - integer :: yr, mon, day, tod - - character(len=*), parameter :: subname = 'set_curr_delta' - !----------------------------------------------------------------------- - - beg_index = lbound(delta, 1) - end_index = get_end(bounds, this%bounds_subgrid_level) - SHR_ASSERT_ALL_FL((ubound(delta) == (/end_index/)), sourcefile, __LINE__) - - if (is_beg_curr_year()) then - do i = beg_index, end_index - this%amount_to_dribble(i) = delta(i) - - ! On the first timestep of the year, we don't have any pass-through flux. Need - ! to zero out any previously-set amount_from_this_timestep. - this%amount_from_this_timestep(i) = 0._r8 - end do - else - do i = beg_index, end_index - this%amount_from_this_timestep(i) = delta(i) - end do - if (.not. this%allows_non_annual_delta .and. .not. is_first_step()) then - do i = beg_index, end_index - if (this%amount_from_this_timestep(i) /= 0._r8) then - write(iulog,*) subname//' ERROR: found unexpected non-zero delta mid-year' - write(iulog,*) 'Dribbler name: ', trim(this%name) - write(iulog,*) 'i, delta = ', i, this%amount_from_this_timestep(i) - call get_prev_date(yr, mon, day, tod) - write(iulog,*) 'Start of time step date (yr, mon, day, tod) = ', & - yr, mon, day, tod - write(iulog,*) 'This indicates that some non-zero flux was generated at a time step' - write(iulog,*) 'other than the first time step of the year, which this dribbler was told not to expect.' - write(iulog,*) 'If this non-zero mid-year delta is expected, then you can suppress this error' - write(iulog,*) 'by setting allows_non_annual_delta to .true. when constructing this dribbler.' - call endrun(decomp_index=i, clmlevel=this%name_subgrid, & - msg=subname//': found unexpected non-zero delta mid-year: ' // & - errMsg(sourcefile, __LINE__)) - end if - end do - end if - end if - - end subroutine set_curr_delta - - !----------------------------------------------------------------------- - subroutine get_curr_flux(this, bounds, flux) - ! - ! !DESCRIPTION: - ! Gets the current flux for this timestep, and stores it in the flux argument. - ! - ! This should be called AFTER set_curr_delta is called for the given timestep. - ! - ! This will get the current flux for this timestep, which is the sum of (1) the - ! dribbled flux from the last start-of-year timestep, and (2) the current timestep's - ! flux, based on the delta passed in to set_curr_delta in this timestep, if this is - ! not the start-of-year timestep. - ! - ! !USES: - ! - ! !ARGUMENTS: - class(annual_flux_dribbler_type), intent(in) :: this - type(bounds_type), intent(in) :: bounds - real(r8), intent(out) :: flux( get_beg(bounds, this%bounds_subgrid_level) : ) - ! - ! !LOCAL VARIABLES: - integer :: beg_index, end_index - integer :: i - real(r8) :: secs_per_year - real(r8) :: dtime - real(r8) :: flux_from_dribbling - real(r8) :: flux_from_this_timestep - - character(len=*), parameter :: subname = 'get_curr_flux' - !----------------------------------------------------------------------- - - beg_index = lbound(flux, 1) - end_index = get_end(bounds, this%bounds_subgrid_level) - SHR_ASSERT_ALL_FL((ubound(flux) == (/end_index/)), sourcefile, __LINE__) - - secs_per_year = get_days_per_year() * secspday - dtime = get_step_size_real() - - do i = beg_index, end_index - flux_from_dribbling = this%amount_to_dribble(i) / secs_per_year - flux_from_this_timestep = this%amount_from_this_timestep(i) / dtime - flux(i) = flux_from_dribbling + flux_from_this_timestep - end do - - end subroutine get_curr_flux - - !----------------------------------------------------------------------- - subroutine get_dribbled_delta(this, bounds, delta) - ! - ! !DESCRIPTION: - ! Gets the current delta for this timestep, and stores it in the delta argument. - ! - ! This is similar to get_curr_flux, but returns the total, dribbled delta over this - ! timestep, rather than a per-second flux. See documentation in get_curr_flux for - ! more usage details. - ! - ! !USES: - ! - ! !ARGUMENTS: - class(annual_flux_dribbler_type), intent(in) :: this - type(bounds_type), intent(in) :: bounds - real(r8), intent(out) :: delta( get_beg(bounds, this%bounds_subgrid_level) : ) - ! - ! !LOCAL VARIABLES: - integer :: beg_index, end_index - integer :: i - real(r8) :: dtime - real(r8), allocatable :: flux(:) - - character(len=*), parameter :: subname = 'get_dribbled_delta' - !----------------------------------------------------------------------- - - beg_index = lbound(delta, 1) - end_index = get_end(bounds, this%bounds_subgrid_level) - SHR_ASSERT_ALL_FL((ubound(delta) == (/end_index/)), sourcefile, __LINE__) - - allocate(flux(beg_index:end_index)) - - call this%get_curr_flux(bounds, flux(beg_index:end_index)) - - dtime = get_step_size_real() - do i = beg_index, end_index - delta(i) = flux(i) * dtime - end do - - end subroutine get_dribbled_delta - - - !----------------------------------------------------------------------- - subroutine get_amount_left_to_dribble_beg(this, bounds, amount_left_to_dribble) - ! - ! !DESCRIPTION: - ! Get the pseudo-state representing the amount that still needs to be dribbled in - ! this and future time steps. This represents the pseudo-state before this time - ! step's dribbling flux has been removed. (This behavior is regardless of whether - ! get_curr_flux has been called already this time step.) - ! - ! As a special case, this returns 0 in the first time step of the year, because we - ! haven't created this year's dribbling pool as of the beginning of this time step. - ! - ! i.e., if we imagined that the total amount to dribble was added to a state - ! variable, and then this state variable was updated each time step as the flux - ! dribbles out, then this subroutine gives the amount left in that state. (However, - ! the actual implementation doesn't explicitly track this state, which is why we - ! refer to it as a pseudo-state.) - ! - ! !USES: - ! - ! !ARGUMENTS: - class(annual_flux_dribbler_type), intent(in) :: this - type(bounds_type), intent(in) :: bounds - real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) - ! - ! !LOCAL VARIABLES: - real(r8) :: yearfrac - - character(len=*), parameter :: subname = 'get_amount_left_to_dribble_beg' - !----------------------------------------------------------------------- - - yearfrac = get_prev_yearfrac() - call this%get_amount_left_to_dribble(bounds, yearfrac, amount_left_to_dribble) - - end subroutine get_amount_left_to_dribble_beg - - - !----------------------------------------------------------------------- - subroutine get_amount_left_to_dribble_end(this, bounds, amount_left_to_dribble) - ! - ! !DESCRIPTION: - ! Gets the pseudo-state representing the amount that still needs to be dribbled in - ! future time steps. This represents the pseudo-state after this time step's dribbling - ! flux has been removed. i.e., this includes the amount that will be dribbled starting - ! with the *next* time step, through the end of this year. So this will return 0 on - ! the last time step of the year. (This behavior is regardless of whether - ! get_curr_flux has been called already this time step.) - ! - ! See documentation of get_amount_left_to_dribble_beg for more details. - ! - ! !ARGUMENTS: - class(annual_flux_dribbler_type), intent(in) :: this - type(bounds_type), intent(in) :: bounds - real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) - ! - ! !LOCAL VARIABLES: - real(r8) :: yearfrac - - character(len=*), parameter :: subname = 'get_amount_left_to_dribble_end' - !----------------------------------------------------------------------- - - yearfrac = get_curr_yearfrac() - call this%get_amount_left_to_dribble(bounds, yearfrac, amount_left_to_dribble) - - end subroutine get_amount_left_to_dribble_end - - - !----------------------------------------------------------------------- - subroutine Restart(this, bounds, ncid, flag) - ! - ! !USES: - use ncdio_pio, only : file_desc_t, ncd_double - use restUtilMod - ! - ! !ARGUMENTS: - class(annual_flux_dribbler_type), intent(inout) :: this - type(bounds_type), intent(in) :: bounds - type(file_desc_t), intent(inout) :: ncid ! netcdf id - character(len=*) , intent(in) :: flag ! 'read' or 'write' - ! - ! !LOCAL VARIABLES: - character(len=:), allocatable :: restname ! name of field on restart file - logical :: readvar - - character(len=*), parameter :: subname = 'Restart' - !----------------------------------------------------------------------- - - restname = trim(this%name) // '_amt_to_dribble' - call restartvar(ncid=ncid, flag=flag, varname=restname, xtype=ncd_double, & - dim1name = this%dim1name, & - long_name = 'total amount to dribble over the year for ' // trim(this%name), & - units = trim(this%units), & - interpinic_flag = 'interp', & - readvar = readvar, & - data = this%amount_to_dribble) - - end subroutine Restart - - !----------------------------------------------------------------------- - subroutine Clean(this) - ! - ! !DESCRIPTION: - ! Deallocate memory associated with this object - ! - ! !USES: - ! - ! !ARGUMENTS: - class(annual_flux_dribbler_type), intent(inout) :: this - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'Clean' - !----------------------------------------------------------------------- - - deallocate(this%amount_to_dribble) - deallocate(this%amount_from_this_timestep) - - end subroutine Clean - - ! ======================================================================== - ! Private methods - ! ======================================================================== - +! subroutine set_curr_delta(this, bounds, delta) +! ! +! ! !DESCRIPTION: +! ! Sets the delta state for this time step. Note that the delta is specified just as +! ! the change in state - NOT as a flux (per-second) quantity. +! ! +! ! This must be called every timestep, even if the deltas are currently 0, in order to +! ! zero out any existing stored delta. This can (and generally should) even be called +! ! when it isn't the first timestep of the year. For deltas that are non-zero at times +! ! other than the first timestep of the year, they will simply be passed on to the +! ! output flux in get_curr_flux, making for easier handling by the client. (i.e., this +! ! class handles the addition of the dribbled flux and the current flux for you.) +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(annual_flux_dribbler_type), intent(inout) :: this +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(in) :: delta( get_beg(bounds, this%bounds_subgrid_level) : ) +! ! +! ! !LOCAL VARIABLES: +! integer :: beg_index, end_index +! integer :: i +! integer :: yr, mon, day, tod +! +! character(len=*), parameter :: subname = 'set_curr_delta' +! !----------------------------------------------------------------------- +! +! beg_index = lbound(delta, 1) +! end_index = get_end(bounds, this%bounds_subgrid_level) +! SHR_ASSERT_ALL_FL((ubound(delta) == (/end_index/)), sourcefile, __LINE__) +! +! if (is_beg_curr_year()) then +! do i = beg_index, end_index +! this%amount_to_dribble(i) = delta(i) +! +! ! On the first timestep of the year, we don't have any pass-through flux. Need +! ! to zero out any previously-set amount_from_this_timestep. +! this%amount_from_this_timestep(i) = 0._r8 +! end do +! else +! do i = beg_index, end_index +! this%amount_from_this_timestep(i) = delta(i) +! end do +! if (.not. this%allows_non_annual_delta .and. .not. is_first_step()) then +! do i = beg_index, end_index +! if (this%amount_from_this_timestep(i) /= 0._r8) then +! write(iulog,*) subname//' ERROR: found unexpected non-zero delta mid-year' +! write(iulog,*) 'Dribbler name: ', trim(this%name) +! write(iulog,*) 'i, delta = ', i, this%amount_from_this_timestep(i) +! call get_prev_date(yr, mon, day, tod) +! write(iulog,*) 'Start of time step date (yr, mon, day, tod) = ', & +! yr, mon, day, tod +! write(iulog,*) 'This indicates that some non-zero flux was generated at a time step' +! write(iulog,*) 'other than the first time step of the year, which this dribbler was told not to expect.' +! write(iulog,*) 'If this non-zero mid-year delta is expected, then you can suppress this error' +! write(iulog,*) 'by setting allows_non_annual_delta to .true. when constructing this dribbler.' +! call endrun(decomp_index=i, clmlevel=this%name_subgrid, & +! msg=subname//': found unexpected non-zero delta mid-year: ' // & +! errMsg(sourcefile, __LINE__)) +! end if +! end do +! end if +! end if +! +! end subroutine set_curr_delta +! +! !----------------------------------------------------------------------- +! subroutine get_curr_flux(this, bounds, flux) +! ! +! ! !DESCRIPTION: +! ! Gets the current flux for this timestep, and stores it in the flux argument. +! ! +! ! This should be called AFTER set_curr_delta is called for the given timestep. +! ! +! ! This will get the current flux for this timestep, which is the sum of (1) the +! ! dribbled flux from the last start-of-year timestep, and (2) the current timestep's +! ! flux, based on the delta passed in to set_curr_delta in this timestep, if this is +! ! not the start-of-year timestep. +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(annual_flux_dribbler_type), intent(in) :: this +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(out) :: flux( get_beg(bounds, this%bounds_subgrid_level) : ) +! ! +! ! !LOCAL VARIABLES: +! integer :: beg_index, end_index +! integer :: i +! real(r8) :: secs_per_year +! real(r8) :: dtime +! real(r8) :: flux_from_dribbling +! real(r8) :: flux_from_this_timestep +! +! character(len=*), parameter :: subname = 'get_curr_flux' +! !----------------------------------------------------------------------- +! +! beg_index = lbound(flux, 1) +! end_index = get_end(bounds, this%bounds_subgrid_level) +! SHR_ASSERT_ALL_FL((ubound(flux) == (/end_index/)), sourcefile, __LINE__) +! +! secs_per_year = get_days_per_year() * secspday +! dtime = get_step_size_real() +! +! do i = beg_index, end_index +! flux_from_dribbling = this%amount_to_dribble(i) / secs_per_year +! flux_from_this_timestep = this%amount_from_this_timestep(i) / dtime +! flux(i) = flux_from_dribbling + flux_from_this_timestep +! end do +! +! end subroutine get_curr_flux +! +! !----------------------------------------------------------------------- +! subroutine get_dribbled_delta(this, bounds, delta) +! ! +! ! !DESCRIPTION: +! ! Gets the current delta for this timestep, and stores it in the delta argument. +! ! +! ! This is similar to get_curr_flux, but returns the total, dribbled delta over this +! ! timestep, rather than a per-second flux. See documentation in get_curr_flux for +! ! more usage details. +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(annual_flux_dribbler_type), intent(in) :: this +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(out) :: delta( get_beg(bounds, this%bounds_subgrid_level) : ) +! ! +! ! !LOCAL VARIABLES: +! integer :: beg_index, end_index +! integer :: i +! real(r8) :: dtime +! real(r8), allocatable :: flux(:) +! +! character(len=*), parameter :: subname = 'get_dribbled_delta' +! !----------------------------------------------------------------------- +! +! beg_index = lbound(delta, 1) +! end_index = get_end(bounds, this%bounds_subgrid_level) +! SHR_ASSERT_ALL_FL((ubound(delta) == (/end_index/)), sourcefile, __LINE__) +! +! allocate(flux(beg_index:end_index)) +! +! call this%get_curr_flux(bounds, flux(beg_index:end_index)) +! +! dtime = get_step_size_real() +! do i = beg_index, end_index +! delta(i) = flux(i) * dtime +! end do +! +! end subroutine get_dribbled_delta +! +! +! !----------------------------------------------------------------------- +! subroutine get_amount_left_to_dribble_beg(this, bounds, amount_left_to_dribble) +! ! +! ! !DESCRIPTION: +! ! Get the pseudo-state representing the amount that still needs to be dribbled in +! ! this and future time steps. This represents the pseudo-state before this time +! ! step's dribbling flux has been removed. (This behavior is regardless of whether +! ! get_curr_flux has been called already this time step.) +! ! +! ! As a special case, this returns 0 in the first time step of the year, because we +! ! haven't created this year's dribbling pool as of the beginning of this time step. +! ! +! ! i.e., if we imagined that the total amount to dribble was added to a state +! ! variable, and then this state variable was updated each time step as the flux +! ! dribbles out, then this subroutine gives the amount left in that state. (However, +! ! the actual implementation doesn't explicitly track this state, which is why we +! ! refer to it as a pseudo-state.) +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(annual_flux_dribbler_type), intent(in) :: this +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) +! ! +! ! !LOCAL VARIABLES: +! real(r8) :: yearfrac +! +! character(len=*), parameter :: subname = 'get_amount_left_to_dribble_beg' +! !----------------------------------------------------------------------- +! +! yearfrac = get_prev_yearfrac() +! call this%get_amount_left_to_dribble(bounds, yearfrac, amount_left_to_dribble) +! +! end subroutine get_amount_left_to_dribble_beg +! +! +! !----------------------------------------------------------------------- +! subroutine get_amount_left_to_dribble_end(this, bounds, amount_left_to_dribble) +! ! +! ! !DESCRIPTION: +! ! Gets the pseudo-state representing the amount that still needs to be dribbled in +! ! future time steps. This represents the pseudo-state after this time step's dribbling +! ! flux has been removed. i.e., this includes the amount that will be dribbled starting +! ! with the *next* time step, through the end of this year. So this will return 0 on +! ! the last time step of the year. (This behavior is regardless of whether +! ! get_curr_flux has been called already this time step.) +! ! +! ! See documentation of get_amount_left_to_dribble_beg for more details. +! ! +! ! !ARGUMENTS: +! class(annual_flux_dribbler_type), intent(in) :: this +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) +! ! +! ! !LOCAL VARIABLES: +! real(r8) :: yearfrac +! +! character(len=*), parameter :: subname = 'get_amount_left_to_dribble_end' +! !----------------------------------------------------------------------- +! +! yearfrac = get_curr_yearfrac() +! call this%get_amount_left_to_dribble(bounds, yearfrac, amount_left_to_dribble) +! +! end subroutine get_amount_left_to_dribble_end +! +! +! !----------------------------------------------------------------------- +! subroutine Restart(this, bounds, ncid, flag) +! ! +! ! !USES: +! use ncdio_pio, only : file_desc_t, ncd_double +! use restUtilMod +! ! +! ! !ARGUMENTS: +! class(annual_flux_dribbler_type), intent(inout) :: this +! type(bounds_type), intent(in) :: bounds +! type(file_desc_t), intent(inout) :: ncid ! netcdf id +! character(len=*) , intent(in) :: flag ! 'read' or 'write' +! ! +! ! !LOCAL VARIABLES: +! character(len=:), allocatable :: restname ! name of field on restart file +! logical :: readvar +! +! character(len=*), parameter :: subname = 'Restart' +! !----------------------------------------------------------------------- +! +! restname = trim(this%name) // '_amt_to_dribble' +! call restartvar(ncid=ncid, flag=flag, varname=restname, xtype=ncd_double, & +! dim1name = this%dim1name, & +! long_name = 'total amount to dribble over the year for ' // trim(this%name), & +! units = trim(this%units), & +! interpinic_flag = 'interp', & +! readvar = readvar, & +! data = this%amount_to_dribble) +! +! end subroutine Restart +! +! !----------------------------------------------------------------------- +! subroutine Clean(this) +! ! +! ! !DESCRIPTION: +! ! Deallocate memory associated with this object +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(annual_flux_dribbler_type), intent(inout) :: this +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'Clean' +! !----------------------------------------------------------------------- +! +! deallocate(this%amount_to_dribble) +! deallocate(this%amount_from_this_timestep) +! +! end subroutine Clean +! +! ! ======================================================================== +! ! Private methods +! ! ======================================================================== +! !----------------------------------------------------------------------- subroutine allocate_and_initialize_data(this, bounds) ! @@ -573,43 +573,43 @@ subroutine set_metadata(this, name, units, allows_non_annual_delta) end subroutine set_metadata !----------------------------------------------------------------------- - subroutine get_amount_left_to_dribble(this, bounds, yearfrac, amount_left_to_dribble) - ! - ! !DESCRIPTION: - ! Helper method shared by get_amount_left_to_dribble_beg and - ! get_amount_left_to_dribble_end. Returns amount left to dribble as of a given - ! yearfrac. - ! - ! !USES: - ! - ! !ARGUMENTS: - class(annual_flux_dribbler_type), intent(in) :: this - type(bounds_type), intent(in) :: bounds - real(r8), intent(in) :: yearfrac - real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) - ! - ! !LOCAL VARIABLES: - integer :: beg_index, end_index - integer :: i - - character(len=*), parameter :: subname = 'get_amount_left_to_dribble' - !----------------------------------------------------------------------- - - beg_index = lbound(amount_left_to_dribble, 1) - end_index = get_end(bounds, this%bounds_subgrid_level) - SHR_ASSERT_ALL_FL((ubound(amount_left_to_dribble) == (/end_index/)), sourcefile, __LINE__) - - do i = beg_index, end_index - if (yearfrac < 1.e-15_r8) then - ! last time step of year; we'd like this to be given a yearfrac of 1 rather than - ! 0 in this case; since it's given as 0, we need to handle it specially - amount_left_to_dribble(i) = 0._r8 - else - amount_left_to_dribble(i) = this%amount_to_dribble(i) * (1._r8 - yearfrac) - end if - end do - - end subroutine get_amount_left_to_dribble - +! subroutine get_amount_left_to_dribble(this, bounds, yearfrac, amount_left_to_dribble) +! ! +! ! !DESCRIPTION: +! ! Helper method shared by get_amount_left_to_dribble_beg and +! ! get_amount_left_to_dribble_end. Returns amount left to dribble as of a given +! ! yearfrac. +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(annual_flux_dribbler_type), intent(in) :: this +! type(bounds_type), intent(in) :: bounds +! real(r8), intent(in) :: yearfrac +! real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) +! ! +! ! !LOCAL VARIABLES: +! integer :: beg_index, end_index +! integer :: i +! +! character(len=*), parameter :: subname = 'get_amount_left_to_dribble' +! !----------------------------------------------------------------------- +! +! beg_index = lbound(amount_left_to_dribble, 1) +! end_index = get_end(bounds, this%bounds_subgrid_level) +! SHR_ASSERT_ALL_FL((ubound(amount_left_to_dribble) == (/end_index/)), sourcefile, __LINE__) +! +! do i = beg_index, end_index +! if (yearfrac < 1.e-15_r8) then +! ! last time step of year; we'd like this to be given a yearfrac of 1 rather than +! ! 0 in this case; since it's given as 0, we need to handle it specially +! amount_left_to_dribble(i) = 0._r8 +! else +! amount_left_to_dribble(i) = this%amount_to_dribble(i) * (1._r8 - yearfrac) +! end if +! end do +! +! end subroutine get_amount_left_to_dribble +! end module AnnualFluxDribbler From aed7f2ccc354504b300d38dc291ff9af32735b1d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 16:42:10 -0500 Subject: [PATCH 148/589] reinstate use statements --- .../GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 index d84780a3a..eaa909475 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -61,8 +61,8 @@ module AnnualFluxDribbler use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use shr_kind_mod , only : r8 => shr_kind_r8 - use decompMod , only : bounds_type -! use decompMod , only : BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_PATCH + use decompMod , only : bounds_type, get_beg, get_end + use decompMod , only : BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_PATCH use clm_varcon , only : secspday, nameg, namep use clm_time_manager , only : get_days_per_year, get_step_size_real ! use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac, get_prev_date From e7f99a629c10210108ac2d6c4b46b35c6de24204 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Dec 2022 16:42:33 -0500 Subject: [PATCH 149/589] reinstate needed functions --- .../CLM51/CNCLM_decompMod.F90 | 95 ++++++++++++++++++- 1 file changed, 94 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 index 0b4fa0dce..e5f3f5869 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 @@ -7,8 +7,18 @@ module decompMod implicit none save ! -! !PUBLIC MEMBER FUNCTIONS: + ! Define possible bounds subgrid levels + integer, parameter, public :: BOUNDS_SUBGRID_GRIDCELL = 1 + integer, parameter, public :: BOUNDS_SUBGRID_LANDUNIT = 2 + integer, parameter, public :: BOUNDS_SUBGRID_COLUMN = 3 + integer, parameter, public :: BOUNDS_SUBGRID_PATCH = 4 + integer, parameter, public :: BOUNDS_SUBGRID_COHORT = 5 + + ! !PUBLIC MEMBER FUNCTIONS: + + public get_beg ! get beg bound for a given subgrid level + public get_end ! get end bound for a given subgrid level public :: init_bounds type bounds_type @@ -42,4 +52,87 @@ subroutine init_bounds(nch, this) this%begp = 1 ; this%endp = nch*NUM_ZON*(numpft+1) end subroutine init_bounds + + + !----------------------------------------------------------------------- + pure function get_beg(bounds, subgrid_level) result(beg_index) + ! + ! !DESCRIPTION: + ! Get beginning bounds for a given subgrid level + ! + ! subgrid_level should be one of the constants defined in this module: + ! BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_LANDUNIT, etc. + ! + ! Returns -1 for invalid subgrid_level (does not abort in this case, in order to keep + ! this function pure). + ! + ! !USES: + ! + ! !ARGUMENTS: + integer :: beg_index ! function result + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: subgrid_level + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_beg' + !----------------------------------------------------------------------- + + select case (subgrid_level) + case (BOUNDS_SUBGRID_GRIDCELL) + beg_index = bounds%begg + case (BOUNDS_SUBGRID_LANDUNIT) + beg_index = bounds%begl + case (BOUNDS_SUBGRID_COLUMN) + beg_index = bounds%begc + case (BOUNDS_SUBGRID_PATCH) + beg_index = bounds%begp + case (BOUNDS_SUBGRID_COHORT) + beg_index = bounds%begCohort + case default + beg_index = -1 + end select + + end function get_beg + + !----------------------------------------------------------------------- + pure function get_end(bounds, subgrid_level) result(end_index) + ! + ! !DESCRIPTION: + ! Get end bounds for a given subgrid level + ! + ! subgrid_level should be one of the constants defined in this module: + ! BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_LANDUNIT, etc. + ! + ! Returns -1 for invalid subgrid_level (does not abort in this case, in order to keep + ! this function pure). + ! + ! !USES: + ! + ! !ARGUMENTS: + integer :: end_index ! function result + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: subgrid_level + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_end' + !----------------------------------------------------------------------- + + select case (subgrid_level) + case (BOUNDS_SUBGRID_GRIDCELL) + end_index = bounds%endg + case (BOUNDS_SUBGRID_LANDUNIT) + end_index = bounds%endl + case (BOUNDS_SUBGRID_COLUMN) + end_index = bounds%endc + case (BOUNDS_SUBGRID_PATCH) + end_index = bounds%endp + case (BOUNDS_SUBGRID_COHORT) + end_index = bounds%endCohort + case default + end_index = -1 + end select + + end function get_end end module decompMod From 67821c4a55a6676dfc6d1082d37ad562f33eec94 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 11:33:19 -0500 Subject: [PATCH 150/589] correct typo --- .../CLM51/SoilBiogeochemDecompCascadeCNMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 index c70650ce5..0dbbf6464 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 @@ -664,7 +664,7 @@ subroutine decomp_rate_constants_cn(bounds, & o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) ! Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) - ) + ! ) mino2lim = CNParamsShareInst%mino2lim From 24f8f9aafb9082588b008740d7fcb0b469c2215b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 11:33:46 -0500 Subject: [PATCH 151/589] add missing function --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index b4e260a4f..7a11e973b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -20,6 +20,7 @@ module SoilBiogeochemStateType ! ! !PUBLIC MEMBER FUNCTIONS: public :: init_soilbiogeochem_state_type + public :: get_spinup_latitude_term ! !PUBLIC TYPES: type, public :: soilbiogeochem_state_type @@ -112,4 +113,25 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, t end do ! nc end subroutine init_soilbiogeochem_state_type + +!----------------------------------------------- + function get_spinup_latitude_term(latitude) result(ans) + + !!DESCRIPTION: + ! calculate a logistic function to scale spinup factors so that spinup is more accelerated in high latitude regions + ! + ! !REVISION HISTORY + ! charlie koven, nov. 2015 + ! + ! !ARGUMENTS: + real(r8), intent(in) :: latitude + ! + ! !LOCAL VARIABLES: + real(r8) :: ans + + ans = 1._r8 + 50._r8 / ( 1._r8 + exp(-0.15_r8 * (abs(latitude) - 60._r8) ) ) + + return + end function get_spinup_latitude_term + end module SoilBiogeochemStateType From 72f3e7ed332acdc5aaed9679ff7d6055e437e75f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 12:50:06 -0500 Subject: [PATCH 152/589] removing unused use statements --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 index 2fab9c2a7..d883d2f54 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_initVerticalMod.F90 @@ -21,9 +21,7 @@ module initVerticalMod use fileutils , only : getfil use LandunitType , only : lun use GridcellType , only : grc - use ColumnType , only : col - use glcBehaviorMod , only : glc_behavior_type - use SnowHydrologyMod , only : InitSnowLayers + use ColumnType , only : col use abortUtils , only : endrun use ncdio_pio ! From 29027d2be5105b5a3768eee4d027564715463d54 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 13:28:23 -0500 Subject: [PATCH 153/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 index 97c1ab9ba..c1ffcda35 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -71,7 +71,7 @@ subroutine init_dgvs_type(bounds, this) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(solarabs_type), intent(inout):: this + type(dgvs_type), intent(inout):: this !LOCAL integer, intent(in) :: begp, endp From 240e76ff80b99d248fa8b99b413db8f6315dec10 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 13:28:39 -0500 Subject: [PATCH 154/589] add maxveg --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index 179b28607..f82b5e9fa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -37,6 +37,7 @@ module clm_varpar integer, parameter :: numpft = 15!19 ! actual # of pfts (without bare), 16 here, since we are removing the split types integer, parameter :: mxpft = 15 ! + integer, public :: maxveg ! # of pfts + cfts integer, public :: maxsoil_patches = numpft + 1 ! # of pfts + cfts + bare ground; replaces maxpatch_pft, which is obsolete integer, public, parameter :: nvariants = 2 ! number of variants of PFT constants @@ -132,6 +133,7 @@ subroutine clm_varpar_init() nlevmaxurbgrnd = max0(nlevurb,nlevgrnd) nlevmaxurbgrnd = nlevgrnd ! jkolassa: set this here, since we are not modelling urban tiles for now max_patch_per_col = maxsoil_patches ! since we don't have CFTs or urban patches + maxveg = maxsoil_patches - 1 ! # of patches without bare ground ! here is a switch to set the number of soil levels for the biogeochemistry calculations. ! currently it works on either a single level or on nlevsoi and nlevgrnd levels From 092aa5c485e080c4c1266d1caeb87811e2fc0914 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 13:58:13 -0500 Subject: [PATCH 155/589] typo fix --- .../CLM51/SoilBiogeochemDecompCascadeCNMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 index 0dbbf6464..a61a6fddd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 @@ -662,9 +662,9 @@ subroutine decomp_rate_constants_cn(bounds, & t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Output: [real(r8) (:,:) ] soil temperature scalar for decomp w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia - decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) ! Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) - ! ) + ) mino2lim = CNParamsShareInst%mino2lim From 0c580afe0ff7a13e36a75a310180d9898d612682 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 16:36:21 -0500 Subject: [PATCH 156/589] adding nitrification loss parameter --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index c24c4d1a5..db29abf05 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -84,6 +84,8 @@ module clm_varcon ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis real(r8), public, parameter :: c3_r2 = c3_r1/(1._r8 + c3_r1) + real(r8), public, parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000) + ! !PUBLIC MEMBER FUNCTIONS: public clm_varcon_init ! Initialze constants that need to be initialized From eba7c51f51ee318b615964131a24b8c68ba4e6c8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 10:03:35 -0500 Subject: [PATCH 157/589] add rotuine to set carbon threshold --- .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index efd6f4bc6..dbdbebce7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -68,7 +68,8 @@ module SoilBiogeochemNitrogenStateType contains - procedure, public :: Summary + procedure , public :: Summary + procedure , public :: SetTotVgCThresh end type soilbiogeochem_nitrogenstate_type type(soilbiogeochem_nitrogenstate_type), public, target, save :: soilbiogeochem_nitrogenstate_inst @@ -397,4 +398,19 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end subroutine Summary + !------------------------------------------------------------------------ + subroutine SetTotVgCThresh(this, totvegcthresh) + + class(soilbiogeochem_nitrogenstate_type) :: this + real(r8) , intent(in) :: totvegcthresh + + if ( totvegcthresh <= 0.0_r8 )then + call endrun(msg=' Error totvegcthresh is zero or negative and should be > 0'//& + errMsg(sourcefile, __LINE__)) + end if + this%totvegcthresh = totvegcthresh + + end subroutine SetTotVgCThresh + + end module SoilBiogeochemNitrogenStateType From bf94103e33b17ff5c9acea183fd4287a92e1b23b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 10:33:31 -0500 Subject: [PATCH 158/589] add variable declaration for msg --- .../CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 | 1 + .../CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 | 1 + 2 files changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index 6ec94af7c..c92c11a12 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -364,6 +364,7 @@ subroutine SetTotVgCThresh(this, totvegcthresh) class(soilbiogeochem_carbonstate_type) :: this real(r8) , intent(in) :: totvegcthresh + character(len=512) :: msg if ( totvegcthresh <= 0.0_r8 )then call endrun(msg=' ERROR totvegcthresh is zero or negative and should be > 0'//& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index dbdbebce7..d0a544c34 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -403,6 +403,7 @@ subroutine SetTotVgCThresh(this, totvegcthresh) class(soilbiogeochem_nitrogenstate_type) :: this real(r8) , intent(in) :: totvegcthresh + character(len=512) :: msg if ( totvegcthresh <= 0.0_r8 )then call endrun(msg=' Error totvegcthresh is zero or negative and should be > 0'//& From c621fe3e063e14def69bab6be3b09c4405b4f918 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 10:35:58 -0500 Subject: [PATCH 159/589] add missing arguments --- .../CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index d0a544c34..557e0f6ed 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -1,6 +1,7 @@ module SoilBiogeochemNitrogenStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use shr_log_mod , only : errMsg => shr_log_errMsg use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi, & @@ -74,6 +75,9 @@ module SoilBiogeochemNitrogenStateType end type soilbiogeochem_nitrogenstate_type type(soilbiogeochem_nitrogenstate_type), public, target, save :: soilbiogeochem_nitrogenstate_inst + character(len=*), parameter, private :: sourcefile = & + __FILE__ + contains !------------------------------------------- From 8955c48033d6d5a4ff87bb2db0efae80b129c7b5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 10:54:20 -0500 Subject: [PATCH 160/589] add missing use statement --- .../CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index 557e0f6ed..db2dc06fb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -2,6 +2,7 @@ module SoilBiogeochemNitrogenStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi, & From efd9e02842488b551564075dcb13ed13e1b4bd29 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 11:17:29 -0500 Subject: [PATCH 161/589] update variable type --- .../CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index db2dc06fb..7f1afb05b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -1,6 +1,6 @@ module SoilBiogeochemNitrogenStateType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use nanMod , only : nan From b56a372a8c517af5b3dd7fb49b4a1e1a547a57c0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 11:38:28 -0500 Subject: [PATCH 162/589] use nanMod --- .../CLM51/CNCLM_FrictionVelocityMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 index d118def30..62d7152e8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 @@ -8,6 +8,7 @@ module FrictionVelocityMod ! !USES: #include "shr_assert.h" use shr_kind_mod , only : r8 => shr_kind_r8 + use nanMod , only : nan use shr_log_mod , only : errMsg => shr_log_errMsg use shr_const_mod , only : SHR_CONST_PI use decompMod , only : bounds_type @@ -84,7 +85,7 @@ module FrictionVelocityMod !------------------------------------------------------------------------ subroutine init_frictionvel_type( bounds, this) - use shr_infnan_mod , only : nan => shr_infnan_nan + ! use shr_infnan_mod , only : nan => shr_infnan_nan type(bounds_type), intent(in) :: bounds type(frictionvel_type), intent(inout) :: this From 2cd916222fc79f796822497f8ceaaf49e2f51872 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 13:23:15 -0500 Subject: [PATCH 163/589] add missing variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 2aa7ee836..91f8ba541 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -73,6 +73,7 @@ module clm_varctl ! 0 (default) = normal model; 1 = AD SPINUP integer, public :: spinup_state = 0 + logical, public :: use_snicar_frc = .false. contains !--------------------------------------- From 4071296cf22443321eaa08669af607deee00c5cd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 13:23:35 -0500 Subject: [PATCH 164/589] remove unused function --- .../CLM51/SurfaceRadiationMod.F90 | 384 +++++++++--------- 1 file changed, 192 insertions(+), 192 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 index 7000cdaca..d5dda10b7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 @@ -151,198 +151,198 @@ subroutine InitAllocate(this, bounds) end subroutine InitAllocate !----------------------------------------------------------------------- - subroutine InitHistory(this, bounds) - ! - ! History fields initialization - ! - ! !USES: - use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) - use clm_varcon , only : spval - use histFileMod , only : hist_addfld1d, hist_addfld2d - use clm_varctl , only : use_SSRE - ! - ! !ARGUMENTS: - class(surfrad_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: begp, endp - integer :: begc, endc - real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays - !--------------------------------------------------------------------- - - begp = bounds%begp; endp = bounds%endp - begc = bounds%begc; endc = bounds%endc - - if (use_snicar_frc) then - this%sfc_frc_aer_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOAERFRCL', units='W/m^2', & - avgflag='A', long_name='surface forcing of all aerosols in snow (land) ', & - ptr_patch=this%sfc_frc_aer_patch, set_urb=spval) - - this%sfc_frc_aer_sno_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOAERFRC2L', units='W/m^2', & - avgflag='A', long_name='surface forcing of all aerosols in snow, averaged only when snow is present (land)', & - ptr_patch=this%sfc_frc_aer_sno_patch, set_urb=spval) - - this%sfc_frc_bc_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOBCFRCL', units='W/m^2', & - avgflag='A', long_name='surface forcing of BC in snow (land) ', & - ptr_patch=this%sfc_frc_bc_patch, set_urb=spval) - - this%sfc_frc_bc_sno_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOBCFRC2L', units='W/m^2', & - avgflag='A', long_name='surface forcing of BC in snow, averaged only when snow is present (land)', & - ptr_patch=this%sfc_frc_bc_sno_patch, set_urb=spval) - - this%sfc_frc_oc_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', & - avgflag='A', long_name='surface forcing of OC in snow (land) ', & - ptr_patch=this%sfc_frc_oc_patch, set_urb=spval) - - this%sfc_frc_oc_sno_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOOCFRC2L', units='W/m^2', & - avgflag='A', long_name='surface forcing of OC in snow, averaged only when snow is present (land)', & - ptr_patch=this%sfc_frc_oc_sno_patch, set_urb=spval) - - this%sfc_frc_dst_patch(begp:endp) = spval - call hist_addfld1d (fname='SNODSTFRCL', units='W/m^2', & - avgflag='A', long_name='surface forcing of dust in snow (land) ', & - ptr_patch=this%sfc_frc_dst_patch, set_urb=spval) - - this%sfc_frc_dst_sno_patch(begp:endp) = spval - call hist_addfld1d (fname='SNODSTFRC2L', units='W/m^2', & - avgflag='A', long_name='surface forcing of dust in snow, averaged only when snow is present (land)', & - ptr_patch=this%sfc_frc_dst_sno_patch, set_urb=spval) - end if - - this%fsds_vis_d_patch(begp:endp) = spval - call hist_addfld1d (fname='FSDSVD', units='W/m^2', & - avgflag='A', long_name='direct vis incident solar radiation', & - ptr_patch=this%fsds_vis_d_patch) - - this%fsds_vis_i_patch(begp:endp) = spval - call hist_addfld1d (fname='FSDSVI', units='W/m^2', & - avgflag='A', long_name='diffuse vis incident solar radiation', & - ptr_patch=this%fsds_vis_i_patch) - - this%fsr_vis_d_patch(begp:endp) = spval - call hist_addfld1d (fname='FSRVD', units='W/m^2', & - avgflag='A', long_name='direct vis reflected solar radiation', & - ptr_patch=this%fsr_vis_d_patch, c2l_scale_type='urbanf') - this%fsr_vis_i_patch(begp:endp) = spval - call hist_addfld1d (fname='FSRVI', units='W/m^2', & - avgflag='A', long_name='diffuse vis reflected solar radiation', & - ptr_patch=this%fsr_vis_i_patch, c2l_scale_type='urbanf') - ! diagnostic fluxes - if (use_SSRE) then - this%fsrSF_vis_d_patch(begp:endp) = spval - call hist_addfld1d (fname='FSRSFVD', units='W/m^2', & - avgflag='A', long_name='direct vis reflected solar radiation', & - ptr_patch=this%fsrSF_vis_d_patch, c2l_scale_type='urbanf') - this%fsrSF_vis_i_patch(begp:endp) = spval - call hist_addfld1d (fname='FSRSFVI', units='W/m^2', & - avgflag='A', long_name='diffuse vis reflected solar radiation', & - ptr_patch=this%fsrSF_vis_i_patch, c2l_scale_type='urbanf') - - this%ssre_fsr_vis_d_patch(begp:endp) = spval - call hist_addfld1d (fname='SSRE_FSRVD', units='W/m^2', & - avgflag='A', long_name='surface snow radiatve effect on direct vis reflected solar radiation', & - ptr_patch=this%ssre_fsr_vis_d_patch, c2l_scale_type='urbanf') - this%ssre_fsr_vis_i_patch(begp:endp) = spval - call hist_addfld1d (fname='SSRE_FSRVI', units='W/m^2', & - avgflag='A', long_name='surface snow radiatve effect on diffuse vis reflected solar radiation', & - ptr_patch=this%ssre_fsr_vis_i_patch, c2l_scale_type='urbanf') - end if - this%fsds_vis_d_ln_patch(begp:endp) = spval - call hist_addfld1d (fname='FSDSVDLN', units='W/m^2', & - avgflag='A', long_name='direct vis incident solar radiation at local noon', & - ptr_patch=this%fsds_vis_d_ln_patch) - - this%fsds_vis_i_ln_patch(begp:endp) = spval - call hist_addfld1d (fname='FSDSVILN', units='W/m^2', & - avgflag='A', long_name='diffuse vis incident solar radiation at local noon', & - ptr_patch=this%fsds_vis_i_ln_patch) - - this%parveg_ln_patch(begp:endp) = spval - call hist_addfld1d (fname='PARVEGLN', units='W/m^2', & - avgflag='A', long_name='absorbed par by vegetation at local noon', & - ptr_patch=this%parveg_ln_patch) - - this%fsr_vis_d_ln_patch(begp:endp) = spval - call hist_addfld1d (fname='FSRVDLN', units='W/m^2', & - avgflag='A', long_name='direct vis reflected solar radiation at local noon', & - ptr_patch=this%fsr_vis_d_ln_patch, c2l_scale_type='urbanf') - ! diagnostic flux - if (use_SSRE) then - this%fsrSF_vis_d_ln_patch(begp:endp) = spval - call hist_addfld1d (fname='FSRSFVDLN', units='W/m^2', & - avgflag='A', long_name='direct vis reflected solar radiation at local noon', & - ptr_patch=this%fsrSF_vis_d_ln_patch, c2l_scale_type='urbanf') - this%ssre_fsr_vis_d_ln_patch(begp:endp) = spval - call hist_addfld1d (fname='SSRE_FSRVDLN', units='W/m^2', & - avgflag='A', long_name='surface snow radiatve effect on direct vis reflected solar radiation at local noon', & - ptr_patch=this%ssre_fsr_vis_d_ln_patch, c2l_scale_type='urbanf') - end if - this%fsds_sno_vd_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOFSDSVD', units='W/m^2', & - avgflag='A', long_name='direct vis incident solar radiation on snow', & - ptr_patch=this%fsds_sno_vd_patch, default='inactive') - - this%fsds_sno_nd_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOFSDSND', units='W/m^2', & - avgflag='A', long_name='direct nir incident solar radiation on snow', & - ptr_patch=this%fsds_sno_nd_patch, default='inactive') - - this%fsds_sno_vi_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOFSDSVI', units='W/m^2', & - avgflag='A', long_name='diffuse vis incident solar radiation on snow', & - ptr_patch=this%fsds_sno_vi_patch, default='inactive') - - this%fsds_sno_ni_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOFSDSNI', units='W/m^2', & - avgflag='A', long_name='diffuse nir incident solar radiation on snow', & - ptr_patch=this%fsds_sno_ni_patch, default='inactive') - - this%fsr_sno_vd_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOFSRVD', units='W/m^2', & - avgflag='A', long_name='direct vis reflected solar radiation from snow', & - ptr_patch=this%fsr_sno_vd_patch) - - this%fsr_sno_nd_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOFSRND', units='W/m^2', & - avgflag='A', long_name='direct nir reflected solar radiation from snow', & - ptr_patch=this%fsr_sno_nd_patch) - - this%fsr_sno_vi_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOFSRVI', units='W/m^2', & - avgflag='A', long_name='diffuse vis reflected solar radiation from snow', & - ptr_patch=this%fsr_sno_vi_patch) - - this%fsr_sno_ni_patch(begp:endp) = spval - call hist_addfld1d (fname='SNOFSRNI', units='W/m^2', & - avgflag='A', long_name='diffuse nir reflected solar radiation from snow', & - ptr_patch=this%fsr_sno_ni_patch) - - - end subroutine InitHistory - - !------------------------------------------------------------------------ - subroutine InitCold(this, bounds) - ! - ! !USES: - ! - ! !ARGUMENTS: - class(surfrad_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: p,l - !----------------------------------------------------------------------- - - ! nothing for now - - end subroutine InitCold +! subroutine InitHistory(this, bounds) +! ! +! ! History fields initialization +! ! +! ! !USES: +! use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) +! use clm_varcon , only : spval +! use histFileMod , only : hist_addfld1d, hist_addfld2d +! use clm_varctl , only : use_SSRE +! ! +! ! !ARGUMENTS: +! class(surfrad_type) :: this +! type(bounds_type), intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! integer :: begp, endp +! integer :: begc, endc +! real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays +! !--------------------------------------------------------------------- +! +! begp = bounds%begp; endp = bounds%endp +! begc = bounds%begc; endc = bounds%endc +! +! if (use_snicar_frc) then +! this%sfc_frc_aer_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOAERFRCL', units='W/m^2', & +! avgflag='A', long_name='surface forcing of all aerosols in snow (land) ', & +! ptr_patch=this%sfc_frc_aer_patch, set_urb=spval) +! +! this%sfc_frc_aer_sno_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOAERFRC2L', units='W/m^2', & +! avgflag='A', long_name='surface forcing of all aerosols in snow, averaged only when snow is present (land)', & +! ptr_patch=this%sfc_frc_aer_sno_patch, set_urb=spval) +! +! this%sfc_frc_bc_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOBCFRCL', units='W/m^2', & +! avgflag='A', long_name='surface forcing of BC in snow (land) ', & +! ptr_patch=this%sfc_frc_bc_patch, set_urb=spval) +! +! this%sfc_frc_bc_sno_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOBCFRC2L', units='W/m^2', & +! avgflag='A', long_name='surface forcing of BC in snow, averaged only when snow is present (land)', & +! ptr_patch=this%sfc_frc_bc_sno_patch, set_urb=spval) +! +! this%sfc_frc_oc_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', & +! avgflag='A', long_name='surface forcing of OC in snow (land) ', & +! ptr_patch=this%sfc_frc_oc_patch, set_urb=spval) +! +! this%sfc_frc_oc_sno_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOOCFRC2L', units='W/m^2', & +! avgflag='A', long_name='surface forcing of OC in snow, averaged only when snow is present (land)', & +! ptr_patch=this%sfc_frc_oc_sno_patch, set_urb=spval) +! +! this%sfc_frc_dst_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNODSTFRCL', units='W/m^2', & +! avgflag='A', long_name='surface forcing of dust in snow (land) ', & +! ptr_patch=this%sfc_frc_dst_patch, set_urb=spval) +! +! this%sfc_frc_dst_sno_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNODSTFRC2L', units='W/m^2', & +! avgflag='A', long_name='surface forcing of dust in snow, averaged only when snow is present (land)', & +! ptr_patch=this%sfc_frc_dst_sno_patch, set_urb=spval) +! end if +! +! this%fsds_vis_d_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSDSVD', units='W/m^2', & +! avgflag='A', long_name='direct vis incident solar radiation', & +! ptr_patch=this%fsds_vis_d_patch) +! +! this%fsds_vis_i_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSDSVI', units='W/m^2', & +! avgflag='A', long_name='diffuse vis incident solar radiation', & +! ptr_patch=this%fsds_vis_i_patch) +! +! this%fsr_vis_d_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSRVD', units='W/m^2', & +! avgflag='A', long_name='direct vis reflected solar radiation', & +! ptr_patch=this%fsr_vis_d_patch, c2l_scale_type='urbanf') +! this%fsr_vis_i_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSRVI', units='W/m^2', & +! avgflag='A', long_name='diffuse vis reflected solar radiation', & +! ptr_patch=this%fsr_vis_i_patch, c2l_scale_type='urbanf') +! ! diagnostic fluxes +! if (use_SSRE) then +! this%fsrSF_vis_d_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSRSFVD', units='W/m^2', & +! avgflag='A', long_name='direct vis reflected solar radiation', & +! ptr_patch=this%fsrSF_vis_d_patch, c2l_scale_type='urbanf') +! this%fsrSF_vis_i_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSRSFVI', units='W/m^2', & +! avgflag='A', long_name='diffuse vis reflected solar radiation', & +! ptr_patch=this%fsrSF_vis_i_patch, c2l_scale_type='urbanf') +! +! this%ssre_fsr_vis_d_patch(begp:endp) = spval +! call hist_addfld1d (fname='SSRE_FSRVD', units='W/m^2', & +! avgflag='A', long_name='surface snow radiatve effect on direct vis reflected solar radiation', & +! ptr_patch=this%ssre_fsr_vis_d_patch, c2l_scale_type='urbanf') +! this%ssre_fsr_vis_i_patch(begp:endp) = spval +! call hist_addfld1d (fname='SSRE_FSRVI', units='W/m^2', & +! avgflag='A', long_name='surface snow radiatve effect on diffuse vis reflected solar radiation', & +! ptr_patch=this%ssre_fsr_vis_i_patch, c2l_scale_type='urbanf') +! end if +! this%fsds_vis_d_ln_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSDSVDLN', units='W/m^2', & +! avgflag='A', long_name='direct vis incident solar radiation at local noon', & +! ptr_patch=this%fsds_vis_d_ln_patch) +! +! this%fsds_vis_i_ln_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSDSVILN', units='W/m^2', & +! avgflag='A', long_name='diffuse vis incident solar radiation at local noon', & +! ptr_patch=this%fsds_vis_i_ln_patch) +! +! this%parveg_ln_patch(begp:endp) = spval +! call hist_addfld1d (fname='PARVEGLN', units='W/m^2', & +! avgflag='A', long_name='absorbed par by vegetation at local noon', & +! ptr_patch=this%parveg_ln_patch) +! +! this%fsr_vis_d_ln_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSRVDLN', units='W/m^2', & +! avgflag='A', long_name='direct vis reflected solar radiation at local noon', & +! ptr_patch=this%fsr_vis_d_ln_patch, c2l_scale_type='urbanf') +! ! diagnostic flux +! if (use_SSRE) then +! this%fsrSF_vis_d_ln_patch(begp:endp) = spval +! call hist_addfld1d (fname='FSRSFVDLN', units='W/m^2', & +! avgflag='A', long_name='direct vis reflected solar radiation at local noon', & +! ptr_patch=this%fsrSF_vis_d_ln_patch, c2l_scale_type='urbanf') +! this%ssre_fsr_vis_d_ln_patch(begp:endp) = spval +! call hist_addfld1d (fname='SSRE_FSRVDLN', units='W/m^2', & +! avgflag='A', long_name='surface snow radiatve effect on direct vis reflected solar radiation at local noon', & +! ptr_patch=this%ssre_fsr_vis_d_ln_patch, c2l_scale_type='urbanf') +! end if +! this%fsds_sno_vd_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOFSDSVD', units='W/m^2', & +! avgflag='A', long_name='direct vis incident solar radiation on snow', & +! ptr_patch=this%fsds_sno_vd_patch, default='inactive') +! +! this%fsds_sno_nd_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOFSDSND', units='W/m^2', & +! avgflag='A', long_name='direct nir incident solar radiation on snow', & +! ptr_patch=this%fsds_sno_nd_patch, default='inactive') +! +! this%fsds_sno_vi_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOFSDSVI', units='W/m^2', & +! avgflag='A', long_name='diffuse vis incident solar radiation on snow', & +! ptr_patch=this%fsds_sno_vi_patch, default='inactive') +! +! this%fsds_sno_ni_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOFSDSNI', units='W/m^2', & +! avgflag='A', long_name='diffuse nir incident solar radiation on snow', & +! ptr_patch=this%fsds_sno_ni_patch, default='inactive') +! +! this%fsr_sno_vd_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOFSRVD', units='W/m^2', & +! avgflag='A', long_name='direct vis reflected solar radiation from snow', & +! ptr_patch=this%fsr_sno_vd_patch) +! +! this%fsr_sno_nd_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOFSRND', units='W/m^2', & +! avgflag='A', long_name='direct nir reflected solar radiation from snow', & +! ptr_patch=this%fsr_sno_nd_patch) +! +! this%fsr_sno_vi_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOFSRVI', units='W/m^2', & +! avgflag='A', long_name='diffuse vis reflected solar radiation from snow', & +! ptr_patch=this%fsr_sno_vi_patch) +! +! this%fsr_sno_ni_patch(begp:endp) = spval +! call hist_addfld1d (fname='SNOFSRNI', units='W/m^2', & +! avgflag='A', long_name='diffuse nir reflected solar radiation from snow', & +! ptr_patch=this%fsr_sno_ni_patch) +! +! +! end subroutine InitHistory +! +! !------------------------------------------------------------------------ +! subroutine InitCold(this, bounds) +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(surfrad_type) :: this +! type(bounds_type), intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! integer :: p,l +! !----------------------------------------------------------------------- +! +! ! nothing for now +! +! end subroutine InitCold subroutine CanopySunShadeFracs(filter_nourbanp, num_nourbanp, & From 9bbb3f1be69103de2713ee4361098b38a886aa55 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 13:24:02 -0500 Subject: [PATCH 165/589] remoove unused function --- .../CLM51/RootBiophysMod.F90 | 152 +++++++++--------- 1 file changed, 76 insertions(+), 76 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 index 379d25d1e..5c3aa0422 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 @@ -31,80 +31,80 @@ module RootBiophysMod contains !-------------------------------------------------------------------------------------- - subroutine init_rootprof(NLFilename) - ! - !DESCRIPTION - ! initialize methods for root profile calculation - - ! !USES: - use abortutils , only : endrun - use fileutils , only : getavu, relavu - use spmdMod , only : mpicom, masterproc - use shr_mpi_mod , only : shr_mpi_bcast - use clm_varctl , only : iulog - use clm_nlUtilsMod , only : find_nlgroup_name - - ! !ARGUMENTS: - !------------------------------------------------------------------------------ - implicit none - character(len=*), intent(in) :: NLFilename - - integer :: nu_nml ! unit for namelist file - integer :: nml_error ! namelist i/o error flag - character(*), parameter :: subName = "('init_rootprof')" - - !----------------------------------------------------------------------- - -! MUST agree with name in namelist and read statement - namelist /rooting_profile_inparm/ rooting_profile_method_water, rooting_profile_method_carbon, & - rooting_profile_varindex_water, rooting_profile_varindex_carbon - - ! Default values for namelist - - rooting_profile_method_water = zeng_2001_root - rooting_profile_method_carbon = zeng_2001_root - rooting_profile_varindex_water = 1 - rooting_profile_varindex_carbon = 2 - - ! Read rooting_profile namelist - if (masterproc) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call find_nlgroup_name(nu_nml, 'rooting_profile_inparm', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=rooting_profile_inparm,iostat=nml_error) - if (nml_error /= 0) then - call endrun(subname // ':: ERROR reading rooting_profile namelist') - end if - else - call endrun(subname // ':: ERROR finding rooting_profile namelist') - end if - close(nu_nml) - call relavu( nu_nml ) - - endif - - call shr_mpi_bcast(rooting_profile_method_water, mpicom) - call shr_mpi_bcast(rooting_profile_method_carbon, mpicom) - call shr_mpi_bcast(rooting_profile_varindex_water, mpicom) - call shr_mpi_bcast(rooting_profile_varindex_carbon, mpicom) - - if (masterproc) then - - write(iulog,*) ' ' - write(iulog,*) 'rooting_profile settings:' - write(iulog,*) ' rooting_profile_method_water = ',rooting_profile_method_water - if ( rooting_profile_method_water == jackson_1996_root )then - write(iulog,*) ' (rooting_profile_varindex_water = ',rooting_profile_varindex_water, ')' - end if - write(iulog,*) ' rooting_profile_method_carbon = ',rooting_profile_method_carbon - if ( rooting_profile_method_carbon == jackson_1996_root )then - write(iulog,*) ' (rooting_profile_varindex_carbon = ',rooting_profile_varindex_carbon, ')' - end if - - endif - - end subroutine init_rootprof +! subroutine init_rootprof(NLFilename) +! ! +! !DESCRIPTION +! ! initialize methods for root profile calculation +! +! ! !USES: +! use abortutils , only : endrun +! use fileutils , only : getavu, relavu +! use spmdMod , only : mpicom, masterproc +! use shr_mpi_mod , only : shr_mpi_bcast +! use clm_varctl , only : iulog +! use clm_nlUtilsMod , only : find_nlgroup_name +! +! ! !ARGUMENTS: +! !------------------------------------------------------------------------------ +! implicit none +! character(len=*), intent(in) :: NLFilename +! +! integer :: nu_nml ! unit for namelist file +! integer :: nml_error ! namelist i/o error flag +! character(*), parameter :: subName = "('init_rootprof')" +! +! !----------------------------------------------------------------------- +! +!! MUST agree with name in namelist and read statement +! namelist /rooting_profile_inparm/ rooting_profile_method_water, rooting_profile_method_carbon, & +! rooting_profile_varindex_water, rooting_profile_varindex_carbon +! +! ! Default values for namelist +! +! rooting_profile_method_water = zeng_2001_root +! rooting_profile_method_carbon = zeng_2001_root +! rooting_profile_varindex_water = 1 +! rooting_profile_varindex_carbon = 2 +! +! ! Read rooting_profile namelist +! if (masterproc) then +! nu_nml = getavu() +! open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) +! call find_nlgroup_name(nu_nml, 'rooting_profile_inparm', status=nml_error) +! if (nml_error == 0) then +! read(nu_nml, nml=rooting_profile_inparm,iostat=nml_error) +! if (nml_error /= 0) then +! call endrun(subname // ':: ERROR reading rooting_profile namelist') +! end if +! else +! call endrun(subname // ':: ERROR finding rooting_profile namelist') +! end if +! close(nu_nml) +! call relavu( nu_nml ) +! +! endif +! +! call shr_mpi_bcast(rooting_profile_method_water, mpicom) +! call shr_mpi_bcast(rooting_profile_method_carbon, mpicom) +! call shr_mpi_bcast(rooting_profile_varindex_water, mpicom) +! call shr_mpi_bcast(rooting_profile_varindex_carbon, mpicom) +! +! if (masterproc) then +! +! write(iulog,*) ' ' +! write(iulog,*) 'rooting_profile settings:' +! write(iulog,*) ' rooting_profile_method_water = ',rooting_profile_method_water +! if ( rooting_profile_method_water == jackson_1996_root )then +! write(iulog,*) ' (rooting_profile_varindex_water = ',rooting_profile_varindex_water, ')' +! end if +! write(iulog,*) ' rooting_profile_method_carbon = ',rooting_profile_method_carbon +! if ( rooting_profile_method_carbon == jackson_1996_root )then +! write(iulog,*) ' (rooting_profile_varindex_carbon = ',rooting_profile_varindex_carbon, ')' +! end if +! +! endif +! +! end subroutine init_rootprof !-------------------------------------------------------------------------------------- subroutine init_vegrootfr(bounds, nlevsoi, nlevgrnd, rootfr, water_carbon) @@ -117,8 +117,8 @@ subroutine init_vegrootfr(bounds, nlevsoi, nlevgrnd, rootfr, water_carbon) use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun - use CNCLM_ColumnType , only : col - use CNCLM_PatchType , only : patch + use ColumnType , only : col + use PatchType , only : patch ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds ! bounds From 11f727e1a65cef4470dee1c4953ed2ed35a5436f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 14:22:37 -0500 Subject: [PATCH 166/589] add local noon function --- .../CLM51/clm_time_manager.F90 | 30 +++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index ab68ab529..bca8925d2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -31,6 +31,7 @@ module clm_time_manager is_end_curr_day, &! return true on last timestep in current day is_restart, &! return true if this is a restart run is_first_step ! dummy function here, because it is loaded, but not used + is_near_local_noon, &! return true if near local noon contains !========================================================================================= @@ -247,4 +248,33 @@ logical function is_restart( ) end function is_restart +!========================================================================================= + + logical function is_near_local_noon( londeg, deltasec ) + + !--------------------------------------------------------------------------------- + ! Is this longitude near it's local noon? + ! + ! uses + use clm_varcon, only: degpsec, isecspday + ! Arguments + real(r8), intent(in) :: londeg ! Longitude in degrees + integer , intent(in) :: deltasec ! Number of seconds before or after local noon + + ! Local variables + integer :: local_secs ! Local time in seconds + integer, parameter :: noonsec = isecspday / 2 ! seconds at local noon + !--------------------------------------------------------------------------------- + SHR_ASSERT( deltasec < noonsec, "deltasec must be less than 12 hours" ) + local_secs = get_local_timestep_time( londeg ) + + if ( local_secs >= (noonsec - deltasec) .and. local_secs <= (noonsec + deltasec)) then + is_near_local_noon = .true. + else + is_near_local_noon = .false. + end if + + !--------------------------------------------------------------------------------- + end function is_near_local_noon + end module clm_time_manager From 8eba9d9a0f2ff048173719a1eda21a5b7da4d7c1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 14:23:01 -0500 Subject: [PATCH 167/589] add mising configurations --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 91f8ba541..6cc882cbd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -40,6 +40,15 @@ module clm_varctl logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model + + ! use subgrid fluxes + logical, public :: use_subgrid_fluxes = .true. + + !---------------------------------------------------------- + ! SSRE diagnostic + !---------------------------------------------------------- + logical, public :: use_SSRE = .false. ! flag for SSRE diagnostic + !---------------------------------------------------------- ! CN matrix !---------------------------------------------------------- From 97d10bcde81db8f5d9ae4bcee260f845de0be4a2 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 8 Dec 2022 14:23:48 -0500 Subject: [PATCH 168/589] remove obsolete function declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 index 5c3aa0422..1a6f68f3f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 @@ -12,7 +12,7 @@ module RootBiophysMod private ! public :: init_vegrootfr - public :: init_rootprof +! public :: init_rootprof integer, private, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function integer, private, parameter :: jackson_1996_root = 1 !the jackson 1996 root profile function From 6d2d6dd79b4c4190f56300e7d892227a6b51a986 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Dec 2022 14:47:50 -0500 Subject: [PATCH 169/589] fix typo --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index bca8925d2..57ff8a379 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -30,8 +30,8 @@ module clm_time_manager is_end_curr_day, &! return true on last timestep in current day is_restart, &! return true if this is a restart run - is_first_step ! dummy function here, because it is loaded, but not used - is_near_local_noon, &! return true if near local noon + is_first_step, & ! dummy function here, because it is loaded, but not used + is_near_local_noon ! return true if near local noon contains !========================================================================================= From 2b5654e280df4fe5fabee102698c1d90520ef60e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Dec 2022 15:13:06 -0500 Subject: [PATCH 170/589] add missing constants --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index db29abf05..8f9cdbcaa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -86,6 +86,10 @@ module clm_varcon real(r8), public, parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000) + real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second + real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day + integer, public, parameter :: isecspday= secspday ! Integer seconds per day + ! !PUBLIC MEMBER FUNCTIONS: public clm_varcon_init ! Initialze constants that need to be initialized From 46a900853f4b15071283b06c0d086c6879778b57 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Dec 2022 15:13:31 -0500 Subject: [PATCH 171/589] add missing function --- .../CLM51/clm_time_manager.F90 | 36 +++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 57ff8a379..05e630d5c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -27,6 +27,7 @@ module clm_time_manager ! get_calendar, &! return calendar get_days_per_year, &! return the days per year for current year + get_local_timestep_time, &! return the local time for the input longitude to the nearest time-step is_end_curr_day, &! return true on last timestep in current day is_restart, &! return true if this is a restart run @@ -277,4 +278,39 @@ logical function is_near_local_noon( londeg, deltasec ) !--------------------------------------------------------------------------------- end function is_near_local_noon + !========================================================================================= + + integer function get_local_timestep_time( londeg, offset ) + + !--------------------------------------------------------------------------------- + ! Get the local time for this longitude that is evenly divisible by the time-step + ! + ! uses + use clm_varcon, only: degpsec, isecspday + ! Arguments + real(r8) , intent(in) :: londeg ! Longitude in degrees + integer, optional, intent(in) :: offset ! Offset from current time in seconds (either sign) + + ! Local variables + integer :: yr, mon, day ! year, month, day, unused + integer :: secs ! seconds into the day + real(r8) :: lon ! positive longitude + integer :: offset_sec ! offset seconds (either 0 for current time or -dtime for previous time) + !--------------------------------------------------------------------------------- + if ( present(offset) ) then + offset_sec = offset + else + offset_sec = 0 + end if + SHR_ASSERT( londeg >= -180.0_r8, "londeg must be greater than -180" ) + SHR_ASSERT( londeg <= 360.0_r8, "londeg must be less than 360" ) + call get_curr_date(yr, mon, day, secs, offset=offset_sec ) + lon = londeg + if ( lon < 0.0_r8 ) lon = lon + 360.0_r8 + get_local_timestep_time = secs + nint((lon/degpsec)/real(dtime,r8))*dtime + get_local_timestep_time = mod(get_local_timestep_time,isecspday) + end function get_local_timestep_time + + !========================================================================================= + end module clm_time_manager From 2b6baf8bc5d53bcbbc58e4551f892f364a9101a6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Dec 2022 15:31:14 -0500 Subject: [PATCH 172/589] remove doubly declared variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index 8f9cdbcaa..af12dae3f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -87,7 +87,6 @@ module clm_varcon real(r8), public, parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000) real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second - real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day integer, public, parameter :: isecspday= secspday ! Integer seconds per day ! !PUBLIC MEMBER FUNCTIONS: From 091bad1ad51f739c57982bafb3b803f763ce1697 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Dec 2022 13:00:07 -0500 Subject: [PATCH 173/589] adding missing use statement and updating date function to ESMF --- .../CLM51/clm_time_manager.F90 | 60 +++++++++++++------ 1 file changed, 43 insertions(+), 17 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 05e630d5c..61236549e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -1,5 +1,7 @@ module clm_time_manager +#include "shr_assert.h" + use MAPL use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec use clm_varctl , only: iulog @@ -95,25 +97,49 @@ end function get_rad_step_size !========================================================================================= -subroutine get_curr_date(yr, mon, day, tod) + subroutine get_curr_date(yr, mon, day, tod, offset) + + !----------------------------------------------------------------------------------------- + ! Return date components valid at end of current timestep with an optional + ! offset (positive or negative) in seconds. + + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_curr_date' + integer :: rc, status + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off + !----------------------------------------------------------------------------------------- + + if ( .not. check_timemgr_initialized(sub) ) return + + call ESMF_ClockGet( tm_clock, currTime=date, rc=STATUS ) + VERIFY_(STATUS) + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=STATUS ) + VERIFY_(STATUS) + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=STATUS ) + VERIFY_(STATUS) + date = date - off + end if + end if - ! Return date components valid at end of current timestep with an optional - ! offset (positive or negative) in seconds. - - implicit none - integer, intent(out) ::& - yr, &! year - mon, &! month - day, &! day of month - tod ! time of day (seconds past 0Z) - - yr = curr_year - mon = curr_month - day = curr_day - tod = 3600*curr_hour + 60*curr_min + curr_sec - -end subroutine get_curr_date + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=STATUS) + VERIFY_(STATUS) + end subroutine get_curr_date !========================================================================================= function get_curr_calday() From 2a7295f564504c5ae2888937156511d3a95362ab Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Dec 2022 13:35:41 -0500 Subject: [PATCH 174/589] add missing function --- .../CLM51/clm_time_manager.F90 | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 61236549e..ee1047910 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -20,6 +20,7 @@ module clm_time_manager get_nstep, &! return CN timestep number get_curr_date, &! return date components at end of current timestep + get_curr_ESMF_Time, &! get current time in terms of the ESMF_Time ! get_start_date, &! return components of the start date ! get_driver_start_ymd, &! return year/month/day (as integer in YYYYMMDD format) of driver start date ! get_ref_date, &! return components of the reference date @@ -35,6 +36,10 @@ module clm_time_manager is_restart, &! return true if this is a restart run is_first_step, & ! dummy function here, because it is loaded, but not used is_near_local_noon ! return true if near local noon + + integer, save ::& + dtime = uninit_int, &! timestep in seconds + type(ESMF_Clock), save :: tm_clock ! model clock contains !========================================================================================= @@ -339,4 +344,20 @@ end function get_local_timestep_time !========================================================================================= + !========================================================================================= + + function get_curr_ESMF_Time( ) + + ! Return the current time as ESMF_Time + + type(ESMF_Time) :: get_curr_ESMF_Time + character(len=*), parameter :: sub = 'clm::get_curr_ESMF_Time' + integer :: rc + + if ( .not. check_timemgr_initialized(sub) ) return + + call ESMF_ClockGet( tm_clock, currTime=get_curr_ESMF_Time, rc=STATUS ) + VERIFY_(STATUS) + + end function get_curr_ESMF_Time end module clm_time_manager From d3b2b963d33225a79afa13be3158c0ef8068f125 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Dec 2022 13:38:09 -0500 Subject: [PATCH 175/589] add missing variable declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 index c1ffcda35..7f302350f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -74,7 +74,8 @@ subroutine init_dgvs_type(bounds, this) type(dgvs_type), intent(inout):: this !LOCAL - integer, intent(in) :: begp, endp + integer :: begp, endp + integer :: m !--------------------------------------------------------------------- begp = bounds%begp; endp = bounds%endp From 3470419d02e0dc6723b29e250627e8a159a614de Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Dec 2022 15:21:50 -0500 Subject: [PATCH 176/589] simplify current date function --- .../CLM51/clm_time_manager.F90 | 85 +++++++------------ 1 file changed, 32 insertions(+), 53 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index ee1047910..f396db1e4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -20,7 +20,7 @@ module clm_time_manager get_nstep, &! return CN timestep number get_curr_date, &! return date components at end of current timestep - get_curr_ESMF_Time, &! get current time in terms of the ESMF_Time +! get_curr_ESMF_Time, &! get current time in terms of the ESMF_Time ! get_start_date, &! return components of the start date ! get_driver_start_ymd, &! return year/month/day (as integer in YYYYMMDD format) of driver start date ! get_ref_date, &! return components of the reference date @@ -44,6 +44,9 @@ module clm_time_manager !========================================================================================= + call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) + VERIFY_(STATUS) + integer function get_step_size( dt ) ! Return the step size in seconds. @@ -104,45 +107,20 @@ end function get_rad_step_size subroutine get_curr_date(yr, mon, day, tod, offset) - !----------------------------------------------------------------------------------------- - ! Return date components valid at end of current timestep with an optional - ! offset (positive or negative) in seconds. - - integer, intent(out) ::& - yr, &! year - mon, &! month - day, &! day of month - tod ! time of day (seconds past 0Z) - - integer, optional, intent(in) :: offset ! Offset from current time in seconds. - ! Positive for future times, negative - ! for previous times. - - character(len=*), parameter :: sub = 'clm::get_curr_date' - integer :: rc, status - type(ESMF_Time) :: date - type(ESMF_TimeInterval) :: off - !----------------------------------------------------------------------------------------- + ! Return date components valid at end of current timestep with an optional + ! offset (positive or negative) in seconds. - if ( .not. check_timemgr_initialized(sub) ) return - - call ESMF_ClockGet( tm_clock, currTime=date, rc=STATUS ) - VERIFY_(STATUS) - - if (present(offset)) then - if (offset > 0) then - call ESMF_TimeIntervalSet( off, s=offset, rc=STATUS ) - VERIFY_(STATUS) - date = date + off - else if (offset < 0) then - call ESMF_TimeIntervalSet( off, s=-offset, rc=STATUS ) - VERIFY_(STATUS) - date = date - off - end if - end if + implicit none + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) - call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=STATUS) - VERIFY_(STATUS) + yr = curr_year + mon = curr_month + day = curr_day + tod = 3600*curr_hour + 60*curr_min + curr_sec end subroutine get_curr_date !========================================================================================= @@ -330,12 +308,13 @@ integer function get_local_timestep_time( londeg, offset ) !--------------------------------------------------------------------------------- if ( present(offset) ) then offset_sec = offset + _ASSERT(.FALSE.,"offset function not enabled") else offset_sec = 0 end if SHR_ASSERT( londeg >= -180.0_r8, "londeg must be greater than -180" ) SHR_ASSERT( londeg <= 360.0_r8, "londeg must be less than 360" ) - call get_curr_date(yr, mon, day, secs, offset=offset_sec ) + call get_curr_date(yr, mon, day, secs ) lon = londeg if ( lon < 0.0_r8 ) lon = lon + 360.0_r8 get_local_timestep_time = secs + nint((lon/degpsec)/real(dtime,r8))*dtime @@ -346,18 +325,18 @@ end function get_local_timestep_time !========================================================================================= - function get_curr_ESMF_Time( ) - - ! Return the current time as ESMF_Time - - type(ESMF_Time) :: get_curr_ESMF_Time - character(len=*), parameter :: sub = 'clm::get_curr_ESMF_Time' - integer :: rc - - if ( .not. check_timemgr_initialized(sub) ) return - - call ESMF_ClockGet( tm_clock, currTime=get_curr_ESMF_Time, rc=STATUS ) - VERIFY_(STATUS) - - end function get_curr_ESMF_Time +! function get_curr_ESMF_Time( ) +! +! ! Return the current time as ESMF_Time +! +! type(ESMF_Time) :: get_curr_ESMF_Time +! character(len=*), parameter :: sub = 'clm::get_curr_ESMF_Time' +! integer :: rc, status +! +! ! if ( .not. check_timemgr_initialized(sub) ) return +! +! call ESMF_ClockGet( tm_clock, currTime=get_curr_ESMF_Time, rc=STATUS ) +! VERIFY_(STATUS) +! +! end function get_curr_ESMF_Time end module clm_time_manager From 6fd6298bed0833d8e4e634f32d4c54e3d1c68e11 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Dec 2022 15:48:26 -0500 Subject: [PATCH 177/589] cleanup --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index f396db1e4..cdd80a7d1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -5,6 +5,7 @@ module clm_time_manager use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec use clm_varctl , only: iulog + use MAPL_ExceptionHandling implicit none private @@ -39,14 +40,10 @@ module clm_time_manager integer, save ::& dtime = uninit_int, &! timestep in seconds - type(ESMF_Clock), save :: tm_clock ! model clock contains !========================================================================================= - call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) - VERIFY_(STATUS) - integer function get_step_size( dt ) ! Return the step size in seconds. From 3779c254ecc2c3e09ff4ff5d1be1d5117b57bb93 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Dec 2022 16:16:33 -0500 Subject: [PATCH 178/589] cleanup --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index cdd80a7d1..0092c618a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -1,7 +1,6 @@ module clm_time_manager #include "shr_assert.h" - use MAPL use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec use clm_varctl , only: iulog @@ -40,11 +39,11 @@ module clm_time_manager integer, save ::& dtime = uninit_int, &! timestep in seconds -contains + contains !========================================================================================= -integer function get_step_size( dt ) + integer function get_step_size( dt ) ! Return the step size in seconds. @@ -59,7 +58,7 @@ integer function get_step_size( dt ) if(dt_default < 0) stop 'CN: dt_default < 0' get_step_size = dt_default -end function get_step_size + end function get_step_size !========================================================================================= From c75e353da0c279ac89070f671cc8cb2ffa48cc41 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 19 Dec 2022 17:06:57 -0500 Subject: [PATCH 179/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 0092c618a..527600c56 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -1,6 +1,7 @@ module clm_time_manager #include "shr_assert.h" + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec use clm_varctl , only: iulog @@ -10,8 +11,6 @@ module clm_time_manager private ! Public methods - -! gkw: this is just to get code to compile public ::& get_step_size, &! return step size in seconds @@ -38,7 +37,7 @@ module clm_time_manager is_near_local_noon ! return true if near local noon integer, save ::& - dtime = uninit_int, &! timestep in seconds + dtime = uninit_int ! timestep in seconds contains !========================================================================================= @@ -335,4 +334,5 @@ end function get_local_timestep_time ! VERIFY_(STATUS) ! ! end function get_curr_ESMF_Time + end module clm_time_manager From 4ab16d53c22fc6a7badb67cc6ef332705f82212f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 08:25:02 -0500 Subject: [PATCH 180/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 527600c56..e50a31013 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -1,5 +1,6 @@ module clm_time_manager +#include "MAPL_Generic.h" #include "shr_assert.h" use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 @@ -36,6 +37,7 @@ module clm_time_manager is_first_step, & ! dummy function here, because it is loaded, but not used is_near_local_noon ! return true if near local noon + integer, parameter :: uninit_int = -999999999 integer, save ::& dtime = uninit_int ! timestep in seconds contains @@ -112,6 +114,8 @@ subroutine get_curr_date(yr, mon, day, tod, offset) day, &! day of month tod ! time of day (seconds past 0Z) + integer, optional, intent(in) :: offset ! Offset from current time in seconds (not used) + yr = curr_year mon = curr_month day = curr_day From a42d627faf0f4eb6e5bc0756195efa81915070a9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 08:49:06 -0500 Subject: [PATCH 181/589] adding missing rc argument --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index e50a31013..1975f65e5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -288,7 +288,7 @@ end function is_near_local_noon !========================================================================================= - integer function get_local_timestep_time( londeg, offset ) + integer function get_local_timestep_time( londeg, offset, rc ) !--------------------------------------------------------------------------------- ! Get the local time for this longitude that is evenly divisible by the time-step @@ -298,6 +298,7 @@ integer function get_local_timestep_time( londeg, offset ) ! Arguments real(r8) , intent(in) :: londeg ! Longitude in degrees integer, optional, intent(in) :: offset ! Offset from current time in seconds (either sign) + integer, optional, intent(out) :: rc ! Local variables integer :: yr, mon, day ! year, month, day, unused From b0de2b466d04998781a5941e515d34a4bfb214d3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 09:45:23 -0500 Subject: [PATCH 182/589] adding missing variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index f82b5e9fa..34cdf7957 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -114,6 +114,8 @@ module clm_varpar integer, public :: max_patch_per_col + integer, public :: maxpatch_glcmec = 0 ! max number of elevation classes (set to 0 here, not specified in CLM clm_varpar.F90) + contains !------------------------------------ From 8b94a3c2885025230b88e7afa021a1e90a681907 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 09:45:49 -0500 Subject: [PATCH 183/589] removing unused write routine --- .../CLM51/column_varcon.F90 | 72 +++++++++---------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 index d57006859..6f3c06e83 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 @@ -129,42 +129,42 @@ function col_itype_to_icemec_class(col_itype) result(icemec_class) end function col_itype_to_icemec_class !----------------------------------------------------------------------- - subroutine write_coltype_metadata(att_prefix, ncid) - ! - ! !DESCRIPTION: - ! Writes column type metadata to a netcdf file. - ! - ! Note that, unlike pft and landunit metadata, this column type metadata is NOT - ! stored in an array. This is because of the trickiness of encoding column values for - ! crop & icemec. So instead, other code must call this routine to do the work of - ! adding the appropriate metadata directly to a netcdf file. - ! - ! !USES: - use ncdio_pio, only : file_desc_t, ncd_global, ncd_putatt - ! - ! !ARGUMENTS: - character(len=*) , intent(in) :: att_prefix ! prefix for attributes (e.g., 'icol_') - type(file_desc_t) , intent(inout) :: ncid ! local file id - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'write_coltype_metadata' - !----------------------------------------------------------------------- - - call ncd_putatt(ncid, ncd_global, att_prefix // 'vegetated_or_bare_soil', 1) - call ncd_putatt(ncid, ncd_global, att_prefix // 'crop' , 2) - call ncd_putatt(ncid, ncd_global, att_prefix // 'crop_noncompete' , '2*100+m, m=cft_lb,cft_ub') - call ncd_putatt(ncid, ncd_global, att_prefix // 'landice' , 3) - call ncd_putatt(ncid, ncd_global, att_prefix // 'landice_multiple_elevation_classes', '4*100+m, m=1,glcnec') - call ncd_putatt(ncid, ncd_global, att_prefix // 'deep_lake' , 5) - call ncd_putatt(ncid, ncd_global, att_prefix // 'wetland' , 6) - call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_roof' , icol_roof) - call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_sunwall' , icol_sunwall) - call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_shadewall' , icol_shadewall) - call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_impervious_road' , icol_road_imperv) - call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_pervious_road' , icol_road_perv) - - end subroutine write_coltype_metadata +! subroutine write_coltype_metadata(att_prefix, ncid) +! ! +! ! !DESCRIPTION: +! ! Writes column type metadata to a netcdf file. +! ! +! ! Note that, unlike pft and landunit metadata, this column type metadata is NOT +! ! stored in an array. This is because of the trickiness of encoding column values for +! ! crop & icemec. So instead, other code must call this routine to do the work of +! ! adding the appropriate metadata directly to a netcdf file. +! ! +! ! !USES: +! use ncdio_pio, only : file_desc_t, ncd_global, ncd_putatt +! ! +! ! !ARGUMENTS: +! character(len=*) , intent(in) :: att_prefix ! prefix for attributes (e.g., 'icol_') +! type(file_desc_t) , intent(inout) :: ncid ! local file id +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'write_coltype_metadata' +! !----------------------------------------------------------------------- +! +! call ncd_putatt(ncid, ncd_global, att_prefix // 'vegetated_or_bare_soil', 1) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'crop' , 2) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'crop_noncompete' , '2*100+m, m=cft_lb,cft_ub') +! call ncd_putatt(ncid, ncd_global, att_prefix // 'landice' , 3) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'landice_multiple_elevation_classes', '4*100+m, m=1,glcnec') +! call ncd_putatt(ncid, ncd_global, att_prefix // 'deep_lake' , 5) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'wetland' , 6) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_roof' , icol_roof) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_sunwall' , icol_sunwall) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_shadewall' , icol_shadewall) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_impervious_road' , icol_road_imperv) +! call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_pervious_road' , icol_road_perv) +! +! end subroutine write_coltype_metadata end module column_varcon From fefa0abab9f9be7c12dee2b8817484ca86499a00 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 10:20:48 -0500 Subject: [PATCH 184/589] commenting out unused routines and aerosol calculations --- .../CLM51/SurfaceRadiationMod.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 index d5dda10b7..70d07b7eb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 @@ -75,8 +75,8 @@ module SurfaceRadiationMod procedure, public :: Init procedure, private :: InitAllocate - procedure, private :: InitHistory - procedure, private :: InitCold + ! procedure, private :: InitHistory + ! procedure, private :: InitCold end type surfrad_type @@ -93,8 +93,8 @@ subroutine Init(this, bounds) type(bounds_type), intent(in) :: bounds call this%InitAllocate(bounds) - call this%InitHistory(bounds) - call this%InitCold(bounds) + ! call this%InitHistory(bounds) + ! call this%InitCold(bounds) end subroutine Init @@ -480,7 +480,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & use landunit_varcon , only : istsoil, istcrop use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE use clm_time_manager , only : get_step_size_real, is_near_local_noon - use SnowSnicarMod , only : DO_SNO_OC + ! use SnowSnicarMod , only : DO_SNO_OC use abortutils , only : endrun ! ! !ARGUMENTS: @@ -857,11 +857,11 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & sfc_frc_bc(p) = sabg(p) - sabg_bc(p) ! OC aerosol forcing (patch-level): - if (DO_SNO_OC) then - sfc_frc_oc(p) = sabg(p) - sabg_oc(p) - else - sfc_frc_oc(p) = 0._r8 - endif +! if (DO_SNO_OC) then +! sfc_frc_oc(p) = sabg(p) - sabg_oc(p) +! else +! sfc_frc_oc(p) = 0._r8 +! endif ! dust aerosol forcing (patch-level): sfc_frc_dst(p) = sabg(p) - sabg_dst(p) From b42722d961a4ce682354d871ab68632c5b6cc56d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 11:28:41 -0500 Subject: [PATCH 185/589] remove obsolete function declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 index 6f3c06e83..4a69438a8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/column_varcon.F90 @@ -30,7 +30,7 @@ module column_varcon public :: is_hydrologically_active ! returns true if the given column type is hydrologically active public :: icemec_class_to_col_itype ! convert an icemec class (1..maxpatch_glcmec) into col%itype public :: col_itype_to_icemec_class ! convert col%itype into an icemec class (1..maxpatch_glcmec) - public :: write_coltype_metadata ! write column type metadata to a netcdf file +! public :: write_coltype_metadata ! write column type metadata to a netcdf file character(len=*), parameter, private :: sourcefile = & __FILE__ From f3149f6e7176b416f52431503564a894eab7029d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 13:07:45 -0500 Subject: [PATCH 186/589] use nanMod --- .../GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 index 70d07b7eb..333636e7e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceRadiationMod.F90 @@ -20,6 +20,7 @@ module SurfaceRadiationMod use ColumnType , only : col use PatchType , only : patch use landunit_varcon , only : istdlak + use nanMod , only : nan ! !PRIVATE TYPES: implicit none @@ -102,7 +103,7 @@ end subroutine Init subroutine InitAllocate(this, bounds) ! ! !USES: - use shr_infnan_mod, only : nan => shr_infnan_nan + ! use shr_infnan_mod, only : nan => shr_infnan_nan ! ! !ARGUMENTS: class(surfrad_type) :: this From 9d14d588ae00e6a517bb8adbc58847f5a9ef71f5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 13:55:28 -0500 Subject: [PATCH 187/589] typo fix --- .../CLM51/CNCLM_Wateratm2lndBulkType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 index 85edb533e..819beb4d0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 @@ -81,4 +81,4 @@ subroutine init_wateratm2lndbulk_type(bounds, this) end subroutine init_wateratm2lndbulk_type -module Wateratm2lndBulkType +end module Wateratm2lndBulkType From e030537533cdff26e83c34301800aaf179afb1fd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 13:55:53 -0500 Subject: [PATCH 188/589] use nanMod --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 index 660a293eb..5661ee7e3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 @@ -15,6 +15,7 @@ module WaterStateBulkType use clm_varpar , only : nlevmaxurbgrnd, nlevsno use clm_varcon , only : spval use WaterStateType , only : waterstate_type + use nanMod , only : nan ! implicit none save From 8426d9a46d4a41eaf6a7734cbddb4604a2637d41 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 14:44:51 -0500 Subject: [PATCH 189/589] fixing type --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index d90df226f..6e8b3e460 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -1,6 +1,6 @@ module GridcellType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4, MAPL_PI + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8, MAPL_PI use nanMod , only : nan use decompMod , only : bounds_type use clm_varcon , only : ispval, max_lunit From 046e2ccfb2707d94b8ba07f947ad6489ee8ebd95 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 14:45:24 -0500 Subject: [PATCH 190/589] enabling global index endrun function (but simplified) --- .../CLM51/abortutils.F90 | 80 +++++++++---------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 index 815b7f840..0d6581540 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 @@ -14,7 +14,7 @@ module abortutils interface endrun module procedure endrun_vanilla - ! module procedure endrun_globalindex + module procedure endrun_globalindex end interface CONTAINS @@ -52,44 +52,44 @@ subroutine endrun_vanilla(msg, additional_msg) end subroutine endrun_vanilla !----------------------------------------------------------------------- -! subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) -! -! !----------------------------------------------------------------------- -! ! Description: -! ! Abort the model for abnormal termination -! ! -! use shr_sys_mod , only: shr_sys_abort -! use clm_varctl , only: iulog -! use GetGlobalValuesMod, only: GetGlobalWrite -! ! -! ! Arguments: -! implicit none -! integer , intent(in) :: decomp_index -! character(len=*) , intent(in) :: clmlevel -! -! ! Generally you want to at least provide msg. The main reason to separate msg from -! ! additional_msg is to supported expected-exception unit testing: you can put -! ! volatile stuff in additional_msg, as in: -! ! call endrun(msg='Informative message', additional_msg=errmsg(__FILE__, __LINE__)) -! ! and then just assert against msg. -! character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort -! character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort -! ! -! ! Local Variables: -! integer :: igrc, ilun, icol -! !----------------------------------------------------------------------- -! -! write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) -! call GetGlobalWrite(decomp_index, clmlevel) -! -! if (present (additional_msg)) then -! write(iulog,*)'ENDRUN: ', additional_msg -! else -! write(iulog,*)'ENDRUN:' -! end if -! -! call shr_sys_abort(msg) -! -! end subroutine endrun_globalindex + subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) + + !----------------------------------------------------------------------- + ! Description: + ! Abort the model for abnormal termination + ! + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + ! use GetGlobalValuesMod, only: GetGlobalWrite + ! + ! Arguments: + implicit none + integer , intent(in) :: decomp_index + character(len=*) , intent(in) :: clmlevel + + ! Generally you want to at least provide msg. The main reason to separate msg from + ! additional_msg is to supported expected-exception unit testing: you can put + ! volatile stuff in additional_msg, as in: + ! call endrun(msg='Informative message', additional_msg=errmsg(__FILE__, __LINE__)) + ! and then just assert against msg. + character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort + character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort + ! + ! Local Variables: + integer :: igrc, ilun, icol + !----------------------------------------------------------------------- + + ! write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) + ! call GetGlobalWrite(decomp_index, clmlevel) + + if (present (additional_msg)) then + write(iulog,*)'ENDRUN: ', additional_msg + else + write(iulog,*)'ENDRUN:' + end if + + call shr_sys_abort(msg) + + end subroutine endrun_globalindex end module abortutils From b49217112ed0beba1531207993651b8b48a69d99 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 15:34:35 -0500 Subject: [PATCH 191/589] update MAPL type --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 | 2 +- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 2 +- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 2 +- .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 | 2 +- .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 2 +- 24 files changed, 24 insertions(+), 24 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index 754658948..a6d53960e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -1,6 +1,6 @@ module CNProductsMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use MAPL_ExceptionHandling use nanMod , only : nan use decompMod , only : bounds_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 98d3f90be..99a4b2fcd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1,6 +1,6 @@ module CNVegCarbonFluxType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use decompMod , only : bounds_type use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index e35ea77a2..e3d7398e9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -1,6 +1,6 @@ module CNVegNitrogenFluxType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use decompMod , only : bounds_type use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index 00a919924..771fe7412 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -1,6 +1,6 @@ module CNVegNitrogenStateType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use MAPL_ExceptionHandling use clm_varctl , only : use_matrixcn use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index c086a6c48..378276939 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -1,6 +1,6 @@ module CNCLM_DriverMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use CNVegetationFacade use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight, diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 index d1afbb6cf..4b73532a9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 @@ -1,6 +1,6 @@ module OzoneBaseMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use decompMod , only : bounds_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index dcc02856b..d4f2977b2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -1,6 +1,6 @@ module PatchType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use decompMod , only : bounds_type use clm_varcon , only : ispval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index 6f482c3cc..8d3bd1e71 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -1,6 +1,6 @@ module SoilBiogeochemCarbonFluxType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan, ndecomp_cascade_outtransitions use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp, nlevsoi, ndecomp_pools_vr diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index db1e080d0..9a6f76238 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -1,6 +1,6 @@ module SoilBiogeochemNitrogenFluxType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, ndecomp_cascade_outtransitions use clm_varpar , only : nlevdecomp_full, nlevdecomp, ndecomp_pools_vr diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 7a11e973b..5386fcee0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -2,7 +2,7 @@ module SoilBiogeochemStateType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan, & nlevsno, nlevgrnd, nlevlak diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index af64885ac..f91f95847 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -1,6 +1,6 @@ module SoilStateType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varpar , only : nlevsoi, nlevgrnd, nlevmaxurbgrnd, & nlayer, nlevsno use clm_varcon , only : spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 index fc9cd988c..b75b6db05 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -1,6 +1,6 @@ module SolarAbsorbedType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varcon , only : spval use clm_varpar , only : nlevcan, numrad, nlevsno use clm_varctl , only : use_luna diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index 5deabade3..bbee951d1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -1,6 +1,6 @@ module SurfaceAlbedoType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use clm_varpar , only : numrad, nlevcan, nlevsno, numpft, num_zon, num_veg, & var_col, var_pft diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 index 2348255d4..62c38ce06 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 @@ -1,6 +1,6 @@ module TemperatureType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevurb, nlevmaxurbgrnd use clm_varctl , only : use_fates, use_luna use clm_varcon , only : spval, ispval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index 6e4b57a07..b208ccbd4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -1,6 +1,6 @@ module WaterDiagnosticBulkType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varpar , only : nlevgrnd, nlevsno, nlevcan use clm_varcon , only : spval use nanMod , only : nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 index 81770d4f6..b38d07c16 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -1,6 +1,6 @@ module WaterFluxBulkType - use MAPL_ConstantsMod , ONLY : r8 => MAPL_R4 + use MAPL_ConstantsMod , ONLY : r8 => MAPL_R8 use nanMod , only : nan use clm_varpar , only : nlevsno, nlevsoi use clm_varcon , only : spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index fc247d3ec..c631b6a91 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -1,6 +1,6 @@ module WaterFluxType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use clm_varpar , only : nlevsno use clm_varcon , only : spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 index 0262f207e..f0b70dc16 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 @@ -1,6 +1,6 @@ module atm2lndType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varpar , only : numrad use clm_varctl , only : use_fates, use_luna use nanMod , only : nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 index 972c76862..0a80e7799 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 @@ -1,6 +1,6 @@ module ch4Mod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use decompMod , only : bounds_type use clm_varcon , only : spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 index e5f3f5869..6a4d92903 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 @@ -1,6 +1,6 @@ module decompMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use clm_varpar , only: NUM_ZON, NUM_VEG, numpft ! !PUBLIC TYPES: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index 32e603c9e..f30b54fe8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -1,6 +1,6 @@ module filterMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use decompMod , only : bounds_type use clm_varpar , only : NUM_ZON, NUM_VEG, numpft diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index bcc8b2d25..2d9afcfd9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -2,7 +2,7 @@ module pftconMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan, bigint use clm_varpar , only : mxpft, numrad,nvariants, ivis, inir use clm_varctl , only : use_flexibleCN, use_cndv diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index af12dae3f..9f4d11310 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -9,7 +9,7 @@ module clm_varcon ! Module containing various model constants ! ! !USES: - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use shr_const_mod, only: SHR_CONST_G, & SHR_CONST_RHOFW, & SHR_CONST_TKFRZ, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 6cc882cbd..af09f43cc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -9,7 +9,7 @@ module clm_varctl ! Module containing run control variables ! ! !USES: - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R4 + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 ! ! !PUBLIC MEMBER FUNCTIONS: implicit none From 4cab4f3d0944ee308ece1453ee3987bb2d94cd84 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 08:08:58 -0500 Subject: [PATCH 192/589] comment out soil matrix calculation --- .../CLM51/SoilBiogeochemLittVertTranspMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemLittVertTranspMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemLittVertTranspMod.F90 index c020d4c2e..ea6b6aba8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemLittVertTranspMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemLittVertTranspMod.F90 @@ -249,13 +249,13 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & conc_ptr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col source => soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col trcr_tendency_ptr => soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col - matrix_input => soilbiogeochem_carbonflux_inst%matrix_Cinput%V + ! matrix_input => soilbiogeochem_carbonflux_inst%matrix_Cinput%V case (2) ! N if (use_cn ) then conc_ptr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col source => soilbiogeochem_nitrogenflux_inst%decomp_npools_sourcesink_col trcr_tendency_ptr => soilbiogeochem_nitrogenflux_inst%decomp_npools_transport_tendency_col - matrix_input => soilbiogeochem_nitrogenflux_inst%matrix_Ninput%V + ! matrix_input => soilbiogeochem_nitrogenflux_inst%matrix_Ninput%V endif case (3) if ( use_c13 ) then From 4353550e3dc4aab36f5488489cbe77da6e419dc8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 09:13:47 -0500 Subject: [PATCH 193/589] remove SurfaceAlbedoMod as it appears to be unused --- .../CLM51/CMakeLists.txt | 1 - .../CLM51/SurfaceAlbedoMod.F90 | 1699 ----------------- 2 files changed, 1700 deletions(-) delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index e8fb1090f..8717cef2d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -122,7 +122,6 @@ set (srcs SoilWaterRetentionCurveMod.F90 spmdMod.F90 subgridAveMod.F90 - SurfaceAlbedoMod.F90 SurfaceRadiationMod.F90 TridiagonalMod.F90 update_model_para4cn.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 deleted file mode 100755 index e8f557f9b..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 +++ /dev/null @@ -1,1699 +0,0 @@ -module SurfaceAlbedoMod - -#include "shr_assert.h" - - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! Performs surface albedo calculations - ! - ! !PUBLIC TYPES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg - use decompMod , only : bounds_type - use abortutils , only : endrun - use landunit_varcon , only : istsoil, istcrop, istdlak - use clm_varcon , only : grlnd, namep - use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan - use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE - use pftconMod , only : pftcon - use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC - use AerosolMod , only : aerosol_type - use CanopyStateType , only : canopystate_type - use LakeStateType , only : lakestate_type - use SurfaceAlbedoType , only : surfalb_type - use TemperatureType , only : temperature_type - use WaterStateBulkType , only : waterstatebulk_type - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type - use GridcellType , only : grc - use LandunitType , only : lun - use ColumnType , only : col - use PatchType , only : patch - ! - implicit none - ! - ! !PUBLIC MEMBER FUNCTIONS: - public :: SurfaceAlbedo_readnl - public :: SurfaceAlbedoInitTimeConst - public :: SurfaceAlbedo ! Surface albedo and two-stream fluxes - ! - ! !PRIVATE MEMBER FUNCTIONS: - private :: SoilAlbedo ! Determine ground surface albedo - private :: TwoStream ! Two-stream fluxes for canopy radiative transfer - ! - ! !PUBLIC DATA MEMBERS: - ! The CLM default albice values are too high. - ! Full-spectral albedo for land ice is ~0.5 (Paterson, Physics of Glaciers, 1994, p. 59) - ! This is the value used in CAM3 by Pritchard et al., GRL, 35, 2008. - - ! albedo land ice by waveband (1=vis, 2=nir) - real(r8), public :: albice(numrad) = (/ 0.80_r8, 0.55_r8 /) - - ! namelist default setting for inputting alblakwi - real(r8), public :: lake_melt_icealb(numrad) = (/ 0.10_r8, 0.10_r8/) - - ! albedo frozen lakes by waveband (1=vis, 2=nir) - ! unclear what the reference is for this - real(r8), private :: alblak(numrad) = (/0.60_r8, 0.40_r8/) - - ! albedo of melting lakes due to puddling, open water, or white ice - ! From D. Mironov (2010) Boreal Env. Research - ! To revert albedo of melting lakes to the cold snow-free value, set - ! lake_melt_icealb namelist to 0.60, 0.40 like alblak above. - real(r8), private :: alblakwi(numrad) - - ! Coefficient for calculating ice "fraction" for lake surface albedo - ! From D. Mironov (2010) Boreal Env. Research - real(r8), parameter :: calb = 95.6_r8 - - ! - ! !PRIVATE DATA MEMBERS: - logical, private :: snowveg_affects_radiation = .true. ! Whether snow on the vegetation canopy affects the radiation/albedo calculations - - ! - ! !PRIVATE DATA FUNCTIONS: - real(r8), allocatable, private :: albsat(:,:) ! wet soil albedo by color class and waveband (1=vis,2=nir) - real(r8), allocatable, private :: albdry(:,:) ! dry soil albedo by color class and waveband (1=vis,2=nir) - integer , allocatable, private :: isoicol(:) ! column soil color class - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - !----------------------------------------------------------------------- - -contains - - !----------------------------------------------------------------------- - subroutine SurfaceAlbedo_readnl( NLFilename ) - ! - ! !DESCRIPTION: - ! Read the namelist for SurfaceAlbedo - ! - ! !USES: - use spmdMod , only : masterproc, mpicom - use fileutils , only : getavu, relavu, opnfil - use shr_nl_mod , only : shr_nl_find_group_name - use shr_mpi_mod , only : shr_mpi_bcast - ! - ! !ARGUMENTS: - character(len=*), intent(in) :: NLFilename ! Namelist filename - ! - ! !LOCAL VARIABLES: - integer :: ierr ! error code - integer :: unitn ! unit for namelist file - character(len=*), parameter :: nmlname = "surfacealbedo_inparm" - - character(len=*), parameter :: subname = 'SurfaceAlbedo_readnl' - !----------------------------------------------------------------------- - - namelist /surfacealbedo_inparm/ snowveg_affects_radiation - - if (masterproc) then - unitn = getavu() - write(iulog,*) 'Read in '//nmlname//' namelist' - call opnfil (NLFilename, unitn, 'F') - call shr_nl_find_group_name(unitn, nmlname, status=ierr) - if (ierr == 0) then - read(unitn, nml=surfacealbedo_inparm, iostat=ierr) - if (ierr /= 0) then - call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) - end if - else - call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) - end if - call relavu( unitn ) - end if - - call shr_mpi_bcast(snowveg_affects_radiation, mpicom) - - if (masterproc) then - write(iulog,*) - write(iulog,*) nmlname, ' settings' - write(iulog,nml=surfacealbedo_inparm) - write(iulog,*) - end if - - end subroutine SurfaceAlbedo_readnl - - - !----------------------------------------------------------------------- - subroutine SurfaceAlbedoInitTimeConst(bounds) - ! - ! !DESCRIPTION: - ! Initialize module time constant variables - ! - ! !USES: - use shr_log_mod, only : errMsg => shr_log_errMsg - use fileutils , only : getfil - use abortutils , only : endrun - use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_pio_openfile, ncd_pio_closefile - use spmdMod , only : masterproc - ! - ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: c,g ! indices - integer :: mxsoil_color ! maximum number of soil color classes - type(file_desc_t) :: ncid ! netcdf id - character(len=256) :: locfn ! local filename - integer :: ier ! error status - logical :: readvar - integer ,pointer :: soic2d (:) ! read in - soil color - !--------------------------------------------------------------------- - - ! Allocate module variable for soil color - - allocate(isoicol(bounds%begc:bounds%endc)) - - ! Determine soil color and number of soil color classes - - call getfil (fsurdat, locfn, 0) - call ncd_pio_openfile (ncid, locfn, 0) - - call ncd_io(ncid=ncid, varname='mxsoil_color', flag='read', data=mxsoil_color, readvar=readvar) - if ( .not. readvar ) then - call endrun(msg=' ERROR: mxsoil_color NOT on surfdata file '//errMsg(sourcefile, __LINE__)) - end if - - allocate(soic2d(bounds%begg:bounds%endg)) - call ncd_io(ncid=ncid, varname='SOIL_COLOR', flag='read', data=soic2d, dim1name=grlnd, readvar=readvar) - if (.not. readvar) then - call endrun(msg=' ERROR: SOIL_COLOR NOT on surfdata file'//errMsg(sourcefile, __LINE__)) - end if - do c = bounds%begc, bounds%endc - g = col%gridcell(c) - isoicol(c) = soic2d(g) - end do - deallocate(soic2d) - - call ncd_pio_closefile(ncid) - - ! Determine saturated and dry soil albedos for n color classes and - ! numrad wavebands (1=vis, 2=nir) - - allocate(albsat(mxsoil_color,numrad), albdry(mxsoil_color,numrad), stat=ier) - if (ier /= 0) then - write(iulog,*)'allocation error for albsat, albdry' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - if (masterproc) then - write(iulog,*) 'Attempting to read soil colo data .....' - end if - - if (mxsoil_color == 8) then - albsat(1:8,1) = (/0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8/) - albsat(1:8,2) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) - albdry(1:8,1) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) - albdry(1:8,2) = (/0.48_r8,0.44_r8,0.40_r8,0.36_r8,0.32_r8,0.28_r8,0.24_r8,0.20_r8/) - else if (mxsoil_color == 20) then - albsat(1:20,1) = (/0.25_r8,0.23_r8,0.21_r8,0.20_r8,0.19_r8,0.18_r8,0.17_r8,0.16_r8,& - 0.15_r8,0.14_r8,0.13_r8,0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8,0.04_r8/) - albsat(1:20,2) = (/0.50_r8,0.46_r8,0.42_r8,0.40_r8,0.38_r8,0.36_r8,0.34_r8,0.32_r8,& - 0.30_r8,0.28_r8,0.26_r8,0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) - albdry(1:20,1) = (/0.36_r8,0.34_r8,0.32_r8,0.31_r8,0.30_r8,0.29_r8,0.28_r8,0.27_r8,& - 0.26_r8,0.25_r8,0.24_r8,0.23_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) - albdry(1:20,2) = (/0.61_r8,0.57_r8,0.53_r8,0.51_r8,0.49_r8,0.48_r8,0.45_r8,0.43_r8,& - 0.41_r8,0.39_r8,0.37_r8,0.35_r8,0.33_r8,0.31_r8,0.29_r8,0.27_r8,0.25_r8,0.23_r8,0.21_r8,0.16_r8/) - else - write(iulog,*)'maximum color class = ',mxsoil_color,' is not supported' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - ! Set alblakwi - alblakwi(:) = lake_melt_icealb(:) - - end subroutine SurfaceAlbedoInitTimeConst - - !----------------------------------------------------------------------- - subroutine SurfaceAlbedo(bounds,nc, & - num_nourbanc, filter_nourbanc, & - num_nourbanp, filter_nourbanp, & - num_urbanc , filter_urbanc, & - num_urbanp , filter_urbanp, & - nextsw_cday , declinp1, & - clm_fates, & - aerosol_inst, canopystate_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, & - lakestate_inst, temperature_inst, surfalb_inst) - ! - ! !DESCRIPTION: - ! Surface albedo and two-stream fluxes - ! Surface albedos. Also fluxes (per unit incoming direct and diffuse - ! radiation) reflected, transmitted, and absorbed by vegetation. - ! Calculate sunlit and shaded fluxes as described by - ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to - ! a multi-layer canopy to calculate APAR profile - ! - ! The calling sequence is: - ! -> SurfaceAlbedo: albedos for next time step - ! -> SoilAlbedo: soil/lake/glacier/wetland albedos - ! -> SNICAR_RT: snow albedos: direct beam (SNICAR) - ! -> SNICAR_RT: snow albedos: diffuse (SNICAR) - ! -> TwoStream: absorbed, reflected, transmitted solar fluxes (vis dir,vis dif, nir dir, nir dif) - ! - ! Note that this is called with the "inactive_and_active" version of the filters, because - ! the variables computed here are needed over inactive points that might later become - ! active (due to landuse change). Thus, this routine cannot depend on variables that are - ! only computed over active points. - ! - ! !USES: - use shr_orb_mod - use clm_time_manager , only : get_nstep - use abortutils , only : endrun - use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, use_fates - use CLMFatesInterfaceMod, only : hlm_fates_interface_type - - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds ! bounds - integer , intent(in) :: nc ! clump index - integer , intent(in) :: num_nourbanc ! number of columns in non-urban filter - integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points - integer , intent(in) :: num_nourbanp ! number of patches in non-urban filter - integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points - integer , intent(in) :: num_urbanc ! number of columns in urban filter - integer , intent(in) :: filter_urbanc(:) ! column filter for urban points - integer , intent(in) :: num_urbanp ! number of patches in urban filter - integer , intent(in) :: filter_urbanp(:) ! patch filter for rban points - real(r8) , intent(in) :: nextsw_cday ! calendar day at Greenwich (1.00, ..., days/year) - real(r8) , intent(in) :: declinp1 ! declination angle (radians) for next time step - type(hlm_fates_interface_type), intent(inout) :: clm_fates - type(aerosol_type) , intent(in) :: aerosol_inst - type(canopystate_type) , intent(in) :: canopystate_inst - type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst - type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst - type(lakestate_type) , intent(in) :: lakestate_inst - type(temperature_type) , intent(in) :: temperature_inst - type(surfalb_type) , intent(inout) :: surfalb_inst - ! - ! !LOCAL VARIABLES: - integer :: i ! index for layers [idx] - integer :: aer ! index for sno_nbr_aer - real(r8) :: extkn ! nitrogen allocation coefficient - integer :: fp,fc,g,c,p,iv ! indices - integer :: ib ! band index - integer :: ic ! 0=unit incoming direct; 1=unit incoming diffuse - real(r8) :: dinc ! lai+sai increment for canopy layer - real(r8) :: dincmax ! maximum lai+sai increment for canopy layer - real(r8) :: dincmax_sum ! cumulative sum of maximum lai+sai increment for canopy layer - real(r8) :: laisum ! sum of canopy layer lai for error check - real(r8) :: saisum ! sum of canopy layer sai for error check - integer :: flg_slr ! flag for SNICAR (=1 if direct, =2 if diffuse) - integer :: flg_snw_ice ! flag for SNICAR (=1 when called from CLM, =2 when called from sea-ice) - integer :: num_vegsol ! number of vegetated patches where coszen>0 - integer :: num_novegsol ! number of vegetated patches where coszen>0 - integer :: filter_vegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 - integer :: filter_novegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 - real(r8) :: wl (bounds%begp:bounds%endp) ! fraction of LAI+SAI that is LAI - real(r8) :: ws (bounds%begp:bounds%endp) ! fraction of LAI+SAI that is SAI - real(r8) :: blai(bounds%begp:bounds%endp) ! lai buried by snow: tlai - elai - real(r8) :: bsai(bounds%begp:bounds%endp) ! sai buried by snow: tsai - esai - real(r8) :: coszen_gcell (bounds%begg:bounds%endg) ! cosine solar zenith angle for next time step (grc) - real(r8) :: coszen_patch (bounds%begp:bounds%endp) ! cosine solar zenith angle for next time step (patch) - real(r8) :: rho(bounds%begp:bounds%endp,numrad) ! leaf/stem refl weighted by fraction LAI and SAI - real(r8) :: tau(bounds%begp:bounds%endp,numrad) ! leaf/stem tran weighted by fraction LAI and SAI - real(r8) :: h2osno_total (bounds%begc:bounds%endc) ! total snow water (mm H2O) - real(r8) :: albsfc (bounds%begc:bounds%endc,numrad) ! albedo of surface underneath snow (col,bnd) - real(r8) :: albsnd(bounds%begc:bounds%endc,numrad) ! snow albedo (direct) - real(r8) :: albsni(bounds%begc:bounds%endc,numrad) ! snow albedo (diffuse) - real(r8) :: albsnd_pur (bounds%begc:bounds%endc,numrad) ! direct pure snow albedo (radiative forcing) - real(r8) :: albsni_pur (bounds%begc:bounds%endc,numrad) ! diffuse pure snow albedo (radiative forcing) - real(r8) :: albsnd_bc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without BC (radiative forcing) - real(r8) :: albsni_bc (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without BC (radiative forcing) - real(r8) :: albsnd_oc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without OC (radiative forcing) - real(r8) :: albsni_oc (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without OC (radiative forcing) - real(r8) :: albsnd_dst (bounds%begc:bounds%endc,numrad) ! direct snow albedo without dust (radiative forcing) - real(r8) :: albsni_dst (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without dust (radiative forcing) - real(r8) :: flx_absd_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (direct) [frc] - real(r8) :: flx_absi_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (diffuse) [frc] - real(r8) :: foo_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! dummy array for forcing calls - real(r8) :: h2osno_liq (bounds%begc:bounds%endc,-nlevsno+1:0) ! liquid snow content (col,lyr) [kg m-2] - real(r8) :: h2osno_ice (bounds%begc:bounds%endc,-nlevsno+1:0) ! ice content in snow (col,lyr) [kg m-2] - integer :: snw_rds_in (bounds%begc:bounds%endc,-nlevsno+1:0) ! snow grain size sent to SNICAR (col,lyr) [microns] - real(r8) :: mss_cnc_aer_in_frc_pur (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for forcing calculation (zero) (col,lyr,aer) [kg kg-1] - real(r8) :: mss_cnc_aer_in_frc_bc (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for BC forcing (col,lyr,aer) [kg kg-1] - real(r8) :: mss_cnc_aer_in_frc_oc (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for OC forcing (col,lyr,aer) [kg kg-1] - real(r8) :: mss_cnc_aer_in_frc_dst (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for dust forcing (col,lyr,aer) [kg kg-1] - real(r8) :: mss_cnc_aer_in_fdb (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of all aerosol species for feedback calculation (col,lyr,aer) [kg kg-1] - real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero - integer , parameter :: nband =numrad ! number of solar radiation waveband classes - !----------------------------------------------------------------------- - - associate(& - rhol => pftcon%rhol , & ! Input: leaf reflectance: 1=vis, 2=nir - rhos => pftcon%rhos , & ! Input: stem reflectance: 1=vis, 2=nir - taul => pftcon%taul , & ! Input: leaf transmittance: 1=vis, 2=nir - taus => pftcon%taus , & ! Input: stem transmittance: 1=vis, 2=nir - - tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow - tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index, no burying by snow - elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow - esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow - - frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) - h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water content (col,lyr) [kg/m2] - h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens content (col,lyr) [kg/m2] - snw_rds => waterdiagnosticbulk_inst%snw_rds_col , & ! Input: [real(r8) (:,:) ] snow grain radius (col,lyr) [microns] - - mss_cnc_bcphi => aerosol_inst%mss_cnc_bcphi_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophilic BC (col,lyr) [kg/kg] - mss_cnc_bcpho => aerosol_inst%mss_cnc_bcpho_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophobic BC (col,lyr) [kg/kg] - mss_cnc_ocphi => aerosol_inst%mss_cnc_ocphi_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophilic OC (col,lyr) [kg/kg] - mss_cnc_ocpho => aerosol_inst%mss_cnc_ocpho_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophobic OC (col,lyr) [kg/kg] - mss_cnc_dst1 => aerosol_inst%mss_cnc_dst1_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 1 (col,lyr) [kg/kg] - mss_cnc_dst2 => aerosol_inst%mss_cnc_dst2_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 2 (col,lyr) [kg/kg] - mss_cnc_dst3 => aerosol_inst%mss_cnc_dst3_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 3 (col,lyr) [kg/kg] - mss_cnc_dst4 => aerosol_inst%mss_cnc_dst4_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 4 (col,lyr) [kg/kg] - - fsun_z => surfalb_inst%fsun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer - tlai_z => surfalb_inst%tlai_z_patch , & ! Output: [real(r8) (:,:) ] tlai increment for canopy layer - tsai_z => surfalb_inst%tsai_z_patch , & ! Output: [real(r8) (:,:) ] tsai increment for canopy layer - vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, sunlit leaf vcmax - vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, shaded leaf vcmax - ncan => surfalb_inst%ncan_patch , & ! Output: [integer (:) ] number of canopy layers - nrad => surfalb_inst%nrad_patch , & ! Output: [integer (:) ] number of canopy layers, above snow for radiative transfer - coszen_col => surfalb_inst%coszen_col , & ! Output: [real(r8) (:) ] cosine of solar zenith angle - albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) - albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) - albsod => surfalb_inst%albsod_col , & ! Output: [real(r8) (:,:) ] direct-beam soil albedo (col,bnd) [frc] - albsoi => surfalb_inst%albsoi_col , & ! Output: [real(r8) (:,:) ] diffuse soil albedo (col,bnd) [frc] - albgrd_pur => surfalb_inst%albgrd_pur_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (direct) - albgri_pur => surfalb_inst%albgri_pur_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (diffuse) - albgrd_bc => surfalb_inst%albgrd_bc_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (direct) - albgri_bc => surfalb_inst%albgri_bc_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (diffuse) - albgrd_oc => surfalb_inst%albgrd_oc_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (direct) - albgri_oc => surfalb_inst%albgri_oc_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (diffuse) - albgrd_dst => surfalb_inst%albgrd_dst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (direct) - albgri_dst => surfalb_inst%albgri_dst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (diffuse) - albsnd_hst => surfalb_inst%albsnd_hst_col , & ! Output: [real(r8) (:,:) ] snow albedo, direct, for history files (col,bnd) [frc] - albsni_hst => surfalb_inst%albsni_hst_col , & ! Output: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd) [frc] - albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) - albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) - albdSF => surfalb_inst%albdSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (direct) - albiSF => surfalb_inst%albiSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (diffuse) - fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux - fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux - fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux - fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux - fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux - fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux - ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flux - ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flux - ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flux - flx_absdv => surfalb_inst%flx_absdv_col , & ! Output: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): VIS [frc] - flx_absdn => surfalb_inst%flx_absdn_col , & ! Output: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): NIR [frc] - flx_absiv => surfalb_inst%flx_absiv_col , & ! Output: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): VIS [frc] - flx_absin => surfalb_inst%flx_absin_col , & ! Output: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): NIR [frc] - fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer - fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer - fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer - fabi_sha_z => surfalb_inst%fabi_sha_z_patch & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer - ) - - ! Cosine solar zenith angle for next time step - - do g = bounds%begg,bounds%endg - coszen_gcell(g) = shr_orb_cosz (nextsw_cday, grc%lat(g), grc%lon(g), declinp1) - end do - do c = bounds%begc,bounds%endc - g = col%gridcell(c) - coszen_col(c) = coszen_gcell(g) - end do - do fp = 1,num_nourbanp - p = filter_nourbanp(fp) - g = patch%gridcell(p) - coszen_patch(p) = coszen_gcell(g) - end do - - ! Initialize output because solar radiation only done if coszen > 0 - - do ib = 1, numrad - do fc = 1,num_nourbanc - c = filter_nourbanc(fc) - albsod(c,ib) = 0._r8 - albsoi(c,ib) = 0._r8 - albgrd(c,ib) = 0._r8 - albgri(c,ib) = 0._r8 - albgrd_pur(c,ib) = 0._r8 - albgri_pur(c,ib) = 0._r8 - albgrd_bc(c,ib) = 0._r8 - albgri_bc(c,ib) = 0._r8 - albgrd_oc(c,ib) = 0._r8 - albgri_oc(c,ib) = 0._r8 - albgrd_dst(c,ib) = 0._r8 - albgri_dst(c,ib) = 0._r8 - do i=-nlevsno+1,1,1 - flx_absdv(c,i) = 0._r8 - flx_absdn(c,i) = 0._r8 - flx_absiv(c,i) = 0._r8 - flx_absin(c,i) = 0._r8 - enddo - end do - - do fp = 1,num_nourbanp - p = filter_nourbanp(fp) - albd(p,ib) = 1._r8 - albi(p,ib) = 1._r8 - if (use_SSRE) then - albdSF(p,ib) = 1._r8 - albiSF(p,ib) = 1._r8 - end if - fabd(p,ib) = 0._r8 - fabd_sun(p,ib) = 0._r8 - fabd_sha(p,ib) = 0._r8 - fabi(p,ib) = 0._r8 - fabi_sun(p,ib) = 0._r8 - fabi_sha(p,ib) = 0._r8 - ftdd(p,ib) = 0._r8 - ftid(p,ib) = 0._r8 - ftii(p,ib) = 0._r8 - end do - - end do ! end of numrad loop - - ! SoilAlbedo called before SNICAR_RT - ! so that reflectance of soil beneath snow column is known - ! ahead of time for snow RT calculation. - - ! Snow albedos - ! Note that snow albedo routine will only compute nonzero snow albedos - ! where h2osno> 0 and coszen > 0 - - ! Ground surface albedos - ! Note that ground albedo routine will only compute nonzero snow albedos - ! where coszen > 0 - - call SoilAlbedo(bounds, & - num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - albsnd(bounds%begc:bounds%endc, :), & - albsni(bounds%begc:bounds%endc, :), & - lakestate_inst, temperature_inst, waterstatebulk_inst, surfalb_inst) - - ! set variables to pass to SNICAR. - - flg_snw_ice = 1 ! calling from CLM, not CSIM - do c=bounds%begc,bounds%endc - albsfc(c,:) = albsoi(c,:) - h2osno_liq(c,:) = h2osoi_liq(c,-nlevsno+1:0) - h2osno_ice(c,:) = h2osoi_ice(c,-nlevsno+1:0) - snw_rds_in(c,:) = nint(snw_rds(c,:)) - end do - - ! zero aerosol input arrays - do aer = 1, sno_nbr_aer - do i = -nlevsno+1, 0 - do c = bounds%begc, bounds%endc - mss_cnc_aer_in_frc_pur(c,i,aer) = 0._r8 - mss_cnc_aer_in_frc_bc(c,i,aer) = 0._r8 - mss_cnc_aer_in_frc_oc(c,i,aer) = 0._r8 - mss_cnc_aer_in_frc_dst(c,i,aer) = 0._r8 - mss_cnc_aer_in_fdb(c,i,aer) = 0._r8 - end do - end do - end do - - ! Set aerosol input arrays - ! feedback input arrays have been zeroed - ! set soot and dust aerosol concentrations: - if (DO_SNO_AER) then - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) - - ! DO_SNO_OC is set in SNICAR_varpar. Default case is to ignore OC concentrations because: - ! 1) Knowledge of their optical properties is primitive - ! 2) When 'water-soluble' OPAC optical properties are applied to OC in snow, - ! it has a negligible darkening effect. - if (DO_SNO_OC) then - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) - endif - - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) - endif - - call waterstatebulk_inst%CalculateTotalH2osno(bounds, num_nourbanc, filter_nourbanc, & - caller = 'SurfaceAlbedo', & - h2osno_total = h2osno_total(bounds%begc:bounds%endc)) - - ! If radiative forcing is being calculated, first estimate clean-snow albedo - - if (use_snicar_frc) then - ! 1. BC input array: - ! set dust and (optionally) OC concentrations, so BC_FRC=[(BC+OC+dust)-(OC+dust)] - mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) - if (DO_SNO_OC) then - mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) - endif - - ! BC FORCING CALCULATIONS - flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsnd_bc(bounds%begc:bounds%endc, :), & - foo_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - - flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsni_bc(bounds%begc:bounds%endc, :), & - foo_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - - ! 2. OC input array: - ! set BC and dust concentrations, so OC_FRC=[(BC+OC+dust)-(BC+dust)] - if (DO_SNO_OC) then - mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) - - ! OC FORCING CALCULATIONS - flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsnd_oc(bounds%begc:bounds%endc, :), & - foo_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - - flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsni_oc(bounds%begc:bounds%endc, :), & - foo_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - endif - - ! 3. DUST input array: - ! set BC and OC concentrations, so DST_FRC=[(BC+OC+dust)-(BC+OC)] - mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) - if (DO_SNO_OC) then - mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) - mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) - endif - - ! DUST FORCING CALCULATIONS - flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsnd_dst(bounds%begc:bounds%endc, :), & - foo_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - - flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsni_dst(bounds%begc:bounds%endc, :), & - foo_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - - ! 4. ALL AEROSOL FORCING CALCULATION - ! (pure snow albedo) - flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_frc_pur(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsnd_pur(bounds%begc:bounds%endc, :), & - foo_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - - flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_frc_pur(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsni_pur(bounds%begc:bounds%endc, :), & - foo_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - end if - - ! CLIMATE FEEDBACK CALCULATIONS, ALL AEROSOLS: - flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsnd(bounds%begc:bounds%endc, :), & - flx_absd_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - - flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsni(bounds%begc:bounds%endc, :), & - flx_absi_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) - - ! ground albedos and snow-fraction weighting of snow absorption factors - do ib = 1, nband - do fc = 1,num_nourbanc - c = filter_nourbanc(fc) - if (coszen_col(c) > 0._r8) then - ! ground albedo was originally computed in SoilAlbedo, but is now computed here - ! because the order of SoilAlbedo and SNICAR_RT was switched for SNICAR. - albgrd(c,ib) = albsod(c,ib)*(1._r8-frac_sno(c)) + albsnd(c,ib)*frac_sno(c) - albgri(c,ib) = albsoi(c,ib)*(1._r8-frac_sno(c)) + albsni(c,ib)*frac_sno(c) - - ! albedos for radiative forcing calculations: - if (use_snicar_frc) then - ! BC forcing albedo - albgrd_bc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_bc(c,ib)*frac_sno(c) - albgri_bc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_bc(c,ib)*frac_sno(c) - - if (DO_SNO_OC) then - ! OC forcing albedo - albgrd_oc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_oc(c,ib)*frac_sno(c) - albgri_oc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_oc(c,ib)*frac_sno(c) - endif - - ! dust forcing albedo - albgrd_dst(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_dst(c,ib)*frac_sno(c) - albgri_dst(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_dst(c,ib)*frac_sno(c) - - ! pure snow albedo for all-aerosol radiative forcing - albgrd_pur(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_pur(c,ib)*frac_sno(c) - albgri_pur(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_pur(c,ib)*frac_sno(c) - end if - - ! also in this loop (but optionally in a different loop for vectorized code) - ! weight snow layer radiative absorption factors based on snow fraction and soil albedo - ! (NEEDED FOR ENERGY CONSERVATION) - do i = -nlevsno+1,1,1 - if (.not. use_subgrid_fluxes .or. lun%itype(col%landunit(c)) == istdlak) then - if (ib == 1) then - flx_absdv(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & - ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) - flx_absiv(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & - ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) - elseif (ib == 2) then - flx_absdn(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & - ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) - flx_absin(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & - ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) - endif - else - if (ib == 1) then - flx_absdv(c,i) = flx_absd_snw(c,i,ib) - flx_absiv(c,i) = flx_absi_snw(c,i,ib) - elseif (ib == 2) then - flx_absdn(c,i) = flx_absd_snw(c,i,ib) - flx_absin(c,i) = flx_absi_snw(c,i,ib) - endif - endif - enddo - endif - enddo - enddo - - ! For diagnostics, set snow albedo to spval over non-snow non-urban points - ! so that it is not averaged in history buffer (OPTIONAL) - ! TODO - this is set to 0 not spval - seems wrong since it will be averaged in - - do ib = 1, nband - do fc = 1,num_nourbanc - c = filter_nourbanc(fc) - if ((coszen_col(c) > 0._r8) .and. (h2osno_total(c) > 0._r8)) then - albsnd_hst(c,ib) = albsnd(c,ib) - albsni_hst(c,ib) = albsni(c,ib) - else - albsnd_hst(c,ib) = 0._r8 - albsni_hst(c,ib) = 0._r8 - endif - enddo - enddo - - ! Create solar-vegetated filter for the following calculations - - num_vegsol = 0 - num_novegsol = 0 - do fp = 1,num_nourbanp - p = filter_nourbanp(fp) - if (coszen_patch(p) > 0._r8) then - if ((lun%itype(patch%landunit(p)) == istsoil .or. & - lun%itype(patch%landunit(p)) == istcrop ) & - .and. (elai(p) + esai(p)) > 0._r8) then - num_vegsol = num_vegsol + 1 - filter_vegsol(num_vegsol) = p - else - num_novegsol = num_novegsol + 1 - filter_novegsol(num_novegsol) = p - end if - end if - end do - - ! Weight reflectance/transmittance by lai and sai - ! Only perform on vegetated patches where coszen > 0 - - do fp = 1,num_vegsol - p = filter_vegsol(fp) - wl(p) = elai(p) / max( elai(p)+esai(p), mpe ) - ws(p) = esai(p) / max( elai(p)+esai(p), mpe ) - end do - - do ib = 1, numrad - do fp = 1,num_vegsol - p = filter_vegsol(fp) - rho(p,ib) = max( rhol(patch%itype(p),ib)*wl(p) + rhos(patch%itype(p),ib)*ws(p), mpe ) - tau(p,ib) = max( taul(patch%itype(p),ib)*wl(p) + taus(patch%itype(p),ib)*ws(p), mpe ) - end do - end do - - ! Diagnose number of canopy layers for radiative transfer, in increments of dincmax. - ! Add to number of layers so long as cumulative leaf+stem area does not exceed total - ! leaf+stem area. Then add any remaining leaf+stem area to next layer and exit the loop. - ! Do this first for elai and esai (not buried by snow) and then for the part of the - ! canopy that is buried by snow. - ! ------------------ - ! tlai_z = leaf area increment for a layer - ! tsai_z = stem area increment for a layer - ! nrad = number of canopy layers above snow - ! ncan = total number of canopy layers - ! - ! tlai_z summed from 1 to nrad = elai - ! tlai_z summed from 1 to ncan = tlai - - ! tsai_z summed from 1 to nrad = esai - ! tsai_z summed from 1 to ncan = tsai - ! ------------------ - ! - ! Canopy layering needs to be done for all "num_nourbanp" not "num_vegsol" - ! because layering is needed for all time steps regardless of radiation - ! - ! Sun/shade big leaf code uses only one layer (nrad = ncan = 1), triggered by - ! nlevcan = 1 - - dincmax = 0.25_r8 - do fp = 1,num_nourbanp - p = filter_nourbanp(fp) - - if (nlevcan == 1) then - nrad(p) = 1 - ncan(p) = 1 - tlai_z(p,1) = elai(p) - tsai_z(p,1) = esai(p) - else if (nlevcan > 1) then - if (elai(p)+esai(p) == 0._r8) then - nrad(p) = 0 - else - dincmax_sum = 0._r8 - do iv = 1, nlevcan - dincmax_sum = dincmax_sum + dincmax - if (((elai(p)+esai(p))-dincmax_sum) > 1.e-06_r8) then - nrad(p) = iv - dinc = dincmax - tlai_z(p,iv) = dinc * elai(p) / max(elai(p)+esai(p), mpe) - tsai_z(p,iv) = dinc * esai(p) / max(elai(p)+esai(p), mpe) - else - nrad(p) = iv - dinc = dincmax - (dincmax_sum - (elai(p)+esai(p))) - tlai_z(p,iv) = dinc * elai(p) / max(elai(p)+esai(p), mpe) - tsai_z(p,iv) = dinc * esai(p) / max(elai(p)+esai(p), mpe) - exit - end if - end do - - ! Mimumum of 4 canopy layers - - if (nrad(p) < 4) then - nrad(p) = 4 - do iv = 1, nrad(p) - tlai_z(p,iv) = elai(p) / nrad(p) - tsai_z(p,iv) = esai(p) / nrad(p) - end do - end if - end if - end if - - ! Error check: make sure cumulative of increments does not exceed total - - laisum = 0._r8 - saisum = 0._r8 - do iv = 1, nrad(p) - laisum = laisum + tlai_z(p,iv) - saisum = saisum + tsai_z(p,iv) - end do - if (abs(laisum-elai(p)) > 1.e-06_r8 .or. abs(saisum-esai(p)) > 1.e-06_r8) then - write (iulog,*) 'multi-layer canopy error 01 in SurfaceAlbedo: ',& - nrad(p),elai(p),laisum,esai(p),saisum - call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) - end if - - ! Repeat to find canopy layers buried by snow - - if (nlevcan > 1) then - blai(p) = tlai(p) - elai(p) - bsai(p) = tsai(p) - esai(p) - if (blai(p)+bsai(p) == 0._r8) then - ncan(p) = nrad(p) - else - dincmax_sum = 0._r8 - do iv = nrad(p)+1, nlevcan - dincmax_sum = dincmax_sum + dincmax - if (((blai(p)+bsai(p))-dincmax_sum) > 1.e-06_r8) then - ncan(p) = iv - dinc = dincmax - tlai_z(p,iv) = dinc * blai(p) / max(blai(p)+bsai(p), mpe) - tsai_z(p,iv) = dinc * bsai(p) / max(blai(p)+bsai(p), mpe) - else - ncan(p) = iv - dinc = dincmax - (dincmax_sum - (blai(p)+bsai(p))) - tlai_z(p,iv) = dinc * blai(p) / max(blai(p)+bsai(p), mpe) - tsai_z(p,iv) = dinc * bsai(p) / max(blai(p)+bsai(p), mpe) - exit - end if - end do - end if - - ! Error check: make sure cumulative of increments does not exceed total - - laisum = 0._r8 - saisum = 0._r8 - do iv = 1, ncan(p) - laisum = laisum + tlai_z(p,iv) - saisum = saisum + tsai_z(p,iv) - end do - if (abs(laisum-tlai(p)) > 1.e-06_r8 .or. abs(saisum-tsai(p)) > 1.e-06_r8) then - write (iulog,*) 'multi-layer canopy error 02 in SurfaceAlbedo: ',nrad(p),ncan(p) - write (iulog,*) tlai(p),elai(p),blai(p),laisum,tsai(p),esai(p),bsai(p),saisum - call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) - end if - end if - - end do - - ! Zero fluxes for active canopy layers - - do fp = 1,num_nourbanp - p = filter_nourbanp(fp) - do iv = 1, nrad(p) - fabd_sun_z(p,iv) = 0._r8 - fabd_sha_z(p,iv) = 0._r8 - fabi_sun_z(p,iv) = 0._r8 - fabi_sha_z(p,iv) = 0._r8 - fsun_z(p,iv) = 0._r8 - end do - end do - - ! Default leaf to canopy scaling coefficients, used when coszen <= 0. - ! This is the leaf nitrogen profile integrated over the full canopy. - ! Integrate exp(-kn*x) over x=0 to x=elai and assign to shaded canopy, - ! because sunlit fraction is 0. Canopy scaling coefficients are set in - ! TwoStream for coszen > 0. So kn must be set here and in TwoStream. - - extkn = 0.30_r8 - do fp = 1,num_nourbanp - p = filter_nourbanp(fp) - if (nlevcan == 1) then - vcmaxcintsun(p) = 0._r8 - vcmaxcintsha(p) = (1._r8 - exp(-extkn*elai(p))) / extkn - if (elai(p) > 0._r8) then - vcmaxcintsha(p) = vcmaxcintsha(p) / elai(p) - else - vcmaxcintsha(p) = 0._r8 - end if - else if (nlevcan > 1) then - vcmaxcintsun(p) = 0._r8 - vcmaxcintsha(p) = 0._r8 - end if - end do - - ! Calculate surface albedos and fluxes - ! Only perform on vegetated pfts where coszen > 0 - - if (use_fates) then - - call clm_fates%wrap_canopy_radiation(bounds, nc, & - num_vegsol, filter_vegsol, & - coszen_patch(bounds%begp:bounds%endp), surfalb_inst) - - else - - call TwoStream (bounds, filter_vegsol, num_vegsol, & - coszen_patch(bounds%begp:bounds%endp), & - rho(bounds%begp:bounds%endp, :), & - tau(bounds%begp:bounds%endp, :), & - canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst) - ! Run TwoStream again just to calculate the Snow Free (SF) albedo's - if (use_SSRE) then - if ( nlevcan > 1 )then - call endrun( 'ERROR: use_ssre option was NOT developed with allowance for multi-layer canopy: '// & - 'nlevcan can ONLY be 1 in when use_ssre is on') - end if - call TwoStream (bounds, filter_vegsol, num_vegsol, & - coszen_patch(bounds%begp:bounds%endp), & - rho(bounds%begp:bounds%endp, :), & - tau(bounds%begp:bounds%endp, :), & - canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst, & - SFonly=.true.) - end if - - endif - - ! Determine values for non-vegetated patches where coszen > 0 - - do ib = 1,numrad - do fp = 1,num_novegsol - p = filter_novegsol(fp) - c = patch%column(p) - fabd(p,ib) = 0._r8 - fabd_sun(p,ib) = 0._r8 - fabd_sha(p,ib) = 0._r8 - fabi(p,ib) = 0._r8 - fabi_sun(p,ib) = 0._r8 - fabi_sha(p,ib) = 0._r8 - ftdd(p,ib) = 1._r8 - ftid(p,ib) = 0._r8 - ftii(p,ib) = 1._r8 - albd(p,ib) = albgrd(c,ib) - albi(p,ib) = albgri(c,ib) - if (use_SSRE) then - albdSF(p,ib) = albsod(c,ib) - albiSF(p,ib) = albsoi(c,ib) - end if - end do - end do - - end associate - - end subroutine SurfaceAlbedo - - !----------------------------------------------------------------------- - subroutine SoilAlbedo (bounds, & - num_nourbanc, filter_nourbanc, & - coszen, albsnd, albsni, & - lakestate_inst, temperature_inst, waterstatebulk_inst, surfalb_inst) - ! - ! !DESCRIPTION: - ! Determine ground surface albedo, accounting for snow - ! - ! !USES: - use clm_varpar , only : numrad - use clm_varcon , only : tfrz - use landunit_varcon , only : istice_mec, istdlak - use LakeCon , only : lakepuddling - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_nourbanc ! number of columns in non-urban points in column filter - integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points - real(r8), intent(in) :: coszen( bounds%begc: ) ! cos solar zenith angle next time step [col] - real(r8), intent(in) :: albsnd( bounds%begc: , 1: ) ! snow albedo (direct) [col, numrad] - real(r8), intent(in) :: albsni( bounds%begc: , 1: ) ! snow albedo (diffuse) [col, numrad] - type(temperature_type) , intent(in) :: temperature_inst - type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst - type(lakestate_type) , intent(in) :: lakestate_inst - type(surfalb_type) , intent(inout) :: surfalb_inst - ! - ! !LOCAL VARIABLES: - ! - integer, parameter :: nband =numrad ! number of solar radiation waveband classes - integer :: fc ! non-urban filter column index - integer :: c,l ! indices - integer :: ib ! waveband number (1=vis, 2=nir) - real(r8) :: inc ! soil water correction factor for soil albedo - integer :: soilcol ! soilcolor - real(r8) :: sicefr ! Lake surface ice fraction (based on D. Mironov 2010) - !----------------------------------------------------------------------- - - ! Enforce expected array sizes - SHR_ASSERT_ALL_FL((ubound(coszen) == (/bounds%endc/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(albsnd) == (/bounds%endc, numrad/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(albsni) == (/bounds%endc, numrad/)), sourcefile, __LINE__) - - associate(& - snl => col%snl , & ! Input: [integer (:) ] number of snow layers - - t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) - - h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water [m3/m3] - - lake_icefrac => lakestate_inst%lake_icefrac_col , & ! Input: [real(r8) (:,:) ] mass fraction of lake layer that is frozen - - albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) - albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) - albsod => surfalb_inst%albsod_col , & ! Output: [real(r8) (:,:) ] soil albedo (direct) - albsoi => surfalb_inst%albsoi_col & ! Output: [real(r8) (:,:) ] soil albedo (diffuse) - ) - - ! Compute soil albedos - - do ib = 1, nband - do fc = 1,num_nourbanc - c = filter_nourbanc(fc) - if (coszen(c) > 0._r8) then - l = col%landunit(c) - - if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then ! soil - inc = max(0.11_r8-0.40_r8*h2osoi_vol(c,1), 0._r8) - soilcol = isoicol(c) - ! changed from local variable to clm_type: - !albsod = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) - !albsoi = albsod - albsod(c,ib) = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) - albsoi(c,ib) = albsod(c,ib) - else if (lun%itype(l) == istice_mec) then ! land ice - ! changed from local variable to clm_type: - !albsod = albice(ib) - !albsoi = albsod - albsod(c,ib) = albice(ib) - albsoi(c,ib) = albsod(c,ib) - ! unfrozen lake, wetland - else if (t_grnd(c) > tfrz .or. (lakepuddling .and. lun%itype(l) == istdlak .and. t_grnd(c) == tfrz .and. & - lake_icefrac(c,1) < 1._r8 .and. lake_icefrac(c,2) > 0._r8) ) then - - albsod(c,ib) = 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8) - ! This expression is apparently from BATS according to Yongjiu Dai. - - ! The diffuse albedo should be an average over the whole sky of an angular-dependent direct expression. - ! The expression above may have been derived to encompass both (e.g. Henderson-Sellers 1986), - ! but I'll assume it applies more appropriately to the direct form for now. - - ! ZMS: Attn EK, currently restoring this for wetlands even though it is wrong in order to try to get - ! bfb baseline comparison when no lakes are present. I'm assuming wetlands will be phased out anyway. - if (lun%itype(l) == istdlak) then - albsoi(c,ib) = 0.10_r8 - else - albsoi(c,ib) = albsod(c,ib) - end if - - else ! frozen lake, wetland - ! Introduce crude surface frozen fraction according to D. Mironov (2010) - ! Attn EK: This formulation is probably just as good for "wetlands" if they are not phased out. - ! Tenatively I'm restricting this to lakes because I haven't tested it for wetlands. But if anything - ! the albedo should be lower when melting over frozen ground than a solid frozen lake. - ! - if (lun%itype(l) == istdlak .and. .not. lakepuddling .and. snl(c) == 0) then - ! Need to reference snow layers here because t_grnd could be over snow or ice - ! but we really want the ice surface temperature with no snow - sicefr = 1._r8 - exp(-calb * (tfrz - t_grnd(c))/tfrz) - albsod(c,ib) = sicefr*alblak(ib) + (1._r8-sicefr)*max(alblakwi(ib), & - 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8)) - albsoi(c,ib) = sicefr*alblak(ib) + (1._r8-sicefr)*max(alblakwi(ib), 0.10_r8) - ! Make sure this is no less than the open water albedo above. - ! Setting lake_melt_icealb(:) = alblak(:) in namelist reverts the melting albedo to the cold - ! snow-free value. - else - albsod(c,ib) = alblak(ib) - albsoi(c,ib) = albsod(c,ib) - end if - end if - - ! Weighting is done in SurfaceAlbedo, after the call to SNICAR_RT - ! This had to be done, because SoilAlbedo is called before SNICAR_RT, so at - ! this point, snow albedo is not yet known. - end if - end do - end do - - end associate - end subroutine SoilAlbedo - - !----------------------------------------------------------------------- - subroutine TwoStream (bounds, & - filter_vegsol, num_vegsol, & - coszen, rho, tau, & - canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst, & - SFonly) - ! - ! !DESCRIPTION: - ! Two-stream fluxes for canopy radiative transfer - ! Use two-stream approximation of Dickinson (1983) Adv Geophysics - ! 25:305-353 and Sellers (1985) Int J Remote Sensing 6:1335-1372 - ! to calculate fluxes absorbed by vegetation, reflected by vegetation, - ! and transmitted through vegetation for unit incoming direct or diffuse - ! flux given an underlying surface with known albedo. - ! Calculate sunlit and shaded fluxes as described by - ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to - ! a multi-layer canopy to calculate APAR profile - ! - ! !USES: - use clm_varpar, only : numrad, nlevcan - use clm_varcon, only : omegas, tfrz, betads, betais - use clm_varctl, only : iulog - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: filter_vegsol (:) ! filter for vegetated patches with coszen>0 - integer , intent(in) :: num_vegsol ! number of vegetated patches where coszen>0 - real(r8), intent(in) :: coszen( bounds%begp: ) ! cosine solar zenith angle for next time step [pft] - real(r8), intent(in) :: rho( bounds%begp: , 1: ) ! leaf/stem refl weighted by fraction LAI and SAI [pft, numrad] - real(r8), intent(in) :: tau( bounds%begp: , 1: ) ! leaf/stem tran weighted by fraction LAI and SAI [pft, numrad] - type(canopystate_type) , intent(in) :: canopystate_inst - type(temperature_type) , intent(in) :: temperature_inst - type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst - type(surfalb_type) , intent(inout) :: surfalb_inst - logical, optional , intent(in) :: SFonly ! If should just calculate the Snow Free albedos - ! - ! !LOCAL VARIABLES: - integer :: fp,p,c,iv ! array indices - integer :: ib ! waveband number - real(r8) :: cosz ! 0.001 <= coszen <= 1.000 - real(r8) :: asu ! single scattering albedo - real(r8) :: chil(bounds%begp:bounds%endp) ! -0.4 <= xl <= 0.6 - real(r8) :: gdir(bounds%begp:bounds%endp) ! leaf projection in solar direction (0 to 1) - real(r8) :: twostext(bounds%begp:bounds%endp)! optical depth of direct beam per unit leaf area - real(r8) :: avmu(bounds%begp:bounds%endp) ! average diffuse optical depth - real(r8) :: omega(bounds%begp:bounds%endp,numrad) ! fraction of intercepted radiation that is scattered (0 to 1) - real(r8) :: omegal ! omega for leaves - real(r8) :: betai ! upscatter parameter for diffuse radiation - real(r8) :: betail ! betai for leaves - real(r8) :: betad ! upscatter parameter for direct beam radiation - real(r8) :: betadl ! betad for leaves - real(r8) :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 ! temporary - real(r8) :: p1,p2,p3,p4,s1,s2,u1,u2,u3 ! temporary - real(r8) :: b,c1,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 ! temporary - real(r8) :: phi1,phi2,sigma ! temporary - real(r8) :: temp1 ! temporary - real(r8) :: temp0 (bounds%begp:bounds%endp) ! temporary - real(r8) :: temp2(bounds%begp:bounds%endp) ! temporary - real(r8) :: t1 ! temporary - real(r8) :: a1,a2 ! parameter for sunlit/shaded leaf radiation absorption - real(r8) :: v,dv,u,du ! temporary for flux derivatives - real(r8) :: dh2,dh3,dh5,dh6,dh7,dh8,dh9,dh10 ! temporary for flux derivatives - real(r8) :: da1,da2 ! temporary for flux derivatives - real(r8) :: d_ftid,d_ftii ! ftid, ftii derivative with respect to lai+sai - real(r8) :: d_fabd,d_fabi ! fabd, fabi derivative with respect to lai+sai - real(r8) :: d_fabd_sun,d_fabd_sha ! fabd_sun, fabd_sha derivative with respect to lai+sai - real(r8) :: d_fabi_sun,d_fabi_sha ! fabi_sun, fabi_sha derivative with respect to lai+sai - real(r8) :: laisum ! cumulative lai+sai for canopy layer (at middle of layer) - real(r8) :: extkb ! direct beam extinction coefficient - real(r8) :: extkn ! nitrogen allocation coefficient - logical :: lSFonly ! Local version of SFonly (Snow Free) flag - !----------------------------------------------------------------------- - - ! Enforce expected array sizes - SHR_ASSERT_ALL_FL((ubound(coszen) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(rho) == (/bounds%endp, numrad/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(tau) == (/bounds%endp, numrad/)), sourcefile, __LINE__) - - if ( present(SFonly) )then - lSFonly = SFonly - else - lSFonly = .false. - end if - - associate(& - xl => pftcon%xl , & ! Input: ecophys const - leaf/stem orientation index - - t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) - - fwet => waterdiagnosticbulk_inst%fwet_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is wet (0 to 1) - fcansno => waterdiagnosticbulk_inst%fcansno_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is snow-covered (0 to 1) - - elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow - esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow - - tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] tlai increment for canopy layer - tsai_z => surfalb_inst%tsai_z_patch , & ! Input: [real(r8) (:,:) ] tsai increment for canopy layer - nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer - albgrd => surfalb_inst%albgrd_col , & ! Input: [real(r8) (:,:) ] ground albedo (direct) (column-level) - albgri => surfalb_inst%albgri_col , & ! Input: [real(r8) (:,:) ] ground albedo (diffuse)(column-level) - - ! For non-Snow Free - fsun_z => surfalb_inst%fsun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer - vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, sunlit leaf vcmax - vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, shaded leaf vcmax - fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer - fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer - fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer - fabi_sha_z => surfalb_inst%fabi_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer - albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) - albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) - fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux - fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux - fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux - fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux - fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux - fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux - ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flx - ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flx - ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flx - - ! Needed for SF Snow free case - albsod => surfalb_inst%albsod_col , & ! Input: [real(r8) (:,:) ] soil albedo (direct) - albsoi => surfalb_inst%albsoi_col , & ! Input: [real(r8) (:,:) ] soil albedo (diffuse) - albdSF => surfalb_inst%albdSF_patch , & ! Output: [real(r8) (:,:) ] Snow Free surface albedo (direct) - albiSF => surfalb_inst%albiSF_patch & ! Output: [real(r8) (:,:) ] Snow Free surface albedo (diffuse) - ) - - ! Calculate two-stream parameters that are independent of waveband: - ! chil, gdir, twostext, avmu, and temp0 and temp2 (used for asu) - - do fp = 1,num_vegsol - p = filter_vegsol(fp) - - ! note that the following limit only acts on cosz values > 0 and less than - ! 0.001, not on values cosz = 0, since these zero have already been filtered - ! out in filter_vegsol - cosz = max(0.001_r8, coszen(p)) - - chil(p) = min( max(xl(patch%itype(p)), -0.4_r8), 0.6_r8 ) - if (abs(chil(p)) <= 0.01_r8) chil(p) = 0.01_r8 - phi1 = 0.5_r8 - 0.633_r8*chil(p) - 0.330_r8*chil(p)*chil(p) - phi2 = 0.877_r8 * (1._r8-2._r8*phi1) - gdir(p) = phi1 + phi2*cosz - twostext(p) = gdir(p)/cosz - avmu(p) = ( 1._r8 - phi1/phi2 * log((phi1+phi2)/phi1) ) / phi2 - ! Restrict this calculation of temp0. We have seen cases where small temp0 - ! can cause unrealistic single scattering albedo (asu) associated with the - ! log calculation in temp2 below, thereby eventually causing a negative soil albedo - ! See bugzilla bug 2431: http://bugs.cgd.ucar.edu/show_bug.cgi?id=2431 - temp0(p) = max(gdir(p) + phi2*cosz,1.e-6_r8) - temp1 = phi1*cosz - temp2(p) = ( 1._r8 - temp1/temp0(p) * log((temp1+temp0(p))/temp1) ) - end do - - ! Loop over all wavebands to calculate for the full canopy the scattered fluxes - ! reflected upward and transmitted downward by the canopy and the flux absorbed by the - ! canopy for a unit incoming direct beam and diffuse flux at the top of the canopy given - ! an underlying surface of known albedo. - ! - ! Output: - ! ------------------ - ! Direct beam fluxes - ! ------------------ - ! albd - Upward scattered flux above canopy (per unit direct beam flux) - ! ftid - Downward scattered flux below canopy (per unit direct beam flux) - ! ftdd - Transmitted direct beam flux below canopy (per unit direct beam flux) - ! fabd - Flux absorbed by canopy (per unit direct beam flux) - ! fabd_sun - Sunlit portion of fabd - ! fabd_sha - Shaded portion of fabd - ! fabd_sun_z - absorbed sunlit leaf direct PAR (per unit sunlit lai+sai) for each canopy layer - ! fabd_sha_z - absorbed shaded leaf direct PAR (per unit shaded lai+sai) for each canopy layer - ! ------------------ - ! Diffuse fluxes - ! ------------------ - ! albi - Upward scattered flux above canopy (per unit diffuse flux) - ! ftii - Downward scattered flux below canopy (per unit diffuse flux) - ! fabi - Flux absorbed by canopy (per unit diffuse flux) - ! fabi_sun - Sunlit portion of fabi - ! fabi_sha - Shaded portion of fabi - ! fabi_sun_z - absorbed sunlit leaf diffuse PAR (per unit sunlit lai+sai) for each canopy layer - ! fabi_sha_z - absorbed shaded leaf diffuse PAR (per unit shaded lai+sai) for each canopy layer - - do ib = 1, numrad - do fp = 1,num_vegsol - p = filter_vegsol(fp) - c = patch%column(p) - - ! Calculate two-stream parameters omega, betad, and betai. - ! Omega, betad, betai are adjusted for snow. Values for omega*betad - ! and omega*betai are calculated and then divided by the new omega - ! because the product omega*betai, omega*betad is used in solution. - ! Also, the transmittances and reflectances (tau, rho) are linear - ! weights of leaf and stem values. - - omegal = rho(p,ib) + tau(p,ib) - asu = 0.5_r8*omegal*gdir(p)/temp0(p) *temp2(p) - betadl = (1._r8+avmu(p)*twostext(p))/(omegal*avmu(p)*twostext(p))*asu - betail = 0.5_r8 * ((rho(p,ib)+tau(p,ib)) + (rho(p,ib)-tau(p,ib)) & - * ((1._r8+chil(p))/2._r8)**2) / omegal - - if ( lSFonly .or. ( (.not. snowveg_affects_radiation) .and. (t_veg(p) > tfrz) ) ) then - ! Keep omega, betad, and betai as they are (for Snow free case or - ! when there is no snow - tmp0 = omegal - tmp1 = betadl - tmp2 = betail - else - ! Adjust omega, betad, and betai for intercepted snow - if (snowveg_affects_radiation) then - tmp0 = (1._r8-fcansno(p))*omegal + fcansno(p)*omegas(ib) - tmp1 = ( (1._r8-fcansno(p))*omegal*betadl + fcansno(p)*omegas(ib)*betads ) / tmp0 - tmp2 = ( (1._r8-fcansno(p))*omegal*betail + fcansno(p)*omegas(ib)*betais ) / tmp0 - else - tmp0 = (1._r8-fwet(p))*omegal + fwet(p)*omegas(ib) - tmp1 = ( (1._r8-fwet(p))*omegal*betadl + fwet(p)*omegas(ib)*betads ) / tmp0 - tmp2 = ( (1._r8-fwet(p))*omegal*betail + fwet(p)*omegas(ib)*betais ) / tmp0 - end if - end if ! end Snow free - - omega(p,ib) = tmp0 - betad = tmp1 - betai = tmp2 - - ! Common terms - - b = 1._r8 - omega(p,ib) + omega(p,ib)*betai - c1 = omega(p,ib)*betai - tmp0 = avmu(p)*twostext(p) - d = tmp0 * omega(p,ib)*betad - f = tmp0 * omega(p,ib)*(1._r8-betad) - tmp1 = b*b - c1*c1 - h = sqrt(tmp1) / avmu(p) - sigma = tmp0*tmp0 - tmp1 - p1 = b + avmu(p)*h - p2 = b - avmu(p)*h - p3 = b + tmp0 - p4 = b - tmp0 - - ! Absorbed, reflected, transmitted fluxes per unit incoming radiation - ! for full canopy - - t1 = min(h*(elai(p)+esai(p)), 40._r8) - s1 = exp(-t1) - t1 = min(twostext(p)*(elai(p)+esai(p)), 40._r8) - s2 = exp(-t1) - - ! Direct beam - if ( .not. lSFonly )then - u1 = b - c1/albgrd(c,ib) - u2 = b - c1*albgrd(c,ib) - u3 = f + c1*albgrd(c,ib) - else - ! Snow Free (SF) only - ! albsod instead of albgrd here: - u1 = b - c1/albsod(c,ib) - u2 = b - c1*albsod(c,ib) - u3 = f + c1*albsod(c,ib) - end if - tmp2 = u1 - avmu(p)*h - tmp3 = u1 + avmu(p)*h - d1 = p1*tmp2/s1 - p2*tmp3*s1 - tmp4 = u2 + avmu(p)*h - tmp5 = u2 - avmu(p)*h - d2 = tmp4/s1 - tmp5*s1 - h1 = -d*p4 - c1*f - tmp6 = d - h1*p3/sigma - tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2 - h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1 - h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1 - h4 = -f*p3 - c1*d - tmp8 = h4/sigma - tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2 - h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2 - h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2 - if ( .not. lSFonly )then - albd(p,ib) = h1/sigma + h2 + h3 - ftid(p,ib) = h4*s2/sigma + h5*s1 + h6/s1 - ftdd(p,ib) = s2 - fabd(p,ib) = 1._r8 - albd(p,ib) - (1._r8-albgrd(c,ib))*ftdd(p,ib) - (1._r8-albgri(c,ib))*ftid(p,ib) - else - albdSF(p,ib) = h1/sigma + h2 + h3 - end if - - - a1 = h1 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & - + h2 * (1._r8 - s2*s1) / (twostext(p) + h) & - + h3 * (1._r8 - s2/s1) / (twostext(p) - h) - - a2 = h4 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & - + h5 * (1._r8 - s2*s1) / (twostext(p) + h) & - + h6 * (1._r8 - s2/s1) / (twostext(p) - h) - if ( .not. lSFonly )then - fabd_sun(p,ib) = (1._r8 - omega(p,ib)) * ( 1._r8 - s2 + 1._r8 / avmu(p) * (a1 + a2) ) - fabd_sha(p,ib) = fabd(p,ib) - fabd_sun(p,ib) - end if - - ! Diffuse - if ( .not. lSFonly )then - u1 = b - c1/albgri(c,ib) - u2 = b - c1*albgri(c,ib) - else - ! Snow Free (SF) only - ! albsoi instead of albgri here: - u1 = b - c1/albsoi(c,ib) - u2 = b - c1*albsoi(c,ib) - end if - tmp2 = u1 - avmu(p)*h - tmp3 = u1 + avmu(p)*h - d1 = p1*tmp2/s1 - p2*tmp3*s1 - tmp4 = u2 + avmu(p)*h - tmp5 = u2 - avmu(p)*h - d2 = tmp4/s1 - tmp5*s1 - h7 = (c1*tmp2) / (d1*s1) - h8 = (-c1*tmp3*s1) / d1 - h9 = tmp4 / (d2*s1) - h10 = (-tmp5*s1) / d2 - - - ! Final Snow Free albedo - if ( lSFonly )then - albiSF(p,ib) = h7 + h8 - else - ! For non snow Free case, adjustments continue - albi(p,ib) = h7 + h8 - ftii(p,ib) = h9*s1 + h10/s1 - fabi(p,ib) = 1._r8 - albi(p,ib) - (1._r8-albgri(c,ib))*ftii(p,ib) - - a1 = h7 * (1._r8 - s2*s1) / (twostext(p) + h) + h8 * (1._r8 - s2/s1) / (twostext(p) - h) - a2 = h9 * (1._r8 - s2*s1) / (twostext(p) + h) + h10 * (1._r8 - s2/s1) / (twostext(p) - h) - - fabi_sun(p,ib) = (1._r8 - omega(p,ib)) / avmu(p) * (a1 + a2) - fabi_sha(p,ib) = fabi(p,ib) - fabi_sun(p,ib) - - ! Repeat two-stream calculations for each canopy layer to calculate derivatives. - ! tlai_z and tsai_z are the leaf+stem area increment for a layer. Derivatives are - ! calculated at the center of the layer. Derivatives are needed only for the - ! visible waveband to calculate absorbed PAR (per unit lai+sai) for each canopy layer. - ! Derivatives are calculated first per unit lai+sai and then normalized for sunlit - ! or shaded fraction of canopy layer. - - ! Sun/shade big leaf code uses only one layer, with canopy integrated values from above - ! and also canopy-integrated scaling coefficients - - if (ib == 1) then - if (nlevcan == 1) then - - ! sunlit fraction of canopy - fsun_z(p,1) = (1._r8 - s2) / t1 - - ! absorbed PAR (per unit sun/shade lai+sai) - laisum = elai(p)+esai(p) - fabd_sun_z(p,1) = fabd_sun(p,ib) / (fsun_z(p,1)*laisum) - fabi_sun_z(p,1) = fabi_sun(p,ib) / (fsun_z(p,1)*laisum) - fabd_sha_z(p,1) = fabd_sha(p,ib) / ((1._r8 - fsun_z(p,1))*laisum) - fabi_sha_z(p,1) = fabi_sha(p,ib) / ((1._r8 - fsun_z(p,1))*laisum) - - ! leaf to canopy scaling coefficients - extkn = 0.30_r8 - extkb = twostext(p) - vcmaxcintsun(p) = (1._r8 - exp(-(extkn+extkb)*elai(p))) / (extkn + extkb) - vcmaxcintsha(p) = (1._r8 - exp(-extkn*elai(p))) / extkn - vcmaxcintsun(p) - if (elai(p) > 0._r8) then - vcmaxcintsun(p) = vcmaxcintsun(p) / (fsun_z(p,1)*elai(p)) - vcmaxcintsha(p) = vcmaxcintsha(p) / ((1._r8 - fsun_z(p,1))*elai(p)) - else - vcmaxcintsun(p) = 0._r8 - vcmaxcintsha(p) = 0._r8 - end if - - else if (nlevcan > 1)then - do iv = 1, nrad(p) - - ! Cumulative lai+sai at center of layer - - if (iv == 1) then - laisum = 0.5_r8 * (tlai_z(p,iv)+tsai_z(p,iv)) - else - laisum = laisum + 0.5_r8 * ((tlai_z(p,iv-1)+tsai_z(p,iv-1))+(tlai_z(p,iv)+tsai_z(p,iv))) - end if - - ! Coefficients s1 and s2 depend on cumulative lai+sai. s2 is the sunlit fraction - - t1 = min(h*laisum, 40._r8) - s1 = exp(-t1) - t1 = min(twostext(p)*laisum, 40._r8) - s2 = exp(-t1) - fsun_z(p,iv) = s2 - - ! =============== - ! Direct beam - ! =============== - - ! Coefficients h1-h6 and a1,a2 depend of cumulative lai+sai - - u1 = b - c1/albgrd(c,ib) - u2 = b - c1*albgrd(c,ib) - u3 = f + c1*albgrd(c,ib) - - ! Derivatives for h2, h3, h5, h6 and a1, a2 - - v = d1 - dv = h * p1 * tmp2 / s1 + h * p2 * tmp3 * s1 - - u = tmp6 * tmp2 / s1 - p2 * tmp7 - du = h * tmp6 * tmp2 / s1 + twostext(p) * p2 * tmp7 - dh2 = (v * du - u * dv) / (v * v) - - u = -tmp6 * tmp3 * s1 + p1 * tmp7 - du = h * tmp6 * tmp3 * s1 - twostext(p) * p1 * tmp7 - dh3 = (v * du - u * dv) / (v * v) - - v = d2 - dv = h * tmp4 / s1 + h * tmp5 * s1 - - u = -h4/sigma * tmp4 / s1 - tmp9 - du = -h * h4/sigma * tmp4 / s1 + twostext(p) * tmp9 - dh5 = (v * du - u * dv) / (v * v) - - u = h4/sigma * tmp5 * s1 + tmp9 - du = -h * h4/sigma * tmp5 * s1 - twostext(p) * tmp9 - dh6 = (v * du - u * dv) / (v * v) - - da1 = h1/sigma * s2*s2 + h2 * s2*s1 + h3 * s2/s1 & - + (1._r8 - s2*s1) / (twostext(p) + h) * dh2 & - + (1._r8 - s2/s1) / (twostext(p) - h) * dh3 - da2 = h4/sigma * s2*s2 + h5 * s2*s1 + h6 * s2/s1 & - + (1._r8 - s2*s1) / (twostext(p) + h) * dh5 & - + (1._r8 - s2/s1) / (twostext(p) - h) * dh6 - - ! Flux derivatives - - d_ftid = -twostext(p)*h4/sigma*s2 - h*h5*s1 + h*h6/s1 + dh5*s1 + dh6/s1 - d_fabd = -(dh2+dh3) + (1._r8-albgrd(c,ib))*twostext(p)*s2 - (1._r8-albgri(c,ib))*d_ftid - d_fabd_sun = (1._r8 - omega(p,ib)) * (twostext(p)*s2 + 1._r8 / avmu(p) * (da1 + da2)) - d_fabd_sha = d_fabd - d_fabd_sun - - fabd_sun_z(p,iv) = max(d_fabd_sun, 0._r8) - fabd_sha_z(p,iv) = max(d_fabd_sha, 0._r8) - - ! Flux derivatives are APARsun and APARsha per unit (LAI+SAI). Need - ! to normalize derivatives by sunlit or shaded fraction to get - ! APARsun per unit (LAI+SAI)sun and APARsha per unit (LAI+SAI)sha - - fabd_sun_z(p,iv) = fabd_sun_z(p,iv) / fsun_z(p,iv) - fabd_sha_z(p,iv) = fabd_sha_z(p,iv) / (1._r8 - fsun_z(p,iv)) - - ! =============== - ! Diffuse - ! =============== - - ! Coefficients h7-h10 and a1,a2 depend of cumulative lai+sai - - u1 = b - c1/albgri(c,ib) - u2 = b - c1*albgri(c,ib) - - a1 = h7 * (1._r8 - s2*s1) / (twostext(p) + h) + h8 * (1._r8 - s2/s1) / (twostext(p) - h) - a2 = h9 * (1._r8 - s2*s1) / (twostext(p) + h) + h10 * (1._r8 - s2/s1) / (twostext(p) - h) - - ! Derivatives for h7, h8, h9, h10 and a1, a2 - - v = d1 - dv = h * p1 * tmp2 / s1 + h * p2 * tmp3 * s1 - - u = c1 * tmp2 / s1 - du = h * c1 * tmp2 / s1 - dh7 = (v * du - u * dv) / (v * v) - - u = -c1 * tmp3 * s1 - du = h * c1 * tmp3 * s1 - dh8 = (v * du - u * dv) / (v * v) - - v = d2 - dv = h * tmp4 / s1 + h * tmp5 * s1 - - u = tmp4 / s1 - du = h * tmp4 / s1 - dh9 = (v * du - u * dv) / (v * v) - - u = -tmp5 * s1 - du = h * tmp5 * s1 - dh10 = (v * du - u * dv) / (v * v) - - da1 = h7*s2*s1 + h8*s2/s1 + (1._r8-s2*s1)/(twostext(p)+h)*dh7 + (1._r8-s2/s1)/(twostext(p)-h)*dh8 - da2 = h9*s2*s1 + h10*s2/s1 + (1._r8-s2*s1)/(twostext(p)+h)*dh9 + (1._r8-s2/s1)/(twostext(p)-h)*dh10 - - ! Flux derivatives - - d_ftii = -h * h9 * s1 + h * h10 / s1 + dh9 * s1 + dh10 / s1 - d_fabi = -(dh7+dh8) - (1._r8-albgri(c,ib))*d_ftii - d_fabi_sun = (1._r8 - omega(p,ib)) / avmu(p) * (da1 + da2) - d_fabi_sha = d_fabi - d_fabi_sun - - fabi_sun_z(p,iv) = max(d_fabi_sun, 0._r8) - fabi_sha_z(p,iv) = max(d_fabi_sha, 0._r8) - - ! Flux derivatives are APARsun and APARsha per unit (LAI+SAI). Need - ! to normalize derivatives by sunlit or shaded fraction to get - ! APARsun per unit (LAI+SAI)sun and APARsha per unit (LAI+SAI)sha - - fabi_sun_z(p,iv) = fabi_sun_z(p,iv) / fsun_z(p,iv) - fabi_sha_z(p,iv) = fabi_sha_z(p,iv) / (1._r8 - fsun_z(p,iv)) - - end do ! end of iv loop - end if ! nlevcan - end if ! first band - end if ! NOT lSFonly - - end do ! end of pft loop - end do ! end of radiation band loop - - end associate - -end subroutine TwoStream - -end module SurfaceAlbedoMod From 138ca8ecef668d8aa1de6adefca0a9f8226d8d75 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 10:44:11 -0500 Subject: [PATCH 194/589] add PFT lower bound index --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index 34cdf7957..d3f6746cc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -37,8 +37,9 @@ module clm_varpar integer, parameter :: numpft = 15!19 ! actual # of pfts (without bare), 16 here, since we are removing the split types integer, parameter :: mxpft = 15 ! - integer, public :: maxveg ! # of pfts + cfts + integer, public :: maxveg ! # of pfts + cfts integer, public :: maxsoil_patches = numpft + 1 ! # of pfts + cfts + bare ground; replaces maxpatch_pft, which is obsolete + integer, public :: natpft_lb = 0 ! In PATCH arrays, lower bound of Patches on the natural veg landunit (i.e., bare ground index) integer, public, parameter :: nvariants = 2 ! number of variants of PFT constants From bb26b78b3443712613b73001ef440e1324a60bc8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 11:10:41 -0500 Subject: [PATCH 195/589] add MAPL_Generic include statements --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 | 2 ++ .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 2 ++ .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 1 + 3 files changed, 5 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index a6d53960e..e7ef586e9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -1,3 +1,5 @@ +#include "MAPL_Generic.h" + module CNProductsMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 99a4b2fcd..ee76da016 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1,3 +1,5 @@ +#include "MAPL_Generic.h" + module CNVegCarbonFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index d4a2c2742..24cb9f593 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -1,5 +1,6 @@ module PhotosynthesisMod +#include "MAPL_Generic.h" #include "shr_assert.h" !------------------------------------------------------------------------------ From ca31cd7b668503f6fa4242dbac57328fe53d1e3a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 12:04:49 -0500 Subject: [PATCH 196/589] add missing variables and functions --- .../CLM51/AnnualFluxDribbler.F90 | 90 +++++++++---------- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 11 ++- .../CLM51/clm_varctl.F90 | 2 + 3 files changed, 55 insertions(+), 48 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 index eaa909475..d5edc66ee 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -109,7 +109,7 @@ module AnnualFluxDribbler ! Public science methods ! procedure, public :: set_curr_delta ! Set the delta state for this time step - ! procedure, public :: get_curr_flux ! Get the current flux for this time step + procedure, public :: get_curr_flux ! Get the current flux for this time step ! procedure, public :: get_dribbled_delta ! Similar to get_curr_flux, but gets result as a delta rather than a per-second flux ! procedure, public :: get_amount_left_to_dribble_beg ! Get the pseudo-state representing the amount that still needs to be dribbled in this and future time steps ! procedure, public :: get_amount_left_to_dribble_end ! Get the pseudo-state representing the amount that still needs to be dribbled in just future time steps @@ -285,50 +285,50 @@ end function annual_flux_dribbler_patch ! end subroutine set_curr_delta ! ! !----------------------------------------------------------------------- -! subroutine get_curr_flux(this, bounds, flux) -! ! -! ! !DESCRIPTION: -! ! Gets the current flux for this timestep, and stores it in the flux argument. -! ! -! ! This should be called AFTER set_curr_delta is called for the given timestep. -! ! -! ! This will get the current flux for this timestep, which is the sum of (1) the -! ! dribbled flux from the last start-of-year timestep, and (2) the current timestep's -! ! flux, based on the delta passed in to set_curr_delta in this timestep, if this is -! ! not the start-of-year timestep. -! ! -! ! !USES: -! ! -! ! !ARGUMENTS: -! class(annual_flux_dribbler_type), intent(in) :: this -! type(bounds_type), intent(in) :: bounds -! real(r8), intent(out) :: flux( get_beg(bounds, this%bounds_subgrid_level) : ) -! ! -! ! !LOCAL VARIABLES: -! integer :: beg_index, end_index -! integer :: i -! real(r8) :: secs_per_year -! real(r8) :: dtime -! real(r8) :: flux_from_dribbling -! real(r8) :: flux_from_this_timestep -! -! character(len=*), parameter :: subname = 'get_curr_flux' -! !----------------------------------------------------------------------- -! -! beg_index = lbound(flux, 1) -! end_index = get_end(bounds, this%bounds_subgrid_level) -! SHR_ASSERT_ALL_FL((ubound(flux) == (/end_index/)), sourcefile, __LINE__) -! -! secs_per_year = get_days_per_year() * secspday -! dtime = get_step_size_real() -! -! do i = beg_index, end_index -! flux_from_dribbling = this%amount_to_dribble(i) / secs_per_year -! flux_from_this_timestep = this%amount_from_this_timestep(i) / dtime -! flux(i) = flux_from_dribbling + flux_from_this_timestep -! end do -! -! end subroutine get_curr_flux + subroutine get_curr_flux(this, bounds, flux) + ! + ! !DESCRIPTION: + ! Gets the current flux for this timestep, and stores it in the flux argument. + ! + ! This should be called AFTER set_curr_delta is called for the given timestep. + ! + ! This will get the current flux for this timestep, which is the sum of (1) the + ! dribbled flux from the last start-of-year timestep, and (2) the current timestep's + ! flux, based on the delta passed in to set_curr_delta in this timestep, if this is + ! not the start-of-year timestep. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(out) :: flux( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + integer :: beg_index, end_index + integer :: i + real(r8) :: secs_per_year + real(r8) :: dtime + real(r8) :: flux_from_dribbling + real(r8) :: flux_from_this_timestep + + character(len=*), parameter :: subname = 'get_curr_flux' + !----------------------------------------------------------------------- + + beg_index = lbound(flux, 1) + end_index = get_end(bounds, this%bounds_subgrid_level) + SHR_ASSERT_ALL_FL((ubound(flux) == (/end_index/)), sourcefile, __LINE__) + + secs_per_year = get_days_per_year() * secspday + dtime = get_step_size_real() + + do i = beg_index, end_index + flux_from_dribbling = this%amount_to_dribble(i) / secs_per_year + flux_from_this_timestep = this%amount_from_this_timestep(i) / dtime + flux(i) = flux_from_dribbling + flux_from_this_timestep + end do + + end subroutine get_curr_flux ! ! !----------------------------------------------------------------------- ! subroutine get_dribbled_delta(this, bounds, delta) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index ee76da016..6e32cdb55 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -17,7 +17,11 @@ module CNVegCarbonFluxType igrain,igrain_st,igrain_xf,ioutc use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight + use clm_varctl , only : use_crop, use_matrixcn, use_cndv, use_grainproduct + use clm_varcon , only : dzsoi_decomp + use pftconMod , only : npcropmin use clm_varcon , only : spval + use ColumnType , only : col use PatchType , only : patch use AnnualFluxDribbler , only : annual_flux_dribbler_type, annual_flux_dribbler_gridcell @@ -479,7 +483,7 @@ module CNVegCarbonFluxType contains !--------------------------------------- - subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start) + subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start, rc) ! !DESCRIPTION: ! Initialize CTSM carbon fluxes @@ -498,6 +502,7 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart logical, optional, intent(in) :: cn5_cold_start type(cnveg_carbonflux_type), intent(inout):: this + integer, optional, intent(out) :: rc ! LOCAL integer :: begp, endp @@ -513,8 +518,8 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. + (size(cnpft,3).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index af09f43cc..d34194284 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -83,6 +83,8 @@ module clm_varctl integer, public :: spinup_state = 0 logical, public :: use_snicar_frc = .false. + + integer, public :: carbon_resp_opt = 0 contains !--------------------------------------- From 96d6b37629cf5d03ecc657666c6e05670b6cd6ed Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 12:42:35 -0500 Subject: [PATCH 197/589] add missing functions and variables --- .../CLM51/CNCLM_CNProductsMod.F90 | 6 +- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 3 +- .../CLM51/subgridAveMod.F90 | 468 +++++++++--------- 3 files changed, 241 insertions(+), 236 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index e7ef586e9..039f19822 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -1,4 +1,5 @@ #include "MAPL_Generic.h" +#include "shr_assert.h" module CNProductsMod @@ -7,6 +8,8 @@ module CNProductsMod use nanMod , only : nan use decompMod , only : bounds_type use clm_varpar , only : num_zon, var_col, cn_zone_weight + use clm_time_manager , only : get_step_size_real + use PatchType , only : patch ! !PUBLIC TYPES: implicit none @@ -70,7 +73,7 @@ module CNProductsMod contains !-------------------------------------------------------------- - subroutine init_cn_products_type(bounds, nch, cncol, species, this) + subroutine init_cn_products_type(bounds, nch, cncol, species, this, rc) ! !DESCRIPTION: ! Initialize CTSM wood products type needed for calling CTSM routines @@ -85,6 +88,7 @@ subroutine init_cn_products_type(bounds, nch, cncol, species, this) real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array character(*), intent(in) :: species ! C or N type(cn_products_type), intent(inout):: this + integer, optional, intent(out) :: rc ! LOCAL integer :: begp, endp diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 6e32cdb55..ef4227e37 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1,4 +1,5 @@ #include "MAPL_Generic.h" +#include "shr_assert.h" module CNVegCarbonFluxType @@ -518,7 +519,7 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. + if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & (size(cnpft,3).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 index 976a51208..4e46d6b00 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 @@ -28,7 +28,7 @@ module subgridAveMod ! !PUBLIC MEMBER FUNCTIONS: public :: p2c ! Perform an average patches to columns ! public :: p2l ! Perform an average patches to landunits - ! public :: p2g ! Perform an average patches to gridcells + public :: p2g ! Perform an average patches to gridcells ! public :: c2l ! Perform an average columns to landunits public :: c2g ! Perform an average columns to gridcells ! public :: l2g ! Perform an average landunits to gridcells @@ -43,10 +43,10 @@ module subgridAveMod ! module procedure p2l_1d ! module procedure p2l_2d ! end interface -! interface p2g -! module procedure p2g_1d -! module procedure p2g_2d -! end interface + interface p2g + module procedure p2g_1d + module procedure p2g_2d + end interface ! interface c2l ! module procedure c2l_1d ! module procedure c2l_2d @@ -503,235 +503,235 @@ end subroutine p2c_2d_filter ! end subroutine p2l_2d ! ! !----------------------------------------------------------------------- -! subroutine p2g_1d(bounds, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) -! ! -! ! !DESCRIPTION: -! ! Perfrom subgrid-average from patches to gridcells. -! ! Averaging is only done for points that are not equal to "spval". -! ! -! ! !ARGUMENTS: -! type(bounds_type), intent(in) :: bounds -! real(r8), intent(in) :: parr( bounds%begp: ) ! input patch array -! real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array -! character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging -! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) -! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging -! ! -! ! !LOCAL VARIABLES: -! integer :: p,c,l,g,index ! indices -! logical :: found ! temporary for error check -! real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor -! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor -! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor -! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights -! !------------------------------------------------------------------------ -! -! ! Enforce expected array sizes -! SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp/)), sourcefile, __LINE__) -! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg/)), sourcefile, __LINE__) -! -! call build_scale_l2g(bounds, l2g_scale_type, & -! scale_l2g(bounds%begl:bounds%endl)) -! -! if (c2l_scale_type == 'unity') then -! do c = bounds%begc,bounds%endc -! scale_c2l(c) = 1.0_r8 -! end do -! else if (c2l_scale_type == 'urbanf') then -! do c = bounds%begc,bounds%endc -! l = col%landunit(c) -! if (lun%urbpoi(l)) then -! if (col%itype(c) == icol_sunwall) then -! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) -! else if (col%itype(c) == icol_shadewall) then -! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) -! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then -! scale_c2l(c) = 3.0_r8 -! else if (col%itype(c) == icol_roof) then -! scale_c2l(c) = 1.0_r8 -! end if -! else -! scale_c2l(c) = 1.0_r8 -! end if -! end do -! else if (c2l_scale_type == 'urbans') then -! do c = bounds%begc,bounds%endc -! l = col%landunit(c) -! if (lun%urbpoi(l)) then -! if (col%itype(c) == icol_sunwall) then -! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_shadewall) then -! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then -! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_roof) then -! scale_c2l(c) = 1.0_r8 -! end if -! else -! scale_c2l(c) = 1.0_r8 -! end if -! end do -! else -! write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if -! -! if (p2c_scale_type == 'unity') then -! do p = bounds%begp,bounds%endp -! scale_p2c(p) = 1.0_r8 -! end do -! else -! write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if -! -! garr(bounds%begg : bounds%endg) = spval -! sumwt(bounds%begg : bounds%endg) = 0._r8 -! do p = bounds%begp,bounds%endp -! if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then -! c = patch%column(p) -! l = patch%landunit(p) -! if (parr(p) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then -! g = patch%gridcell(p) -! if (sumwt(g) == 0._r8) garr(g) = 0._r8 -! garr(g) = garr(g) + parr(p) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p) -! sumwt(g) = sumwt(g) + patch%wtgcell(p) -! end if -! end if -! end do -! found = .false. -! do g = bounds%begg, bounds%endg -! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then -! found = .true. -! index = g -! else if (sumwt(g) /= 0._r8) then -! garr(g) = garr(g)/sumwt(g) -! end if -! end do -! if (found) then -! write(iulog,*)'p2g_1d error: sumwt is greater than 1.0 at g= ',index -! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) -! end if -! -! end subroutine p2g_1d -! -! !----------------------------------------------------------------------- -! subroutine p2g_2d(bounds, num2d, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) -! ! -! ! !DESCRIPTION: -! ! Perfrom subgrid-average from patches to gridcells. -! ! Averaging is only done for points that are not equal to "spval". -! ! -! ! !USES: -! ! -! ! !ARGUMENTS: -! type(bounds_type), intent(in) :: bounds -! integer , intent(in) :: num2d ! size of second dimension -! real(r8), intent(in) :: parr( bounds%begp: , 1: ) ! input patch array -! real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array -! character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging -! character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) -! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging -! ! -! ! !LOCAL VARIABLES: -! integer :: j,p,c,l,g,index ! indices -! logical :: found ! temporary for error check -! real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor -! real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor -! real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor -! real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights -! !------------------------------------------------------------------------ -! -! ! Enforce expected array sizes -! SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp, num2d/)), sourcefile, __LINE__) -! SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg, num2d/)), sourcefile, __LINE__) -! -! call build_scale_l2g(bounds, l2g_scale_type, & -! scale_l2g(bounds%begl:bounds%endl)) -! -! if (c2l_scale_type == 'unity') then -! do c = bounds%begc,bounds%endc -! scale_c2l(c) = 1.0_r8 -! end do -! else if (c2l_scale_type == 'urbanf') then -! do c = bounds%begc,bounds%endc -! l = col%landunit(c) -! if (lun%urbpoi(l)) then -! if (col%itype(c) == icol_sunwall) then -! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) -! else if (col%itype(c) == icol_shadewall) then -! scale_c2l(c) = 3.0 * lun%canyon_hwr(l) -! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then -! scale_c2l(c) = 3.0_r8 -! else if (col%itype(c) == icol_roof) then -! scale_c2l(c) = 1.0_r8 -! end if -! else -! scale_c2l(c) = 1.0_r8 -! end if -! end do -! else if (c2l_scale_type == 'urbans') then -! do c = bounds%begc,bounds%endc -! l = col%landunit(c) -! if (lun%urbpoi(l)) then -! if (col%itype(c) == icol_sunwall) then -! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_shadewall) then -! scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then -! scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) -! else if (col%itype(c) == icol_roof) then -! scale_c2l(c) = 1.0_r8 -! end if -! else -! scale_c2l(c) = 1.0_r8 -! end if -! end do -! else -! write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if -! -! if (p2c_scale_type == 'unity') then -! do p = bounds%begp,bounds%endp -! scale_p2c(p) = 1.0_r8 -! end do -! else -! write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if -! -! garr(bounds%begg : bounds%endg, :) = spval -! do j = 1,num2d -! sumwt(bounds%begg : bounds%endg) = 0._r8 -! do p = bounds%begp,bounds%endp -! if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then -! c = patch%column(p) -! l = patch%landunit(p) -! if (parr(p,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then -! g = patch%gridcell(p) -! if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 -! garr(g,j) = garr(g,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p) -! sumwt(g) = sumwt(g) + patch%wtgcell(p) -! end if -! end if -! end do -! found = .false. -! do g = bounds%begg, bounds%endg -! if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then -! found = .true. -! index = g -! else if (sumwt(g) /= 0._r8) then -! garr(g,j) = garr(g,j)/sumwt(g) -! end if -! end do -! if (found) then -! write(iulog,*)'p2g_2d error: sumwt gt 1.0 at g/sumwt = ',index,sumwt(index) -! call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) -! end if -! end do -! -! end subroutine p2g_2d + subroutine p2g_1d(bounds, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from patches to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: parr( bounds%begp: ) ! input patch array + real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: p,c,l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg/)), sourcefile, __LINE__) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + garr(bounds%begg : bounds%endg) = spval + sumwt(bounds%begg : bounds%endg) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then + c = patch%column(p) + l = patch%landunit(p) + if (parr(p) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = patch%gridcell(p) + if (sumwt(g) == 0._r8) garr(g) = 0._r8 + garr(g) = garr(g) + parr(p) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p) + sumwt(g) = sumwt(g) + patch%wtgcell(p) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g) = garr(g)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'p2g_1d error: sumwt is greater than 1.0 at g= ',index + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) + end if + + end subroutine p2g_1d + + !----------------------------------------------------------------------- + subroutine p2g_2d(bounds, num2d, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from patches to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: parr( bounds%begp: , 1: ) ! input patch array + real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module) + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: j,p,c,l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(parr) == (/bounds%endp, num2d/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(garr) == (/bounds%endg, num2d/)), sourcefile, __LINE__) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + garr(bounds%begg : bounds%endg, :) = spval + do j = 1,num2d + sumwt(bounds%begg : bounds%endg) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then + c = patch%column(p) + l = patch%landunit(p) + if (parr(p,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = patch%gridcell(p) + if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 + garr(g,j) = garr(g,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p) + sumwt(g) = sumwt(g) + patch%wtgcell(p) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g,j) = garr(g,j)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'p2g_2d error: sumwt gt 1.0 at g/sumwt = ',index,sumwt(index) + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__)) + end if + end do + + end subroutine p2g_2d ! ! !----------------------------------------------------------------------- ! subroutine c2l_1d (bounds, carr, larr, c2l_scale_type, include_inactive) From f9f749b59d4592d29d95dd1e2610010512ed15a0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 14:40:15 -0500 Subject: [PATCH 198/589] cleanup --- .../CLM51/CNCLM_CNProductsMod.F90 | 4 +- .../CLM51/PhotosynthesisMod.F90 | 231 +++++++++--------- .../CLM51/clm_time_manager.F90 | 33 ++- .../CLM51/clm_varctl.F90 | 11 +- 4 files changed, 160 insertions(+), 119 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index 039f19822..8aec7a687 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -1,8 +1,8 @@ +module CNProductsMod + #include "MAPL_Generic.h" #include "shr_assert.h" -module CNProductsMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use MAPL_ExceptionHandling use nanMod , only : nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 24cb9f593..9ca3446cb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -10,10 +10,9 @@ module PhotosynthesisMod ! a multi-layer canopy ! ! !USES: - use shr_sys_mod , only : shr_sys_flush use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg - use shr_infnan_mod , only : nan => shr_infnan_nan + use nanMod , only : nan use abortutils , only : endrun use clm_varctl , only : use_c13, use_c14, use_cn, use_cndv, use_fates, use_luna, use_hydrstress use clm_varctl , only : iulog @@ -21,7 +20,7 @@ module PhotosynthesisMod use clm_varcon , only : namep, spval, isecspday use decompMod , only : bounds_type use QuadraticMod , only : quadratic - use CNCLM_pftconMod , only : pftcon + use pftconMod , only : pftcon use atm2lndType , only : atm2lnd_type use CanopyStateType , only : canopystate_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type @@ -34,6 +33,7 @@ module PhotosynthesisMod use LandunitType , only : lun use PatchType , only : patch use GridcellType , only : grc + use MAPL_ExceptionHandling ! implicit none private @@ -229,7 +229,7 @@ module PhotosynthesisMod contains !------------------------------------------------------------------------ - subroutine Init(bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,this) + subroutine Init(this,bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,rc) ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds @@ -240,6 +240,7 @@ subroutine Init(bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,this) real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array logical, optional, intent(in) :: cn5_cold_start class(photosyns_type) :: this + integer, optional, intent(out) :: rc ! ! !LOCAL VARIABLES: @@ -259,7 +260,7 @@ subroutine Init(bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,this) ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) + (size(cnpft,3).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if @@ -377,7 +378,7 @@ subroutine Init(bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,this) if (cold_start) then photosyns_inst%alphapsnsun_patch(np) = 0._r8 photosyns_inst%alphapsnsha_patch(np) = 0._r8 - else (cold_start=.false.) then + else (cold_start==.false.) then photosyns_inst%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 76) photosyns_inst%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 77) end if @@ -604,115 +605,115 @@ subroutine ReadNML(this, NLFilename) end subroutine ReadNML !------------------------------------------------------------------------ - subroutine Restart(this, bounds, ncid, flag) - ! - ! !USES: - use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen - use restUtilMod - ! - ! !ARGUMENTS: - class(photosyns_type) :: this - type(bounds_type), intent(in) :: bounds - type(file_desc_t), intent(inout) :: ncid ! netcdf id - character(len=*) , intent(in) :: flag ! 'read' or 'write' - ! - ! !LOCAL VARIABLES: - integer :: j,c ! indices - logical :: readvar ! determine if variable is on initial file - !----------------------------------------------------------------------- - - if ( use_c13 ) then - call restartvar(ncid=ncid, flag=flag, varname='rc13_canair', xtype=ncd_double, & - dim1name='pft', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%rc13_canair_patch) - - call restartvar(ncid=ncid, flag=flag, varname='rc13_psnsun', xtype=ncd_double, & - dim1name='pft', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%rc13_psnsun_patch) - - call restartvar(ncid=ncid, flag=flag, varname='rc13_psnsha', xtype=ncd_double, & - dim1name='pft', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%rc13_psnsha_patch) - endif - - call restartvar(ncid=ncid, flag=flag, varname='GSSUN', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='sunlit leaf stomatal conductance', units='umol H20/m2/s', & - interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sun_patch) - - call restartvar(ncid=ncid, flag=flag, varname='GSSHA', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='shaded leaf stomatal conductance', units='umol H20/m2/s', & - interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sha_patch) - - call restartvar(ncid=ncid, flag=flag, varname='GSSUNLN', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & - units='umol H20/m2/s', & - interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sun_ln_patch) - - call restartvar(ncid=ncid, flag=flag, varname='GSSHALN', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & - units='umol H20/m2/s', & - interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sha_ln_patch) - - call restartvar(ncid=ncid, flag=flag, varname='lnca', xtype=ncd_double, & - dim1name='pft', long_name='leaf N concentration', units='gN leaf/m^2', & - interpinic_flag='interp', readvar=readvar, data=this%lnca_patch) - - if(use_luna) then - call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='Maximum carboxylation rate at 25 Celcius for canopy layers', units='umol CO2/m**2/s', & - interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_patch) - call restartvar(ncid=ncid, flag=flag, varname='jmx25_z', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='Maximum rate of electron transport at 25 Celcius for canopy layers', units='umol electrons/m**2/s', & - interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch) - call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z_last_valid_patch:vcmx_prevyr', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & - interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_last_valid_patch) - call restartvar(ncid=ncid, flag=flag, varname='jmx25_z_last_valid_patch:jmx_prevyr', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='avg rate of electron transport at 25 Celcius for canopy layers', units='umol electrons/m**2/s', & - interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_last_valid_patch) - call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='proportion of leaf nitrogen allocated for light capture', units='unitless', & - interpinic_flag='interp', readvar=readvar, data=this%pnlc_z_patch ) - call restartvar(ncid=ncid, flag=flag, varname='enzs_z', xtype=ncd_double, & - dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='enzyme decay status during stress: 1.0-fully active; 0.0-all decayed', units='unitless', & - interpinic_flag='interp', readvar=readvar, data=this%enzs_z_patch ) - call restartvar(ncid=ncid, flag=flag, varname='gpp24', xtype=ncd_double, & - dim1name='pft', long_name='accumulative gross primary production', units='umol CO2/m**2 ground/day', & - interpinic_flag='interp', readvar=readvar, data=this%fpsn24_patch) - endif - call restartvar(ncid=ncid, flag=flag, varname='vcmx25t', xtype=ncd_double, & - dim1name='pft', long_name='canopy profile of vcmax25', & - units='umol/m2/s', & - interpinic_flag='interp', readvar=readvar, data=this%luvcmax25top_patch) - - call restartvar(ncid=ncid, flag=flag, varname='jmx25t', xtype=ncd_double, & - dim1name='pft', long_name='canopy profile of jmax', & - units='umol/m2/s', & - interpinic_flag='interp', readvar=readvar, data=this%lujmax25top_patch) - - call restartvar(ncid=ncid, flag=flag, varname='tpu25t', xtype=ncd_double, & - dim1name='pft', long_name='canopy profile of tpu', & - units='umol/m2/s', & - interpinic_flag='interp', readvar=readvar, data=this%lutpu25top_patch) - - call restartvar(ncid=ncid, flag=flag, varname='VPD_CAN', xtype=ncd_double, & - dim1name='pft', long_name='canopy vapor pressure deficit', & - units='kPa', & - interpinic_flag='interp', readvar=readvar, data=this%vpd_can_patch) - - - - end subroutine Restart +! subroutine Restart(this, bounds, ncid, flag) +! ! +! ! !USES: +! use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen +! use restUtilMod +! ! +! ! !ARGUMENTS: +! class(photosyns_type) :: this +! type(bounds_type), intent(in) :: bounds +! type(file_desc_t), intent(inout) :: ncid ! netcdf id +! character(len=*) , intent(in) :: flag ! 'read' or 'write' +! ! +! ! !LOCAL VARIABLES: +! integer :: j,c ! indices +! logical :: readvar ! determine if variable is on initial file +! !----------------------------------------------------------------------- +! +! if ( use_c13 ) then +! call restartvar(ncid=ncid, flag=flag, varname='rc13_canair', xtype=ncd_double, & +! dim1name='pft', long_name='', units='', & +! interpinic_flag='interp', readvar=readvar, data=this%rc13_canair_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='rc13_psnsun', xtype=ncd_double, & +! dim1name='pft', long_name='', units='', & +! interpinic_flag='interp', readvar=readvar, data=this%rc13_psnsun_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='rc13_psnsha', xtype=ncd_double, & +! dim1name='pft', long_name='', units='', & +! interpinic_flag='interp', readvar=readvar, data=this%rc13_psnsha_patch) +! endif +! +! call restartvar(ncid=ncid, flag=flag, varname='GSSUN', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='sunlit leaf stomatal conductance', units='umol H20/m2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sun_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='GSSHA', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='shaded leaf stomatal conductance', units='umol H20/m2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sha_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='GSSUNLN', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='sunlit leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & +! units='umol H20/m2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sun_ln_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='GSSHALN', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='shaded leaf stomatal conductance averaged over 1 hour before to 1 hour after local noon', & +! units='umol H20/m2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sha_ln_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='lnca', xtype=ncd_double, & +! dim1name='pft', long_name='leaf N concentration', units='gN leaf/m^2', & +! interpinic_flag='interp', readvar=readvar, data=this%lnca_patch) +! +! if(use_luna) then +! call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='Maximum carboxylation rate at 25 Celcius for canopy layers', units='umol CO2/m**2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_patch) +! call restartvar(ncid=ncid, flag=flag, varname='jmx25_z', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='Maximum rate of electron transport at 25 Celcius for canopy layers', units='umol electrons/m**2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch) +! call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z_last_valid_patch:vcmx_prevyr', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_last_valid_patch) +! call restartvar(ncid=ncid, flag=flag, varname='jmx25_z_last_valid_patch:jmx_prevyr', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='avg rate of electron transport at 25 Celcius for canopy layers', units='umol electrons/m**2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_last_valid_patch) +! call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='proportion of leaf nitrogen allocated for light capture', units='unitless', & +! interpinic_flag='interp', readvar=readvar, data=this%pnlc_z_patch ) +! call restartvar(ncid=ncid, flag=flag, varname='enzs_z', xtype=ncd_double, & +! dim1name='pft', dim2name='levcan', switchdim=.true., & +! long_name='enzyme decay status during stress: 1.0-fully active; 0.0-all decayed', units='unitless', & +! interpinic_flag='interp', readvar=readvar, data=this%enzs_z_patch ) +! call restartvar(ncid=ncid, flag=flag, varname='gpp24', xtype=ncd_double, & +! dim1name='pft', long_name='accumulative gross primary production', units='umol CO2/m**2 ground/day', & +! interpinic_flag='interp', readvar=readvar, data=this%fpsn24_patch) +! endif +! call restartvar(ncid=ncid, flag=flag, varname='vcmx25t', xtype=ncd_double, & +! dim1name='pft', long_name='canopy profile of vcmax25', & +! units='umol/m2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%luvcmax25top_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='jmx25t', xtype=ncd_double, & +! dim1name='pft', long_name='canopy profile of jmax', & +! units='umol/m2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%lujmax25top_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='tpu25t', xtype=ncd_double, & +! dim1name='pft', long_name='canopy profile of tpu', & +! units='umol/m2/s', & +! interpinic_flag='interp', readvar=readvar, data=this%lutpu25top_patch) +! +! call restartvar(ncid=ncid, flag=flag, varname='VPD_CAN', xtype=ncd_double, & +! dim1name='pft', long_name='canopy vapor pressure deficit', & +! units='kPa', & +! interpinic_flag='interp', readvar=readvar, data=this%vpd_can_patch) +! +! +! +! end subroutine Restart !------------------------------------------------------------------------------ subroutine TimeStepInit (this, bounds) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 1975f65e5..be0bc7f24 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -31,7 +31,8 @@ module clm_time_manager get_days_per_year, &! return the days per year for current year get_local_timestep_time, &! return the local time for the input longitude to the nearest time-step - + get_local_time, &! return the local time for the input longitude + is_end_curr_day, &! return true on last timestep in current day is_restart, &! return true if this is a restart run is_first_step, & ! dummy function here, because it is loaded, but not used @@ -323,6 +324,36 @@ end function get_local_timestep_time !========================================================================================= + integer function get_local_timestep_time( londeg, offset ) + + !--------------------------------------------------------------------------------- + ! Get the local time for this longitude that is evenly divisible by the time-step + ! + ! uses + use clm_varcon, only: degpsec, isecspday + ! Arguments + real(r8) , intent(in) :: londeg ! Longitude in degrees + integer, optional, intent(in) :: offset ! Offset from current time in seconds (either sign) + + ! Local variables + integer :: yr, mon, day ! year, month, day, unused + integer :: secs ! seconds into the day + real(r8) :: lon ! positive longitude + integer :: offset_sec ! offset seconds (either 0 for current time or -dtime for previous time) + !--------------------------------------------------------------------------------- + if ( present(offset) ) then + offset_sec = offset + else + offset_sec = 0 + end if + SHR_ASSERT( londeg >= -180.0_r8, "londeg must be greater than -180" ) + SHR_ASSERT( londeg <= 360.0_r8, "londeg must be less than 360" ) + call get_curr_date(yr, mon, day, secs, offset=offset_sec ) + lon = londeg + if ( lon < 0.0_r8 ) lon = lon + 360.0_r8 + get_local_timestep_time = secs + nint((lon/degpsec)/real(dtime,r8))*dtime + get_local_timestep_time = mod(get_local_timestep_time,isecspday) + end function get_local_timestep_time !========================================================================================= ! function get_curr_ESMF_Time( ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index d34194284..c4f7dbbeb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -14,7 +14,8 @@ module clm_varctl ! !PUBLIC MEMBER FUNCTIONS: implicit none - public init_clm_varctl ! set parameters + public :: init_clm_varctl ! set parameters + public :: cnallocate_carbon_only logical, public :: use_nguardrail = .true. ! true => use precision control @@ -37,6 +38,9 @@ module clm_varctl logical, public :: use_bedrock = .false. ! true => use spatially variable soil depth logical, public :: use_extralakelayers = .false. logical, public :: use_biomass_heat_storage = .false. + logical, public :: lnc_opt = .false. + logical, public :: reduce_dayl_factor = .false. + integer, public :: vcmax_opt = 0 logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model @@ -101,4 +105,9 @@ subroutine init_clm_varctl() end subroutine init_clm_varctl + ! Get module carbon_only flag + logical function CNAllocate_Carbon_only() + cnallocate_carbon_only = carbon_only + end function CNAllocate_Carbon_only + end module clm_varctl From 691bcb751d8ecf853883c1189f6f66ee81afc825 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 15:23:08 -0500 Subject: [PATCH 199/589] add missing variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index c4f7dbbeb..ca2ea5bd0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -38,9 +38,6 @@ module clm_varctl logical, public :: use_bedrock = .false. ! true => use spatially variable soil depth logical, public :: use_extralakelayers = .false. logical, public :: use_biomass_heat_storage = .false. - logical, public :: lnc_opt = .false. - logical, public :: reduce_dayl_factor = .false. - integer, public :: vcmax_opt = 0 logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model @@ -73,6 +70,9 @@ module clm_varctl logical, public :: use_flexibleCN = .false. logical, public :: CNratio_floating = .false. integer, public :: CN_evergreen_phenology_opt = 0 + logical, public :: lnc_opt = .false. + logical, public :: reduce_dayl_factor = .false. + integer, public :: vcmax_opt = 0 !---------------------------------------------------------- ! BGC logic and datasets @@ -89,6 +89,9 @@ module clm_varctl logical, public :: use_snicar_frc = .false. integer, public :: carbon_resp_opt = 0 + + ! Set in CNAllocationInit (TODO - had to move it here to avoid circular dependency) + logical, private:: carbon_only contains !--------------------------------------- From de7d6c52d2cd540deef736ada824c1d0c7e52658 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 21 Dec 2022 15:51:20 -0500 Subject: [PATCH 200/589] add missing function --- .../CLM51/clm_time_manager.F90 | 62 +++++++++++-------- 1 file changed, 35 insertions(+), 27 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index be0bc7f24..061ac8066 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -324,51 +324,59 @@ end function get_local_timestep_time !========================================================================================= - integer function get_local_timestep_time( londeg, offset ) +! function get_curr_ESMF_Time( ) +! +! ! Return the current time as ESMF_Time +! +! type(ESMF_Time) :: get_curr_ESMF_Time +! character(len=*), parameter :: sub = 'clm::get_curr_ESMF_Time' +! integer :: rc, status +! +! ! if ( .not. check_timemgr_initialized(sub) ) return +! +! call ESMF_ClockGet( tm_clock, currTime=get_curr_ESMF_Time, rc=STATUS ) +! VERIFY_(STATUS) +! +! end function get_curr_ESMF_Time + + integer function get_local_time( londeg, starttime, offset ) !--------------------------------------------------------------------------------- - ! Get the local time for this longitude that is evenly divisible by the time-step + ! Get the local time for this longitude ! ! uses use clm_varcon, only: degpsec, isecspday ! Arguments - real(r8) , intent(in) :: londeg ! Longitude in degrees - integer, optional, intent(in) :: offset ! Offset from current time in seconds (either sign) + real(r8) , intent(in) :: londeg ! Longitude in degrees + integer, optional, intent(in) :: starttime ! Start time (sec) + integer, optional, intent(in) :: offset ! Offset from current time in seconds (either sign) ! Local variables integer :: yr, mon, day ! year, month, day, unused integer :: secs ! seconds into the day - real(r8) :: lon ! positive longitude + integer :: start ! start seconds integer :: offset_sec ! offset seconds (either 0 for current time or -dtime for previous time) + real(r8) :: lon ! positive longitude !--------------------------------------------------------------------------------- + if ( present(starttime) ) then + start = starttime + else + start = 0 + end if if ( present(offset) ) then offset_sec = offset else offset_sec = 0 end if - SHR_ASSERT( londeg >= -180.0_r8, "londeg must be greater than -180" ) - SHR_ASSERT( londeg <= 360.0_r8, "londeg must be less than 360" ) + SHR_ASSERT( start >= 0, "starttime must be greater than or equal to zero" ) + SHR_ASSERT( start <= isecspday, "starttime must be less than or equal to number of seconds in a day" ) + SHR_ASSERT( londeg >= -180.0_r8, "londeg must be greater than -180" ) + SHR_ASSERT( londeg <= 360.0_r8, "londeg must be less than 360" ) + SHR_ASSERT( (offset_sec == 0) .or. (offset_sec == -dtime), "offset must be zero or negative time-step" ) call get_curr_date(yr, mon, day, secs, offset=offset_sec ) lon = londeg if ( lon < 0.0_r8 ) lon = lon + 360.0_r8 - get_local_timestep_time = secs + nint((lon/degpsec)/real(dtime,r8))*dtime - get_local_timestep_time = mod(get_local_timestep_time,isecspday) - end function get_local_timestep_time - !========================================================================================= - -! function get_curr_ESMF_Time( ) -! -! ! Return the current time as ESMF_Time -! -! type(ESMF_Time) :: get_curr_ESMF_Time -! character(len=*), parameter :: sub = 'clm::get_curr_ESMF_Time' -! integer :: rc, status -! -! ! if ( .not. check_timemgr_initialized(sub) ) return -! -! call ESMF_ClockGet( tm_clock, currTime=get_curr_ESMF_Time, rc=STATUS ) -! VERIFY_(STATUS) -! -! end function get_curr_ESMF_Time - + get_local_time = modulo(secs + nint(londeg/degpsec), isecspday) + get_local_time = modulo(get_local_time - start,isecspday) + end function get_local_time end module clm_time_manager From 9d22b9a20f2767576ab31977dc86085c8f64a77f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 10:20:06 -0500 Subject: [PATCH 201/589] add missing sourcefile declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index 8aec7a687..6e1a7c8a1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -70,6 +70,9 @@ module CNProductsMod end type cn_products_type type(cn_products_type), public, target, save :: cn_products_inst + character(len=*), parameter, private :: sourcefile = & + __FILE__ + contains !-------------------------------------------------------------- From 6b76658ebebe2b8bdc1e19802e995b09671f3dfd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 10:45:38 -0500 Subject: [PATCH 202/589] fixinng invlude statment position --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index ef4227e37..4edf150c2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1,8 +1,8 @@ +module CNVegCarbonFluxType + #include "MAPL_Generic.h" #include "shr_assert.h" -module CNVegCarbonFluxType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use decompMod , only : bounds_type From 5eea1094f00c20af0d1953e8d917b429a6f53dc1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 11:11:55 -0500 Subject: [PATCH 203/589] add missing subroutine --- .../CLM51/AnnualFluxDribbler.F90 | 136 +++++++++--------- 1 file changed, 68 insertions(+), 68 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 index d5edc66ee..3efef0e4a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -108,7 +108,7 @@ module AnnualFluxDribbler ! procedure, public :: Clean ! Public science methods - ! procedure, public :: set_curr_delta ! Set the delta state for this time step + procedure, public :: set_curr_delta ! Set the delta state for this time step procedure, public :: get_curr_flux ! Get the current flux for this time step ! procedure, public :: get_dribbled_delta ! Similar to get_curr_flux, but gets result as a delta rather than a per-second flux ! procedure, public :: get_amount_left_to_dribble_beg ! Get the pseudo-state representing the amount that still needs to be dribbled in this and future time steps @@ -217,73 +217,73 @@ end function annual_flux_dribbler_patch ! ======================================================================== !----------------------------------------------------------------------- -! subroutine set_curr_delta(this, bounds, delta) -! ! -! ! !DESCRIPTION: -! ! Sets the delta state for this time step. Note that the delta is specified just as -! ! the change in state - NOT as a flux (per-second) quantity. -! ! -! ! This must be called every timestep, even if the deltas are currently 0, in order to -! ! zero out any existing stored delta. This can (and generally should) even be called -! ! when it isn't the first timestep of the year. For deltas that are non-zero at times -! ! other than the first timestep of the year, they will simply be passed on to the -! ! output flux in get_curr_flux, making for easier handling by the client. (i.e., this -! ! class handles the addition of the dribbled flux and the current flux for you.) -! ! -! ! !USES: -! ! -! ! !ARGUMENTS: -! class(annual_flux_dribbler_type), intent(inout) :: this -! type(bounds_type), intent(in) :: bounds -! real(r8), intent(in) :: delta( get_beg(bounds, this%bounds_subgrid_level) : ) -! ! -! ! !LOCAL VARIABLES: -! integer :: beg_index, end_index -! integer :: i -! integer :: yr, mon, day, tod -! -! character(len=*), parameter :: subname = 'set_curr_delta' -! !----------------------------------------------------------------------- -! -! beg_index = lbound(delta, 1) -! end_index = get_end(bounds, this%bounds_subgrid_level) -! SHR_ASSERT_ALL_FL((ubound(delta) == (/end_index/)), sourcefile, __LINE__) -! -! if (is_beg_curr_year()) then -! do i = beg_index, end_index -! this%amount_to_dribble(i) = delta(i) -! -! ! On the first timestep of the year, we don't have any pass-through flux. Need -! ! to zero out any previously-set amount_from_this_timestep. -! this%amount_from_this_timestep(i) = 0._r8 -! end do -! else -! do i = beg_index, end_index -! this%amount_from_this_timestep(i) = delta(i) -! end do -! if (.not. this%allows_non_annual_delta .and. .not. is_first_step()) then -! do i = beg_index, end_index -! if (this%amount_from_this_timestep(i) /= 0._r8) then -! write(iulog,*) subname//' ERROR: found unexpected non-zero delta mid-year' -! write(iulog,*) 'Dribbler name: ', trim(this%name) -! write(iulog,*) 'i, delta = ', i, this%amount_from_this_timestep(i) -! call get_prev_date(yr, mon, day, tod) -! write(iulog,*) 'Start of time step date (yr, mon, day, tod) = ', & -! yr, mon, day, tod -! write(iulog,*) 'This indicates that some non-zero flux was generated at a time step' -! write(iulog,*) 'other than the first time step of the year, which this dribbler was told not to expect.' -! write(iulog,*) 'If this non-zero mid-year delta is expected, then you can suppress this error' -! write(iulog,*) 'by setting allows_non_annual_delta to .true. when constructing this dribbler.' -! call endrun(decomp_index=i, clmlevel=this%name_subgrid, & -! msg=subname//': found unexpected non-zero delta mid-year: ' // & -! errMsg(sourcefile, __LINE__)) -! end if -! end do -! end if -! end if -! -! end subroutine set_curr_delta -! + subroutine set_curr_delta(this, bounds, delta) + ! + ! !DESCRIPTION: + ! Sets the delta state for this time step. Note that the delta is specified just as + ! the change in state - NOT as a flux (per-second) quantity. + ! + ! This must be called every timestep, even if the deltas are currently 0, in order to + ! zero out any existing stored delta. This can (and generally should) even be called + ! when it isn't the first timestep of the year. For deltas that are non-zero at times + ! other than the first timestep of the year, they will simply be passed on to the + ! output flux in get_curr_flux, making for easier handling by the client. (i.e., this + ! class handles the addition of the dribbled flux and the current flux for you.) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: delta( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + integer :: beg_index, end_index + integer :: i + integer :: yr, mon, day, tod + + character(len=*), parameter :: subname = 'set_curr_delta' + !----------------------------------------------------------------------- + + beg_index = lbound(delta, 1) + end_index = get_end(bounds, this%bounds_subgrid_level) + SHR_ASSERT_ALL_FL((ubound(delta) == (/end_index/)), sourcefile, __LINE__) + + if (is_beg_curr_year()) then + do i = beg_index, end_index + this%amount_to_dribble(i) = delta(i) + + ! On the first timestep of the year, we don't have any pass-through flux. Need + ! to zero out any previously-set amount_from_this_timestep. + this%amount_from_this_timestep(i) = 0._r8 + end do + else + do i = beg_index, end_index + this%amount_from_this_timestep(i) = delta(i) + end do + if (.not. this%allows_non_annual_delta .and. .not. is_first_step()) then + do i = beg_index, end_index + if (this%amount_from_this_timestep(i) /= 0._r8) then + write(iulog,*) subname//' ERROR: found unexpected non-zero delta mid-year' + write(iulog,*) 'Dribbler name: ', trim(this%name) + write(iulog,*) 'i, delta = ', i, this%amount_from_this_timestep(i) + call get_prev_date(yr, mon, day, tod) + write(iulog,*) 'Start of time step date (yr, mon, day, tod) = ', & + yr, mon, day, tod + write(iulog,*) 'This indicates that some non-zero flux was generated at a time step' + write(iulog,*) 'other than the first time step of the year, which this dribbler was told not to expect.' + write(iulog,*) 'If this non-zero mid-year delta is expected, then you can suppress this error' + write(iulog,*) 'by setting allows_non_annual_delta to .true. when constructing this dribbler.' + call endrun(decomp_index=i, clmlevel=this%name_subgrid, & + msg=subname//': found unexpected non-zero delta mid-year: ' // & + errMsg(sourcefile, __LINE__)) + end if + end do + end if + end if + + end subroutine set_curr_delta + ! !----------------------------------------------------------------------- subroutine get_curr_flux(this, bounds, flux) ! From 8421bfd6c13932d8a273e32fbf537f1bb009e835 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 11:12:28 -0500 Subject: [PATCH 204/589] add sourcefile declaration and MAPL_ExceptionHandling --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 4edf150c2..f96853ed9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -24,7 +24,8 @@ module CNVegCarbonFluxType use clm_varcon , only : spval use ColumnType , only : col use PatchType , only : patch - use AnnualFluxDribbler , only : annual_flux_dribbler_type, annual_flux_dribbler_gridcell + use AnnualFluxDribbler , only : annual_flux_dribbler_type, annual_flux_dribbler_gridcell + use MAPL_ExceptionHandling ! !PUBLIC TYPES: implicit none @@ -481,6 +482,9 @@ module CNVegCarbonFluxType type(cnveg_carbonflux_type), public, target, save :: cnveg_carbonflux_inst + character(len=*), parameter, private :: sourcefile = & + __FILE__ + contains !--------------------------------------- From 9fee9ce7e932deded9f636d64563d5b1ee56d67d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 12:02:06 -0500 Subject: [PATCH 205/589] add beginning of year check function --- .../CLM51/AnnualFluxDribbler.F90 | 2 +- .../CLM51/clm_time_manager.F90 | 24 +++++++++++++++++++ 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 index 3efef0e4a..84f93ee99 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -64,7 +64,7 @@ module AnnualFluxDribbler use decompMod , only : bounds_type, get_beg, get_end use decompMod , only : BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_PATCH use clm_varcon , only : secspday, nameg, namep - use clm_time_manager , only : get_days_per_year, get_step_size_real + use clm_time_manager , only : get_days_per_year, get_step_size_real, is_beg_curr_year ! use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac, get_prev_date use clm_time_manager , only : is_first_step ! diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 061ac8066..63f1d6438 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -34,6 +34,7 @@ module clm_time_manager get_local_time, &! return the local time for the input longitude is_end_curr_day, &! return true on last timestep in current day + is_beg_curr_year, &! return true on first timestep in current year is_restart, &! return true if this is a restart run is_first_step, & ! dummy function here, because it is loaded, but not used is_near_local_noon ! return true if near local noon @@ -379,4 +380,27 @@ integer function get_local_time( londeg, starttime, offset ) get_local_time = modulo(secs + nint(londeg/degpsec), isecspday) get_local_time = modulo(get_local_time - start,isecspday) end function get_local_time + + !----------------------------------------------------------------------- + logical function is_beg_curr_year() + ! + ! !DESCRIPTION: + ! Return true if current timestep is first timestep in current year. + ! + ! !LOCAL VARIABLES: + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + character(len=*), parameter :: subname = 'is_beg_curr_year' + !----------------------------------------------------------------------- + + if ( .not. check_timemgr_initialized(subname) ) return + + call get_curr_date(yr, mon, day, tod) + is_beg_curr_year = (mon == 1 .and. day == 1 .and. tod == dtime) + + end function is_beg_curr_year end module clm_time_manager From 0b41dc02ecdce7edf92f18bfe7ac65d4dc7aff27 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 12:31:29 -0500 Subject: [PATCH 206/589] comment out unneeded check --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 63f1d6438..93f1ad350 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -397,7 +397,7 @@ logical function is_beg_curr_year() character(len=*), parameter :: subname = 'is_beg_curr_year' !----------------------------------------------------------------------- - if ( .not. check_timemgr_initialized(subname) ) return + ! if ( .not. check_timemgr_initialized(subname) ) return call get_curr_date(yr, mon, day, tod) is_beg_curr_year = (mon == 1 .and. day == 1 .and. tod == dtime) From 50114c235c28062283f6fccb0da15e96ee8013ab Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 13:03:32 -0500 Subject: [PATCH 207/589] typo fix and add missing variable --- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 3013b2dce..99c11476b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -1,7 +1,9 @@ module CNVegCarbonStateType +#include "shr_assert.h" + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 - use clm_varctl , only : iulog, use_cndv, use_crop, use_matrixc + use clm_varctl , only : iulog, use_cndv, use_crop, use_matrixcn use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight use nanMod , only : nan @@ -49,6 +51,7 @@ module CNVegCarbonStateType real(r8), pointer :: deadstemc_patch (:) ! (gC/m2) dead stem C real(r8), pointer :: deadstemc_storage_patch (:) ! (gC/m2) dead stem C storage real(r8), pointer :: deadstemc_xfer_patch (:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: matrix_cap_deadstemc_patch (:) ! (gC/m2) Capacity of dead stem C real(r8), pointer :: matrix_cap_deadstemc_storage_patch (:) ! (gC/m2) Capacity of dead stem C storage real(r8), pointer :: matrix_cap_deadstemc_xfer_patch (:) ! (gC/m2) Capacity of dead stem C transfer real(r8), pointer :: livecrootc_patch (:) ! (gC/m2) live coarse root C From 5b60eea5c3306e0c39cb20caa188a9f11bd5c56a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 13:51:29 -0500 Subject: [PATCH 208/589] adding sourcefile declaration --- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 99c11476b..4eeb7f144 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -204,6 +204,9 @@ module CNVegCarbonStateType type(cnveg_carbonstate_type), public, target, save :: cnveg_carbonstate_inst + character(len=*), parameter :: sourcefile = & + __FILE__ + contains !---------------------------------------------- From 08342868697408c972c2157ae5194ca799722a7e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 14:31:12 -0500 Subject: [PATCH 209/589] add missing variable imports --- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index e3d7398e9..ae2bf412a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -3,16 +3,17 @@ module CNVegNitrogenFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use decompMod , only : bounds_type - use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools,& - nvegcpool,ncphtrans,ncgmtrans,ncfitrans,& - ncphouttrans,ncgmouttrans,ncfiouttrans + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools use clm_varpar , only : nlevdecomp_full, nlevgrnd,nlevdecomp - use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& - ilivestem,ilivestem_st,ilivestem_xf,& - ideadstem,ideadstem_st,ideadstem_xf,& - ilivecroot,ilivecroot_st,ilivecroot_xf,& - ideadcroot,ideadcroot_st,ideadcroot_xf,& - igrain,igrain_st,igrain_xf,ioutc + use clm_varpar , only : nlevdecomp_full, nlevdecomp,nvegnpool,& + nnphtrans,nngmtrans,nnfitrans,nnphouttrans,& + nngmouttrans,nnfiouttrans + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,iretransn,ioutn use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight use clm_varcon , only : spval, ispval, dzsoi_decomp From 4f9d2372fed4cad7062808ee56a8f6f7cca7d5de Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 09:33:18 -0500 Subject: [PATCH 210/589] add missing variable declaration --- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index ae2bf412a..bb36cf25f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -263,6 +263,7 @@ module CNVegNitrogenFluxType real(r8), pointer :: matrix_ngmtransfer_patch (:,:) ! A-matrix_gap mortality for nitrogen real(r8), pointer :: matrix_ngmturnover_patch (:,:) ! K-matrix_gap mortality for nitrogen integer, pointer :: matrix_ngmtransfer_doner_patch (:) ! A-matrix_gap mortality non-zero indices (column indices) for nitrogen + integer, pointer :: matrix_ngmtransfer_receiver_patch (:) ! A-matrix_gap mortality non-zero indices (row indices) for nitrogen real(r8), pointer :: matrix_nfitransfer_patch (:,:) ! A-matrix_fire for nitrogen real(r8), pointer :: matrix_nfiturnover_patch (:,:) ! K-matrix_fire for nitrogen From b661e77f3b6a10ba9ca9539491dd6c44737e348b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 10:10:40 -0500 Subject: [PATCH 211/589] typo fix and missing use statements --- .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index 771fe7412..6527058f9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -2,7 +2,7 @@ module CNVegNitrogenStateType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use MAPL_ExceptionHandling - use clm_varctl , only : use_matrixcn + use clm_varctl , only : use_matrixcn, use_crop use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp use clm_varpar , only : NUM_ZON, NUM_VEG, VAR_COL, VAR_PFT, & numpft, CN_zone_weight @@ -11,6 +11,7 @@ module CNVegNitrogenStateType use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi use nanMod , only : nan use decompMod , only : bounds_type + use pftconMod , only : npcropmin use PatchType , only : patch ! !PUBLIC TYPES: @@ -235,7 +236,7 @@ subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, ! LOCAL: - integer :: begp, endp, begg, endgg, begc, endc + integer :: begp, endp, begg, endg, begc, endc integer :: np, nc, nz, p, nv, n !--------------------------------------------------------------------- From bfb2793d6070c2e331b084f79a2b1ffb5b219305 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 11:16:59 -0500 Subject: [PATCH 212/589] bug fixes and missing use statements --- .../CLM51/PhotosynthesisMod.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 9ca3446cb..862b3febc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -17,6 +17,7 @@ module PhotosynthesisMod use clm_varctl , only : use_c13, use_c14, use_cn, use_cndv, use_fates, use_luna, use_hydrstress use clm_varctl , only : iulog use clm_varpar , only : nlevcan, nvegwcs, mxpft + use clm_varpar , only : numpft, NUM_VEG, NUM_ZON, VAR_COL, VAR_PFT use clm_varcon , only : namep, spval, isecspday use decompMod , only : bounds_type use QuadraticMod , only : quadratic @@ -376,11 +377,11 @@ subroutine Init(this,bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,rc) do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then if (cold_start) then - photosyns_inst%alphapsnsun_patch(np) = 0._r8 - photosyns_inst%alphapsnsha_patch(np) = 0._r8 - else (cold_start==.false.) then - photosyns_inst%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 76) - photosyns_inst%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 77) + this%alphapsnsun_patch(np) = 0._r8 + this%alphapsnsha_patch(np) = 0._r8 + else if (cold_start==.false.) then + this%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 76) + this%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 77) end if end if ! ityp =p end do !nv @@ -791,7 +792,7 @@ subroutine PhotosynthesisTotal (fn, filterp, & ! !LOCAL VARIABLES: integer :: f,fp,p,l,g ! indices - real(r8) :: rc14_atm(nsectors_c14), rc13_atm + ! real(r8) :: rc14_atm(nsectors_c14), rc13_atm integer :: sector_c14 !----------------------------------------------------------------------- From 116d6154cff7f63a450757a1fed7e39620fce21b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 11:41:45 -0500 Subject: [PATCH 213/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 5d7197532..d4806b358 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -4,7 +4,7 @@ module CNCLM_Photosynthesis use clm_varpar, only : numpft, numrad, num_veg, num_zon use decompMod, only : bounds_type use PatchType, only : patch - use clm_varcon only : rair + use clm_varcon, only : rair use CNVegNitrogenstateType use CNVegCarbonstateType From 83bad7c4fc643befe2e291efd42a1194d4cf9fa2 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 12:28:59 -0500 Subject: [PATCH 214/589] fixing a number of bugs --- .../CLM51/CNCLM51_Photosynthesis.F90 | 86 ++++++++++++------- 1 file changed, 53 insertions(+), 33 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index d4806b358..93d827a2c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -4,7 +4,7 @@ module CNCLM_Photosynthesis use clm_varpar, only : numpft, numrad, num_veg, num_zon use decompMod, only : bounds_type use PatchType, only : patch - use clm_varcon, only : rair + use clm_varcon, only : rair use CNVegNitrogenstateType use CNVegCarbonstateType @@ -17,7 +17,7 @@ module CNCLM_Photosynthesis use SolarAbsorbedType use CanopyStateType use OzoneBaseMod - use PhotosynsType + use PhotosynthesisMod use WaterFluxBulkType use filterMod, only: filter @@ -96,19 +96,19 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, dimension(nch*NUM_ZON*(numpft+1)) :: laisun_dt, laisha_dt, rssun_dt, rssha_dt ! local variables to compute Photosynthesis inputs - real, dimension (nch) :: esat_tv ! vapor pressure inside leaf (sat vapor press at tc) (Pa) - real, dimension (nch) :: eair ! vapor pressure of canopy air + real, dimension (nch, NUM_ZON) :: esat_tv ! vapor pressure inside leaf (sat vapor press at tc) (Pa) + real, dimension (nch, NUM_ZON) :: eair ! vapor pressure of canopy air real, dimension (nch) :: oair ! Atmospheric O2 partial pressure (Pa) real, dimension (nch) :: deldT ! d(es)/d(T) real, dimension (nch) :: cair ! compute CO2 partial pressure real, dimension (nch) :: rb ! boundary layer resistance (s/m) real, dimension (nch) :: el ! vapor pressure on leaf surface [pa] - real, dimension (nch) :: qsatl ! leaf specific humidity [kg/kg] - real, dimension (nch) :: qsatldT ! derivative of "qsatl" on "t_veg" - real, dimension (nch) :: qaf ! canopy air humidity [kg/kg] - real, dimension (nch*num_zon*(numpft+1)) :: coszen_clm ! cosine solar zenith angle for next time step in CLM dimensions + real, dimension (nch, NUM_ZON) :: qsatl ! leaf specific humidity [kg/kg] + real, dimension (nch, NUM_ZON) :: qsatldT ! derivative of "qsatl" on "t_veg" + real, dimension (nch, NUM_ZON) :: qaf ! canopy air humidity [kg/kg] ! local inputs to Photosynthesis in CLM space + real, dimension(nch*NUM_ZON*(numpft+1)) :: coszen_clm ! cosine solar zenith angle for next time step in CLM dimensions real, dimension(nch*NUM_ZON*(numpft+1)) :: esat_tv_clm real, dimension(nch*NUM_ZON*(numpft+1)) :: eair_clm real, dimension(nch*NUM_ZON*(numpft+1)) :: cair_clm @@ -117,12 +117,17 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, dimension(nch*NUM_ZON*(numpft+1)) :: dayl_factor_clm real, dimension(nch*NUM_ZON*(numpft+1)) :: qsatl_clm real, dimension(nch*NUM_ZON*(numpft+1)) :: qaf_clm + real, dimension(nch*NUM_ZON*(numpft+1)) :: deldT_clm ! local pointers for Photosynthesis inputs real, pointer :: leafn(:) ! leaf N (gN/m2) real, pointer :: froot_carbon(:) ! fine root carbon (gC/m2) [pft] real, pointer :: croot_carbon(:) ! live coarse root carbon (gC/m2) [pft] + ! other local variables + + integer :: num_vegsol, num_novegsol + ! CLM variables type(bounds_type) :: bounds type(atm2lnd_type) :: atm2lnd_inst @@ -135,6 +140,8 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & type(ozone_base_type) :: ozone_inst type(photosyns_type) :: photosyns_inst type(waterfluxbulk_type) :: waterfluxbulk_inst + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst ! associate variables @@ -145,23 +152,28 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & xl => pftcon%xl , & rhol => pftcon%rhol , & taul => pftcon%taul , & - leafn => cnveg_nitrogenstate%leafn_patch , & - froot_carbon => cnveg_carbonstate%frootc_patch , & - croot_carbon => cnveg_carbonstate%liverootc_patch, & + leafn => cnveg_nitrogenstate_inst%leafn_patch , & + froot_carbon => cnveg_carbonstate_inst%frootc_patch , & + croot_carbon => cnveg_carbonstate_inst%liverootc_patch, & elai => canopystate_inst%elai_patch , & - esai => canopystate_inst%esai_patch , & + esai => canopystate_inst%esai_patch & ) ! compute saturation vapor pressure ! --------------------------------- do n = 1,nch - esat_tv(n) = MAPL_EQsat(tc(n),DQ=deldT(n)) + do nz = 1,NUM_ZON + esat_tv(n,nz) = MAPL_EQsat(tc(n,nz),DQ=deldT(n)) + end do end do ! compute canopy air vapor pressure !---------------------------------- - eair(:) = pbot(:) * qa(:) / (0.622 + qa(:)) ! canopy air vapor pressure (Pa); jk: this is different from the formulation in the CLM code, which is different from the formulation in the CLM documentation - + do n = 1,nch + do nz = 1,NUM_ZON + eair(n,nz) = pbot(n) * qa(n,nz) / (0.622 + qa(n-nz)) ! canopy air vapor pressure (Pa); jk: this is different from the formulation in the CLM code, which is different from the formulation in the CLM documentation + end do + end do ! compute atmospheric O2 partial pressure !----------------------------------------- oair(:) = 0.20946*pbot @@ -177,14 +189,21 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! leaf specific humidity !------------------------ do n = 1,nch - call QSat(tc(n), pbot(n), qsatl(n), & + do nz = 1,NUM_ZON + call QSat(tc(n,nz), pbot(n), qsatl(n,nz), & el(n), & qsatldT(n)) + end do end do ! canopy air humidity !-------------------- - qaf = qa + + do n = 1,nch + do nz = 1,NUM_ZON + qaf(n,nz) = qa(n,nz) + end do + end do ! atmospheric pressure and density downscaled to column level ! vegetation temperature, 2m 10-day running mean temperature, temperature at AGCM ref. height @@ -201,13 +220,13 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & do nz = 1,num_zon n = n + 1 atm2lnd_inst%forc_pbot_downscaled_col (n) = pbot(nc) - atm2lnd_inst%forc_rho_downscaled_col (n) = pbot(nc)-0.378*eair(nc)/(rair*tc(nc)) + atm2lnd_inst%forc_rho_downscaled_col (n) = pbot(nc)-0.378*eair(nc,nz)/(rair*tc(nc,nz)) soilstate_inst%hk_sat_col (n) = 1000.*COND(nc) ! saturated hydraulic conductivity mapped to CLM space ! and converted to [mm/s] - soilstate_inst%hk_l_col (n) = 1000.*COND(nc)*(wet3(nc)^(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space + soilstate_inst%hk_l_col (n) = 1000.*COND(nc)*(wet3(nc)**(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space ! and converted to [mm/s] - soilstate_inst%smp_l_col (n) = 1000.*PSIS(nc)*(wet3(nc)^(-bee(nc))) ! actual soil matric potential mapped to CLM space + soilstate_inst%smp_l_col (n) = 1000.*PSIS(nc)*(wet3(nc)**(-bee(nc))) ! actual soil matric potential mapped to CLM space ! and converted to [mm] soilstate_inst%bsw_col (n) = bee(nc) ! Clapp-Hornberger 'b' soilstate_inst%sucsat_col (n) = 1000.*psis(nc)*(-1) ! minimum soil suction [mm] @@ -242,17 +261,18 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & soilstate_inst%rootfr_patch(p,1) = 0. ! map Photosynthesis inputs to CLM space - esat_tv_clm (p) = esat_tv(nc) + esat_tv_clm (p) = esat_tv(nc,nz) oair_clm (p) = oair(nc) cair_clm (p) = cair(nc) rb_clm (p) = rb(nc) - qsatl_clm (p) = qsatl(nc) - qaf_clm (p) = qaf(nc) + qsatl_clm (p) = qsatl(nc,nz) + qaf_clm (p) = qaf(nc,nz) dayl_factor_clm(p) = dayl_factor(nc) coszen_clm (p) = coszen(nc) + deldT_clm (p) = deldT(nc) ! compute canopy air vapor pressure (in CLM space) - eair_ clm (p) = pbot(nc) * qa(nc,nz) / (0.622 + qa(nc,nz)) + eair_clm (p) = eair(nc,nz) do nv = 1,num_veg if (ityp(nc,nv,nz).eq.np) then @@ -294,7 +314,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call TwoStream(bounds, & filter_vegsol, num_vegsol, & - coszen, rho, tau, & + coszen_clm, rho, tau, & canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst) ! compute canopy shaded and sunlit variables (jk: needed to fill solarabs_inst before PHS call) @@ -309,11 +329,11 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! compute resistance with small delta ea - eair_pert(:) = eair(:) + dea + eair_pert(:) = eair_clm(:) + dea call PhotosynthesisHydraulicStress ( bounds, filter%num_exposedvegp, filter%exposedvegp, & - esat_tv, eair_pert, oair, cair, rb, bsun, bsha, btran, dayl_factor, leafn, & - qsatl, qaf, & + esat_tv_clm, eair_pert, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & + qsatl_clm, qaf_clm, & atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) @@ -327,11 +347,11 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & temp_unpert = temperature_inst%t_veg_patch temperature_inst%t_veg_patch = temperature_inst%t_veg_patch + dtc - esat_tv_pert(:) = esat_tv(:) + deldT(:)*dtc + esat_tv_pert(:) = esat_tv_clm(:) + deldT_clm(:)*dtc call PhotosynthesisHydraulicStress ( bounds, fn, filterp, & - esat_tv_pert, eair, oair, cair, rb, bsun, bsha, btran, dayl_factor, leafn, & - qsatl, qaf, & + esat_tv_pert, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & + qsatl_clm, qaf_clm, & atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) @@ -346,8 +366,8 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & temperature_inst%t_veg_patch = temp_unpert ! reset canopy temperature to unperturbed value call PhotosynthesisHydraulicStress ( bounds, fn, filterp, & - esat_tv, eair, oair, cair, rb, bsun, bsha, btran, dayl_factor, leafn, & - qsatl, qaf, & + esat_tv_clm, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & + qsatl_clm, qaf_clm, & atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) From 952df2a0942be2ae80ef34d912ff03a6366cd37b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 13:03:31 -0500 Subject: [PATCH 215/589] commenting out matrix calculations --- .../CLM51/CNCStateUpdate1Mod.F90 | 22 ++++++------- .../CLM51/CNCStateUpdate2Mod.F90 | 32 +++++++++---------- .../CLM51/CNCStateUpdate3Mod.F90 | 22 ++++++------- .../CLM51/CNNStateUpdate1Mod.F90 | 16 +++++----- .../CLM51/CNNStateUpdate2Mod.F90 | 32 +++++++++---------- .../CLM51/CNNStateUpdate3Mod.F90 | 20 ++++++------ 6 files changed, 72 insertions(+), 72 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate1Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate1Mod.F90 index 2599c386c..426611390 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate1Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate1Mod.F90 @@ -150,7 +150,7 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! variables (except for gap-phase mortality and fire fluxes) ! use clm_varctl , only : carbon_resp_opt - use CNVegMatrixMod, only : matrix_update_phc + !use CNVegMatrixMod, only : matrix_update_phc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns @@ -211,12 +211,12 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! time step, but to be safe, I'm explicitly setting it to zero here. cf_soil%decomp_cpools_sourcesink_col(c,j,i_cwd) = 0._r8 else - cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_met_c_col(c,j) *dt - cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_cel_c_col(c,j) *dt - cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_lig_c_col(c,j) *dt +! cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_met_c_col(c,j) *dt +! cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_cel_c_col(c,j) *dt +! cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%phenology_c_to_litr_lig_c_col(c,j) *dt end if end do end do @@ -537,8 +537,8 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & if(.not. use_matrixcn)then cf_veg%xsmrpool_to_atm_patch(p) = cf_veg%xsmrpool_to_atm_patch(p) + cs_veg%frootc_patch(p)/dt else - cf_veg%xsmrpool_to_atm_patch(p) = cf_veg%xsmrpool_to_atm_patch(p) & - + cs_veg%frootc_patch(p) * matrix_update_phc(p,cf_veg%ifroot_to_iout_ph,1._r8/dt,dt,cnveg_carbonflux_inst,.true.,.true.) +! cf_veg%xsmrpool_to_atm_patch(p) = cf_veg%xsmrpool_to_atm_patch(p) & +! + cs_veg%frootc_patch(p) * matrix_update_phc(p,cf_veg%ifroot_to_iout_ph,1._r8/dt,dt,cnveg_carbonflux_inst,.true.,.true.) end if ! Save xsmrpool, cpool, frootc to loss state variable for ! dribbling @@ -552,8 +552,8 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & if(.not. use_matrixcn)then cs_veg%xsmrpool_loss_patch(p) = cs_veg%xsmrpool_loss_patch(p) + cs_veg%frootc_patch(p) else - cs_veg%xsmrpool_loss_patch(p) = cs_veg%xsmrpool_loss_patch(p) & - + cs_veg%frootc_patch(p) * matrix_update_phc(p,cf_veg%ifroot_to_iout_ph,1._r8/dt,dt,cnveg_carbonflux_inst,.true.,.true.) +! cs_veg%xsmrpool_loss_patch(p) = cs_veg%xsmrpool_loss_patch(p) & +! + cs_veg%frootc_patch(p) * matrix_update_phc(p,cf_veg%ifroot_to_iout_ph,1._r8/dt,dt,cnveg_carbonflux_inst,.true.,.true.) end if end if if (.not. use_matrixcn) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate2Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate2Mod.F90 index d273520af..adbccb71e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate2Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate2Mod.F90 @@ -79,14 +79,14 @@ subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = & cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + cf_veg%gap_mortality_c_to_cwdc_col(c,j) * dt else - cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_met_c_col(c,j) * dt - cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_cel_c_col(c,j) * dt - cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_lig_c_col(c,j) * dt - cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_cwdc_col(c,j) * dt +! cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_met_c_col(c,j) * dt +! cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_cel_c_col(c,j) * dt +! cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_litr_lig_c_col(c,j) * dt +! cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + cf_veg%gap_mortality_c_to_cwdc_col(c,j) * dt end if !soil_matrix end do end do @@ -202,14 +202,14 @@ subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = & cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + cf_veg%harvest_c_to_cwdc_col(c,j) * dt else - cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_met_c_col(c,j) * dt - cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_cel_c_col(c,j) * dt - cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_lig_c_col(c,j) * dt - cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = & - cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + cf_veg%harvest_c_to_cwdc_col(c,j) * dt +! cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_met_c_col(c,j) * dt +! cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_cel_c_col(c,j) * dt +! cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + cf_veg%harvest_c_to_litr_lig_c_col(c,j) * dt +! cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = & +! cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + cf_veg%harvest_c_to_cwdc_col(c,j) * dt end if ! wood to product pools - states updated in CNProducts diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate3Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate3Mod.F90 index 4ed4b828b..b9d55b231 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate3Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCStateUpdate3Mod.F90 @@ -77,17 +77,17 @@ subroutine CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) + & cf_veg%m_c_to_litr_lig_fire_col(c,j)* dt else - ! patch-level wood to column-level CWD (uncombusted wood) - cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + & - cf_veg%fire_mortality_c_to_cwdc_col(c,j) * dt - - ! patch-level wood to column-level litter (uncombusted wood) - cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + & - cf_veg%m_c_to_litr_met_fire_col(c,j)* dt - cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + & - cf_veg%m_c_to_litr_cel_fire_col(c,j)* dt - cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + & - cf_veg%m_c_to_litr_lig_fire_col(c,j)* dt +! ! patch-level wood to column-level CWD (uncombusted wood) +! cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_cwd-1)*nlevdecomp) + & +! cf_veg%fire_mortality_c_to_cwdc_col(c,j) * dt +! +! ! patch-level wood to column-level litter (uncombusted wood) +! cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_met_lit-1)*nlevdecomp) + & +! cf_veg%m_c_to_litr_met_fire_col(c,j)* dt +! cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_cel_lit-1)*nlevdecomp) + & +! cf_veg%m_c_to_litr_cel_fire_col(c,j)* dt +! cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) = cf_soil%matrix_Cinput%V(c,j+(i_lig_lit-1)*nlevdecomp) + & +! cf_veg%m_c_to_litr_lig_fire_col(c,j)* dt end if end do end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate1Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate1Mod.F90 index 3aabe0c3f..61a0388b4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate1Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate1Mod.F90 @@ -147,14 +147,14 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & nf_soil%decomp_npools_sourcesink_col(c,j,i_cwd) = 0._r8 else - nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_met_n_col(c,j) *dt - - nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_cel_n_col(c,j) *dt - - nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_lig_n_col(c,j) *dt +! nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_met_n_col(c,j) *dt +! +! nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_cel_n_col(c,j) *dt +! +! nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%phenology_n_to_litr_lig_n_col(c,j) *dt end if end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate2Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate2Mod.F90 index 15423f19a..0ca87fab2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate2Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate2Mod.F90 @@ -78,14 +78,14 @@ subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & ns_soil%decomp_npools_vr_col(c,j,i_cwd) = & ns_soil%decomp_npools_vr_col(c,j,i_cwd) + nf_veg%gap_mortality_n_to_cwdn_col(c,j) * dt else - nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_met_n_col(c,j) * dt - nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_cel_n_col(c,j) * dt - nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_lig_n_col(c,j) * dt - nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_cwdn_col(c,j) * dt +! nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_met_n_col(c,j) * dt +! nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_cel_n_col(c,j) * dt +! nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_litr_lig_n_col(c,j) * dt +! nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + nf_veg%gap_mortality_n_to_cwdn_col(c,j) * dt end if !not use_soil_matrix end do end do @@ -201,14 +201,14 @@ subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & ns_soil%decomp_npools_vr_col(c,j,i_cwd) = & ns_soil%decomp_npools_vr_col(c,j,i_cwd) + nf_veg%harvest_n_to_cwdn_col(c,j) * dt else - nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_met_n_col(c,j) * dt - nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_cel_n_col(c,j) * dt - nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_lig_n_col(c,j) * dt - nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = & - nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + nf_veg%harvest_n_to_cwdn_col(c,j) * dt +! nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_met_n_col(c,j) * dt +! nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_cel_n_col(c,j) * dt +! nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + nf_veg%harvest_n_to_litr_lig_n_col(c,j) * dt +! nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = & +! nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + nf_veg%harvest_n_to_cwdn_col(c,j) * dt end if !not use_soil_matrixcn end do end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate3Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate3Mod.F90 index c0de9f890..8243508dc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate3Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNStateUpdate3Mod.F90 @@ -92,16 +92,16 @@ subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) = ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) + & nf_veg%m_n_to_litr_lig_fire_col(c,j)* dt else - nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + & - nf_veg%fire_mortality_n_to_cwdn_col(c,j) * dt - - ! patch-level wood to column-level litter (uncombusted wood) - nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + & - nf_veg%m_n_to_litr_met_fire_col(c,j)* dt - nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + & - nf_veg%m_n_to_litr_cel_fire_col(c,j)* dt - nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + & - nf_veg%m_n_to_litr_lig_fire_col(c,j)* dt +! nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_cwd-1)*nlevdecomp) + & +! nf_veg%fire_mortality_n_to_cwdn_col(c,j) * dt +! +! ! patch-level wood to column-level litter (uncombusted wood) +! nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_met_lit-1)*nlevdecomp) + & +! nf_veg%m_n_to_litr_met_fire_col(c,j)* dt +! nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_cel_lit-1)*nlevdecomp) + & +! nf_veg%m_n_to_litr_cel_fire_col(c,j)* dt +! nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) = nf_soil%matrix_Ninput%V(c,j+(i_lig_lit-1)*nlevdecomp) + & +! nf_veg%m_n_to_litr_lig_fire_col(c,j)* dt end if ! not use_soil_matrix end do ! end of column loop end do From 7b737c8b30ff45b0805e092e268e798dc62e8e76 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 14:04:30 -0500 Subject: [PATCH 216/589] comment out matrix calculations --- .../CLM51/CNFireLi2014Mod.F90 | 260 ++++---- .../CLM51/CNGapMortalityMod.F90 | 98 +-- .../CLM51/CNPhenologyMod.F90 | 598 +++++++++--------- .../CLM51/CNVegetationFacade.F90 | 202 +++--- .../NutrientCompetitionFlexibleCNMod.F90 | 70 +- 5 files changed, 614 insertions(+), 614 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 index cc2ec215b..f7fd7d75c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 @@ -45,7 +45,7 @@ module CNFireLi2014Mod use PatchType , only : patch use FireMethodType , only : fire_method_type use CNFireBaseMod , only : cnfire_base_type, cnfire_const, cnfire_params - use CNVegMatrixMod , only : matrix_update_fic, matrix_update_fin + ! use CNVegMatrixMod , only : matrix_update_fic, matrix_update_fin ! implicit none private @@ -1028,44 +1028,44 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte m_retransn_to_fire(p) = retransn(p) * f * cc_other(patch%itype(p)) else - m_leafc_to_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_storage_to_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_xfer_to_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_storage_to_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_to_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_to_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_storage_to_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_xfer_to_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_to_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - - m_leafn_to_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_storage_to_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_xfer_to_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_storage_to_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_to_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_to_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_storage_to_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_xfer_to_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_to_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_retransn_to_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafc_to_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_leafc_storage_to_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_leafc_xfer_to_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_to_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_storage_to_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_to_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_to_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_storage_to_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_xfer_to_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_to_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_to_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! +! m_leafn_to_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafn_storage_to_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafn_xfer_to_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_to_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_storage_to_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_to_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_to_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_storage_to_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_xfer_to_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_to_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_to_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_retransn_to_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) end if ! mortality due to fire ! carbon pools @@ -1214,87 +1214,87 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte fm_other(patch%itype(p)) else - m_leafc_to_litter_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic, & - f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_litter_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic, & - f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_deadstemc_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_ideadstem_fic,& - f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_to_litter_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic, & - f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_to_litter_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic, & - f * fm_root(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_litter_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic, & - f * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_ideadcroot_fic,& - f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic, & - f * m * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - - m_leafn_to_litter_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin, & - f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_litter_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin, & - f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_deadstemn_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_ideadstem_fin,& - f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_to_litter_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin, & - f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_to_litter_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin, & - f * fm_root(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_litter_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin, & - f * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_ideadcroot_fin,& - f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin, & - f * m * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafc_to_litter_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic, & +! f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_to_litter_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic, & +! f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_to_deadstemc_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_ideadstem_fic,& +! f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_to_litter_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic, & +! f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_to_litter_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic, & +! f * fm_root(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_to_litter_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic, & +! f * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_ideadcroot_fic,& +! f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic, & +! f * m * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! +! m_leafn_to_litter_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin, & +! f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_to_litter_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin, & +! f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_to_deadstemn_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_ideadstem_fin,& +! f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_to_litter_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin, & +! f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_to_litter_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin, & +! f * fm_root(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_to_litter_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin, & +! f * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_ideadcroot_fin,& +! f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin, & +! f * m * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) !KO ! This term is not currently in the matrix code version of CNFireBaseMod, but there are non-matrix terms for this ! in CNFireLi2014Mod and in CNFireBaseMod in ctsm5.1.dev012. I'm not adding it here because tests are passing without it. @@ -1414,22 +1414,22 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte if ( is_litter(l) ) then m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * f * 0.5_r8 if(use_soil_matrixcn)then - associate( & - matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] - ) - matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) - f * 0.5_r8 * dt - end associate +! associate( & +! matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] +! ) +! matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) - f * 0.5_r8 * dt +! end associate end if end if if ( is_cwd(l) ) then m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * & (f-baf_crop(c)) * 0.25_r8 if(use_soil_matrixcn)then - associate( & - matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] - ) - matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) - (f-baf_crop(c)) * 0.25_r8 * dt - end associate +! associate( & +! matrix_decomp_fire_k => soilbiogeochem_carbonflux_inst%matrix_decomp_fire_k_col & ! Output: [real(r8) (:,:) ] +! ) +! matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) = matrix_decomp_fire_k(c,j+nlevdecomp*(l-1)) - (f-baf_crop(c)) * 0.25_r8 * dt +! end associate end if end if end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 index 19407316f..e7e2f5bad 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 @@ -29,7 +29,7 @@ module CNGapMortalityMod ideadstem,ideadstem_st,ideadstem_xf,& ilivecroot,ilivecroot_st,ilivecroot_xf,& ideadcroot,ideadcroot_st,ideadcroot_xf,iretransn,ioutc,ioutn - use CNVegMatrixMod , only : matrix_update_gmc, matrix_update_gmn + ! use CNVegMatrixMod , only : matrix_update_gmc, matrix_update_gmn ! implicit none private @@ -243,18 +243,18 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * m cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * m else - cnveg_carbonflux_inst%m_leafc_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_patch(p) * matrix_update_gmc(p,ileaf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_frootc_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) * matrix_update_gmc(p,ifroot_to_iout_gmc,m,dt,cnveg_carbonflux_inst,.true.,.True.) - cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * matrix_update_gmc(p,ilivestem_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * matrix_update_gmc(p,ilivecroot_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_leafc_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_patch(p) * matrix_update_gmc(p,ileaf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_frootc_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) * matrix_update_gmc(p,ifroot_to_iout_gmc,m,dt,cnveg_carbonflux_inst,.true.,.True.) +! cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * matrix_update_gmc(p,ilivestem_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * matrix_update_gmc(p,ilivecroot_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) end if if(.not. use_matrixcn)then cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m * spinup_factor_deadwood cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m * spinup_factor_deadwood else - cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * matrix_update_gmc(p,ideadstem_to_iout_gmc, & - m*spinup_factor_deadwood,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * matrix_update_gmc(p,ideadcroot_to_iout_gmc, & +! cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * matrix_update_gmc(p,ideadstem_to_iout_gmc, & +! m*spinup_factor_deadwood,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * matrix_update_gmc(p,ideadcroot_to_iout_gmc, & m*spinup_factor_deadwood,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) end if !use_matrixcn @@ -277,23 +277,23 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) * m cnveg_carbonflux_inst%m_gresp_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%gresp_xfer_patch(p) * m else - ! NOTE: The non-matrix version of this is in CNCStateUpdate2Mod CStateUpdate2 (EBK 11/25/2019) - - ! storage pools - cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) * matrix_update_gmc(p,ileafst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_storage_patch(p) * matrix_update_gmc(p,ifrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_storage_patch(p) * matrix_update_gmc(p,ilivestemst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_storage_patch(p) * matrix_update_gmc(p,ideadstemst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_storage_patch(p) * matrix_update_gmc(p,ilivecrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_storage_patch(p) * matrix_update_gmc(p,ideadcrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - - ! transfer pools - cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_xfer_patch(p) * matrix_update_gmc(p,ileafxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_xfer_patch(p) * matrix_update_gmc(p,ifrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_xfer_patch(p) * matrix_update_gmc(p,ilivestemxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_xfer_patch(p) * matrix_update_gmc(p,ideadstemxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_xfer_patch(p) * matrix_update_gmc(p,ilivecrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) - cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) * matrix_update_gmc(p,ideadcrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! ! NOTE: The non-matrix version of this is in CNCStateUpdate2Mod CStateUpdate2 (EBK 11/25/2019) +! +! ! storage pools +! cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) * matrix_update_gmc(p,ileafst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_storage_patch(p) * matrix_update_gmc(p,ifrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_storage_patch(p) * matrix_update_gmc(p,ilivestemst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_storage_patch(p) * matrix_update_gmc(p,ideadstemst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_storage_patch(p) * matrix_update_gmc(p,ilivecrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_storage_patch(p) * matrix_update_gmc(p,ideadcrootst_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! +! ! transfer pools +! cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_xfer_patch(p) * matrix_update_gmc(p,ileafxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_xfer_patch(p) * matrix_update_gmc(p,ifrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_xfer_patch(p) * matrix_update_gmc(p,ilivestemxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_xfer_patch(p) * matrix_update_gmc(p,ideadstemxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_xfer_patch(p) * matrix_update_gmc(p,ilivecrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) +! cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) * matrix_update_gmc(p,ideadcrootxf_to_iout_gmc,m,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) end if !use_matrixcn !------------------------------------------------------ @@ -307,10 +307,10 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) * m cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) * m else - cnveg_nitrogenflux_inst%m_leafn_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_patch(p) * matrix_update_gmn(p,ileaf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_frootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_patch(p) * matrix_update_gmn(p,ifroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,.true.,.True.) - cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) * matrix_update_gmn(p,ilivestem_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) * matrix_update_gmn(p,ilivecroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_leafn_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_patch(p) * matrix_update_gmn(p,ileaf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_frootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_patch(p) * matrix_update_gmn(p,ifroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,.true.,.True.) +! cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) * matrix_update_gmn(p,ilivestem_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) * matrix_update_gmn(p,ilivecroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) end if if (spinup_state == 2 .and. .not. use_cndv) then !accelerate mortality of dead woody pools @@ -318,9 +318,9 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m * spinup_factor_deadwood cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m * spinup_factor_deadwood else - cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * matrix_update_gmn(p,ideadstem_to_iout_gmn , & - m*spinup_factor_deadwood,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * matrix_update_gmn(p,ideadcroot_to_iout_gmn, & +! cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * matrix_update_gmn(p,ideadstem_to_iout_gmn , & +! m*spinup_factor_deadwood,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * matrix_update_gmn(p,ideadcroot_to_iout_gmn, & m*spinup_factor_deadwood,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) end if !.not. use_matrixcn else @@ -328,8 +328,8 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m else - cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * matrix_update_gmn(p,ideadstem_to_iout_gmn ,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * matrix_update_gmn(p,ideadcroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * matrix_update_gmn(p,ideadstem_to_iout_gmn ,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * matrix_update_gmn(p,ideadcroot_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) end if !use_matrixcn end if @@ -358,21 +358,21 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) * m cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) * m else - ! storage pools - cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_storage_patch(p) * matrix_update_gmn(p,ileafst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_storage_patch(p) * matrix_update_gmn(p,ifrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_storage_patch(p) * matrix_update_gmn(p,ilivestemst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) * matrix_update_gmn(p,ideadstemst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) * matrix_update_gmn(p,ilivecrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) * matrix_update_gmn(p,ideadcrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - - ! transfer pools - cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_xfer_patch(p) * matrix_update_gmn(p,ileafxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_xfer_patch(p) * matrix_update_gmn(p,ifrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) * matrix_update_gmn(p,ilivestemxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) * matrix_update_gmn(p,ideadstemxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) * matrix_update_gmn(p,ilivecrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) - cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) * matrix_update_gmn(p,ideadcrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! ! storage pools +! cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_storage_patch(p) * matrix_update_gmn(p,ileafst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_storage_patch(p) * matrix_update_gmn(p,ifrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_storage_patch(p) * matrix_update_gmn(p,ilivestemst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) * matrix_update_gmn(p,ideadstemst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) * matrix_update_gmn(p,ilivecrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) * matrix_update_gmn(p,ideadcrootst_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! +! ! transfer pools +! cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_xfer_patch(p) * matrix_update_gmn(p,ileafxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_xfer_patch(p) * matrix_update_gmn(p,ifrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) * matrix_update_gmn(p,ilivestemxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) * matrix_update_gmn(p,ideadstemxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) * matrix_update_gmn(p,ilivecrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) +! cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) * matrix_update_gmn(p,ideadcrootxf_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) end if !use_matrixcn ! added by F. Li and S. Levis diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 index e5a170c95..9c1d290cc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 @@ -42,8 +42,8 @@ module CNPhenologyMod use GridcellType , only : grc use PatchType , only : patch use atm2lndType , only : atm2lnd_type - use CNVegMatrixMod , only : matrix_update_phc, matrix_update_phn - use CNVegMatrixMod , only : matrix_update_gmc, matrix_update_gmn + ! use CNVegMatrixMod , only : matrix_update_phc, matrix_update_phn + ! use CNVegMatrixMod , only : matrix_update_gmc, matrix_update_gmn ! implicit none private @@ -632,14 +632,14 @@ subroutine CNEvergreenPhenology (num_soilp, filter_soilp , & tranr=0.0002_r8 ! set carbon fluxes for shifting storage pools to transfer pools if (use_matrixcn) then - leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - if (woody(ivt(p)) == 1.0_r8) then - livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc,tranr/dt ,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc,tranr/dt ,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - end if +! leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! if (woody(ivt(p)) == 1.0_r8) then +! livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc,tranr/dt ,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc,tranr/dt ,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,tranr/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) leafc_storage_to_xfer(p) = tranr * leafc_storage(p)/dt @@ -655,14 +655,14 @@ subroutine CNEvergreenPhenology (num_soilp, filter_soilp , & ! set nitrogen fluxes for shifting storage pools to transfer pools if (use_matrixcn) then - leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - if (woody(ivt(p)) == 1.0_r8) then - livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,tranr/dt ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,tranr/dt ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! if (woody(ivt(p)) == 1.0_r8) then +! livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,tranr/dt ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,tranr/dt ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,tranr/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) leafn_storage_to_xfer(p) = tranr * leafn_storage(p)/dt @@ -678,22 +678,22 @@ subroutine CNEvergreenPhenology (num_soilp, filter_soilp , & t1 = 1.0_r8 / dt if (use_matrixcn) then - leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - - leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - if (woody(ivt(p)) == 1.0_r8) then - livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - - livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! +! leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! if (woody(ivt(p)) == 1.0_r8) then +! livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! +! livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -1058,25 +1058,25 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ! set carbon fluxes for shifting storage pools to transfer pools if(use_matrixcn)then - leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - - if (woody(ivt(p)) == 1.0_r8) then - livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc ,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc ,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt - end if - leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - - if (woody(ivt(p)) == 1.0_r8) then - livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn ,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn ,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! +! if (woody(ivt(p)) == 1.0_r8) then +! livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc ,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc ,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt +! end if +! leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! +! if (woody(ivt(p)) == 1.0_r8) then +! livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn ,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn ,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -1485,23 +1485,23 @@ subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & ! set carbon fluxes for shifting storage pools to transfer pools if (use_matrixcn) then - leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - if (woody(ivt(p)) == 1.0_r8) then - livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - end if - - leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - if (woody(ivt(p)) == 1.0_r8) then - livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! if (woody(ivt(p)) == 1.0_r8) then +! livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,fstor2tran/dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! end if +! +! leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! if (woody(ivt(p)) == 1.0_r8) then +! livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,fstor2tran/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -1626,24 +1626,24 @@ subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & leafc_storage_to_xfer(p) = max(0.0_r8,(leafc_storage(p)-leafc(p))) * bgtr(p) frootc_storage_to_xfer(p) = max(0.0_r8,(frootc_storage(p)-frootc(p))) * bgtr(p) if (use_matrixcn) then - if(leafc_storage(p) .gt. 0)then - leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,& - leafc_storage_to_xfer(p) / leafc_storage(p), dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - leafc_storage_to_xfer(p) = 0 - end if - if(frootc_storage(p) .gt. 0)then - frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,& - frootc_storage_to_xfer(p) / frootc_storage(p), dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - frootc_storage_to_xfer(p) = 0 - end if - if (woody(ivt(p)) == 1.0_r8) then - livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc ,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc ,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - end if +! if(leafc_storage(p) .gt. 0)then +! leafc_storage_to_xfer(p) = leafc_storage(p) * matrix_update_phc(p,ileafst_to_ileafxf_phc,& +! leafc_storage_to_xfer(p) / leafc_storage(p), dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! leafc_storage_to_xfer(p) = 0 +! end if +! if(frootc_storage(p) .gt. 0)then +! frootc_storage_to_xfer(p) = frootc_storage(p) * matrix_update_phc(p,ifrootst_to_ifrootxf_phc,& +! frootc_storage_to_xfer(p) / frootc_storage(p), dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! frootc_storage_to_xfer(p) = 0 +! end if +! if (woody(ivt(p)) == 1.0_r8) then +! livestemc_storage_to_xfer(p) = livestemc_storage(p) * matrix_update_phc(p,ilivestemst_to_ilivestemxf_phc ,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * matrix_update_phc(p,ideadstemst_to_ideadstemxf_phc ,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * matrix_update_phc(p,ilivecrootst_to_ilivecrootxf_phc,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * matrix_update_phc(p,ideadcrootst_to_ideadcrootxf_phc,bgtr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -1658,14 +1658,14 @@ subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & ! set nitrogen fluxes for shifting storage pools to transfer pools if (use_matrixcn) then - leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - if (woody(ivt(p)) == 1.0_r8) then - livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,bgtr(p) ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,bgtr(p) ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! leafn_storage_to_xfer(p) = leafn_storage(p) * matrix_update_phn(p,ileafst_to_ileafxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! frootn_storage_to_xfer(p) = frootn_storage(p) * matrix_update_phn(p,ifrootst_to_ifrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! if (woody(ivt(p)) == 1.0_r8) then +! livestemn_storage_to_xfer(p) = livestemn_storage(p) * matrix_update_phn(p,ilivestemst_to_ilivestemxf_phn,bgtr(p) ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * matrix_update_phn(p,ideadstemst_to_ideadstemxf_phn,bgtr(p) ,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * matrix_update_phn(p,ilivecrootst_to_ilivecrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * matrix_update_phn(p,ideadcrootst_to_ideadcrootxf_phn,bgtr(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -2638,22 +2638,22 @@ subroutine CNOnsetGrowth (num_soilp, filter_soilp, & t1 = 2.0_r8 / (onset_counter(p)) end if if (use_matrixcn)then - leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - if (woody(ivt(p)) == 1.0_r8) then - - livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - - livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! if (woody(ivt(p)) == 1.0_r8) then +! +! livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,t1,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! +! livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,t1,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -2681,22 +2681,22 @@ subroutine CNOnsetGrowth (num_soilp, filter_soilp, & if (bgtr(p) > 0._r8) then if(use_matrixcn)then - leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - if (woody(ivt(p)) == 1.0_r8) then - - livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - - livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! leafc_xfer_to_leafc(p) = leafc_xfer(p) * matrix_update_phc(p,ileafxf_to_ileaf_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! frootc_xfer_to_frootc(p) = frootc_xfer(p) * matrix_update_phc(p,ifrootxf_to_ifroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! leafn_xfer_to_leafn(p) = leafn_xfer(p) * matrix_update_phn(p,ileafxf_to_ileaf_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! frootn_xfer_to_frootn(p) = frootn_xfer(p) * matrix_update_phn(p,ifrootxf_to_ifroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! if (woody(ivt(p)) == 1.0_r8) then +! +! livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) * matrix_update_phc(p,ilivestemxf_to_ilivestem_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) * matrix_update_phc(p,ideadstemxf_to_ideadstem_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) * matrix_update_phc(p,ilivecrootxf_to_ilivecroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) * matrix_update_phc(p,ideadcrootxf_to_ideadcroot_phc,1._r8 / dt,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! +! livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) * matrix_update_phn(p,ilivestemxf_to_ilivestem_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) * matrix_update_phn(p,ideadstemxf_to_ideadstem_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) * matrix_update_phn(p,ilivecrootxf_to_ilivecroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) * matrix_update_phn(p,ideadcrootxf_to_ideadcroot_phn,1._r8 / dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -2872,16 +2872,16 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & leafc_to_litter(p) = t1 * leafc(p)*(1._r8-biofuel_harvfrac(ivt(p))) + cpool_to_leafc(p) if (use_matrixcn) then - if(leafc(p) .gt. 0)then - leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - leafc_to_litter(p) = 0 - end if - if(frootc(p) .gt. 0)then - frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - frootc_to_litter(p) = 0 - end if +! if(leafc(p) .gt. 0)then +! leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! leafc_to_litter(p) = 0 +! end if +! if(frootc(p) .gt. 0)then +! frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! frootc_to_litter(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -2911,43 +2911,43 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & livestemn_to_biofueln(p) = t1 * livestemn(p) * biofuel_harvfrac(ivt(p)) if(use_matrixcn)then - if(grainc(p) .gt. 0)then - grainc_to_out = grainc(p) * matrix_update_phc(p,igrain_to_iout_phc,(grainc_to_seed(p) + grainc_to_food(p)) / grainc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - grainc_to_seed(p) = 0 - grainc_to_food(p) = 0 - end if - if(grainn(p) .gt. 0)then - grainn_to_out = grainn(p) * matrix_update_phn(p,igrain_to_iout_phn,(grainn_to_seed(p) + grainn_to_food(p)) / grainn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - grainn_to_seed(p) = 0 - grainn_to_food(p) = 0 - end if - if(livestemc(p) .gt. 0)then - livestemc_to_litter(p) = livestemc(p) * matrix_update_phc(p,ilivestem_to_iout_phc,livestemc_to_litter(p) / livestemc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - livestemc_to_litter(p) = 0 - end if - if(livestemn(p) .gt. 0)then - livestemn_to_biofueln(p) = livestemn(p) * matrix_update_gmn(p,ilivestem_to_iout_gmn,livestemn_to_biofueln(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - else - livestemn_to_biofueln(p) = 0 - end if - if(leafn(p) > 0)then - leafn_to_biofueln(p) = leafn(p) * matrix_update_gmn(p,ileaf_to_iout_gmn,leafn_to_biofueln(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - else - leafn_to_biofueln(p) = 0 - end if - if (leafc(p) > 0)then - leafc_to_biofuelc(p) = leafc(p) * matrix_update_gmc(p,ileaf_to_iout_gmc,leafc_to_biofuelc(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,.True.) - else - leafc_to_biofuelc(p) = 0 - end if - if(livestemc(p) .gt. 0)then - livestemc_to_biofuelc(p) = livestemc(p) * matrix_update_gmc(p,ilivestem_to_iout_gmc,livestemc_to_biofuelc(p) / livestemc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,.True.) - else - livestemc_to_biofuelc(p) = 0 - end if +! if(grainc(p) .gt. 0)then +! grainc_to_out = grainc(p) * matrix_update_phc(p,igrain_to_iout_phc,(grainc_to_seed(p) + grainc_to_food(p)) / grainc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! grainc_to_seed(p) = 0 +! grainc_to_food(p) = 0 +! end if +! if(grainn(p) .gt. 0)then +! grainn_to_out = grainn(p) * matrix_update_phn(p,igrain_to_iout_phn,(grainn_to_seed(p) + grainn_to_food(p)) / grainn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! grainn_to_seed(p) = 0 +! grainn_to_food(p) = 0 +! end if +! if(livestemc(p) .gt. 0)then +! livestemc_to_litter(p) = livestemc(p) * matrix_update_phc(p,ilivestem_to_iout_phc,livestemc_to_litter(p) / livestemc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! livestemc_to_litter(p) = 0 +! end if +! if(livestemn(p) .gt. 0)then +! livestemn_to_biofueln(p) = livestemn(p) * matrix_update_gmn(p,ilivestem_to_iout_gmn,livestemn_to_biofueln(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! else +! livestemn_to_biofueln(p) = 0 +! end if +! if(leafn(p) > 0)then +! leafn_to_biofueln(p) = leafn(p) * matrix_update_gmn(p,ileaf_to_iout_gmn,leafn_to_biofueln(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! else +! leafn_to_biofueln(p) = 0 +! end if +! if (leafc(p) > 0)then +! leafc_to_biofuelc(p) = leafc(p) * matrix_update_gmc(p,ileaf_to_iout_gmc,leafc_to_biofuelc(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,.True.) +! else +! leafc_to_biofuelc(p) = 0 +! end if +! if(livestemc(p) .gt. 0)then +! livestemc_to_biofuelc(p) = livestemc(p) * matrix_update_gmc(p,ilivestem_to_iout_gmc,livestemc_to_biofuelc(p) / livestemc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,.True.) +! else +! livestemc_to_biofuelc(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -2959,31 +2959,31 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & frootc_to_litter(p) = prev_frootc_to_litter(p) + t1*(frootc(p) - prev_frootc_to_litter(p)*offset_counter(p)) if (use_matrixcn) then - if(leafc(p) .gt. 0)then - leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - leafc_to_litter(p) = 0 - end if - if(frootc(p) .gt. 0)then - frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - frootc_to_litter(p) = 0 - end if - else - ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) - ! and CNNStateUpdate1::NStateUpdate1 - end if !use_matrixcn +! if(leafc(p) .gt. 0)then +! leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! leafc_to_litter(p) = 0 +! end if +! if(frootc(p) .gt. 0)then +! frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! frootc_to_litter(p) = 0 +! end if +! else +! ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) +! ! and CNNStateUpdate1::NStateUpdate1 +! end if !use_matrixcn end if if ( use_fun ) then if(leafc_to_litter(p)*dt.gt.leafc(p))then leafc_to_litter(p) = leafc(p)/dt + cpool_to_leafc(p) if (use_matrixcn) then - if(leafc(p) .gt. 0)then - leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - leafc_to_litter(p) = 0 - end if +! if(leafc(p) .gt. 0)then +! leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,leafc_to_litter(p) / leafc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! leafc_to_litter(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -2991,11 +2991,11 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & if(frootc_to_litter(p)*dt.gt.frootc(p))then frootc_to_litter(p) = frootc(p)/dt + cpool_to_frootc(p) if (use_matrixcn) then - if(frootc(p) .gt. 0)then - frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - else - frootc_to_litter(p) = 0 - end if +! if(frootc(p) .gt. 0)then +! frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,frootc_to_litter(p) / frootc(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! else +! frootc_to_litter(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3018,13 +3018,13 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & leafn_to_litter(p) = leafc_to_litter(p)/leafcn_offset(p) - leafn_to_retransn(p) leafn_to_litter(p) = max(leafn_to_litter(p),0._r8) if (use_matrixcn) then - if(leafn(p) .gt. 0)then - leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - leafn_to_litter(p) = 0 - leafn_to_retransn(p) = 0 - end if +! if(leafn(p) .gt. 0)then +! leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! leafn_to_litter(p) = 0 +! leafn_to_retransn(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -3048,13 +3048,13 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) if (use_matrixcn) then - if(leafn(p) .gt. 0)then - leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - leafn_to_litter(p) = 0 - leafn_to_retransn(p) = 0 - end if +! if(leafn(p) .gt. 0)then +! leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! leafn_to_litter(p) = 0 +! leafn_to_retransn(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3063,11 +3063,11 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & ! calculate fine root N litterfall (no retranslocation of fine root N) frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) if (use_matrixcn) then - if(frootn(p) .gt. 0)then - frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - frootn_to_litter(p) = 0 - end if +! if(frootn(p) .gt. 0)then +! frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! frootn_to_litter(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3082,13 +3082,13 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & leafn_to_litter(p) = fr_leafn_to_litter * ntovr_leaf leafn_to_retransn(p) = ntovr_leaf - leafn_to_litter(p) if (use_matrixcn) then - if(leafn(p) .gt. 0)then - leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - leafn_to_litter(p) = 0 - leafn_to_retransn(p) = 0 - end if +! if(leafn(p) .gt. 0)then +! leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! leafn_to_litter(p) = 0 +! leafn_to_retransn(p) = 0 +! end if end if !use_matrixcn if (frootc(p) == 0.0_r8) then frootn_to_litter(p) = 0.0_r8 @@ -3096,11 +3096,11 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & frootn_to_litter(p) = frootc_to_litter(p) * (frootn(p) / frootc(p)) end if if (use_matrixcn) then - if(frootn(p) .gt. 0)then - frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - frootn_to_litter(p) = 0 - end if +! if(frootn(p) .gt. 0)then +! frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! frootn_to_litter(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3111,7 +3111,7 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & if (.not. use_matrixcn) then frootn_to_litter(p) = frootn(p)/dt else - frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,1._r8/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + ! frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,1._r8/dt,dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) end if endif end if @@ -3122,7 +3122,7 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & ! NOTE(slevis, 2014-12) Beth Drewniak suggested this instead livestemn_to_litter(p) = livestemn(p) / dt * (1._r8 - biofuel_harvfrac(ivt(p))) if(use_matrixcn)then - livestemn_to_litter(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iout_phn, (1._r8- biofuel_harvfrac(ivt(p)))/dt, dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + ! livestemn_to_litter(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iout_phn, (1._r8- biofuel_harvfrac(ivt(p)))/dt, dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) end if end if @@ -3244,8 +3244,8 @@ subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & leafc_to_litter(p) = bglfr(p) * leafc(p) frootc_to_litter(p) = bglfr(p) * frootc(p) if (use_matrixcn) then - leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,bglfr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - frootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,bglfr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + ! leafc_to_litter(p) = leafc(p) * matrix_update_phc(p,ileaf_to_iout_phc,bglfr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + ! x_updatefrootc_to_litter(p) = frootc(p) * matrix_update_phc(p,ifroot_to_iout_phc,bglfr(p),dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) end if if ( use_fun ) then leafc_to_litter_fun(p) = leafc_to_litter(p) @@ -3262,10 +3262,10 @@ subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & leafn_to_litter(p) = leafc_to_litter(p)/leafcn_offset(p) - leafn_to_retransn(p) leafn_to_litter(p) = max(leafn_to_litter(p),0._r8) if(use_matrixcn)then - if(leafn(p) .ne. 0._r8)then - leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! if(leafn(p) .ne. 0._r8)then +! leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3289,10 +3289,10 @@ subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) if (use_matrixcn) then - if(leafn(p) .ne. 0)then - leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! if(leafn(p) .ne. 0)then +! leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3311,13 +3311,13 @@ subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & leafn_to_litter(p) = fr_leafn_to_litter * ntovr_leaf leafn_to_retransn(p) = ntovr_leaf - leafn_to_litter(p) if (use_matrixcn) then - if(leafn(p) .gt. 0)then - leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - leafn_to_litter(p) = 0 - leafn_to_retransn(p) = 0 - end if +! if(leafn(p) .gt. 0)then +! leafn_to_litter(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iout_phn,leafn_to_litter(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! leafn_to_litter(p) = 0 +! leafn_to_retransn(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3335,9 +3335,9 @@ subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & end if if (use_matrixcn) then - if(frootn(p) .ne. 0)then - frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if +! if(frootn(p) .ne. 0)then +! frootn_to_litter(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iout_phn,frootn_to_litter(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3454,12 +3454,12 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & livestemc_to_deadstemc(p) = ctovr livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p)) if( use_matrixcn)then - livestemc_to_deadstemc(p) = livestemc(p) * matrix_update_phc(p,ilivestem_to_ideadstem_phc,lwtop,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - if (livestemn(p) .gt. 0.0_r8) then - livestemn_to_deadstemn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_ideadstem_phn,livestemn_to_deadstemn(p)/livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - livestemn_to_deadstemn(p) = 0 - end if +! livestemc_to_deadstemc(p) = livestemc(p) * matrix_update_phc(p,ilivestem_to_ideadstem_phc,lwtop,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) +! if (livestemn(p) .gt. 0.0_r8) then +! livestemn_to_deadstemn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_ideadstem_phn,livestemn_to_deadstemn(p)/livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! livestemn_to_deadstemn(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) ! and CNNStateUpdate1::NStateUpdate1 @@ -3474,12 +3474,12 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & end if if (use_matrixcn)then - if (livestemn(p) .gt. 0.0_r8) then - livestemn_to_deadstemn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_ideadstem_phn,& - livestemn_to_deadstemn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - else - livestemn_to_deadstemn(p) = 0 - end if +! if (livestemn(p) .gt. 0.0_r8) then +! livestemn_to_deadstemn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_ideadstem_phn,& +! livestemn_to_deadstemn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! else +! livestemn_to_deadstemn(p) = 0 +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if @@ -3498,8 +3498,8 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & livecrootc_to_deadcrootc(p) = ctovr livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p)) else - livecrootc_to_deadcrootc(p) = livecrootc(p) * matrix_update_phc(p,ilivecroot_to_ideadcroot_phc,lwtop,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) - livecrootn_to_deadcrootn(p) = livecrootn(p) * matrix_update_phn(p,ilivecroot_to_ideadcroot_phn,lwtop/deadwdcn(ivt(p)),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) + ! livecrootc_to_deadcrootc(p) = livecrootc(p) * matrix_update_phc(p,ilivecroot_to_ideadcroot_phc,lwtop,dt,cnveg_carbonflux_inst,matrixcheck_ph,acc_ph) + ! livecrootn_to_deadcrootn(p) = livecrootn(p) * matrix_update_phn(p,ilivecroot_to_ideadcroot_phn,lwtop/deadwdcn(ivt(p)),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) end if !use_matrixcn if (CNratio_floating .eqv. .true.) then @@ -3512,10 +3512,10 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & end if if (use_matrixcn)then - if (livecrootn(p) .ne.0.0_r8 )then - livecrootn_to_deadcrootn(p) = matrix_update_phn(p,ilivecroot_to_ideadcroot_phn,& - livecrootn_to_deadcrootn(p) / livecrootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livecrootn(p) - end if +! if (livecrootn(p) .ne.0.0_r8 )then +! livecrootn_to_deadcrootn(p) = matrix_update_phn(p,ilivecroot_to_ideadcroot_phn,& +! livecrootn_to_deadcrootn(p) / livecrootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livecrootn(p) +! end if else ! NOTE: The non matrix version of this is in CNNStateUpdate1::NStateUpdate1 EBK (11/26/2019) end if !use_matrixcn @@ -3523,35 +3523,35 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & livecrootn_to_retransn(p) = ntovr - livecrootn_to_deadcrootn(p) if(use_matrixcn)then - if(livecrootn(p) .gt. 0.0_r8) then - livecrootn_to_retransn(p) = matrix_update_phn(p,ilivecroot_to_iretransn_phn,& - livecrootn_to_retransn(p) / livecrootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livecrootn(p) - else - livecrootn_to_retransn(p) = 0 - end if - if(livestemn(p) .gt. 0.0_r8) then - livestemn_to_retransn(p) = matrix_update_phn(p,ilivestem_to_iretransn_phn,& - livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livestemn(p) - else - livestemn_to_retransn(p) = 0 - end if - ! WW change logic so livestem_retrans goes to npool (via - ! free_retrans flux) - ! this should likely be done more cleanly if it works, i.e. not - ! update fluxes w/ states - ! additional considerations for crop? - ! The non-matrix version of this is in NStateUpdate1 - if (use_fun) then - if (retransn(p) .gt. 0._r8) then - ! The acc matrix check MUST be turned on, or this will - ! fail with Nitrogen balance error EBK 03/11/2021 - free_retransn_to_npool(p) = free_retransn_to_npool(p) + retransn(p) * matrix_update_phn(p,iretransn_to_iout, & - (livestemn_to_retransn(p) + livecrootn_to_retransn(p)) / retransn(p),dt, & - cnveg_nitrogenflux_inst, matrixcheck_ph, acc=.true.) - else - free_retransn_to_npool(p) = 0._r8 - end if - end if +! if(livecrootn(p) .gt. 0.0_r8) then +! livecrootn_to_retransn(p) = matrix_update_phn(p,ilivecroot_to_iretransn_phn,& +! livecrootn_to_retransn(p) / livecrootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livecrootn(p) +! else +! livecrootn_to_retransn(p) = 0 +! end if +! if(livestemn(p) .gt. 0.0_r8) then +! livestemn_to_retransn(p) = matrix_update_phn(p,ilivestem_to_iretransn_phn,& +! livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) * livestemn(p) +! else +! livestemn_to_retransn(p) = 0 +! end if +! ! WW change logic so livestem_retrans goes to npool (via +! ! free_retrans flux) +! ! this should likely be done more cleanly if it works, i.e. not +! ! update fluxes w/ states +! ! additional considerations for crop? +! ! The non-matrix version of this is in NStateUpdate1 +! if (use_fun) then +! if (retransn(p) .gt. 0._r8) then +! ! The acc matrix check MUST be turned on, or this will +! ! fail with Nitrogen balance error EBK 03/11/2021 +! free_retransn_to_npool(p) = free_retransn_to_npool(p) + retransn(p) * matrix_update_phn(p,iretransn_to_iout, & +! (livestemn_to_retransn(p) + livecrootn_to_retransn(p)) / retransn(p),dt, & +! cnveg_nitrogenflux_inst, matrixcheck_ph, acc=.true.) +! else +! free_retransn_to_npool(p) = 0._r8 +! end if +! end if end if !use_matrixcn end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index ad6356297..fce9e1074 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -157,7 +157,7 @@ module CNVegetationFacade procedure, public :: InitAccBuffer procedure, public :: InitAccVars procedure, public :: UpdateAccVars - procedure, public :: Restart + ! procedure, public :: Restart procedure, public :: Init2 ! Do initialization in initialize phase, after subgrid weights are determined procedure, public :: InitEachTimeStep ! Do initializations at the start of each time step @@ -430,106 +430,106 @@ end subroutine UpdateAccVars !----------------------------------------------------------------------- - subroutine Restart(this, bounds, ncid, flag) - ! - ! !DESCRIPTION: - ! Handle restart (read / write) for CNVeg - ! - ! Should be called regardless of whether use_cn is true - ! - ! !USES: - use ncdio_pio, only : file_desc_t - use clm_varcon, only : c3_r2, c14ratio - use clm_varctl, only : use_soil_matrixcn, use_matrixcn - use CNVegMatrixMod, only : CNVegMatrixRest - use CNSoilMatrixMod, only : CNSoilMatrixRest - ! - ! !ARGUMENTS: - class(cn_vegetation_type), intent(inout) :: this - type(bounds_type), intent(in) :: bounds - type(file_desc_t), intent(inout) :: ncid - character(len=*) , intent(in) :: flag - integer :: reseed_patch(bounds%endp-bounds%begp+1) - integer :: num_reseed_patch - ! - ! !LOCAL VARIABLES: - - integer :: begp, endp - real(r8) :: spinup_factor4deadwood ! Spinup factor used for deadwood (dead-stem and dead course root) - - character(len=*), parameter :: subname = 'Restart' - !----------------------------------------------------------------------- - - if (use_cn) then - begp = bounds%begp - endp = bounds%endp - call this%cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c12', & - reseed_dead_plants=this%reseed_dead_plants, filter_reseed_patch=reseed_patch, & - num_reseed_patch=num_reseed_patch, spinup_factor4deadwood=spinup_factor4deadwood ) - if ( flag /= 'read' .and. num_reseed_patch /= 0 )then - call endrun(msg="ERROR num_reseed should be zero and is not"//errmsg(sourcefile, __LINE__)) - end if - if ( flag /= 'read' .and. spinup_factor4deadwood /= 10_r8 )then - call endrun(msg="ERROR spinup_factor4deadwood should be 10 and is not"//errmsg(sourcefile, __LINE__)) - end if - if (use_c13) then - call this%c13_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c13', & - reseed_dead_plants=this%reseed_dead_plants, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) - end if - if (use_c14) then - call this%c14_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c14', & - reseed_dead_plants=this%reseed_dead_plants, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) - end if - - call this%cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c12') - if (use_c13) then - call this%c13_cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c13') - end if - if (use_c14) then - call this%c14_cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c14') - end if - - call this%cnveg_nitrogenstate_inst%restart(bounds, ncid, flag=flag, & - leafc_patch=this%cnveg_carbonstate_inst%leafc_patch(begp:endp), & - leafc_storage_patch=this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), & - frootc_patch=this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & - frootc_storage_patch=this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & - deadstemc_patch=this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp), & - filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch, & - spinup_factor_deadwood=spinup_factor4deadwood ) - call this%cnveg_nitrogenflux_inst%restart(bounds, ncid, flag=flag) - call this%cnveg_state_inst%restart(bounds, ncid, flag=flag, & - cnveg_carbonstate=this%cnveg_carbonstate_inst, & - cnveg_nitrogenstate=this%cnveg_nitrogenstate_inst, & - filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch) - - call this%c_products_inst%restart(bounds, ncid, flag) - if (use_c13) then - call this%c13_products_inst%restart(bounds, ncid, flag, & - template_for_missing_fields = this%c_products_inst, & - template_multiplier = c3_r2) - end if - if (use_c14) then - call this%c14_products_inst%restart(bounds, ncid, flag, & - template_for_missing_fields = this%c_products_inst, & - template_multiplier = c14ratio) - end if - call this%n_products_inst%restart(bounds, ncid, flag) - - if ( use_matrixcn )then - call CNVegMatrixRest( ncid, flag ) - end if - end if - - if ( use_soil_matrixcn )then - call CNSoilMatrixRest( ncid, flag ) - end if - - if (use_cndv) then - call this%dgvs_inst%Restart(bounds, ncid, flag=flag) - end if - - end subroutine Restart +! subroutine Restart(this, bounds, ncid, flag) +! ! +! ! !DESCRIPTION: +! ! Handle restart (read / write) for CNVeg +! ! +! ! Should be called regardless of whether use_cn is true +! ! +! ! !USES: +! use ncdio_pio, only : file_desc_t +! use clm_varcon, only : c3_r2, c14ratio +! use clm_varctl, only : use_soil_matrixcn, use_matrixcn +! use CNVegMatrixMod, only : CNVegMatrixRest +! use CNSoilMatrixMod, only : CNSoilMatrixRest +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type), intent(inout) :: this +! type(bounds_type), intent(in) :: bounds +! type(file_desc_t), intent(inout) :: ncid +! character(len=*) , intent(in) :: flag +! integer :: reseed_patch(bounds%endp-bounds%begp+1) +! integer :: num_reseed_patch +! ! +! ! !LOCAL VARIABLES: +! +! integer :: begp, endp +! real(r8) :: spinup_factor4deadwood ! Spinup factor used for deadwood (dead-stem and dead course root) +! +! character(len=*), parameter :: subname = 'Restart' +! !----------------------------------------------------------------------- +! +! if (use_cn) then +! begp = bounds%begp +! endp = bounds%endp +! call this%cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c12', & +! reseed_dead_plants=this%reseed_dead_plants, filter_reseed_patch=reseed_patch, & +! num_reseed_patch=num_reseed_patch, spinup_factor4deadwood=spinup_factor4deadwood ) +! if ( flag /= 'read' .and. num_reseed_patch /= 0 )then +! call endrun(msg="ERROR num_reseed should be zero and is not"//errmsg(sourcefile, __LINE__)) +! end if +! if ( flag /= 'read' .and. spinup_factor4deadwood /= 10_r8 )then +! call endrun(msg="ERROR spinup_factor4deadwood should be 10 and is not"//errmsg(sourcefile, __LINE__)) +! end if +! if (use_c13) then +! call this%c13_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c13', & +! reseed_dead_plants=this%reseed_dead_plants, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) +! end if +! if (use_c14) then +! call this%c14_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c14', & +! reseed_dead_plants=this%reseed_dead_plants, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) +! end if +! +! call this%cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c12') +! if (use_c13) then +! call this%c13_cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c13') +! end if +! if (use_c14) then +! call this%c14_cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c14') +! end if +! +! call this%cnveg_nitrogenstate_inst%restart(bounds, ncid, flag=flag, & +! leafc_patch=this%cnveg_carbonstate_inst%leafc_patch(begp:endp), & +! leafc_storage_patch=this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), & +! frootc_patch=this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & +! frootc_storage_patch=this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & +! deadstemc_patch=this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp), & +! filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch, & +! spinup_factor_deadwood=spinup_factor4deadwood ) +! call this%cnveg_nitrogenflux_inst%restart(bounds, ncid, flag=flag) +! call this%cnveg_state_inst%restart(bounds, ncid, flag=flag, & +! cnveg_carbonstate=this%cnveg_carbonstate_inst, & +! cnveg_nitrogenstate=this%cnveg_nitrogenstate_inst, & +! filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch) +! +! call this%c_products_inst%restart(bounds, ncid, flag) +! if (use_c13) then +! call this%c13_products_inst%restart(bounds, ncid, flag, & +! template_for_missing_fields = this%c_products_inst, & +! template_multiplier = c3_r2) +! end if +! if (use_c14) then +! call this%c14_products_inst%restart(bounds, ncid, flag, & +! template_for_missing_fields = this%c_products_inst, & +! template_multiplier = c14ratio) +! end if +! call this%n_products_inst%restart(bounds, ncid, flag) +! +! if ( use_matrixcn )then +! call CNVegMatrixRest( ncid, flag ) +! end if +! end if +! +! if ( use_soil_matrixcn )then +! call CNSoilMatrixRest( ncid, flag ) +! end if +! +! if (use_cndv) then +! call this%dgvs_inst%Restart(bounds, ncid, flag=flag) +! end if +! +! end subroutine Restart !----------------------------------------------------------------------- subroutine Init2(this, bounds, NLFilename) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 index 1e9e77ae3..83df830b8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 @@ -216,7 +216,7 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & ilivecroot,ilivecroot_st,ilivecroot_xf,& ideadcroot,ideadcroot_st,ideadcroot_xf,& igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn,nvegnpool - use CNVegMatrixMod , only : matrix_update_phn + ! use CNVegMatrixMod , only : matrix_update_phn ! ! !ARGUMENTS: @@ -501,11 +501,11 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) if(use_matrixcn)then - associate( & - matrix_Ninput => cnveg_nitrogenflux_inst%matrix_Ninput_patch & ! N input of matrix - ) - matrix_Ninput(p) = sminn_to_npool(p)! + retransn_to_npool(p) - end associate +! associate( & +! matrix_Ninput => cnveg_nitrogenflux_inst%matrix_Ninput_patch & ! N input of matrix +! ) +! matrix_Ninput(p) = sminn_to_npool(p)! + retransn_to_npool(p) +! end associate end if if(.not.use_fun)then @@ -516,10 +516,10 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & excess_cflux(p) = availc(p) - plant_calloc(p) if(use_matrixcn)then - associate( & - matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch & ! C input of matrix - ) - matrix_Cinput(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) +! associate( & +! matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch & ! C input of matrix +! ) +! matrix_Cinput(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) end associate end if @@ -1278,26 +1278,26 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & matrix_Ninput(p) = npool_to_veg - retransn_to_npool(p) else if(retransn(p) .ne. 0)then - retransn_to_npool(p) = retransn(p) * matrix_update_phn(p,iretransn_to_iout,retransn_to_npool(p)/retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) + ! retransn_to_npool(p) = retransn(p) * matrix_update_phn(p,iretransn_to_iout,retransn_to_npool(p)/retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) end if end if if(retransn(p) .ne. 0)then - tmp = matrix_update_phn(p,iretransn_to_ileaf ,matrix_nalloc(p,ileaf ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ileafst ,matrix_nalloc(p,ileaf_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ifroot ,matrix_nalloc(p,ifroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ifrootst ,matrix_nalloc(p,ifroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ilivestem ,matrix_nalloc(p,ilivestem ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ilivestemst ,matrix_nalloc(p,ilivestem_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ideadstem ,matrix_nalloc(p,ideadstem ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ideadstemst ,matrix_nalloc(p,ideadstem_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ilivecroot ,matrix_nalloc(p,ilivecroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ilivecrootst ,matrix_nalloc(p,ilivecroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ideadcroot ,matrix_nalloc(p,ideadcroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_ideadcrootst ,matrix_nalloc(p,ideadcroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - if(ivt(p) >= npcropmin)then - tmp = matrix_update_phn(p,iretransn_to_igrain ,matrix_nalloc(p,igrain ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - tmp = matrix_update_phn(p,iretransn_to_igrainst ,matrix_nalloc(p,igrain_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ileaf ,matrix_nalloc(p,ileaf ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ileafst ,matrix_nalloc(p,ileaf_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ifroot ,matrix_nalloc(p,ifroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ifrootst ,matrix_nalloc(p,ifroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ilivestem ,matrix_nalloc(p,ilivestem ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ilivestemst ,matrix_nalloc(p,ilivestem_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ideadstem ,matrix_nalloc(p,ideadstem ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ideadstemst ,matrix_nalloc(p,ideadstem_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ilivecroot ,matrix_nalloc(p,ilivecroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ilivecrootst ,matrix_nalloc(p,ilivecroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ideadcroot ,matrix_nalloc(p,ideadcroot ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_ideadcrootst ,matrix_nalloc(p,ideadcroot_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! if(ivt(p) >= npcropmin)then +! tmp = matrix_update_phn(p,iretransn_to_igrain ,matrix_nalloc(p,igrain ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) +! tmp = matrix_update_phn(p,iretransn_to_igrainst ,matrix_nalloc(p,igrain_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) end if end if end associate @@ -1403,7 +1403,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ilivecroot,ilivecroot_st,ilivecroot_xf,& ideadcroot,ideadcroot_st,ideadcroot_xf,& igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn - use CNVegMatrixMod , only : matrix_update_phn + ! use CNVegMatrixMod , only : matrix_update_phn ! !ARGUMENTS: class(nutrient_competition_FlexibleCN_type), intent(inout) :: this type(bounds_type) , intent(in) :: bounds @@ -1790,14 +1790,14 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & end if grain_flag(p) = 1._r8 if(use_matrixcn)then - if(leafn(p) .ne. 0._r8)then - leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if - if(frootn(p) .ne. 0._r8)then - frootn_to_retransn(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iretransn_phn,frootn_to_retransn(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if - if(livestemn(p) .ne. 0._r8)then - livestemn_to_retransn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iretransn_phn,livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! if(leafn(p) .ne. 0._r8)then +! leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn_phn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if +! if(frootn(p) .ne. 0._r8)then +! frootn_to_retransn(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iretransn_phn,frootn_to_retransn(p) / frootn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) +! end if +! if(livestemn(p) .ne. 0._r8)then +! livestemn_to_retransn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iretransn_phn,livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) end if end if From d99108c9f190a30a9b19c65fa7772729783ca5ec Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 10:08:45 -0500 Subject: [PATCH 217/589] add missing variables --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 2d9afcfd9..8deac7eab 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -42,6 +42,8 @@ module pftconMod integer, public :: nc3crop = 15 ! C3_crop [moisture + deciduous] integer, public :: npcropmin = 15 ! value for first crop functional type (not including the more generic C3 crop PFT) + integer, public :: nc3irrig = 16 ! value for irrigated generic crop (ir) + integer, public :: npcropmax ! value for last prognostic crop in list ! type, public :: pftcon_type @@ -788,7 +790,7 @@ subroutine init_pftcon_type(this) call ncd_io('max_SH_planting_date', this%mxSHplantdate, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - + npcropmax = mxpft ! last prognostic crop in list do m = 0,mxpft this%dwood(m) = dwood From 6b8aad64b632564504fd375a5e632d1ee91c3970 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 10:09:05 -0500 Subject: [PATCH 218/589] correct read statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 index 964e2b05c..35c9357a0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNMRespMod.F90 @@ -128,13 +128,8 @@ subroutine readParams ( ncid ) !----------------------------------------------------------------------- tString='br_mr' - ierr = NF90_INQ_VARID(ncid,trim(tString),clm_varid) - ierr = NF90_GET_VAR(ncid, clm_varid, tempr) - - ! call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - ! if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - if ( ierr/=0 ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) params_inst%br=tempr if ( params_inst%br_root == spval ) then From e82d7fac671299a58978223e40ce19632621cb16 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 10:09:55 -0500 Subject: [PATCH 219/589] file containing variables and types for sire emission calculations --- .../CLM51/shr_fire_emis_mod.F90 | 299 ++++++++++++++++++ 1 file changed, 299 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_fire_emis_mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_fire_emis_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_fire_emis_mod.F90 new file mode 100755 index 000000000..4243d580b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_fire_emis_mod.F90 @@ -0,0 +1,299 @@ +!================================================================================ +! Coordinates carbon emissions fluxes from CLM fires for use as sources of +! chemical constituents in CAM +! +! This module reads fire_emis_nl namelist which specifies the compound fluxes +! that are to be passed through the model coupler. +!================================================================================ +module shr_fire_emis_mod + + use shr_kind_mod,only : r8 => shr_kind_r8 + use shr_kind_mod,only : CL => SHR_KIND_CL, CX => SHR_KIND_CX, CS => SHR_KIND_CS + use shr_sys_mod, only : shr_sys_abort + use shr_log_mod, only : loglev => shr_log_Level + + implicit none + save + private + + ! public :: shr_fire_emis_readnl ! reads fire_emis_nl namelist + public :: shr_fire_emis_mechcomps ! points to an array of chemical compounds (in CAM-Chem mechanism) than have fire emissions + public :: shr_fire_emis_mechcomps_n ! number of unique compounds in the CAM chemical mechanism that have fire emissions + public :: shr_fire_emis_comps_n ! number of unique emissions components + public :: shr_fire_emis_linkedlist ! points to linked list of shr_fire_emis_comp_t objects + public :: shr_fire_emis_elevated ! elevated emissions in ATM + public :: shr_fire_emis_comp_ptr ! user defined type that points to fire emis data obj (shr_fire_emis_comp_t) + public :: shr_fire_emis_comp_t ! emission component data type + public :: shr_fire_emis_mechcomp_t ! data type for chemical compound in CAM mechanism than has fire emissions + + logical :: shr_fire_emis_elevated = .true. + + character(len=CS), public :: shr_fire_emis_fields_token = '' ! emissions fields token + character(len=CL), public :: shr_fire_emis_factors_file = '' ! a table of basic fire emissions compounds + character(len=CS), public :: shr_fire_emis_ztop_token = 'Sl_fztop' ! token for emissions top of vertical distribution + integer, parameter :: name_len=16 + ! fire emissions component data structure (or user defined type) + type shr_fire_emis_comp_t + character(len=name_len) :: name ! emissions component name (in fire emissions input table) + integer :: index + real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) + real(r8) :: coeff ! emissions component coeffecient + real(r8) :: molec_weight ! molecular weight of the fire emissions compound (g/mole) + type(shr_fire_emis_comp_t), pointer :: next_emiscomp ! points to next member in the linked list + endtype shr_fire_emis_comp_t + + type shr_fire_emis_comp_ptr + type(shr_fire_emis_comp_t), pointer :: ptr ! points to fire emis data obj (shr_fire_emis_comp_t) + endtype shr_fire_emis_comp_ptr + + ! chemical compound in CAM mechanism that has fire emissions + type shr_fire_emis_mechcomp_t + character(len=name_len) :: name ! compound name + type(shr_fire_emis_comp_ptr), pointer :: emis_comps(:) ! an array of pointers to fire emis components + integer :: n_emis_comps ! number of fire emis compounds that make up the emissions for this mechanis compound + end type shr_fire_emis_mechcomp_t + + type(shr_fire_emis_mechcomp_t), pointer :: shr_fire_emis_mechcomps(:) ! array of chemical compounds (in CAM mechanism) that have fire emissions + type(shr_fire_emis_comp_t), pointer :: shr_fire_emis_linkedlist ! points to linked list top + + integer :: shr_fire_emis_comps_n = 0 ! number of unique fire components + integer :: shr_fire_emis_mechcomps_n = 0 ! number of unique compounds in the CAM chemical mechanism that have fire emissions + +contains + + !------------------------------------------------------------------------- + ! + ! This reads the fire_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + ! + ! Namelist variables: + ! fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated + ! + ! fire_emis_specifier (array of strings) -- Each array element specifies + ! how CAM-Chem constituents are mapped to basic smoke compounds in + ! the fire emissions factors table (fire_emis_factors_file). Each + ! chemistry constituent name (left of '=' sign) is mapped to one or more + ! smoke compound (separated by + sign if more than one), which can be + ! proceeded by a multiplication factor (separated by '*'). + ! Example: + ! fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC','SO2 = SO2' + ! + ! fire_emis_factors_file (string) -- Input file that contains the table + ! of basic compounds that make up the smoke from the CLM fires. This is + ! used in CLM module FireEmisFactorsMod. + ! + ! fire_emis_elevated (locical) -- If true then CAM-Chem treats the fire + ! emission sources as 3-D vertically distributed forcings for the + ! corresponding chemical tracers. + ! + !------------------------------------------------------------------------- +! subroutine shr_fire_emis_readnl( NLFileName, ID, emis_fields ) +! +! use shr_nl_mod, only : shr_nl_find_group_name +! use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit +! use seq_comm_mct, only : seq_comm_iamroot, seq_comm_setptrs, logunit +! use shr_mpi_mod, only : shr_mpi_bcast +! +! character(len=*), intent(in) :: NLFileName ! name of namelist file +! integer , intent(in) :: ID ! seq_comm ID +! character(len=*), intent(out) :: emis_fields ! emis flux fields +! +! integer :: unitn ! namelist unit number +! integer :: ierr ! error code +! logical :: exists ! if file exists or not +! integer :: mpicom ! MPI communicator +! +! integer, parameter :: maxspc = 100 +! +! character(len=2*CX) :: fire_emis_specifier(maxspc) = ' ' +! character(len=CL) :: fire_emis_factors_file = ' ' +! +! character(*),parameter :: F00 = "('(shr_fire_emis_readnl) ',2a)" +! +! logical :: fire_emis_elevated = .true. +! +! namelist /fire_emis_nl/ fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated +! +! call seq_comm_setptrs(ID,mpicom=mpicom) +! if (seq_comm_iamroot(ID)) then +! +! inquire( file=trim(NLFileName), exist=exists) +! +! if ( exists ) then +! +! unitn = shr_file_getUnit() +! open( unitn, file=trim(NLFilename), status='old' ) +! if ( loglev > 0 ) write(logunit,F00) & +! 'Read in fire_emis_readnl namelist from: ', trim(NLFilename) +! +! call shr_nl_find_group_name(unitn, 'fire_emis_nl', status=ierr) +! ! If ierr /= 0, no namelist present. +! +! if (ierr == 0) then +! read(unitn, fire_emis_nl, iostat=ierr) +! +! if (ierr > 0) then +! call shr_sys_abort( 'problem on read of fire_emis_nl namelist in shr_fire_emis_readnl' ) +! endif +! endif +! +! close( unitn ) +! call shr_file_freeUnit( unitn ) +! end if +! end if +! call shr_mpi_bcast( fire_emis_specifier, mpicom) +! call shr_mpi_bcast( fire_emis_factors_file, mpicom) +! call shr_mpi_bcast( fire_emis_elevated, mpicom) +! +! shr_fire_emis_factors_file = fire_emis_factors_file +! shr_fire_emis_elevated = fire_emis_elevated +! +! ! parse the namelist info and initialize the module data +! call shr_fire_emis_init( fire_emis_specifier, emis_fields ) +! +! end subroutine shr_fire_emis_readnl + + !----------------------------------------------------------------------- + ! module data initializer + !------------------------------------------------------------------------ +! subroutine shr_fire_emis_init( specifier, emis_fields ) +! +! use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy +! +! character(len=*), intent(in) :: specifier(:) +! character(len=*), intent(out) :: emis_fields +! +! integer :: n_entries +! integer :: i, j, k +! +! type(shr_exp_item_t), pointer :: items_list, item +! character(len=12) :: token ! fire emis field name to add +! +! nullify(shr_fire_emis_linkedlist) +! +! items_list => shr_exp_parse( specifier, nitems=n_entries ) +! +! allocate(shr_fire_emis_mechcomps(n_entries)) +! shr_fire_emis_mechcomps(:)%n_emis_comps = 0 +! +! emis_fields = '' +! +! item => items_list +! i = 1 +! do while(associated(item)) +! +! do k=1,shr_fire_emis_mechcomps_n +! if ( trim(shr_fire_emis_mechcomps(k)%name) == trim(item%name) ) then +! call shr_sys_abort( 'shr_fire_emis_init : multiple emissions definitions specified for : '//trim(item%name)) +! endif +! enddo +! if (len_trim(item%name) .le. name_len) then +! shr_fire_emis_mechcomps(i)%name = item%name(1:name_len) +! else +! call shr_sys_abort("shr_file_emis_init : name too long for data structure :"//trim(item%name)) +! endif +! shr_fire_emis_mechcomps(i)%n_emis_comps = item%n_terms +! allocate(shr_fire_emis_mechcomps(i)%emis_comps(item%n_terms)) +! +! do j = 1,item%n_terms +! shr_fire_emis_mechcomps(i)%emis_comps(j)%ptr => add_emis_comp( item%vars(j), item%coeffs(j) ) +! enddo +! shr_fire_emis_mechcomps_n = shr_fire_emis_mechcomps_n+1 +! +! write(token,333) shr_fire_emis_mechcomps_n +! +! if ( shr_fire_emis_mechcomps_n == 1 ) then +! ! do not prepend ":" to the string for the first token +! emis_fields = trim(token) +! shr_fire_emis_fields_token = token +! else +! emis_fields = trim(emis_fields)//':'//trim(token) +! endif +! +! item => item%next_item +! i = i+1 +! enddo +! if (associated(items_list)) call shr_exp_list_destroy(items_list) +! +! ! Need to explicitly add Fl_ based on naming convention +!333 format ('Fall_fire',i3.3) +! +! end subroutine shr_fire_emis_init + + !------------------------------------------------------------------------- + ! private methods... + + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + function add_emis_comp( name, coeff ) result(emis_comp) + + character(len=*), intent(in) :: name + real(r8), intent(in) :: coeff + type(shr_fire_emis_comp_t), pointer :: emis_comp + + emis_comp => get_emis_comp_by_name(shr_fire_emis_linkedlist, name) + if(associated(emis_comp)) then + ! already in the list so return... + return + endif + + ! create new emissions component and add it to the list + allocate(emis_comp) + + ! element%index = lookup_element( name ) + ! element%emis_factors = get_factors( list_elem%index ) + + emis_comp%index = shr_fire_emis_comps_n+1 + + emis_comp%name = trim(name) + emis_comp%coeff = coeff + nullify(emis_comp%next_emiscomp) + + call add_emis_comp_to_list(emis_comp) + + end function add_emis_comp + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + recursive function get_emis_comp_by_name(list_comp, name) result(emis_comp) + + type(shr_fire_emis_comp_t), pointer :: list_comp + character(len=*), intent(in) :: name ! variable name + type(shr_fire_emis_comp_t), pointer :: emis_comp ! returned object + + if(associated(list_comp)) then + if(list_comp%name .eq. name) then + emis_comp => list_comp + else + emis_comp => get_emis_comp_by_name(list_comp%next_emiscomp, name) + end if + else + nullify(emis_comp) + end if + + end function get_emis_comp_by_name + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + subroutine add_emis_comp_to_list( new_emis_comp ) + + type(shr_fire_emis_comp_t), target, intent(in) :: new_emis_comp + + type(shr_fire_emis_comp_t), pointer :: list_comp + + if(associated(shr_fire_emis_linkedlist)) then + list_comp => shr_fire_emis_linkedlist + do while(associated(list_comp%next_emiscomp)) + list_comp => list_comp%next_emiscomp + end do + list_comp%next_emiscomp => new_emis_comp + else + shr_fire_emis_linkedlist => new_emis_comp + end if + + shr_fire_emis_comps_n = shr_fire_emis_comps_n + 1 + + end subroutine add_emis_comp_to_list + +endmodule shr_fire_emis_mod From b7189e18f92af1dccc5f315e9e10c3cd882830b3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 10:29:30 -0500 Subject: [PATCH 220/589] add missing use statements --- .../GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 index 11e280f2c..3951055ef 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 @@ -10,6 +10,8 @@ module CNFireEmissionsMod use abortutils, only : endrun use PatchType, only : patch use decompMod, only : bounds_type + use shr_fire_emis_mod, only : shr_fire_emis_comps_n, shr_fire_emis_comp_t, shr_fire_emis_linkedlist + use shr_fire_emis_mod, only : shr_fire_emis_mechcomps_n, shr_fire_emis_mechcomps ! implicit none private From bfc69a15578b3c59b506effaa83cba08c69ce1e8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 11:37:24 -0500 Subject: [PATCH 221/589] bug fixes, dimension fixes, cleanup --- .../CLM51/CNCLM51_Photosynthesis.F90 | 87 +++++++++++-------- 1 file changed, 50 insertions(+), 37 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 93d827a2c..90a21de64 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -4,7 +4,8 @@ module CNCLM_Photosynthesis use clm_varpar, only : numpft, numrad, num_veg, num_zon use decompMod, only : bounds_type use PatchType, only : patch - use clm_varcon, only : rair + use pftconMod, only : pftcon + use filterMod, only : clumpfilter use CNVegNitrogenstateType use CNVegCarbonstateType @@ -19,7 +20,7 @@ module CNCLM_Photosynthesis use OzoneBaseMod use PhotosynthesisMod use WaterFluxBulkType - use filterMod, only: filter + use WaterStateType, only : waterstate_type implicit none @@ -80,10 +81,14 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! LOCAL ! temporary and loop variables - integer :: n, p, pft_num, nv, nc, nz, np - real :: bare, elai_pft, esai_pft, tmp_albgrd_vis,tmp_albgrd_nir,& + integer :: n, p, pft_num, nv, nc, nz, np, ib + real :: bare, tmp_albgrd_vis,tmp_albgrd_nir,& tmp_albgri_vis,tmp_albgri_nir + ! filter variables + integer, allocatable, save :: filter_vegsol(:), filter_novegsol(:) + integer :: num_vegsol, num_novegsol + ! constants and parameters real :: rair = MAPL_RDRY real :: extkn = 0.30_r8 ! nitrogen allocation coefficient @@ -96,13 +101,15 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, dimension(nch*NUM_ZON*(numpft+1)) :: laisun_dt, laisha_dt, rssun_dt, rssha_dt ! local variables to compute Photosynthesis inputs + real :: ws, wl + real, allocatable, dimension(:,:) :: rho, tau real, dimension (nch, NUM_ZON) :: esat_tv ! vapor pressure inside leaf (sat vapor press at tc) (Pa) real, dimension (nch, NUM_ZON) :: eair ! vapor pressure of canopy air - real, dimension (nch) :: oair ! Atmospheric O2 partial pressure (Pa) - real, dimension (nch) :: deldT ! d(es)/d(T) - real, dimension (nch) :: cair ! compute CO2 partial pressure - real, dimension (nch) :: rb ! boundary layer resistance (s/m) - real, dimension (nch) :: el ! vapor pressure on leaf surface [pa] + real, dimension (nch) :: oair ! Atmospheric O2 partial pressure (Pa) + real, dimension (nch) :: deldT ! d(es)/d(T) + real, dimension (nch) :: cair ! compute CO2 partial pressure + real, dimension (nch) :: rb ! boundary layer resistance (s/m) + real, dimension (nch) :: el ! vapor pressure on leaf surface [pa] real, dimension (nch, NUM_ZON) :: qsatl ! leaf specific humidity [kg/kg] real, dimension (nch, NUM_ZON) :: qsatldT ! derivative of "qsatl" on "t_veg" real, dimension (nch, NUM_ZON) :: qaf ! canopy air humidity [kg/kg] @@ -124,10 +131,6 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, pointer :: froot_carbon(:) ! fine root carbon (gC/m2) [pft] real, pointer :: croot_carbon(:) ! live coarse root carbon (gC/m2) [pft] - ! other local variables - - integer :: num_vegsol, num_novegsol - ! CLM variables type(bounds_type) :: bounds type(atm2lnd_type) :: atm2lnd_inst @@ -142,10 +145,16 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & type(waterfluxbulk_type) :: waterfluxbulk_inst type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst + type(waterstate_type) :: waterstate_inst + type(clumpfilter) :: filter ! associate variables associate(& + rhol => pftcon%rhol , & ! Input: leaf reflectance: 1=vis, 2=nir + rhos => pftcon%rhos , & ! Input: stem reflectance: 1=vis, 2=nir + taul => pftcon%taul , & ! Input: leaf transmittance: 1=vis, 2=nir + taus => pftcon%taus , & ! Input: stem transmittance: 1=vis, 2=nir vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & f_sun_z => surfalb_inst%fsun_z_patch , & @@ -154,11 +163,25 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & taul => pftcon%taul , & leafn => cnveg_nitrogenstate_inst%leafn_patch , & froot_carbon => cnveg_carbonstate_inst%frootc_patch , & - croot_carbon => cnveg_carbonstate_inst%liverootc_patch, & + croot_carbon => cnveg_carbonstate_inst%livecrootc_patch, & elai => canopystate_inst%elai_patch , & esai => canopystate_inst%esai_patch & ) +! allocate filters +!----------------------------- + + allocate (filter_vegsol(bounds%endp-bounds%begp+1)) + allocate (filter_novegsol(bounds%endp-bounds%begp+1)) + num_vegsol = 0 + num_novegsol = 0 + +! allocate variables for radiation calculations +!--------------------------------- + + allocate(rho(bounds%begp:bounds%endp,numrad)) + allocate(tau(bounds%begp:bounds%endp,numrad)) + ! compute saturation vapor pressure ! --------------------------------- do n = 1,nch @@ -171,7 +194,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & !---------------------------------- do n = 1,nch do nz = 1,NUM_ZON - eair(n,nz) = pbot(n) * qa(n,nz) / (0.622 + qa(n-nz)) ! canopy air vapor pressure (Pa); jk: this is different from the formulation in the CLM code, which is different from the formulation in the CLM documentation + eair(n,nz) = pbot(n) * qa(n,nz) / (0.622 + qa(n,nz)) ! canopy air vapor pressure (Pa); jk: this is different from the formulation in the CLM code, which is different from the formulation in the CLM documentation end do end do ! compute atmospheric O2 partial pressure @@ -192,7 +215,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & do nz = 1,NUM_ZON call QSat(tc(n,nz), pbot(n), qsatl(n,nz), & el(n), & - qsatldT(n)) + qsatldT(n,nz)) end do end do @@ -210,26 +233,23 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & !------------------------------------------------ p = 0 n = 0 - - num_vegsol = 0 - num_novegsol = 0 do nc = 1,nch - atm2lnd_inst%forc_solad (nc,1) = pardir(nc) - atm2lnd_inst%forc_solai (nc,1) = pardif(nc) + atm2lnd_inst%forc_solad_grc (nc,1) = pardir(nc) + atm2lnd_inst%forc_solai_grc (nc,1) = pardif(nc) do nz = 1,num_zon n = n + 1 atm2lnd_inst%forc_pbot_downscaled_col (n) = pbot(nc) atm2lnd_inst%forc_rho_downscaled_col (n) = pbot(nc)-0.378*eair(nc,nz)/(rair*tc(nc,nz)) - soilstate_inst%hk_sat_col (n) = 1000.*COND(nc) ! saturated hydraulic conductivity mapped to CLM space + soilstate_inst%hksat_col (n) = 1000.*COND(nc) ! saturated hydraulic conductivity mapped to CLM space ! and converted to [mm/s] - soilstate_inst%hk_l_col (n) = 1000.*COND(nc)*(wet3(nc)**(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space + soilstate_inst%hk_l_col (n,1:nlevgrnd) = 1000.*COND(nc)*(wet3(nc)**(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space ! and converted to [mm/s] - soilstate_inst%smp_l_col (n) = 1000.*PSIS(nc)*(wet3(nc)**(-bee(nc))) ! actual soil matric potential mapped to CLM space + soilstate_inst%smp_l_col (n,1:nlevgrnd) = 1000.*PSIS(nc)*(wet3(nc)**(-bee(nc))) ! actual soil matric potential mapped to CLM space ! and converted to [mm] - soilstate_inst%bsw_col (n) = bee(nc) ! Clapp-Hornberger 'b' - soilstate_inst%sucsat_col (n) = 1000.*psis(nc)*(-1) ! minimum soil suction [mm] + soilstate_inst%bsw_col (n,1:nlevgrnd) = bee(nc) ! Clapp-Hornberger 'b' + soilstate_inst%sucsat_col (n,1:nlevgrnd) = 1000.*psis(nc)*(-1) ! minimum soil suction [mm] ! compute column level direct and diffuse albedos (vis and nir) from pft level quantities tmp_albgrd_vis = 0. @@ -274,21 +294,14 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! compute canopy air vapor pressure (in CLM space) eair_clm (p) = eair(nc,nz) - do nv = 1,num_veg - if (ityp(nc,nv,nz).eq.np) then - elai_pft = elai(nc,nv,nz) - esai_pft = esai(nc,nv,nz) - end if - end do ! nv - - if (coszen_clm(p)>0. .and. (elai_pft + esai_pft)>0.) then + if (coszen_clm(p)>0. .and. (elai(p) + esai(p))>0.) then ! calculate solar vegetated filter num_vegsol = num_vegsol + 1 filter_vegsol(num_vegsol) = p ! calculate rho (weighted reflectance) and tau (weighted transmittance) needed for call to TwoStream later - wl = elai_pft / max( elai_pft+esai_pft, 1.e-06_r8 ) - ws = esai_pft / max( elai_pft+esai_pft, 1.e-06_r8 ) + wl = elai(p) / max( elai(p)+esai(p), 1.e-06_r8 ) + ws = esai(p) / max( elai(p)+esai(p), 1.e-06_r8 ) do ib = 1, numrad rho(p,ib) = max( rhol(np,ib)*wl + rhos(np,ib)*ws, 1.e-06_r8 ) @@ -299,7 +312,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_novegsol(num_novegsol) = p end if - waterstate_inst%fdry_patch(p) = (1-fwet(nc))*elai_pft/(elai_pft+esai_pft) + waterstate_inst%fdry_patch(p) = (1-fwet(nc))*elai(p)/(elai(p)+esai(p)) waterstate_inst%fwet_patch(p) = fwet(nc) waterstate_inst%fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet end do From d31f15cac5fab42de840f01744f1e55cb72d10a4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 11:37:40 -0500 Subject: [PATCH 222/589] change filter save --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index f30b54fe8..e5f353421 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -96,7 +96,7 @@ module filterMod ! This is the standard set of filters, which should be used in most places in the code. ! These filters only include 'active' points. - type(clumpfilter), allocatable, public :: filter(:) + type(clumpfilter), public, target, save :: filter contains From e0fa1842ed105518083dc5a8bc3d3022ad8660f0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 12:22:50 -0500 Subject: [PATCH 223/589] several bug fixes --- .../CLM51/CNCLM51_Photosynthesis.F90 | 77 ++++++++++--------- 1 file changed, 41 insertions(+), 36 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 90a21de64..4c736dc9e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -4,7 +4,6 @@ module CNCLM_Photosynthesis use clm_varpar, only : numpft, numrad, num_veg, num_zon use decompMod, only : bounds_type use PatchType, only : patch - use pftconMod, only : pftcon use filterMod, only : clumpfilter use CNVegNitrogenstateType @@ -80,6 +79,23 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! LOCAL + ! CLM variables + type(bounds_type) :: bounds + type(atm2lnd_type) :: atm2lnd_inst + type(temperature_type) :: temperature_inst + type(soilstate_type) :: soilstate_inst + type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst + type(surfalb_type) :: surfalb_inst + type(solarabs_type) :: solarabs_inst + type(canopystate_type) :: canopystate_inst + type(ozone_base_type) :: ozone_inst + type(photosyns_type) :: photosyns_inst + type(waterfluxbulk_type) :: waterfluxbulk_inst + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst + type(waterstate_type) :: waterstate_inst + type(clumpfilter) :: filter + ! temporary and loop variables integer :: n, p, pft_num, nv, nc, nz, np, ib real :: bare, tmp_albgrd_vis,tmp_albgrd_nir,& @@ -115,38 +131,29 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, dimension (nch, NUM_ZON) :: qaf ! canopy air humidity [kg/kg] ! local inputs to Photosynthesis in CLM space - real, dimension(nch*NUM_ZON*(numpft+1)) :: coszen_clm ! cosine solar zenith angle for next time step in CLM dimensions - real, dimension(nch*NUM_ZON*(numpft+1)) :: esat_tv_clm - real, dimension(nch*NUM_ZON*(numpft+1)) :: eair_clm - real, dimension(nch*NUM_ZON*(numpft+1)) :: cair_clm - real, dimension(nch*NUM_ZON*(numpft+1)) :: oair_clm - real, dimension(nch*NUM_ZON*(numpft+1)) :: rb_clm - real, dimension(nch*NUM_ZON*(numpft+1)) :: dayl_factor_clm - real, dimension(nch*NUM_ZON*(numpft+1)) :: qsatl_clm - real, dimension(nch*NUM_ZON*(numpft+1)) :: qaf_clm - real, dimension(nch*NUM_ZON*(numpft+1)) :: deldT_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: coszen_clm ! cosine solar zenith angle for next time step in CLM dimensions + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: esat_tv_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: eair_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: cair_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: oair_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: rb_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: dayl_factor_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: qsatl_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: qaf_clm + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: deldT_clm + + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: eair_pert + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: temp_unpert ! local pointers for Photosynthesis inputs real, pointer :: leafn(:) ! leaf N (gN/m2) real, pointer :: froot_carbon(:) ! fine root carbon (gC/m2) [pft] real, pointer :: croot_carbon(:) ! live coarse root carbon (gC/m2) [pft] - ! CLM variables - type(bounds_type) :: bounds - type(atm2lnd_type) :: atm2lnd_inst - type(temperature_type) :: temperature_inst - type(soilstate_type) :: soilstate_inst - type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst - type(surfalb_type) :: surfalb_inst - type(solarabs_type) :: solarabs_inst - type(canopystate_type) :: canopystate_inst - type(ozone_base_type) :: ozone_inst - type(photosyns_type) :: photosyns_inst - type(waterfluxbulk_type) :: waterfluxbulk_inst - type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst - type(waterstate_type) :: waterstate_inst - type(clumpfilter) :: filter + ! local outputs from Photosynthesis routine + real(r8) , dimension(bounds%begp:bounds%endp) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) + real(r8) , dimension(bounds%begp:bounds%endp) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) + real(r8) , dimension(bounds%begp:bounds%endp) :: btran ! transpiration wetness factor (0 to 1) [pft] ! associate variables @@ -159,8 +166,6 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & f_sun_z => surfalb_inst%fsun_z_patch , & xl => pftcon%xl , & - rhol => pftcon%rhol , & - taul => pftcon%taul , & leafn => cnveg_nitrogenstate_inst%leafn_patch , & froot_carbon => cnveg_carbonstate_inst%frootc_patch , & croot_carbon => cnveg_carbonstate_inst%livecrootc_patch, & @@ -242,7 +247,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & atm2lnd_inst%forc_pbot_downscaled_col (n) = pbot(nc) atm2lnd_inst%forc_rho_downscaled_col (n) = pbot(nc)-0.378*eair(nc,nz)/(rair*tc(nc,nz)) - soilstate_inst%hksat_col (n) = 1000.*COND(nc) ! saturated hydraulic conductivity mapped to CLM space + soilstate_inst%hksat_col (n,1:nlevgrnd) = 1000.*COND(nc) ! saturated hydraulic conductivity mapped to CLM space ! and converted to [mm/s] soilstate_inst%hk_l_col (n,1:nlevgrnd) = 1000.*COND(nc)*(wet3(nc)**(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space ! and converted to [mm/s] @@ -312,9 +317,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_novegsol(num_novegsol) = p end if - waterstate_inst%fdry_patch(p) = (1-fwet(nc))*elai(p)/(elai(p)+esai(p)) - waterstate_inst%fwet_patch(p) = fwet(nc) - waterstate_inst%fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet + waterdiagnosticbulk_inst%fdry_patch(p) = (1-fwet(nc))*elai(p)/(elai(p)+esai(p)) + waterdiagnosticbulk_inst%fwet_patch(p) = fwet(nc) + waterdiagnosticbulk_inst%fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet end do end do end do @@ -347,7 +352,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call PhotosynthesisHydraulicStress ( bounds, filter%num_exposedvegp, filter%exposedvegp, & esat_tv_clm, eair_pert, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & - atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) @@ -365,7 +370,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call PhotosynthesisHydraulicStress ( bounds, fn, filterp, & esat_tv_pert, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & - atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) @@ -381,7 +386,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call PhotosynthesisHydraulicStress ( bounds, fn, filterp, & esat_tv_clm, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & - atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) From af00a92ff77a2317ce8b9dc183edb7ac4ad94ee5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 14:05:49 -0500 Subject: [PATCH 224/589] bug fixes --- .../CLM51/CNCLM51_Photosynthesis.F90 | 35 ++++++++++++++----- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 4c736dc9e..68728fac0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -97,9 +97,10 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & type(clumpfilter) :: filter ! temporary and loop variables - integer :: n, p, pft_num, nv, nc, nz, np, ib + integer :: n, p, pft_num, nv, nc, nz, np, ib, nl real :: bare, tmp_albgrd_vis,tmp_albgrd_nir,& - tmp_albgri_vis,tmp_albgri_nir + tmp_albgri_vis,tmp_albgri_nir, & + tmp_parsun, tmp_parsha ! filter variables integer, allocatable, save :: filter_vegsol(:), filter_novegsol(:) @@ -143,6 +144,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: deldT_clm real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: eair_pert + real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: esat_tv_pert real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: temp_unpert ! local pointers for Photosynthesis inputs @@ -151,9 +153,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, pointer :: croot_carbon(:) ! live coarse root carbon (gC/m2) [pft] ! local outputs from Photosynthesis routine - real(r8) , dimension(bounds%begp:bounds%endp) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) - real(r8) , dimension(bounds%begp:bounds%endp) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) - real(r8) , dimension(bounds%begp:bounds%endp) :: btran ! transpiration wetness factor (0 to 1) [pft] + real(r8) , allocatable, dimension(:) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) + real(r8) , allocatable, dimension(:) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) + real(r8) , allocatable, dimension(:) :: btran ! transpiration wetness factor (0 to 1) [pft] ! associate variables @@ -181,12 +183,19 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & num_vegsol = 0 num_novegsol = 0 -! allocate variables for radiation calculations +! allocate variables for radiation calculations !--------------------------------- allocate(rho(bounds%begp:bounds%endp,numrad)) allocate(tau(bounds%begp:bounds%endp,numrad)) +! allocate Photosynthesis outputs +!-------------------------------- + + allocate(bsun(bounds%begp:bounds%endp)) + allocate(bsha(bounds%begp:bounds%endp)) + allocate(btran(bounds%begp:bounds%endp)) + ! compute saturation vapor pressure ! --------------------------------- do n = 1,nch @@ -367,7 +376,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & temperature_inst%t_veg_patch = temperature_inst%t_veg_patch + dtc esat_tv_pert(:) = esat_tv_clm(:) + deldT_clm(:)*dtc - call PhotosynthesisHydraulicStress ( bounds, fn, filterp, & + call PhotosynthesisHydraulicStress ( bounds, filter%num_exposedvegp, filter%exposedvegp, & esat_tv_pert, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & @@ -383,7 +392,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & temperature_inst%t_veg_patch = temp_unpert ! reset canopy temperature to unperturbed value - call PhotosynthesisHydraulicStress ( bounds, fn, filterp, & + call PhotosynthesisHydraulicStress ( bounds, filter%num_exposedvegp, filter%exposedvegp, & esat_tv_clm, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & @@ -395,7 +404,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & rssun = photosyns_inst%rssun_patch rssha = photosyns_inst%rssha_patch - call PhotosynthesisTotal (fn, filterp, & + call PhotosynthesisTotal (filter%num_exposedvegp, filter%exposedvegp, & atm2lnd_inst, canopystate_inst, photosyns_inst) np = 0 @@ -458,6 +467,14 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & end associate + deallocate(filter_vegsol) + deallocate(filter_novegsol) + deallocate(rho) + deallocate(tau) + deallocate(bsun) + deallocate(bsha) + deallocate(btran) + end subroutine catchcn_calc_rc end module CNCLM_Photosynthesis From f2b9080ae9811a7b625d2225d1dd2e1a3b446f6f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 14:24:25 -0500 Subject: [PATCH 225/589] ass shr_fire_emis_mod --- .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 8717cef2d..e7eb80f86 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -108,6 +108,7 @@ set (srcs shr_assert.h shr_const_mod.F90 shr_file_mod.F90 + shr_fire_emis_mod.F90 shr_kind_mod.F90 shr_log_mod.F90 shr_mpi_mod.F90 From 55d40dcc89c9d4d52bda15b73a93b836ab6c2e47 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 15:03:39 -0500 Subject: [PATCH 226/589] add missing functions --- .../CLM51/AnnualFluxDribbler.F90 | 144 +++++++++++++----- 1 file changed, 104 insertions(+), 40 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 index 84f93ee99..83ae34537 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -111,13 +111,13 @@ module AnnualFluxDribbler procedure, public :: set_curr_delta ! Set the delta state for this time step procedure, public :: get_curr_flux ! Get the current flux for this time step ! procedure, public :: get_dribbled_delta ! Similar to get_curr_flux, but gets result as a delta rather than a per-second flux - ! procedure, public :: get_amount_left_to_dribble_beg ! Get the pseudo-state representing the amount that still needs to be dribbled in this and future time steps - ! procedure, public :: get_amount_left_to_dribble_end ! Get the pseudo-state representing the amount that still needs to be dribbled in just future time steps + procedure, public :: get_amount_left_to_dribble_beg ! Get the pseudo-state representing the amount that still needs to be dribbled in this and future time steps + procedure, public :: get_amount_left_to_dribble_end ! Get the pseudo-state representing the amount that still needs to be dribbled in just future time steps ! Private methods procedure, private :: allocate_and_initialize_data procedure, private :: set_metadata - ! procedure, private :: get_amount_left_to_dribble + procedure, private :: get_amount_left_to_dribble end type annual_flux_dribbler_type public :: annual_flux_dribbler_gridcell ! Creates an annual_flux_dribbler_type object at the gridcell-level @@ -573,43 +573,107 @@ subroutine set_metadata(this, name, units, allows_non_annual_delta) end subroutine set_metadata !----------------------------------------------------------------------- -! subroutine get_amount_left_to_dribble(this, bounds, yearfrac, amount_left_to_dribble) -! ! -! ! !DESCRIPTION: -! ! Helper method shared by get_amount_left_to_dribble_beg and -! ! get_amount_left_to_dribble_end. Returns amount left to dribble as of a given -! ! yearfrac. -! ! -! ! !USES: -! ! -! ! !ARGUMENTS: -! class(annual_flux_dribbler_type), intent(in) :: this -! type(bounds_type), intent(in) :: bounds -! real(r8), intent(in) :: yearfrac -! real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) -! ! -! ! !LOCAL VARIABLES: -! integer :: beg_index, end_index -! integer :: i -! -! character(len=*), parameter :: subname = 'get_amount_left_to_dribble' -! !----------------------------------------------------------------------- -! -! beg_index = lbound(amount_left_to_dribble, 1) -! end_index = get_end(bounds, this%bounds_subgrid_level) -! SHR_ASSERT_ALL_FL((ubound(amount_left_to_dribble) == (/end_index/)), sourcefile, __LINE__) -! -! do i = beg_index, end_index -! if (yearfrac < 1.e-15_r8) then -! ! last time step of year; we'd like this to be given a yearfrac of 1 rather than -! ! 0 in this case; since it's given as 0, we need to handle it specially -! amount_left_to_dribble(i) = 0._r8 -! else -! amount_left_to_dribble(i) = this%amount_to_dribble(i) * (1._r8 - yearfrac) -! end if -! end do -! -! end subroutine get_amount_left_to_dribble + subroutine get_amount_left_to_dribble(this, bounds, yearfrac, amount_left_to_dribble) + ! + ! !DESCRIPTION: + ! Helper method shared by get_amount_left_to_dribble_beg and + ! get_amount_left_to_dribble_end. Returns amount left to dribble as of a given + ! yearfrac. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: yearfrac + real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + integer :: beg_index, end_index + integer :: i + + character(len=*), parameter :: subname = 'get_amount_left_to_dribble' + !----------------------------------------------------------------------- + + beg_index = lbound(amount_left_to_dribble, 1) + end_index = get_end(bounds, this%bounds_subgrid_level) + SHR_ASSERT_ALL_FL((ubound(amount_left_to_dribble) == (/end_index/)), sourcefile, __LINE__) + + do i = beg_index, end_index + if (yearfrac < 1.e-15_r8) then + ! last time step of year; we'd like this to be given a yearfrac of 1 rather than + ! 0 in this case; since it's given as 0, we need to handle it specially + amount_left_to_dribble(i) = 0._r8 + else + amount_left_to_dribble(i) = this%amount_to_dribble(i) * (1._r8 - yearfrac) + end if + end do + + end subroutine get_amount_left_to_dribble ! + !----------------------------------------------------------------------- + subroutine get_amount_left_to_dribble_beg(this, bounds, amount_left_to_dribble) + ! + ! !DESCRIPTION: + ! Get the pseudo-state representing the amount that still needs to be dribbled in + ! this and future time steps. This represents the pseudo-state before this time + ! step's dribbling flux has been removed. (This behavior is regardless of whether + ! get_curr_flux has been called already this time step.) + ! + ! As a special case, this returns 0 in the first time step of the year, because we + ! haven't created this year's dribbling pool as of the beginning of this time step. + ! + ! i.e., if we imagined that the total amount to dribble was added to a state + ! variable, and then this state variable was updated each time step as the flux + ! dribbles out, then this subroutine gives the amount left in that state. (However, + ! the actual implementation doesn't explicitly track this state, which is why we + ! refer to it as a pseudo-state.) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + real(r8) :: yearfrac + + character(len=*), parameter :: subname = 'get_amount_left_to_dribble_beg' + !----------------------------------------------------------------------- + + yearfrac = get_prev_yearfrac() + call this%get_amount_left_to_dribble(bounds, yearfrac, amount_left_to_dribble) + + end subroutine get_amount_left_to_dribble_beg + + !----------------------------------------------------------------------- + subroutine get_amount_left_to_dribble_end(this, bounds, amount_left_to_dribble) + ! + ! !DESCRIPTION: + ! Gets the pseudo-state representing the amount that still needs to be dribbled in + ! future time steps. This represents the pseudo-state after this time step's dribbling + ! flux has been removed. i.e., this includes the amount that will be dribbled starting + ! with the *next* time step, through the end of this year. So this will return 0 on + ! the last time step of the year. (This behavior is regardless of whether + ! get_curr_flux has been called already this time step.) + ! + ! See documentation of get_amount_left_to_dribble_beg for more details. + ! + ! !ARGUMENTS: + class(annual_flux_dribbler_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(out) :: amount_left_to_dribble( get_beg(bounds, this%bounds_subgrid_level) : ) + ! + ! !LOCAL VARIABLES: + real(r8) :: yearfrac + + character(len=*), parameter :: subname = 'get_amount_left_to_dribble_end' + !----------------------------------------------------------------------- + + yearfrac = get_curr_yearfrac() + call this%get_amount_left_to_dribble(bounds, yearfrac, amount_left_to_dribble) + + end subroutine get_amount_left_to_dribble_end end module AnnualFluxDribbler From f7b668b6af8df7a832716cc461e93d1771b2d3f0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 15:04:47 -0500 Subject: [PATCH 227/589] add missing variable --- .../CLM51/CNBalanceCheckMod.F90 | 2 +- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 index c41ac2bc5..81831df6b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 @@ -6,7 +6,7 @@ module CNBalanceCheckMod ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan + use nanMod , only : nan use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 4eeb7f144..841faea9b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -204,6 +204,17 @@ module CNVegCarbonStateType type(cnveg_carbonstate_type), public, target, save :: cnveg_carbonstate_inst + real(r8), public :: spinup_factor_deadwood = 1.0_r8 ! Spinup factor used for this simulation + real(r8), public :: spinup_factor_AD = 10.0_r8 ! Spinup factor used when in Accelerated Decomposition mode + + ! !PRIVATE DATA: + + type, private :: cnvegcarbonstate_const_type + ! !PRIVATE MEMBER DATA: + real(r8) :: initial_vegC = 20._r8 ! Initial vegetation carbon for leafc/frootc and storage + end type + type(cnvegcarbonstate_const_type), private :: cnvegcstate_const ! Constants used here + character(len=*), parameter :: sourcefile = & __FILE__ From 1d9a9bd76279ff0bac26fac2c1fd6a723fe091d7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 15:04:57 -0500 Subject: [PATCH 228/589] add missing variable --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 8deac7eab..5a9c954f1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -42,8 +42,13 @@ module pftconMod integer, public :: nc3crop = 15 ! C3_crop [moisture + deciduous] integer, public :: npcropmin = 15 ! value for first crop functional type (not including the more generic C3 crop PFT) + ! variables that do not apply here, but are needed; set to mxpft + 1 integer, public :: nc3irrig = 16 ! value for irrigated generic crop (ir) - integer, public :: npcropmax ! value for last prognostic crop in list + integer, public :: npcropmax = 16 ! value for last prognostic crop in list + integer, public :: ntmp_soybean = 16 ! value for temperate soybean (rf) + integer, public :: nirrig_tmp_soybean = 16 ! value for temperate soybean (ir) + integer, public :: ntrp_soybean = 16 !value for tropical soybean (rf) + integer, public :: nirrig_trp_soybean = 16 !value for tropical soybean (ir) ! type, public :: pftcon_type From 0c3b494c6d3121cdca079cb7e3b8db42f2204cfe Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 15:05:10 -0500 Subject: [PATCH 229/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 index e7e2f5bad..bca42c2fc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNGapMortalityMod.F90 @@ -255,7 +255,7 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so ! cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * matrix_update_gmc(p,ideadstem_to_iout_gmc, & ! m*spinup_factor_deadwood,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) ! cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * matrix_update_gmc(p,ideadcroot_to_iout_gmc, & - m*spinup_factor_deadwood,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) + ! m*spinup_factor_deadwood,dt,cnveg_carbonflux_inst,matrixcheck_gm,.True.) end if !use_matrixcn ! storage pools @@ -321,7 +321,7 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so ! cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * matrix_update_gmn(p,ideadstem_to_iout_gmn , & ! m*spinup_factor_deadwood,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) ! cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * matrix_update_gmn(p,ideadcroot_to_iout_gmn, & - m*spinup_factor_deadwood,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + !m*spinup_factor_deadwood,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) end if !.not. use_matrixcn else if (.not. use_matrixcn) then @@ -337,7 +337,7 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so if(.not. use_matrixcn)then cnveg_nitrogenflux_inst%m_retransn_to_litter_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) * m else - cnveg_nitrogenflux_inst%m_retransn_to_litter_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) * matrix_update_gmn(p,iretransn_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) + !cnveg_nitrogenflux_inst%m_retransn_to_litter_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) * matrix_update_gmn(p,iretransn_to_iout_gmn,m,dt,cnveg_nitrogenflux_inst,matrixcheck_gm,.True.) end if end if From 977f031e7736bb6ebf26d523d77de27985d657dd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 16:31:03 -0500 Subject: [PATCH 230/589] add use statements --- .../GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 index 83ae34537..1c7413592 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -65,7 +65,7 @@ module AnnualFluxDribbler use decompMod , only : BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_PATCH use clm_varcon , only : secspday, nameg, namep use clm_time_manager , only : get_days_per_year, get_step_size_real, is_beg_curr_year - ! use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac, get_prev_date + use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac use clm_time_manager , only : is_first_step ! implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 index 216f8c23f..1cf21deaa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNNDynamicsMod.F90 @@ -157,7 +157,7 @@ subroutine CNFreeLivingFixation(num_soilc, filter_soilc, & use clm_time_manager , only : get_days_per_year - use shr_sys_mod , only : shr_sys_flush + ! use shr_sys_mod , only : shr_sys_flush use clm_varcon , only : secspday, spval integer , intent(in) :: num_soilc ! number of soil columns in filter @@ -201,7 +201,7 @@ subroutine CNNFixation(num_soilc, filter_soilc, & ! ! !USES: use clm_time_manager , only : get_days_per_year - use shr_sys_mod , only : shr_sys_flush + ! use shr_sys_mod , only : shr_sys_flush use clm_varcon , only : secspday, spval use CNSharedParamsMod , only: use_fun ! From 70f861e060c8913c0c9ca92c6a6f3a88d33f7504 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 16:31:31 -0500 Subject: [PATCH 231/589] add year fraction functions --- .../CLM51/clm_time_manager.F90 | 53 +++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 93f1ad350..07bb0e43f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -32,6 +32,9 @@ module clm_time_manager get_days_per_year, &! return the days per year for current year get_local_timestep_time, &! return the local time for the input longitude to the nearest time-step get_local_time, &! return the local time for the input longitude + get_curr_yearfrac, &! return the fractional position in the current year, as of the end of the current timestep + get_prev_yearfrac, &! return the fractional position in the current year, as of the beginning of the current timestep + is_end_curr_day, &! return true on last timestep in current day is_beg_curr_year, &! return true on first timestep in current year @@ -403,4 +406,54 @@ logical function is_beg_curr_year() is_beg_curr_year = (mon == 1 .and. day == 1 .and. tod == dtime) end function is_beg_curr_year + + !========================================================================================= + + function get_curr_yearfrac( offset ) + + !--------------------------------------------------------------------------------- + ! Get the fractional position in the current year, as of the end of the current + ! timestep. This is 0 at midnight on Jan 1, and 1 at the end of Dec 31. + + ! + ! Arguments + real(r8) :: get_curr_yearfrac ! function result + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_curr_yearfrac' + real(r8) :: cday ! current calendar day (1.0 = 0Z on Jan 1) + real(r8) :: days_per_year ! days per year + + if ( .not. check_timemgr_initialized(sub) ) return + + cday = get_curr_calday(offset=offset) + days_per_year = get_days_per_year() + + get_curr_yearfrac = (cday - 1._r8)/days_per_year + + end function get_curr_yearfrac + + !========================================================================================= + + function get_prev_yearfrac() + + !--------------------------------------------------------------------------------- + ! Get the fractional position in the current year, as of the beginning of the current + ! timestep. This is 0 at midnight on Jan 1, and 1 at the end of Dec 31. + + ! + ! Arguments + real(r8) :: get_prev_yearfrac ! function result + + character(len=*), parameter :: sub = 'clm::get_curr_yearfrac' + + if ( .not. check_timemgr_initialized(sub) ) return + + get_prev_yearfrac = get_curr_yearfrac(offset = -dtime) + + end function get_prev_yearfrac + end module clm_time_manager From 10c77328c2502b8fdb2ef421821e50f3484d11ab Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 17:06:03 -0500 Subject: [PATCH 232/589] add new function for getting current calendar day --- .../CLM51/clm_time_manager.F90 | 73 ++++++++++++++++++- 1 file changed, 71 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 07bb0e43f..75bdad3c6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -7,6 +7,7 @@ module clm_time_manager use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec use clm_varctl , only: iulog use MAPL_ExceptionHandling + use ESMF implicit none private @@ -427,7 +428,7 @@ function get_curr_yearfrac( offset ) real(r8) :: cday ! current calendar day (1.0 = 0Z on Jan 1) real(r8) :: days_per_year ! days per year - if ( .not. check_timemgr_initialized(sub) ) return + ! if ( .not. check_timemgr_initialized(sub) ) return cday = get_curr_calday(offset=offset) days_per_year = get_days_per_year() @@ -450,10 +451,78 @@ function get_prev_yearfrac() character(len=*), parameter :: sub = 'clm::get_curr_yearfrac' - if ( .not. check_timemgr_initialized(sub) ) return + ! if ( .not. check_timemgr_initialized(sub) ) return get_prev_yearfrac = get_curr_yearfrac(offset = -dtime) end function get_prev_yearfrac + !========================================================================================= + + function get_curr_calday(offset) + + ! Return calendar day at end of current timestep with optional offset. + ! Calendar day 1.0 = 0Z on Jan 1. + + ! Arguments + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + ! Return value + real(r8) :: get_curr_calday + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_curr_calday' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off, diurnal + integer :: year, month, day, tod + !----------------------------------------------------------------------------------------- + +! if ( .not. check_timemgr_initialized(sub) ) return + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + if ( tm_perp_calendar ) then + call ESMF_TimeGet(date, yy=year, mm=month, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeIntervalSet( diurnal, s=tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + diurnal + end if + + call ESMF_TimeGet( date, dayOfYear_r8=get_curr_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + !----------------------------------------------------------------------------------------! + !!!!!!!!!!!!!! WARNING HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!! + !!!! The following hack fakes day 366 by reusing day 365. This is just because the !!!!!! + !!!! current shr_orb_decl calculation can't handle days > 366. !!!!!! + !!!! Dani Bundy-Coleman and Erik Kluzek Aug/2008 !!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if ( (get_curr_calday > 366.0) .and. (get_curr_calday <= 367.0) .and. & + (trim(calendar) == GREGORIAN_C) )then + get_curr_calday = get_curr_calday - 1.0_r8 + end if + !!!!!!!!!!!!!! END HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!!!!!! + !----------------------------------------------------------------------------------------! + if ( (get_curr_calday < 1.0) .or. (get_curr_calday > 366.0) )then + write(iulog,*) sub, ' = ', get_curr_calday + if ( present(offset) ) write(iulog,*) 'offset = ', offset + call shr_sys_abort( sub//': error get_curr_calday out of bounds' ) + end if + + end function get_curr_calday end module clm_time_manager From 2a6f4a35587ec7fc37bbd1082f4f9ce7e7101ec7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 3 Jan 2023 17:06:36 -0500 Subject: [PATCH 233/589] removing old calendar day function --- .../CLM51/clm_time_manager.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 75bdad3c6..809fd485d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -130,16 +130,16 @@ subroutine get_curr_date(yr, mon, day, tod, offset) end subroutine get_curr_date !========================================================================================= -function get_curr_calday() - - ! Return calendar day at end of current timestep with optional offset. - ! Calendar day 1.0 = 0Z on Jan 1. - - real :: get_curr_calday - - get_curr_calday = curr_dofyr - -end function get_curr_calday +!function get_curr_calday() +! +! ! Return calendar day at end of current timestep with optional offset. +! ! Calendar day 1.0 = 0Z on Jan 1. +! +! real :: get_curr_calday +! +! get_curr_calday = curr_dofyr +! +!end function get_curr_calday !========================================================================================= From b24baf4231c27f808a11ecf12e98202c13171e1f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 08:34:23 -0500 Subject: [PATCH 234/589] revert to old function for calendar day --- .../CLM51/clm_time_manager.F90 | 152 +++++++++--------- 1 file changed, 76 insertions(+), 76 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 809fd485d..4dd741954 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -130,16 +130,16 @@ subroutine get_curr_date(yr, mon, day, tod, offset) end subroutine get_curr_date !========================================================================================= -!function get_curr_calday() -! -! ! Return calendar day at end of current timestep with optional offset. -! ! Calendar day 1.0 = 0Z on Jan 1. -! -! real :: get_curr_calday -! -! get_curr_calday = curr_dofyr -! -!end function get_curr_calday +function get_curr_calday(offset) + + ! Return calendar day at end of current timestep with optional offset. + ! Calendar day 1.0 = 0Z on Jan 1. + integer, optional, intent(in) :: offset ! Offset from current time in seconds.(not used) + real :: get_curr_calday + + get_curr_calday = curr_dofyr + +end function get_curr_calday !========================================================================================= @@ -459,70 +459,70 @@ end function get_prev_yearfrac !========================================================================================= - function get_curr_calday(offset) - - ! Return calendar day at end of current timestep with optional offset. - ! Calendar day 1.0 = 0Z on Jan 1. - - ! Arguments - integer, optional, intent(in) :: offset ! Offset from current time in seconds. - ! Positive for future times, negative - ! for previous times. - ! Return value - real(r8) :: get_curr_calday - - ! Local variables - character(len=*), parameter :: sub = 'clm::get_curr_calday' - integer :: rc - type(ESMF_Time) :: date - type(ESMF_TimeInterval) :: off, diurnal - integer :: year, month, day, tod - !----------------------------------------------------------------------------------------- - -! if ( .not. check_timemgr_initialized(sub) ) return - - call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_ClockGet') - - if (present(offset)) then - if (offset > 0) then - call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') - date = date + off - else if (offset < 0) then - call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') - date = date - off - end if - end if - - if ( tm_perp_calendar ) then - call ESMF_TimeGet(date, yy=year, mm=month, dd=day, s=tod, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeGet') - call ESMF_TimeIntervalSet( diurnal, s=tod, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') - date = tm_perp_date + diurnal - end if - - call ESMF_TimeGet( date, dayOfYear_r8=get_curr_calday, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_TimeGet') - !----------------------------------------------------------------------------------------! - !!!!!!!!!!!!!! WARNING HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!! - !!!! The following hack fakes day 366 by reusing day 365. This is just because the !!!!!! - !!!! current shr_orb_decl calculation can't handle days > 366. !!!!!! - !!!! Dani Bundy-Coleman and Erik Kluzek Aug/2008 !!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - if ( (get_curr_calday > 366.0) .and. (get_curr_calday <= 367.0) .and. & - (trim(calendar) == GREGORIAN_C) )then - get_curr_calday = get_curr_calday - 1.0_r8 - end if - !!!!!!!!!!!!!! END HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!!!!!! - !----------------------------------------------------------------------------------------! - if ( (get_curr_calday < 1.0) .or. (get_curr_calday > 366.0) )then - write(iulog,*) sub, ' = ', get_curr_calday - if ( present(offset) ) write(iulog,*) 'offset = ', offset - call shr_sys_abort( sub//': error get_curr_calday out of bounds' ) - end if - - end function get_curr_calday +! function get_curr_calday(offset) +! +! ! Return calendar day at end of current timestep with optional offset. +! ! Calendar day 1.0 = 0Z on Jan 1. +! +! ! Arguments +! integer, optional, intent(in) :: offset ! Offset from current time in seconds. +! ! Positive for future times, negative +! ! for previous times. +! ! Return value +! real(r8) :: get_curr_calday +! +! ! Local variables +! character(len=*), parameter :: sub = 'clm::get_curr_calday' +! integer :: rc +! type(ESMF_Time) :: date +! type(ESMF_TimeInterval) :: off, diurnal +! integer :: year, month, day, tod +! !----------------------------------------------------------------------------------------- +! +!! if ( .not. check_timemgr_initialized(sub) ) return +! +! call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) +! call chkrc(rc, sub//': error return from ESMF_ClockGet') +! +! if (present(offset)) then +! if (offset > 0) then +! call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) +! call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') +! date = date + off +! else if (offset < 0) then +! call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) +! call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') +! date = date - off +! end if +! end if +! +! if ( tm_perp_calendar ) then +! call ESMF_TimeGet(date, yy=year, mm=month, dd=day, s=tod, rc=rc) +! call chkrc(rc, sub//': error return from ESMF_TimeGet') +! call ESMF_TimeIntervalSet( diurnal, s=tod, rc=rc ) +! call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') +! date = tm_perp_date + diurnal +! end if +! +! call ESMF_TimeGet( date, dayOfYear_r8=get_curr_calday, rc=rc ) +! call chkrc(rc, sub//': error return from ESMF_TimeGet') +! !----------------------------------------------------------------------------------------! +! !!!!!!!!!!!!!! WARNING HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!! +! !!!! The following hack fakes day 366 by reusing day 365. This is just because the !!!!!! +! !!!! current shr_orb_decl calculation can't handle days > 366. !!!!!! +! !!!! Dani Bundy-Coleman and Erik Kluzek Aug/2008 !!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! if ( (get_curr_calday > 366.0) .and. (get_curr_calday <= 367.0) .and. & +! (trim(calendar) == GREGORIAN_C) )then +! get_curr_calday = get_curr_calday - 1.0_r8 +! end if +! !!!!!!!!!!!!!! END HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!!!!!! +! !----------------------------------------------------------------------------------------! +! if ( (get_curr_calday < 1.0) .or. (get_curr_calday > 366.0) )then +! write(iulog,*) sub, ' = ', get_curr_calday +! if ( present(offset) ) write(iulog,*) 'offset = ', offset +! call shr_sys_abort( sub//': error get_curr_calday out of bounds' ) +! end if +! +! end function get_curr_calday end module clm_time_manager From 86f0c277630f707fd826110fdb3a5035a0131be3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 10:01:48 -0500 Subject: [PATCH 235/589] add crop type variables --- .../CLM51/CNCLM_pftconMod.F90 | 146 +++++++++++++++++- 1 file changed, 138 insertions(+), 8 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 5a9c954f1..4d973ec8d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -42,13 +42,74 @@ module pftconMod integer, public :: nc3crop = 15 ! C3_crop [moisture + deciduous] integer, public :: npcropmin = 15 ! value for first crop functional type (not including the more generic C3 crop PFT) - ! variables that do not apply here, but are needed; set to mxpft + 1 - integer, public :: nc3irrig = 16 ! value for irrigated generic crop (ir) - integer, public :: npcropmax = 16 ! value for last prognostic crop in list - integer, public :: ntmp_soybean = 16 ! value for temperate soybean (rf) - integer, public :: nirrig_tmp_soybean = 16 ! value for temperate soybean (ir) - integer, public :: ntrp_soybean = 16 !value for tropical soybean (rf) - integer, public :: nirrig_trp_soybean = 16 !value for tropical soybean (ir) + ! variables that do not apply here, but are needed; set to mxpft + 1 in initialization routine + + integer, public :: ntmp_corn ! value for temperate corn, rain fed (rf) + integer, public :: nirrig_tmp_corn ! value for temperate corn, irrigated (ir) + integer, public :: nswheat ! value for spring temperate cereal (rf) + integer, public :: nirrig_swheat ! value for spring temperate cereal (ir) + integer, public :: nwwheat ! value for winter temperate cereal (rf) + integer, public :: nirrig_wwheat ! value for winter temperate cereal (ir) + integer, public :: ntmp_soybean ! value for temperate soybean (rf) + integer, public :: nirrig_tmp_soybean ! value for temperate soybean (ir) + integer, public :: nbarley ! value for spring barley (rf) + integer, public :: nirrig_barley ! value for spring barley (ir) + integer, public :: nwbarley ! value for winter barley (rf) + integer, public :: nirrig_wbarley ! value for winter barley (ir) + integer, public :: nrye ! value for spring rye (rf) + integer, public :: nirrig_rye ! value for spring rye (ir) + integer, public :: nwrye ! value for winter rye (rf) + integer, public :: nirrig_wrye ! value for winter rye (ir) + integer, public :: ncassava ! ...and so on + integer, public :: nirrig_cassava + integer, public :: ncitrus + integer, public :: nirrig_citrus + integer, public :: ncocoa + integer, public :: nirrig_cocoa + integer, public :: ncoffee + integer, public :: nirrig_coffee + integer, public :: ncotton + integer, public :: nirrig_cotton + integer, public :: ndatepalm + integer, public :: nirrig_datepalm + integer, public :: nfoddergrass + integer, public :: nirrig_foddergrass + integer, public :: ngrapes + integer, public :: nirrig_grapes + integer, public :: ngroundnuts + integer, public :: nirrig_groundnuts + integer, public :: nmillet + integer, public :: nirrig_millet + integer, public :: noilpalm + integer, public :: nirrig_oilpalm + integer, public :: npotatoes + integer, public :: nirrig_potatoes + integer, public :: npulses + integer, public :: nirrig_pulses + integer, public :: nrapeseed + integer, public :: nirrig_rapeseed + integer, public :: nrice + integer, public :: nirrig_rice + integer, public :: nsorghum + integer, public :: nirrig_sorghum + integer, public :: nsugarbeet + integer, public :: nirrig_sugarbeet + integer, public :: nsugarcane + integer, public :: nirrig_sugarcane + integer, public :: nsunflower + integer, public :: nirrig_sunflower + integer, public :: nmiscanthus + integer, public :: nirrig_miscanthus + integer, public :: nswitchgrass + integer, public :: nirrig_switchgrass + integer, public :: ntrp_corn !value for tropical corn (rf) + integer, public :: nirrig_trp_corn !value for tropical corn (ir) + integer, public :: ntrp_soybean !value for tropical soybean (rf) + integer, public :: nirrig_trp_soybean !value for tropical soybean (ir) + integer, public :: npcropmax ! value for last prognostic crop in list + integer, public :: nc3crop ! value for generic crop (rf) + integer, public :: nc3irrig ! value for irrigated generic crop (ir) + ! type, public :: pftcon_type @@ -795,7 +856,76 @@ subroutine init_pftcon_type(this) call ncd_io('max_SH_planting_date', this%mxSHplantdate, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - npcropmax = mxpft ! last prognostic crop in list + + npcropmax = mxpft ! last prognostic crop in list + + ! jkolassa Jan 2023: we do not model these crops, but the below variables are needed + ! for some checks; setting them to mxpft + 1 + ntmp_corn = mxpft + 1 ! value for temperate corn, rain fed (rf) + nirrig_tmp_corn = mxpft + 1 ! value for temperate corn, irrigated (ir) + nswheat = mxpft + 1 ! value for spring temperate cereal (rf) + nirrig_swheat = mxpft + 1 ! value for spring temperate cereal (ir) + nwwheat = mxpft + 1 ! value for winter temperate cereal (rf) + nirrig_wwheat = mxpft + 1 ! value for winter temperate cereal (ir) + ntmp_soybean = mxpft + 1 ! value for temperate soybean (rf) + nirrig_tmp_soybean = mxpft + 1 ! value for temperate soybean (ir) + nbarley = mxpft + 1 ! value for spring barley (rf) + nirrig_barley = mxpft + 1 ! value for spring barley (ir) + nwbarley = mxpft + 1 ! value for winter barley (rf) + nirrig_wbarley = mxpft + 1 ! value for winter barley (ir) + nrye = mxpft + 1 ! value for spring rye (rf) + nirrig_rye = mxpft + 1 ! value for spring rye (ir) + nwrye = mxpft + 1 ! value for winter rye (rf) + nirrig_wrye = mxpft + 1 ! value for winter rye (ir) + ncassava = mxpft + 1 ! ...and so on + nirrig_cassava = mxpft + 1 + ncitrus = mxpft + 1 + nirrig_citrus = mxpft + 1 + ncocoa = mxpft + 1 + nirrig_cocoa = mxpft + 1 + ncoffee = mxpft + 1 + nirrig_coffee = mxpft + 1 + ncotton = mxpft + 1 + nirrig_cotton = mxpft + 1 + ndatepalm = mxpft + 1 + nirrig_datepalm = mxpft + 1 + nfoddergrass = mxpft + 1 + nirrig_foddergrass = mxpft + 1 + ngrapes = mxpft + 1 + nirrig_grapes = mxpft + 1 + ngroundnuts = mxpft + 1 + nirrig_groundnuts = mxpft + 1 + nmillet = mxpft + 1 + nirrig_millet = mxpft + 1 + noilpalm = mxpft + 1 + nirrig_oilpalm = mxpft + 1 + npotatoes = mxpft + 1 + nirrig_potatoes = mxpft + 1 + npulses = mxpft + 1 + nirrig_pulses = mxpft + 1 + nrapeseed = mxpft + 1 + nirrig_rapeseed = mxpft + 1 + nrice = mxpft + 1 + nirrig_rice = mxpft + 1 + nsorghum = mxpft + 1 + nirrig_sorghum = mxpft + 1 + nsugarbeet = mxpft + 1 + nirrig_sugarbeet = mxpft + 1 + nsugarcane = mxpft + 1 + nirrig_sugarcane = mxpft + 1 + nsunflower = mxpft + 1 + nirrig_sunflower = mxpft + 1 + nmiscanthus = mxpft + 1 + nirrig_miscanthus = mxpft + 1 + nswitchgrass = mxpft + 1 + nirrig_switchgrass = mxpft + 1 + ntrp_corn = mxpft + 1 !value for tropical corn (rf) + nirrig_trp_corn = mxpft + 1 !value for tropical corn (ir) + ntrp_soybean = mxpft + 1 !value for tropical soybean (rf) + nirrig_trp_soybean = mxpft + 1 !value for tropical soybean (ir) + npcropmax = mxpft + 1 ! value for last prognostic crop in list + nc3crop = mxpft + 1 ! value for generic crop (rf) + nc3irrig = mxpft + 1 ! value for irrigated generic crop (ir) do m = 0,mxpft this%dwood(m) = dwood From 30eabcc0a762f9b3abe22f2b38da759f3ee1535c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 10:02:06 -0500 Subject: [PATCH 236/589] update call to FireInit --- .../GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 index f9d1a7370..c607a6011 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -76,7 +76,7 @@ subroutine CNDriverInit(bounds, NLFilename, cnfire_method) !----------------------------------------------------------------------- call SoilBiogeochemCompetitionInit(bounds) call CNPhenologyInit(bounds) - call cnfire_method%FireInit(bounds, NLFilename) + call cnfire_method%FireInit(bounds end subroutine CNDriverInit From c2dd42e8a518f6b24d9de592c2ad372097845310 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 10:02:51 -0500 Subject: [PATCH 237/589] remove obsolete use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 index 9c1d290cc..a6b594ae3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 @@ -12,7 +12,7 @@ module CNPhenologyMod ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg - use shr_sys_mod , only : shr_sys_flush + ! use shr_sys_mod , only : shr_sys_flush use decompMod , only : bounds_type use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& ilivestem,ilivestem_st,ilivestem_xf,& From afd515a69e50f425f45d0194a7eab0514e2bab88 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 10:03:19 -0500 Subject: [PATCH 238/589] add dummy arguments for c13/c14 ratio --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index 9f4d11310..e0dfd81d0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -84,6 +84,11 @@ module clm_varcon ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis real(r8), public, parameter :: c3_r2 = c3_r1/(1._r8 + c3_r1) + real(r8), public :: c13ratio = 1. !jkolassa Jan 2023: dummy value since this is only needed to compile the code, but not used + real(r8), public :: c14ratio = 1. !jkolassa Jan 2023: dummy value since this is only needed to compile the co +de, but not used + + real(r8), public, parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000) real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second From b609228b9b9d9a79beab5711fcbca4f4c6699704 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 10:03:48 -0500 Subject: [PATCH 239/589] add fertilization toggle --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index ca2ea5bd0..44f8965e3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -38,6 +38,7 @@ module clm_varctl logical, public :: use_bedrock = .false. ! true => use spatially variable soil depth logical, public :: use_extralakelayers = .false. logical, public :: use_biomass_heat_storage = .false. + logical, public :: use_fertilizer = .false. logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model From 1c4fb20818114d2ee4eb3acf892089fe5ac75664 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 10:26:50 -0500 Subject: [PATCH 240/589] typo correction --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index e0dfd81d0..b956bb7de 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -85,8 +85,7 @@ module clm_varcon real(r8), public, parameter :: c3_r2 = c3_r1/(1._r8 + c3_r1) real(r8), public :: c13ratio = 1. !jkolassa Jan 2023: dummy value since this is only needed to compile the code, but not used - real(r8), public :: c14ratio = 1. !jkolassa Jan 2023: dummy value since this is only needed to compile the co -de, but not used + real(r8), public :: c14ratio = 1. !jkolassa Jan 2023: dummy value since this is only needed to compile the code, but not used real(r8), public, parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000) From 7c723f3b630010d3f46e7429c66f64df4bc45e5a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 10:45:19 -0500 Subject: [PATCH 241/589] remove double definition of nc3crop --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 4d973ec8d..84dade2e4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -107,7 +107,6 @@ module pftconMod integer, public :: ntrp_soybean !value for tropical soybean (rf) integer, public :: nirrig_trp_soybean !value for tropical soybean (ir) integer, public :: npcropmax ! value for last prognostic crop in list - integer, public :: nc3crop ! value for generic crop (rf) integer, public :: nc3irrig ! value for irrigated generic crop (ir) ! @@ -924,7 +923,6 @@ subroutine init_pftcon_type(this) ntrp_soybean = mxpft + 1 !value for tropical soybean (rf) nirrig_trp_soybean = mxpft + 1 !value for tropical soybean (ir) npcropmax = mxpft + 1 ! value for last prognostic crop in list - nc3crop = mxpft + 1 ! value for generic crop (rf) nc3irrig = mxpft + 1 ! value for irrigated generic crop (ir) do m = 0,mxpft From 234d55ae2981f09b126e9f2e30efb7079adf6426 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 11:14:17 -0500 Subject: [PATCH 242/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 index c607a6011..793b04859 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -76,7 +76,7 @@ subroutine CNDriverInit(bounds, NLFilename, cnfire_method) !----------------------------------------------------------------------- call SoilBiogeochemCompetitionInit(bounds) call CNPhenologyInit(bounds) - call cnfire_method%FireInit(bounds + call cnfire_method%FireInit(bounds) end subroutine CNDriverInit From 5ebf16490f151fba33bc2023552de7b7098f0dd1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 11:14:30 -0500 Subject: [PATCH 243/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 index a6b594ae3..a5e537345 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 @@ -2969,10 +2969,10 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & ! else ! frootc_to_litter(p) = 0 ! end if -! else -! ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) -! ! and CNNStateUpdate1::NStateUpdate1 -! end if !use_matrixcn + else + ! NOTE: The non matrix version of this is in CNCStateUpdate1::CStateUpdate1 EBK (11/26/2019) + ! and CNNStateUpdate1::NStateUpdate1 + end if !use_matrixcn end if if ( use_fun ) then From df3f8e123f3e8c22ff7850cd008c3846cc5852d3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 11:14:54 -0500 Subject: [PATCH 244/589] update FireInit interface --- .../GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 index 63c05821b..8c5bd6287 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 @@ -52,7 +52,7 @@ module FireMethodType ! consistent between different implementations. ! !--------------------------------------------------------------------------- - subroutine FireInit_interface(this, bounds, NLFilename ) + subroutine FireInit_interface(this, bounds) ! ! !DESCRIPTION: ! Initialize Fire datasets @@ -63,7 +63,7 @@ subroutine FireInit_interface(this, bounds, NLFilename ) ! !ARGUMENTS: class(fire_method_type) :: this type(bounds_type), intent(in) :: bounds - character(len=*), intent(in) :: NLFilename + ! character(len=*), intent(in) :: NLFilename !----------------------------------------------------------------------- end subroutine FireInit_interface From 18cd0e960ad4a88a723aab1779ec5315b50316a3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 11:57:09 -0500 Subject: [PATCH 245/589] adjust FireRead interface --- .../CLM51/CNCLM_CNFireBaseMod.F90 | 241 +++++++++--------- 1 file changed, 121 insertions(+), 120 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 index 905fbec61..ffddc90f5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -14,6 +14,7 @@ module CNFireBaseMod ! climatological lightning data. ! ! !USES: + use nanMod , only : nan use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varctl , only : iulog @@ -145,7 +146,7 @@ end subroutine CNFireInit subroutine InitAllocate( this, bounds ) ! ! Initiaze memory allocate's - use shr_infnan_mod , only : nan => shr_infnan_nan + ! use shr_infnan_mod , only : nan => shr_infnan_nan ! ! !ARGUMENTS: class(cnfire_base_type) :: this @@ -818,44 +819,44 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte m_retransn_to_fire(p) = retransn(p) * f * cc_other(patch%itype(p)) else - m_leafc_to_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_storage_to_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_xfer_to_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_storage_to_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_to_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_to_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_storage_to_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_xfer_to_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_to_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) - - m_leafn_to_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_storage_to_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_xfer_to_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_storage_to_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_to_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_to_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_storage_to_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_xfer_to_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_to_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_retransn_to_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafc_to_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_leafc_storage_to_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_leafc_xfer_to_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_to_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_storage_to_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_to_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_to_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_storage_to_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_xfer_to_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_to_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_to_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic ,f * 0._r8 ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic ,f * cc_other(patch%itype(p)) ,dt,cnveg_carbonflux_inst,.True.,.True.) +! +! m_leafn_to_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin ,f * cc_leaf(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafn_storage_to_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafn_xfer_to_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_to_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin ,f * cc_lstem(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_storage_to_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_to_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin ,f * cc_dstem(patch%itype(p))*m,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_to_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_storage_to_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_xfer_to_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_to_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_to_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin ,f * cc_other(patch%itype(p)) ,dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_retransn_to_fire(p) = retransn(p) * matrix_update_fin(p,iretransn_to_iout_fin ,f * 0._r8 ,dt,cnveg_nitrogenflux_inst,.True.,.True.) end if ! mortality due to fire ! carbon pools @@ -1004,87 +1005,87 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte fm_other(patch%itype(p)) else - m_leafc_to_litter_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic, & - f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_litter_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic, & - f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livestemc_to_deadstemc_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_ideadstem_fic,& - f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_to_litter_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic, & - f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_to_litter_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic, & - f * fm_root(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_litter_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic, & - f * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_ideadcroot_fic,& - f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic, & - f * m * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) - - m_leafn_to_litter_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin, & - f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_litter_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin, & - f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livestemn_to_deadstemn_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_ideadstem_fin,& - f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_to_litter_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin, & - f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_to_litter_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin, & - f * fm_root(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_litter_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin, & - f * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_ideadcroot_fin,& - f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin, & - f * m * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) - m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin, & - f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafc_to_litter_fire(p) = leafc(p) * matrix_update_fic(p,ileaf_to_iout_fic, & +! f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * matrix_update_fic(p,ileafst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * matrix_update_fic(p,ileafxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_to_litter_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_iout_fic, & +! f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * matrix_update_fic(p,ilivestemst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * matrix_update_fic(p,ilivestemxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livestemc_to_deadstemc_fire(p) = livestemc(p) * matrix_update_fic(p,ilivestem_to_ideadstem_fic,& +! f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_to_litter_fire(p) = deadstemc(p) * matrix_update_fic(p,ideadstem_to_iout_fic, & +! f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * matrix_update_fic(p,ideadstemst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * matrix_update_fic(p,ideadstemxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_to_litter_fire(p) = frootc(p) * matrix_update_fic(p,ifroot_to_iout_fic, & +! f * fm_root(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * matrix_update_fic(p,ifrootst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * matrix_update_fic(p,ifrootxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_to_litter_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_iout_fic, & +! f * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * matrix_update_fic(p,ilivecrootst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * matrix_update_fic(p,ilivecrootxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * matrix_update_fic(p,ilivecroot_to_ideadcroot_fic,& +! f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * matrix_update_fic(p,ideadcroot_to_iout_fic, & +! f * m * fm_droot(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * matrix_update_fic(p,ideadcrootst_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * matrix_update_fic(p,ideadcrootxf_to_iout_fic, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_carbonflux_inst,.True.,.True.) +! +! m_leafn_to_litter_fire(p) = leafn(p) * matrix_update_fin(p,ileaf_to_iout_fin, & +! f * (1._r8 - cc_leaf(patch%itype(p))) * fm_leaf(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * matrix_update_fin(p,ileafst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * matrix_update_fin(p,ileafxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_to_litter_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_iout_fin, & +! f * (1._r8 - cc_lstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * matrix_update_fin(p,ilivestemst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * matrix_update_fin(p,ilivestemxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livestemn_to_deadstemn_fire(p) = livestemn(p) * matrix_update_fin(p,ilivestem_to_ideadstem_fin,& +! f * (1._r8 - cc_lstem(patch%itype(p))) * (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_to_litter_fire(p) = deadstemn(p) * matrix_update_fin(p,ideadstem_to_iout_fin, & +! f * (1._r8 - cc_dstem(patch%itype(p))) * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_storage_to_litter_fire(p) = deadstemn_storage(p) * matrix_update_fin(p,ideadstemst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadstemn_xfer_to_litter_fire(p) = deadstemn_xfer(p) * matrix_update_fin(p,ideadstemxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_to_litter_fire(p) = frootn(p) * matrix_update_fin(p,ifroot_to_iout_fin, & +! f * fm_root(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * matrix_update_fin(p,ifrootst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * matrix_update_fin(p,ifrootxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_to_litter_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_iout_fin, & +! f * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * matrix_update_fin(p,ilivecrootst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * matrix_update_fin(p,ilivecrootxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * matrix_update_fin(p,ilivecroot_to_ideadcroot_fin,& +! f * (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * matrix_update_fin(p,ideadcroot_to_iout_fin, & +! f * m * fm_droot(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * matrix_update_fin(p,ideadcrootst_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) +! m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * matrix_update_fin(p,ideadcrootxf_to_iout_fin, & +! f * (1._r8 - cc_other(patch%itype(p))) * fm_other(patch%itype(p)),dt,cnveg_nitrogenflux_inst,.True.,.True.) end if if (use_cndv) then From 1497631824a96714a3993364d80e2d78fb7a9d83 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 11:58:26 -0500 Subject: [PATCH 246/589] adjust FireRead interface --- .../CLM51/CNCLM_FireDataBaseType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 index 0188c4c23..a416be6f7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 @@ -64,7 +64,7 @@ end function need_lightning_and_popdens_interface contains !----------------------------------------------------------------------- - subroutine FireReadNML_interface( this, NLFilename ) + subroutine FireReadNML_interface( this, fire_method ) ! ! !DESCRIPTION: ! Read the namelist for Fire @@ -73,7 +73,7 @@ subroutine FireReadNML_interface( this, NLFilename ) ! ! !ARGUMENTS: class(fire_base_type) :: this - character(len=*), intent(in) :: NLFilename ! Namelist filename + character(len=*), intent(in) :: fire_method end subroutine FireReadNML_interface !----------------------------------------------------------------------- From b3a53301f8a92765a31ab14014a3ce6c8817dd34 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 12:11:02 -0500 Subject: [PATCH 247/589] adjust FireRead interface --- .../GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 index 8c5bd6287..992c267ba 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 @@ -68,7 +68,7 @@ subroutine FireInit_interface(this, bounds) end subroutine FireInit_interface - subroutine FireReadNML_interface(this, NLFilename ) + subroutine FireReadNML_interface(this, fire_method ) ! ! !DESCRIPTION: ! Read general fire namelist @@ -77,7 +77,7 @@ subroutine FireReadNML_interface(this, NLFilename ) import :: fire_method_type ! !ARGUMENTS: class(fire_method_type) :: this - character(len=*), intent(in) :: NLFilename + character(len=*), intent(in) :: fire_method !----------------------------------------------------------------------- end subroutine FireReadNML_interface From ef748bc72cad211b82fc2b3a6ec3cb2f9d37988e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 12:11:22 -0500 Subject: [PATCH 248/589] remove matrix calculations --- .../NutrientCompetitionCLM45defaultMod.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 index bb40bb47d..e1d92eabc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 @@ -17,7 +17,7 @@ module NutrientCompetitionCLM45defaultMod use PatchType , only : patch use NutrientCompetitionMethodMod, only : nutrient_competition_method_type use NutrientCompetitionMethodMod, only : params_inst - use CNVegMatrixMod , only : matrix_update_phn + ! use CNVegMatrixMod , only : matrix_update_phn !use clm_varctl , only : iulog ! implicit none @@ -1043,15 +1043,15 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & end if !fun grain_flag(p) = 1._r8 if(use_matrixcn)then - if(leafn(p) .ne. 0._r8)then - leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) - end if - if(frootn(p) .ne. 0._r8)then - frootn_to_retransn(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iretransn,frootn_to_retransn(p) / frootn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) - end if - if(livestemn(p) .ne. 0._r8)then - livestemn_to_retransn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iretransn,livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) - end if +! if(leafn(p) .ne. 0._r8)then +! leafn_to_retransn(p) = leafn(p) * matrix_update_phn(p,ileaf_to_iretransn,leafn_to_retransn(p) / leafn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) +! end if +! if(frootn(p) .ne. 0._r8)then +! frootn_to_retransn(p) = frootn(p) * matrix_update_phn(p,ifroot_to_iretransn,frootn_to_retransn(p) / frootn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) +! end if +! if(livestemn(p) .ne. 0._r8)then +! livestemn_to_retransn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iretransn,livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,.True.,.False.) +! end if end if end if end if From 03e9b865d1c60d8f9e7fdd4aa22400e5aca2f995 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 12:11:33 -0500 Subject: [PATCH 249/589] remove matrix calculations --- .../NutrientCompetitionFlexibleCNMod.F90 | 65 ++++++++++--------- 1 file changed, 33 insertions(+), 32 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 index 83df830b8..393fa5db0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 @@ -18,6 +18,7 @@ module NutrientCompetitionFlexibleCNMod ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 + use nanMod , only : nan use decompMod , only : bounds_type use LandunitType , only : lun use ColumnType , only : col @@ -44,7 +45,7 @@ module NutrientCompetitionFlexibleCNMod ! ! private methods procedure, private :: InitAllocate - procedure, private :: InitHistory + !procedure, private :: InitHistory procedure, private :: calc_plant_cn_alloc procedure, private :: calc_plant_nitrogen_demand end type nutrient_competition_FlexibleCN_type @@ -81,7 +82,7 @@ subroutine Init(this, bounds) type(bounds_type), intent(in) :: bounds call this%InitAllocate(bounds) - call this%InitHistory(bounds) + ! call this%InitHistory(bounds) end subroutine Init @@ -92,7 +93,7 @@ subroutine InitAllocate(this, bounds) ! Allocate memory for the class data ! ! !USES: - use shr_infnan_mod , only : nan => shr_infnan_nan + !use shr_infnan_mod , only : nan => shr_infnan_nan ! !ARGUMENTS: class(nutrient_competition_FlexibleCN_type) :: this type(bounds_type), intent(in) :: bounds @@ -103,35 +104,35 @@ subroutine InitAllocate(this, bounds) end subroutine InitAllocate !------------------------------------------------------------------------ - subroutine InitHistory(this, bounds) - ! - ! !DESCRIPTION: - ! Send data to history file - ! - ! !USES: - use histFileMod , only : hist_addfld1d - use clm_varcon , only : spval - ! - ! !ARGUMENTS: - class(nutrient_competition_FlexibleCN_type), intent(in) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: begp, endp - !------------------------------------------------------------------------ - - begp = bounds%begp; endp= bounds%endp - - this%actual_leafcn(begp:endp) = spval - call hist_addfld1d (fname='LEAFCN', units='gC/gN', & - avgflag='A', long_name='Leaf CN ratio used for flexible CN', & - ptr_patch=this%actual_leafcn ) - this%actual_storage_leafcn(begp:endp) = spval - call hist_addfld1d (fname='LEAFCN_STORAGE', units='gC/gN', & - avgflag='A', long_name='Storage Leaf CN ratio used for flexible CN', & - ptr_patch=this%actual_storage_leafcn, default='inactive') - - end subroutine InitHistory +! subroutine InitHistory(this, bounds) +! ! +! ! !DESCRIPTION: +! ! Send data to history file +! ! +! ! !USES: +! use histFileMod , only : hist_addfld1d +! use clm_varcon , only : spval +! ! +! ! !ARGUMENTS: +! class(nutrient_competition_FlexibleCN_type), intent(in) :: this +! type(bounds_type), intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! integer :: begp, endp +! !------------------------------------------------------------------------ +! +! begp = bounds%begp; endp= bounds%endp +! +! this%actual_leafcn(begp:endp) = spval +! call hist_addfld1d (fname='LEAFCN', units='gC/gN', & +! avgflag='A', long_name='Leaf CN ratio used for flexible CN', & +! ptr_patch=this%actual_leafcn ) +! this%actual_storage_leafcn(begp:endp) = spval +! call hist_addfld1d (fname='LEAFCN_STORAGE', units='gC/gN', & +! avgflag='A', long_name='Storage Leaf CN ratio used for flexible CN', & +! ptr_patch=this%actual_storage_leafcn, default='inactive') +! +! end subroutine InitHistory !----------------------------------------------------------------------- subroutine calc_plant_nutrient_competition (this, & From 37bc19e861b00c9bfb0a0abbed283a5087f43b76 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 12:11:49 -0500 Subject: [PATCH 250/589] add missing variables --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 44f8965e3..446b3ba1b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -40,6 +40,14 @@ module clm_varctl logical, public :: use_biomass_heat_storage = .false. logical, public :: use_fertilizer = .false. + logical, public :: downreg_opt = .true. + logical, public :: nscalar_opt = .true. + integer, public :: plant_ndemand_opt = 0 + logical, public :: substrate_term_opt = .true. + logical, public :: temp_scalar_opt = .true. + integer, public :: CN_residual_opt = 0 + integer, public :: CN_partition_opt = 0 + logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model From f1184bccc4eae376c53b6ff465e8d67dc9287f15 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 12:34:15 -0500 Subject: [PATCH 251/589] remove obsolete function declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 index ffddc90f5..dd8b32f33 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -94,7 +94,7 @@ module CNFireBaseMod procedure, public :: CNFire_calc_fire_root_wetness_Li2021 ! Calculate CN-fire specific root wetness: 2021 version ! !PRIVATE MEMBER FUNCTIONS: procedure, private :: InitAllocate ! Memory allocation of Fire - procedure, private :: InitHistory ! History file assignment of fire + ! procedure, private :: InitHistory ! History file assignment of fire ! end type cnfire_base_type !----------------------------------------------------------------------- From d886eb5d60238341e9df15090ca716000b812527 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 12:41:37 -0500 Subject: [PATCH 252/589] remove unused function --- .../CLM51/NutrientCompetitionCLM45defaultMod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 index e1d92eabc..ba0e1a111 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionCLM45defaultMod.F90 @@ -41,7 +41,7 @@ module NutrientCompetitionCLM45defaultMod ! interface nutrient_competition_clm45default_type ! initialize a new nutrient_competition_clm45default_type object - module procedure constructor + ! module procedure constructor end interface nutrient_competition_clm45default_type ! @@ -52,13 +52,13 @@ module NutrientCompetitionCLM45defaultMod contains !------------------------------------------------------------------------ - type(nutrient_competition_clm45default_type) function constructor() - ! - ! !DESCRIPTION: - ! Creates an object of type nutrient_competition_clm45default_type. - ! For now, this is simply a place-holder. - - end function constructor +! type(nutrient_competition_clm45default_type) function constructor() +! ! +! ! !DESCRIPTION: +! ! Creates an object of type nutrient_competition_clm45default_type. +! ! For now, this is simply a place-holder. +! +! end function constructor !------------------------------------------------------------------------ subroutine Init(this, bounds) From 4ccb76772e8f6f1dbe274ce9daf8dffce7aa9e0c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 12:42:02 -0500 Subject: [PATCH 253/589] remove unused function and fix typos --- .../NutrientCompetitionFlexibleCNMod.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 index 393fa5db0..ab573e8db 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 @@ -52,7 +52,7 @@ module NutrientCompetitionFlexibleCNMod ! interface nutrient_competition_FlexibleCN_type ! initialize a new nutrient_competition_FlexibleCN_type object - module procedure constructor + ! module procedure constructor end interface nutrient_competition_FlexibleCN_type ! @@ -65,12 +65,12 @@ module NutrientCompetitionFlexibleCNMod contains !------------------------------------------------------------------------ - type(nutrient_competition_FlexibleCN_type) function constructor() - ! - ! !DESCRIPTION: - ! Creates an object of type nutrient_competition_FlexibleCN_type. - ! For now, this is simply a place-holder. - end function constructor +! type(nutrient_competition_FlexibleCN_type) function constructor() +! ! +! ! !DESCRIPTION: +! ! Creates an object of type nutrient_competition_FlexibleCN_type. +! ! For now, this is simply a place-holder. +! end function constructor !------------------------------------------------------------------------ subroutine Init(this, bounds) @@ -521,7 +521,7 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & ! matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch & ! C input of matrix ! ) ! matrix_Cinput(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) - end associate + ! end associate end if ! reduce gpp fluxes due to N limitation @@ -1299,7 +1299,7 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & ! if(ivt(p) >= npcropmin)then ! tmp = matrix_update_phn(p,iretransn_to_igrain ,matrix_nalloc(p,igrain ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) ! tmp = matrix_update_phn(p,iretransn_to_igrainst ,matrix_nalloc(p,igrain_st ) * retransn_to_npool(p) / retransn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,.True.) - end if + ! end if end if end associate end if !end use_matrixcn @@ -1799,7 +1799,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ! end if ! if(livestemn(p) .ne. 0._r8)then ! livestemn_to_retransn(p) = livestemn(p) * matrix_update_phn(p,ilivestem_to_iretransn_phn,livestemn_to_retransn(p) / livestemn(p),dt,cnveg_nitrogenflux_inst,matrixcheck_ph,acc_ph) - end if + ! end if end if end if From 81a862c9efe7a6956da23dce3fde6f9850f7c80f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 13:07:39 -0500 Subject: [PATCH 254/589] initialize actual leafcn --- .../CLM51/NutrientCompetitionFlexibleCNMod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 index ab573e8db..6b9753c66 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 @@ -101,6 +101,10 @@ subroutine InitAllocate(this, bounds) allocate(this%actual_leafcn(bounds%begp:bounds%endp)) ; this%actual_leafcn(:) = nan allocate(this%actual_storage_leafcn(bounds%begp:bounds%endp)) ; this%actual_storage_leafcn(:) = nan + + this%actual_leafcn(bounds%begp:bounds%endp) = spval + this%actual_storage_leafcn(bounds%begp:bounds%endp) = spval + end subroutine InitAllocate !------------------------------------------------------------------------ From 28142a9f062878d512e653c036d948e3c104b5e1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 13:27:24 -0500 Subject: [PATCH 255/589] add missing use statement --- .../CLM51/NutrientCompetitionFactoryMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 index 99daa738f..c11b000b0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 @@ -9,6 +9,7 @@ module NutrientCompetitionFactoryMod use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varctl , only : iulog + use clm_varcon , only : spval implicit none save From 4538207c241a1538e1163fdfa6ddf6014cb22f56 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 13:46:20 -0500 Subject: [PATCH 256/589] correct use statement --- .../CLM51/NutrientCompetitionFactoryMod.F90 | 1 - .../CLM51/NutrientCompetitionFlexibleCNMod.F90 | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 index c11b000b0..99daa738f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 @@ -9,7 +9,6 @@ module NutrientCompetitionFactoryMod use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varctl , only : iulog - use clm_varcon , only : spval implicit none save diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 index 6b9753c66..dd75aea2b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 @@ -26,6 +26,7 @@ module NutrientCompetitionFlexibleCNMod use NutrientCompetitionMethodMod, only : nutrient_competition_method_type use NutrientCompetitionMethodMod, only : params_inst use clm_varctl , only : iulog, use_matrixcn + use clm_varcon , only : spval ! implicit none private From 40727f211c68b05b0a72ff35557c39f68f9f103d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 14:59:17 -0500 Subject: [PATCH 257/589] remove allocation for flexibleCN that is not needed --- .../CLM51/NutrientCompetitionFactoryMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 index 99daa738f..bba2746bd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 @@ -72,8 +72,8 @@ function create_nutrient_competition_method(bounds) result(nutrient_competition_ source=nutrient_competition_clm45default_type()) case ("flexible_cn") - allocate(nutrient_competition_method, & - source=nutrient_competition_FlexibleCN_type()) + ! allocate(nutrient_competition_method, & + ! source=nutrient_competition_FlexibleCN_type()) case default write(iulog,*) subname//' ERROR: unknown method: ', method From 9de4a8a139ddf3e6a38cc351dc35f9e790a719ce Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 15:58:03 -0500 Subject: [PATCH 258/589] add new files to be copiled --- .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index e7eb80f86..5a2f83717 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -51,6 +51,7 @@ set (srcs CNCLM_SaturatedExcessRunoffMod.F90 CNCLM_SoilBiogeochemCarbonFluxType.F90 CNCLM_SoilBiogeochemCarbonStateType.F90 + CNCLM_SoilBiogeochemCompetitionMod.F90 CNCLM_SoilBiogeochemDecompCascadeConType.F90 CNCLM_SoilBiogeochemNitrogenFluxType.F90 CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -116,6 +117,7 @@ set (srcs shr_sys_mod.F90 SoilBiogeochemDecompCascadeBGCMod.F90 SoilBiogeochemDecompCascadeCNMod.F90 + SoilBiogeochemDecompMod.F90 SoilBiogeochemLittVertTranspMod.F90 SoilBiogeochemNLeachingMod.F90 SoilBiogeochemNStateUpdate1Mod.F90 From 846cd4c58e29227bdd228aeb4be25c32f757d732 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 15:58:44 -0500 Subject: [PATCH 259/589] comment out unused functions that would require the addition of extra modules to compile --- .../CLM51/CNDriverMod.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 index 793b04859..d51ae303e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -116,12 +116,12 @@ subroutine CNDriverNoLeaching(bounds, use CropType , only: crop_type use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix,CNFreeLivingFixation use CNMRespMod , only: CNMResp - use CNFUNMod , only: CNFUNInit !, CNFUN + ! use CNFUNMod , only: CNFUNInit !, CNFUN use CNPhenologyMod , only: CNPhenology use CNGRespMod , only: CNGResp use FireMethodType , only: fire_method_type - use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 - use CNC14DecayMod , only: C14Decay + ! use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 + ! use CNC14DecayMod , only: C14Decay use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h use CNCStateUpdate3Mod , only: CStateUpdate3 @@ -137,7 +137,7 @@ subroutine CNDriverNoLeaching(bounds, use SoilBiogeochemLittVertTranspMod , only: SoilBiogeochemLittVertTransp use SoilBiogeochemPotentialMod , only: SoilBiogeochemPotential use SoilBiogeochemVerticalProfileMod , only: SoilBiogeochemVerticalProfile - use SoilBiogeochemNitrifDenitrifMod , only: SoilBiogeochemNitrifDenitrif + ! use SoilBiogeochemNitrifDenitrifMod , only: SoilBiogeochemNitrifDenitrif use SoilBiogeochemNStateUpdate1Mod , only: SoilBiogeochemNStateUpdate1 use NutrientCompetitionMethodMod , only: nutrient_competition_method_type use CNRootDynMod , only: CNRootDyn @@ -351,9 +351,9 @@ subroutine CNDriverNoLeaching(bounds, ! calculate nitrification and denitrification rates (previously subroutine nitrif_denitrif called from CNDecompAlloc) if (use_nitrif_denitrif) then - call SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & - soilstate_inst, waterstatebulk_inst, temperature_inst, ch4_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) +! call SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & +! soilstate_inst, waterstatebulk_inst, temperature_inst, ch4_inst, & +! soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) end if call t_stopf('SoilBiogeochem') @@ -388,9 +388,9 @@ subroutine CNDriverNoLeaching(bounds, phase=1) call t_stopf('CNPhenology_phase1') - call t_startf('CNFUNInit') - call CNFUNInit(bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst) - call t_stopf('CNFUNInit') +! call t_startf('CNFUNInit') +! call CNFUNInit(bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst) +! call t_stopf('CNFUNInit') end if From 48e79d3744672cfbbd755114462a4dc42bfdf74a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 15:58:56 -0500 Subject: [PATCH 260/589] comment out unused functions that would require the addition of extra modules to compile --- .../CLM51/CNVegetationFacade.F90 | 620 +++++++++--------- 1 file changed, 310 insertions(+), 310 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index fce9e1074..27ed771cc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -40,7 +40,7 @@ module CNVegetationFacade ! !USES: #include "shr_assert.h" use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan + use nanMod , only : nan use shr_log_mod , only : errMsg => shr_log_errMsg use perf_mod , only : t_startf, t_stopf use decompMod , only : bounds_type @@ -58,8 +58,8 @@ module CNVegetationFacade use FireMethodType , only : fire_method_type use CNProductsMod , only : cn_products_type use NutrientCompetitionMethodMod , only : nutrient_competition_method_type - use SpeciesIsotopeType , only : species_isotope_type - use SpeciesNonIsotopeType , only : species_non_isotope_type +! use SpeciesIsotopeType , only : species_isotope_type +! use SpeciesNonIsotopeType , only : species_non_isotope_type use CanopyStateType , only : canopystate_type use PhotosynthesisMod , only : photosyns_type use atm2lndType , only : atm2lnd_type @@ -72,7 +72,7 @@ module CNVegetationFacade use CropType , only : crop_type use ch4Mod , only : ch4_type use CNDVType , only : dgvs_type - use CNDVDriverMod , only : CNDVDriver, CNDVHIST + ! use CNDVDriverMod , only : CNDVDriver, CNDVHIST use EnergyFluxType , only : energyflux_type use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type use FrictionVelocityMod , only : frictionvel_type @@ -83,7 +83,7 @@ module CNVegetationFacade use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type use CNFireEmissionsMod , only : fireemis_type, CNFireEmisUpdate - use CNDriverMod , only : CNDriverInit + !use CNDriverMod , only : CNDriverInit use CNDriverMod , only : CNDriverSummarizeStates, CNDriverSummarizeFluxes use CNDriverMod , only : CNDriverNoLeaching, CNDriverLeaching use CNCStateUpdate1Mod , only : CStateUpdateDynPatch @@ -153,23 +153,23 @@ module CNVegetationFacade ! - drydepvel_inst contains - procedure, public :: Init + ! procedure, public :: Init procedure, public :: InitAccBuffer procedure, public :: InitAccVars procedure, public :: UpdateAccVars ! procedure, public :: Restart - procedure, public :: Init2 ! Do initialization in initialize phase, after subgrid weights are determined + ! procedure, public :: Init2 ! Do initialization in initialize phase, after subgrid weights are determined procedure, public :: InitEachTimeStep ! Do initializations at the start of each time step procedure, public :: InterpFileInputs ! Interpolate inputs from files - procedure, public :: UpdateSubgridWeights ! Update subgrid weights if running with prognostic patch weights - procedure, public :: DynamicAreaConservation ! Conserve C & N with updates in subgrid weights + ! procedure, public :: UpdateSubgridWeights ! Update subgrid weights if running with prognostic patch weights + ! procedure, public :: DynamicAreaConservation ! Conserve C & N with updates in subgrid weights procedure, public :: InitColumnBalance ! Set the starting point for col-level balance checks procedure, public :: InitGridcellBalance ! Set the starting point for gridcell-level balance checks procedure, public :: EcosystemDynamicsPreDrainage ! Do the main science that needs to be done before hydrology-drainage procedure, public :: EcosystemDynamicsPostDrainage ! Do the main science that needs to be done after hydrology-drainage procedure, public :: BalanceCheck ! Check the carbon and nitrogen balance - procedure, public :: EndOfTimeStepVegDynamics ! Do vegetation dynamics that should be done at the end of each time step + ! procedure, public :: EndOfTimeStepVegDynamics ! Do vegetation dynamics that should be done at the end of each time step procedure, public :: WriteHistory ! Do any history writes that are specific to veg dynamics procedure, public :: get_net_carbon_exchange_grc ! Get gridcell-level net carbon exchange array @@ -195,92 +195,92 @@ module CNVegetationFacade contains !----------------------------------------------------------------------- - subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) - ! - ! !DESCRIPTION: - ! Initialize a CNVeg object. - ! - ! Should be called regardless of whether use_cn is true - ! - ! !USES: - use CNFireFactoryMod , only : create_cnfire_method - use clm_varcon , only : c13ratio, c14ratio - use ncdio_pio , only : file_desc_t - ! - ! !ARGUMENTS: - class(cn_vegetation_type), intent(inout) :: this - type(bounds_type), intent(in) :: bounds - character(len=*) , intent(in) :: NLFilename ! namelist filename - integer , intent(in) :: nskip_steps ! Number of steps to skip at startup - type(file_desc_t), intent(inout) :: params_ncid ! NetCDF handle to parameter file - ! - ! !LOCAL VARIABLES: - integer :: begp, endp - - character(len=*), parameter :: subname = 'Init' - !----------------------------------------------------------------------- - - begp = bounds%begp - endp = bounds%endp - - ! Note - always initialize the memory for cnveg_state_inst (used in biogeophys/) - call this%cnveg_state_inst%Init(bounds) - - skip_steps = nskip_steps - - if (use_cn) then - - ! Read in the general CN namelist - call this%CNReadNML( NLFilename ) ! MUST be called first as passes down control information to others - - call this%cnveg_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8, & - NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm ) - if (use_c13) then - call this%c13_cnveg_carbonstate_inst%Init(bounds, carbon_type='c13', ratio=c13ratio, & - NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & - c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) - end if - if (use_c14) then - call this%c14_cnveg_carbonstate_inst%Init(bounds, carbon_type='c14', ratio=c14ratio, & - NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & - c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) - end if - call this%cnveg_carbonflux_inst%Init(bounds, carbon_type='c12', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm ) - if (use_c13) then - call this%c13_cnveg_carbonflux_inst%Init(bounds, carbon_type='c13', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm) - end if - if (use_c14) then - call this%c14_cnveg_carbonflux_inst%Init(bounds, carbon_type='c14', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm) - end if - call this%cnveg_nitrogenstate_inst%Init(bounds, & - this%cnveg_carbonstate_inst%leafc_patch(begp:endp), & - this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), & - this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & - this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & - this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp) ) - call this%cnveg_nitrogenflux_inst%Init(bounds) - - call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) - if (use_c13) then - call this%c13_products_inst%Init(bounds, species_isotope_type('C', '13')) - end if - if (use_c14) then - call this%c14_products_inst%Init(bounds, species_isotope_type('C', '14')) - end if - call this%n_products_inst%Init(bounds, species_non_isotope_type('N')) - - call this%cn_balance_inst%Init(bounds) - - ! Initialize the memory for the dgvs_inst data structure regardless of whether - ! use_cndv is true so that it can be used in associate statements (nag compiler - ! complains otherwise) - call this%dgvs_inst%Init(bounds) - end if - - call create_cnfire_method(NLFilename, this%cnfire_method) - call this%cnfire_method%CNFireReadParams( params_ncid ) - - end subroutine Init +! subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) +! ! +! ! !DESCRIPTION: +! ! Initialize a CNVeg object. +! ! +! ! Should be called regardless of whether use_cn is true +! ! +! ! !USES: +! use CNFireFactoryMod , only : create_cnfire_method +! use clm_varcon , only : c13ratio, c14ratio +! use ncdio_pio , only : file_desc_t +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type), intent(inout) :: this +! type(bounds_type), intent(in) :: bounds +! character(len=*) , intent(in) :: NLFilename ! namelist filename +! integer , intent(in) :: nskip_steps ! Number of steps to skip at startup +! type(file_desc_t), intent(inout) :: params_ncid ! NetCDF handle to parameter file +! ! +! ! !LOCAL VARIABLES: +! integer :: begp, endp +! +! character(len=*), parameter :: subname = 'Init' +! !----------------------------------------------------------------------- +! +! begp = bounds%begp +! endp = bounds%endp +! +! ! Note - always initialize the memory for cnveg_state_inst (used in biogeophys/) +! call this%cnveg_state_inst%Init(bounds) +! +! skip_steps = nskip_steps +! +! if (use_cn) then +! +! ! Read in the general CN namelist +! call this%CNReadNML( NLFilename ) ! MUST be called first as passes down control information to others +! +! call this%cnveg_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8, & +! NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm ) +! if (use_c13) then +! call this%c13_cnveg_carbonstate_inst%Init(bounds, carbon_type='c13', ratio=c13ratio, & +! NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & +! c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) +! end if +! if (use_c14) then +! call this%c14_cnveg_carbonstate_inst%Init(bounds, carbon_type='c14', ratio=c14ratio, & +! NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & +! c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) +! end if +! call this%cnveg_carbonflux_inst%Init(bounds, carbon_type='c12', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm ) +! if (use_c13) then +! call this%c13_cnveg_carbonflux_inst%Init(bounds, carbon_type='c13', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm) +! end if +! if (use_c14) then +! call this%c14_cnveg_carbonflux_inst%Init(bounds, carbon_type='c14', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm) +! end if +! call this%cnveg_nitrogenstate_inst%Init(bounds, & +! this%cnveg_carbonstate_inst%leafc_patch(begp:endp), & +! this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), & +! this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & +! this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & +! this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp) ) +! call this%cnveg_nitrogenflux_inst%Init(bounds) +! +! call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) +! if (use_c13) then +! call this%c13_products_inst%Init(bounds, species_isotope_type('C', '13')) +! end if +! if (use_c14) then +! call this%c14_products_inst%Init(bounds, species_isotope_type('C', '14')) +! end if +! call this%n_products_inst%Init(bounds, species_non_isotope_type('N')) +! +! call this%cn_balance_inst%Init(bounds) +! +! ! Initialize the memory for the dgvs_inst data structure regardless of whether +! ! use_cndv is true so that it can be used in associate statements (nag compiler +! ! complains otherwise) +! call this%dgvs_inst%Init(bounds) +! end if +! +! call create_cnfire_method(NLFilename, this%cnfire_method) +! call this%cnfire_method%CNFireReadParams( params_ncid ) +! +! end subroutine Init !----------------------------------------------------------------------- subroutine CNReadNML( this, NLFilename ) @@ -532,33 +532,33 @@ end subroutine UpdateAccVars ! end subroutine Restart !----------------------------------------------------------------------- - subroutine Init2(this, bounds, NLFilename) - ! - ! !DESCRIPTION: - ! Do initialization that is needed in the initialize phase, after subgrid weights are - ! determined - ! - ! Should only be called if use_cn is true - ! - ! !USES: - ! - ! !ARGUMENTS: - class(cn_vegetation_type) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - character(len=*) , intent(in) :: NLFilename ! namelist filename - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'Init2' - !----------------------------------------------------------------------- - - call CNDriverInit(bounds, NLFilename, this%cnfire_method) - - if (use_cndv) then - call dynCNDV_init(bounds, this%dgvs_inst) - end if - - end subroutine Init2 +! subroutine Init2(this, bounds, NLFilename) +! ! +! ! !DESCRIPTION: +! ! Do initialization that is needed in the initialize phase, after subgrid weights are +! ! determined +! ! +! ! Should only be called if use_cn is true +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type) , intent(inout) :: this +! type(bounds_type) , intent(in) :: bounds +! character(len=*) , intent(in) :: NLFilename ! namelist filename +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'Init2' +! !----------------------------------------------------------------------- +! +! call CNDriverInit(bounds, NLFilename, this%cnfire_method) +! +! if (use_cndv) then +! call dynCNDV_init(bounds, this%dgvs_inst) +! end if +! +! end subroutine Init2 !----------------------------------------------------------------------- @@ -628,137 +628,137 @@ end subroutine InterpFileInputs !----------------------------------------------------------------------- - subroutine UpdateSubgridWeights(this, bounds) - ! - ! !DESCRIPTION: - ! Update subgrid weights if running with prognostic patch weights - ! - ! !USES: - ! - ! !ARGUMENTS: - class(cn_vegetation_type) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'UpdateSubgridWeights' - !----------------------------------------------------------------------- - - if (use_cndv) then - call dynCNDV_interp(bounds, this%dgvs_inst) - end if - - end subroutine UpdateSubgridWeights +! subroutine UpdateSubgridWeights(this, bounds) +! ! +! ! !DESCRIPTION: +! ! Update subgrid weights if running with prognostic patch weights +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type) , intent(inout) :: this +! type(bounds_type) , intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'UpdateSubgridWeights' +! !----------------------------------------------------------------------- +! +! if (use_cndv) then +! call dynCNDV_interp(bounds, this%dgvs_inst) +! end if +! +! end subroutine UpdateSubgridWeights !----------------------------------------------------------------------- - subroutine DynamicAreaConservation(this, bounds, clump_index, & - num_soilp_with_inactive, filter_soilp_with_inactive, & - num_soilc_with_inactive, filter_soilc_with_inactive, & - prior_weights, patch_state_updater, column_state_updater, & - canopystate_inst, photosyns_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & - soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, ch4_inst, soilbiogeochem_state_inst) - ! - ! !DESCRIPTION: - ! Conserve C & N with updates in subgrid weights - ! - ! Should only be called if use_cn is true - ! - ! !USES: - use dynPriorWeightsMod , only : prior_weights_type - use dynPatchStateUpdaterMod, only : patch_state_updater_type - use dynColumnStateUpdaterMod, only : column_state_updater_type - ! - ! !ARGUMENTS: - class(cn_vegetation_type), intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - - ! Index of clump on which we're currently operating. Note that this implies that this - ! routine must be called from within a clump loop. - integer , intent(in) :: clump_index - - integer , intent(in) :: num_soilp_with_inactive ! number of points in filter_soilp_with_inactive - integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points - integer , intent(in) :: num_soilc_with_inactive ! number of points in filter_soilc_with_inactive - integer , intent(in) :: filter_soilc_with_inactive(:) ! soil column filter that includes inactive points - type(prior_weights_type) , intent(in) :: prior_weights ! weights prior to the subgrid weight updates - type(patch_state_updater_type) , intent(in) :: patch_state_updater - type(column_state_updater_type) , intent(in) :: column_state_updater - type(canopystate_type) , intent(inout) :: canopystate_inst - type(photosyns_type) , intent(inout) :: photosyns_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst - type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst - type(ch4_type) , intent(inout) :: ch4_inst - type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'DynamicAreaConservation' - !----------------------------------------------------------------------- - - call t_startf('dyn_cnbal_patch') - call dyn_cnbal_patch(bounds, & - num_soilp_with_inactive, filter_soilp_with_inactive, & - prior_weights, patch_state_updater, & - canopystate_inst, photosyns_inst, & - this%cnveg_state_inst, & - this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, this%c14_cnveg_carbonstate_inst, & - this%cnveg_carbonflux_inst, this%c13_cnveg_carbonflux_inst, this%c14_cnveg_carbonflux_inst, & - this%cnveg_nitrogenstate_inst, this%cnveg_nitrogenflux_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_state_inst) - call t_stopf('dyn_cnbal_patch') - - ! It is important to update column-level state variables based on the fluxes - ! generated by dyn_cnbal_patch (which handles the change in aboveground / patch-level - ! C/N due to shrinking patches), before calling dyn_cnbal_col (which handles the - ! change in belowground / column-level C/N due to changing column areas). This way, - ! any aboveground biomass which is sent to litter or soil due to shrinking patch - ! areas is accounted for by the column-level conservation. This is important if - ! column weights on the grid cell are changing at the same time as patch weights on - ! the grid cell (which will typically be the case when columns change in area). - ! - ! The filters here need to include inactive points as well as active points so that - ! we correctly update column states in columns that have just shrunk to 0 area - - ! since those column states are still important in the following dyn_cnbal_col. - call t_startf('CNUpdateDynPatch') - call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & - this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst ) - if (use_c13) then - call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & - this%c13_cnveg_carbonflux_inst, this%c13_cnveg_carbonstate_inst, & - c13_soilbiogeochem_carbonstate_inst) - end if - if (use_c14) then - call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & - this%c14_cnveg_carbonflux_inst, this%c14_cnveg_carbonstate_inst, & - c14_soilbiogeochem_carbonstate_inst) - end if - call NStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & - this%cnveg_nitrogenflux_inst, this%cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & - soilbiogeochem_nitrogenflux_inst ) - call t_stopf('CNUpdateDynPatch') - - ! This call fixes issue #741 by performing precision control on decomp_cpools_vr_col - call t_startf('SoilBiogeochemPrecisionControl') - call SoilBiogeochemPrecisionControl(num_soilc_with_inactive, filter_soilc_with_inactive, & - soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) - call t_stopf('SoilBiogeochemPrecisionControl') - - call t_startf('dyn_cnbal_col') - call dyn_cnbal_col(bounds, clump_index, column_state_updater, & - soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst, & - ch4_inst) - call t_stopf('dyn_cnbal_col') - - end subroutine DynamicAreaConservation +! subroutine DynamicAreaConservation(this, bounds, clump_index, & +! num_soilp_with_inactive, filter_soilp_with_inactive, & +! num_soilc_with_inactive, filter_soilc_with_inactive, & +! prior_weights, patch_state_updater, column_state_updater, & +! canopystate_inst, photosyns_inst, & +! soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & +! c13_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & +! soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, ch4_inst, soilbiogeochem_state_inst) +! ! +! ! !DESCRIPTION: +! ! Conserve C & N with updates in subgrid weights +! ! +! ! Should only be called if use_cn is true +! ! +! ! !USES: +! use dynPriorWeightsMod , only : prior_weights_type +! use dynPatchStateUpdaterMod, only : patch_state_updater_type +! use dynColumnStateUpdaterMod, only : column_state_updater_type +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type), intent(inout) :: this +! type(bounds_type) , intent(in) :: bounds +! +! ! Index of clump on which we're currently operating. Note that this implies that this +! ! routine must be called from within a clump loop. +! integer , intent(in) :: clump_index +! +! integer , intent(in) :: num_soilp_with_inactive ! number of points in filter_soilp_with_inactive +! integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points +! integer , intent(in) :: num_soilc_with_inactive ! number of points in filter_soilc_with_inactive +! integer , intent(in) :: filter_soilc_with_inactive(:) ! soil column filter that includes inactive points +! type(prior_weights_type) , intent(in) :: prior_weights ! weights prior to the subgrid weight updates +! type(patch_state_updater_type) , intent(in) :: patch_state_updater +! type(column_state_updater_type) , intent(in) :: column_state_updater +! type(canopystate_type) , intent(inout) :: canopystate_inst +! type(photosyns_type) , intent(inout) :: photosyns_inst +! type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst +! type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst +! type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst +! type(ch4_type) , intent(inout) :: ch4_inst +! type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'DynamicAreaConservation' +! !----------------------------------------------------------------------- +! +! call t_startf('dyn_cnbal_patch') +! call dyn_cnbal_patch(bounds, & +! num_soilp_with_inactive, filter_soilp_with_inactive, & +! prior_weights, patch_state_updater, & +! canopystate_inst, photosyns_inst, & +! this%cnveg_state_inst, & +! this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, this%c14_cnveg_carbonstate_inst, & +! this%cnveg_carbonflux_inst, this%c13_cnveg_carbonflux_inst, this%c14_cnveg_carbonflux_inst, & +! this%cnveg_nitrogenstate_inst, this%cnveg_nitrogenflux_inst, & +! soilbiogeochem_carbonflux_inst, soilbiogeochem_state_inst) +! call t_stopf('dyn_cnbal_patch') +! +! ! It is important to update column-level state variables based on the fluxes +! ! generated by dyn_cnbal_patch (which handles the change in aboveground / patch-level +! ! C/N due to shrinking patches), before calling dyn_cnbal_col (which handles the +! ! change in belowground / column-level C/N due to changing column areas). This way, +! ! any aboveground biomass which is sent to litter or soil due to shrinking patch +! ! areas is accounted for by the column-level conservation. This is important if +! ! column weights on the grid cell are changing at the same time as patch weights on +! ! the grid cell (which will typically be the case when columns change in area). +! ! +! ! The filters here need to include inactive points as well as active points so that +! ! we correctly update column states in columns that have just shrunk to 0 area - +! ! since those column states are still important in the following dyn_cnbal_col. +! call t_startf('CNUpdateDynPatch') +! call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & +! this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst ) +! if (use_c13) then +! call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & +! this%c13_cnveg_carbonflux_inst, this%c13_cnveg_carbonstate_inst, & +! c13_soilbiogeochem_carbonstate_inst) +! end if +! if (use_c14) then +! call CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & +! this%c14_cnveg_carbonflux_inst, this%c14_cnveg_carbonstate_inst, & +! c14_soilbiogeochem_carbonstate_inst) +! end if +! call NStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_with_inactive, & +! this%cnveg_nitrogenflux_inst, this%cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & +! soilbiogeochem_nitrogenflux_inst ) +! call t_stopf('CNUpdateDynPatch') +! +! ! This call fixes issue #741 by performing precision control on decomp_cpools_vr_col +! call t_startf('SoilBiogeochemPrecisionControl') +! call SoilBiogeochemPrecisionControl(num_soilc_with_inactive, filter_soilc_with_inactive, & +! soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & +! c14_soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) +! call t_stopf('SoilBiogeochemPrecisionControl') +! +! call t_startf('dyn_cnbal_col') +! call dyn_cnbal_col(bounds, clump_index, column_state_updater, & +! soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & +! c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst, & +! ch4_inst) +! call t_stopf('dyn_cnbal_col') +! +! end subroutine DynamicAreaConservation !----------------------------------------------------------------------- subroutine InitColumnBalance(this, bounds, num_allc, filter_allc, & @@ -1175,65 +1175,65 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & end subroutine BalanceCheck !----------------------------------------------------------------------- - subroutine EndOfTimeStepVegDynamics(this, bounds, num_natvegp, filter_natvegp, & - atm2lnd_inst, wateratm2lndbulk_inst) - ! - ! !DESCRIPTION: - ! Do vegetation dynamics that should be done at the end of each time step - ! - ! Should only be called if use_cn is true - ! - ! !USES: - ! - ! !ARGUMENTS: - class(cn_vegetation_type), intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(inout) :: num_natvegp ! number of naturally-vegetated patches in filter - integer , intent(inout) :: filter_natvegp(:) ! filter for naturally-vegetated patches - type(atm2lnd_type) , intent(inout) :: atm2lnd_inst - type(wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst - ! - ! !LOCAL VARIABLES: - integer :: nstep ! time step number - integer :: yr ! year (0, ...) - integer :: mon ! month (1, ..., 12) - integer :: day ! day of month (1, ..., 31) - integer :: sec ! seconds of the day - integer :: ncdate ! current date - integer :: nbdate ! base date (reference date) - integer :: kyr ! thousand years, equals 2 at end of first year - - character(len=*), parameter :: subname = 'EndOfTimeStepVegDynamics' - !----------------------------------------------------------------------- - - if (use_cndv) then - ! Call dv (dynamic vegetation) at last time step of year - - call t_startf('d2dgvm') - if (is_end_curr_year() .and. .not. is_first_step()) then - - ! Get date info. kyr is used in lpj(). At end of first year, kyr = 2. - call get_curr_date(yr, mon, day, sec) - ncdate = yr*10000 + mon*100 + day - call get_ref_date(yr, mon, day, sec) - nbdate = yr*10000 + mon*100 + day - kyr = ncdate/10000 - nbdate/10000 + 1 - - if (masterproc) then - nstep = get_nstep() - write(iulog,*) 'End of year. CNDV called now: ncdate=', & - ncdate,' nbdate=',nbdate,' kyr=',kyr,' nstep=', nstep - end if - - call CNDVDriver(bounds, & - num_natvegp, filter_natvegp, kyr, & - atm2lnd_inst, wateratm2lndbulk_inst, & - this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, this%dgvs_inst) - end if - call t_stopf('d2dgvm') - end if - - end subroutine EndOfTimeStepVegDynamics +! subroutine EndOfTimeStepVegDynamics(this, bounds, num_natvegp, filter_natvegp, & +! atm2lnd_inst, wateratm2lndbulk_inst) +! ! +! ! !DESCRIPTION: +! ! Do vegetation dynamics that should be done at the end of each time step +! ! +! ! Should only be called if use_cn is true +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type), intent(inout) :: this +! type(bounds_type) , intent(in) :: bounds +! integer , intent(inout) :: num_natvegp ! number of naturally-vegetated patches in filter +! integer , intent(inout) :: filter_natvegp(:) ! filter for naturally-vegetated patches +! type(atm2lnd_type) , intent(inout) :: atm2lnd_inst +! type(wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst +! ! +! ! !LOCAL VARIABLES: +! integer :: nstep ! time step number +! integer :: yr ! year (0, ...) +! integer :: mon ! month (1, ..., 12) +! integer :: day ! day of month (1, ..., 31) +! integer :: sec ! seconds of the day +! integer :: ncdate ! current date +! integer :: nbdate ! base date (reference date) +! integer :: kyr ! thousand years, equals 2 at end of first year +! +! character(len=*), parameter :: subname = 'EndOfTimeStepVegDynamics' +! !----------------------------------------------------------------------- +! +! if (use_cndv) then +! ! Call dv (dynamic vegetation) at last time step of year +! +! call t_startf('d2dgvm') +! if (is_end_curr_year() .and. .not. is_first_step()) then +! +! ! Get date info. kyr is used in lpj(). At end of first year, kyr = 2. +! call get_curr_date(yr, mon, day, sec) +! ncdate = yr*10000 + mon*100 + day +! call get_ref_date(yr, mon, day, sec) +! nbdate = yr*10000 + mon*100 + day +! kyr = ncdate/10000 - nbdate/10000 + 1 +! +! if (masterproc) then +! nstep = get_nstep() +! write(iulog,*) 'End of year. CNDV called now: ncdate=', & +! ncdate,' nbdate=',nbdate,' kyr=',kyr,' nstep=', nstep +! end if +! +! call CNDVDriver(bounds, & +! num_natvegp, filter_natvegp, kyr, & +! atm2lnd_inst, wateratm2lndbulk_inst, & +! this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, this%dgvs_inst) +! end if +! call t_stopf('d2dgvm') +! end if +! +! end subroutine EndOfTimeStepVegDynamics !----------------------------------------------------------------------- subroutine WriteHistory(this, bounds) From b2784b4e70643428f6464e377b62b32d006105a8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 15:59:46 -0500 Subject: [PATCH 261/589] add parameter reading for soil biogeochemistry competition --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 8c33b7656..c2fbbd763 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -65,6 +65,7 @@ module CN_initMod use CNFireFactoryMod , only : CNFireReadNML, create_cnfire_method use FireMethodType , only : fire_method_type use SoilBiogeochemNLeachingMod , only : readSoilBiogeochemNLeachingParams => readParams + use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -296,6 +297,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call photosyns_inst%ReadParams( ncid ) call cnfire_method%CNFireReadParams( ncid ) call readSoilBiogeochemNLeachingParams(ncid) + call readSoilBiogeochemCompetitionParams(ncid) call ncid%close(rc=status) From 0c2b287faf97fc4c99cfbe5bc61d64f533912ca4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 16:00:27 -0500 Subject: [PATCH 262/589] soil biogeochemistry competition module --- .../CNCLM_SoilBiogeochemCompetitionMod.F90 | 948 ++++++++++++++++++ 1 file changed, 948 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCompetitionMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCompetitionMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCompetitionMod.F90 new file mode 100755 index 000000000..ab4b10cd3 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCompetitionMod.F90 @@ -0,0 +1,948 @@ +module SoilBiogeochemCompetitionMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Resolve plant/heterotroph competition for mineral N + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : dzsoi_decomp + use clm_varctl , only : use_nitrif_denitrif + use abortutils , only : endrun + use decompMod , only : bounds_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + ! use SoilBiogeochemNitrogenUptakeMod , only : SoilBiogeochemNitrogenUptake + use ColumnType , only : col + use CNVegstateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type + use CNVegnitrogenfluxType , only : cnveg_nitrogenflux_type + !use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use TemperatureType , only : temperature_type + use SoilStateType , only : soilstate_type + use CanopyStateType , only : CanopyState_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: SoilBiogeochemCompetitionInit ! Initialization + public :: SoilBiogeochemCompetition ! run method + + type :: params_type + real(r8) :: bdnr ! bulk denitrification rate (1/s) + real(r8) :: compet_plant_no3 ! (unitless) relative compettiveness of plants for NO3 + real(r8) :: compet_plant_nh4 ! (unitless) relative compettiveness of plants for NH4 + real(r8) :: compet_decomp_no3 ! (unitless) relative competitiveness of immobilizers for NO3 + real(r8) :: compet_decomp_nh4 ! (unitless) relative competitiveness of immobilizers for NH4 + real(r8) :: compet_denit ! (unitless) relative competitiveness of denitrifiers for NO3 + real(r8) :: compet_nit ! (unitless) relative competitiveness of nitrifiers for NH4 + end type params_type + ! + type(params_type), private :: params_inst ! params_inst is populated in readParamsMod + ! + ! !PUBLIC DATA MEMBERS: + character(len=* ), public, parameter :: suplnAll='ALL' ! Supplemental Nitrogen for all PFT's + character(len=* ), public, parameter :: suplnNon='NONE' ! No supplemental Nitrogen + character(len=15), public :: suplnitro = suplnNon ! Supplemental Nitrogen mode + ! + ! !PRIVATE DATA MEMBERS: + real(r8) :: dt ! decomp timestep (seconds) + real(r8) :: bdnr ! bulk denitrification rate (1/s) + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNAllocParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + tString='bdnr' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%bdnr=tempr + + tString='compet_plant_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%compet_plant_no3=tempr + + tString='compet_plant_nh4' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%compet_plant_nh4=tempr + + tString='compet_decomp_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%compet_decomp_no3=tempr + + tString='compet_decomp_nh4' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%compet_decomp_nh4=tempr + + tString='compet_denit' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%compet_denit=tempr + + tString='compet_nit' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%compet_nit=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemCompetitionInit ( bounds) + ! + ! !DESCRIPTION: + ! + ! !USES: + use clm_varcon , only: secspday + use clm_time_manager, only: get_step_size_real + use clm_varctl , only: iulog, cnallocate_carbon_only_set + use nanMod , only: nan + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'SoilBiogeochemCompetitionInit' + logical :: carbon_only + !----------------------------------------------------------------------- + + ! set time steps + dt = get_step_size_real() + + ! set space-and-time parameters from parameter file + bdnr = params_inst%bdnr * (dt/secspday) + + ! Change namelist settings into private logical variables + select case(suplnitro) + case(suplnNon) + carbon_only = .false. + case(suplnAll) + carbon_only = .true. + case default + write(iulog,*) 'Supplemental Nitrogen flag (suplnitro) can only be: ', & + suplnNon, ' or ', suplnAll + call endrun(msg='ERROR: supplemental Nitrogen flag is not correct'//& + errMsg(sourcefile, __LINE__)) + end select + + call cnallocate_carbon_only_set(carbon_only) + + end subroutine SoilBiogeochemCompetitionInit + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, filter_soilp, waterstatebulk_inst, & + waterfluxbulk_inst, temperature_inst,soilstate_inst, & + cnveg_state_inst,cnveg_carbonstate_inst, & + cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst,canopystate_inst) + ! + ! !USES: + use clm_varctl , only: cnallocate_carbon_only, iulog + use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions + use clm_varcon , only: nitrif_n2o_loss_frac + use CNSharedParamsMod, only: use_fun + ! use CNFUNMod , only: CNFUN + use subgridAveMod , only: p2c + use perf_mod , only : t_startf, t_stopf + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + type(temperature_type) , intent(in) :: temperature_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(canopystate_type) , intent(inout) :: canopystate_inst +! + ! + ! !LOCAL VARIABLES: + integer :: c,p,l,pi,j ! indices + integer :: fc ! filter column index + logical :: local_use_fun ! local version of use_fun + real(r8) :: compet_plant_no3 ! (unitless) relative compettiveness of plants for NO3 + real(r8) :: compet_plant_nh4 ! (unitless) relative compettiveness of plants for NH4 + real(r8) :: compet_decomp_no3 ! (unitless) relative competitiveness of immobilizers for NO3 + real(r8) :: compet_decomp_nh4 ! (unitless) relative competitiveness of immobilizers for NH4 + real(r8) :: compet_denit ! (unitless) relative competitiveness of denitrifiers for NO3 + real(r8) :: compet_nit ! (unitless) relative competitiveness of nitrifiers for NH4 + real(r8) :: fpi_no3_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! fraction of potential immobilization supplied by no3(no units) + real(r8) :: fpi_nh4_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! fraction of potential immobilization supplied by nh4 (no units) + real(r8) :: sum_nh4_demand(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_nh4_demand_scaled(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_no3_demand(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_no3_demand_scaled(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_ndemand_vr(bounds%begc:bounds%endc, 1:nlevdecomp) !total column N demand (gN/m3/s) at a given level + real(r8) :: nuptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) :: sminn_tot(bounds%begc:bounds%endc) + integer :: nlimit(bounds%begc:bounds%endc,0:nlevdecomp) !flag for N limitation + integer :: nlimit_no3(bounds%begc:bounds%endc,0:nlevdecomp) !flag for NO3 limitation + integer :: nlimit_nh4(bounds%begc:bounds%endc,0:nlevdecomp) !flag for NH4 limitation + real(r8) :: residual_sminn_vr(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) :: residual_sminn(bounds%begc:bounds%endc) + real(r8) :: residual_smin_nh4_vr(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) :: residual_smin_no3_vr(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) :: residual_smin_nh4(bounds%begc:bounds%endc) + real(r8) :: residual_smin_no3(bounds%begc:bounds%endc) + real(r8) :: residual_plant_ndemand(bounds%begc:bounds%endc) + real(r8) :: sminn_to_plant_new(bounds%begc:bounds%endc) + !----------------------------------------------------------------------- + + associate( & + fpg => soilbiogeochem_state_inst%fpg_col , & ! Output: [real(r8) (:) ] fraction of potential gpp (no units) + fpi => soilbiogeochem_state_inst%fpi_col , & ! Output: [real(r8) (:) ] fraction of potential immobilization (no units) + fpi_vr => soilbiogeochem_state_inst%fpi_vr_col , & ! Output: [real(r8) (:,:) ] fraction of potential immobilization (no units) + nfixation_prof => soilbiogeochem_state_inst%nfixation_prof_col , & ! Output: [real(r8) (:,:) ] + plant_ndemand => soilbiogeochem_state_inst%plant_ndemand_col , & ! Input: [real(r8) (:) ] column-level plant N demand + + sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N + smin_nh4_vr => soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NH4 + smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 + + pot_f_nit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_nit_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3/s) potential soil nitrification flux + pot_f_denit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_denit_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3/s) potential soil denitrification flux + f_nit_vr => soilbiogeochem_nitrogenflux_inst%f_nit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) soil nitrification flux + f_denit_vr => soilbiogeochem_nitrogenflux_inst%f_denit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) soil denitrification flux + potential_immob => soilbiogeochem_nitrogenflux_inst%potential_immob_col , & ! Output: [real(r8) (:) ] + actual_immob => soilbiogeochem_nitrogenflux_inst%actual_immob_col , & ! Output: [real(r8) (:) ] + sminn_to_plant => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_col , & ! Output: [real(r8) (:) ] + sminn_to_denit_excess_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_denit_excess_vr_col , & ! Output: [real(r8) (:,:) ] + actual_immob_no3_vr => soilbiogeochem_nitrogenflux_inst%actual_immob_no3_vr_col , & ! Output: [real(r8) (:,:) ] + actual_immob_nh4_vr => soilbiogeochem_nitrogenflux_inst%actual_immob_nh4_vr_col , & ! Output: [real(r8) (:,:) ] + smin_no3_to_plant_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_to_plant_vr_col , & ! Output: [real(r8) (:,:) ] + smin_nh4_to_plant_vr => soilbiogeochem_nitrogenflux_inst%smin_nh4_to_plant_vr_col , & ! Output: [real(r8) (:,:) ] + n2_n2o_ratio_denit_vr => soilbiogeochem_nitrogenflux_inst%n2_n2o_ratio_denit_vr_col , & ! Output: [real(r8) (:,:) ] ratio of N2 to N2O production by denitrification [gN/gN] + f_n2o_denit_vr => soilbiogeochem_nitrogenflux_inst%f_n2o_denit_vr_col , & ! Output: [real(r8) (:,:) ] flux of N2O from denitrification [gN/m3/s] + f_n2o_nit_vr => soilbiogeochem_nitrogenflux_inst%f_n2o_nit_vr_col , & ! Output: [real(r8) (:,:) ] flux of N2O from nitrification [gN/m3/s] + supplement_to_sminn_vr => soilbiogeochem_nitrogenflux_inst%supplement_to_sminn_vr_col , & ! Output: [real(r8) (:,:) ] + sminn_to_plant_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_vr_col , & ! Output: [real(r8) (:,:) ] + potential_immob_vr => soilbiogeochem_nitrogenflux_inst%potential_immob_vr_col , & ! Input: [real(r8) (:,:) ] + actual_immob_vr => soilbiogeochem_nitrogenflux_inst%actual_immob_vr_col , & ! Output: [real(r8) (:,:) ] + sminn_to_plant_fun_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_vr_col , & ! Iutput: [real(r8) (:) ] Total layer soil N uptake of FUN (gN/m2/s) + sminn_to_plant_fun_no3_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_no3_vr_col, & ! Iutput: [real(r8) (:) ] Total layer no3 uptake of FUN (gN/m2/s) + sminn_to_plant_fun_nh4_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_nh4_vr_col & ! Iutput: [real(r8) (:) ] Total layer nh4 uptake of FUN (gN/m2/s) + ) + + ! calcualte nitrogen uptake profile + ! nuptake_prof(:,:) = nan + ! call SoilBiogelchemNitrogenUptakeProfile(bounds, & + ! nlevdecomp, num_soilc, filter_soilc, & + ! sminn_vr, dzsoi_decomp, nfixation_prof, nuptake_prof) + + ! column loops to resolve plant/heterotroph competition for mineral N + + sminn_to_plant_new(bounds%begc:bounds%endc) = 0._r8 + + local_use_fun = use_fun + + if (.not. use_nitrif_denitrif) then + + ! init sminn_tot + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = 0. + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = sminn_tot(c) + sminn_vr(c,j) * dzsoi_decomp(j) + end do + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (sminn_tot(c) > 0.) then + nuptake_prof(c,j) = sminn_vr(c,j) / sminn_tot(c) + else + nuptake_prof(c,j) = nfixation_prof(c,j) + endif + end do + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sum_ndemand_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + potential_immob_vr(c,j) + end do + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + l = col%landunit(c) + if (sum_ndemand_vr(c,j)*dt < sminn_vr(c,j)) then + + ! N availability is not limiting immobilization or plant + ! uptake, and both can proceed at their potential rates + nlimit(c,j) = 0 + fpi_vr(c,j) = 1.0_r8 + actual_immob_vr(c,j) = potential_immob_vr(c,j) + sminn_to_plant_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + else if ( cnallocate_carbon_only()) then !.or. & + ! this code block controls the addition of N to sminn pool + ! to eliminate any N limitation, when Carbon_Only is set. This lets the + ! model behave essentially as a carbon-only model, but with the + ! benefit of keeping track of the N additions needed to + ! eliminate N limitations, so there is still a diagnostic quantity + ! that describes the degree of N limitation at steady-state. + + nlimit(c,j) = 1 + fpi_vr(c,j) = 1.0_r8 + actual_immob_vr(c,j) = potential_immob_vr(c,j) + sminn_to_plant_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + supplement_to_sminn_vr(c,j) = sum_ndemand_vr(c,j) - (sminn_vr(c,j)/dt) + else + ! N availability can not satisfy the sum of immobilization and + ! plant growth demands, so these two demands compete for available + ! soil mineral N resource. + + nlimit(c,j) = 1 + if (sum_ndemand_vr(c,j) > 0.0_r8) then + actual_immob_vr(c,j) = (sminn_vr(c,j)/dt)*(potential_immob_vr(c,j) / sum_ndemand_vr(c,j)) + else + actual_immob_vr(c,j) = 0.0_r8 + end if + + if (potential_immob_vr(c,j) > 0.0_r8) then + fpi_vr(c,j) = actual_immob_vr(c,j) / potential_immob_vr(c,j) + else + fpi_vr(c,j) = 0.0_r8 + end if + + sminn_to_plant_vr(c,j) = (sminn_vr(c,j)/dt) - actual_immob_vr(c,j) + end if + end do + end do + + if ( local_use_fun ) then +! call t_startf( 'CNFUN' ) +! call CNFUN(bounds,num_soilc,filter_soilc,num_soilp,filter_soilp,waterstatebulk_inst, & +! waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst,cnveg_carbonstate_inst,& +! cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst ,& +! soilbiogeochem_nitrogenflux_inst,soilbiogeochem_carbonflux_inst,canopystate_inst, & +! soilbiogeochem_nitrogenstate_inst) +! call p2c(bounds, nlevdecomp, & +! cnveg_nitrogenflux_inst%sminn_to_plant_fun_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& +! soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_vr_col(bounds%begc:bounds%endc,1:nlevdecomp), & +! 'unity') +! call t_stopf( 'CNFUN' ) + end if + + ! sum up N fluxes to plant + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) + if ( local_use_fun ) then + if (sminn_to_plant_fun_vr(c,j).gt.sminn_to_plant_vr(c,j)) then + sminn_to_plant_fun_vr(c,j) = sminn_to_plant_vr(c,j) + end if + end if + end do + end do + + ! give plants a second pass to see if there is any mineral N left over with which to satisfy residual N demand. + do fc=1,num_soilc + c = filter_soilc(fc) + residual_sminn(c) = 0._r8 + end do + + ! sum up total N left over after initial plant and immobilization fluxes + do fc=1,num_soilc + c = filter_soilc(fc) + residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (residual_plant_ndemand(c) > 0._r8 ) then + if (nlimit(c,j) .eq. 0) then + residual_sminn_vr(c,j) = max(sminn_vr(c,j) - (actual_immob_vr(c,j) + sminn_to_plant_vr(c,j) ) * dt, 0._r8) + residual_sminn(c) = residual_sminn(c) + residual_sminn_vr(c,j) * dzsoi_decomp(j) + else + residual_sminn_vr(c,j) = 0._r8 + endif + endif + end do + end do + + ! distribute residual N to plants + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if ( residual_plant_ndemand(c) > 0._r8 .and. residual_sminn(c) > 0._r8 .and. nlimit(c,j) .eq. 0) then + sminn_to_plant_vr(c,j) = sminn_to_plant_vr(c,j) + residual_sminn_vr(c,j) * & + min(( residual_plant_ndemand(c) * dt ) / residual_sminn(c), 1._r8) / dt + endif + end do + end do + + ! re-sum up N fluxes to plant + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) + if ( .not. local_use_fun ) then + sum_ndemand_vr(c,j) = potential_immob_vr(c,j) + sminn_to_plant_vr(c,j) + else + sminn_to_plant_new(c) = sminn_to_plant_new(c) + sminn_to_plant_fun_vr(c,j) * dzsoi_decomp(j) + sum_ndemand_vr(c,j) = potential_immob_vr(c,j) + sminn_to_plant_fun_vr(c,j) + end if + end do + end do + + ! under conditions of excess N, some proportion is assumed to + ! be lost to denitrification, in addition to the constant + ! proportion lost in the decomposition pathways + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if ( .not. local_use_fun ) then + if ((sminn_to_plant_vr(c,j) + actual_immob_vr(c,j))*dt < sminn_vr(c,j)) then + sminn_to_denit_excess_vr(c,j) = max(bdnr*((sminn_vr(c,j)/dt) - sum_ndemand_vr(c,j)),0._r8) + else + sminn_to_denit_excess_vr(c,j) = 0._r8 + endif + else + if ((sminn_to_plant_fun_vr(c,j) + actual_immob_vr(c,j))*dt < sminn_vr(c,j)) then + sminn_to_denit_excess_vr(c,j) = max(bdnr*((sminn_vr(c,j)/dt) - sum_ndemand_vr(c,j)),0._r8) + else + sminn_to_denit_excess_vr(c,j) = 0._r8 + endif + end if + end do + end do + + ! sum up N fluxes to immobilization + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + actual_immob(c) = actual_immob(c) + actual_immob_vr(c,j) * dzsoi_decomp(j) + potential_immob(c) = potential_immob(c) + potential_immob_vr(c,j) * dzsoi_decomp(j) + end do + end do + + do fc=1,num_soilc + c = filter_soilc(fc) + ! calculate the fraction of potential growth that can be + ! acheived with the N available to plants + if (plant_ndemand(c) > 0.0_r8) then + if ( .not. local_use_fun ) then + fpg(c) = sminn_to_plant(c) / plant_ndemand(c) + else + fpg(c) = sminn_to_plant_new(c) / plant_ndemand(c) + end if + else + fpg(c) = 1.0_r8 + end if + + ! calculate the fraction of immobilization realized (for diagnostic purposes) + if (potential_immob(c) > 0.0_r8) then + fpi(c) = actual_immob(c) / potential_immob(c) + else + fpi(c) = 1.0_r8 + end if + end do + + else !----------NITRIF_DENITRIF-------------! + + ! column loops to resolve plant/heterotroph/nitrifier/denitrifier competition for mineral N + !read constants from external netcdf file + compet_plant_no3 = params_inst%compet_plant_no3 + compet_plant_nh4 = params_inst%compet_plant_nh4 + compet_decomp_no3 = params_inst%compet_decomp_no3 + compet_decomp_nh4 = params_inst%compet_decomp_nh4 + compet_denit = params_inst%compet_denit + compet_nit = params_inst%compet_nit + + ! init total mineral N pools + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = 0. + end do + + ! sum up total mineral N pools + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = sminn_tot(c) + (smin_no3_vr(c,j) + smin_nh4_vr(c,j)) * dzsoi_decomp(j) + end do + end do + + ! define N uptake profile for initial vertical distribution of plant N uptake, assuming plant seeks N from where it is most abundant + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (sminn_tot(c) > 0.) then + nuptake_prof(c,j) = sminn_vr(c,j) / sminn_tot(c) + else + nuptake_prof(c,j) = nfixation_prof(c,j) + endif + end do + end do + + ! main column/vertical loop + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + l = col%landunit(c) + + ! first compete for nh4 + sum_nh4_demand(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + potential_immob_vr(c,j) + pot_f_nit_vr(c,j) + sum_nh4_demand_scaled(c,j) = plant_ndemand(c)* nuptake_prof(c,j) * compet_plant_nh4 + & + potential_immob_vr(c,j)*compet_decomp_nh4 + pot_f_nit_vr(c,j)*compet_nit + + if (sum_nh4_demand(c,j)*dt < smin_nh4_vr(c,j)) then + + ! NH4 availability is not limiting immobilization or plant + ! uptake, and all can proceed at their potential rates + nlimit_nh4(c,j) = 0 + fpi_nh4_vr(c,j) = 1.0_r8 + actual_immob_nh4_vr(c,j) = potential_immob_vr(c,j) + !RF added new term. + + f_nit_vr(c,j) = pot_f_nit_vr(c,j) + + if ( .not. local_use_fun ) then + smin_nh4_to_plant_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + else + smin_nh4_to_plant_vr(c,j) = smin_nh4_vr(c,j)/dt - actual_immob_nh4_vr(c,j) - f_nit_vr(c,j) + end if + + else + + ! NH4 availability can not satisfy the sum of immobilization, nitrification, and + ! plant growth demands, so these three demands compete for available + ! soil mineral NH4 resource. + nlimit_nh4(c,j) = 1 + if (sum_nh4_demand(c,j) > 0.0_r8) then + ! RF microbes compete based on the hypothesised plant demand. + actual_immob_nh4_vr(c,j) = min((smin_nh4_vr(c,j)/dt)*(potential_immob_vr(c,j)* & + compet_decomp_nh4 / sum_nh4_demand_scaled(c,j)), potential_immob_vr(c,j)) + + f_nit_vr(c,j) = min((smin_nh4_vr(c,j)/dt)*(pot_f_nit_vr(c,j)*compet_nit / & + sum_nh4_demand_scaled(c,j)), pot_f_nit_vr(c,j)) + + if ( .not. local_use_fun ) then + smin_nh4_to_plant_vr(c,j) = min((smin_nh4_vr(c,j)/dt)*(plant_ndemand(c)* & + nuptake_prof(c,j)*compet_plant_nh4 / sum_nh4_demand_scaled(c,j)), plant_ndemand(c)*nuptake_prof(c,j)) + + else + ! RF added new term. send rest of N to plant - which decides whether it should pay or not? + smin_nh4_to_plant_vr(c,j) = smin_nh4_vr(c,j)/dt - actual_immob_nh4_vr(c,j) - f_nit_vr(c,j) + end if + + else + actual_immob_nh4_vr(c,j) = 0.0_r8 + smin_nh4_to_plant_vr(c,j) = 0.0_r8 + f_nit_vr(c,j) = 0.0_r8 + end if + + if (potential_immob_vr(c,j) > 0.0_r8) then + fpi_nh4_vr(c,j) = actual_immob_nh4_vr(c,j) / potential_immob_vr(c,j) + else + fpi_nh4_vr(c,j) = 0.0_r8 + end if + + end if + + + + if(.not.local_use_fun)then + sum_no3_demand(c,j) = (plant_ndemand(c)*nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j)) + & + (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j)) + pot_f_denit_vr(c,j) + sum_no3_demand_scaled(c,j) = (plant_ndemand(c)*nuptake_prof(c,j) & + -smin_nh4_to_plant_vr(c,j))*compet_plant_no3 + & + (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j))*compet_decomp_no3 + pot_f_denit_vr(c,j)*compet_denit + else + sum_no3_demand(c,j) = plant_ndemand(c)*nuptake_prof(c,j) + & + (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j)) + pot_f_denit_vr(c,j) + sum_no3_demand_scaled(c,j) = (plant_ndemand(c)*nuptake_prof(c,j))*compet_plant_no3 + & + (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j))*compet_decomp_no3 + pot_f_denit_vr(c,j)*compet_denit + endif + + + + if (sum_no3_demand(c,j)*dt < smin_no3_vr(c,j)) then + + ! NO3 availability is not limiting immobilization or plant + ! uptake, and all can proceed at their potential rates + nlimit_no3(c,j) = 0 + fpi_no3_vr(c,j) = 1.0_r8 - fpi_nh4_vr(c,j) + actual_immob_no3_vr(c,j) = (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j)) + + f_denit_vr(c,j) = pot_f_denit_vr(c,j) + + if(.not.local_use_fun)then + smin_no3_to_plant_vr(c,j) = (plant_ndemand(c)*nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j)) + else + ! This restricts the N uptake of a single layer to the value determined from the total demands and the + ! hypothetical uptake profile above. Which is a strange thing to do, since that is independent of FUN + ! do we need this at all? + smin_no3_to_plant_vr(c,j) = plant_ndemand(c)*nuptake_prof(c,j) + ! RF added new term. send rest of N to plant - which decides whether it should pay or not? + if ( local_use_fun ) then + smin_no3_to_plant_vr(c,j) = smin_no3_vr(c,j)/dt - actual_immob_no3_vr(c,j) - f_denit_vr(c,j) + end if + endif + + else + + ! NO3 availability can not satisfy the sum of immobilization, denitrification, and + ! plant growth demands, so these three demands compete for available + ! soil mineral NO3 resource. + nlimit_no3(c,j) = 1 + + if (sum_no3_demand(c,j) > 0.0_r8) then + if(.not.local_use_fun)then + actual_immob_no3_vr(c,j) = min((smin_no3_vr(c,j)/dt)*((potential_immob_vr(c,j)- & + actual_immob_nh4_vr(c,j))*compet_decomp_no3 / sum_no3_demand_scaled(c,j)), & + potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j)) + + smin_no3_to_plant_vr(c,j) = min((smin_no3_vr(c,j)/dt)*((plant_ndemand(c)* & + nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j))*compet_plant_no3 / sum_no3_demand_scaled(c,j)), & + plant_ndemand(c)*nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j)) + + f_denit_vr(c,j) = min((smin_no3_vr(c,j)/dt)*(pot_f_denit_vr(c,j)*compet_denit / & + sum_no3_demand_scaled(c,j)), pot_f_denit_vr(c,j)) + else + actual_immob_no3_vr(c,j) = min((smin_no3_vr(c,j)/dt)*((potential_immob_vr(c,j)- & + actual_immob_nh4_vr(c,j))*compet_decomp_no3 / sum_no3_demand_scaled(c,j)), & + potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j)) + + f_denit_vr(c,j) = min((smin_no3_vr(c,j)/dt)*(pot_f_denit_vr(c,j)*compet_denit / & + sum_no3_demand_scaled(c,j)), pot_f_denit_vr(c,j)) + + smin_no3_to_plant_vr(c,j) = (smin_no3_vr(c,j)/dt)*((plant_ndemand(c)* & + nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j))*compet_plant_no3 / sum_no3_demand_scaled(c,j)) + + ! RF added new term. send rest of N to plant - which decides whether it should pay or not? + smin_no3_to_plant_vr(c,j) = (smin_no3_vr(c,j) / dt) - actual_immob_no3_vr(c,j) - f_denit_vr(c,j) + + + end if ! use_fun + + else ! no no3 demand. no uptake fluxes. + actual_immob_no3_vr(c,j) = 0.0_r8 + smin_no3_to_plant_vr(c,j) = 0.0_r8 + f_denit_vr(c,j) = 0.0_r8 + + end if !any no3 demand? + + + + + if (potential_immob_vr(c,j) > 0.0_r8) then + fpi_no3_vr(c,j) = actual_immob_no3_vr(c,j) / potential_immob_vr(c,j) + else + fpi_no3_vr(c,j) = 0.0_r8 + end if + + end if + + + + + ! n2o emissions: n2o from nitr is const fraction, n2o from denitr is calculated in nitrif_denitrif + f_n2o_nit_vr(c,j) = f_nit_vr(c,j) * nitrif_n2o_loss_frac + f_n2o_denit_vr(c,j) = f_denit_vr(c,j) / (1._r8 + n2_n2o_ratio_denit_vr(c,j)) + + + ! this code block controls the addition of N to sminn pool + ! to eliminate any N limitation, when Carbon_Only is set. This lets the + ! model behave essentially as a carbon-only model, but with the + ! benefit of keeping track of the N additions needed to + ! eliminate N limitations, so there is still a diagnostic quantity + ! that describes the degree of N limitation at steady-state. + + if ( cnallocate_carbon_only()) then !.or. & + if ( fpi_no3_vr(c,j) + fpi_nh4_vr(c,j) < 1._r8 ) then + fpi_nh4_vr(c,j) = 1.0_r8 - fpi_no3_vr(c,j) + supplement_to_sminn_vr(c,j) = (potential_immob_vr(c,j) & + - actual_immob_no3_vr(c,j)) - actual_immob_nh4_vr(c,j) + ! update to new values that satisfy demand + actual_immob_nh4_vr(c,j) = potential_immob_vr(c,j) - actual_immob_no3_vr(c,j) + end if + if ( smin_no3_to_plant_vr(c,j) + smin_nh4_to_plant_vr(c,j) < plant_ndemand(c)*nuptake_prof(c,j) ) then + supplement_to_sminn_vr(c,j) = supplement_to_sminn_vr(c,j) + & + (plant_ndemand(c)*nuptake_prof(c,j) - smin_no3_to_plant_vr(c,j)) - smin_nh4_to_plant_vr(c,j) ! use old values + smin_nh4_to_plant_vr(c,j) = plant_ndemand(c)*nuptake_prof(c,j) - smin_no3_to_plant_vr(c,j) + end if + sminn_to_plant_vr(c,j) = smin_no3_to_plant_vr(c,j) + smin_nh4_to_plant_vr(c,j) + end if + + ! sum up no3 and nh4 fluxes + fpi_vr(c,j) = fpi_no3_vr(c,j) + fpi_nh4_vr(c,j) + sminn_to_plant_vr(c,j) = smin_no3_to_plant_vr(c,j) + smin_nh4_to_plant_vr(c,j) + actual_immob_vr(c,j) = actual_immob_no3_vr(c,j) + actual_immob_nh4_vr(c,j) + end do + end do + + if ( local_use_fun ) then +! call t_startf( 'CNFUN' ) +! call CNFUN(bounds,num_soilc,filter_soilc,num_soilp,filter_soilp,waterstatebulk_inst,& +! waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst,cnveg_carbonstate_inst,& +! cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst ,& +! soilbiogeochem_nitrogenflux_inst,soilbiogeochem_carbonflux_inst,canopystate_inst, & +! soilbiogeochem_nitrogenstate_inst) +! +! ! sminn_to_plant_fun is output of actual N uptake from FUN +! call p2c(bounds,nlevdecomp, & +! cnveg_nitrogenflux_inst%sminn_to_plant_fun_no3_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& +! soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_no3_vr_col(bounds%begc:bounds%endc,1:nlevdecomp),& +! 'unity') +! +! call p2c(bounds,nlevdecomp, & +! cnveg_nitrogenflux_inst%sminn_to_plant_fun_nh4_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& +! soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_nh4_vr_col(bounds%begc:bounds%endc,1:nlevdecomp),& +! 'unity') +! call t_stopf( 'CNFUN' ) + end if + + + + if(.not.local_use_fun)then + do fc=1,num_soilc + c = filter_soilc(fc) + ! sum up N fluxes to plant after initial competition + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) + end do + end do + else + do fc=1,num_soilc + c = filter_soilc(fc) + ! sum up N fluxes to plant after initial competition + sminn_to_plant(c) = 0._r8 !this isn't use in fun. + do j = 1, nlevdecomp + if ((sminn_to_plant_fun_no3_vr(c,j)-smin_no3_to_plant_vr(c,j)).gt.0.0000000000001_r8) then + write(iulog,*) 'problem with limitations on no3 uptake', & + sminn_to_plant_fun_no3_vr(c,j),smin_no3_to_plant_vr(c,j) + call endrun("too much NO3 uptake predicted by FUN") + end if +!KO if ((sminn_to_plant_fun_nh4_vr(c,j)-smin_nh4_to_plant_vr(c,j)).gt.0.0000000000001_r8) then +!KO + if ((sminn_to_plant_fun_nh4_vr(c,j)-smin_nh4_to_plant_vr(c,j)).gt.0.0000001_r8) then +!KO + write(iulog,*) 'problem with limitations on nh4 uptake', & + sminn_to_plant_fun_nh4_vr(c,j),smin_nh4_to_plant_vr(c,j) + call endrun("too much NH4 uptake predicted by FUN") + end if + end do + end do + + end if + + if(.not.local_use_fun)then + ! give plants a second pass to see if there is any mineral N left over with which to satisfy residual N demand. + ! first take frm nh4 pool; then take from no3 pool + do fc=1,num_soilc + c = filter_soilc(fc) + residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) + residual_smin_nh4(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (residual_plant_ndemand(c) > 0._r8 ) then + if (nlimit_nh4(c,j) .eq. 0) then + residual_smin_nh4_vr(c,j) = max(smin_nh4_vr(c,j) - (actual_immob_nh4_vr(c,j) + & + smin_nh4_to_plant_vr(c,j) + f_nit_vr(c,j) ) * dt, 0._r8) + + residual_smin_nh4(c) = residual_smin_nh4(c) + residual_smin_nh4_vr(c,j) * dzsoi_decomp(j) + else + residual_smin_nh4_vr(c,j) = 0._r8 + endif + + if ( residual_smin_nh4(c) > 0._r8 .and. nlimit_nh4(c,j) .eq. 0 ) then + smin_nh4_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + residual_smin_nh4_vr(c,j) * & + min(( residual_plant_ndemand(c) * dt ) / residual_smin_nh4(c), 1._r8) / dt + endif + end if + end do + end do + + ! re-sum up N fluxes to plant after second pass for nh4 + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + smin_no3_to_plant_vr(c,j) + sminn_to_plant(c) = sminn_to_plant(c) + (sminn_to_plant_vr(c,j)) * dzsoi_decomp(j) + end do + end do + + ! + ! and now do second pass for no3 + do fc=1,num_soilc + c = filter_soilc(fc) + residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) + residual_smin_no3(c) = 0._r8 + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (residual_plant_ndemand(c) > 0._r8 ) then + if (nlimit_no3(c,j) .eq. 0) then + residual_smin_no3_vr(c,j) = max(smin_no3_vr(c,j) - (actual_immob_no3_vr(c,j) + & + smin_no3_to_plant_vr(c,j) + f_denit_vr(c,j) ) * dt, 0._r8) + residual_smin_no3(c) = residual_smin_no3(c) + residual_smin_no3_vr(c,j) * dzsoi_decomp(j) + else + residual_smin_no3_vr(c,j) = 0._r8 + endif + + if ( residual_smin_no3(c) > 0._r8 .and. nlimit_no3(c,j) .eq. 0) then + smin_no3_to_plant_vr(c,j) = smin_no3_to_plant_vr(c,j) + residual_smin_no3_vr(c,j) * & + min(( residual_plant_ndemand(c) * dt ) / residual_smin_no3(c), 1._r8) / dt + endif + endif + end do + end do + + ! re-sum up N fluxes to plant after second passes of both no3 and nh4 + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + smin_no3_to_plant_vr(c,j) + sminn_to_plant(c) = sminn_to_plant(c) + (sminn_to_plant_vr(c,j)) * dzsoi_decomp(j) + end do + end do + + else !use_fun + !calculate maximum N available to plants. + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + smin_no3_to_plant_vr(c,j) + sminn_to_plant(c) = sminn_to_plant(c) + (sminn_to_plant_vr(c,j)) * dzsoi_decomp(j) + end do + end do + + + ! add up fun fluxes from SMINN to plant. + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant_new(c) = sminn_to_plant_new(c) + & + (sminn_to_plant_fun_no3_vr(c,j) + sminn_to_plant_fun_nh4_vr(c,j)) * dzsoi_decomp(j) + + end do + end do + + + end if !use_f + ! sum up N fluxes to immobilization + do fc=1,num_soilc + c = filter_soilc(fc) + actual_immob(c) = 0._r8 + potential_immob(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + actual_immob(c) = actual_immob(c) + actual_immob_vr(c,j) * dzsoi_decomp(j) + potential_immob(c) = potential_immob(c) + potential_immob_vr(c,j) * dzsoi_decomp(j) + end do + end do + + + + + do fc=1,num_soilc + c = filter_soilc(fc) + ! calculate the fraction of potential growth that can be + ! acheived with the N available to plants + ! calculate the fraction of immobilization realized (for diagnostic purposes) + if(.not.local_use_fun)then !FUN has no concept of FPG. + + if (plant_ndemand(c) > 0.0_r8) then + fpg(c) = sminn_to_plant(c) / plant_ndemand(c) + else + fpg(c) = 1._r8 + end if + end if + + if (potential_immob(c) > 0.0_r8) then + fpi(c) = actual_immob(c) / potential_immob(c) + else + fpi(c) = 1._r8 + end if + end do ! end of column loops + + end if !end of if_not_use_nitrif_denitrif + + end associate + + end subroutine SoilBiogeochemCompetition + +end module SoilBiogeochemCompetitionMod From 8214f26d9920d9a06e18c6b54d75dac8f3d0b351 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 4 Jan 2023 16:01:10 -0500 Subject: [PATCH 263/589] soil biogeochemistry decomposition module --- .../CLM51/SoilBiogeochemDecompMod.F90 | 282 ++++++++++++++++++ 1 file changed, 282 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 new file mode 100755 index 000000000..3e7f27ee6 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 @@ -0,0 +1,282 @@ +module SoilBiogeochemDecompMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines used in litter and soil decomposition model + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varpar , only : nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use clm_varctl , only : use_nitrif_denitrif, use_lch4, use_fates, use_soil_matrixcn + use clm_varcon , only : dzsoi_decomp + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: SoilBiogeochemDecomp + ! + type, private :: params_type + real(r8) :: dnp !denitrification proportion + end type params_type + ! + type(params_type), private :: params_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read parameters + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + use abortutils , only: endrun + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='dnp' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%dnp=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cn_decomp_pools, p_decomp_cpool_loss, pmnf_decomp_cascade) + ! + ! !USES: + use SoilBiogeochemDecompCascadeConType, only : i_atm + ! + ! !ARGUMENT: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + real(r8) , intent(inout) :: cn_decomp_pools(bounds%begc:,1:,1:) ! c:n ratios of applicable pools + real(r8) , intent(inout) :: p_decomp_cpool_loss(bounds%begc:,1:,1:) ! potential C loss from one pool to another + real(r8) , intent(inout) :: pmnf_decomp_cascade(bounds%begc:,1:,1:) ! potential mineral N flux from one pool to another + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l,m ! indices + integer :: fc ! lake filter column index + integer :: begc,endc ! bounds + ! For methane code + real(r8):: hrsum(bounds%begc:bounds%endc,1:nlevdecomp) ! sum of HR (gC/m2/s) + !----------------------------------------------------------------------- + + begc = bounds%begc; endc = bounds%endc + + SHR_ASSERT_ALL_FL((ubound(cn_decomp_pools) == (/endc,nlevdecomp,ndecomp_pools/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(p_decomp_cpool_loss) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(pmnf_decomp_cascade) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , sourcefile, __LINE__) + + associate( & + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Input: [logical (:) ] TRUE => pool has fixed C:N ratio + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Input: [real(r8) (:) ] c:n ratio for initialization of pools + + fpi_vr => soilbiogeochem_state_inst%fpi_vr_col , & ! Input: [real(r8) (:,:) ] fraction of potential immobilization (no units) + rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac) + pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac) + + decomp_npools_vr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + decomp_cpools_vr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + + decomp_cascade_ntransfer_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_ntransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) + decomp_cascade_sminn_flux_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_sminn_flux_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res mineral N flux for transition along decomposition cascade (gN/m3/s) + potential_immob_vr => soilbiogeochem_nitrogenflux_inst%potential_immob_vr_col , & ! Output: [real(r8) (:,:) ] + sminn_to_denit_decomp_cascade_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_denit_decomp_cascade_vr_col , & ! Output: [real(r8) (:,:,:) ] + gross_nmin_vr => soilbiogeochem_nitrogenflux_inst%gross_nmin_vr_col , & ! Output: [real(r8) (:,:) ] + net_nmin_vr => soilbiogeochem_nitrogenflux_inst%net_nmin_vr_col , & ! Output: [real(r8) (:,:) ] + gross_nmin => soilbiogeochem_nitrogenflux_inst%gross_nmin_col , & ! Output: [real(r8) (:) ] gross rate of N mineralization (gN/m2/s) + net_nmin => soilbiogeochem_nitrogenflux_inst%net_nmin_col , & ! Output: [real(r8) (:) ] net rate of N mineralization (gN/m2/s) + + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] fraction by which decomposition is limited by moisture availability + decomp_cascade_hr_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_hr_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + decomp_cascade_ctransfer_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Input: [real(r8) (:,:) ] potential HR (gC/m3/s) + fphr => soilbiogeochem_carbonflux_inst%fphr_col , & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic + Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! In/Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ) + + ! column loop to calculate actual immobilization and decomp rates, following + ! resolution of plant/heterotroph competition for mineral N + + if ( .not. use_fates) then + ! calculate c:n ratios of applicable pools + do l = 1, ndecomp_pools + if ( floating_cn_ratio_decomp_pools(l) ) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if ( decomp_npools_vr(c,j,l) > 0._r8 ) then + cn_decomp_pools(c,j,l) = decomp_cpools_vr(c,j,l) / decomp_npools_vr(c,j,l) + end if + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cn_decomp_pools(c,j,l) = initial_cn_ratio(l) + end do + end do + end if + end do + + ! column loop to calculate actual immobilization and decomp rates, following + ! resolution of plant/heterotroph competition for mineral N + + ! upon return from SoilBiogeochemCompetition, the fraction of potential immobilization + ! has been set (soilbiogeochem_state_inst%fpi_vr_col). now finish the decomp calculations. + ! Only the immobilization steps are limited by fpi_vr (pmnf > 0) + ! Also calculate denitrification losses as a simple proportion + ! of mineralization flux. + + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (decomp_cpools_vr(c,j,cascade_donor_pool(k)) > 0._r8) then + if ( pmnf_decomp_cascade(c,j,k) > 0._r8 ) then + p_decomp_cpool_loss(c,j,k) = p_decomp_cpool_loss(c,j,k) * fpi_vr(c,j) + pmnf_decomp_cascade(c,j,k) = pmnf_decomp_cascade(c,j,k) * fpi_vr(c,j) + if (use_soil_matrixcn)then ! correct only when one transfer from each litter pool + Ksoil%DM(c,j+nlevdecomp*(cascade_donor_pool(k)-1)) & + = Ksoil%DM(c,j+nlevdecomp*(cascade_donor_pool(k)-1)) * fpi_vr(c,j) + end if + if (.not. use_nitrif_denitrif) then + sminn_to_denit_decomp_cascade_vr(c,j,k) = 0._r8 + end if + else + if (.not. use_nitrif_denitrif) then + sminn_to_denit_decomp_cascade_vr(c,j,k) = -params_inst%dnp * pmnf_decomp_cascade(c,j,k) + end if + end if + decomp_cascade_hr_vr(c,j,k) = rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) + decomp_cascade_ctransfer_vr(c,j,k) = (1._r8 - rf_decomp_cascade(c,j,k)) * p_decomp_cpool_loss(c,j,k) + if (decomp_npools_vr(c,j,cascade_donor_pool(k)) > 0._r8 .and. cascade_receiver_pool(k) /= i_atm) then + decomp_cascade_ntransfer_vr(c,j,k) = p_decomp_cpool_loss(c,j,k) / cn_decomp_pools(c,j,cascade_donor_pool(k)) + else + decomp_cascade_ntransfer_vr(c,j,k) = 0._r8 + endif + if ( cascade_receiver_pool(k) /= 0 ) then + decomp_cascade_sminn_flux_vr(c,j,k) = pmnf_decomp_cascade(c,j,k) + else ! keep sign convention negative for terminal pools + decomp_cascade_sminn_flux_vr(c,j,k) = - pmnf_decomp_cascade(c,j,k) + endif + net_nmin_vr(c,j) = net_nmin_vr(c,j) - pmnf_decomp_cascade(c,j,k) + else + decomp_cascade_ntransfer_vr(c,j,k) = 0._r8 + if (.not. use_nitrif_denitrif) then + sminn_to_denit_decomp_cascade_vr(c,j,k) = 0._r8 + end if + decomp_cascade_sminn_flux_vr(c,j,k) = 0._r8 + end if + + end do + end do + end do + else + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ! + decomp_cascade_hr_vr(c,j,k) = rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) + ! + decomp_cascade_ctransfer_vr(c,j,k) = (1._r8 - rf_decomp_cascade(c,j,k)) * p_decomp_cpool_loss(c,j,k) + ! + end do + end do + end do + end if + + if (use_lch4) then + ! Calculate total fraction of potential HR, for methane code + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + hrsum(c,j) = 0._r8 + end do + end do + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + hrsum(c,j) = hrsum(c,j) + rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) + end do + end do + end do + + + ! Nitrogen limitation / (low)-moisture limitation + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (phr_vr(c,j) > 0._r8) then + fphr(c,j) = hrsum(c,j) / phr_vr(c,j) * w_scalar(c,j) + fphr(c,j) = max(fphr(c,j), 0.01_r8) ! Prevent overflow errors for 0 respiration + else + fphr(c,j) = 1._r8 + end if + end do + end do + end if + + + ! vertically integrate net and gross mineralization fluxes for diagnostic output + + do fc = 1,num_soilc + c = filter_soilc(fc) + do j = 1,nlevdecomp + if(.not.use_fates)then + net_nmin(c) = net_nmin(c) + net_nmin_vr(c,j) * dzsoi_decomp(j) + gross_nmin(c) = gross_nmin(c) + gross_nmin_vr(c,j) * dzsoi_decomp(j) + ! else + ! net_nmin(c) = 0.0_r8 + ! gross_nmin(c) = 0.0_r8 + endif + end do + end do + + end associate + + end subroutine SoilBiogeochemDecomp + +end module SoilBiogeochemDecompMod From 96355fdad2996c37168aa32e0d82c551ca34215b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 09:03:51 -0500 Subject: [PATCH 264/589] add new module files --- .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 5a2f83717..da1d2dd38 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -121,7 +121,9 @@ set (srcs SoilBiogeochemLittVertTranspMod.F90 SoilBiogeochemNLeachingMod.F90 SoilBiogeochemNStateUpdate1Mod.F90 + SoilBiogeochemPotentialMod.F90 SoilBiogeochemPrecisionControlMod.F90 + SoilBiogeochemVerticalProfileMod.F90 SoilWaterRetentionCurveMod.F90 spmdMod.F90 subgridAveMod.F90 From c95b3e9f4bc7b2ef3605bf9411159bdfb6ba376b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 09:04:13 -0500 Subject: [PATCH 265/589] add harvest check --- .../CLM51/CNCLM_dynSubgridControlMod.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 index 9a60a90bc..bc1c12d2a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 @@ -21,6 +21,7 @@ module dynSubgridControlMod ! !PUBLIC MEMBER FUNCTIONS: public :: get_do_transient_pfts ! return the value of the do_transient_pfts control flag public :: get_do_transient_crops ! return the value of the do_transient_crops control flag + public :: get_do_harvest ! return the value of the do_harvest control flag public :: run_has_transient_landcover ! returns true if any aspects of prescribed transient landcover are enabled ! ! !PRIVATE TYPES: @@ -116,4 +117,15 @@ end function run_has_transient_landcover !----------------------------------------------------------------------- + logical function get_do_harvest() + ! !DESCRIPTION: + ! Return the value of the do_harvest control flag + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(dyn_subgrid_control_inst%initialized, sourcefile, __LINE__) + + get_do_harvest = dyn_subgrid_control_inst%do_harvest + + end function get_do_harvest + end module dynSubgridControlMod From cb335536da20c879564a2fc39912d22a49c3bb61 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 09:04:42 -0500 Subject: [PATCH 266/589] remove unused functions that need additional modules to compile --- .../CLM51/CNDriverMod.F90 | 44 +++++++++---------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 index d51ae303e..818b47334 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -129,7 +129,7 @@ subroutine CNDriverNoLeaching(bounds, use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h use CNGapMortalityMod , only: CNGapMortality use CNSharedParamsMod , only: use_fun - use dynHarvestMod , only: CNHarvest + ! use dynHarvestMod , only: CNHarvest use SoilBiogeochemDecompCascadeBGCMod , only: decomp_rate_constants_bgc use SoilBiogeochemDecompCascadeCNMod , only: decomp_rate_constants_cn use SoilBiogeochemCompetitionMod , only: SoilBiogeochemCompetition @@ -690,9 +690,9 @@ subroutine CNDriverNoLeaching(bounds, ! Set harvest mortality routine if (get_do_harvest()) then - call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & - cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) +! call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & +! cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end if if ( use_c13 ) then @@ -882,9 +882,9 @@ subroutine CNDriverLeaching(bounds, & ! !USES: use SoilBiogeochemNLeachingMod, only: SoilBiogeochemNLeaching use CNNStateUpdate3Mod , only: NStateUpdate3 - use CNVegMatrixMod , only: CNVegMatrix - use CNSoilMatrixMod , only: CNSoilMatrix - use clm_time_manager , only : is_first_step_of_this_run_segment,is_beg_curr_year,is_end_curr_year,get_curr_date + ! use CNVegMatrixMod , only: CNVegMatrix + ! use CNSoilMatrixMod , only: CNSoilMatrix + use clm_time_manager , only : is_beg_curr_year,get_curr_date ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -938,24 +938,24 @@ subroutine CNDriverLeaching(bounds, & call t_stopf('NUpdate3') if(use_matrixcn)then - call t_startf('CNVMatrix') - call CNVegMatrix(bounds,num_soilp,filter_soilp(1:num_soilp),num_actfirep,filter_actfirep,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst,& - cnveg_carbonflux_inst, cnveg_nitrogenflux_inst,cnveg_state_inst,soilbiogeochem_nitrogenflux_inst,& - c13_cnveg_carbonstate_inst,c14_cnveg_carbonstate_inst,c13_cnveg_carbonflux_inst,& - c14_cnveg_carbonflux_inst) - call t_stopf('CNVMatrix') +! call t_startf('CNVMatrix') +! call CNVegMatrix(bounds,num_soilp,filter_soilp(1:num_soilp),num_actfirep,filter_actfirep,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst,& +! cnveg_carbonflux_inst, cnveg_nitrogenflux_inst,cnveg_state_inst,soilbiogeochem_nitrogenflux_inst,& +! c13_cnveg_carbonstate_inst,c14_cnveg_carbonstate_inst,c13_cnveg_carbonflux_inst,& +! c14_cnveg_carbonflux_inst) +! call t_stopf('CNVMatrix') end if if(use_soil_matrixcn)then - call t_startf('CNSoilMatrix') - call CNSoilMatrix(bounds,num_soilc, filter_soilc(1:num_soilc), num_actfirec, filter_actfirec, & - cnveg_carbonflux_inst,soilbiogeochem_carbonstate_inst, & - soilbiogeochem_carbonflux_inst,soilbiogeochem_state_inst, & - cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst, & - soilbiogeochem_nitrogenstate_inst,c13_soilbiogeochem_carbonstate_inst,& - c13_soilbiogeochem_carbonflux_inst,c14_soilbiogeochem_carbonstate_inst,& - c14_soilbiogeochem_carbonflux_inst) - call t_stopf('CNSoilMatrix') +! call t_startf('CNSoilMatrix') +! call CNSoilMatrix(bounds,num_soilc, filter_soilc(1:num_soilc), num_actfirec, filter_actfirec, & +! cnveg_carbonflux_inst,soilbiogeochem_carbonstate_inst, & +! soilbiogeochem_carbonflux_inst,soilbiogeochem_state_inst, & +! cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst, & +! soilbiogeochem_nitrogenstate_inst,c13_soilbiogeochem_carbonstate_inst,& +! c13_soilbiogeochem_carbonflux_inst,c14_soilbiogeochem_carbonstate_inst,& +! c14_soilbiogeochem_carbonflux_inst) +! call t_stopf('CNSoilMatrix') end if end subroutine CNDriverLeaching From ac0e89eb327fd994f18f1e563bada2c3a9456720 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 09:05:03 -0500 Subject: [PATCH 267/589] add parameter read for new modules --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index c2fbbd763..de36d98d6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -66,6 +66,7 @@ module CN_initMod use FireMethodType , only : fire_method_type use SoilBiogeochemNLeachingMod , only : readSoilBiogeochemNLeachingParams => readParams use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams + use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -298,6 +299,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call cnfire_method%CNFireReadParams( ncid ) call readSoilBiogeochemNLeachingParams(ncid) call readSoilBiogeochemCompetitionParams(ncid) + call readSoilBiogeochemPotentialParams(ncid) call ncid%close(rc=status) From 62ad44db266ee3cb423f02cc88ce6fd33cd24ec0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 09:05:17 -0500 Subject: [PATCH 268/589] new module --- .../CLM51/SoilBiogeochemPotentialMod.F90 | 264 ++++++++++++++++++ 1 file changed, 264 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemPotentialMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemPotentialMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemPotentialMod.F90 new file mode 100755 index 000000000..b9b9afad0 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemPotentialMod.F90 @@ -0,0 +1,264 @@ +module SoilBiogeochemPotentialMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate potential decomp rates and total immobilization demand. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varpar , only : nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use clm_varctl , only : use_fates, iulog + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: SoilBiogeochemPotential + ! + type, private :: params_type + real(r8) :: dnp !denitrification proportion + end type Params_type + ! + type(params_type), private :: params_inst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read parameters + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + use abortutils , only: endrun + use shr_log_mod , only: errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNDecompParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='dnp' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%dnp=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cn_decomp_pools, p_decomp_cpool_loss, pmnf_decomp_cascade) + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use SoilBiogeochemDecompCascadeConType, only : i_atm + ! + ! !ARGUMENT: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + real(r8) , intent(out) :: cn_decomp_pools(bounds%begc:,1:,1:) ! c:n ratios of applicable pools + real(r8) , intent(out) :: p_decomp_cpool_loss(bounds%begc:,1:,1:) ! potential C loss from one pool to another + real(r8) , intent(out) :: pmnf_decomp_cascade(bounds%begc:,1:,1:) ! potential mineral N flux, from one pool to another + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l,m !indices + integer :: fc !filter column index + integer :: begc,endc !bounds + real(r8):: immob(bounds%begc:bounds%endc,1:nlevdecomp) !potential N immobilization + real(r8):: ratio !temporary variable + !----------------------------------------------------------------------- + + begc = bounds%begc; endc = bounds%endc + + SHR_ASSERT_ALL_FL((ubound(cn_decomp_pools) == (/endc,nlevdecomp,ndecomp_pools/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(p_decomp_cpool_loss) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(pmnf_decomp_cascade) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , sourcefile, __LINE__) + + associate( & + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Input: [logical (:) ] TRUE => pool has fixed C:N ratio + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Input: [real(r8) (:) ] c:n ratio for initialization of pools + + fpi_vr => soilbiogeochem_state_inst%fpi_vr_col , & ! Input: [real(r8) (:,:) ] fraction of potential immobilization (no units) + rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac) + pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac) + + decomp_npools_vr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + + decomp_cpools_vr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + + decomp_cascade_ntransfer_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_ntransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) + decomp_cascade_sminn_flux_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_sminn_flux_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res mineral N flux for transition along decomposition cascade (gN/m3/s) + potential_immob_vr => soilbiogeochem_nitrogenflux_inst%potential_immob_vr_col , & ! Output: [real(r8) (:,:) ] + sminn_to_denit_decomp_cascade_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_denit_decomp_cascade_vr_col , & ! Output: [real(r8) (:,:,:) ] + gross_nmin_vr => soilbiogeochem_nitrogenflux_inst%gross_nmin_vr_col , & ! Output: [real(r8) (:,:) ] + net_nmin_vr => soilbiogeochem_nitrogenflux_inst%net_nmin_vr_col , & ! Output: [real(r8) (:,:) ] + gross_nmin => soilbiogeochem_nitrogenflux_inst%gross_nmin_col , & ! Output: [real(r8) (:) ] gross rate of N mineralization (gN/m2/s) + net_nmin => soilbiogeochem_nitrogenflux_inst%net_nmin_col , & ! Output: [real(r8) (:) ] net rate of N mineralization (gN/m2/s) + + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] fraction by which decomposition is limited by moisture availability + decomp_cascade_hr_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_hr_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + decomp_cascade_ctransfer_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Output: [real(r8) (:,:) ] potential HR (gC/m3/s) + fphr => soilbiogeochem_carbonflux_inst%fphr_col & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic + ) + + if ( .not. use_fates ) then + ! set initial values for potential C and N fluxes + p_decomp_cpool_loss(begc:endc, :, :) = 0._r8 + pmnf_decomp_cascade(begc:endc, :, :) = 0._r8 + + ! column loop to calculate potential decomp rates and total immobilization demand + + !! calculate c:n ratios of applicable pools + do l = 1, ndecomp_pools + if ( floating_cn_ratio_decomp_pools(l) ) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if ( decomp_npools_vr(c,j,l) > 0._r8 ) then + cn_decomp_pools(c,j,l) = decomp_cpools_vr(c,j,l) / decomp_npools_vr(c,j,l) + end if + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cn_decomp_pools(c,j,l) = initial_cn_ratio(l) + end do + end do + end if + end do + + ! calculate the non-nitrogen-limited fluxes + ! these fluxes include the "/ dt" term to put them on a + ! per second basis, since the rate constants have been + ! calculated on a per timestep basis. + + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (decomp_cpools_vr(c,j,cascade_donor_pool(k)) > 0._r8 .and. & + decomp_k(c,j,cascade_donor_pool(k)) > 0._r8 ) then + p_decomp_cpool_loss(c,j,k) = decomp_cpools_vr(c,j,cascade_donor_pool(k)) & + * decomp_k(c,j,cascade_donor_pool(k)) * pathfrac_decomp_cascade(c,j,k) + if ( .not. floating_cn_ratio_decomp_pools(cascade_receiver_pool(k)) ) then !! not transition of cwd to litter + + if (cascade_receiver_pool(k) /= i_atm ) then ! not 100% respiration + ratio = 0._r8 + + if (decomp_npools_vr(c,j,cascade_donor_pool(k)) > 0._r8) then + ratio = cn_decomp_pools(c,j,cascade_receiver_pool(k))/cn_decomp_pools(c,j,cascade_donor_pool(k)) + endif + + pmnf_decomp_cascade(c,j,k) = (p_decomp_cpool_loss(c,j,k) * (1.0_r8 - rf_decomp_cascade(c,j,k) - ratio) & + / cn_decomp_pools(c,j,cascade_receiver_pool(k)) ) + + else ! 100% respiration + pmnf_decomp_cascade(c,j,k) = - p_decomp_cpool_loss(c,j,k) / cn_decomp_pools(c,j,cascade_donor_pool(k)) + endif + + else ! CWD -> litter + pmnf_decomp_cascade(c,j,k) = 0._r8 + end if + end if + end do + + end do + end do + + ! Sum up all the potential immobilization fluxes (positive pmnf flux) + ! and all the mineralization fluxes (negative pmnf flux) + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + immob(c,j) = 0._r8 + end do + end do + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pmnf_decomp_cascade(c,j,k) > 0._r8) then + immob(c,j) = immob(c,j) + pmnf_decomp_cascade(c,j,k) + else + gross_nmin_vr(c,j) = gross_nmin_vr(c,j) - pmnf_decomp_cascade(c,j,k) + end if + end do + end do + end do + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + potential_immob_vr(c,j) = immob(c,j) + end do + end do + else ! use_fates + ! As a first step we are making this a C-only model, so no N downregulation of fluxes. + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + p_decomp_cpool_loss(c,j,k) = decomp_cpools_vr(c,j,cascade_donor_pool(k)) & + * decomp_k(c,j,cascade_donor_pool(k)) * pathfrac_decomp_cascade(c,j,k) + end do + end do + end do + end if + + ! Add up potential hr for methane calculations + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + phr_vr(c,j) = 0._r8 + end do + end do + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + phr_vr(c,j) = phr_vr(c,j) + rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) + end do + end do + end do + + end associate + + end subroutine SoilBiogeochemPotential + +end module SoilBiogeochemPotentialMod From 39be3b9a85c10233c90e25887830249ccab0ecdb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 09:05:33 -0500 Subject: [PATCH 269/589] new module --- .../SoilBiogeochemVerticalProfileMod.F90 | 277 ++++++++++++++++++ 1 file changed, 277 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemVerticalProfileMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemVerticalProfileMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemVerticalProfileMod.F90 new file mode 100755 index 000000000..fe689d975 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemVerticalProfileMod.F90 @@ -0,0 +1,277 @@ +module SoilBiogeochemVerticalProfileMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate vertical profiles for distributing soil and litter C and N + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: SoilBiogeochemVerticalProfile + ! + real(r8), public :: surfprof_exp = 10. ! how steep profile is for surface components (1/ e_folding depth) (1/m) + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soilp,filter_soilp, & + active_layer_inst, soilstate_inst, soilbiogeochem_state_inst) + ! + ! !DESCRIPTION: + ! calculate vertical profiles for distributing soil and litter C and N + ! + ! BUG(wjs, 2014-12-15, bugz 2107) + ! Because of this routine's placement in the driver sequence (it is + ! called very early in each timestep, before weights are adjusted and filters are + ! updated), it may be necessary for this routine to compute values over inactive as well + ! as active points (since some inactive points may soon become active) - so that's what + ! is done now. Currently, it seems to be okay to do this, because the variables computed + ! here seem to only depend on quantities that are valid over inactive as well as active + ! points. However, note that this routine is (mistakenly) called from two places + ! currently - the above note applies to its call from the driver, but its call from + ! CNDecompMod uses the standard filters that just apply over active points + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varcon , only : zsoi, dzsoi, zisoi, dzsoi_decomp, zmin_bedrock + use clm_varpar , only : nlevdecomp, nlevgrnd, nlevdecomp_full, maxsoil_patches + use clm_varctl , only : use_vertsoilc, iulog, use_bedrock + use pftconMod , only : noveg, pftcon + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use ActiveLayerMod , only : active_layer_type + use SoilStateType , only : soilstate_type + use ColumnType , only : col + use PatchType , only : patch + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(active_layer_type) , intent(in) :: active_layer_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: surface_prof(1:nlevdecomp) + real(r8) :: surface_prof_tot + real(r8) :: rootfr_tot + real(r8) :: cinput_rootfr(bounds%begp:bounds%endp, 1:nlevdecomp_full) ! pft-native root fraction used for calculating inputs + real(r8) :: col_cinput_rootfr(bounds%begc:bounds%endc, 1:nlevdecomp_full) ! col-native root fraction used for calculating inputs + integer :: c, j, fc, p, fp, pi + integer :: alt_ind + ! debugging temp variables + real(r8) :: froot_prof_sum + real(r8) :: croot_prof_sum + real(r8) :: leaf_prof_sum + real(r8) :: stem_prof_sum + real(r8) :: ndep_prof_sum + real(r8) :: nfixation_prof_sum + real(r8) :: delta = 1.e-10 + integer :: begp, endp + integer :: begc, endc + character(len=32) :: subname = 'SoilBiogeochemVerticalProfile' + !----------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + associate( & + altmax_lastyear_indx => active_layer_inst%altmax_lastyear_indx_col , & ! Input: [integer (:) ] frost table depth (m) + + crootfr => soilstate_inst%crootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevgrnd) + + nfixation_prof => soilbiogeochem_state_inst%nfixation_prof_col , & ! Input : [real(r8) (:,:) ] (1/m) profile for N fixation additions + ndep_prof => soilbiogeochem_state_inst%ndep_prof_col , & ! Input : [real(r8) (:,:) ] (1/m) profile for N fixation additions + leaf_prof => soilbiogeochem_state_inst%leaf_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => soilbiogeochem_state_inst%froot_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of fine roots + croot_prof => soilbiogeochem_state_inst%croot_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => soilbiogeochem_state_inst%stem_prof_patch & ! Output : [real(r8) (:,:) ] (1/m) profile of stems + ) + + if (use_vertsoilc) then + + ! define a single shallow surface profile for surface additions (leaves, stems, and N deposition) + surface_prof(:) = 0._r8 + do j = 1, nlevdecomp + surface_prof(j) = exp(-surfprof_exp * zsoi(j)) / dzsoi_decomp(j) + if (use_bedrock) then + if (zsoi(j) > zmin_bedrock) then + surface_prof(j) = 0._r8 + end if + end if + end do + + ! initialize profiles to zero + leaf_prof(begp:endp, :) = 0._r8 + froot_prof(begp:endp, :) = 0._r8 + croot_prof(begp:endp, :) = 0._r8 + stem_prof(begp:endp, :) = 0._r8 + nfixation_prof(begc:endc, :) = 0._r8 + ndep_prof(begc:endc, :) = 0._r8 + + cinput_rootfr(begp:endp, :) = 0._r8 + col_cinput_rootfr(begc:endc, :) = 0._r8 + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + if (patch%itype(p) /= noveg) then + do j = 1, nlevdecomp + cinput_rootfr(p,j) = crootfr(p,j) / dzsoi_decomp(j) + end do + + else + cinput_rootfr(p,1) = 0. + endif + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + ! integrate rootfr over active layer of soil column + rootfr_tot = 0._r8 + surface_prof_tot = 0._r8 + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + rootfr_tot = rootfr_tot + cinput_rootfr(p,j) * dzsoi_decomp(j) + surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j) + end do + if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then + ! where there is not permafrost extending to the surface, integrate the profiles over the active layer + ! this is equivalnet to integrating over all soil layers outside of permafrost regions + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + froot_prof(p,j) = cinput_rootfr(p,j) / rootfr_tot + croot_prof(p,j) = cinput_rootfr(p,j) / rootfr_tot + + if (j > col%nbedrock(c) .and. cinput_rootfr(p,j) > 0._r8) then + write(iulog,*) 'cinput_rootfr > 0 in bedrock' + end if + ! set all surface processes to shallower profile + leaf_prof(p,j) = surface_prof(j)/ surface_prof_tot + stem_prof(p,j) = surface_prof(j)/ surface_prof_tot + end do + else + ! if fully frozen, or no roots, put everything in the top layer + froot_prof(p,1) = 1./dzsoi_decomp(1) + croot_prof(p,1) = 1./dzsoi_decomp(1) + leaf_prof(p,1) = 1./dzsoi_decomp(1) + stem_prof(p,1) = 1./dzsoi_decomp(1) + endif + + end do + + !! aggregate root profile to column + ! call p2c (decomp, nlevdecomp_full, & + ! cinput_rootfr(bounds%begp:bounds%endp, :), & + ! col_cinput_rootfr(bounds%begc:bounds%endc, :), & + ! 'unity') + do pi = 1,maxsoil_patches + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + do j = 1,nlevdecomp + col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) + end do + end if + end do + end do + + ! repeat for column-native profiles: Ndep and Nfix + do fc = 1,num_soilc + c = filter_soilc(fc) + rootfr_tot = 0._r8 + surface_prof_tot = 0._r8 + ! redo column ntegration over active layer for column-native profiles + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + rootfr_tot = rootfr_tot + col_cinput_rootfr(c,j) * dzsoi_decomp(j) + surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j) + end do + if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + nfixation_prof(c,j) = col_cinput_rootfr(c,j) / rootfr_tot + ndep_prof(c,j) = surface_prof(j)/ surface_prof_tot + end do + else + nfixation_prof(c,1) = 1./dzsoi_decomp(1) + ndep_prof(c,1) = 1./dzsoi_decomp(1) + endif + end do + + else + + ! for one layer decomposition model, set profiles to unity + leaf_prof(begp:endp, :) = 1._r8 + froot_prof(begp:endp, :) = 1._r8 + croot_prof(begp:endp, :) = 1._r8 + stem_prof(begp:endp, :) = 1._r8 + nfixation_prof(begc:endc, :) = 1._r8 + ndep_prof(begc:endc, :) = 1._r8 + + end if + + + ! check to make sure integral of all profiles = 1. + do fc = 1,num_soilc + c = filter_soilc(fc) + ndep_prof_sum = 0. + nfixation_prof_sum = 0. + do j = 1, nlevdecomp + ndep_prof_sum = ndep_prof_sum + ndep_prof(c,j) * dzsoi_decomp(j) + nfixation_prof_sum = nfixation_prof_sum + nfixation_prof(c,j) * dzsoi_decomp(j) + end do + if ( ( abs(ndep_prof_sum - 1._r8) > delta ) .or. ( abs(nfixation_prof_sum - 1._r8) > delta ) ) then + write(iulog, *) 'profile sums: ', ndep_prof_sum, nfixation_prof_sum + write(iulog, *) 'c: ', c + write(iulog, *) 'altmax_lastyear_indx: ', altmax_lastyear_indx(c) + write(iulog, *) 'nfixation_prof: ', nfixation_prof(c,:) + write(iulog, *) 'ndep_prof: ', ndep_prof(c,:) + write(iulog, *) 'cinput_rootfr: ', cinput_rootfr(c,:) + write(iulog, *) 'dzsoi_decomp: ', dzsoi_decomp(:) + write(iulog, *) 'surface_prof: ', surface_prof(:) + write(iulog, *) 'npfts(c): ', col%npatches(c) + do p = col%patchi(c), col%patchi(c) + col%npatches(c) -1 + write(iulog, *) 'p, itype(p), wtcol(p): ', p, patch%itype(p), patch%wtcol(p) + write(iulog, *) 'cinput_rootfr(p,:): ', cinput_rootfr(p,:) + end do + call endrun(msg=" ERROR: _prof_sum-1>delta"//errMsg(sourcefile, __LINE__)) + endif + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + froot_prof_sum = 0. + croot_prof_sum = 0. + leaf_prof_sum = 0. + stem_prof_sum = 0. + do j = 1, nlevdecomp + froot_prof_sum = froot_prof_sum + froot_prof(p,j) * dzsoi_decomp(j) + croot_prof_sum = croot_prof_sum + croot_prof(p,j) * dzsoi_decomp(j) + leaf_prof_sum = leaf_prof_sum + leaf_prof(p,j) * dzsoi_decomp(j) + stem_prof_sum = stem_prof_sum + stem_prof(p,j) * dzsoi_decomp(j) + end do + if ( ( abs(froot_prof_sum - 1._r8) > delta ) .or. ( abs(croot_prof_sum - 1._r8) > delta ) .or. & + ( abs(stem_prof_sum - 1._r8) > delta ) .or. ( abs(leaf_prof_sum - 1._r8) > delta ) ) then + write(iulog, *) 'profile sums: ', froot_prof_sum, croot_prof_sum, leaf_prof_sum, stem_prof_sum + call endrun(msg=' ERROR: sum-1 > delta'//errMsg(sourcefile, __LINE__)) + endif + end do + + end associate + + end subroutine SoilBiogeochemVerticalProfile + +end module SoilBiogeochemVerticalProfileMod From e27000194e3548fc15eddc17082b38925778caeb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 09:38:30 -0500 Subject: [PATCH 270/589] remove unused matrix calculation --- .../CLM51/SoilBiogeochemDecompMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 index 3e7f27ee6..8b9b6f8fa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 @@ -130,7 +130,7 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Input: [real(r8) (:,:) ] potential HR (gC/m3/s) fphr => soilbiogeochem_carbonflux_inst%fphr_col , & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic - Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! In/Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ! Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! In/Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) ) ! column loop to calculate actual immobilization and decomp rates, following @@ -177,8 +177,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, p_decomp_cpool_loss(c,j,k) = p_decomp_cpool_loss(c,j,k) * fpi_vr(c,j) pmnf_decomp_cascade(c,j,k) = pmnf_decomp_cascade(c,j,k) * fpi_vr(c,j) if (use_soil_matrixcn)then ! correct only when one transfer from each litter pool - Ksoil%DM(c,j+nlevdecomp*(cascade_donor_pool(k)-1)) & - = Ksoil%DM(c,j+nlevdecomp*(cascade_donor_pool(k)-1)) * fpi_vr(c,j) +! Ksoil%DM(c,j+nlevdecomp*(cascade_donor_pool(k)-1)) & +! = Ksoil%DM(c,j+nlevdecomp*(cascade_donor_pool(k)-1)) * fpi_vr(c,j) end if if (.not. use_nitrif_denitrif) then sminn_to_denit_decomp_cascade_vr(c,j,k) = 0._r8 From f75345fc578b7d566991aaa8e6cc3123adb5b578 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 09:57:33 -0500 Subject: [PATCH 271/589] typo correct --- .../GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 index 8b9b6f8fa..883308a70 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompMod.F90 @@ -129,7 +129,7 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, decomp_cascade_ctransfer_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Input: [real(r8) (:,:) ] potential HR (gC/m3/s) - fphr => soilbiogeochem_carbonflux_inst%fphr_col , & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic + fphr => soilbiogeochem_carbonflux_inst%fphr_col & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic ! Ksoil => soilbiogeochem_carbonflux_inst%Ksoil & ! In/Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) ) From cf73687484d3fee3527f342cddcf5825a6cdaa1c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 10:54:17 -0500 Subject: [PATCH 272/589] add bedrock depth --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index b956bb7de..c1609b9be 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -56,7 +56,7 @@ module clm_varcon real(r8), pointer :: dzsoi(:) !soil dz (thickness) real(r8), pointer :: zisoi(:) !soil zi (interfaces) real(r8), pointer :: dzsoi_decomp(:) !soil dz (thickness) - + real(r8), public, parameter :: zmin_bedrock = 0.4_r8 ! minimum soil depth [m] !------------------------------------------------------------------ ! Set subgrid names From 11572346b22896c0b4570a35cbb84122c3cc6259 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 11:23:12 -0500 Subject: [PATCH 273/589] add carbon only toggle --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 446b3ba1b..ab8e327c6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -16,6 +16,7 @@ module clm_varctl public :: init_clm_varctl ! set parameters public :: cnallocate_carbon_only + public :: cnallocate_carbon_only_set logical, public :: use_nguardrail = .true. ! true => use precision control @@ -122,4 +123,9 @@ logical function CNAllocate_Carbon_only() cnallocate_carbon_only = carbon_only end function CNAllocate_Carbon_only + ! Set module carbon_only flag + subroutine cnallocate_carbon_only_set(carbon_only_in) + logical, intent(in) :: carbon_only_in + carbon_only = carbon_only_in + end subroutine cnallocate_carbon_only_set end module clm_varctl From d2252976537c5814f3be92c0512f9bfcd4ef586e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 12:09:07 -0500 Subject: [PATCH 274/589] remove unused file interpolation function --- .../CLM51/CNVegetationFacade.F90 | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 27ed771cc..0f2f7b79e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -161,7 +161,7 @@ module CNVegetationFacade ! procedure, public :: Init2 ! Do initialization in initialize phase, after subgrid weights are determined procedure, public :: InitEachTimeStep ! Do initializations at the start of each time step - procedure, public :: InterpFileInputs ! Interpolate inputs from files + ! procedure, public :: InterpFileInputs ! Interpolate inputs from files ! procedure, public :: UpdateSubgridWeights ! Update subgrid weights if running with prognostic patch weights ! procedure, public :: DynamicAreaConservation ! Conserve C & N with updates in subgrid weights procedure, public :: InitColumnBalance ! Set the starting point for col-level balance checks @@ -598,33 +598,33 @@ subroutine InitEachTimeStep(this, bounds, num_soilc, filter_soilc) end subroutine InitEachTimeStep !----------------------------------------------------------------------- - subroutine InterpFileInputs(this, bounds) - ! - ! !DESCRIPTION: - ! Interpolate inputs from files - ! - ! NOTE(wjs, 2016-02-23) Stuff done here could probably be done at the end of - ! InitEachTimeStep, rather than in this separate routine, except for the fact that - ! (currently) this Interp stuff is done with proc bounds rather thna clump bounds. I - ! think that is needed so that you don't update a given stream multiple times. If we - ! rework the handling of threading / clumps so that there is a separate object for - ! each clump, then I think this problem would disappear - at which point we could - ! remove this Interp routine, moving its body to the end of InitEachTimeStep. - ! - ! !USES: - ! - ! !ARGUMENTS: - class(cn_vegetation_type) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'InterpFileInputs' - !----------------------------------------------------------------------- - - call this%cnfire_method%FireInterp(bounds) - - end subroutine InterpFileInputs +! subroutine InterpFileInputs(this, bounds) +! ! +! ! !DESCRIPTION: +! ! Interpolate inputs from files +! ! +! ! NOTE(wjs, 2016-02-23) Stuff done here could probably be done at the end of +! ! InitEachTimeStep, rather than in this separate routine, except for the fact that +! ! (currently) this Interp stuff is done with proc bounds rather thna clump bounds. I +! ! think that is needed so that you don't update a given stream multiple times. If we +! ! rework the handling of threading / clumps so that there is a separate object for +! ! each clump, then I think this problem would disappear - at which point we could +! ! remove this Interp routine, moving its body to the end of InitEachTimeStep. +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type) , intent(inout) :: this +! type(bounds_type) , intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'InterpFileInputs' +! !----------------------------------------------------------------------- +! +! call this%cnfire_method%FireInterp(bounds) +! +! end subroutine InterpFileInputs !----------------------------------------------------------------------- From adee611dcd7f262b4ca2f7016ac8d58d5468cad9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 12:09:32 -0500 Subject: [PATCH 275/589] remove unused fire interpolation function --- .../CLM51/FireMethodType.F90 | 30 +++++++++---------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 index 992c267ba..5399ebcf7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 @@ -26,7 +26,7 @@ module FireMethodType procedure(CNFireReadParams_interface), public, deferred :: CNFireReadParams ! Interpolate the fire datasets - procedure(FireInterp_interface) , public, deferred :: FireInterp + ! procedure(FireInterp_interface) , public, deferred :: FireInterp ! Figure out the fire area procedure(CNFireArea_interface) , public, deferred :: CNFireArea @@ -82,20 +82,20 @@ subroutine FireReadNML_interface(this, fire_method ) end subroutine FireReadNML_interface - subroutine FireInterp_interface(this, bounds) - ! - ! !DESCRIPTION: - ! Interpolate Fire datasets - ! - ! USES - use decompMod , only : bounds_type - import :: fire_method_type - ! !ARGUMENTS: - class(fire_method_type) :: this - type(bounds_type), intent(in) :: bounds - !----------------------------------------------------------------------- - - end subroutine FireInterp_interface +! subroutine FireInterp_interface(this, bounds) +! ! +! ! !DESCRIPTION: +! ! Interpolate Fire datasets +! ! +! ! USES +! use decompMod , only : bounds_type +! import :: fire_method_type +! ! !ARGUMENTS: +! class(fire_method_type) :: this +! type(bounds_type), intent(in) :: bounds +! !----------------------------------------------------------------------- +! +! end subroutine FireInterp_interface !----------------------------------------------------------------------- subroutine CNFireReadParams_interface( this, ncid ) From 64a2a6580b3d97ea3c6b3800ad2ba2b662286922 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 12:09:49 -0500 Subject: [PATCH 276/589] add secsperday variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index c1609b9be..243303050 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -45,8 +45,9 @@ module clm_varcon real(r8) :: rgas = SHR_CONST_RGAS !universal gas constant [J/K/kmole] real(r8) :: tfrz = SHR_CONST_TKFRZ !freezing temperature [K] real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day - real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data - integer , public, parameter :: ispval = -9999 ! special value for int data + real(r8), public, parameter :: secsphr = 3600._r8 ! Seconds in an hour + real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data + integer , public, parameter :: ispval = -9999 ! special value for int data !------------------------------------------------------------------ ! Soil depths From cf2ef6e662ae401caf08d80475a74ec831770bbe Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 12:33:40 -0500 Subject: [PATCH 277/589] removing unused isotope calculations --- .../CLM51/CNDriverMod.F90 | 92 +++++++++---------- 1 file changed, 46 insertions(+), 46 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 index 818b47334..edb028010 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -557,22 +557,22 @@ subroutine CNDriverNoLeaching(bounds, ! Set the carbon isotopic flux variables (except for gap-phase mortality and fire fluxes) if ( use_c13 ) then - call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & - isotope='c13') +! call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst, & +! soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & +! cnveg_carbonflux_inst, cnveg_carbonstate_inst, & +! c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & +! c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & +! isotope='c13') end if if ( use_c14 ) then - call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & - isotope='c14') +! call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst, & +! soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & +! cnveg_carbonflux_inst, cnveg_carbonstate_inst, & +! c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & +! c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & +! isotope='c14') end if ! Update all prognostic carbon state variables (except for gap-phase mortality and fire fluxes) @@ -650,18 +650,18 @@ subroutine CNDriverNoLeaching(bounds, ! Set the carbon isotopic fluxes for gap mortality if ( use_c13 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & - iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & - isotope='c13') +! call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & +! iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & +! iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & +! isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & - iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & - isotope='c14') +! call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & +! iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & +! iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & +! isotope='c14') end if ! Update all the prognostic carbon state variables affected by gap-phase mortality fluxes @@ -696,18 +696,18 @@ subroutine CNDriverNoLeaching(bounds, end if if ( use_c13 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & - isotope='c13') +! call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst, & +! cnveg_carbonflux_inst, cnveg_carbonstate_inst, & +! c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & +! isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & - isotope='c14') +! call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst, & +! cnveg_carbonflux_inst, cnveg_carbonstate_inst, & +! c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & +! isotope='c14') end if call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & @@ -811,20 +811,20 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNUpdate3') if ( use_c13 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & - c13_soilbiogeochem_carbonstate_inst, & - isotope='c13') +! call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & +! cnveg_carbonflux_inst, cnveg_carbonstate_inst, & +! c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & +! c13_soilbiogeochem_carbonstate_inst, & +! isotope='c13') end if if ( use_c14 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & - c14_soilbiogeochem_carbonstate_inst, & - isotope='c14') +! call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & +! soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & +! cnveg_carbonflux_inst, cnveg_carbonstate_inst, & +! c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & +! c14_soilbiogeochem_carbonstate_inst, & +! isotope='c14') end if call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & From c5f5de7ab83dd619c2fbadc6d5923cfc0040f096 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 13:44:48 -0500 Subject: [PATCH 278/589] new module --- .../CLM51/CNVegStructUpdateMod.F90 | 327 ++++++++++++++++++ 1 file changed, 327 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegStructUpdateMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegStructUpdateMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegStructUpdateMod.F90 new file mode 100755 index 000000000..b9fdfe6f8 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegStructUpdateMod.F90 @@ -0,0 +1,327 @@ +module CNVegStructUpdateMod + + !----------------------------------------------------------------------- + ! Module for vegetation structure updates (LAI, SAI, htop, hbot) + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_PI + use clm_varctl , only : iulog, use_cndv + use CNDVType , only : dgv_ecophyscon + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use FrictionVelocityMod , only : frictionvel_type + use CNDVType , only : dgvs_type + use CNVegStateType , only : cnveg_state_type + use CropType , only : crop_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood + use CanopyStateType , only : canopystate_type + use PatchType , only : patch + use decompMod , only : bounds_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNVegStructUpdate + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & + waterdiagnosticbulk_inst, frictionvel_inst, dgvs_inst, cnveg_state_inst, crop_inst, & + cnveg_carbonstate_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, use C state variables and epc to diagnose + ! vegetation structure (LAI, SAI, height) + ! + ! !USES: + use pftconMod , only : noveg, nc3crop, nc3irrig, nbrdlf_evr_shrub, nbrdlf_dcd_brl_shrub + use pftconMod , only : npcropmin + use pftconMod , only : ntmp_corn, nirrig_tmp_corn + use pftconMod , only : ntrp_corn, nirrig_trp_corn + use pftconMod , only : nsugarcane, nirrig_sugarcane + use pftconMod , only : nmiscanthus, nirrig_miscanthus, nswitchgrass, nirrig_switchgrass + + use pftconMod , only : pftcon + use clm_varctl , only : spinup_state, use_biomass_heat_storage + use clm_varcon , only : c_to_b + use clm_time_manager , only : get_rad_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of column soil points in patch filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + type(dgvs_type) , intent(in) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(in) :: crop_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !REVISION HISTORY: + ! 10/28/03: Created by Peter Thornton + ! 2/29/08, David Lawrence: revised snow burial fraction for short vegetation + ! + ! !LOCAL VARIABLES: + integer :: p,c,g ! indices + integer :: fp ! lake filter indices + real(r8) :: stocking ! #stems / ha (stocking density) + real(r8) :: ol ! thickness of canopy layer covered by snow (m) + real(r8) :: fb ! fraction of canopy layer covered by snow + real(r8) :: tlai_old ! for use in Zeng tsai formula + real(r8) :: tsai_old ! for use in Zeng tsai formula + real(r8) :: tsai_min ! PATCH derived minimum tsai + real(r8) :: tsai_alpha ! monthly decay rate of tsai + real(r8) :: dt ! radiation time step (sec) + real(r8) :: frac_sno_adjusted ! frac_sno adjusted per frac_sno_threshold + + real(r8), parameter :: dtsmonth = 2592000._r8 ! number of seconds in a 30 day month (60x60x24x30) + real(r8), parameter :: frac_sno_threshold = 0.999_r8 ! frac_sno values greater than this are treated as 1 + !----------------------------------------------------------------------- + ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 + ! + ! tsai(p) = max( tsai_alpha(ivt(p))*tsai_old + max(tlai_old-tlai(p),0_r8), tsai_min(ivt(p)) ) + ! notes: + ! * RHS tsai & tlai are from previous timestep + ! * should create tsai_alpha(ivt(p)) & tsai_min(ivt(p)) in pftconMod.F90 - slevis + ! * all non-crop patches use same values: + ! crop tsai_alpha,tsai_min = 0.0,0.1 + ! noncrop tsai_alpha,tsai_min = 0.5,1.0 (includes bare soil and urban) + !------------------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis [m^2/gC] + dsladlai => pftcon%dsladlai , & ! Input: dSLA/dLAI, projected area basis [m^2/gC] + z0mr => pftcon%z0mr , & ! Input: ratio of momentum roughness length to canopy top height (-) + displar => pftcon%displar , & ! Input: ratio of displacement height to canopy top height (-) + dwood => pftcon%dwood , & ! Input: density of wood (gC/m^3) + ztopmx => pftcon%ztopmx , & ! Input: + laimx => pftcon%laimx , & ! Input: + nstem => pftcon%nstem , & ! Input: Tree number density (#ind/m2) + taper => pftcon%taper , & ! Input: ratio of height:radius_breast_height (tree allometry) + fbw => pftcon%fbw , & ! Input: Fraction of fresh biomass that is water + + allom2 => dgv_ecophyscon%allom2 , & ! Input: [real(r8) (:) ] ecophys const + allom3 => dgv_ecophyscon%allom3 , & ! Input: [real(r8) (:) ] ecophys const + + nind => dgvs_inst%nind_patch , & ! Input: [real(r8) (:) ] number of individuals (#/m**2) + fpcgrid => dgvs_inst%fpcgrid_patch , & ! Input: [real(r8) (:) ] fractional area of patch (pft area/nat veg area) + + frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at patch-level [m] + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C + + farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] F. Li and S. Levis + htmx => cnveg_state_inst%htmx_patch , & ! Output: [real(r8) (:) ] max hgt attained by a crop during yr (m) + peaklai => cnveg_state_inst%peaklai_patch , & ! Output: [integer (:) ] 1: max allowed lai; 0: not at max + + harvdate => crop_inst%harvdate_patch , & ! Input: [integer (:) ] harvest date + + ! *** Key Output from CN*** + tlai => canopystate_inst%tlai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index, no burying by snow + stem_biomass => canopystate_inst%stem_biomass_patch , & ! Output: [real(r8) (:) ] Aboveground stem biomass (kg/m**2) + leaf_biomass => canopystate_inst%leaf_biomass_patch , & ! Output: [real(r8) (:) ] Aboveground leave biomass (kg/m**2) + htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m) + hbot => canopystate_inst%hbot_patch , & ! Output: [real(r8) (:) ] canopy bottom (m) + elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow + frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] frac of vegetation not covered by snow [-] + ) + + dt = real( get_rad_step_size(), r8 ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = patch%gridcell(p) + + if (ivt(p) /= noveg) then + + tlai_old = tlai(p) ! n-1 value + tsai_old = tsai(p) ! n-1 value + + ! update the leaf area index based on leafC and SLA + ! Eq 3 from Thornton and Zimmerman, 2007, J Clim, 20, 3902-3923. + if (dsladlai(ivt(p)) > 0._r8) then + tlai(p) = (slatop(ivt(p))*(exp(leafc(p)*dsladlai(ivt(p))) - 1._r8))/dsladlai(ivt(p)) + else + tlai(p) = slatop(ivt(p)) * leafc(p) + end if + tlai(p) = max(0._r8, tlai(p)) + + ! update the stem area index and height based on LAI, stem mass, and veg type. + ! With the exception of htop for woody vegetation, this follows the DGVM logic. + + ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 (see notes) + ! Assumes doalb time step .eq. CLM time step, SAI min and monthly decay factor + ! alpha are set by PFT, and alpha is scaled to CLM time step by multiplying by + ! dt and dividing by dtsmonth (seconds in average 30 day month) + ! tsai_min scaled by 0.5 to match MODIS satellite derived values + if (ivt(p) == nc3crop .or. ivt(p) == nc3irrig) then ! generic crops + + tsai_alpha = 1.0_r8-1.0_r8*dt/dtsmonth + tsai_min = 0.1_r8 + else + tsai_alpha = 1.0_r8-0.5_r8*dt/dtsmonth + tsai_min = 1.0_r8 + end if + tsai_min = tsai_min * 0.5_r8 + tsai(p) = max(tsai_alpha*tsai_old+max(tlai_old-tlai(p),0._r8),tsai_min) + + ! calculate vegetation physiological parameters used in biomass heat storage + if (use_biomass_heat_storage) then + ! Assumes fbw (fraction of biomass that is water) is the same for leaves and stems + leaf_biomass(p) = max(0.0025_r8,leafc(p)) & + * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) + + if (woody(ivt(p)) == 1._r8) then + stem_biomass(p) = (spinup_factor_deadwood*deadstemc(p) + livestemc(p)) & + * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) + else + stem_biomass(p) = 0._r8 + end if + else + leaf_biomass(p) = 0._r8 + stem_biomass(p) = 0._r8 + end if + if (woody(ivt(p)) == 1._r8) then + + ! trees and shrubs for now have a very simple allometry, with hard-wired + ! stem taper (height:radius) and nstem from PFT parameter file + if (use_cndv) then + + if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then + + stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area + htop(p) = allom2(ivt(p)) * ( (24._r8 * deadstemc(p) / & + (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper(ivt(p))))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam + + else + htop(p) = 0._r8 + end if + + else + !correct height calculation if doing accelerated spinup + htop(p) = ((3._r8 * deadstemc(p) * spinup_factor_deadwood * taper(ivt(p)) * taper(ivt(p)))/ & + (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) + + endif + ! + ! Peter Thornton, 5/3/2004 + ! Adding test to keep htop from getting too close to forcing height for windspeed + ! Also added for grass, below, although it is not likely to ever be an issue. + htop(p) = min(htop(p),(forc_hgt_u_patch(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8) + + ! Peter Thornton, 8/11/2004 + ! Adding constraint to keep htop from going to 0.0. + ! This becomes an issue when fire mortality is pushing deadstemc + ! to 0.0. + htop(p) = max(htop(p), 0.01_r8) + + hbot(p) = max(0._r8, min(3._r8, htop(p)-1._r8)) + + else if (ivt(p) >= npcropmin) then ! prognostic crops + + if (tlai(p) >= laimx(ivt(p))) peaklai(p) = 1 ! used in CNAllocation + + if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & + ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & + ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane .or. & + ivt(p) == nmiscanthus .or. ivt(p) == nirrig_miscanthus .or. & + ivt(p) == nswitchgrass .or. ivt(p) == nirrig_switchgrass) then + tsai(p) = 0.1_r8 * tlai(p) + else + tsai(p) = 0.2_r8 * tlai(p) + end if + + ! "stubble" after harvest + if (harvdate(p) < 999 .and. tlai(p) == 0._r8) then + tsai(p) = 0.25_r8*(1._r8-farea_burned(c)*0.90_r8) !changed by F. Li and S. Levis + htmx(p) = 0._r8 + peaklai(p) = 0 + end if + !if (harvdate(p) < 999 .and. tlai(p) > 0._r8) write(iulog,*) 'CNVegStructUpdate: tlai>0 after harvest!' ! remove after initial debugging? + + ! canopy top and bottom heights + htop(p) = ztopmx(ivt(p)) * (min(tlai(p)/(laimx(ivt(p))-1._r8),1._r8))**2 + htmx(p) = max(htmx(p), htop(p)) + htop(p) = max(0.05_r8, max(htmx(p),htop(p))) + hbot(p) = 0.02_r8 + + else ! generic crops and ... + + ! grasses + + ! height for grasses depends only on LAI + htop(p) = max(0.25_r8, tlai(p) * 0.25_r8) + + htop(p) = min(htop(p),(forc_hgt_u_patch(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8) + + ! Peter Thornton, 8/11/2004 + ! Adding constraint to keep htop from going to 0.0. + htop(p) = max(htop(p), 0.01_r8) + + hbot(p) = max(0.0_r8, min(0.05_r8, htop(p)-0.20_r8)) + end if + + else + + tlai(p) = 0._r8 + tsai(p) = 0._r8 + htop(p) = 0._r8 + hbot(p) = 0._r8 + + end if + + ! adjust lai and sai for burying by snow. + ! snow burial fraction for short vegetation (e.g. grasses, crops) changes with vegetation height + ! accounts for a 20% bending factor, as used in Lombardozzi et al. (2018) GRL 45(18), 9889-9897 + + ! NOTE: The following snow burial code is duplicated in SatellitePhenologyMod. + ! Changes in one place should be accompanied by similar changes in the other. + + if (ivt(p) > noveg .and. ivt(p) <= nbrdlf_dcd_brl_shrub ) then + ol = min( max(snow_depth(c)-hbot(p), 0._r8), htop(p)-hbot(p)) + fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p)) + else + fb = 1._r8 - (max(min(snow_depth(c),max(0.05,htop(p)*0.8_r8)),0._r8)/(max(0.05,htop(p)*0.8_r8))) + !depth of snow required for complete burial of grasses + endif + + if (frac_sno(c) <= frac_sno_threshold) then + frac_sno_adjusted = frac_sno(c) + else + ! avoid tiny but non-zero elai and esai that can cause radiation and/or photosynthesis code to blow up + frac_sno_adjusted = 1._r8 + end if + + elai(p) = max(tlai(p)*(1.0_r8 - frac_sno_adjusted) + tlai(p)*fb*frac_sno_adjusted, 0.0_r8) + esai(p) = max(tsai(p)*(1.0_r8 - frac_sno_adjusted) + tsai(p)*fb*frac_sno_adjusted, 0.0_r8) + + ! Fraction of vegetation free of snow + if ((elai(p) + esai(p)) > 0._r8) then + frac_veg_nosno_alb(p) = 1 + else + frac_veg_nosno_alb(p) = 0 + end if + + end do + + end associate + + end subroutine CNVegStructUpdate + +end module CNVegStructUpdateMod From 1e699a690b09a9e42d6170f20caa82dbf66a5755 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 13:45:06 -0500 Subject: [PATCH 279/589] adding new modules --- .../GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index da1d2dd38..877e9b914 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -89,6 +89,7 @@ set (srcs CNRootDynMod.F90 CNSharedParamsMod.F90 CNVegetationFacade.F90 + CNVegStructUpdateMod.F90 column_varcon.F90 fileutils.F90 filterColMod.F90 From ba228ac626043bb1d924bd1f8ffc6abfc805b983 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 13:45:54 -0500 Subject: [PATCH 280/589] adding extra initialization function --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 35 +++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index f96853ed9..21e0b5668 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -477,6 +477,7 @@ module CNVegCarbonFluxType procedure , public :: SetValues procedure , public :: Summary => Summary_carbonflux + procedure , public :: ZeroDWT end type cnveg_carbonflux_type @@ -2146,8 +2147,42 @@ subroutine Summary_carbonflux(this, & end associate end subroutine Summary_carbonflux +!----------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize flux variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(cnveg_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c, g, j ! indices + !----------------------------------------------------------------------- + ! set conversion and product pool fluxes to 0 at the beginning of every timestep + do g = bounds%begg, bounds%endg + this%dwt_seedc_to_leaf_grc(g) = 0._r8 + this%dwt_seedc_to_deadstem_grc(g) = 0._r8 + this%dwt_conv_cflux_grc(g) = 0._r8 + this%dwt_slash_cflux_grc(g) = 0._r8 + end do + + do j = 1, nlevdecomp_full + do c = bounds%begc,bounds%endc + this%dwt_frootc_to_litr_met_c_col(c,j) = 0._r8 + this%dwt_frootc_to_litr_cel_c_col(c,j) = 0._r8 + this%dwt_frootc_to_litr_lig_c_col(c,j) = 0._r8 + this%dwt_livecrootc_to_cwdc_col(c,j) = 0._r8 + this%dwt_deadcrootc_to_cwdc_col(c,j) = 0._r8 + end do + end do + + end subroutine ZeroDwt + + !----------------------------------------------------------------------- end module CNVegCarbonFluxType From d6aacbcc82604f71992426b7abeb6409773148b1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 13:46:02 -0500 Subject: [PATCH 281/589] adding extra initialization function --- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 23 +++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 841faea9b..524644c10 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -199,6 +199,7 @@ module CNVegCarbonStateType contains procedure , public :: Summary => Summary_carbonstate + procedure , public :: ZeroDWT end type cnveg_carbonstate_type @@ -666,4 +667,26 @@ subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & end subroutine Summary_carbonstate + !----------------------------------------------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(cnveg_carbonstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + this%dispvegc_patch(p) = 0._r8 + this%storvegc_patch(p) = 0._r8 + this%totc_patch(p) = 0._r8 + end do + + end subroutine ZeroDwt + end module CNVegCarbonStateType From 4ce960ab1fa33d7feb302f3bd1f929604273d514 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 13:46:12 -0500 Subject: [PATCH 282/589] adding extra initialization function --- .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index 6527058f9..242e9ab02 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -207,6 +207,7 @@ module CNVegNitrogenStateType contains procedure , public :: Summary => Summary_nitrogenstate + procedure , public :: ZeroDWT end type cnveg_nitrogenstate_type type(cnveg_nitrogenstate_type), public, target, save :: cnveg_nitrogenstate_inst @@ -602,5 +603,28 @@ subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & end subroutine Summary_nitrogenstate + !----------------------------------------------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(cnveg_nitrogenstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + this%dispvegn_patch(p) = 0._r8 + this%storvegn_patch(p) = 0._r8 + this%totvegn_patch(p) = 0._r8 + this%totn_patch(p) = 0._r8 + end do + + end subroutine ZeroDwt + end module CNVegNitrogenStateType From e44a86d0015c53c9b31e452b32542669090b07ed Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 13:46:27 -0500 Subject: [PATCH 283/589] adding extra initialization function --- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 33 +++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index bb36cf25f..344ec4380 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -361,6 +361,7 @@ module CNVegNitrogenFluxType procedure , public :: SetValues procedure , public :: Summary => Summary_nitrogenflux + procedure , public :: ZeroDWT end type cnveg_nitrogenflux_type @@ -1330,4 +1331,36 @@ subroutine Summary_nitrogenflux(this, bounds, num_soilc, filter_soilc, num_soilp end subroutine Summary_nitrogenflux + !----------------------------------------------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize flux variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(cnveg_nitrogenflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c, g, j ! indices + !----------------------------------------------------------------------- + + do g = bounds%begg, bounds%endg + this%dwt_seedn_to_leaf_grc(g) = 0._r8 + this%dwt_seedn_to_deadstem_grc(g) = 0._r8 + this%dwt_conv_nflux_grc(g) = 0._r8 + end do + + do j = 1, nlevdecomp_full + do c = bounds%begc,bounds%endc + this%dwt_frootn_to_litr_met_n_col(c,j) = 0._r8 + this%dwt_frootn_to_litr_cel_n_col(c,j) = 0._r8 + this%dwt_frootn_to_litr_lig_n_col(c,j) = 0._r8 + this%dwt_livecrootn_to_cwdn_col(c,j) = 0._r8 + this%dwt_deadcrootn_to_cwdn_col(c,j) = 0._r8 + end do + end do + + end subroutine ZeroDwt + end module CNVegNitrogenFluxType From f941346999ae00933ec2d577f168d82bcf5393d3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 13:46:54 -0500 Subject: [PATCH 284/589] removing unused functions --- .../CLM51/CNVegetationFacade.F90 | 244 +++++++++--------- 1 file changed, 122 insertions(+), 122 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 0f2f7b79e..56a80235f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -47,8 +47,8 @@ module CNVegetationFacade use clm_varctl , only : iulog, use_cn, use_cndv, use_c13, use_c14 use abortutils , only : endrun use spmdMod , only : masterproc - use clm_time_manager , only : get_curr_date, get_ref_date - use clm_time_manager , only : get_nstep, is_end_curr_year, is_first_step + use clm_time_manager , only : get_curr_date + use clm_time_manager , only : get_nstep, is_first_step use CNBalanceCheckMod , only : cn_balance_type use CNVegStateType , only : cnveg_state_type use CNVegCarbonFluxType , only : cnveg_carbonflux_type @@ -90,8 +90,8 @@ module CNVegetationFacade use CNNStateUpdate1Mod , only : NStateUpdateDynPatch use CNVegStructUpdateMod , only : CNVegStructUpdate use CNAnnualUpdateMod , only : CNAnnualUpdate - use dynConsBiogeochemMod , only : dyn_cnbal_patch, dyn_cnbal_col - use dynCNDVMod , only : dynCNDV_init, dynCNDV_interp + !use dynConsBiogeochemMod , only : dyn_cnbal_patch, dyn_cnbal_col + !use dynCNDVMod , only : dynCNDV_init, dynCNDV_interp use CNPrecisionControlMod , only: CNPrecisionControl use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControl use GridcellType , only : grc @@ -154,9 +154,9 @@ module CNVegetationFacade contains ! procedure, public :: Init - procedure, public :: InitAccBuffer - procedure, public :: InitAccVars - procedure, public :: UpdateAccVars +! procedure, public :: InitAccBuffer +! procedure, public :: InitAccVars +! procedure, public :: UpdateAccVars ! procedure, public :: Restart ! procedure, public :: Init2 ! Do initialization in initialize phase, after subgrid weights are determined @@ -170,7 +170,7 @@ module CNVegetationFacade procedure, public :: EcosystemDynamicsPostDrainage ! Do the main science that needs to be done after hydrology-drainage procedure, public :: BalanceCheck ! Check the carbon and nitrogen balance ! procedure, public :: EndOfTimeStepVegDynamics ! Do vegetation dynamics that should be done at the end of each time step - procedure, public :: WriteHistory ! Do any history writes that are specific to veg dynamics + ! procedure, public :: WriteHistory ! Do any history writes that are specific to veg dynamics procedure, public :: get_net_carbon_exchange_grc ! Get gridcell-level net carbon exchange array procedure, public :: get_leafn_patch ! Get patch-level leaf nitrogen array @@ -348,85 +348,85 @@ end subroutine CNReadNML !----------------------------------------------------------------------- - subroutine InitAccBuffer(this, bounds) - ! - ! !DESCRIPTION: - ! Initialize accumulation buffer for types contained here - ! - ! !USES: - ! - ! !ARGUMENTS: - class(cn_vegetation_type), intent(inout) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'InitAccBuffer' - !----------------------------------------------------------------------- - - if (use_cndv) then - call this%dgvs_inst%InitAccBuffer(bounds) - end if - - end subroutine InitAccBuffer - - !----------------------------------------------------------------------- - subroutine InitAccVars(this, bounds) - ! - ! !DESCRIPTION: - ! Initialize variables that are associated with accumulated fields - ! - ! !USES: - ! - ! !ARGUMENTS: - class(cn_vegetation_type), intent(inout) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'InitAccVars' - !----------------------------------------------------------------------- - - if (use_cndv) then - call this%dgvs_inst%initAccVars(bounds) - end if - - end subroutine InitAccVars - - !----------------------------------------------------------------------- - subroutine UpdateAccVars(this, bounds, t_a10_patch, t_ref2m_patch) - ! - ! !DESCRIPTION: - ! Update accumulated variables - ! - ! Should be called every time step - ! - ! !USES: - ! - ! !ARGUMENTS: - class(cn_vegetation_type), intent(inout) :: this - type(bounds_type), intent(in) :: bounds - ! NOTE(wjs, 2016-02-23) These need to be pointers to agree with the interface of - ! UpdateAccVars in CNDVType (they are pointers there as a workaround for a compiler - ! bug). - real(r8), pointer , intent(in) :: t_a10_patch(:) ! 10-day running mean of the 2 m temperature (K) - real(r8), pointer , intent(in) :: t_ref2m_patch(:) ! 2 m height surface air temperature (K) - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'UpdateAccVars' - !----------------------------------------------------------------------- - - SHR_ASSERT_ALL_FL((ubound(t_a10_patch) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(t_ref2m_patch) == (/bounds%endp/)), sourcefile, __LINE__) - - if (use_cndv) then - call this%dgvs_inst%UpdateAccVars(bounds, & - t_a10_patch = t_a10_patch, & - t_ref2m_patch = t_ref2m_patch) - end if - - end subroutine UpdateAccVars +! subroutine InitAccBuffer(this, bounds) +! ! +! ! !DESCRIPTION: +! ! Initialize accumulation buffer for types contained here +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type), intent(inout) :: this +! type(bounds_type), intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'InitAccBuffer' +! !----------------------------------------------------------------------- +! +! if (use_cndv) then +! call this%dgvs_inst%InitAccBuffer(bounds) +! end if +! +! end subroutine InitAccBuffer +! +! !----------------------------------------------------------------------- +! subroutine InitAccVars(this, bounds) +! ! +! ! !DESCRIPTION: +! ! Initialize variables that are associated with accumulated fields +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type), intent(inout) :: this +! type(bounds_type), intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'InitAccVars' +! !----------------------------------------------------------------------- +! +! if (use_cndv) then +! call this%dgvs_inst%initAccVars(bounds) +! end if +! +! end subroutine InitAccVars +! +! !----------------------------------------------------------------------- +! subroutine UpdateAccVars(this, bounds, t_a10_patch, t_ref2m_patch) +! ! +! ! !DESCRIPTION: +! ! Update accumulated variables +! ! +! ! Should be called every time step +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type), intent(inout) :: this +! type(bounds_type), intent(in) :: bounds +! ! NOTE(wjs, 2016-02-23) These need to be pointers to agree with the interface of +! ! UpdateAccVars in CNDVType (they are pointers there as a workaround for a compiler +! ! bug). +! real(r8), pointer , intent(in) :: t_a10_patch(:) ! 10-day running mean of the 2 m temperature (K) +! real(r8), pointer , intent(in) :: t_ref2m_patch(:) ! 2 m height surface air temperature (K) +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'UpdateAccVars' +! !----------------------------------------------------------------------- +! +! SHR_ASSERT_ALL_FL((ubound(t_a10_patch) == (/bounds%endp/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(t_ref2m_patch) == (/bounds%endp/)), sourcefile, __LINE__) +! +! if (use_cndv) then +! call this%dgvs_inst%UpdateAccVars(bounds, & +! t_a10_patch = t_a10_patch, & +! t_ref2m_patch = t_ref2m_patch) +! end if +! +! end subroutine UpdateAccVars !----------------------------------------------------------------------- @@ -1236,41 +1236,41 @@ end subroutine BalanceCheck ! end subroutine EndOfTimeStepVegDynamics !----------------------------------------------------------------------- - subroutine WriteHistory(this, bounds) - ! - ! !DESCRIPTION: - ! Do any history writes that are specific to vegetation dynamics - ! - ! NOTE(wjs, 2016-02-23) This could probably be combined with - ! EndOfTimeStepVegDynamics, except for the fact that (currently) history writes are - ! done with proc bounds rather than clump bounds. If that were changed, then the body - ! of this could be moved into EndOfTimeStepVegDynamics, inside a "if (.not. - ! use_noio)" conditional. - ! - ! Should only be called if use_cn is true - ! - ! !USES: - ! - ! !ARGUMENTS: - class(cn_vegetation_type), intent(in) :: this - type(bounds_type) , intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'WriteHistory' - !----------------------------------------------------------------------- - - ! Write to CNDV history buffer if appropriate - if (use_cndv) then - if (is_end_curr_year() .and. .not. is_first_step()) then - call t_startf('clm_drv_io_hdgvm') - call CNDVHist( bounds, this%dgvs_inst ) - if (masterproc) write(iulog,*) 'Annual CNDV calculations are complete' - call t_stopf('clm_drv_io_hdgvm') - end if - end if - - end subroutine WriteHistory +! subroutine WriteHistory(this, bounds) +! ! +! ! !DESCRIPTION: +! ! Do any history writes that are specific to vegetation dynamics +! ! +! ! NOTE(wjs, 2016-02-23) This could probably be combined with +! ! EndOfTimeStepVegDynamics, except for the fact that (currently) history writes are +! ! done with proc bounds rather than clump bounds. If that were changed, then the body +! ! of this could be moved into EndOfTimeStepVegDynamics, inside a "if (.not. +! ! use_noio)" conditional. +! ! +! ! Should only be called if use_cn is true +! ! +! ! !USES: +! ! +! ! !ARGUMENTS: +! class(cn_vegetation_type), intent(in) :: this +! type(bounds_type) , intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! +! character(len=*), parameter :: subname = 'WriteHistory' +! !----------------------------------------------------------------------- +! +! ! Write to CNDV history buffer if appropriate +! if (use_cndv) then +! if (is_end_curr_year() .and. .not. is_first_step()) then +! call t_startf('clm_drv_io_hdgvm') +! call CNDVHist( bounds, this%dgvs_inst ) +! if (masterproc) write(iulog,*) 'Annual CNDV calculations are complete' +! call t_stopf('clm_drv_io_hdgvm') +! end if +! end if +! +! end subroutine WriteHistory !----------------------------------------------------------------------- From 67b5bb544e8b7900e3fc55bb33985ebc326e0fbb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 13:47:17 -0500 Subject: [PATCH 285/589] adding variable --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index 243303050..5a3d54def 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -94,6 +94,8 @@ module clm_varcon real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second integer, public, parameter :: isecspday= secspday ! Integer seconds per day + real(r8), public, parameter :: c_to_b = 2.0_r8 ! conversion between mass carbon and total biomass (g biomass /g C) + ! !PUBLIC MEMBER FUNCTIONS: public clm_varcon_init ! Initialze constants that need to be initialized From ab645bbcbe71f52493197cbda9077e42a7d3e245 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 14:20:50 -0500 Subject: [PATCH 286/589] remove crop calculation --- .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 56a80235f..0f462d77a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -965,7 +965,7 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & character(len=*), parameter :: subname = 'EcosystemDynamicsPreDrainage' !----------------------------------------------------------------------- - call crop_inst%CropIncrementYear(num_pcropp, filter_pcropp) + ! call crop_inst%CropIncrementYear(num_pcropp, filter_pcropp) call CNDriverNoLeaching(bounds, & num_soilc, filter_soilc, & From 0a3a9a69aa4f28687e12f070066f33897d433870 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 5 Jan 2023 17:06:38 -0500 Subject: [PATCH 287/589] correct use statements --- .../CLM51/CNCLM_DriverMod.F90 | 37 ++++++++++--------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 378276939..3416fdf2c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -2,8 +2,8 @@ module CNCLM_DriverMod use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan - use CNVegetationFacade - use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight, + use CNVegetationFacade, only : cn_vegetation_type + use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& var_col, var_pft use clm_varcon , only : grav, denh2o @@ -29,19 +29,20 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m sminn_to_npoolg,ndep_to_sminng,totvegng,totlitng,totsomng,& retransng,retransn_to_npoolg,fuelcg,totlitcg,cwdcg,rootcg) - use decompMod, only : bounds - use filterMod, only : filter - use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_inst - use SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_inst - use ActiveLayerMod - use GridcellType - use FireMethodType , only : fire_method_inst - use SaturatedExcessRunoffMod , only : saturated_excess_runoff_inst - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_inst - use atm2lndType , only : atm2lnd_inst - use Wateratm2lndBulkType , only : wateratm2lndbulk_inst - use CNVegStateType , only : cnveg_state_inst - use WaterStateBulkType , only : waterstatebulk_inst + use decompMod, only : bounds_type + use filterMod, only : clumpfilter + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type + use ActiveLayerMod , only : active_layer_type + use GridcellType , only : gridcell_type + use FireMethodType , only : fire_method_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use atm2lndType , only : atm2lnd_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use CNVegStateType , only : cnveg_state_type + use WaterStateBulkType , only : waterstatebulk_type + use SoilStateType , only : soilstate_type !ARGUMENTS implicit none @@ -139,6 +140,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(cn_vegetation_type), public :: bgc_vegetation_inst type(fire_method_type) :: cnfire_method type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst + type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst + type(soilstate_type) :: soilstate_inst logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. @@ -186,7 +189,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,car1m(nc)/CN_zone_weight(nz)),1.) elseif(nz==2) then saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,(car1m(nc)-CN_zone_weight(1))/CN_zone_weight(nz)),1.) - elseif(nz==3) + elseif(nz==3) then saturated_excess_runoff_inst%fsat_col(n) = min(max(0.,(car1m(nc)-CN_zone_weight(1)-CN_zone_weight(2))/CN_zone_weight(nz)),1.) endif @@ -601,4 +604,4 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) end subroutine get_CN_LAI -end module CN_DriverMod +end module CNCLM_DriverMod From 1c820f27d08dffd4f15909bb75e741bd8c995171 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 6 Jan 2023 08:45:24 -0500 Subject: [PATCH 288/589] directly passing fire method information from initialization to driver --- .../CLM51/CNCLM_DriverMod.F90 | 19 ++++++++++++++----- .../CLM51/CN_init_mod.F90 | 4 ++-- .../GEOS_CatchCNCLM51GridComp.F90 | 7 +++++-- 3 files changed, 21 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 3416fdf2c..277424e86 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -4,7 +4,7 @@ module CNCLM_DriverMod use nanMod , only : nan use CNVegetationFacade, only : cn_vegetation_type use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& - var_col, var_pft + var_col, var_pft, nlevgrnd use clm_varcon , only : grav, denh2o implicit none @@ -21,7 +21,7 @@ module CNCLM_DriverMod subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& - fsnow,tg10d,t2m5d,sndzn5d, & + fsnow,tg10d,t2m5d,sndzn5d, cnfire_method, & zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& @@ -43,6 +43,10 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m use CNVegStateType , only : cnveg_state_type use WaterStateBulkType , only : waterstatebulk_type use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use CNVegStateType , only : cnveg_state_type + use WaterStateBulkType , only : waterstatebulk_type !ARGUMENTS implicit none @@ -82,6 +86,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: tg10d ! 10-day running mean of ground temperature [K] real, dimension(nch), intent(in) :: t2m5d ! 5-day running mean of daily minimum 2m temperature [K] real, dimension(nch), intent(in) :: sndzn5d ! 5-day running mean of total snow depth + class(fire_method_type) , intent(in) :: cnfire_method ! OUTPUT @@ -133,15 +138,19 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! above are enough type(bounds_type) :: bounds - type(clumpfilter_type) :: filter + type(clumpfilter) :: filter type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst type(gridcell_type) :: grc - type(cn_vegetation_type), public :: bgc_vegetation_inst - type(fire_method_type) :: cnfire_method + type(cn_vegetation_type) :: bgc_vegetation_inst type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst type(soilstate_type) :: soilstate_inst + type(atm2lnd_type) :: atm2lnd_inst + type(temperature_type) :: temperature_inst + type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst + type(cnveg_state_type) :: cnveg_state_inst + type(waterstatebulk_type) :: waterstatebulk_inst logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index de36d98d6..7d66ad97c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -79,7 +79,7 @@ module CN_initMod contains !------------------------------------------------------ - subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) + subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_start) !ARGUMENTS implicit none @@ -92,6 +92,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) real, dimension(nch), intent(in) :: lats ! Catchment tile latitudes [rad] real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes [rad] logical, optional, intent(in) :: cn5_cold_start ! cold start for the CLM variables that are new in Catchment-CN5.0 + class(fire_method_type), intent(out) :: cnfire_method !LOCAL @@ -129,7 +130,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(ch4_type) :: ch4_inst type(crop_type) :: crop_inst type(dgvs_type) :: dgvs_inst - type(fire_method_type) :: cnfire_method type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst type(energyflux_type) :: energyflux_inst type(waterstatebulk_type) :: waterstatebulk_inst diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index cd1ebd4a4..37ed98b56 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -3763,6 +3763,8 @@ end subroutine SetServices subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) + use FireMethodType , only : fire_method_type + ! !ARGUMENTS: type(ESMF_GridComp),intent(inout) :: GC !Gridded component @@ -3915,6 +3917,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) real :: bare logical, save :: first = .true. integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline + class(fire_method_type) :: cnfire_method ! Offline mode @@ -4227,7 +4230,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start=.true.) + call CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_start=.true.) call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif @@ -6899,7 +6902,7 @@ subroutine Driver ( RC ) call CN_Driver(ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& - asnowm,TG10D,T2MMIN5D,SNDZM5D, & + asnowm,TG10D,T2MMIN5D,SNDZM5D,cnfire_method, & elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& fire_nloss,leafn,leafc,gross_nmin,net_nmin,& From 6df49f6238c93d9b8abecc59257234b9242c3773 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 6 Jan 2023 09:38:21 -0500 Subject: [PATCH 289/589] cleanup and bug fixes --- .../CLM51/CNCLM_DriverMod.F90 | 43 +++++++++++++------ .../CLM51/CN_init_mod.F90 | 2 +- .../GEOS_CatchCNCLM51GridComp.F90 | 4 +- 3 files changed, 33 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 277424e86..f314dbb5d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -4,7 +4,7 @@ module CNCLM_DriverMod use nanMod , only : nan use CNVegetationFacade, only : cn_vegetation_type use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& - var_col, var_pft, nlevgrnd + var_col, var_pft, nlevgrnd, numpft use clm_varcon , only : grav, denh2o implicit none @@ -20,7 +20,7 @@ module CNCLM_DriverMod !--------------------------------- subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& - abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& + abm,peatf,poros,rh30,totwat,bflow,runsrf,sndzn,& fsnow,tg10d,t2m5d,sndzn5d, cnfire_method, & zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& @@ -33,6 +33,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m use filterMod, only : clumpfilter use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type use SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type use ActiveLayerMod , only : active_layer_type use GridcellType , only : gridcell_type use FireMethodType , only : fire_method_type @@ -47,6 +49,10 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use CNVegStateType , only : cnveg_state_type use WaterStateBulkType , only : waterstatebulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use FrictionVelocityMod , only : frictionvel_type + use ActiveLayerMod , only : active_layer_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type !ARGUMENTS implicit none @@ -74,8 +80,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: gdp ! Real GDP (K 1995US$/capita) real, dimension(nch), intent(in) :: abm ! Peak month for agricultural fire, unitless real, dimension(nch), intent(in) :: peatf ! Fraction of peatland, unitless (0-1) - real, dimension(nch), intent(in) :: hdm ! Human population density in 2010 (individual/km2) - real, dimension(nch), intent(in) :: lnfm ! Lightning frequency [Flashes/km^2/day] +! real, dimension(nch), intent(in) :: hdm ! Human population density in 2010 (individual/km2) +! real, dimension(nch), intent(in) :: lnfm ! Lightning frequency [Flashes/km^2/day] real, dimension(nch), intent(in) :: poros ! porosity real, dimension(nch), intent(in) :: rh30 ! 30-day running mean of relative humidity real, dimension(nch), intent(in) :: totwat ! soil liquid water content [kg m^-2] @@ -140,6 +146,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(bounds_type) :: bounds type(clumpfilter) :: filter type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type) :: c14_soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst type(gridcell_type) :: grc type(cn_vegetation_type) :: bgc_vegetation_inst @@ -150,7 +158,16 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(temperature_type) :: temperature_inst type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst type(cnveg_state_type) :: cnveg_state_inst - type(waterstatebulk_type) :: waterstatebulk_inst + type(waterstatebulk_type) :: waterstatebulk_inst + type(waterfluxbulk_type) :: waterfluxbulk_inst + type(frictionvel_type) :: frictionvel_inst + type(active_layer_type) :: active_layer_inst + type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst + logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. @@ -167,18 +184,16 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m grc%dayl(nc) = dayl(nc) wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - cnfire_method%forc_hdm(nc) = hdm(nc) - cnfire_method%forc_lnfm(nc) = lnfm(nc) do nz = 1,num_zon ! CN zone loop n = n + 1 temperature_inst%t_soisno_col(n,-nlevsno+1:nlevmaxurbgrnd) = tp1(nc) ! jkolassa: only one soil and no snow column at this point (may change in future) - temperature_inst%t_grnd_col(n) = temperature_inst%t_soisno_col(n) + temperature_inst%t_grnd_col(n) = temperature_inst%t_soisno_col(n,1) temperature_inst%t_soi17cm_col(n) = temperature_inst%t_grnd_col(n) soilstate_inst%soilpsi_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd) = poros(nc) - atm2lnd_inst%forc_t_downscaled_col(n) = tm(nc) + atm2lnd_inst%forc_t_downscaled_col(n) = tairm(nc) wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) waterdiagnosticbulk_inst%wf_col(n) = sfm(nc,nz) @@ -260,9 +275,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m soilbiogeochem_state_inst, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & active_layer_inst, & - atm2lnd_inst, water_inst%waterstatebulk_inst, & - water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & - water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + atm2lnd_inst, waterstatebulk_inst, & + waterdiagnosticbulk_inst, waterfluxbulk_inst, & + wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & soil_water_retention_curve, crop_inst, ch4_inst, & photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & nutrient_competition_method, fireemis_inst) @@ -278,8 +293,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m filter%num_actfirep, filter%actfirep, & doalb, crop_inst, & soilstate_inst, soilbiogeochem_state_inst, & - water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & - water_inst%waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & + waterstatebulk_inst, waterdiagnosticbulk_inst, & + waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 7d66ad97c..206d4569c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -92,7 +92,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st real, dimension(nch), intent(in) :: lats ! Catchment tile latitudes [rad] real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes [rad] logical, optional, intent(in) :: cn5_cold_start ! cold start for the CLM variables that are new in Catchment-CN5.0 - class(fire_method_type), intent(out) :: cnfire_method + class(fire_method_type), allocatable, intent(out) :: cnfire_method !LOCAL diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 37ed98b56..fe3e9b84a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -6898,10 +6898,12 @@ subroutine Driver ( RC ) sndzm = sndzm / cnsum asnowm = asnowm / cnsum + cnfire_method%forc_hdm = hdm(nc) + cnfire_method%forc_lnfm = lnfm(nc) call CN_Driver(ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& - abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& + abm,peatf,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& asnowm,TG10D,T2MMIN5D,SNDZM5D,cnfire_method, & elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& From 935b5aa20c96e3e0e9b502fe7d0977c418041d30 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 6 Jan 2023 13:24:57 -0500 Subject: [PATCH 290/589] cleanup and bug fixes --- .../CLM51/CNCLM_DriverMod.F90 | 32 +++++++++++++++++-- .../CLM51/CN_init_mod.F90 | 4 +-- 2 files changed, 31 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index f314dbb5d..4b557f232 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -53,6 +53,17 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m use FrictionVelocityMod , only : frictionvel_type use ActiveLayerMod , only : active_layer_type use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use CanopyStateType , only : canopystate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use CropType , only : crop_type + use ch4Mod , only : ch4_type + use PhotosynthesisMod , only : photosyns_type + use EnergyFluxType , only : energyflux_type + use CNFireEmissionsMod , only : fireemis_type + use CN_initMod , only : nutrient_competition_method + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type !ARGUMENTS implicit none @@ -106,6 +117,12 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(out) :: srg ! (gC/m2/s) total soil respiration (HR + root resp) [column] real, dimension(nch), intent(out) :: neeg ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, landuse, harvest, and hrv_xsmrpool flux, positive for source [column] + + real, dimension(nch), intent(out) :: fuelcg ! fuel avalability for non-crop areas outside tropical closed broadleaf evergreen closed forests (gC/m2) + real, dimension(nch), intent(out) :: totlitcg ! (gC/m2) total litter carbon + real, dimension(nch), intent(out) :: totlitcg ! (gC/m2) total litter carbon + real, dimension(nch), intent(out) :: cwdcg ! (gC/m2) coarse woody debris C + real, dimension(nch), intent(out) :: rootcg ! (gC/m2) total root carbon real, dimension(nch), intent(out) :: burn ! burn rate / fractional area burned (/sec) real, dimension(nch), intent(out) :: closs ! (gC/m2/s) total fire C loss @@ -167,7 +184,16 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst - + type(canopystate_type) :: canopystate_inst + type(soil_water_retention_curve_type) :: soil_water_retention_curve_inst + type(crop_type) :: crop_inst + type(ch4_type) :: ch4_inst + type(photosyns_type) :: photosyns_inst + type(energyflux_type) :: energyflux_inst + type(fireemis_type) :: fireemis_inst + type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst + type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. @@ -222,7 +248,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m temperature_inst%t_ref2m_patch(p) = tairm(nc) temperature_inst%soila10_patch(p) = tg10d(nc) temperature_inst%t_a5min_patch(p) = t2m5d(nc) - cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 + cnfire_method%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) @@ -235,7 +261,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! call CLM routines that are needed prior to Ecosystem Dynamics call - call active_layer_inst%alt_calc(num_soilc, filter_soilc, & + call active_layer_inst%alt_calc(filter%num_soilc, filter%soilc, & temperature_inst) call bgc_vegetation_inst%InitGridcellBalance(bounds, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 206d4569c..281601905 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -56,7 +56,7 @@ module CN_initMod use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn use SoilBiogeochemDecompCascadeCNMod , only : readSoilBiogeochemDecompCnParams => readParams - use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method + use NutrientCompetitionFactoryMod , only : nutrient_competition_method_type, create_nutrient_competition_method use SoilBiogeochemDecompMod , only : readSoilBiogeochemDecompParams => readParams use CNPhenologyMod , only : readCNPhenolParams => readParams use SoilBiogeochemLittVertTranspMod , only : readSoilBiogeochemLittVertTranspParams => readParams @@ -135,7 +135,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(waterstatebulk_type) :: waterstatebulk_inst type(waterstate_type) :: waterstate_inst type(frictionvel_type) :: frictionvel_inst - + class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method character(300) :: paramfile character(300) :: NLFilename From 92936d2de66efc90a32bc2427e213cb8b1384670 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 6 Jan 2023 15:06:32 -0500 Subject: [PATCH 291/589] add no fire module --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/CNFireNoFireMod.F90 | 141 ++++++++++++++++++ 2 files changed, 142 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireNoFireMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 877e9b914..29b6ed17d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -76,6 +76,7 @@ set (srcs CNFireLi2014Mod.F90 CNFireLi2016Mod.F90 CNFireLi2021Mod.F90 + CNFireNoFireMod.F90 CNGapMortalityMod.F90 CNGRespMod.F90 CN_init_mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireNoFireMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireNoFireMod.F90 new file mode 100755 index 000000000..0dc1ee39d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireNoFireMod.F90 @@ -0,0 +1,141 @@ +module CNFireNoFireMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for fire dynamics with fire explicitly turned off + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use EnergyFluxType , only : energyflux_type + use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterStateBulkType , only : waterstatebulk_type + use SoilStateType , only : soilstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use FireMethodType , only : fire_method_type + use CNFireBaseMod , only : cnfire_base_type + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: cnfire_nofire_type + ! + type, extends(cnfire_base_type) :: cnfire_nofire_type + private + contains + ! + ! !PUBLIC MEMBER FUNCTIONS: + procedure, public :: need_lightning_and_popdens + procedure, public :: CNFireArea ! Calculate fire area + end type cnfire_nofire_type + +contains + + !----------------------------------------------------------------------- + function need_lightning_and_popdens(this) + ! !ARGUMENTS: + class(cnfire_nofire_type), intent(in) :: this + logical :: need_lightning_and_popdens ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'need_lightning_and_popdens' + !----------------------------------------------------------------------- + + need_lightning_and_popdens = .false. + end function need_lightning_and_popdens + + !----------------------------------------------------------------------- + subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, & + waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) + ! + ! !DESCRIPTION: + ! Computes column-level burned area + ! + ! !USES: + use subgridAveMod , only : p2c + ! + ! !ARGUMENTS: + class(cnfire_nofire_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + real(r8) , intent(in) :: totlitc_col(bounds%begc:) + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) + real(r8) , intent(in) :: t_soi17cm_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + integer :: c,fc ! index variables + !----------------------------------------------------------------------- + + associate( & + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + baf_crop => cnveg_state_inst%baf_crop_col , & ! Output: [real(r8) (:) ] burned area fraction for cropland (/sec) + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Output: [real(r8) (:) ] burned area fraction for peatland (/sec) + fbac => cnveg_state_inst%fbac_col , & ! Output: [real(r8) (:) ] total burned area out of conversion (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Output: [real(r8) (:) ] burned area out of conversion region due to land use fire + lfc => cnveg_state_inst%lfc_col , & ! Output: [real(r8) (:) ] conversion area frac. of BET+BDT that haven't burned before + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_col => cnveg_carbonstate_inst%leafc_col , & ! Output: [real(r8) (:) ] leaf carbon at column level + farea_burned => cnveg_state_inst%farea_burned_col & ! Output: [real(r8) (:) ] total fractional area burned (/sec) + ) + + !pft to column average + call p2c(bounds, num_soilc, filter_soilc, & + leafc(bounds%begp:bounds%endp), & + leafc_col(bounds%begc:bounds%endc)) + ! + ! begin column loop to calculate fractional area affected by fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + + ! zero out the fire area + + farea_burned(c) = 0._r8 + baf_crop(c) = 0._r8 + baf_peatf(c) = 0._r8 + fbac(c) = 0._r8 + fbac1(c) = 0._r8 + cropf_col(c) = 0._r8 + lfc(c) = 0._r8 + ! with NOFIRE, tree carbon is still removed in landuse change regions by the + ! landuse code + end do ! end of column loop + + end associate + + end subroutine CNFireArea + +end module CNFireNoFireMod From 3b2728416ce468900b7b881628fe02d3ac8b8170 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 6 Jan 2023 16:13:36 -0500 Subject: [PATCH 292/589] cleanup and bug fixes --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 2 +- .../CLM51/CNCLM_dynSubgridControlMod.F90 | 1 + .../CLM51/CNSharedParamsMod.F90 | 2 +- .../CLM51/CN_init_mod.F90 | 23 +++++++++++-------- 4 files changed, 17 insertions(+), 11 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 5386fcee0..87456704f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -46,7 +46,7 @@ module SoilBiogeochemStateType contains !--------------------------------------- - subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, cn5_cold_start, this, rc) + subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this, cn5_cold_start, rc) ! ! !ARGUMENTS: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 index bc1c12d2a..73bca29a4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_dynSubgridControlMod.F90 @@ -19,6 +19,7 @@ module dynSubgridControlMod private ! ! !PUBLIC MEMBER FUNCTIONS: + public :: dynSubgridControl_init public :: get_do_transient_pfts ! return the value of the do_transient_pfts control flag public :: get_do_transient_crops ! return the value of the do_transient_crops control flag public :: get_do_harvest ! return the value of the do_harvest control flag diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 index c8c71d388..81c2588d4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -42,7 +42,7 @@ subroutine CNParamsReadShared(ncid, namelist_file) use ncdio_pio , only : file_desc_t type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id - character(len=*), intent(in) :: namelist_file + character(len=*), optional, intent(in) :: namelist_file call CNParamsReadShared_netcdf(ncid) ! call CNParamsReadShared_namelist(namelist_file) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 281601905..b7d7ba6ce 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -9,7 +9,7 @@ module CN_initMod use clm_varctl , only : use_century_decomp use decompMod use CNVegNitrogenStateType - use CNCarbonStateType + use CNVegCarbonStateType use atm2lndType use TemperatureType use SoilStateType @@ -52,11 +52,14 @@ module CN_initMod use WaterStateBulkType use WaterStateType use FrictionVelocityMod + use PhotosynthesisMod + use CNVegetationFacade, only : cn_vegetation_type use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn use SoilBiogeochemDecompCascadeCNMod , only : readSoilBiogeochemDecompCnParams => readParams - use NutrientCompetitionFactoryMod , only : nutrient_competition_method_type, create_nutrient_competition_method + use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method + use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use SoilBiogeochemDecompMod , only : readSoilBiogeochemDecompParams => readParams use CNPhenologyMod , only : readCNPhenolParams => readParams use SoilBiogeochemLittVertTranspMod , only : readSoilBiogeochemLittVertTranspParams => readParams @@ -100,7 +103,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(patch_type) :: patch type(column_type) :: col type(landunit_type) :: lun - type(clumpfilter_type) :: filter + type(clumpfilter) :: filter type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(atm2lnd_type) :: atm2lnd_inst @@ -112,7 +115,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(canopystate_type) :: canopystate_inst type(solarabs_type) :: solarabs_inst type(surfalb_type) :: surfalb_inst - type(ozone_type) :: ozone_inst + type(ozone_base_type) :: ozone_inst type(photosyns_type) :: photosyns_inst type(pftcon_type) :: pftcon type(waterflux_type) :: waterflux_inst @@ -135,13 +138,15 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(waterstatebulk_type) :: waterstatebulk_inst type(waterstate_type) :: waterstate_inst type(frictionvel_type) :: frictionvel_inst - class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method + type(cn_vegetation_type) :: bgc_vegetation_inst + class(nutrient_competition_method_type), allocatable :: nutrient_competition_method character(300) :: paramfile character(300) :: NLFilename type(Netcdf4_fileformatter) :: ncid - integer :: rc + integer :: rc, status + integer, private, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function !----------------------------------------- ! initialize CN model @@ -159,7 +164,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st ! initialize subrgid types - call init_patch_type (bound, nch, ityp, fveg, patch) + call init_patch_type (bounds, nch, ityp, fveg, patch) call init_column_type (bounds, nch, col) @@ -173,7 +178,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st ! initialize filters - call init_filter_type (bounds, nch, ityp, fveg, filter) + call init_filter_type (bounds, nch, ityp, fveg, filter(1)) ! read parameters and configurations from namelist file @@ -197,7 +202,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st call init_wateratm2lndbulk_type (bounds, wateratm2lndbulk_inst) - call init_wateratm2lnd_type (bounds, wateratm2lnd_type) + call init_wateratm2lnd_type (bounds, wateratm2lnd_inst) call init_canopystate_type (bounds, nch, ityp, fveg, cncol, cnpft, canopystate_inst, cn5_cold_start) From 6ae632a215324d79ecef30ed3725820f68636dcb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 6 Jan 2023 16:41:04 -0500 Subject: [PATCH 293/589] bug fixes and cleanup --- .../CLM51/CNCLM_filterMod.F90 | 78 +++++++++---------- .../CLM51/CN_init_mod.F90 | 4 +- 2 files changed, 41 insertions(+), 41 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index e5f353421..f44b7e3ac 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -115,59 +115,59 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) integer, intent(in) :: nch ! number of Catchment tiles integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction - type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate + type(clumpfilter), intent(inout):: this_filter(:) ! the filter to allocate ! LOCAL: integer :: n, nc ,nz, p, np, nv !-------------------------------------- - if( .not. allocated(this_filter)) then - allocate(this_filter(1)) - end if +! if( .not. allocated(this_filter)) then +! allocate(this_filter(1)) +! end if - allocate(this_filter(1)%allc(bounds%endc-bounds%begc+1)) + allocate(this_filter%allc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%lakep(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%nolakep(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%nolakeurbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter%lakep(bounds%endp-bounds%begp+1)) + allocate(this_filter%nolakep(bounds%endp-bounds%begp+1)) + allocate(this_filter%nolakeurbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%lakec(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%nolakec(bounds%endc-bounds%begc+1)) + allocate(this_filter%lakec(bounds%endc-bounds%begc+1)) + allocate(this_filter%nolakec(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%soilc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%soilp(bounds%endp-bounds%begp+1)) + allocate(this_filter%soilc(bounds%endc-bounds%begc+1)) + allocate(this_filter%soilp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%snowc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%nosnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter%snowc(bounds%endc-bounds%begc+1)) + allocate(this_filter%nosnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%lakesnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%lakenosnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter%lakesnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter%lakenosnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%exposedvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%noexposedvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter%exposedvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter%noexposedvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%natvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter%natvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%hydrologyc(bounds%endc-bounds%begc+1)) + allocate(this_filter%hydrologyc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%urbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%nourbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter%urbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter%nourbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%urbanc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%nourbanc(bounds%endc-bounds%begc+1)) + allocate(this_filter%urbanc(bounds%endc-bounds%begc+1)) + allocate(this_filter%nourbanc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%urbanl(bounds%endl-bounds%begl+1)) - allocate(this_filter(1)%nourbanl(bounds%endl-bounds%begl+1)) + allocate(this_filter%urbanl(bounds%endl-bounds%begl+1)) + allocate(this_filter%nourbanl(bounds%endl-bounds%begl+1)) - allocate(this_filter(1)%pcropp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%soilnopcropp(bounds%endp-bounds%begp+1)) + allocate(this_filter%pcropp(bounds%endp-bounds%begp+1)) + allocate(this_filter%soilnopcropp(bounds%endp-bounds%begp+1)) - allocate(this_filter(1)%icemecc(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%do_smb_c(bounds%endc-bounds%begc+1)) + allocate(this_filter%icemecc(bounds%endc-bounds%begc+1)) + allocate(this_filter%do_smb_c(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%actfirec(bounds%endc-bounds%begc+1)) - allocate(this_filter(1)%actfirep(bounds%endp-bounds%begp+1)) + allocate(this_filter%actfirec(bounds%endc-bounds%begc+1)) + allocate(this_filter%actfirep(bounds%endp-bounds%begp+1)) this_filter%num_actfirep = 1 this_filter%num_actfirec = 1 @@ -188,9 +188,9 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) n = n + 1 this_filter%num_soilc = this_filter%num_soilc + 1 - this_filter(1)%soilc(this_filter%num_soilc) = n + this_filter%soilc(this_filter%num_soilc) = n this_filter%num_allc = this_filter%num_allc + 1 - this_filter(1)%allc(this_filter%num_allc) = n + this_filter%allc(this_filter%num_allc) = n do p = 0,numpft ! PFT index loop np = np + 1 @@ -198,27 +198,27 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) if(ityp(nc,nv,nz)==p) then this_filter%num_nourbanp = this_filter%num_nourbanp + 1 - this_filter(1)%nourbanp(this_filter%num_nourbanp) = np + this_filter%nourbanp(this_filter%num_nourbanp) = np this_filter%num_soilp = this_filter%num_soilp + 1 - this_filter(1)%soilp(this_filter%num_soilp) = np + this_filter%soilp(this_filter%num_soilp) = np ! jkolassa: not sure this is needed, since we do not use prognostic crop information if(ityp(nc,nv,nz) >= npcropmin) then this_filter%num_pcropp = this_filter%num_pcropp + 1 - this_filter(1)%pcropp(this_filter%num_pcropp) = np + this_filter%pcropp(this_filter%num_pcropp) = np endif if (fveg(nc,nv,nz)>1.e-4) then this_filter%num_exposedvegp = this_filter%num_exposedvegp + 1 - this_filter(1)%exposedvegp(this_filter%num_exposedvegp) = np + this_filter%exposedvegp(this_filter%num_exposedvegp) = np elseif (fveg(nc,nv,nz)<=1.e-4) then this_filter%num_noexposedvegp = this_filter%num_noexposedvegp + 1 - this_filter(1)%noexposedvegp(this_filter%num_noexposedvegp) = np + this_filter%noexposedvegp(this_filter%num_noexposedvegp) = np end if end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index b7d7ba6ce..304ffd350 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -178,7 +178,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st ! initialize filters - call init_filter_type (bounds, nch, ityp, fveg, filter(1)) + call init_filter_type (bounds, nch, ityp, fveg, filter) ! read parameters and configurations from namelist file @@ -212,7 +212,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st call init_ozone_base_type (bounds, ozone_inst) - call photosyns_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, photosyns_inst, cn5_cold_start) + call photosyns_inst%Init (photosyns_inst, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) call init_pftcon_type (pftcon) From d0b326c72a228f58cc308a785b5a808a6c0fa25b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 6 Jan 2023 17:19:21 -0500 Subject: [PATCH 294/589] fix filter allocation --- .../CLM51/CNCLM_filterMod.F90 | 140 +++++++++++------- .../CLM51/CN_init_mod.F90 | 5 +- 2 files changed, 85 insertions(+), 60 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index f44b7e3ac..14a121f0a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -12,7 +12,9 @@ module filterMod ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_filter_type + public allocFilters ! allocate memory for filters + ! PRIVATE + private :: init_filter_type @@ -96,10 +98,34 @@ module filterMod ! This is the standard set of filters, which should be used in most places in the code. ! These filters only include 'active' points. - type(clumpfilter), public, target, save :: filter + type(clumpfilter), allocatable, public :: filter(:) contains + !------------------------------------------------------------------------ + subroutine allocFilters(bounds, nch, ityp, fveg) + ! + ! !DESCRIPTION: + ! Allocate CLM filters. + ! + ! !REVISION HISTORY: + ! Created by Bill Sacks + + ! !ARGUMENTS: + implicit none + ! INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles + integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index + real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction + + !------------------------------------------------------------------------ + + call init_filter_type(bounds, nch, ityp, fveg, filter) + + + end subroutine allocFilters + !-------------------------------------------------------------- subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) @@ -115,110 +141,110 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) integer, intent(in) :: nch ! number of Catchment tiles integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction - type(clumpfilter), intent(inout):: this_filter(:) ! the filter to allocate + type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate ! LOCAL: integer :: n, nc ,nz, p, np, nv !-------------------------------------- -! if( .not. allocated(this_filter)) then -! allocate(this_filter(1)) -! end if + if( .not. allocated(this_filter)) then + allocate(this_filter(1)) + end if - allocate(this_filter%allc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%allc(bounds%endc-bounds%begc+1)) - allocate(this_filter%lakep(bounds%endp-bounds%begp+1)) - allocate(this_filter%nolakep(bounds%endp-bounds%begp+1)) - allocate(this_filter%nolakeurbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%lakep(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%nolakep(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%nolakeurbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter%lakec(bounds%endc-bounds%begc+1)) - allocate(this_filter%nolakec(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%lakec(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%nolakec(bounds%endc-bounds%begc+1)) - allocate(this_filter%soilc(bounds%endc-bounds%begc+1)) - allocate(this_filter%soilp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%soilc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%soilp(bounds%endp-bounds%begp+1)) - allocate(this_filter%snowc(bounds%endc-bounds%begc+1)) - allocate(this_filter%nosnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%snowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%nosnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter%lakesnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter%lakenosnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%lakesnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%lakenosnowc(bounds%endc-bounds%begc+1)) - allocate(this_filter%exposedvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter%noexposedvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%exposedvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%noexposedvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter%natvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%natvegp(bounds%endp-bounds%begp+1)) - allocate(this_filter%hydrologyc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%hydrologyc(bounds%endc-bounds%begc+1)) - allocate(this_filter%urbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter%nourbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%urbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%nourbanp(bounds%endp-bounds%begp+1)) - allocate(this_filter%urbanc(bounds%endc-bounds%begc+1)) - allocate(this_filter%nourbanc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%urbanc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%nourbanc(bounds%endc-bounds%begc+1)) - allocate(this_filter%urbanl(bounds%endl-bounds%begl+1)) - allocate(this_filter%nourbanl(bounds%endl-bounds%begl+1)) + allocate(this_filter(1)%urbanl(bounds%endl-bounds%begl+1)) + allocate(this_filter(1)%nourbanl(bounds%endl-bounds%begl+1)) - allocate(this_filter%pcropp(bounds%endp-bounds%begp+1)) - allocate(this_filter%soilnopcropp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%pcropp(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%soilnopcropp(bounds%endp-bounds%begp+1)) - allocate(this_filter%icemecc(bounds%endc-bounds%begc+1)) - allocate(this_filter%do_smb_c(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%icemecc(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%do_smb_c(bounds%endc-bounds%begc+1)) - allocate(this_filter%actfirec(bounds%endc-bounds%begc+1)) - allocate(this_filter%actfirep(bounds%endp-bounds%begp+1)) + allocate(this_filter(1)%actfirec(bounds%endc-bounds%begc+1)) + allocate(this_filter(1)%actfirep(bounds%endp-bounds%begp+1)) - this_filter%num_actfirep = 1 - this_filter%num_actfirec = 1 + this_filter(1)%num_actfirep = 1 + this_filter(1)%num_actfirec = 1 ! initialize - this_filter%num_soilc = 0 - this_filter%num_soilp = 0 - this_filter%num_pcropp = 0 - this_filter%num_exposedvegp = 0 - this_filter%num_noexposedvegp = 0 - this_filter%num_nourbanp = 0 - this_filter%num_allc = 0 + this_filter(1)%num_soilc = 0 + this_filter(1)%num_soilp = 0 + this_filter(1)%num_pcropp = 0 + this_filter(1)%num_exposedvegp = 0 + this_filter(1)%num_noexposedvegp = 0 + this_filter(1)%num_nourbanp = 0 + this_filter(1)%num_allc = 0 n = 0 do nc = 1,nch do nz = 1,num_zon n = n + 1 - this_filter%num_soilc = this_filter%num_soilc + 1 - this_filter%soilc(this_filter%num_soilc) = n - this_filter%num_allc = this_filter%num_allc + 1 - this_filter%allc(this_filter%num_allc) = n + this_filter(1)%num_soilc = this_filter(1)%num_soilc + 1 + this_filter(1)%soilc(this_filter(1)%num_soilc) = n + this_filter(1)%num_allc = this_filter(1)%num_allc + 1 + this_filter(1)%allc(this_filter(1)%num_allc) = n do p = 0,numpft ! PFT index loop np = np + 1 do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p) then - this_filter%num_nourbanp = this_filter%num_nourbanp + 1 - this_filter%nourbanp(this_filter%num_nourbanp) = np + this_filter(1)%num_nourbanp = this_filter(1)%num_nourbanp + 1 + this_filter(1)%nourbanp(this_filter(1)%num_nourbanp) = np - this_filter%num_soilp = this_filter%num_soilp + 1 - this_filter%soilp(this_filter%num_soilp) = np + this_filter(1)%num_soilp = this_filter(1)%num_soilp + 1 + this_filter(1)%soilp(this_filter(1)%num_soilp) = np ! jkolassa: not sure this is needed, since we do not use prognostic crop information if(ityp(nc,nv,nz) >= npcropmin) then - this_filter%num_pcropp = this_filter%num_pcropp + 1 - this_filter%pcropp(this_filter%num_pcropp) = np + this_filter(1)%num_pcropp = this_filter(1)%num_pcropp + 1 + this_filter(1)%pcropp(this_filter(1)%num_pcropp) = np endif if (fveg(nc,nv,nz)>1.e-4) then - this_filter%num_exposedvegp = this_filter%num_exposedvegp + 1 - this_filter%exposedvegp(this_filter%num_exposedvegp) = np + this_filter(1)%num_exposedvegp = this_filter(1)%num_exposedvegp + 1 + this_filter(1)%exposedvegp(this_filter(1)%num_exposedvegp) = np elseif (fveg(nc,nv,nz)<=1.e-4) then - this_filter%num_noexposedvegp = this_filter%num_noexposedvegp + 1 - this_filter%noexposedvegp(this_filter%num_noexposedvegp) = np + this_filter(1)%num_noexposedvegp = this_filter(1)%num_noexposedvegp + 1 + this_filter(1)%noexposedvegp(this_filter(1)%num_noexposedvegp) = np end if end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 304ffd350..2ad14c00d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -8,6 +8,7 @@ module CN_initMod use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init use clm_varctl , only : use_century_decomp use decompMod + use filterMod use CNVegNitrogenStateType use CNVegCarbonStateType use atm2lndType @@ -29,7 +30,6 @@ module CN_initMod use CNVegNitrogenFluxType use GridcellType use WaterFluxBulkType - use filterMod use SoilBiogeochemCarbonFluxType use SoilBiogeochemNitrogenFluxType use PatchType @@ -103,7 +103,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(patch_type) :: patch type(column_type) :: col type(landunit_type) :: lun - type(clumpfilter) :: filter type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(atm2lnd_type) :: atm2lnd_inst @@ -178,7 +177,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st ! initialize filters - call init_filter_type (bounds, nch, ityp, fveg, filter) + call allocFilters (bounds, nch, ityp, fveg) ! read parameters and configurations from namelist file From 71b641e66bb5bc670b904d0b8d4374bc2a32d2f6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 9 Jan 2023 09:12:03 -0500 Subject: [PATCH 295/589] fixing photosynthesis initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 2ad14c00d..47512f347 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -114,8 +114,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(canopystate_type) :: canopystate_inst type(solarabs_type) :: solarabs_inst type(surfalb_type) :: surfalb_inst - type(ozone_base_type) :: ozone_inst - type(photosyns_type) :: photosyns_inst + type(ozone_base_type) :: ozone_inst + type(photosyns_type), public :: photosyns_inst type(pftcon_type) :: pftcon type(waterflux_type) :: waterflux_inst type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst @@ -145,7 +145,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(Netcdf4_fileformatter) :: ncid integer :: rc, status - integer, private, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function + integer, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function !----------------------------------------- ! initialize CN model @@ -211,7 +211,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st call init_ozone_base_type (bounds, ozone_inst) - call photosyns_inst%Init (photosyns_inst, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) + call photosyns_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) call init_pftcon_type (pftcon) From 2c4c601fa593f8b70fa0626e592788532daeb5e3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 9 Jan 2023 10:05:40 -0500 Subject: [PATCH 296/589] moving photosyns_type specification --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 47512f347..a5fb1a9d1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -79,6 +79,8 @@ module CN_initMod implicit none private + type(photosyns_type), public :: photosyns_inst + contains !------------------------------------------------------ @@ -115,7 +117,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(solarabs_type) :: solarabs_inst type(surfalb_type) :: surfalb_inst type(ozone_base_type) :: ozone_inst - type(photosyns_type), public :: photosyns_inst type(pftcon_type) :: pftcon type(waterflux_type) :: waterflux_inst type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst From 805095bd4ab630d8d3bc7dad44a55695e82f9cc5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 9 Jan 2023 11:34:04 -0500 Subject: [PATCH 297/589] fixes to use statements and variable declaration --- .../CLM51/CNCLM_DriverMod.F90 | 85 ++++++++++++------- .../CLM51/CN_init_mod.F90 | 4 +- 2 files changed, 56 insertions(+), 33 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 4b557f232..86ce48a80 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -1,34 +1,11 @@ module CNCLM_DriverMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 - use nanMod , only : nan - use CNVegetationFacade, only : cn_vegetation_type - use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 + use nanMod , only : nan + use CNVegetationFacade, only : cn_vegetation_type + use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& var_col, var_pft, nlevgrnd, numpft - use clm_varcon , only : grav, denh2o - - implicit none - private - -! !PUBLIC MEMBER FUNCTIONS: - public :: CN_Driver - public :: CN_exit - public :: get_CN_LAI - -contains - -!--------------------------------- - subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& - rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& - abm,peatf,poros,rh30,totwat,bflow,runsrf,sndzn,& - fsnow,tg10d,t2m5d,sndzn5d, cnfire_method, & - zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& - som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& - col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& - nfix_to_sminng,actual_immobg,fpgg,fpig,sminn_to_plantg,& - sminn_to_npoolg,ndep_to_sminng,totvegng,totlitng,totsomng,& - retransng,retransn_to_npoolg,fuelcg,totlitcg,cwdcg,rootcg) - + use clm_varcon , only : grav, denh2o use decompMod, only : bounds_type use filterMod, only : clumpfilter use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type @@ -64,6 +41,33 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegCarbonStateType , only : cnveg_carbonstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNProductsMod , only : cn_products_type + + implicit none + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: CN_Driver + public :: CN_exit + public :: get_CN_LAI + + + +contains + +!--------------------------------- + subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& + rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& + abm,peatf,poros,rh30,totwat,bflow,runsrf,sndzn,& + fsnow,tg10d,t2m5d,sndzn5d, cnfire_method, & + zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& + som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& + col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& + nfix_to_sminng,actual_immobg,fpgg,fpig,sminn_to_plantg,& + sminn_to_npoolg,ndep_to_sminng,totvegng,totlitng,totsomng,& + retransng,retransn_to_npoolg,fuelcg,totlitcg,cwdcg,rootcg) + !ARGUMENTS implicit none @@ -120,7 +124,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(out) :: fuelcg ! fuel avalability for non-crop areas outside tropical closed broadleaf evergreen closed forests (gC/m2) real, dimension(nch), intent(out) :: totlitcg ! (gC/m2) total litter carbon - real, dimension(nch), intent(out) :: totlitcg ! (gC/m2) total litter carbon real, dimension(nch), intent(out) :: cwdcg ! (gC/m2) coarse woody debris C real, dimension(nch), intent(out) :: rootcg ! (gC/m2) total root carbon @@ -185,7 +188,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst type(canopystate_type) :: canopystate_inst - type(soil_water_retention_curve_type) :: soil_water_retention_curve_inst + type(soil_water_retention_curve_type) :: soil_water_retention_curve type(crop_type) :: crop_inst type(ch4_type) :: ch4_inst type(photosyns_type) :: photosyns_inst @@ -194,7 +197,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + real, dimension(nch*NUM_ZON*(numpft+1)) ::pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. integer :: n, p, nc, nz, np, nv @@ -466,6 +471,24 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) real, dimension(nch,num_zon,num_veg,var_pft), intent(out) :: cnpft ! PFT-level restart variables ! LOCAL + + type(bounds_type) :: bounds + type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst + type(gridcell_type) :: grc + type(cn_vegetation_type) :: bgc_vegetation_inst + type(cnveg_state_type) :: cnveg_state_inst + type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst + type(canopystate_type) :: canopystate_inst + type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst + type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(cn_products_type) :: c_products_inst + type(cn_products_type) :: n_products_inst + integer :: n, p, nv, nc, nz, np, nd integer, dimension(8) :: decomp_cpool_cncol_index = (/ 3, 4, 5, 2, 10, 11, 12, 13 /) integer, dimension(8) :: decomp_npool_cncol_index = (/ 18, 19, 20, 17,25, 26, 27, 28 /) @@ -474,7 +497,7 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) n = 0 np = 0 do nc = 1,nch ! catchment tile loop - do nz = 1,nzone ! CN zone loop + do nz = 1,num_zon ! CN zone loop n = n + 1 cncol(nc,nz, 1) = soilbiogeochem_carbonstate_inst%ctrunc_vr_col(n,1) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index a5fb1a9d1..bae7c92ff 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -80,7 +80,8 @@ module CN_initMod private type(photosyns_type), public :: photosyns_inst - + class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method + contains !------------------------------------------------------ @@ -139,7 +140,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st type(waterstate_type) :: waterstate_inst type(frictionvel_type) :: frictionvel_inst type(cn_vegetation_type) :: bgc_vegetation_inst - class(nutrient_competition_method_type), allocatable :: nutrient_competition_method character(300) :: paramfile character(300) :: NLFilename From 362880358b43977bcadb1c19157e1b653a4cbc81 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 9 Jan 2023 13:00:35 -0500 Subject: [PATCH 298/589] changing how cnfire_method is initialized --- .../CLM51/CNCLM_DriverMod.F90 | 42 +++++++++++++++---- .../CLM51/CN_init_mod.F90 | 8 ++-- .../GEOS_CatchCNCLM51GridComp.F90 | 10 ++--- 3 files changed, 40 insertions(+), 20 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 86ce48a80..01ed5b507 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -43,6 +43,8 @@ module CNCLM_DriverMod use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNProductsMod , only : cn_products_type + use CNFireFactoryMod , only : CNFireReadNM, create_cnfire_method + use FireMethodType , only : fire_method_type implicit none private @@ -51,16 +53,17 @@ module CNCLM_DriverMod public :: CN_Driver public :: CN_exit public :: get_CN_LAI + public :: FireMethodInit - + class(fire_method_type) , allocatable :: cnfire_method contains !--------------------------------- subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& - abm,peatf,poros,rh30,totwat,bflow,runsrf,sndzn,& - fsnow,tg10d,t2m5d,sndzn5d, cnfire_method, & + abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& + fsnow,tg10d,t2m5d,sndzn5d, & zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& @@ -95,8 +98,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: gdp ! Real GDP (K 1995US$/capita) real, dimension(nch), intent(in) :: abm ! Peak month for agricultural fire, unitless real, dimension(nch), intent(in) :: peatf ! Fraction of peatland, unitless (0-1) -! real, dimension(nch), intent(in) :: hdm ! Human population density in 2010 (individual/km2) -! real, dimension(nch), intent(in) :: lnfm ! Lightning frequency [Flashes/km^2/day] + real, dimension(nch), intent(in) :: hdm ! Human population density in 2010 (individual/km2) + real, dimension(nch), intent(in) :: lnfm ! Lightning frequency [Flashes/km^2/day] real, dimension(nch), intent(in) :: poros ! porosity real, dimension(nch), intent(in) :: rh30 ! 30-day running mean of relative humidity real, dimension(nch), intent(in) :: totwat ! soil liquid water content [kg m^-2] @@ -107,7 +110,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: tg10d ! 10-day running mean of ground temperature [K] real, dimension(nch), intent(in) :: t2m5d ! 5-day running mean of daily minimum 2m temperature [K] real, dimension(nch), intent(in) :: sndzn5d ! 5-day running mean of total snow depth - class(fire_method_type) , intent(in) :: cnfire_method ! OUTPUT @@ -188,7 +190,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst type(canopystate_type) :: canopystate_inst - type(soil_water_retention_curve_type) :: soil_water_retention_curve type(crop_type) :: crop_inst type(ch4_type) :: ch4_inst type(photosyns_type) :: photosyns_inst @@ -199,7 +200,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - real, dimension(nch*NUM_ZON*(numpft+1)) ::pwtgcell + real ::pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. integer :: n, p, nc, nz, np, nv @@ -216,6 +217,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) + cnfire_method%forc_hdm(nc) = hdm(nc) + cnfire_method%forc_lnfm(nc) = lnfm(nc) + do nz = 1,num_zon ! CN zone loop n = n + 1 @@ -677,4 +681,26 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) end subroutine get_CN_LAI +!--------------------------- + + subroutine FireMethodInit(bounds,paramfile) + + use MAPL , only : NetCDF4_FileFormatter + + + type(bounds_type), intent(in) :: bounds + character(300), intent(in) :: paramfile + + type(Netcdf4_fileformatter) :: ncid + integer :: rc, status + !-------------------------------- + + call create_cnfire_method(cnfire_method) + call cnfire_method%FireInit(bounds) + + call ncid%open(trim(paramfile),pFIO_READ, __RC__) + call cnfire_method%CNFireReadParams( ncid ) + call ncid%close(rc=status) + + end subroutine FireMethodInit end module CNCLM_DriverMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index bae7c92ff..c5b310870 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -71,6 +71,7 @@ module CN_initMod use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams + use CNCLM_Driver , only : FireMethodInit use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -85,7 +86,7 @@ module CN_initMod contains !------------------------------------------------------ - subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_start) + subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) !ARGUMENTS implicit none @@ -264,9 +265,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st call bgc_vegetation_inst%cn_balance_inst%Init (bounds) - call create_cnfire_method(cnfire_method) - call cnfire_method%FireInit(bounds) - ! calls to original CTSM initialization routines ! initialize rooting profile with default values @@ -301,13 +299,13 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_st call readCNPhenolParams(ncid) call readSoilBiogeochemLittVertTranspParams(ncid) call photosyns_inst%ReadParams( ncid ) - call cnfire_method%CNFireReadParams( ncid ) call readSoilBiogeochemNLeachingParams(ncid) call readSoilBiogeochemCompetitionParams(ncid) call readSoilBiogeochemPotentialParams(ncid) call ncid%close(rc=status) + call FireMethodInit(bounds,paramfile) if (use_century_decomp) then call init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index fe3e9b84a..1774d7f65 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -3917,7 +3917,6 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) real :: bare logical, save :: first = .true. integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline - class(fire_method_type) :: cnfire_method ! Offline mode @@ -4230,7 +4229,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cnfire_method,cn5_cold_start=.true.) + call CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start=.true.) call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif @@ -6897,14 +6896,11 @@ subroutine Driver ( RC ) ar1m = ar1m / cnsum sndzm = sndzm / cnsum asnowm = asnowm / cnsum - - cnfire_method%forc_hdm = hdm(nc) - cnfire_method%forc_lnfm = lnfm(nc) call CN_Driver(ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& - abm,peatf,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& - asnowm,TG10D,T2MMIN5D,SNDZM5D,cnfire_method, & + abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& + asnowm,TG10D,T2MMIN5D,SNDZM5D, & elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& fire_nloss,leafn,leafc,gross_nmin,net_nmin,& From e9e47f259be09d946d6772ce156fe8f55502f500 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 9 Jan 2023 13:24:59 -0500 Subject: [PATCH 299/589] fix fire initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index c5b310870..01ab258eb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -71,7 +71,7 @@ module CN_initMod use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams - use CNCLM_Driver , only : FireMethodInit + use CNCLM_DriverMod , only : FireMethodInit use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -99,7 +99,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) real, dimension(nch), intent(in) :: lats ! Catchment tile latitudes [rad] real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes [rad] logical, optional, intent(in) :: cn5_cold_start ! cold start for the CLM variables that are new in Catchment-CN5.0 - class(fire_method_type), allocatable, intent(out) :: cnfire_method + !LOCAL From 38d5a8d42a5b2b9679e1512f12d82f0909fe52ce Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 10 Jan 2023 11:38:34 -0500 Subject: [PATCH 300/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 01ed5b507..2df388631 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -200,7 +200,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - real ::pwtgcell + real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. integer :: n, p, nc, nz, np, nv From ef37bf797d9e404c192efdf2565d3e8c8c6401d7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 10 Jan 2023 17:06:47 -0500 Subject: [PATCH 301/589] changing fir initialization --- .../CLM51/CNCLM_CNProductsMod.F90 | 2 +- .../CLM51/CNCLM_DriverMod.F90 | 27 ++++++++++--------- .../CLM51/CN_init_mod.F90 | 4 +++ 3 files changed, 19 insertions(+), 14 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index 6e1a7c8a1..a2e01f02a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -21,7 +21,7 @@ module CNProductsMod ! !PUBLIC TYPES: type, public :: cn_products_type - private + ! ------------------------------------------------------------------------ ! Public instance variables ! ------------------------------------------------------------------------ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 2df388631..67546ca4e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -4,7 +4,7 @@ module CNCLM_DriverMod use nanMod , only : nan use CNVegetationFacade, only : cn_vegetation_type use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& - var_col, var_pft, nlevgrnd, numpft + var_col, var_pft, nlevgrnd, numpft, ndecomp_pools use clm_varcon , only : grav, denh2o use decompMod, only : bounds_type use filterMod, only : clumpfilter @@ -43,7 +43,7 @@ module CNCLM_DriverMod use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNProductsMod , only : cn_products_type - use CNFireFactoryMod , only : CNFireReadNM, create_cnfire_method + use CNFireFactoryMod , only : create_cnfire_method use FireMethodType , only : fire_method_type implicit none @@ -55,8 +55,6 @@ module CNCLM_DriverMod public :: get_CN_LAI public :: FireMethodInit - class(fire_method_type) , allocatable :: cnfire_method - contains !--------------------------------- @@ -111,6 +109,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: t2m5d ! 5-day running mean of daily minimum 2m temperature [K] real, dimension(nch), intent(in) :: sndzn5d ! 5-day running mean of total snow depth + ! OUTPUT real, dimension(nch,num_veg,num_zon), intent(out) :: zlai ! leaf-area index for tile (subject to burying by snow) @@ -217,8 +216,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - cnfire_method%forc_hdm(nc) = hdm(nc) - cnfire_method%forc_lnfm(nc) = lnfm(nc) + bgc_vegetation_inst%cnfire_method%forc_hdm(nc) = hdm(nc) + bgc_vegetation_inst%cnfire_method%forc_lnfm(nc) = lnfm(nc) do nz = 1,num_zon ! CN zone loop n = n + 1 @@ -257,7 +256,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m temperature_inst%t_ref2m_patch(p) = tairm(nc) temperature_inst%soila10_patch(p) = tg10d(nc) temperature_inst%t_a5min_patch(p) = t2m5d(nc) - cnfire_method%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 + bgc_vegetation_inst%cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) @@ -389,6 +388,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m fuelcg(nc) = 0. totlitcg(nc) = 0. cwdcg(nc) = 0. + xsmr(nc) = 0. neeg(nc) = cnveg_carbonflux_inst%nee_grc(nc) @@ -428,7 +428,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m zsai(nc,nv,nz) = canopystate_inst%esai_patch(p) ztai(nc,nv,nz) = canopystate_inst%tlai_patch(p) - pwtgcell = fveg(nc,nv,nz)*wtzone(nc,nz) ! PFT weight in catchment tile + pwtgcell = fveg(nc,nv,nz)*CN_zone_weight(nc,nz) ! PFT weight in catchment tile nppg(nc) = nppg(nc) + cnveg_carbonflux_inst%npp_patch(p)*pwtgcell gppg(nc) = gppg(nc) + cnveg_carbonflux_inst%gpp_patch(p)*pwtgcell root(nc) = root(nc) + (cnveg_carbonstate_inst%frootc_patch(p) & @@ -453,7 +453,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m + cnveg_carbonstate_inst%deadcrootc_storage_patch(p) & + cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) & )*pwtgcell - + + xsmr(nc) = xsmr(nc) + cnveg_carbonstate_inst%xsmrpool_patch(p)*pwtgcell end if end do ! nv end do !np @@ -537,7 +538,7 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) do p = 0,numpft ! PFT index loop np = np + 1 - do nv = 1,nveg ! defined veg loop + do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then cnpft(nc,nz,nv, 1) = cnveg_carbonstate_inst%cpool_patch (np) @@ -614,7 +615,7 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) cnpft(nc,nz,nv, 72) = canopystate_inst%htop_patch (np) cnpft(nc,nz,nv, 73) = canopystate_inst%tlai_patch (np) cnpft(nc,nz,nv, 74) = canopystate_inst%tsai_patch (np) - cnpft(nc,nz,nv, 75) = cnveg_carbonflux_inst%plant_ndemand_patch (np) + cnpft(nc,nz,nv, 75) = cnveg_nitrogenflux_inst%plant_ndemand_patch (np) cnpft(nc,nz,nv, 76) = canopystate_inst%vegwp_patch (np,1) cnpft(nc,nz,nv, 77) = canopystate_inst%vegwp_patch (np,2) cnpft(nc,nz,nv, 78) = canopystate_inst%vegwp_patch (np,3) @@ -659,11 +660,11 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) n = 0 np = 0 do nc = 1,nch ! catchment tile loop - do nz = 1,nzone ! CN zone loop + do nz = 1,num_zon ! CN zone loop n = n + 1 do p = 0,numpft ! PFT index loop np = np + 1 - do nv = 1,nveg ! defined veg loop + do nv = 1,num_veg ! defined veg loop ! extract LAI & SAI from CN clmtype ! --------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 01ab258eb..598f79575 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -82,6 +82,7 @@ module CN_initMod type(photosyns_type), public :: photosyns_inst class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method + class(fire_method_type), allocatable :: cnfire_method contains @@ -264,6 +265,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call CNPhenologyInit (bounds) call bgc_vegetation_inst%cn_balance_inst%Init (bounds) + call create_cnfire_method( bgc_vegetation_inst%cnfire_method) + call bgc_vegetation_inst%cnfire_method%CNFireReadParams( params_ncid ) ! calls to original CTSM initialization routines @@ -302,6 +305,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call readSoilBiogeochemNLeachingParams(ncid) call readSoilBiogeochemCompetitionParams(ncid) call readSoilBiogeochemPotentialParams(ncid) + call bgc_vegetation_inst%cnfire_method%CNFireReadParams( ncid ) call ncid%close(rc=status) From d5d3cf543d6415fe91e046c6eefc52c7fd65feb0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 10 Jan 2023 18:13:27 -0500 Subject: [PATCH 302/589] remove use of Driver module; cleanup --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 598f79575..9aebe0ef5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -71,7 +71,7 @@ module CN_initMod use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams - use CNCLM_DriverMod , only : FireMethodInit + use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -266,7 +266,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call bgc_vegetation_inst%cn_balance_inst%Init (bounds) call create_cnfire_method( bgc_vegetation_inst%cnfire_method) - call bgc_vegetation_inst%cnfire_method%CNFireReadParams( params_ncid ) + ! calls to original CTSM initialization routines From b266304ce0eb585afccc5e457e173af972d8bc5c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 11 Jan 2023 08:59:48 -0500 Subject: [PATCH 303/589] change fire data base initialization --- .../CLM51/CNCLM_DriverMod.F90 | 49 +++++++++---------- 1 file changed, 24 insertions(+), 25 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 67546ca4e..61bf758c4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -44,7 +44,7 @@ module CNCLM_DriverMod use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNProductsMod , only : cn_products_type use CNFireFactoryMod , only : create_cnfire_method - use FireMethodType , only : fire_method_type + use FireDataBaseType , only : fire_base_type implicit none private @@ -53,7 +53,6 @@ module CNCLM_DriverMod public :: CN_Driver public :: CN_exit public :: get_CN_LAI - public :: FireMethodInit contains @@ -216,8 +215,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - bgc_vegetation_inst%cnfire_method%forc_hdm(nc) = hdm(nc) - bgc_vegetation_inst%cnfire_method%forc_lnfm(nc) = lnfm(nc) + fire_base_type%forc_hdm(nc) = hdm(nc) + fire_base_type%forc_lnfm(nc) = lnfm(nc) do nz = 1,num_zon ! CN zone loop n = n + 1 @@ -428,7 +427,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m zsai(nc,nv,nz) = canopystate_inst%esai_patch(p) ztai(nc,nv,nz) = canopystate_inst%tlai_patch(p) - pwtgcell = fveg(nc,nv,nz)*CN_zone_weight(nc,nz) ! PFT weight in catchment tile + pwtgcell = fveg(nc,nv,nz)*CN_zone_weight(nz) ! PFT weight in catchment tile nppg(nc) = nppg(nc) + cnveg_carbonflux_inst%npp_patch(p)*pwtgcell gppg(nc) = gppg(nc) + cnveg_carbonflux_inst%gpp_patch(p)*pwtgcell root(nc) = root(nc) + (cnveg_carbonstate_inst%frootc_patch(p) & @@ -684,24 +683,24 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) end subroutine get_CN_LAI !--------------------------- - subroutine FireMethodInit(bounds,paramfile) - - use MAPL , only : NetCDF4_FileFormatter - - - type(bounds_type), intent(in) :: bounds - character(300), intent(in) :: paramfile - - type(Netcdf4_fileformatter) :: ncid - integer :: rc, status - !-------------------------------- - - call create_cnfire_method(cnfire_method) - call cnfire_method%FireInit(bounds) - - call ncid%open(trim(paramfile),pFIO_READ, __RC__) - call cnfire_method%CNFireReadParams( ncid ) - call ncid%close(rc=status) - - end subroutine FireMethodInit +! subroutine FireMethodInit(bounds,paramfile) +! +! use MAPL , only : NetCDF4_FileFormatter +! +! +! type(bounds_type), intent(in) :: bounds +! character(300), intent(in) :: paramfile +! +! type(Netcdf4_fileformatter) :: ncid +! integer :: rc, status +! !-------------------------------- +! +! call create_cnfire_method(cnfire_method) +! call cnfire_method%FireInit(bounds) +! +! call ncid%open(trim(paramfile),pFIO_READ, __RC__) +! call cnfire_method%CNFireReadParams( ncid ) +! call ncid%close(rc=status) +! +! end subroutine FireMethodInit end module CNCLM_DriverMod From 8ff3f0b58e46b914b11975dd4c2dda0ac5a6afeb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 11 Jan 2023 09:20:23 -0500 Subject: [PATCH 304/589] change variable name --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 61bf758c4..e1ecddb0c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -197,6 +197,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(fire_base_type) :: fire_base_inst real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions @@ -215,8 +216,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - fire_base_type%forc_hdm(nc) = hdm(nc) - fire_base_type%forc_lnfm(nc) = lnfm(nc) + fire_base_inst%forc_hdm(nc) = hdm(nc) + fire_base_inst%forc_lnfm(nc) = lnfm(nc) do nz = 1,num_zon ! CN zone loop n = n + 1 From 9688feb0830a57d0d4e449e97811b613d246850e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 11 Jan 2023 12:25:28 -0500 Subject: [PATCH 305/589] remove soil_water_retention_curve input and ficing fire initialization --- .../CLM51/CNCLM_DriverMod.F90 | 25 +++++++++++++------ .../CLM51/CNDriverMod.F90 | 6 ++--- .../CLM51/CNFireLi2014Mod.F90 | 6 ++--- .../CLM51/CNFireLi2016Mod.F90 | 6 ++--- .../CLM51/CNFireLi2021Mod.F90 | 6 ++--- .../CLM51/CNFireNoFireMod.F90 | 4 +-- .../CLM51/CNVegetationFacade.F90 | 6 ++--- .../CLM51/CN_init_mod.F90 | 4 +-- .../CLM51/FireMethodType.F90 | 6 ++--- 9 files changed, 35 insertions(+), 34 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index e1ecddb0c..71b776b32 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -31,7 +31,6 @@ module CNCLM_DriverMod use ActiveLayerMod , only : active_layer_type use SoilBiogeochemStateType , only : soilbiogeochem_state_type use CanopyStateType , only : canopystate_type - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type use CropType , only : crop_type use ch4Mod , only : ch4_type use PhotosynthesisMod , only : photosyns_type @@ -45,7 +44,10 @@ module CNCLM_DriverMod use CNProductsMod , only : cn_products_type use CNFireFactoryMod , only : create_cnfire_method use FireDataBaseType , only : fire_base_type - + use CNFireLi2014Mod , only : cnfire_li2014_type + use CNFireLi2016Mod , only : cnfire_li2016_type + use CNFireLi2021Mod , only : cnfire_li2021_type + implicit none private @@ -196,8 +198,10 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst - type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - type(fire_base_type) :: fire_base_inst + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(cnfire_li2014_type) :: cnfire_li2014_inst + type(cnfire_li2016_type) :: cnfire_li2016_inst + type(cnfire_li2021_type) :: cnfire_li2021_inst real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions @@ -216,8 +220,13 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - fire_base_inst%forc_hdm(nc) = hdm(nc) - fire_base_inst%forc_lnfm(nc) = lnfm(nc) + cnfire_li2014_inst%forc_hdm(nc) = hdm(nc) + cnfire_li2014_inst%forc_lnfm(nc) = lnfm(nc) + cnfire_li2016_inst%forc_hdm(nc) = hdm(nc) + cnfire_li2016_inst%forc_lnfm(nc) = lnfm(nc) + cnfire_li2021_inst%forc_hdm(nc) = hdm(nc) + cnfire_li2021_inst%forc_lnfm(nc) = lnfm(nc) + do nz = 1,num_zon ! CN zone loop n = n + 1 @@ -256,7 +265,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m temperature_inst%t_ref2m_patch(p) = tairm(nc) temperature_inst%soila10_patch(p) = tg10d(nc) temperature_inst%t_a5min_patch(p) = t2m5d(nc) - bgc_vegetation_inst%cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 + ! bgc_vegetation_inst%cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) @@ -312,7 +321,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m atm2lnd_inst, waterstatebulk_inst, & waterdiagnosticbulk_inst, waterfluxbulk_inst, & wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & - soil_water_retention_curve, crop_inst, ch4_inst, & + crop_inst, ch4_inst, & photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & nutrient_competition_method, fireemis_inst) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 index edb028010..0cbe3fa43 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -41,7 +41,6 @@ module CNDriverMod use EnergyFluxType , only : energyflux_type use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type use ActiveLayerMod , only : active_layer_type - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type ! ! !PUBLIC TYPES: implicit none @@ -99,7 +98,7 @@ subroutine CNDriverNoLeaching(bounds, active_layer_inst, & atm2lnd_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, & wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & - soil_water_retention_curve, crop_inst, ch4_inst, & + crop_inst, ch4_inst, & dgvs_inst, photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & nutrient_competition_method, cnfire_method, dribble_crophrv_xsmrpool_2atm) ! @@ -191,7 +190,6 @@ subroutine CNDriverNoLeaching(bounds, type(canopystate_type) , intent(inout) :: canopystate_inst type(soilstate_type) , intent(inout) :: soilstate_inst type(temperature_type) , intent(inout) :: temperature_inst - class(soil_water_retention_curve_type) , intent(in) :: soil_water_retention_curve type(crop_type) , intent(inout) :: crop_inst type(ch4_type) , intent(in) :: ch4_inst type(dgvs_type) , intent(inout) :: dgvs_inst @@ -783,7 +781,7 @@ subroutine CNDriverNoLeaching(bounds, call cnfire_method%CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + waterstatebulk_inst, soilstate_inst, & cnveg_state_inst, cnveg_carbonstate_inst, & totlitc_col=soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 index f7fd7d75c..e7cddf019 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 @@ -39,7 +39,7 @@ module CNFireLi2014Mod use Wateratm2lndBulkType , only : wateratm2lndbulk_type use WaterStateBulkType , only : waterstatebulk_type use SoilStateType , only : soilstate_type - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type +! use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type use GridcellType , only : grc use ColumnType , only : col use PatchType , only : patch @@ -86,7 +86,7 @@ end function need_lightning_and_popdens subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, & - wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, & cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) ! ! !DESCRIPTION: @@ -117,7 +117,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(soilstate_type) , intent(in) :: soilstate_inst - class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + !class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst real(r8) , intent(in) :: totlitc_col(bounds%begc:) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 index 74ac5e744..d7b44b0dc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 @@ -38,7 +38,7 @@ module CNFireLi2016Mod use Wateratm2lndBulkType , only : wateratm2lndbulk_type use WaterStateBulkType , only : waterstatebulk_type use SoilStateType , only : soilstate_type - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + ! use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type use GridcellType , only : grc use ColumnType , only : col use PatchType , only : patch @@ -88,7 +88,7 @@ end function need_lightning_and_popdens subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, & - wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, & cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) ! ! !DESCRIPTION: @@ -120,7 +120,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(soilstate_type) , intent(in) :: soilstate_inst - class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + !class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst real(r8) , intent(in) :: totlitc_col(bounds%begc:) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 index 1fc851c46..a6b0c70b9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 @@ -38,7 +38,7 @@ module CNFireLi2021Mod use Wateratm2lndBulkType , only : wateratm2lndbulk_type use WaterStateBulkType , only : waterstatebulk_type use SoilStateType , only : soilstate_type - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + ! use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type use GridcellType , only : grc use ColumnType , only : col use PatchType , only : patch @@ -88,7 +88,7 @@ end function need_lightning_and_popdens subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, & - wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + wateratm2lndbulk_inst, waterstatebulk_inst, soilstate_inst, & cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) ! ! !DESCRIPTION: @@ -120,7 +120,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(soilstate_type) , intent(in) :: soilstate_inst - class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + !class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst real(r8) , intent(in) :: totlitc_col(bounds%begc:) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireNoFireMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireNoFireMod.F90 index 0dc1ee39d..5c1472bcb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireNoFireMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireNoFireMod.F90 @@ -21,7 +21,6 @@ module CNFireNoFireMod use Wateratm2lndBulkType , only : wateratm2lndbulk_type use WaterStateBulkType , only : waterstatebulk_type use SoilStateType , only : soilstate_type - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type use FireMethodType , only : fire_method_type use CNFireBaseMod , only : cnfire_base_type ! @@ -61,7 +60,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, & waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + waterstatebulk_inst, soilstate_inst, & cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) ! ! !DESCRIPTION: @@ -88,7 +87,6 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(soilstate_type) , intent(in) :: soilstate_inst - class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst real(r8) , intent(in) :: totlitc_col(bounds%begc:) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 0f462d77a..b66c4927b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -95,7 +95,6 @@ module CNVegetationFacade use CNPrecisionControlMod , only: CNPrecisionControl use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControl use GridcellType , only : grc - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type ! implicit none private @@ -903,7 +902,7 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & active_layer_inst, & atm2lnd_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, & wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & - soil_water_retention_curve, crop_inst, ch4_inst, & + crop_inst, ch4_inst, & photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & nutrient_competition_method, fireemis_inst) ! @@ -951,7 +950,6 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & type(canopystate_type) , intent(inout) :: canopystate_inst type(soilstate_type) , intent(inout) :: soilstate_inst type(temperature_type) , intent(inout) :: temperature_inst - class(soil_water_retention_curve_type) , intent(in) :: soil_water_retention_curve type(crop_type) , intent(inout) :: crop_inst type(ch4_type) , intent(in) :: ch4_inst type(photosyns_type) , intent(in) :: photosyns_inst @@ -991,7 +989,7 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & active_layer_inst, & atm2lnd_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, & wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & - soil_water_retention_curve, crop_inst, ch4_inst, & + crop_inst, ch4_inst, & this%dgvs_inst, photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & nutrient_competition_method, this%cnfire_method, this%dribble_crophrv_xsmrpool_2atm) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 9aebe0ef5..0101189fd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -70,7 +70,6 @@ module CN_initMod use SoilBiogeochemNLeachingMod , only : readSoilBiogeochemNLeachingParams => readParams use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams - use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -82,7 +81,7 @@ module CN_initMod type(photosyns_type), public :: photosyns_inst class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method - class(fire_method_type), allocatable :: cnfire_method + class(fire_method_type), allocatable :: cnfire_method contains @@ -266,7 +265,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call bgc_vegetation_inst%cn_balance_inst%Init (bounds) call create_cnfire_method( bgc_vegetation_inst%cnfire_method) - ! calls to original CTSM initialization routines diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 index 5399ebcf7..25f715d63 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 @@ -118,7 +118,7 @@ subroutine CNFireArea_interface (this, bounds, num_soilc, filter_soilc, num_soil num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, & waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + waterstatebulk_inst, soilstate_inst, & cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) ! ! !DESCRIPTION: @@ -134,7 +134,7 @@ subroutine CNFireArea_interface (this, bounds, num_soilc, filter_soilc, num_soil use Wateratm2lndBulkType , only : wateratm2lndbulk_type use WaterStateBulkType , only : waterstatebulk_type use SoilStateType , only : soilstate_type - use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + ! use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type use CNVegStateType , only : cnveg_state_type use CNVegCarbonStateType , only : cnveg_carbonstate_type import :: fire_method_type @@ -157,7 +157,7 @@ subroutine CNFireArea_interface (this, bounds, num_soilc, filter_soilc, num_soil type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(soilstate_type) , intent(in) :: soilstate_inst - class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + !class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst real(r8) , intent(in) :: totlitc_col(bounds%begc:) From bd6f549f87f13c647817b17edbbf84dfbb27c96e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 11 Jan 2023 13:03:27 -0500 Subject: [PATCH 306/589] add btran2 initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 71b776b32..ae5d5c475 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -265,7 +265,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m temperature_inst%t_ref2m_patch(p) = tairm(nc) temperature_inst%soila10_patch(p) = tg10d(nc) temperature_inst%t_a5min_patch(p) = t2m5d(nc) - ! bgc_vegetation_inst%cnfire_method%btran2_patch(p) = btran_fire(nc,nz) ! only needed if fire method is Li 2016 + cnfire_li2014_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + cnfire_li2016_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + cnfire_li2021_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) From 306415411733fe682780161ce70ada958e33b7e2 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 12 Jan 2023 09:07:38 -0500 Subject: [PATCH 307/589] fix typo --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 1774d7f65..6a2357e8d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -5406,8 +5406,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,SNDZM ,'SNDZM5D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,ASNOWM ,'ASNOWM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,T2M10D ,'T2M10D' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,T2M10D ,'TG10D' ,RC=STATUS); VERIFY_(STATUS - call MAPL_GetPointer(INTERNAL,T2M10D ,'T2MMIN5D' ,RC=STATUS); VERIFY_(STATUS + call MAPL_GetPointer(INTERNAL,T2M10D ,'TG10D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,T2M10D ,'T2MMIN5D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,RH30D ,'RH30D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC10D ,'TPREC10D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC60D ,'TPREC60D' ,RC=STATUS); VERIFY_(STATUS) From d52cd39a6672608ae80ab4365eba6ceee69109ed Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 12 Jan 2023 10:09:11 -0500 Subject: [PATCH 308/589] bug fixes --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 1 + .../GEOS_CatchCNCLM51GridComp.F90 | 13 ++++++++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index d3f6746cc..c3e7eb4e4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -54,6 +54,7 @@ module clm_varpar integer, parameter, PUBLIC :: VAR_COL=35 ! number of CN column restart variables integer, parameter, PUBLIC :: VAR_PFT=81 ! number of CN PFT restart variables real, parameter, PUBLIC, dimension(NUM_ZON) :: CN_zone_weight = (/0.10,0.45,0.45/) ! gkw: tunable; must sum to 1 + integer, parameter, PUBLIC :: map_cat(0:numpft) = (/4,3,3,3,1,1,2,2,2,5,5,6,4,4,4,4/) ! constants for decomposition cascade diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 6a2357e8d..57730da72 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -62,7 +62,7 @@ module GEOS_CatchCNCLM51GridCompMod USE MAPL use MAPL_ConstantsMod,only: Tzero => MAPL_TICE, pi => MAPL_PI use clm_time_manager, only: get_days_per_year, get_step_size - use pftvarcon, only: noveg + use pftconMod, only: noveg USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & catch_calc_zbar, catch_calc_peatclsm_waterlevel, irrigation_rate, & gndtmp @@ -3913,6 +3913,9 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) integer, allocatable :: ityp(:,:,:) real, allocatable :: fveg(:,:,:), elai(:,:,:), esai(:,:,:), tlai(:,:,:), wtzone(:,:), lai1(:), lai2(:), wght(:) + real,pointer,dimension(:) :: lats + real,pointer,dimension(:) :: lons + integer :: nv, nz, ib real :: bare logical, save :: first = .true. @@ -4229,7 +4232,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start=.true.) + call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start=.true.) call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif @@ -4716,6 +4719,8 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: ar1m real, dimension(:), pointer :: tpm real, dimension(:), pointer :: cnsum + real, dimension(:), pointer :: psnsunm + real, dimension(:), pointer :: psnsham real, dimension(:), pointer :: sndzm real, dimension(:), pointer :: asnowm real, dimension(:,:), pointer :: RDU001 @@ -5074,10 +5079,12 @@ subroutine Driver ( RC ) real, allocatable, dimension(:) :: SWSRF1, SWSRF2, SWSRF4 ! soil water as frac of WHC for the 3 dydrological zones at surface soil real, allocatable, dimension(:,:) :: tcx, qax real, allocatable, dimension(:,:) :: tgw, rzm, sfm,rcxdt, rcxdq,rc00, rcdt,rcdq, totcolc, wtzone + real, allocatable, dimension(:,:) :: btran_fire, bt real, allocatable, dimension(:,:,:) :: btran,elai,esai,fveg,tlai,psnsun,psnsha,laisun,laisha,lmrsun,lmrsha integer, allocatable, dimension(:,:,:) :: ityp real, allocatable, dimension(:) :: car1, car2, car4 real, allocatable, dimension(:) :: para + real, allocatable, dimension(:) :: rcxdt, rcxdq real, allocatable, dimension(:) :: dayl, dayl_fac real, allocatable, dimension(:), save :: nee, npp, gpp, sr, padd, frootc, vegc, xsmr,burn, closs real, allocatable, dimension(:) :: nfire, som_closs, fsnow @@ -5643,7 +5650,7 @@ subroutine Driver ( RC ) ! obtain LAI from previous time step (from CN model) ! -------------------------------------------------- - call get_CN_LAI(ntiles,nveg,nzone,ityp,fveg,elai,esai=esai,tlai = tlai) + call get_CN_LAI(ntiles,ityp,fveg,elai,esai=esai,tlai = tlai) ! OPTIONAL IMPOSE MONTHLY MEAN DIURNAL CYCLE FROM NOAA CARBON TRACKER ! ------------------------------------------------------------------- From 673ceff4f58f749539cc6aa3031d74ca43eed9bd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 12 Jan 2023 11:02:57 -0500 Subject: [PATCH 309/589] bug fixes in GirdComp --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 ++ .../GEOS_CatchCNCLM51GridComp.F90 | 9 +++++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 0101189fd..526edc951 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -86,6 +86,7 @@ module CN_initMod contains !------------------------------------------------------ +interface subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) !ARGUMENTS @@ -317,6 +318,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) end if end subroutine CN_init +end interface end module CN_initMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 57730da72..0ac14850d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -5078,7 +5078,7 @@ subroutine Driver ( RC ) real, allocatable, dimension(:,:) :: sm ! soil water as frac of WHC for the 3 dydrological zones at root depth real, allocatable, dimension(:) :: SWSRF1, SWSRF2, SWSRF4 ! soil water as frac of WHC for the 3 dydrological zones at surface soil real, allocatable, dimension(:,:) :: tcx, qax - real, allocatable, dimension(:,:) :: tgw, rzm, sfm,rcxdt, rcxdq,rc00, rcdt,rcdq, totcolc, wtzone + real, allocatable, dimension(:,:) :: tgw, rzm, sfm,rc00, rcdt,rcdq, totcolc, wtzone real, allocatable, dimension(:,:) :: btran_fire, bt real, allocatable, dimension(:,:,:) :: btran,elai,esai,fveg,tlai,psnsun,psnsha,laisun,laisha,lmrsun,lmrsha integer, allocatable, dimension(:,:,:) :: ityp @@ -5146,7 +5146,8 @@ subroutine Driver ( RC ) real, allocatable, dimension(:) :: Qair_relative ! relative humidity (%) integer :: nz, iv - real :: cn1, cn2, cn3, cn12, cn23, ar, f1, f2, f3, f4, ax1, ax2, ax4 + real :: cn1, cn2, cn3, cn12, cn23, ar, ax1, ax2, ax4 + real, dimension(fsat:fwlt) :: f1, f2, f3, f4 real, allocatable, dimension(:,:,:,:) :: albdir, albdif integer, allocatable, dimension(:) :: ityp_tmp @@ -6420,9 +6421,9 @@ subroutine Driver ( RC ) end do bt(:,fsat) = 1.0 - bt(:,ftrns) = sm(:,ftrns)**(-bee) + bt(:,ftrn) = sm(:,ftrn)**(-bee) wpp = wpwet ** (-bee) - bt(:,ftrns) = (bt(:,ftrns)-wpp)/(1.-wpp) + bt(:,ftrn) = (bt(:,ftrn)-wpp)/(1.-wpp) bt(:,fwlt) = 0. do n = 1,ntiles From ef896c268b11933096ec88e2c6acaf1ef3e9185e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 12 Jan 2023 11:30:13 -0500 Subject: [PATCH 310/589] adjusting logical comparison to preferred Fortran standard --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 6 +++--- .../CLM51/CNCLM_CanopyStateType.F90 | 8 ++++---- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 4 ++-- .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 6 +++--- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 21e0b5668..923a65c72 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -519,12 +519,12 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi !-------------------------------------------------------- ! check whether a cn5_cold_start option was set and change cold_start accordingly - if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + if (present(cn5_cold_start) .and. (cn5_cold_start.eqv..true.)) then cold_start = .true. end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + if ((cold_start.eqv..false.) .and. ((size(cncol,3).ne.var_col) .or. & (size(cnpft,3).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if @@ -1099,7 +1099,7 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi ! "new" variables: introduced in CNCLM50 - if (cold_start==.false.) then + if (cold_start.eqv..false.) then this%annsum_litfall_patch(np) = cnpft(nc,nz,nv, 80) this%tempsum_litfall_patch(np) = cnpft(nc,nz,nv, 81) elseif (cold_start) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 0655b5613..a0606ee35 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -55,7 +55,7 @@ module CanopyStateType real(r8) :: leaf_mr_vcm = spval ! Scalar constant of leaf respiration with Vcmax end type canopystate_type - type(canopystate_type), public, target, save :: canopystate_inst + type(canopystate_type), public :: canopystate_inst contains @@ -93,12 +93,12 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn begg = bounds%begg ; endg = bounds%endg ! check whether a cn5_cold_start option was set and change cold_start accordingly - if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + if (present(cn5_cold_start) .and. (cn5_cold_start.eqv..true.)) then cold_start = .true. end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + if ((cold_start.eqv..false.) .and. ((size(cncol,3).ne.var_col) .or. & (size(cnpft,3).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if @@ -157,7 +157,7 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn this%tsai_patch (np) = cnpft(nc,nz,nv, 74) ! "new" variables: introduced in CNCLM50 - if (cold_start==.false.) then + if (cold_start.eqv..false.) then do nw = 1,nvegwcs this%vegwp_patch(np,nw) = cnpft(nc,nz,nv, 76+(nw-1)) end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 87456704f..1a9c0e93f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -69,12 +69,12 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this, cn5_cold_sta begc = bounds%begc; endc= bounds%endc ! check whether a cn5_cold_start option was set and change cold_start accordingly - if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + if (present(cn5_cold_start) .and. (cn5_cold_start.eqv..true.)) then cold_start = .true. end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. (size(cncol,3).ne.var_col)) then + if ((cold_start.eqv..false.) .and. (size(cncol,3).ne.var_col)) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 862b3febc..2047bd3d8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -255,12 +255,12 @@ subroutine Init(this,bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,rc) begc = bounds%begc; endc= bounds%endc ! check whether a cn5_cold_start option was set and change cold_start accordingly - if (present(cn5_cold_start) .and. (cn5_cold_start==.true.)) then + if (present(cn5_cold_start) .and. (cn5_cold_start.eqv..true.)) then cold_start = .true. end if ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start==.false.) .and. ((size(cncol,3).ne.var_col) .or. & + if ((cold_start.eqv..false.) .and. ((size(cncol,3).ne.var_col) .or. & (size(cnpft,3).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if @@ -379,7 +379,7 @@ subroutine Init(this,bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,rc) if (cold_start) then this%alphapsnsun_patch(np) = 0._r8 this%alphapsnsha_patch(np) = 0._r8 - else if (cold_start==.false.) then + else if (cold_start.eqv..false.) then this%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 76) this%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 77) end if From b287b3ed98b3728ebb71c09fb4282026713c22ba Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 12 Jan 2023 13:02:51 -0500 Subject: [PATCH 311/589] removing keyword arguments from CN_init call --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 -- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 526edc951..0101189fd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -86,7 +86,6 @@ module CN_initMod contains !------------------------------------------------------ -interface subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) !ARGUMENTS @@ -318,7 +317,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) end if end subroutine CN_init -end interface end module CN_initMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 0ac14850d..b38e2faf0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -4232,7 +4232,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start=.true.) + call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,.true.) call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif From c8ee777500b887452e84e103038003065fc8620f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 12 Jan 2023 13:48:46 -0500 Subject: [PATCH 312/589] bug fixes --- .../GEOS_CatchCNCLM51GridComp.F90 | 87 ++++++++++--------- 1 file changed, 46 insertions(+), 41 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index b38e2faf0..22447419a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -4722,6 +4722,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: psnsunm real, dimension(:), pointer :: psnsham real, dimension(:), pointer :: sndzm + real, dimension(:), pointer :: sndzm5d real, dimension(:), pointer :: asnowm real, dimension(:,:), pointer :: RDU001 real, dimension(:,:), pointer :: RDU002 @@ -5181,8 +5182,8 @@ subroutine Driver ( RC ) integer, save :: istep ! model time step index integer :: accper ! number of time steps accumulated in a period of XX days, increases from 1 to nXXd in the first XX days, ! and remains as nXXd thereafter - integer :: ta_count = 0 - real :: TA_MIN = 1000. + integer, dimension(:) :: ta_count + real, dimension(:) :: TA_MIN integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_MI, AGCM_S, AGCM_HH, dofyr, AGCM_S_ofday logical, save :: first = .true. @@ -5411,7 +5412,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,PSNSUNM ,'PSNSUNM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,PSNSHAM ,'PSNSHAM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,SNDZM ,'SNDZM' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,SNDZM ,'SNDZM5D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SNDZM5D ,'SNDZM5D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,ASNOWM ,'ASNOWM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,T2M10D ,'T2M10D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,T2M10D ,'TG10D' ,RC=STATUS); VERIFY_(STATUS) @@ -5839,6 +5840,9 @@ subroutine Driver ( RC ) allocate(QA4_0 (NTILES)) allocate(PLSIN (NTILES)) + allocate(TA_MIN (NTILES)) + allocate(ta_count (NTILES)) + call ESMF_VMGetCurrent ( VM, RC=STATUS ) ! -------------------------------------------------------------------------- ! Catchment Id and vegetation types used to index into tables @@ -6487,7 +6491,7 @@ subroutine Driver ( RC ) btran_fire(n,nz) = (f1(nz)*bt(n,fsat) + f2(nz)*bt(n,ftrn) + f4(nz)*bt(n,fwlt) )/wtzone(n,nz) tgw(n,nz) = (f1(nz)*tg(n,fsat) + f2(nz)*tg(n,ftrn) + f4(nz)*tg(n,fwlt))/wtzone(n,nz) tcx(n,nz) = (f1(nz)*tc(n,fsat) + f2(nz)*tc(n,ftrn) + f4(nz)*tc(n,fwlt))/wtzone(n,nz) - qcx(n,nz) = (f1(nz)*qc(n,fsat) + f2(nz)*qc(n,ftrn) + f4(nz)*qc(n,fwlt))/wtzone(n,nz) + qax(n,nz) = (f1(nz)*qc(n,fsat) + f2(nz)*qc(n,ftrn) + f4(nz)*qc(n,fwlt))/wtzone(n,nz) rzm(n,nz) = (f1(nz)*sm(n,fsat) + f2(nz)*sm(n,ftrn) + f4(nz)*sm(n,fwlt))/wtzone(n,nz) sfm(n,nz) = (f1(nz)*SWSRF1(n) + f2(nz)*SWSRF2(n) + f4(nz)*SWSRF4(n) )/wtzone(n,nz) end do @@ -6560,7 +6564,7 @@ subroutine Driver ( RC ) accper = min(istep,n10d) T2M10D = ((accper-1)*T2M10D + TA) / accper TPREC10D = ((accper-1)*TPREC10D + PCU + PLS + SNO) / accper - TG10D = ((accper-1)*TG10D + TG) / accper + TG10D = ((accper-1)*TG10D + TG(:,1)) / accper ! (2) 30-day running mean of relative humidity [%] accper = min(istep,n30d) @@ -6574,14 +6578,16 @@ subroutine Driver ( RC ) ! jkolassa: for T2MMIN5D compute minimum T2M once per day, then use that value to compute new 5-day running mean of minimum T2M - ta_count = ta_count + 1 - TA_MIN = min(TA_MIN,TA) + do n = 1,ntiles + ta_count(n) = ta_count(n) + 1 + TA_MIN(n) = min(TA_MIN(n),TA(n)) - if (ta_count == n1d) then - T2MMIN5D = ((accper-1)*T2MMIN5D + TA_MIN) / accper - TA_MIN = 1000. - ta_count = 0 - end if + if (ta_count(n) == n1d) then + T2MMIN5D(n) = ((accper-1)*T2MMIN5D(n) + TA_MIN(n)) / accper + TA_MIN(n) = 1000. + ta_count(n) = 0 + end if + end do else @@ -6595,14 +6601,16 @@ subroutine Driver ( RC ) ! jkolassa: for T2MMIN5D compute minimum T2M once per day, then use that value to compute new 5-day running mean of minimum T2M - ta_count = ta_count + 1 - TA_MIN = min(TA_MIN,TA) + do n = 1,ntiles + ta_count(n) = ta_count(n) + 1 + TA_MIN(n) = min(TA_MIN(n),TA(n)) - if (ta_count == n1d) then - T2MMIN5D = ((n5d-1)*T2MMIN5D + TA_MIN) / n5d - TA_MIN = 1000. - ta_count = 0 - end if + if (ta_count(n) == n1d) then + T2MMIN5D(n) = ((accper-1)*T2MMIN5D(n) + TA_MIN(n)) / accper + TA_MIN(n) = 1000. + ta_count(n) = 0 + end if + end do endif @@ -6734,7 +6742,7 @@ subroutine Driver ( RC ) ! fsnow: pft-level; asnow: grid-level ! ----------------------------------- - where(tlai(:,nv,z) > 0.) + where(tlai(:,nv,nz) > 0.) fsnow(:) = 1. - elai(:,nv,nz)/tlai(:,nv,nz) fsnow(:) = min(max(fsnow(:),0.),1.) elsewhere @@ -6768,7 +6776,7 @@ subroutine Driver ( RC ) end do end do - NTCurrent = CEILING (real (dofyr) / 8.) + ! NTCurrent = CEILING (real (dofyr) / 8.) if(associated(CNCO2)) CNCO2 = CO2V * 1e6 deallocate (co2v) @@ -7119,19 +7127,19 @@ subroutine Driver ( RC ) ! catchment: saturated area if(ax1 .lt. cn1) then - f1 = ax1 ; f2 = 0. ; f3 = 0. + f1(1) = ax1 ; f2(1) = 0. ; f3(1) = 0. else if(ax1 .lt. (cn1+cn2)) then - f1 = cn1 ; f2 = ax1-cn1 ; f3 = 0. + f1(1) = cn1 ; f2(1) = ax1-cn1 ; f3(1) = 0. else - f1 = cn1 ; f2 = cn2 ; f3 = ax1-cn1-cn2 + f1(1) = cn1 ; f2(1) = cn2 ; f3(1) = ax1-cn1-cn2 endif endif if(ax1 .gt. 0.) then - rcsat(n) = ax1/(f1/rc00(n,1)+f2/rc00(n,2)+f3/rc00(n,3)) - rcxdt(n) = ax1/(f1/rcdt(n,1)+f2/rcdt(n,2)+f3/rcdt(n,3)) - rcxdq(n) = ax1/(f1/rcdq(n,1)+f2/rcdq(n,2)+f3/rcdq(n,3)) + rcsat(n) = ax1/(f1(1)/rc00(n,1)+f2(1)/rc00(n,2)+f3(1)/rc00(n,3)) + rcxdt(n) = ax1/(f1(1)/rcdt(n,1)+f2(1)/rcdt(n,2)+f3(1)/rcdt(n,3)) + rcxdq(n) = ax1/(f1(1)/rcdq(n,1)+f2(1)/rcdq(n,2)+f3(1)/rcdq(n,3)) else rcsat(n) = 1.e3 rcxdt(n) = 1.e3 @@ -7147,31 +7155,31 @@ subroutine Driver ( RC ) if(ax1 .lt. cn1) then ar = ax1 + ax2 if(ar .lt. cn1) then - f1 = ax2 ; f2 = 0. ; f3 = 0. + f1(2) = ax2 ; f2(2) = 0. ; f3(2) = 0. else if(ar .lt. (cn1+cn2)) then - f1 = cn1-ax1 ; f2 = ar-cn1 ; f3 = 0. + f1(2) = cn1-ax1 ; f2(2) = ar-cn1 ; f3(2) = 0. else - f1 = cn1-ax1 ; f2 = cn2 ; f3 = ar-cn1-cn2 + f1(2) = cn1-ax1 ; f2(2) = cn2 ; f3(2) = ar-cn1-cn2 endif endif else ar = ax2 + ax4 if(ar .lt. cn3) then - f1 = 0. ; f2 = 0. ; f3 = ax2 + f1(2) = 0. ; f2(2) = 0. ; f3(2) = ax2 else if(ax4 .gt. cn3) then - f1 = 0. ; f2 = ax2 ; f3 = 0. + f1(2) = 0. ; f2(2) = ax2 ; f3(2) = 0. else - f1 = 0. ; f2 = ar-cn3 ; f3 = cn3-ax4 + f1(2) = 0. ; f2(2) = ar-cn3 ; f3(2) = cn3-ax4 endif endif endif if(ax2 .gt. 0.) then - rcuns(n) = ax2/(f1/rc00(n,1)+f2/rc00(n,2)+f3/rc00(n,3)) - rcxdt(n) = ax2/(f1/rcdt(n,1)+f2/rcdt(n,2)+f3/rcdt(n,3)) - rcxdq(n) = ax2/(f1/rcdq(n,1)+f2/rcdq(n,2)+f3/rcdq(n,3)) + rcuns(n) = ax2/(f1(2)/rc00(n,1)+f2(2)/rc00(n,2)+f3(2)/rc00(n,3)) + rcxdt(n) = ax2/(f1(2)/rcdt(n,1)+f2(2)/rcdt(n,2)+f3(2)/rcdt(n,3)) + rcxdq(n) = ax2/(f1(2)/rcdq(n,1)+f2(2)/rcdq(n,2)+f3(2)/rcdq(n,3)) else rcuns(n) = 1.e3 rcxdt(n) = 1.e3 @@ -7878,7 +7886,6 @@ subroutine Driver ( RC ) deallocate( SWSRF4 ) deallocate( tcx ) deallocate( qax ) - deallocate( rcx ) deallocate( rcxdt ) deallocate( rcxdq ) deallocate( car1 ) @@ -7931,10 +7938,6 @@ subroutine Driver ( RC ) deallocate( sfm ) deallocate( bt ) deallocate( btran_fire ) - deallocate( psnsunx ) - deallocate( psnshax ) - deallocate( sifsunx ) - deallocate( sifshax ) deallocate( laisunx ) deallocate( laishax ) deallocate( elaz ) @@ -7961,6 +7964,8 @@ subroutine Driver ( RC ) deallocate( tp ) deallocate( soilice ) deallocate (PLSIN) + deallocate(TA_MIN) + deallocate(ta_count) call MAPL_TimerOff ( MAPL, "-CATCHCNCLM51" ) RETURN_(ESMF_SUCCESS) From 419bab860032d1fa85ef176e4af80d10b1e8d119 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 12 Jan 2023 14:22:36 -0500 Subject: [PATCH 313/589] bug fixes --- .../GEOS_CatchCNCLM51GridComp.F90 | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 22447419a..42b9978ce 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -5182,8 +5182,8 @@ subroutine Driver ( RC ) integer, save :: istep ! model time step index integer :: accper ! number of time steps accumulated in a period of XX days, increases from 1 to nXXd in the first XX days, ! and remains as nXXd thereafter - integer, dimension(:) :: ta_count - real, dimension(:) :: TA_MIN + integer, allocatable, dimension(:) :: ta_count + real, allocatable, dimension(:) :: TA_MIN integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_MI, AGCM_S, AGCM_HH, dofyr, AGCM_S_ofday logical, save :: first = .true. @@ -6593,7 +6593,7 @@ subroutine Driver ( RC ) SNDZM5D = ((n5d-1)*SNDZM5D + SNDZM) / n5d T2M10D = ((n10d-1)*T2M10D + TA) / n10d - TG10D = ((n10d-1)*TG10D + TG) / n10d + TG10D = ((n10d-1)*TG10D + TG(:,1)) / n10d TPREC10D = ((n10d-1)*TPREC10D + PCU + PLS + SNO) / n10d RH30D = ((n30d-1)*RH30D + Qair_relative) / n30d TPREC60D = ((n60d-1)*TPREC60D + PCU + PLS + SNO) / n60d @@ -7938,15 +7938,6 @@ subroutine Driver ( RC ) deallocate( sfm ) deallocate( bt ) deallocate( btran_fire ) - deallocate( laisunx ) - deallocate( laishax ) - deallocate( elaz ) - deallocate( esaz ) - deallocate( fvez ) - deallocate( ityz ) - deallocate( lmrsunx ) - deallocate( lmrshax ) - deallocate( tlaz ) deallocate( albdir ) deallocate( albdif ) deallocate( elai ) @@ -8303,7 +8294,7 @@ subroutine RUN0(gc, import, export, clock, rc) wtzone(:,nz) = CN_zone_weight(nz) end do - call get_CN_LAI(ntiles,num_veg,num_zon,ityp,fveg,elai,esai=esai) + call get_CN_LAI(ntiles,ityp,fveg,elai,esai=esai) lai1 = 0. wght = 0. From 00018f4e39cb16635bec066b1e869f138104f951 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 17 Jan 2023 11:08:08 -0500 Subject: [PATCH 314/589] cleanup to meet Fortran standards --- .../CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 6 +++--- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index c92c11a12..469d121f1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -62,7 +62,7 @@ module SoilBiogeochemCarbonStateType end type soilbiogeochem_carbonstate_type - type(soilbiogeochem_carbonstate_type), public, target, save :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type), public :: soilbiogeochem_carbonstate_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index 7f1afb05b..d0389ab9c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -74,7 +74,7 @@ module SoilBiogeochemNitrogenStateType procedure , public :: SetTotVgCThresh end type soilbiogeochem_nitrogenstate_type - type(soilbiogeochem_nitrogenstate_type), public, target, save :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type), public :: soilbiogeochem_nitrogenstate_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 84dade2e4..0584c4076 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -40,7 +40,7 @@ module pftconMod integer, public :: nc3_nonarctic_grass = 13 ! Cool c3 grass [moisture + deciduous] integer, public :: nc4_grass = 14 ! Warm c4 grass [moisture + deciduous] integer, public :: nc3crop = 15 ! C3_crop [moisture + deciduous] - integer, public :: npcropmin = 15 ! value for first crop functional type (not including the more generic C3 crop PFT) + integer, public :: npcropmin = 16 ! value for first crop functional type (not including the more generic C3 crop PFT) ! variables that do not apply here, but are needed; set to mxpft + 1 in initialization routine @@ -281,7 +281,7 @@ module pftconMod end type pftcon_type -type(pftcon_type), public, target, save :: pftcon +type(pftcon_type), public :: pftcon integer, public, parameter :: pftname_len = 40 ! max length of pftname character(len=pftname_len), public :: pftname(0:mxpft) ! PFT description @@ -351,7 +351,7 @@ subroutine init_pftcon_type(this) allocate( this%rootb_par (0:mxpft) ); this%rootb_par(:) = nan allocate( this%crop (0:mxpft) ); this%crop (:) = nan !# allocate( this%mergetoclmpft (0:mxpft) ); this%mergetoclmpft (:) = bigint !# - allocate( this%is_pft_known_to_model (0:mxpft) ); this%is_pft_known_to_model(:) = nan !# + allocate( this%is_pft_known_to_model (0:mxpft) ); this%is_pft_known_to_model(:) = .false. !# allocate( this%irrigated (0:mxpft) ); this%irrigated (:) = nan !# allocate( this%smpso (0:mxpft) ); this%smpso (:) = nan !# allocate( this%smpsc (0:mxpft) ); this%smpsc (:) = nan !# From 77a7367140e74bface1036465cca38dab66be2dd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 17 Jan 2023 14:08:43 -0500 Subject: [PATCH 315/589] cleanup to meet Fortran standards --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 | 2 +- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 2 +- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 2 +- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 2 +- .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 | 2 +- .../CLM51/CNCLM_FrictionVelocityMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 | 2 +- .../CLM51/CNCLM_SolarAbsorbedType.F90 | 2 +- .../CLM51/CNCLM_SurfaceAlbedoType.F90 | 2 +- .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 2 +- .../CLM51/CNCLM_WaterStateBulkType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 | 2 +- .../CLM51/CNCLM_Wateratm2lndType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 | 2 -- .../GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 | 4 ++-- 31 files changed, 31 insertions(+), 33 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 index c64e02089..9073614c0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 @@ -40,7 +40,7 @@ module ActiveLayerMod procedure, public :: alt_calc end type active_layer_type - type(active_layer_type), public, target, save :: active_layer_inst + type(active_layer_type), public :: active_layer_inst !--------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 index 7f302350f..53778b465 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -54,7 +54,7 @@ module CNDVType real(r8), pointer, public :: heatstress_patch (:) end type dgvs_type - type(dgvs_type), public, target, save :: dgvs_inst + type(dgvs_type), public :: dgvs_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index a2e01f02a..fd442488a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -68,7 +68,7 @@ module CNProductsMod end type cn_products_type - type(cn_products_type), public, target, save :: cn_products_inst + type(cn_products_type), public :: cn_products_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 923a65c72..661ceb984 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -481,7 +481,7 @@ module CNVegCarbonFluxType end type cnveg_carbonflux_type -type(cnveg_carbonflux_type), public, target, save :: cnveg_carbonflux_inst +type(cnveg_carbonflux_type), public :: cnveg_carbonflux_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 524644c10..4198765cd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -203,7 +203,7 @@ module CNVegCarbonStateType end type cnveg_carbonstate_type -type(cnveg_carbonstate_type), public, target, save :: cnveg_carbonstate_inst +type(cnveg_carbonstate_type), public :: cnveg_carbonstate_inst real(r8), public :: spinup_factor_deadwood = 1.0_r8 ! Spinup factor used for this simulation real(r8), public :: spinup_factor_AD = 10.0_r8 ! Spinup factor used when in Accelerated Decomposition mode diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index 344ec4380..d7d38e9cf 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -365,7 +365,7 @@ module CNVegNitrogenFluxType end type cnveg_nitrogenflux_type -type(cnveg_nitrogenflux_type), public, target, save :: cnveg_nitrogenflux_inst +type(cnveg_nitrogenflux_type), public :: cnveg_nitrogenflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index 242e9ab02..881d2bfc3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -210,7 +210,7 @@ module CNVegNitrogenStateType procedure , public :: ZeroDWT end type cnveg_nitrogenstate_type -type(cnveg_nitrogenstate_type), public, target, save :: cnveg_nitrogenstate_inst +type(cnveg_nitrogenstate_type), public :: cnveg_nitrogenstate_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index 75483d50a..d34d53253 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -100,7 +100,7 @@ module CNVegStateType end type cnveg_state_type - type(cnveg_state_type), public, target, save :: cnveg_state_inst + type(cnveg_state_type), public :: cnveg_state_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index 108d89a93..4e31a2f65 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -84,7 +84,7 @@ module ColumnType integer , pointer :: levgrnd_class (:,:) ! class in which each layer falls (1:nlevgrnd) end type column_type - type(column_type), public, target, save :: col + type(column_type), public :: col contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 index 107186ecb..6020850a0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 @@ -29,7 +29,7 @@ module CropType real(r8) :: baset_latvary_slope end type crop_type - type(crop_type), public, target, save :: crop_inst + type(crop_type), public :: crop_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 index 2cc7fb485..55503e92e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 @@ -121,7 +121,7 @@ module EnergyFluxType real(r8), pointer :: errlon_patch (:) ! longwave radiation conservation error (W/m**2) real(r8), pointer :: errlon_col (:) ! longwave radiation conservation error (W/m**2) end type energyflux_type - type(energyflux_type), public, target, save :: energyflux_inst + type(energyflux_type), public :: energyflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 index 62d7152e8..f33c8e409 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 @@ -74,7 +74,7 @@ module FrictionVelocityMod end type frictionvel_type - type(frictionvel_type), public, target, save :: frictionvel_inst + type(frictionvel_type), public :: frictionvel_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index 6e8b3e460..79258651b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -39,7 +39,7 @@ module GridcellType integer , pointer :: landunit_indices (:,:) end type gridcell_type - type(gridcell_type), public, target, save :: grc + type(gridcell_type), public :: grc contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 index 4b73532a9..dd49d6bb0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 @@ -22,7 +22,7 @@ module OzoneBaseMod real(r8), pointer, public :: o3coefgsun_patch(:) ! ozone coefficient for conductance, sunlit leaves (0 - 1) end type ozone_base_type - type(ozone_base_type), public, target, save :: ozone_inst + type(ozone_base_type), public :: ozone_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index d4f2977b2..0bf1adaf5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -65,7 +65,7 @@ module PatchType ! including patches which are not currently ! associated with a FATES linked-list patch end type patch_type - type(patch_type), public, target, save :: patch + type(patch_type), public :: patch contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index 8d3bd1e71..3e9494ae9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -79,7 +79,7 @@ module SoilBiogeochemCarbonFluxType procedure , public :: Summary end type soilbiogeochem_carbonflux_type - type(soilbiogeochem_carbonflux_type), public, target, save :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type), public :: soilbiogeochem_carbonflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index 9a6f76238..93a6c3412 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -144,7 +144,7 @@ module SoilBiogeochemNitrogenFluxType procedure , public :: Summary end type soilbiogeochem_nitrogenflux_type - type(soilbiogeochem_nitrogenflux_type), public, target, save :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type), public :: soilbiogeochem_nitrogenflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 1a9c0e93f..cfd1e3f0e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -41,7 +41,7 @@ module SoilBiogeochemStateType real(r8) , pointer :: plant_ndemand_col (:) ! column-level plant N demand end type soilbiogeochem_state_type - type(soilbiogeochem_state_type), public, target, save :: soilbiogeochem_state_inst + type(soilbiogeochem_state_type), public :: soilbiogeochem_state_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index f91f95847..f7306a24f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -74,7 +74,7 @@ module SoilStateType real(r8), pointer :: soil_conductance_patch(:,:) ! patch soil conductance [mm/s] end type soilstate_type -type(soilstate_type), public, target, save :: soilstate_inst +type(soilstate_type), public :: soilstate_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 index b75b6db05..1ccabca9d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -68,7 +68,7 @@ module SolarAbsorbedType real(r8), pointer :: ssre_fsr_nir_d_ln_patch(:) ! snow-free patch reflected direct beam nir solar radiation at local noon (W/m**2) end type solarabs_type - type(solarabs_type), public, target, save :: solarabs_inst + type(solarabs_type), public :: solarabs_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index bbee951d1..9e40b8241 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -65,7 +65,7 @@ module SurfaceAlbedoType end type surfalb_type -type(surfalb_type), public, target, save :: surfalb_inst +type(surfalb_type), public :: surfalb_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index b208ccbd4..1dbe85cc3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -59,7 +59,7 @@ module WaterDiagnosticBulkType real(r8), pointer :: qflx_prec_grnd_col (:) ! col water onto ground including canopy runoff (mm H2O/s) end type waterdiagnosticbulk_type -type(waterdiagnosticbulk_type), public, target, save :: waterdiagnosticbulk_inst +type(waterdiagnosticbulk_type), public :: waterdiagnosticbulk_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index c631b6a91..188e5f86a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -103,7 +103,7 @@ module WaterFluxType type(annual_flux_dribbler_type) :: qflx_ice_dynbal_dribbler end type waterflux_type - type(waterflux_type), public, target, save :: waterflux_inst + type(waterflux_type), public :: waterflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 index 5661ee7e3..280e268af 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 @@ -31,7 +31,7 @@ module WaterStateBulkType real(r8), pointer :: int_snow_col (:) ! col integrated snowfall (mm H2O) end type waterstatebulk_type - type(waterstatebulk_type), public, target, save :: waterstatebulk_inst + type(waterstatebulk_type), public :: waterstatebulk_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 index b87e65471..aa25fd4d7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 @@ -49,7 +49,7 @@ module WaterStateType real(r8) :: aquifer_water_baseline ! baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) end type waterstate_type - type(waterstate_type), public, target, save :: waterstate_inst + type(waterstate_type), public :: waterstate_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 index 083a3deb3..d4bf4b579 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 @@ -34,7 +34,7 @@ module Wateratm2lndType end type wateratm2lnd_type - type(wateratm2lnd_type), public, target, save :: wateratm2lnd_inst + type(wateratm2lnd_type), public :: wateratm2lnd_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 index f0b70dc16..3dc851f6a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 @@ -63,7 +63,7 @@ module atm2lndType real(r8) , pointer :: t_mo_min_patch (:) => null() ! patch annual min of t_mo (Kelvin) end type atm2lnd_type -type(atm2lnd_type), public, target, save :: atm2lnd_inst +type(atm2lnd_type), public :: atm2lnd_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 index 0a80e7799..5ad3358cd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 @@ -107,7 +107,7 @@ module ch4Mod end type ch4_type -type(ch4_type), public, target, save :: ch4_inst +type(ch4_type), public :: ch4_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 index 6a4d92903..21ed463c2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 @@ -31,7 +31,7 @@ module decompMod integer :: level ! whether defined on the proc or clump level integer :: clump_index ! if defined on the clump level, this gives the clump index end type bounds_type - type(bounds_type), public, target, save :: bounds + type(bounds_type), public :: bounds contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 index 3951055ef..12420e975 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireEmissionsMod.F90 @@ -35,8 +35,6 @@ module CNFireEmissionsMod end type fireemis_type - integer :: shr_fire_emis_mechcomps_n = 0 - !------------------------------------------------------------------------ contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 index ab872a270..1f2a629ca 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 @@ -92,8 +92,8 @@ Module shr_mpi_mod shr_mpi_maxr1 end interface shr_mpi_max -#include ! mpi library include file - +!#include ! mpi library include file + #include "mpif.h" ! mpi library include file !=============================================================================== CONTAINS !=============================================================================== From 5b72ef5956600de48f10dba4f7f4ab0e4bc966ff Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 17 Jan 2023 15:04:40 -0500 Subject: [PATCH 316/589] cleanup to meet Fortran standards --- .../GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 index 1f2a629ca..7da4182c3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_mpi_mod.F90 @@ -93,7 +93,7 @@ Module shr_mpi_mod end interface shr_mpi_max !#include ! mpi library include file - #include "mpif.h" ! mpi library include file + include 'mpif.h' ! mpi library include file !=============================================================================== CONTAINS !=============================================================================== From 28e952da008df9b357d7e8e6d757d9934eeb93e3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 17 Jan 2023 15:57:03 -0500 Subject: [PATCH 317/589] cleanup --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 index 62c38ce06..59be25cac 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 @@ -116,7 +116,7 @@ module TemperatureType real(r8), pointer :: c_h2osfc_col (:) ! heat capacity of surface water end type temperature_type -type(temperature_type), public, target, save :: temperature_inst +type(temperature_type), public :: temperature_inst contains From 72c56b2263e73b72dd8d5fe79bae5360962e0a8c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 19 Jan 2023 14:00:41 -0500 Subject: [PATCH 318/589] hardcode CLM namelist file for now --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 0101189fd..5eaece430 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -183,6 +183,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) ! read parameters and configurations from namelist file + NLFilename = trim('/discover/nobackup/jkolassa/new/CatchCN5.1.nml') call CNPhenologyReadNML ( NLFilename ) call dynSubgridControl_init ( ) call CNFireReadNML ( NLFilename ) From 0ef73dfd4a75b85cd7725eeae9829c6a81e7a53c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 19 Jan 2023 14:43:52 -0500 Subject: [PATCH 319/589] adding LSM_CHOICE = 4 for CNCLM51 --- .../GEOS_SurfaceGridComp.F90 | 13 ++++++++----- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 8 ++++---- .../GEOS_CatchCNGridComp.F90 | 2 +- .../Shared/SurfParams.F90 | 19 +++++++++++++++++++ 4 files changed, 32 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index 9b111edcf..f9e5ff143 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -238,7 +238,10 @@ subroutine SetServices ( GC, RC ) elseif (LSM_CHOICE.eq.2) then call MAPL_GetResource (SCF, LAND_PARAMS, label='LAND_PARAMS:', DEFAULT="CN_CLM40", __RC__ ) elseif (LSM_CHOICE.eq.3) then - call MAPL_GetResource (SCF, LAND_PARAMS, label='LAND_PARAMS:', DEFAULT="CN_CLM45", __RC__ ) + call MAPL_GetResource (SCF, LAND_PARAMS, label='LAND_PARAMS:', DEFAULT="CN_CLM45", __RC__ ) + elseif (LSM_CHOICE.eq.4) then + call MAPL_GetResource (SCF, LAND_PARAMS, label='LAND_PARAMS:', DEFAULT="CN_CLM51", __RC__ ) + else _ASSERT(.FALSE.,'unknown LSM_CHOICE') end if @@ -2804,7 +2807,7 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - if (LSM_CHOICE == 3) then + if (LSM_CHOICE >= 3) then call MAPL_AddExportSpec(GC ,& LONG_NAME = 'CN_fine_root_carbon' ,& UNITS = 'kg m-2' ,& @@ -6233,7 +6236,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , CNTOTC , 'CNTOTC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , CNVEGC , 'CNVEGC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , CNROOT , 'CNROOT' , RC=STATUS); VERIFY_(STATUS) - if (LSM_CHOICE == 3) then + if (LSM_CHOICE >= 3) then call MAPL_GetPointer(EXPORT , CNFROOTC, 'CNFROOTC' ,RC=STATUS); VERIFY_(STATUS) endif call MAPL_GetPointer(EXPORT , CNNPP , 'CNNPP' , RC=STATUS); VERIFY_(STATUS) @@ -6808,7 +6811,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MKTILE(CNTOTC ,CNTOTCTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(CNVEGC ,CNVEGCTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(CNROOT ,CNROOTTILE ,NT,RC=STATUS); VERIFY_(STATUS) - if (LSM_CHOICE == 3) then + if (LSM_CHOICE >= 3) then call MKTILE(CNFROOTC,CNFROOTCTILE ,NT,RC=STATUS);VERIFY_(STATUS) endif call MKTILE(CNNPP ,CNNPPTILE ,NT,RC=STATUS); VERIFY_(STATUS) @@ -8534,7 +8537,7 @@ subroutine DOTYPE(type,RC) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'CNROOT' , ALLOC=associated(CNROOTTILE ), notFoundOK=.true., RC=STATUS) VERIFY_(STATUS) - if (LSM_CHOICE == 3) then + if (LSM_CHOICE >= 3) then call MAPL_GetPointer(GEX(type), dum, 'CNFROOTC' , ALLOC=associated(CNFROOTCTILE), notFoundOK=.true., RC=STATUS) endif VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index facda0ad9..2ac33268f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -173,7 +173,7 @@ subroutine SetServices ( GC, RC ) end do end if - CASE (2,3) + CASE (2,3,4) allocate (CATCHCN(NUM_CATCH), stat=status) VERIFY_(STATUS) @@ -935,7 +935,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'ROC002', CHILD_ID = CATCH(1), RC=STATUS) ; VERIFY_(STATUS) end if - CASE (2,3) + CASE (2,3,4) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'LST', CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) @@ -1202,7 +1202,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNROOT' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) - if (LSM_CHOICE == 3) then + if (LSM_CHOICE >= 3) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNFROOTC' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) endif @@ -1378,7 +1378,7 @@ subroutine SetServices ( GC, RC ) ! VERIFY_(STATUS) ! ENDIF - CASE (2,3) + CASE (2,3,4) call MAPL_AddConnectivity ( & GC , & SHORT_NAME = (/'LAI ', 'GRN ', 'ROOTL ', 'Z2CH ', & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 19a744bd2..504d07a8a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -918,7 +918,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNROOT' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) - if (LSM_CHOICE == 3) then + if (LSM_CHOICE >= 3) then ! jkolassa: needed for CNCLM45 and CNCLM51 call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNFROOTC' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 index 1ed10273f..b96ba9f8a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 @@ -126,6 +126,25 @@ subroutine SurfParams_init(LAND_PARAMS,LSM_CHOICE, rc) case DEFAULT _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') end select + + else if (LSM_CHOICE==4) then + select case (LAND_PARAMS) + + case ("CN_CLM51") ! parameters to reproduce Eunjee Lee's Catchment-CN4.5 fire carbon emission simulations + LAND_FIX = .TRUE. + CSOIL_2 = 70000. ! Post H5_0 + WEMIN = 13. + AICEV = 0.107 + AICEN = 19.893 + FLWALPHA = 0.005 + ASTRFR = 0.333 ! reverted + STEXP = 1. ! reverted + RSWILT = 2000. + + case DEFAULT + _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') + end select + else _ASSERT(.FALSE.,'land model choice not valid') end if ! LSM_CHOICE From ebe96035da400ba436273d5db48846abb2db7894 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 24 Jan 2023 11:38:02 -0500 Subject: [PATCH 320/589] cleanup and manual updates to match develop --- .../GEOS_CatchCNCLM51GridComp.F90 | 21 +++++++------------ 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 42b9978ce..e82e64330 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -1737,7 +1737,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for relative humidity',& - UNITS = 'K' ,& + UNITS = '%' ,& SHORT_NAME = 'RHM' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -1747,7 +1747,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for wind speed' ,& - UNITS = 'K' ,& + UNITS = 'm s-1' ,& SHORT_NAME = 'WINDM' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -1757,7 +1757,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for rainfall' ,& - UNITS = 'K' ,& + UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RAINFM' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -1767,7 +1767,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for snow fall' ,& - UNITS = 'K' ,& + UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'SNOWFM' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -1777,7 +1777,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for surface runoff' ,& - UNITS = 'K' ,& + UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNSRFM' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -1787,7 +1787,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for frac saturated area',& - UNITS = 'K' ,& + UNITS = '1' ,& SHORT_NAME = 'AR1M' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -3763,8 +3763,6 @@ end subroutine SetServices subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) - use FireMethodType , only : fire_method_type - ! !ARGUMENTS: type(ESMF_GridComp),intent(inout) :: GC !Gridded component @@ -5415,8 +5413,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,SNDZM5D ,'SNDZM5D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,ASNOWM ,'ASNOWM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,T2M10D ,'T2M10D' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,T2M10D ,'TG10D' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,T2M10D ,'T2MMIN5D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TG10D ,'TG10D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,T2MMIN5D ,'T2MMIN5D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,RH30D ,'RH30D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC10D ,'TPREC10D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC60D ,'TPREC60D' ,RC=STATUS); VERIFY_(STATUS) @@ -6331,7 +6329,6 @@ subroutine Driver ( RC ) allocate( laisha(ntiles,nveg,nzone) ) allocate( lmrsun(ntiles,nveg,nzone) ) allocate( lmrsha(ntiles,nveg,nzone) ) - allocate( parzone(ntiles,nveg,nzone)) allocate( ht(N_gt) ) allocate( tp(N_gt) ) allocate( soilice(N_gt) ) @@ -6776,8 +6773,6 @@ subroutine Driver ( RC ) end do end do - ! NTCurrent = CEILING (real (dofyr) / 8.) - if(associated(CNCO2)) CNCO2 = CO2V * 1e6 deallocate (co2v) From 4b2b31d401776ca590ad6e6579503285254e0b88 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 25 Jan 2023 09:23:39 -0500 Subject: [PATCH 321/589] adjusting CNPFT dimension and indices --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 4 ++-- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 661ceb984..32b2ff848 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1100,8 +1100,8 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi ! "new" variables: introduced in CNCLM50 if (cold_start.eqv..false.) then - this%annsum_litfall_patch(np) = cnpft(nc,nz,nv, 80) - this%tempsum_litfall_patch(np) = cnpft(nc,nz,nv, 81) + this%annsum_litfall_patch(np) = cnpft(nc,nz,nv, 82) + this%tempsum_litfall_patch(np) = cnpft(nc,nz,nv, 83) elseif (cold_start) then this%annsum_litfall_patch(np) = spval this%tempsum_litfall_patch(np) = spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index a0606ee35..d82e27f56 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -159,7 +159,7 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn ! "new" variables: introduced in CNCLM50 if (cold_start.eqv..false.) then do nw = 1,nvegwcs - this%vegwp_patch(np,nw) = cnpft(nc,nz,nv, 76+(nw-1)) + this%vegwp_patch(np,nw) = cnpft(nc,nz,nv, 78+(nw-1)) end do elseif (cold_start) then this%vegwp_patch(np,1:nvegwcs) = -2.5e4_r8 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index c3e7eb4e4..fba12337b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -52,7 +52,7 @@ module clm_varpar integer, parameter, PUBLIC :: NUM_ZON=3 ! number of CN hydrology zones per tile integer, parameter, PUBLIC :: NUM_VEG=4 ! number of CN PFTs per zone integer, parameter, PUBLIC :: VAR_COL=35 ! number of CN column restart variables - integer, parameter, PUBLIC :: VAR_PFT=81 ! number of CN PFT restart variables + integer, parameter, PUBLIC :: VAR_PFT=83 ! number of CN PFT restart variables real, parameter, PUBLIC, dimension(NUM_ZON) :: CN_zone_weight = (/0.10,0.45,0.45/) ! gkw: tunable; must sum to 1 integer, parameter, PUBLIC :: map_cat(0:numpft) = (/4,3,3,3,1,1,2,2,2,5,5,6,4,4,4,4/) From c5c1c7d6e8e2d4008bf72ed1efaae86a7848d280 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 26 Jan 2023 15:02:53 -0500 Subject: [PATCH 322/589] make CN_init public --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 5eaece430..a48b9bf83 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -83,6 +83,9 @@ module CN_initMod class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method class(fire_method_type), allocatable :: cnfire_method +! !PUBLIC MEMBER FUNCTIONS: + public :: CN_init + contains !------------------------------------------------------ From d9984b479b4d1b172208a1acf8820ee064dd42a3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 26 Jan 2023 15:36:17 -0500 Subject: [PATCH 323/589] add function declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index a48b9bf83..a8b15645c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -6,7 +6,7 @@ module CN_initMod use clm_varcon , only : clm_varcon_init use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init - use clm_varctl , only : use_century_decomp + use clm_varctl , only : use_century_decomp, init_clm_varctl use decompMod use filterMod use CNVegNitrogenStateType From 7780debe9a913a3fd8f93fdc69c12b5ebefd28a3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 26 Jan 2023 15:56:07 -0500 Subject: [PATCH 324/589] specific use statement for PatchType --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index a8b15645c..16fbb0ea2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -32,7 +32,7 @@ module CN_initMod use WaterFluxBulkType use SoilBiogeochemCarbonFluxType use SoilBiogeochemNitrogenFluxType - use PatchType + use PatchType , only : init_patch_type, patch_type use ColumnType use ch4Mod use SoilBiogeochemDecompCascadeConType From cbef06d7fc28015e74ff69bc6d85ebfc3ce547ef Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 26 Jan 2023 16:37:28 -0500 Subject: [PATCH 325/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 0bf1adaf5..124e29a0a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -87,6 +87,9 @@ subroutine init_patch_type(bounds, nch, ityp, fveg, this) integer :: np, nc, nz, p, nv, n !------------------------------- + begp = bounds%begp + endp = bounds%begp + allocate(this%gridcell (begp:endp)); this%gridcell (:) = ispval allocate(this%wtgcell (begp:endp)); this%wtgcell (:) = nan From ea496cc0a45155b6b328d549beb9456cf39fbbbd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 26 Jan 2023 16:55:19 -0500 Subject: [PATCH 326/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 124e29a0a..3621a5b21 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -88,7 +88,7 @@ subroutine init_patch_type(bounds, nch, ityp, fveg, this) !------------------------------- begp = bounds%begp - endp = bounds%begp + endp = bounds%endp allocate(this%gridcell (begp:endp)); this%gridcell (:) = ispval allocate(this%wtgcell (begp:endp)); this%wtgcell (:) = nan From 4be35f1d3dba2648ac713c8a3d0f552e1d87d359 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 27 Jan 2023 11:35:28 -0500 Subject: [PATCH 327/589] typo fix --- .../CLM51/CNCLM_ColumnType.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index 4e31a2f65..af1436015 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -143,13 +143,13 @@ subroutine init_column_type(bounds,nch, this) this%nbedrock(:) = 1 !jkolassa: set this to 1, since we only have one soil layer do c = bounds%begc,bounds%endc - col%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd) - col%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd) - col%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd) + this%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd) + this%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd) + this%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd) if (nlevgrnd < nlevurb) then - col%z(c,nlevgrnd+1:nlevurb) = spval - col%zi(c,nlevgrnd+1:nlevurb) = spval - col%dz(c,nlevgrnd+1:nlevurb) = spval + this%z(c,nlevgrnd+1:nlevurb) = spval + this%zi(c,nlevgrnd+1:nlevurb) = spval + this%dz(c,nlevgrnd+1:nlevurb) = spval end if end do From 6d4fce11010ea67f0556e9dd0202815f86a10886 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 27 Jan 2023 11:58:17 -0500 Subject: [PATCH 328/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index 8a1a2f0ba..aadc86c51 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -25,6 +25,10 @@ module LandunitType implicit none save private + + ! PUBLIC MEMBER FUNCTIONS: + public :: init_landunit_type + ! type, public :: landunit_type ! g/l/c/p hierarchy, local g/l/c/p cells only From 06e2d62b8f1badac775615e3904654d537ad11d1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 27 Jan 2023 13:15:34 -0500 Subject: [PATCH 329/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 16fbb0ea2..cc1686822 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -54,6 +54,7 @@ module CN_initMod use FrictionVelocityMod use PhotosynthesisMod use CNVegetationFacade, only : cn_vegetation_type + use initSubgridMod use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn From 3e6d44bad53020cffb09f7ca9e4dc77a85754e69 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 3 Feb 2023 14:36:04 -0500 Subject: [PATCH 330/589] declare target --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 3621a5b21..498e4f17a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -65,7 +65,7 @@ module PatchType ! including patches which are not currently ! associated with a FATES linked-list patch end type patch_type - type(patch_type), public :: patch + type(patch_type), public, target :: patch contains From daa187d36a5d6bb49dfc28861a64e9d626d44b1e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 11:54:21 -0500 Subject: [PATCH 331/589] change initialization for patch, col, lun and grc --- .../CLM51/CNCLM_ColumnType.F90 | 11 +++++---- .../CLM51/CNCLM_GridcellType.F90 | 11 +++++---- .../CLM51/CNCLM_LandunitType.F90 | 9 ++++--- .../CLM51/CNCLM_PatchType.F90 | 10 +++++--- .../CLM51/CN_init_mod.F90 | 24 +++++++++---------- 5 files changed, 39 insertions(+), 26 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index af1436015..73db5976c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -33,7 +33,6 @@ module ColumnType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_column_type type, public :: column_type ! g/l/c/p hierarchy, local g/l/c/p cells only @@ -83,13 +82,17 @@ module ColumnType ! this column (i.e., this column doesn't use the full nlevgrnd layers). integer , pointer :: levgrnd_class (:,:) ! class in which each layer falls (1:nlevgrnd) + contains + + procedure, public :: init_column_type + end type column_type - type(column_type), public :: col + type(column_type), public, target :: col contains !----------------------------------------------------- - subroutine init_column_type(bounds,nch, this) + subroutine init_column_type(this, bounds,nch) ! !ARGUMENTS: implicit none @@ -97,7 +100,7 @@ subroutine init_column_type(bounds,nch, this) ! INPUT: type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of Catchment tiles - type(column_type), intent(inout) :: this + class(column_type) :: this ! LOCAL: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index 79258651b..b3e8948e0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -11,7 +11,6 @@ module GridcellType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_gridcell_type type, public :: gridcell_type @@ -38,13 +37,17 @@ module GridcellType ! landunit type in the inner loop) integer , pointer :: landunit_indices (:,:) + contains + + procedure, public :: init_gridcell_type + end type gridcell_type - type(gridcell_type), public :: grc + type(gridcell_type), public, target :: grc contains !----------------------------------------------- - subroutine init_gridcell_type(bounds, nch, cnpft, lats, lons, this) + subroutine init_gridcell_type(this, bounds, nch, cnpft, lats, lons) ! !DESCRIPTION: ! Initialize CTSM gridcell type needed for calling CTSM routines @@ -59,7 +62,7 @@ subroutine init_gridcell_type(bounds, nch, cnpft, lats, lons, this) real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array real, dimension(nch), intent(in) :: lats ! Catchment tile latitudes in radians real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes in radians - type(gridcell_type), intent(inout):: this + class(gridcell_type), :: this !LOCAL integer :: begg, endg diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index aadc86c51..35030fce1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -27,7 +27,6 @@ module LandunitType private ! PUBLIC MEMBER FUNCTIONS: - public :: init_landunit_type ! type, public :: landunit_type @@ -57,6 +56,10 @@ module LandunitType real(r8), pointer :: z_0_town (:) ! urban landunit momentum roughness length (m) real(r8), pointer :: z_d_town (:) ! urban landunit displacement height (m) + contains + + procedure, public :: init_landunit_type + end type landunit_type ! Singleton instance of the landunitType type(landunit_type), public, target :: lun !geomorphological landunits @@ -65,7 +68,7 @@ module LandunitType contains !------------------------------------------------------------------------ - subroutine init_landunit_type(bounds, this) + subroutine init_landunit_type(this, bounds) !----------------------------------------------------------------------- ! !DESCRIPTION: ! Allocate memory and initialize to signalling NaN to require @@ -74,7 +77,7 @@ subroutine init_landunit_type(bounds, this) ! !ARGUMENTS: !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(landunit_type), intent(inout) :: this + class(landunit_type) :: this !LOCAL integer :: begl,endl diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 498e4f17a..99a6deb9b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -35,7 +35,6 @@ module PatchType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_patch_type type, public :: patch_type @@ -64,13 +63,18 @@ module PatchType ! patches within fates jurisdiction ! including patches which are not currently ! associated with a FATES linked-list patch + + contains + + procedure, public :: init_patch_type + end type patch_type type(patch_type), public, target :: patch contains !---------------------------------------------------- - subroutine init_patch_type(bounds, nch, ityp, fveg, this) + subroutine init_patch_type(this, bounds, nch, ityp, fveg) ! !ARGUMENTS: implicit none @@ -80,7 +84,7 @@ subroutine init_patch_type(bounds, nch, ityp, fveg, this) integer, intent(in) :: nch ! number of Catchment tiles integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction - type(patch_type), intent(inout) :: this + class(patch_type) :: this ! LOCAL: integer :: begp,endp diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index cc1686822..989cc1d89 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -28,18 +28,18 @@ module CN_initMod use CNVegStateType use CNVegCarbonFluxType use CNVegNitrogenFluxType - use GridcellType + use GridcellType , only : init_gridcell_type, grc use WaterFluxBulkType use SoilBiogeochemCarbonFluxType use SoilBiogeochemNitrogenFluxType - use PatchType , only : init_patch_type, patch_type - use ColumnType + use PatchType , only : init_patch_type, patch + use ColumnType , only : init_column_type, col use ch4Mod use SoilBiogeochemDecompCascadeConType use ActiveLayerMod use CropType use CNDVType - use LandunitType + use LandunitType , only : init_landunit_type, lun use RootBiophysMod use CNMRespMod , only : readCNMRespParams => readParams use CNSharedParamsMod , only : CNParamsReadShared @@ -108,9 +108,9 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) !LOCAL type(bounds_type) :: bounds - type(patch_type) :: patch - type(column_type) :: col - type(landunit_type) :: lun + !type(patch_type) :: patch + !type(column_type) :: col + !type(landunit_type) :: lun type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(atm2lnd_type) :: atm2lnd_inst @@ -133,7 +133,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(cnveg_state_type) :: cnveg_state_inst type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst - type(gridcell_type) :: grc + !type(gridcell_type) :: grc type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst type(ch4_type) :: ch4_inst @@ -169,13 +169,13 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) ! initialize subrgid types - call init_patch_type (bounds, nch, ityp, fveg, patch) + call patch%init_patch_type (bounds, nch, ityp, fveg) - call init_column_type (bounds, nch, col) + call col%init_column_type (bounds, nch) - call init_landunit_type (bounds, lun) + call lun%init_landunit_type (bounds) - call init_gridcell_type (bounds, nch, cnpft, lats, lons, grc) + call grc%init_gridcell_type (bounds, nch, cnpft, lats, lons) ! create subgrid structure From f0e787b6378ccf70f676c48a0c41d12fc161a4a0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 12:53:11 -0500 Subject: [PATCH 332/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index b3e8948e0..6d8c0c4f5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -62,7 +62,7 @@ subroutine init_gridcell_type(this, bounds, nch, cnpft, lats, lons) real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array real, dimension(nch), intent(in) :: lats ! Catchment tile latitudes in radians real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes in radians - class(gridcell_type), :: this + class(gridcell_type) :: this !LOCAL integer :: begg, endg From 5feb08fdf5f590a36ba260bcaac8d1047b3b3b5e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 13:07:49 -0500 Subject: [PATCH 333/589] correct use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 989cc1d89..da882fa46 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -28,18 +28,18 @@ module CN_initMod use CNVegStateType use CNVegCarbonFluxType use CNVegNitrogenFluxType - use GridcellType , only : init_gridcell_type, grc + use GridcellType , only : grc use WaterFluxBulkType use SoilBiogeochemCarbonFluxType use SoilBiogeochemNitrogenFluxType - use PatchType , only : init_patch_type, patch - use ColumnType , only : init_column_type, col + use PatchType , only : patch + use ColumnType , only : col use ch4Mod use SoilBiogeochemDecompCascadeConType use ActiveLayerMod use CropType use CNDVType - use LandunitType , only : init_landunit_type, lun + use LandunitType , only : lun use RootBiophysMod use CNMRespMod , only : readCNMRespParams => readParams use CNSharedParamsMod , only : CNParamsReadShared From ae89683818dcdad953cd30aaaf906cd0234dc833 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 13:29:04 -0500 Subject: [PATCH 334/589] initialize weights relative to gridcell and land unit --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 99a6deb9b..7333d4069 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -5,7 +5,7 @@ module PatchType use decompMod , only : bounds_type use clm_varcon , only : ispval use clm_varctl , only : use_fates - use clm_varpar , only : numpft, NUM_ZON, NUM_VEG + use clm_varpar , only : numpft, NUM_ZON, NUM_VEG, CN_zone_weight !----------------------------------------------------------------------- ! !DESCRIPTION: @@ -134,6 +134,10 @@ subroutine init_patch_type(this, bounds, nch, ityp, fveg) this%itype(np) = ityp(nc,nv,nz) this%wtcol(np) = fveg(nc,nv,nz) this%column(np) = n + this%gridcell(np) = nc + this%wtgcell(np) = fveg(nc,nv,nz)*CN_zone_weight(nz) + this%landunit(np) = nc + this%wtlunit(np) = fveg(nc,nv,nz)*CN_zone_weight(nz) end do ! nv end do ! p end do ! nz From 1e5e0487068180bc728967e873f4d3ebac412f6d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 13:47:15 -0500 Subject: [PATCH 335/589] initialize land unit at column level --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index 73db5976c..3d364190d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -164,6 +164,8 @@ subroutine init_column_type(this, bounds,nch) n = n + 1 this%gridcell(n) = nc this%wtgcell(n) = CN_zone_weight(nz) + this%landunit(n) = nc + this%wtlunit(n) = CN_zone_weight(nz) this%patchi(n) = (numpft+1)*(n-1) + 1 this%patchf(n) = (numpft+1)*n end do ! nz From b32b429283fc33504f1877c3ca73f19f3832abdb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 15:28:40 -0500 Subject: [PATCH 336/589] initialize gridcell in land unit type --- .../CLM51/CNCLM_LandunitType.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index 35030fce1..60a9b80c5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -81,6 +81,7 @@ subroutine init_landunit_type(this, bounds) !LOCAL integer :: begl,endl + integer :: nc !------------------------------------------------------------------------ begl = bounds%begl ; endl = bounds%endl @@ -111,6 +112,15 @@ subroutine init_landunit_type(this, bounds) allocate(this%z_0_town (begl:endl)); this%z_0_town (:) = nan allocate(this%z_d_town (begl:endl)); this%z_d_town (:) = nan + do nc = 1,nch ! catchment tile loop + + this%gridcell(nc) = nc + this%patchi(nc) = (numpft+1)*num_zon*(nc-1) + 1 + this%patchf(nc) = (numpft+1)*num_zon*nc + this%coli(nc) = (num_zon)*(nc-1) + 1 + this%colf(nc) = num_zon*nc + end do + end subroutine init_landunit_type end module LandunitType From 4e7e6f35fc478f5f71a7f7062b495746395ddc63 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 15:40:56 -0500 Subject: [PATCH 337/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index 60a9b80c5..fbc7e6253 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -20,6 +20,7 @@ module LandunitType use nanMod , only : nan use clm_varcon , only : ispval use decompMod , only : bounds_type + use clm_varpar , only : NUM_ZON ! !PUBLIC TYPES: implicit none From 4528aa32f8ae61a91eb881a5175e61b7b03354b7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 16:02:26 -0500 Subject: [PATCH 338/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index fbc7e6253..f8717f73a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -20,7 +20,7 @@ module LandunitType use nanMod , only : nan use clm_varcon , only : ispval use decompMod , only : bounds_type - use clm_varpar , only : NUM_ZON + use clm_varpar , only : NUM_ZON, numpft ! !PUBLIC TYPES: implicit none From a9b08dfc3769633d8579da70223ffe707a0383d4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 16:15:30 -0500 Subject: [PATCH 339/589] update land unit initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 3 ++- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index f8717f73a..450ec8974 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -69,7 +69,7 @@ module LandunitType contains !------------------------------------------------------------------------ - subroutine init_landunit_type(this, bounds) + subroutine init_landunit_type(this, bounds, nch) !----------------------------------------------------------------------- ! !DESCRIPTION: ! Allocate memory and initialize to signalling NaN to require @@ -78,6 +78,7 @@ subroutine init_landunit_type(this, bounds) ! !ARGUMENTS: !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of Catchment tiles class(landunit_type) :: this !LOCAL diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index da882fa46..18531d2cb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -173,7 +173,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call col%init_column_type (bounds, nch) - call lun%init_landunit_type (bounds) + call lun%init_landunit_type (bounds, nch) call grc%init_gridcell_type (bounds, nch, cnpft, lats, lons) From 992017c5068056a974439e12cd7e67cd56acd2c0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Feb 2023 16:38:01 -0500 Subject: [PATCH 340/589] initialize every land unit as bare or vegetated soil --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index 450ec8974..efd5565ae 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -121,6 +121,7 @@ subroutine init_landunit_type(this, bounds, nch) this%patchf(nc) = (numpft+1)*num_zon*nc this%coli(nc) = (num_zon)*(nc-1) + 1 this%colf(nc) = num_zon*nc + this%itype(nc) = 1 ! set land unit type so bare or vegetated soil everywhere end do end subroutine init_landunit_type From 7a53556d04d0bafd79f222cb1644ed590d9d68f0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 10 Feb 2023 09:50:06 -0500 Subject: [PATCH 341/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index 14a121f0a..6c6437605 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -14,7 +14,7 @@ module filterMod ! !PUBLIC MEMBER FUNCTIONS: public allocFilters ! allocate memory for filters ! PRIVATE - private :: init_filter_type + private init_filter_type From 799368e4413cc4494a31f35116a22e616957b670 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 10 Feb 2023 10:19:16 -0500 Subject: [PATCH 342/589] add counter initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index 6c6437605..6677be405 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -209,6 +209,7 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) this_filter(1)%num_allc = 0 n = 0 + np = 0 do nc = 1,nch do nz = 1,num_zon n = n + 1 From ab8311f44819a68a71bbaddc379d36a13e1a0180 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 22 Feb 2023 16:05:12 -0500 Subject: [PATCH 343/589] fix allocation --- .../CLM51/CNCLM_Wateratm2lndType.F90 | 10 ++++++++++ .../GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 index d4bf4b579..8281e2efd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 @@ -58,6 +58,16 @@ subroutine init_wateratm2lnd_type(bounds,this) begc = bounds%begc; endc= bounds%endc begg = bounds%begg; endg= bounds%endg + allocate(this%forc_q_not_downscaled_grc (begg:endg)) + allocate(this%forc_rain_not_downscaled_grc (begg:endg)) + allocate(this%forc_snow_not_downscaled_grc (begg:endg)) + allocate(this%forc_q_downscaled_col (begc:endc)) + allocate(this%forc_flood_grc (begg:endg)) + allocate(this%forc_rain_downscaled_col (begc:endc)) + allocate(this%forc_snow_downscaled_col (begc:endc)) + allocate(this%rain_to_snow_conversion_col (begc:endc)) + allocate(this%snow_to_rain_conversion_col (begc:endc)) + this%forc_rain_not_downscaled_grc(begg:endg) = spval this%forc_snow_not_downscaled_grc(begg:endg) = spval this%forc_q_downscaled_col(begc:endc) = spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 072254265..bc97791a4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -47,7 +47,7 @@ subroutine shr_abort_abort(string,ec,rc) integer(shr_kind_in), intent(out), optional :: rc ! error code !----- local ----- - logical :: flag + !logical :: flag ! Local version of the string. ! (Gets a default value if string is not present.) From c8d304e53217dd7c3a70d7f6a97e8799eb012218 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Feb 2023 09:38:56 -0500 Subject: [PATCH 344/589] use get_var instead of MAPL_VarRead for reading parameters --- .../CLM51/ncdio_pio.F90 | 72 +++++++++---------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 68903b565..2aa51e615 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -80,8 +80,8 @@ subroutine ncd_io_char_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTon if (flag == 'read') then readvar = .false. - ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + ! call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -108,8 +108,8 @@ subroutine ncd_io_char_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTon if (flag == 'read') then readvar = .false. - ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + ! call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -136,8 +136,8 @@ subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonf if (flag == 'read') then readvar = .false. - ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + ! call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -165,8 +165,8 @@ subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + ! call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -194,8 +194,8 @@ subroutine ncd_io_r4_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + ! call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -223,8 +223,8 @@ subroutine ncd_io_r4_2d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + ! call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -253,8 +253,8 @@ subroutine ncd_io_r4_3d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -283,8 +283,8 @@ subroutine ncd_io_r4_4d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + ! call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -313,8 +313,8 @@ subroutine ncd_io_r8_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -343,8 +343,8 @@ subroutine ncd_io_r8_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -373,8 +373,8 @@ subroutine ncd_io_r8_2d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - ! call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + ! call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -404,8 +404,8 @@ subroutine ncd_io_r8_3d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -435,8 +435,8 @@ subroutine ncd_io_r8_4d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -464,8 +464,8 @@ subroutine ncd_io_i4_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -494,8 +494,8 @@ subroutine ncd_io_i4_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -524,8 +524,8 @@ subroutine ncd_io_i4_2d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -553,8 +553,8 @@ subroutine ncd_io_i4_3d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif @@ -582,8 +582,8 @@ subroutine ncd_io_i4_4d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfi if (flag == 'read') then readvar = .false. - !call ncid%get_var(varname, data, rc=status) - call MAPL_VarRead(ncid,varname,data,status) + call ncid%get_var(varname, data, rc=status) + !call MAPL_VarRead(ncid,varname,data,status) if (status ==0) readvar = .true. endif From e02113189052c1f517f0e6b30d4e0a1308235308 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Feb 2023 10:42:19 -0500 Subject: [PATCH 345/589] correct allocation --- .../CLM51/CNCLM_WaterFluxType.F90 | 45 +++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index 188e5f86a..61254157b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -131,6 +131,51 @@ subroutine init_waterflux_type(bounds, this) begc = bounds%begc ; endc = bounds%endc begg = bounds%begg ; endg = bounds%endg + allocate(this%qflx_through_liq_patch(begp:endp)) + allocate(this%qflx_through_snow_patch(begp:endp)) + allocate(this%qflx_liqcanfall_patch(begp:endp)) + allocate(this%qflx_snocanfall_patch(begp:endp)) + allocate(this%qflx_snow_unload_patch(begp:endp)) + allocate(this%qflx_top_soil_col(begc:endc)) + allocate(this%qflx_infl_col(begc:endc)) + allocate(this%qflx_surf_col(begc:endc)) + allocate(this%qflx_qrgwl_col(begc:endc)) + allocate(this%qflx_drain_col(begc:endc)) + allocate(this%qflx_drain_perched_col(begc:endc)) + allocate(this%qflx_liq_dynbal_grc(begg:endg)) + allocate(this%qflx_ice_dynbal_grc(begg:endg)) + allocate(this%qflx_runoff_col(begc:endc)) + allocate(this%qflx_runoff_u_col(begc:endc)) + allocate(this%qflx_runoff_r_col(begc:endc)) + allocate(this%qflx_snomelt_col(begc:endc)) + allocate(this%qflx_snofrz_col(begc:endc)) + allocate(this%qflx_snofrz_lyr_col(begc:endc,-nlevsno+1:0)) + allocate(this%qflx_snow_drain_col(begc:endc)) + allocate(this%qflx_evap_soi_patch(begp:endp)) + allocate(this%qflx_evap_can_patch(begp:endp)) + allocate(this%qflx_tran_veg_patch(begp:endp)) + allocate(this%qflx_snwcp_liq_col(begc:endc)) + allocate(this%qflx_snwcp_ice_col(begc:endc)) + allocate(this%qflx_glcice_col(begc:endc)) + allocate(this%qflx_glcice_frz_col(begc:endc)) + allocate(this%qflx_glcice_melt_col(begc:endc)) + allocate(this%qflx_liq_grnd_col(begc:endc)) + allocate(this%qflx_snow_grnd_col(begc:endc)) + allocate(this%qflx_liqevap_from_top_layer_patch(begp:endp)) + allocate(this%qflx_evap_veg_patch(begp:endp)) + allocate(this%qflx_evap_tot_patch(begp:endp)) + allocate(this%qflx_liqdew_to_top_layer_patch(begp:endp)) + allocate(this%qflx_solidevap_from_top_layer_patch(begp:endp)) + allocate(this%qflx_soliddew_to_top_layer_patch(begp:endp)) + allocate(this%qflx_rsub_sat_col(begc:endc)) + allocate(this%qflx_h2osfc_to_ice_col(begc:endc)) + allocate(this%qflx_sfc_irrig_col(begc:endc)) + allocate(this%qflx_gw_uncon_irrig_col(begc:endc)) + allocate(this%qflx_gw_con_irrig_col(begc:endc)) + allocate(this%qflx_irrig_drip_patch(begp:endp)) + allocate(this%qflx_irrig_sprinkler_patch(begp:endp)) + + this%qflx_through_liq_patch(begp:endp) = spval this%qflx_through_snow_patch(begp:endp) = spval this%qflx_liqcanfall_patch(begp:endp) = spval From 9d2caad37946476893a7cd5952c4da2ccb4ce5b5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Feb 2023 12:39:31 -0500 Subject: [PATCH 346/589] fix allocation --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 9 +++++++++ .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 9 +++++++++ 2 files changed, 18 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 32b2ff848..384799bd5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -529,6 +529,9 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if + allocate(this%matrix_phtransfer_doner_patch(1:18)) + allocate(this%matrix_phtransfer_receiver_patch(1:18)) + this%ileafst_to_ileafxf_ph = 1 this%matrix_phtransfer_doner_patch(this%ileafst_to_ileafxf_ph) = ileaf_st this%matrix_phtransfer_receiver_patch(this%ileafst_to_ileafxf_ph) = ileaf_xf @@ -603,6 +606,9 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi this%matrix_phtransfer_receiver_patch(this%igrain_to_iout_ph) = ioutc end if + allocate(this%matrix_gmtransfer_doner_patch(1:18)) + allocate(this%matrix_gmtransfer_receiver_patch(1:18)) + this%ileaf_to_iout_gm = 1 this%matrix_gmtransfer_doner_patch(this%ileaf_to_iout_gm) = ileaf this%matrix_gmtransfer_receiver_patch(this%ileaf_to_iout_gm) = ioutc @@ -675,6 +681,9 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi this%matrix_gmtransfer_doner_patch(this%ideadcrootxf_to_iout_gm) = ideadcroot_xf this%matrix_gmtransfer_receiver_patch(this%ideadcrootxf_to_iout_gm) = ioutc + allocate(this%matrix_fitransfer_doner_patch(1:20)) + allocate(this%matrix_fitransfer_receiver_patch(1:20)) + this%ilivestem_to_ideadstem_fi = 1 this%matrix_fitransfer_doner_patch(this%ilivestem_to_ideadstem_fi) = ilivestem this%matrix_fitransfer_receiver_patch(this%ilivestem_to_ideadstem_fi) = ideadstem diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index d7d38e9cf..afd98d5dc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -396,6 +396,9 @@ subroutine init_cnveg_nitrogenflux_type(bounds, nch, ityp, fveg, cncol, cnpft, t integer :: np, nc, nz, p, nv, n !-------------------------------- + allocate(this%matrix_nphtransfer_doner_patch(1:37)) + allocate(this%matrix_nphtransfer_receiver_patch(1:37)) + this%ileaf_to_iretransn_ph = 1 this%matrix_nphtransfer_doner_patch(this%ileaf_to_iretransn_ph) = ileaf this%matrix_nphtransfer_receiver_patch(this%ileaf_to_iretransn_ph) = iretransn @@ -561,6 +564,9 @@ subroutine init_cnveg_nitrogenflux_type(bounds, nch, ityp, fveg, cncol, cnpft, t this%matrix_nphtransfer_receiver_patch(this%iretransn_to_iout_ph) = ioutn end if + allocate(this%matrix_ngmtransfer_doner_patch(1:19)) + allocate(this%matrix_ngmtransfer_receiver_patch(1:19)) + this%ileaf_to_iout_gm = 1 this%matrix_ngmtransfer_doner_patch(this%ileaf_to_iout_gm) = ileaf this%matrix_ngmtransfer_receiver_patch(this%ileaf_to_iout_gm) = ioutn @@ -638,6 +644,9 @@ subroutine init_cnveg_nitrogenflux_type(bounds, nch, ityp, fveg, cncol, cnpft, t this%matrix_ngmtransfer_doner_patch(this%iretransn_to_iout_gm) = iretransn this%matrix_ngmtransfer_receiver_patch(this%iretransn_to_iout_gm) = ioutn + allocate(this%matrix_nfitransfer_doner_patch(1:21)) + allocate(this%matrix_nfitransfer_receiver_patch(1:21)) + this%ilivestem_to_ideadstem_fi = 1 this%matrix_nfitransfer_doner_patch(this%ilivestem_to_ideadstem_fi) = ilivestem this%matrix_nfitransfer_receiver_patch(this%ilivestem_to_ideadstem_fi) = ideadstem From fb5f2389c00cd47f17061207671ce08af646ba43 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Feb 2023 15:33:32 -0500 Subject: [PATCH 347/589] change pftcon initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 9 ++++++--- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 6 +++--- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 0584c4076..3c709fa5b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -279,6 +279,10 @@ module pftconMod ! pft parameters for dynamic root code real(r8), allocatable :: root_dmx(:) !maximum root depth + contains + + procedure, public :: init_pftcon_type + end type pftcon_type type(pftcon_type), public :: pftcon @@ -313,10 +317,9 @@ subroutine init_pftcon_type(this) ! !ARGUMENTS: implicit none !INPUT/OUTPUT - type(pftcon_type), intent(inout):: this + class(pftcon_type) :: this + - !LOCAL - character(300) :: paramfile integer :: ierr, clm_varid, status, m logical :: readv ! has variable been read in or not type(Netcdf4_fileformatter) :: ncid diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 18531d2cb..8ae26f984 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -19,7 +19,7 @@ module CN_initMod use SolarAbsorbedType use SurfaceAlbedoType use OzoneBaseMod - use pftconMod + use pftconMod , only : pftcon use WaterFluxType use SoilBiogeochemCarbonStateType use SoilBiogeochemNitrogenStateType @@ -123,7 +123,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) type(solarabs_type) :: solarabs_inst type(surfalb_type) :: surfalb_inst type(ozone_base_type) :: ozone_inst - type(pftcon_type) :: pftcon +! type(pftcon_type) :: pftcon type(waterflux_type) :: waterflux_inst type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst @@ -220,7 +220,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) call photosyns_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) - call init_pftcon_type (pftcon) + call pftcon%init_pftcon_type () call init_waterflux_type (bounds, waterflux_inst) From 72b25603d83e4f979e21f1bef5e934737168fddf Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Feb 2023 15:58:17 -0500 Subject: [PATCH 348/589] removing duplicate function declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 3c709fa5b..446c8439e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -19,7 +19,7 @@ module pftconMod save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_pftcon_type + ! ! Vegetation type constants From ffc46f24f6f631ce62dc42c72ef55906bb9acb1f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Feb 2023 16:02:02 -0500 Subject: [PATCH 349/589] commenting out read function for logical data types (not currently used) --- .../CLM51/ncdio_pio.F90 | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 index 2aa51e615..e145c84a1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/ncdio_pio.F90 @@ -38,7 +38,7 @@ module ncdio_pio module procedure ncd_io_char_0d module procedure ncd_io_char_1d - module procedure ncd_io_log_1d + ! module procedure ncd_io_log_1d module procedure ncd_io_r4_0d module procedure ncd_io_r4_1d module procedure ncd_io_r4_2d @@ -115,33 +115,33 @@ subroutine ncd_io_char_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTon end subroutine ncd_io_char_1d - subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) - - ! ARGUMENTS: - !------------- - type(file_desc_t), intent(inout) :: ncid ! netcdf file id - logical, intent(inout) :: data(:) - character(len=*), intent(in) :: flag ! 'read' or 'write' - character(len=*), intent(in) :: varname ! variable name - logical, intent(out) :: readvar - integer,optional, intent(out) :: rc - integer, optional , intent(in) :: nt ! time sample index - logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file - - ! LOCAL: - - integer :: status - - !------------------------------------- - - if (flag == 'read') then - readvar = .false. - call ncid%get_var(varname, data, rc=status) - ! call MAPL_VarRead(ncid,varname,data,status) - if (status ==0) readvar = .true. - endif - - end subroutine ncd_io_log_1d +! subroutine ncd_io_log_1d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) +! +! ! ARGUMENTS: +! !------------- +! type(file_desc_t), intent(inout) :: ncid ! netcdf file id +! logical, intent(inout) :: data(:) +! character(len=*), intent(in) :: flag ! 'read' or 'write' +! character(len=*), intent(in) :: varname ! variable name +! logical, intent(out) :: readvar +! integer,optional, intent(out) :: rc +! integer, optional , intent(in) :: nt ! time sample index +! logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file +! +! ! LOCAL: +! +! integer :: status +! +! !------------------------------------- +! +! if (flag == 'read') then +! readvar = .false. +! ! call ncid%get_var(varname, data, rc=status) +! ! call MAPL_VarRead(ncid,varname,data,status) +! if (status ==0) readvar = .true. +! endif +! +! end subroutine ncd_io_log_1d !---------------------------------------------------- subroutine ncd_io_r4_0d ( varname, data, flag, ncid, readvar, rc, nt, posNOTonfile) From dab4e406a85e716771bcb27ef818799f36a8efae Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 09:13:23 -0500 Subject: [PATCH 350/589] add missing file declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index 446c8439e..a2c866b95 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -329,6 +329,7 @@ subroutine init_pftcon_type(this) integer , allocatable, dimension(:) :: read_tmp_3 character(len=512) :: msg + character(len=300) :: paramfile !--------------------------------------------------------- From 16348013d5a536fd744eab771eedd573af090809 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 09:27:10 -0500 Subject: [PATCH 351/589] add missing function import --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 8ae26f984..f4c61de07 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -75,7 +75,7 @@ module CN_initMod use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi - use MAPL , only : NetCDF4_FileFormatter + use MAPL , only : NetCDF4_FileFormatter, pFIO_READ implicit none private From dc2b841bc4ec602bdbbda3cba6fe1f34c09210f3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 09:51:04 -0500 Subject: [PATCH 352/589] adding missing function declaration --- .../CLM51/CNCLM_FrictionVelocityMod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 index f33c8e409..64281f860 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 @@ -29,6 +29,9 @@ module FrictionVelocityMod private save +! !PUBLIC MEMBER FUNCTIONS: + public :: init_frictionvel_type + type, public :: frictionvel_type private From b8df82bc172b39224c59f1f0e4ae9ef6795b8440 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 10:12:40 -0500 Subject: [PATCH 353/589] add missing function import --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index f4c61de07..6f99b75b5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -64,7 +64,7 @@ module CN_initMod use SoilBiogeochemDecompMod , only : readSoilBiogeochemDecompParams => readParams use CNPhenologyMod , only : readCNPhenolParams => readParams use SoilBiogeochemLittVertTranspMod , only : readSoilBiogeochemLittVertTranspParams => readParams - use CNPhenologyMod , only : CNPhenologyReadNML + use CNPhenologyMod , only : CNPhenologyReadNML, CNPhenologyInit use dynSubgridControlMod , only : dynSubgridControl_init use CNFireFactoryMod , only : CNFireReadNML, create_cnfire_method use FireMethodType , only : fire_method_type From 15302b621a9d56abf7ce115ed6299a2ec7c5334f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 14:40:59 -0500 Subject: [PATCH 354/589] initialize CN time step earlier --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 9 +++++++-- .../GEOS_CatchCNCLM51GridComp.F90 | 2 +- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 6f99b75b5..d10063675 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -90,7 +90,7 @@ module CN_initMod contains !------------------------------------------------------ - subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) + subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) !ARGUMENTS implicit none @@ -102,6 +102,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! patch/pft-level CN restart variables real, dimension(nch), intent(in) :: lats ! Catchment tile latitudes [rad] real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes [rad] + real, intent(in) :: dtcn ! Catchment-CN step size logical, optional, intent(in) :: cn5_cold_start ! cold start for the CLM variables that are new in Catchment-CN5.0 @@ -149,11 +150,15 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,cn5_cold_start) character(300) :: paramfile character(300) :: NLFilename type(Netcdf4_fileformatter) :: ncid - integer :: rc, status + integer :: rc, status, ndt integer, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function !----------------------------------------- +! initialize CN step size + + ndt = get_step_size( nint(dtcn) ) + ! initialize CN model ! ------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index e82e64330..08dfccf3b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -4230,7 +4230,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,.true.) + call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,DTCN,.true.) call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif From 58e7f3a4e904c4b9cb0473fde930ae16c89587a2 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 14:50:40 -0500 Subject: [PATCH 355/589] add missing function import --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index d10063675..abb4db852 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -7,6 +7,7 @@ module CN_initMod use clm_varcon , only : clm_varcon_init use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init use clm_varctl , only : use_century_decomp, init_clm_varctl + use clm_time_manager , only: get_step_size use decompMod use filterMod use CNVegNitrogenStateType From 765a97a4a4d9b9cf3b64de843ba8634d1bd0e065 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 15:21:44 -0500 Subject: [PATCH 356/589] change order of initialization and parameter read --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index abb4db852..599f41161 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -272,11 +272,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call init_frictionvel_type (bounds, frictionvel_inst) - call CNPhenologyInit (bounds) - - call bgc_vegetation_inst%cn_balance_inst%Init (bounds) - call create_cnfire_method( bgc_vegetation_inst%cnfire_method) - ! calls to original CTSM initialization routines ! initialize rooting profile with default values @@ -318,6 +313,13 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call ncid%close(rc=status) + ! initialize types that depend on parameters + + call CNPhenologyInit (bounds) + + call bgc_vegetation_inst%cn_balance_inst%Init (bounds) + call create_cnfire_method( bgc_vegetation_inst%cnfire_method) + call FireMethodInit(bounds,paramfile) if (use_century_decomp) then From 98a98f72e33764f928255861c11f60df36c30427 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 15:43:31 -0500 Subject: [PATCH 357/589] split parameter read according to type --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 599f41161..5ad101247 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -309,7 +309,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call readSoilBiogeochemNLeachingParams(ncid) call readSoilBiogeochemCompetitionParams(ncid) call readSoilBiogeochemPotentialParams(ncid) - call bgc_vegetation_inst%cnfire_method%CNFireReadParams( ncid ) call ncid%close(rc=status) @@ -320,6 +319,10 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call bgc_vegetation_inst%cn_balance_inst%Init (bounds) call create_cnfire_method( bgc_vegetation_inst%cnfire_method) + call ncid%open(trim(paramfile),pFIO_READ, __RC__) + call bgc_vegetation_inst%cnfire_method%CNFireReadParams( ncid ) + call ncid%close(rc=status) + call FireMethodInit(bounds,paramfile) if (use_century_decomp) then From 43c1ec108bc87b10d18cef796fc59a74168c3f28 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 17:18:21 -0500 Subject: [PATCH 358/589] change fire method initialization call --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 5ad101247..ac29098cc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -323,7 +323,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call bgc_vegetation_inst%cnfire_method%CNFireReadParams( ncid ) call ncid%close(rc=status) - call FireMethodInit(bounds,paramfile) + call bgc_vegetation_inst%cnfire_method%FireInit(bounds) + ! call FireMethodInit(bounds,paramfile) if (use_century_decomp) then call init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, & From 0ed19c30bf8ea9376077a795cc9ce5eeb21bdd92 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 18:19:21 -0500 Subject: [PATCH 359/589] add target declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index d82e27f56..27dd58b87 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -55,7 +55,7 @@ module CanopyStateType real(r8) :: leaf_mr_vcm = spval ! Scalar constant of leaf respiration with Vcmax end type canopystate_type - type(canopystate_type), public :: canopystate_inst + type(canopystate_type), public, target :: canopystate_inst contains From a09302d8227881213c7310fa8fb2e465bcacedff Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Feb 2023 18:36:22 -0500 Subject: [PATCH 360/589] make canopystate initialization internal function --- .../CLM51/CNCLM_CanopyStateType.F90 | 9 ++++++--- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 ++-- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 27dd58b87..97d6e7120 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -16,7 +16,6 @@ module CanopyStateType ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_canopystate_type type, public :: canopystate_type @@ -54,13 +53,17 @@ module CanopyStateType real(r8) :: leaf_mr_vcm = spval ! Scalar constant of leaf respiration with Vcmax + contains + + procedure, public :: init_canopystate_type + end type canopystate_type type(canopystate_type), public, target :: canopystate_inst contains !-------------------------------------------------------------- - subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start, rc) + subroutine init_canopystate_type(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) ! !DESCRIPTION: ! Initialize CTSM canopy state type needed for calling CTSM routines @@ -77,7 +80,7 @@ subroutine init_canopystate_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array logical, optional, intent(in) :: cn5_cold_start - type(canopystate_type), intent(inout):: this + class(canopystate_type) :: this integer, optional, intent(out) :: rc ! LOCAL diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index ac29098cc..904d7ca7c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -121,7 +121,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst type(wateratm2lnd_type) :: wateratm2lnd_inst - type(canopystate_type) :: canopystate_inst + !type(canopystate_type) :: canopystate_inst type(solarabs_type) :: solarabs_inst type(surfalb_type) :: surfalb_inst type(ozone_base_type) :: ozone_inst @@ -216,7 +216,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call init_wateratm2lnd_type (bounds, wateratm2lnd_inst) - call init_canopystate_type (bounds, nch, ityp, fveg, cncol, cnpft, canopystate_inst, cn5_cold_start) + call canopystate_inst%init_canopystate_type (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) call init_solarabs_type (bounds, solarabs_inst) From b0a9c4d5af6d06ff2542d0e8ca225c18f3b31b2c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 Feb 2023 09:02:14 -0500 Subject: [PATCH 361/589] modify initialization calls --- .../CLM51/CNCLM_ActiveLayerMod.F90 | 15 +- .../CLM51/CNCLM_CNDVType.F90 | 13 +- .../CLM51/CNCLM_CNProductsMod.F90 | 11 +- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 10 +- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 10 +- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 10 +- .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 10 +- .../CLM51/CNCLM_CNVegStateType.F90 | 13 +- .../CLM51/CNCLM_CropType.F90 | 13 +- .../CLM51/CNCLM_EnergyFluxType.F90 | 15 +- .../CLM51/CNCLM_FrictionVelocityMod.F90 | 12 +- .../CLM51/CNCLM_OzoneBaseMod.F90 | 13 +- .../CLM51/CNCLM_SaturatedExcessRunoffMod.F90 | 13 +- .../CNCLM_SoilBiogeochemCarbonFluxType.F90 | 10 +- .../CNCLM_SoilBiogeochemCarbonStateType.F90 | 10 +- ...CLM_SoilBiogeochemDecompCascadeConType.F90 | 5 +- .../CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 10 +- .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 10 +- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 14 +- .../CLM51/CNCLM_SoilStateType.F90 | 13 +- .../CLM51/CNCLM_SolarAbsorbedType.F90 | 13 +- .../CLM51/CNCLM_SurfaceAlbedoType.F90 | 12 +- .../CLM51/CNCLM_TemperatureType.F90 | 11 +- .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 13 +- .../CLM51/CNCLM_WaterFluxBulkType.F90 | 10 +- .../CLM51/CNCLM_WaterFluxType.F90 | 13 +- .../CLM51/CNCLM_WaterStateBulkType.F90 | 13 +- .../CLM51/CNCLM_WaterStateType.F90 | 13 +- .../CLM51/CNCLM_Wateratm2lndBulkType.F90 | 11 +- .../CLM51/CNCLM_Wateratm2lndType.F90 | 12 +- .../CLM51/CNCLM_atm2lndType.F90 | 13 +- .../CLM51/CNCLM_ch4Mod.F90 | 13 +- .../CLM51/CN_init_mod.F90 | 147 +++++++++--------- 33 files changed, 296 insertions(+), 228 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 index 9073614c0..cf4759d9e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 @@ -20,8 +20,6 @@ module ActiveLayerMod ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_active_layer_type - public:: alt_calc ! !PUBLIC TYPES: type, public :: active_layer_type @@ -37,21 +35,22 @@ module ActiveLayerMod integer , pointer :: alt_indx_col (:) ! col current depth of thaw contains - procedure, public :: alt_calc - + procedure , public :: alt_calc + procedure , public :: Init + end type active_layer_type - type(active_layer_type), public :: active_layer_inst + type(active_layer_type), public, target :: active_layer_inst !--------------------------------------- contains !--------------------------------------- - subroutine init_active_layer_type(bounds, this) + subroutine Init(this, bounds) ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds - type(active_layer_type), intent(inout) :: this + class(active_layer_type) :: this ! !----------------------------------------------------------------------- @@ -69,7 +68,7 @@ subroutine init_active_layer_type(bounds, this) end associate - end subroutine init_active_layer_type + end subroutine Init !----------------------------------------- subroutine alt_calc(this, num_soilc, filter_soilc, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 index 53778b465..e333dd87b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -17,7 +17,6 @@ module CNDVType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_dgvs_type ! !PUBLIC DATA TYPES: ! @@ -53,13 +52,17 @@ module CNDVType real(r8), pointer, public :: greffic_patch (:) real(r8), pointer, public :: heatstress_patch (:) + contains + + procedure , public :: Init + end type dgvs_type - type(dgvs_type), public :: dgvs_inst + type(dgvs_type), public, target :: dgvs_inst contains !------------------------------------------------------ - subroutine init_dgvs_type(bounds, this) + subroutine Init(this, bounds) use nanMod , only : nan use clm_varpar , only : maxveg @@ -71,7 +74,7 @@ subroutine init_dgvs_type(bounds, this) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(dgvs_type), intent(inout):: this + class(dgvs_type) :: this !LOCAL integer :: begp, endp @@ -123,6 +126,6 @@ subroutine init_dgvs_type(bounds, this) dgv_ecophyscon%allom2(m) = allom2s end if end do - end subroutine init_dgvs_type + end subroutine Init end module CNDVType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index fd442488a..66ae215db 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -17,7 +17,6 @@ module CNProductsMod ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_cn_products_type ! !PUBLIC TYPES: type, public :: cn_products_type @@ -65,10 +64,10 @@ module CNProductsMod procedure, private :: PartitionWoodFluxes procedure, private :: PartitionGrainFluxes procedure, private :: ComputeSummaryVars - + procedure, public :: Init end type cn_products_type - type(cn_products_type), public :: cn_products_inst + type(cn_products_type), public, target :: cn_products_inst character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -76,7 +75,7 @@ module CNProductsMod contains !-------------------------------------------------------------- - subroutine init_cn_products_type(bounds, nch, cncol, species, this, rc) + subroutine Init(this, bounds, nch, cncol, species, rc) ! !DESCRIPTION: ! Initialize CTSM wood products type needed for calling CTSM routines @@ -90,7 +89,7 @@ subroutine init_cn_products_type(bounds, nch, cncol, species, this, rc) integer, intent(in) :: nch ! number of Catchment tiles real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array character(*), intent(in) :: species ! C or N - type(cn_products_type), intent(inout):: this + class(cn_products_type) :: this integer, optional, intent(out) :: rc ! LOCAL @@ -150,7 +149,7 @@ subroutine init_cn_products_type(bounds, nch, cncol, species, this, rc) end do ! nz end do ! nc - end subroutine init_cn_products_type + end subroutine Init !----------------------------------------------------------------------- subroutine UpdateProducts(this, bounds, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 384799bd5..4b5cbe114 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -32,7 +32,6 @@ module CNVegCarbonFluxType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_cnveg_carbonflux_type type, public :: cnveg_carbonflux_type @@ -478,10 +477,11 @@ module CNVegCarbonFluxType procedure , public :: SetValues procedure , public :: Summary => Summary_carbonflux procedure , public :: ZeroDWT + procedure , public :: Init end type cnveg_carbonflux_type -type(cnveg_carbonflux_type), public :: cnveg_carbonflux_inst +type(cnveg_carbonflux_type), public, target :: cnveg_carbonflux_inst character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -489,7 +489,7 @@ module CNVegCarbonFluxType contains !--------------------------------------- - subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, this, cn5_cold_start, rc) + subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) ! !DESCRIPTION: ! Initialize CTSM carbon fluxes @@ -507,7 +507,7 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart logical, optional, intent(in) :: cn5_cold_start - type(cnveg_carbonflux_type), intent(inout):: this + class(cnveg_carbonflux_type) :: this integer, optional, intent(out) :: rc ! LOCAL @@ -1124,7 +1124,7 @@ subroutine init_cnveg_carbonflux_type(bounds, nch, ityp, fveg, cncol, cnpft, thi end do ! nz end do ! nc - end subroutine init_cnveg_carbonflux_type + end subroutine Init !----------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 4198765cd..c5b5a760f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -16,7 +16,6 @@ module CNVegCarbonStateType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_cnveg_carbonstate_type type, public :: cnveg_carbonstate_type @@ -200,10 +199,11 @@ module CNVegCarbonStateType procedure , public :: Summary => Summary_carbonstate procedure , public :: ZeroDWT + procedure , public :: Init end type cnveg_carbonstate_type -type(cnveg_carbonstate_type), public :: cnveg_carbonstate_inst +type(cnveg_carbonstate_type), public, target :: cnveg_carbonstate_inst real(r8), public :: spinup_factor_deadwood = 1.0_r8 ! Spinup factor used for this simulation real(r8), public :: spinup_factor_AD = 10.0_r8 ! Spinup factor used when in Accelerated Decomposition mode @@ -222,7 +222,7 @@ module CNVegCarbonStateType contains !---------------------------------------------- - subroutine init_cnveg_carbonstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this) + subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) ! !DESCRIPTION: ! Initialize CTSM carbon states @@ -239,7 +239,7 @@ subroutine init_cnveg_carbonstate_type(bounds, nch, ityp, fveg, cncol, cnpft, th real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart - type(cnveg_carbonstate_type), intent(inout):: this + class(cnveg_carbonstate_type) :: this ! LOCAL integer :: begp, endp @@ -526,7 +526,7 @@ subroutine init_cnveg_carbonstate_type(bounds, nch, ityp, fveg, cncol, cnpft, th end do ! nz end do ! nc - end subroutine init_cnveg_carbonstate_type + end subroutine Init !----------------------------------------------------------------------- subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index afd98d5dc..92f9b5213 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -25,7 +25,6 @@ module CNVegNitrogenFluxType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_cnveg_nitrogenflux_type type, public :: cnveg_nitrogenflux_type @@ -362,15 +361,16 @@ module CNVegNitrogenFluxType procedure , public :: SetValues procedure , public :: Summary => Summary_nitrogenflux procedure , public :: ZeroDWT + procedure , public :: Init end type cnveg_nitrogenflux_type -type(cnveg_nitrogenflux_type), public :: cnveg_nitrogenflux_inst +type(cnveg_nitrogenflux_type), public, target :: cnveg_nitrogenflux_inst contains !--------------------------------------- - subroutine init_cnveg_nitrogenflux_type(bounds, nch, ityp, fveg, cncol, cnpft, this) + subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) ! !DESCRIPTION: ! Initialize CTSM nitrogen fluxes @@ -387,7 +387,7 @@ subroutine init_cnveg_nitrogenflux_type(bounds, nch, ityp, fveg, cncol, cnpft, t real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart - type(cnveg_nitrogenflux_type), intent(inout):: this + class(cnveg_nitrogenflux_type) :: this ! LOCAL integer :: begp, endp @@ -992,7 +992,7 @@ subroutine init_cnveg_nitrogenflux_type(bounds, nch, ityp, fveg, cncol, cnpft, t end do ! nz end do ! nc - end subroutine init_cnveg_nitrogenflux_type + end subroutine Init !------------------------------------------ subroutine SetValues ( this,nvegnpool, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index 881d2bfc3..6a8b7f952 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -19,7 +19,6 @@ module CNVegNitrogenStateType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_cnveg_nitrogenstate_type ! type, public :: cnveg_nitrogenstate_type @@ -208,14 +207,15 @@ module CNVegNitrogenStateType procedure , public :: Summary => Summary_nitrogenstate procedure , public :: ZeroDWT + procedure , public :: Init end type cnveg_nitrogenstate_type -type(cnveg_nitrogenstate_type), public :: cnveg_nitrogenstate_inst +type(cnveg_nitrogenstate_type), public, target :: cnveg_nitrogenstate_inst contains !------------------------------------------------------------- - subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, this) + subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) ! !DESCRIPTION: ! Initialize CTSM nitrogen states @@ -232,7 +232,7 @@ subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart - type(cnveg_nitrogenstate_type), intent(inout):: this + class(cnveg_nitrogenstate_type) :: this ! LOCAL: @@ -481,7 +481,7 @@ subroutine init_cnveg_nitrogenstate_type(bounds, nch, ityp, fveg, cncol, cnpft, end do !nz end do ! nc - end subroutine init_cnveg_nitrogenstate_type + end subroutine Init !----------------------------------------------------------------------- subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index d34d53253..696fbf091 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -14,7 +14,6 @@ module CNVegStateType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_cnveg_state_type type, public :: cnveg_state_type @@ -98,15 +97,19 @@ module CNVegStateType real(r8), pointer :: leafcn_offset_patch (:) ! patch leaf C:N used by FUN real(r8), pointer :: plantCN_patch (:) ! patch plant C:N used by FUN + contains + + procedure, public :: Init + end type cnveg_state_type - type(cnveg_state_type), public :: cnveg_state_inst + type(cnveg_state_type), public, target :: cnveg_state_inst contains !----------------------------------------------------- !---------------------------------------------- - subroutine init_cnveg_state_type(bounds, nch, ityp, fveg, cncol, cnpft, this) + subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) ! !DESCRIPTION: ! Initialize CTSM vegetation states @@ -123,7 +126,7 @@ subroutine init_cnveg_state_type(bounds, nch, ityp, fveg, cncol, cnpft, this) real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart - type(cnveg_state_type), intent(inout):: this + class(cnveg_state_type) :: this ! LOCAL integer :: begp, endp @@ -247,7 +250,7 @@ subroutine init_cnveg_state_type(bounds, nch, ityp, fveg, cncol, cnpft, this) end do ! nz end do ! nc - end subroutine init_cnveg_state_type + end subroutine Init end module CNVegStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 index 6020850a0..c86a589af 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 @@ -9,7 +9,6 @@ module CropType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_crop_type type, public :: crop_type @@ -28,13 +27,17 @@ module CropType real(r8) :: baset_latvary_intercept real(r8) :: baset_latvary_slope + contains + + procedure , public :: Init + end type crop_type - type(crop_type), public :: crop_inst + type(crop_type), public, target :: crop_inst contains !------------------------------------------------------ - subroutine init_crop_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM crop type needed for calling CTSM routines @@ -45,7 +48,7 @@ subroutine init_crop_type(bounds, this) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(crop_type), intent(inout):: this + class(crop_type) :: this !LOCAL integer :: begp, endp @@ -65,6 +68,6 @@ subroutine init_crop_type(bounds, this) allocate(this%cphase_patch (begp:endp)) ; this%cphase_patch (:) = 0.0_r8 allocate(this%latbaset_patch (begp:endp)) ; this%latbaset_patch (:) = spval - end subroutine init_crop_type + end subroutine Init end module CropType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 index 55503e92e..32878e130 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 @@ -22,7 +22,6 @@ module EnergyFluxType private ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_energyflux_type ! type, public :: energyflux_type @@ -120,19 +119,25 @@ module EnergyFluxType real(r8), pointer :: errsol_col (:) ! solar radiation conservation error (W/m**2) real(r8), pointer :: errlon_patch (:) ! longwave radiation conservation error (W/m**2) real(r8), pointer :: errlon_col (:) ! longwave radiation conservation error (W/m**2) + + + contains + + procedure , public :: Init + end type energyflux_type - type(energyflux_type), public :: energyflux_inst + type(energyflux_type), public, target :: energyflux_inst contains !--------------------------------------------- - subroutine init_energyflux_type(bounds, this) + subroutine Init(this, bounds) ! !ARGUMENTS: implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(energyflux_type), intent(inout):: this + class(energyflux_type) :: this !LOCAL integer :: begp, endp @@ -228,7 +233,7 @@ subroutine init_energyflux_type(bounds, this) allocate( this%errlon_col (begc:endc)) ; this%errlon_col (:) = nan - end subroutine init_energyflux_type + end subroutine Init end module EnergyFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 index 64281f860..0f50da08a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 @@ -30,7 +30,6 @@ module FrictionVelocityMod save ! !PUBLIC MEMBER FUNCTIONS: - public :: init_frictionvel_type type, public :: frictionvel_type private @@ -75,9 +74,12 @@ module FrictionVelocityMod real(r8), pointer, public :: num_iter_patch (:) ! patch number of iterations real(r8), pointer, public :: z0m_actual_patch (:) ! patch roughness length actually used in flux calculations, momentum [m] + contains + + procedure , public :: Init end type frictionvel_type - type(frictionvel_type), public :: frictionvel_inst + type(frictionvel_type), public, target :: frictionvel_inst character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -86,12 +88,12 @@ module FrictionVelocityMod contains !------------------------------------------------------------------------ - subroutine init_frictionvel_type( bounds, this) + subroutine Init( this, bounds) ! use shr_infnan_mod , only : nan => shr_infnan_nan type(bounds_type), intent(in) :: bounds - type(frictionvel_type), intent(inout) :: this + class(frictionvel_type) :: this ! ! !LOCAL VARIABLES: integer :: begp, endp @@ -133,7 +135,7 @@ subroutine init_frictionvel_type( bounds, this) allocate(this%num_iter_patch (begp:endp)) ; this%num_iter_patch (:) = nan allocate(this%z0m_actual_patch (begp:endp)) ; this%z0m_actual_patch (:) = nan - end subroutine init_frictionvel_type + end subroutine Init end module FrictionVelocityMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 index dd49d6bb0..8fa0dee37 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 @@ -9,7 +9,6 @@ module OzoneBaseMod save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_ozone_base_type type, public :: ozone_base_type @@ -21,13 +20,17 @@ module OzoneBaseMod real(r8), pointer, public :: o3coefgsha_patch(:) ! ozone coefficient for conductance, shaded leaves (0 - 1) real(r8), pointer, public :: o3coefgsun_patch(:) ! ozone coefficient for conductance, sunlit leaves (0 - 1) + contains + + procedure, public :: Init + end type ozone_base_type - type(ozone_base_type), public :: ozone_inst + type(ozone_base_type), public, target :: ozone_inst contains !------------------------------------------------ - subroutine init_ozone_base_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM ozone base type needed for calling CTSM routines @@ -38,7 +41,7 @@ subroutine init_ozone_base_type(bounds, this) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(ozone_base_type), intent(inout) :: this + class(ozone_base_type) :: this ! LOCAL integer :: begp, endp @@ -56,6 +59,6 @@ subroutine init_ozone_base_type(bounds, this) this%o3coefgsha_patch = 1. this%o3coefgsun_patch = 1. - end subroutine init_ozone_base_type + end subroutine Init end module OzoneBaseMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 index 74bcc7603..745d0d212 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SaturatedExcessRunoffMod.F90 @@ -19,8 +19,6 @@ module SaturatedExcessRunoffMod save private - public :: init_saturated_excess_runoff_type - ! !PUBLIC TYPES: type, public :: saturated_excess_runoff_type @@ -32,6 +30,11 @@ module SaturatedExcessRunoffMod ! Private data members integer :: fsat_method real(r8), pointer :: fcov_col(:) ! fractional impermeable area + + contains + + procedure, public :: Init + end type saturated_excess_runoff_type type, private :: params_type @@ -42,7 +45,7 @@ module SaturatedExcessRunoffMod contains !-------------------------------------------------------------- - subroutine init_saturated_excess_runoff_type(bounds, this) + subroutine Init(this, bounds) ! !USES: ! @@ -50,7 +53,7 @@ subroutine init_saturated_excess_runoff_type(bounds, this) implicit none ! INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(saturated_excess_runoff_type), intent(inout):: this + class(saturated_excess_runoff_type) :: this ! LOCAL integer :: begc, endc @@ -61,6 +64,6 @@ subroutine init_saturated_excess_runoff_type(bounds, this) allocate(this%fsat_col(begc:endc)) ; this%fsat_col(:) = nan allocate(this%fcov_col(begc:endc)) ; this%fcov_col(:) = nan - end subroutine init_saturated_excess_runoff_type + end subroutine Init end module SaturatedExcessRunoffMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index 3e9494ae9..5023a3f2f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -15,7 +15,6 @@ module SoilBiogeochemCarbonFluxType ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_soilbiogeochem_carbonflux_type type, public :: soilbiogeochem_carbonflux_type @@ -77,17 +76,18 @@ module SoilBiogeochemCarbonFluxType procedure , public :: SetValues procedure , public :: Summary + procedure , public :: Init end type soilbiogeochem_carbonflux_type - type(soilbiogeochem_carbonflux_type), public :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type), public, target :: soilbiogeochem_carbonflux_inst contains !-------------------------------------------------------------- - subroutine init_soilbiogeochem_carbonflux_type(bounds,this) + subroutine Init(this, bounds) type(bounds_type), intent(in) :: bounds - type(soilbiogeochem_carbonflux_type), intent(inout) :: this + class(soilbiogeochem_carbonflux_type) :: this ! ! !LOCAL VARIABLES: integer :: begp,endp @@ -172,7 +172,7 @@ subroutine init_soilbiogeochem_carbonflux_type(bounds,this) endif - end subroutine init_soilbiogeochem_carbonflux_type + end subroutine Init !----------------------------------------------------------------------- subroutine SetValues ( this, num_column, filter_column, value_column) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index 469d121f1..69fc51aae 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -18,7 +18,6 @@ module SoilBiogeochemCarbonStateType ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_soilbiogeochem_carbonstate_type type, public :: soilbiogeochem_carbonstate_type @@ -59,10 +58,11 @@ module SoilBiogeochemCarbonStateType procedure , public :: Summary procedure , public :: SetTotVgCThresh + procedure , public :: Init end type soilbiogeochem_carbonstate_type - type(soilbiogeochem_carbonstate_type), public :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type), public, target :: soilbiogeochem_carbonstate_inst character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -71,7 +71,7 @@ module SoilBiogeochemCarbonStateType contains !------------------------------------------- - subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) + subroutine Init(this, bounds, nch, cncol) ! ! !ARGUMENTS: @@ -79,7 +79,7 @@ subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of tiles real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart - type(soilbiogeochem_carbonstate_type), intent(inout) :: this + class(soilbiogeochem_carbonstate_type) :: this ! ! !LOCAL VARIABLES: integer :: begc,endc @@ -165,7 +165,7 @@ subroutine init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, this) end do !nz end do ! nc - end subroutine init_soilbiogeochem_carbonstate_type + end subroutine Init !----------------------------------------------------------------------- subroutine Summary(this, bounds, num_allc, filter_allc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 index b20d955a0..2ee97754a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemDecompCascadeConType.F90 @@ -60,11 +60,14 @@ module SoilBiogeochemDecompCascadeConType end type decomp_cascade_type integer, public, parameter :: i_atm = 0 ! for terminal pools (i.e. 100% respiration) (only used for CN not for BGC) - type(decomp_cascade_type), public :: decomp_cascade_con + + type(decomp_cascade_type), public, target :: decomp_cascade_con !------------------------------------------------------------------------ contains + + !------------------------------------------------------------------------ subroutine init_decomp_cascade_constants( use_century_decomp ) ! diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index 93a6c3412..ef9e96180 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -15,7 +15,6 @@ module SoilBiogeochemNitrogenFluxType ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_soilbiogeochem_nitrogenflux_type type, public :: SoilBiogeochem_nitrogenflux_type @@ -142,20 +141,21 @@ module SoilBiogeochemNitrogenFluxType procedure , public :: SetValues procedure , public :: Summary + procedure , public :: Init end type soilbiogeochem_nitrogenflux_type - type(soilbiogeochem_nitrogenflux_type), public :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type), public, target :: soilbiogeochem_nitrogenflux_inst contains !-------------------------------------------------------------- - subroutine init_soilbiogeochem_nitrogenflux_type(bounds,this) + subroutine Init(this, bounds) !ARGUMENTS implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(soilbiogeochem_nitrogenflux_type), intent(inout) :: this + class(soilbiogeochem_nitrogenflux_type) :: this ! ! !LOCAL VARIABLES: integer :: begc,endc,Ntrans,Ntrans_diag @@ -277,7 +277,7 @@ subroutine init_soilbiogeochem_nitrogenflux_type(bounds,this) ! call this%matrix_Ninput%InitV (ndecomp_pools*nlevdecomp,begc,endc) end if - end subroutine init_soilbiogeochem_nitrogenflux_type + end subroutine Init !----------------------------------------------------------------------- subroutine SetValues ( this, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index d0389ab9c..06ccdfde5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -18,7 +18,6 @@ module SoilBiogeochemNitrogenStateType ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_soilbiogeochem_nitrogenstate_type type, public :: soilbiogeochem_nitrogenstate_type @@ -72,9 +71,10 @@ module SoilBiogeochemNitrogenStateType procedure , public :: Summary procedure , public :: SetTotVgCThresh + procedure , public :: Init end type soilbiogeochem_nitrogenstate_type - type(soilbiogeochem_nitrogenstate_type), public :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type), public, target :: soilbiogeochem_nitrogenstate_inst character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -82,7 +82,7 @@ module SoilBiogeochemNitrogenStateType contains !------------------------------------------- - subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) + subroutine Init(this, bounds, nch, cncol) ! ! !ARGUMENTS: @@ -90,7 +90,7 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of tiles real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart - type(soilbiogeochem_nitrogenstate_type), intent(inout) :: this + class(soilbiogeochem_nitrogenstate_type) :: this ! ! !LOCAL VARIABLES: integer :: begc,endc @@ -175,7 +175,7 @@ subroutine init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, this) end do !nz end do - end subroutine init_soilbiogeochem_nitrogenstate_type + end subroutine Init !----------------------------------------------------------------------- subroutine Summary(this, bounds, num_allc, filter_allc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index cfd1e3f0e..17e79b7df 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -19,7 +19,7 @@ module SoilBiogeochemStateType ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_soilbiogeochem_state_type + public :: get_spinup_latitude_term ! !PUBLIC TYPES: @@ -40,13 +40,17 @@ module SoilBiogeochemStateType real(r8) , pointer :: som_diffus_coef_col (:,:) ! (m2/s) SOM diffusivity due to bio/cryo-turbation real(r8) , pointer :: plant_ndemand_col (:) ! column-level plant N demand + contains + + procedure, public :: Init + end type soilbiogeochem_state_type - type(soilbiogeochem_state_type), public :: soilbiogeochem_state_inst + type(soilbiogeochem_state_type), public, target :: soilbiogeochem_state_inst contains !--------------------------------------- - subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this, cn5_cold_start, rc) + subroutine Init(this, bounds, nch, cncol, cn5_cold_start, rc) ! ! !ARGUMENTS: @@ -55,7 +59,7 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this, cn5_cold_sta integer, intent(in) :: nch ! number of tiles real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart logical, optional, intent(in) :: cn5_cold_start - type(soilbiogeochem_state_type), intent(inout) :: this + class(soilbiogeochem_state_type) :: this integer, optional, intent(out) :: rc ! ! !LOCAL VARIABLES: @@ -112,7 +116,7 @@ subroutine init_soilbiogeochem_state_type(bounds, nch, cncol, this, cn5_cold_sta end do !nz end do ! nc - end subroutine init_soilbiogeochem_state_type + end subroutine Init !----------------------------------------------- function get_spinup_latitude_term(latitude) result(ans) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index f7306a24f..031afd0a4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -12,7 +12,6 @@ module SoilStateType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_soilstate_type ! type, public :: soilstate_type @@ -73,13 +72,17 @@ module SoilStateType real(r8), pointer :: root_conductance_patch(:,:) ! patch root conductance [mm/s] real(r8), pointer :: soil_conductance_patch(:,:) ! patch soil conductance [mm/s] + contains + + procedure, public :: Init + end type soilstate_type -type(soilstate_type), public :: soilstate_inst +type(soilstate_type), public, target :: soilstate_inst contains !----------------------------------------------------------- - subroutine init_soilstate_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM soil state type needed for calling CTSM routines @@ -90,7 +93,7 @@ subroutine init_soilstate_type(bounds, this) implicit none !INPUT type(bounds_type), intent(in) :: bounds - type(soilstate_type), intent(inout):: this + class(soilstate_type) :: this !LOCAL integer :: begp, endp @@ -153,6 +156,6 @@ subroutine init_soilstate_type(bounds, this) allocate(this%alphasw_col (begc:endc,1:nlevgrnd)) ; this%alphasw_col (:,:) = nan allocate(this%watres_col (begc:endc,1:nlevgrnd)) ; this%watres_col (:,:) = nan - end subroutine init_soilstate_type + end subroutine Init end module SoilStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 index 1ccabca9d..e5fe4ea00 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -12,7 +12,6 @@ module SolarAbsorbedType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_solarabs_type type, public :: solarabs_type @@ -67,13 +66,17 @@ module SolarAbsorbedType real(r8), pointer :: ssre_fsr_nir_i_patch (:) ! snow-free patch reflected diffuse nir solar radiation (W/m**2) real(r8), pointer :: ssre_fsr_nir_d_ln_patch(:) ! snow-free patch reflected direct beam nir solar radiation at local noon (W/m**2) + contains + + procedure, public :: Init + end type solarabs_type - type(solarabs_type), public :: solarabs_inst + type(solarabs_type), public, target :: solarabs_inst contains !------------------------------------------------------ - subroutine init_solarabs_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM solar absorbed type needed for calling CTSM routines @@ -84,7 +87,7 @@ subroutine init_solarabs_type(bounds, this) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(solarabs_type), intent(inout):: this + class(solarabs_type) :: this !LOCAL integer :: begp, endp @@ -141,6 +144,6 @@ subroutine init_solarabs_type(bounds, this) allocate(this%fsds_nir_i_patch (begp:endp)) ; this%fsds_nir_i_patch (:) = nan allocate(this%fsds_nir_d_ln_patch (begp:endp)) ; this%fsds_nir_d_ln_patch (:) = nan - end subroutine init_solarabs_type + end subroutine Init end module SolarAbsorbedType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index 9e40b8241..0caa83d9d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -12,7 +12,6 @@ module SurfaceAlbedoType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_surfalb_type ! type, public :: surfalb_type @@ -63,14 +62,17 @@ module SurfaceAlbedoType real(r8) , pointer :: vcmaxcintsun_patch (:) ! patch leaf to canopy scaling coefficient, sunlit leaf vcmax real(r8) , pointer :: vcmaxcintsha_patch (:) ! patch leaf to canopy scaling coefficient, shaded leaf vcmax + contains + + procedure, public :: Init end type surfalb_type -type(surfalb_type), public :: surfalb_inst +type(surfalb_type), public, target :: surfalb_inst contains !--------------------------------------------------- - subroutine init_surfalb_type(bounds, nch, cncol, cnpft, this) + subroutine Init(this, bounds, nch, cncol, cnpft) ! !DESCRIPTION: ! Initialize CTSM surface albedo needed for calling CTSM routines @@ -84,7 +86,7 @@ subroutine init_surfalb_type(bounds, nch, cncol, cnpft, this) integer, intent(in) :: nch ! number of Catchment tiles real, dimension(nch,num_zon,var_col), intent(in) :: cncol ! column-level restart variable array real, dimension(nch,num_zon,num_veg,var_pft), intent(in) :: cnpft ! pft-level (patch-level) restart variable array - type(surfalb_type), intent(inout):: this + class(surfalb_type) :: this ! LOCAL integer :: begp, endp @@ -160,6 +162,6 @@ subroutine init_surfalb_type(bounds, nch, cncol, cnpft, this) end do ! nz end do ! nc - end subroutine init_surfalb_type + end subroutine Init end module SurfaceAlbedoType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 index 59be25cac..0462801be 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 @@ -12,7 +12,6 @@ module TemperatureType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_temperature_type ! type, public :: temperature_type @@ -115,13 +114,17 @@ module TemperatureType real(r8), pointer :: fact_col (:,:) ! used in computing tridiagonal matrix real(r8), pointer :: c_h2osfc_col (:) ! heat capacity of surface water + contains + + procedure, public :: Init + end type temperature_type -type(temperature_type), public :: temperature_inst +type(temperature_type), public, target :: temperature_inst contains !------------------------------------------------------------------- - subroutine init_temperature_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM temperature (forcing type) needed for calling CTSM routines @@ -235,6 +238,6 @@ subroutine init_temperature_type(bounds, this) allocate(this%fact_col (begc:endc, -nlevsno+1:nlevmaxurbgrnd)) ; this%fact_col (:,:) = nan allocate(this%c_h2osfc_col (begc:endc)) ; this%c_h2osfc_col (:) = nan - end subroutine init_temperature_type + end subroutine Init end module TemperatureType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index 1dbe85cc3..0ba2a262d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -11,7 +11,6 @@ module WaterDiagnosticBulkType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_waterdiagnosticbulk_type ! type, public :: waterdiagnosticbulk_type @@ -58,13 +57,17 @@ module WaterDiagnosticBulkType real(r8), pointer :: qflx_prec_intr_patch (:) ! patch interception of precipitation (mm H2O/s) real(r8), pointer :: qflx_prec_grnd_col (:) ! col water onto ground including canopy runoff (mm H2O/s) + contains + + procedure, public :: Init + end type waterdiagnosticbulk_type -type(waterdiagnosticbulk_type), public :: waterdiagnosticbulk_inst +type(waterdiagnosticbulk_type), public, target :: waterdiagnosticbulk_inst contains !----------------------------------------------- - subroutine init_waterdiagnosticbulk_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM type for water diagnostic variables that just apply to bulk water and are needed for calling CTSM routines @@ -75,7 +78,7 @@ subroutine init_waterdiagnosticbulk_type(bounds, this) implicit none !INPUT type(bounds_type), intent(in) :: bounds - type(waterdiagnosticbulk_type), intent(inout):: this + class(waterdiagnosticbulk_type) :: this !LOCAL integer :: begp, endp @@ -129,6 +132,6 @@ subroutine init_waterdiagnosticbulk_type(bounds, this) allocate(this%qflx_prec_intr_patch (begp:endp)) ; this%qflx_prec_intr_patch (:) = nan allocate(this%qflx_prec_grnd_col (begc:endc)) ; this%qflx_prec_grnd_col (:) = nan - end subroutine init_waterdiagnosticbulk_type + end subroutine Init end module WaterDiagnosticBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 index b38d07c16..5e10746e1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -45,13 +45,17 @@ module WaterFluxBulkType ! ET accumulation real(r8), pointer :: AnnEt (:) ! Annual average ET flux mmH20/s + contains + + procedure , public :: Init + end type waterfluxbulk_type type(waterfluxbulk_type), public, target, save :: waterfluxbulk_inst contains !--------------------------------------------- - subroutine init_waterfluxbulk_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM type for water flux bulk variables that just apply to bulk water and are needed for calling CTSM routines @@ -62,7 +66,7 @@ subroutine init_waterfluxbulk_type(bounds, this) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(waterfluxbulk_type), intent(inout):: this + class(waterfluxbulk_type) :: this !LOCAL integer :: begp, endp @@ -103,5 +107,5 @@ subroutine init_waterfluxbulk_type(bounds, this) allocate(this%qflx_deficit_col (begc:endc)) ; this%qflx_deficit_col (:) = nan allocate(this%AnnET (begc:endc)) ; this%AnnET (:) = nan - end subroutine init_waterfluxbulk_type + end subroutine Init end module WaterFluxBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index 61254157b..4cfc04829 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -14,7 +14,6 @@ module WaterFluxType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_waterflux_type ! type, public :: waterflux_type @@ -102,13 +101,17 @@ module WaterFluxType type(annual_flux_dribbler_type) :: qflx_liq_dynbal_dribbler type(annual_flux_dribbler_type) :: qflx_ice_dynbal_dribbler + contains + + procedure, public :: Init + end type waterflux_type - type(waterflux_type), public :: waterflux_inst + type(waterflux_type), public, target :: waterflux_inst contains !--------------------------------------------- - subroutine init_waterflux_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM type for water flux variables that just apply to bulk water and are needed for calling CTSM routines @@ -119,7 +122,7 @@ subroutine init_waterflux_type(bounds, this) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(waterflux_type), intent(inout):: this + class(waterflux_type) :: this !LOCAL integer :: begp, endp @@ -220,6 +223,6 @@ subroutine init_waterflux_type(bounds, this) this%qflx_irrig_drip_patch(begp:endp) = spval this%qflx_irrig_sprinkler_patch(begp:endp) = spval - end subroutine init_waterflux_type + end subroutine Init end module WaterFluxType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 index 280e268af..39648a283 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 @@ -22,7 +22,6 @@ module WaterStateBulkType private ! !PUBLIC MEMBER FUNCTIONS: - public :: init_waterstatebulk_type ! ! !PUBLIC TYPES: type, extends(waterstate_type), public :: waterstatebulk_type @@ -30,19 +29,23 @@ module WaterStateBulkType real(r8), pointer :: snow_persistence_col (:) ! col length of time that ground has had non-zero snow thickness (sec) real(r8), pointer :: int_snow_col (:) ! col integrated snowfall (mm H2O) + contains + + procedure , public :: Init + end type waterstatebulk_type - type(waterstatebulk_type), public :: waterstatebulk_inst + type(waterstatebulk_type), public, target :: waterstatebulk_inst contains !--------------------------------------------- - subroutine init_waterstatebulk_type(bounds, this) + subroutine Init(this, bounds) ! !ARGUMENTS: implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(waterstatebulk_type), intent(inout):: this + class(waterstatebulk_type) :: this !LOCAL integer :: begp, endp @@ -59,6 +62,6 @@ subroutine init_waterstatebulk_type(bounds, this) allocate(this%snow_persistence_col (begc:endc)) ; this%snow_persistence_col (:) = nan allocate(this%int_snow_col (begc:endc)) ; this%int_snow_col (:) = nan - end subroutine init_waterstatebulk_type + end subroutine Init end module WaterStateBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 index aa25fd4d7..67ad563ce 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 @@ -23,7 +23,6 @@ module WaterStateType private ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_waterstate_type ! ! !PUBLIC TYPES: @@ -48,19 +47,23 @@ module WaterStateType real(r8) :: aquifer_water_baseline ! baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) + contains + + procedure , public :: Init + end type waterstate_type - type(waterstate_type), public :: waterstate_inst + type(waterstate_type), public, target :: waterstate_inst contains !--------------------------------------------- - subroutine init_waterstate_type(bounds, this) + subroutine Init(this, bounds) ! !ARGUMENTS: implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - type(waterstate_type), intent(inout):: this + class(waterstate_type) :: this !LOCAL integer :: begp, endp @@ -88,5 +91,5 @@ subroutine init_waterstate_type(bounds, this) allocate( this%dynbal_baseline_liq_col (begc:endc)); this%dynbal_baseline_liq_col(begc:endc) = nan allocate( this%dynbal_baseline_ice_col (begc:endc)); this%dynbal_baseline_ice_col(begc:endc) = nan - end subroutine init_waterstate_type + end subroutine Init end module WaterStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 index 819beb4d0..9dcc8f4c2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 @@ -23,7 +23,6 @@ module Wateratm2lndBulkType private ! !PUBLIC MEMBER FUNCTIONS: - public :: init_wateratm2lndbulk_type ! ! !PUBLIC TYPES: type, extends(wateratm2lnd_type), public :: wateratm2lndbulk_type @@ -38,12 +37,16 @@ module Wateratm2lndBulkType real(r8) , pointer :: prec24_patch (:) ! patch 24-hour running mean of tot. precipitation (mm/s) real(r8) , pointer :: rh24_patch (:) ! patch 24-hour running mean of relative humidity + contains + + procedure, public :: Init + end type wateratm2lndbulk_type contains !------------------------------------------------------------------------ - subroutine init_wateratm2lndbulk_type(bounds, this) + subroutine Init(this, bounds) ! ! !DESCRIPTION: ! Initialize module data structure @@ -53,7 +56,7 @@ subroutine init_wateratm2lndbulk_type(bounds, this) ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds - type(wateratm2lndbulk_type), intent(inout) :: this + class(wateratm2lndbulk_type) :: this ! ! !LOCAL VARIABLES: @@ -80,5 +83,5 @@ subroutine init_wateratm2lndbulk_type(bounds, this) end if - end subroutine init_wateratm2lndbulk_type + end subroutine Init end module Wateratm2lndBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 index 8281e2efd..ccb9ed14d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 @@ -16,7 +16,6 @@ module Wateratm2lndType private ! !PUBLIC MEMBER FUNCTIONS: - public :: init_wateratm2lnd_type ! ! !PUBLIC TYPES: type, public :: wateratm2lnd_type @@ -32,14 +31,17 @@ module Wateratm2lndType real(r8), pointer :: rain_to_snow_conversion_col (:) ! amount of rain converted to snow via precipitation repartitioning (mm/s) real(r8), pointer :: snow_to_rain_conversion_col (:) ! amount of snow converted to rain via precipitation repartitioning (mm/s) + contains + + procedure, public :: Init end type wateratm2lnd_type - type(wateratm2lnd_type), public :: wateratm2lnd_inst + type(wateratm2lnd_type), public, target :: wateratm2lnd_inst contains !------------------------------------------------------------------------ - subroutine init_wateratm2lnd_type(bounds,this) + subroutine Init(this, bounds) ! ! !DESCRIPTION: ! @@ -48,7 +50,7 @@ subroutine init_wateratm2lnd_type(bounds,this) ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds - type(wateratm2lnd_type), intent(inout) :: this + class(wateratm2lnd_type) :: this ! ! !LOCAL VARIABLES: integer :: begc, endc @@ -75,5 +77,5 @@ subroutine init_wateratm2lnd_type(bounds,this) this%forc_rain_downscaled_col(begc:endc) = spval this%forc_snow_downscaled_col(begc:endc) = spval - end subroutine init_wateratm2lnd_type + end subroutine Init end module Wateratm2lndType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 index 3dc851f6a..f6b07a8f2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 @@ -11,7 +11,6 @@ module atm2lndType save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_atm2lnd_type ! type, public :: atm2lnd_type @@ -62,13 +61,17 @@ module atm2lndType real(r8) , pointer :: t_mo_patch (:) => null() ! patch 30-day average temperature (Kelvin) real(r8) , pointer :: t_mo_min_patch (:) => null() ! patch annual min of t_mo (Kelvin) + contains + + procedure, public :: Init + end type atm2lnd_type -type(atm2lnd_type), public :: atm2lnd_inst +type(atm2lnd_type), public, target :: atm2lnd_inst contains !--------------------------------------------------------------------- - subroutine init_atm2lnd_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM atmosphere2land (forcing type) needed for calling CTSM routines @@ -78,7 +81,7 @@ subroutine init_atm2lnd_type(bounds, this) ! !ARGUMENTS: implicit none type(bounds_type), intent(in) :: bounds - type(atm2lnd_type), intent(inout):: this + class(atm2lnd_type) :: this ! LOCAL: real(r8) :: ival = 0.0_r8 ! initial value @@ -140,6 +143,6 @@ subroutine init_atm2lnd_type(bounds, this) allocate(this%t_mo_patch (begp:endp)) ; this%t_mo_patch (:) = nan allocate(this%t_mo_min_patch (begp:endp)) ; this%t_mo_min_patch (:) = nan ! - end subroutine init_atm2lnd_type + end subroutine Init end module atm2lndType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 index 5ad3358cd..2255e003d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 @@ -11,7 +11,6 @@ module ch4Mod save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: init_ch4_type type, public :: ch4_type real(r8), pointer, private :: ch4_prod_depth_sat_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) @@ -105,14 +104,18 @@ module ch4Mod real(r8), pointer, public :: grnd_ch4_cond_col (:) ! col tracer conductance for boundary layer [m/s] ! type(ch4finundatedstream_type), private :: ch4findstream ! ch4 finundated stream data + contains + + procedure , public :: Init + end type ch4_type -type(ch4_type), public :: ch4_inst +type(ch4_type), public, target :: ch4_inst contains !----------------------------------------------------- - subroutine init_ch4_type(bounds, this) + subroutine Init(this, bounds) ! !DESCRIPTION: ! Initialize CTSM CH4 type; dummy for now, since we have use_lch4 set to .false. @@ -122,7 +125,7 @@ subroutine init_ch4_type(bounds, this) ! INPUT type(bounds_type), intent(in) :: bounds - type(ch4_type), intent(inout):: this + class(ch4_type) :: this ! LOCAL integer :: begp, endp @@ -217,6 +220,6 @@ subroutine init_ch4_type(bounds, this) allocate(this%grnd_ch4_cond_col (begc:endc)) ; this%grnd_ch4_cond_col (:) = nan - end subroutine init_ch4_type + end subroutine Init end module ch4Mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 904d7ca7c..822a5f2d2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -109,44 +109,46 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) !LOCAL - type(bounds_type) :: bounds - !type(patch_type) :: patch - !type(column_type) :: col - !type(landunit_type) :: lun - type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst - type(atm2lnd_type) :: atm2lnd_inst - type(temperature_type) :: temperature_inst - type(soilstate_type) :: soilstate_inst - type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst - type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst - type(wateratm2lnd_type) :: wateratm2lnd_inst - !type(canopystate_type) :: canopystate_inst - type(solarabs_type) :: solarabs_inst - type(surfalb_type) :: surfalb_inst - type(ozone_base_type) :: ozone_inst -! type(pftcon_type) :: pftcon - type(waterflux_type) :: waterflux_inst - type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst - type(cn_products_type) :: c_products_inst - type(cn_products_type) :: n_products_inst - type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst - type(cnveg_state_type) :: cnveg_state_inst - type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst - type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst - !type(gridcell_type) :: grc - type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst - type(ch4_type) :: ch4_inst - type(crop_type) :: crop_inst - type(dgvs_type) :: dgvs_inst - type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst - type(energyflux_type) :: energyflux_inst - type(waterstatebulk_type) :: waterstatebulk_inst - type(waterstate_type) :: waterstate_inst - type(frictionvel_type) :: frictionvel_inst - type(cn_vegetation_type) :: bgc_vegetation_inst +! type(bounds_type) :: bounds +! !type(patch_type) :: patch +! !type(column_type) :: col +! !type(landunit_type) :: lun +! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst +! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst +! type(atm2lnd_type) :: atm2lnd_inst +! type(temperature_type) :: temperature_inst +! type(soilstate_type) :: soilstate_inst +! type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst +! type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst +! type(wateratm2lnd_type) :: wateratm2lnd_inst +! !type(canopystate_type) :: canopystate_inst +! type(solarabs_type) :: solarabs_inst +! type(surfalb_type) :: surfalb_inst +! type(ozone_base_type) :: ozone_inst +!! type(pftcon_type) :: pftcon +! type(waterflux_type) :: waterflux_inst +! type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst +! type(cn_products_type) :: c_products_inst +! type(cn_products_type) :: n_products_inst +! type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst +! type(cnveg_state_type) :: cnveg_state_inst +! type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst +! type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst +! !type(gridcell_type) :: grc +! type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst +! type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst +! type(ch4_type) :: ch4_inst +! type(crop_type) :: crop_inst +! type(dgvs_type) :: dgvs_inst +! type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst +! type(energyflux_type) :: energyflux_inst +! type(waterstatebulk_type) :: waterstatebulk_inst +! type(waterstate_type) :: waterstate_inst +! type(frictionvel_type) :: frictionvel_inst +! type(cn_vegetation_type) :: bgc_vegetation_inst + + type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst character(300) :: paramfile character(300) :: NLFilename @@ -200,77 +202,73 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) ! initialize states and fluxes - call init_cnveg_nitrogenstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenstate_inst) + call cnveg_nitrogenstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) - call init_cnveg_carbonstate_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonstate_inst) + call cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) - call init_atm2lnd_type (bounds, atm2lnd_inst) + call atm2lnd_inst%Init (bounds) - call init_temperature_type (bounds, temperature_inst) + call temperature_inst%Init (bounds) - call init_soilstate_type (bounds, soilstate_inst) + call soilstate_inst%Init (bounds) - call init_waterdiagnosticbulk_type (bounds, waterdiagnosticbulk_inst) + call waterdiagnosticbulk_inst%Init (bounds) - call init_wateratm2lndbulk_type (bounds, wateratm2lndbulk_inst) + call wateratm2lndbulk_inst%Init (bounds) - call init_wateratm2lnd_type (bounds, wateratm2lnd_inst) + call wateratm2lnd_inst%Init (bounds) call canopystate_inst%init_canopystate_type (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) - call init_solarabs_type (bounds, solarabs_inst) + call solarabs_inst%Init (bounds) - call init_surfalb_type (bounds, nch, cncol, cnpft, surfalb_inst) + call surfalb_inst%Init (bounds, nch, cncol, cnpft) - call init_ozone_base_type (bounds, ozone_inst) + call ozone_base_inst%Init (bounds) call photosyns_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) call pftcon%init_pftcon_type () - call init_waterflux_type (bounds, waterflux_inst) + call waterflux_inst%Init (bounds) - call init_soilbiogeochem_carbonstate_type(bounds, nch, cncol, soilbiogeochem_carbonstate_inst) + call soilbiogeochem_carbonstate_inst%Init(bounds, nch, cncol) - call init_soilbiogeochem_nitrogenstate_type(bounds, nch, cncol, soilbiogeochem_nitrogenstate_inst) + call soilbiogeochem_nitrogenstate_inst%Init(bounds, nch, cncol) - call init_cn_products_type (bounds, nch, cncol, 'C', c_products_inst) + call soilbiogeochem_state_inst%Init (bounds, nch, cncol) - call init_cn_products_type (bounds, nch, cncol, 'N', n_products_inst) + call cnveg_state_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) - call init_soilbiogeochem_state_type (bounds, nch, cncol, soilbiogeochem_state_inst) - - call init_cnveg_state_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_state_inst) - - call init_cnveg_carbonflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_carbonflux_inst, cn5_cold_start) + call cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) - call init_cnveg_nitrogenflux_type (bounds, nch, ityp, fveg, cncol, cnpft, cnveg_nitrogenflux_inst) + call cnveg_nitrogenflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) - call init_waterfluxbulk_type (bounds, waterfluxbulk_inst) + call waterfluxbulk_inst%Init (bounds) - call init_soilbiogeochem_carbonflux_type(bounds,soilbiogeochem_carbonflux_inst) + call soilbiogeochem_carbonflux_inst%Init (bounds) - call init_soilbiogeochem_nitrogenflux_type(bounds,soilbiogeochem_nitrogenflux_inst) + call soilbiogeochem_nitrogenflux_inst%Init(bounds) - call init_ch4_type (bounds, ch4_inst) + call ch4_inst%Init (bounds) call init_decomp_cascade_constants (use_century_decomp) - call init_active_layer_type (bounds, active_layer_inst) + call active_layer_inst%Init (bounds) - call init_crop_type (bounds, crop_inst) + call crop_inst%Init (bounds) - call init_dgvs_type (bounds, dgvs_inst) + call dgvs_inst%Init (bounds) - call init_saturated_excess_runoff_type(bounds, saturated_excess_runoff_inst) + call saturated_excess_runoff_inst%Init(bounds) - call init_energyflux_type (bounds, energyflux_inst) + call energyflux_inst%Init (bounds) - call init_waterstatebulk_type (bounds, waterstatebulk_inst) + call waterstatebulk_inst%Init (bounds) - call init_waterstate_type (bounds, waterstate_inst) + call waterstate_inst%Init (bounds) - call init_frictionvel_type (bounds, frictionvel_inst) + call frictionvel_inst%Init (bounds) ! calls to original CTSM initialization routines @@ -324,6 +322,11 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call ncid%close(rc=status) call bgc_vegetation_inst%cnfire_method%FireInit(bounds) + + call bgc_vegetation_inst%c_products_inst%Init (bounds, nch, cncol, 'C') + + call bgc_vegetation_inst%n_products_inst%Init (bounds, nch, cncol, 'N') + ! call FireMethodInit(bounds,paramfile) if (use_century_decomp) then From 222bd169e19769d13ca82a9530dcd2e86b8d833e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 Feb 2023 09:19:25 -0500 Subject: [PATCH 362/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 index 0462801be..8516d164e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 @@ -134,7 +134,7 @@ subroutine Init(this, bounds) ! !ARGUMENTS: implicit none type(bounds_type), intent(in) :: bounds - type(temperature_type), intent(inout):: this + class(temperature_type) :: this ! LOCAL integer :: begp, endp From f141d7b1ce000dbfd30e69adcd7a42b430314388 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 Feb 2023 09:32:48 -0500 Subject: [PATCH 363/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 822a5f2d2..bd8b393b2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -146,7 +146,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) ! type(waterstatebulk_type) :: waterstatebulk_inst ! type(waterstate_type) :: waterstate_inst ! type(frictionvel_type) :: frictionvel_inst -! type(cn_vegetation_type) :: bgc_vegetation_inst + type(cn_vegetation_type) :: bgc_vegetation_inst type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst From eb98c93a0c193ae3cca23d76ae4a609ca5e20850 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 Feb 2023 10:02:54 -0500 Subject: [PATCH 364/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index bd8b393b2..e2a69e5c6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -124,7 +124,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) ! !type(canopystate_type) :: canopystate_inst ! type(solarabs_type) :: solarabs_inst ! type(surfalb_type) :: surfalb_inst -! type(ozone_base_type) :: ozone_inst + type(ozone_base_type) :: ozone_inst !! type(pftcon_type) :: pftcon ! type(waterflux_type) :: waterflux_inst ! type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst From 4cee8a8f4c933450b9d82bd229955e695c8b1dfd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 Feb 2023 10:17:20 -0500 Subject: [PATCH 365/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index e2a69e5c6..38b76ff5f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -84,6 +84,8 @@ module CN_initMod type(photosyns_type), public :: photosyns_inst class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method class(fire_method_type), allocatable :: cnfire_method + type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst + type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst ! !PUBLIC MEMBER FUNCTIONS: public :: CN_init @@ -124,7 +126,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) ! !type(canopystate_type) :: canopystate_inst ! type(solarabs_type) :: solarabs_inst ! type(surfalb_type) :: surfalb_inst - type(ozone_base_type) :: ozone_inst + ! type(ozone_base_type) :: ozone_inst !! type(pftcon_type) :: pftcon ! type(waterflux_type) :: waterflux_inst ! type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst @@ -224,7 +226,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call surfalb_inst%Init (bounds, nch, cncol, cnpft) - call ozone_base_inst%Init (bounds) + call ozone_inst%Init (bounds) call photosyns_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) From 4dd5188fce1da0b7907743ad3cb02b8d936b202e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 Feb 2023 10:25:25 -0500 Subject: [PATCH 366/589] remove duplicate statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 38b76ff5f..42c7763d1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -150,8 +150,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) ! type(frictionvel_type) :: frictionvel_inst type(cn_vegetation_type) :: bgc_vegetation_inst - type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst - character(300) :: paramfile character(300) :: NLFilename type(Netcdf4_fileformatter) :: ncid From 84f21284aafd6c20a1e7b767ff5be2cb97a658b9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 09:14:20 -0500 Subject: [PATCH 367/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 42c7763d1..c28999d09 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -10,7 +10,7 @@ module CN_initMod use clm_time_manager , only: get_step_size use decompMod use filterMod - use CNVegNitrogenStateType + use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type use CNVegCarbonStateType use atm2lndType use TemperatureType @@ -336,7 +336,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call init_decompcascade_cn(bounds, soilbiogeochem_state_inst) end if - end subroutine CN_init + end subroutine CN_init end module CN_initMod From 90422a4be6ca145c22e8954ef49c7945a5133b57 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 09:36:08 -0500 Subject: [PATCH 368/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index c28999d09..061d6f370 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -115,7 +115,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) ! !type(patch_type) :: patch ! !type(column_type) :: col ! !type(landunit_type) :: lun -! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst ! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst ! type(atm2lnd_type) :: atm2lnd_inst ! type(temperature_type) :: temperature_inst @@ -202,7 +202,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) ! initialize states and fluxes - call cnveg_nitrogenstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + call cnveg_nitrogenstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) call cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) From 2ff9b61c0423800c7eb2b37de25afc257d77d242 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 10:06:03 -0500 Subject: [PATCH 369/589] revise initialization --- .../CLM51/CNCLM_ColumnType.F90 | 6 +- .../CLM51/CNCLM_GridcellType.F90 | 6 +- .../CLM51/CNCLM_LandunitType.F90 | 6 +- .../CLM51/CNCLM_PatchType.F90 | 6 +- .../CLM51/CNCLM_decompMod.F90 | 12 +- .../CLM51/CN_init_mod.F90 | 162 +++++++++--------- 6 files changed, 101 insertions(+), 97 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index 3d364190d..2d8c7087c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -84,7 +84,7 @@ module ColumnType contains - procedure, public :: init_column_type + procedure, public :: Init end type column_type type(column_type), public, target :: col @@ -92,7 +92,7 @@ module ColumnType contains !----------------------------------------------------- - subroutine init_column_type(this, bounds,nch) + subroutine Init(this, bounds,nch) ! !ARGUMENTS: implicit none @@ -171,5 +171,5 @@ subroutine init_column_type(this, bounds,nch) end do ! nz end do ! nc - end subroutine init_column_type + end subroutine Init end module ColumnType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index 6d8c0c4f5..606a95d8a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -39,7 +39,7 @@ module GridcellType contains - procedure, public :: init_gridcell_type + procedure, public :: Init end type gridcell_type type(gridcell_type), public, target :: grc @@ -47,7 +47,7 @@ module GridcellType contains !----------------------------------------------- - subroutine init_gridcell_type(this, bounds, nch, cnpft, lats, lons) + subroutine Init(this, bounds, nch, cnpft, lats, lons) ! !DESCRIPTION: ! Initialize CTSM gridcell type needed for calling CTSM routines @@ -102,5 +102,5 @@ subroutine init_gridcell_type(this, bounds, nch, cnpft, lats, lons) this%prev_dayl(nc) = this%dayl(nc) ! following previous Catchment-CN versions, daylength of previous day is initialized as daylength of current day; changed for subsequent time steps in CN_DriverMod end do ! nc - end subroutine init_gridcell_type + end subroutine Init end module GridcellType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 index efd5565ae..e020e7f1d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_LandunitType.F90 @@ -59,7 +59,7 @@ module LandunitType contains - procedure, public :: init_landunit_type + procedure, public :: Init end type landunit_type ! Singleton instance of the landunitType @@ -69,7 +69,7 @@ module LandunitType contains !------------------------------------------------------------------------ - subroutine init_landunit_type(this, bounds, nch) + subroutine Init(this, bounds, nch) !----------------------------------------------------------------------- ! !DESCRIPTION: ! Allocate memory and initialize to signalling NaN to require @@ -124,6 +124,6 @@ subroutine init_landunit_type(this, bounds, nch) this%itype(nc) = 1 ! set land unit type so bare or vegetated soil everywhere end do - end subroutine init_landunit_type + end subroutine Init end module LandunitType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 7333d4069..da75b80e9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -66,7 +66,7 @@ module PatchType contains - procedure, public :: init_patch_type + procedure, public :: Init end type patch_type type(patch_type), public, target :: patch @@ -74,7 +74,7 @@ module PatchType contains !---------------------------------------------------- - subroutine init_patch_type(this, bounds, nch, ityp, fveg) + subroutine Init(this, bounds, nch, ityp, fveg) ! !ARGUMENTS: implicit none @@ -142,5 +142,5 @@ subroutine init_patch_type(this, bounds, nch, ityp, fveg) end do ! p end do ! nz end do ! nc - end subroutine init_patch_type + end subroutine Init end module PatchType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 index 21ed463c2..21cf36a43 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 @@ -19,7 +19,6 @@ module decompMod public get_beg ! get beg bound for a given subgrid level public get_end ! get end bound for a given subgrid level - public :: init_bounds type bounds_type integer :: begg, endg ! beginning and ending gridcell index @@ -30,20 +29,25 @@ module decompMod integer :: level ! whether defined on the proc or clump level integer :: clump_index ! if defined on the clump level, this gives the clump index + + contains + + procedure, public :: Init + end type bounds_type type(bounds_type), public :: bounds contains !---------------------------------------------------- - subroutine init_bounds(nch, this) + subroutine Init(this, nch) ! !ARGUMENTS: implicit none ! INPUT: integer, intent(in) :: nch ! number of Catchment tiles - type(bounds_type), intent(inout) :: this + class(bounds_type) :: this !---------------------------------- this%begg = 1 ; this%endg = nch @@ -51,7 +55,7 @@ subroutine init_bounds(nch, this) this%begc = 1 ; this%endc = nch*NUM_ZON this%begp = 1 ; this%endp = nch*NUM_ZON*(numpft+1) - end subroutine init_bounds + end subroutine Init !----------------------------------------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 061d6f370..bf2a4217c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -7,52 +7,52 @@ module CN_initMod use clm_varcon , only : clm_varcon_init use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init use clm_varctl , only : use_century_decomp, init_clm_varctl - use clm_time_manager , only: get_step_size - use decompMod + use clm_time_manager , only : get_step_size + use decompMod , only : bounds_type use filterMod use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type - use CNVegCarbonStateType - use atm2lndType - use TemperatureType - use SoilStateType - use WaterDiagnosticBulkType - use CanopyStateType - use SolarAbsorbedType - use SurfaceAlbedoType - use OzoneBaseMod - use pftconMod , only : pftcon - use WaterFluxType - use SoilBiogeochemCarbonStateType - use SoilBiogeochemNitrogenStateType - use CNProductsMod - use SoilBiogeochemStateType - use CNVegStateType - use CNVegCarbonFluxType - use CNVegNitrogenFluxType - use GridcellType , only : grc - use WaterFluxBulkType - use SoilBiogeochemCarbonFluxType - use SoilBiogeochemNitrogenFluxType - use PatchType , only : patch - use ColumnType , only : col - use ch4Mod - use SoilBiogeochemDecompCascadeConType - use ActiveLayerMod - use CropType - use CNDVType - use LandunitType , only : lun + use CNVegCarbonStateType, only : cnveg_carbonstate_type + use atm2lndType, only : atm2lnd_type + use TemperatureType, only : temperature_type + use SoilStateType, only : soilstate_type + use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type + use CanopyStateType, only : canopystate_type + use SolarAbsorbedType, only : solarabs_type + use SurfaceAlbedoType, only : surfalb_type + use OzoneBaseMod, only : ozone_base_type + use pftconMod , only : pftcon + use WaterFluxType, only : waterflux_type + use SoilBiogeochemCarbonStateType, only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use CNProductsMod, only : cn_products_type + use SoilBiogeochemStateType, only : soilbiogeochem_state_type + use CNVegStateType, only : cnveg_state_type + use CNVegCarbonFluxType, only : cnveg_carbonflux_type + use CNVegNitrogenFluxType, only : cnveg_nitrogenflux_type + use GridcellType , only : grc + use WaterFluxBulkType, only : waterfluxbulk_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type + use PatchType , only : patch + use ColumnType , only : col + use ch4Mod, only : ch4_type + use SoilBiogeochemDecompCascadeConType, only : decomp_cascade_type, init_decomp_cascade_constants + use ActiveLayerMod, only : active_layer_type + use CropType, only : crop_type + use CNDVType, only : dgvs_type + use LandunitType , only : lun use RootBiophysMod use CNMRespMod , only : readCNMRespParams => readParams use CNSharedParamsMod , only : CNParamsReadShared use spmdMod - use Wateratm2lndBulkType - use WaterDiagnosticBulkType - use Wateratm2lndType - use EnergyFluxType - use SaturatedExcessRunoffMod - use WaterStateBulkType - use WaterStateType - use FrictionVelocityMod + use Wateratm2lndBulkType, only : wateratm2lndbulk_type + use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type + use Wateratm2lndType, only : wateratm2lnd_type + use EnergyFluxType, only : energyflux_type + use SaturatedExcessRunoffMod, only : saturated_excess_runoff_type + use WaterStateBulkType, only : waterstatebulk_type + use WaterStateType, only : waterstate_type + use FrictionVelocityMod, only : frictionvel_type use PhotosynthesisMod use CNVegetationFacade, only : cn_vegetation_type use initSubgridMod @@ -111,43 +111,43 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) !LOCAL -! type(bounds_type) :: bounds -! !type(patch_type) :: patch -! !type(column_type) :: col -! !type(landunit_type) :: lun + type(bounds_type) :: bounds + type(patch_type) :: patch + type(column_type) :: col + type(landunit_type) :: lun type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst -! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst -! type(atm2lnd_type) :: atm2lnd_inst -! type(temperature_type) :: temperature_inst -! type(soilstate_type) :: soilstate_inst -! type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst -! type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst -! type(wateratm2lnd_type) :: wateratm2lnd_inst -! !type(canopystate_type) :: canopystate_inst -! type(solarabs_type) :: solarabs_inst -! type(surfalb_type) :: surfalb_inst - ! type(ozone_base_type) :: ozone_inst -!! type(pftcon_type) :: pftcon -! type(waterflux_type) :: waterflux_inst -! type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst -! type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst -! type(cn_products_type) :: c_products_inst -! type(cn_products_type) :: n_products_inst -! type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst -! type(cnveg_state_type) :: cnveg_state_inst -! type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst -! type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst -! !type(gridcell_type) :: grc -! type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst -! type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst -! type(ch4_type) :: ch4_inst -! type(crop_type) :: crop_inst -! type(dgvs_type) :: dgvs_inst -! type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst -! type(energyflux_type) :: energyflux_inst -! type(waterstatebulk_type) :: waterstatebulk_inst -! type(waterstate_type) :: waterstate_inst -! type(frictionvel_type) :: frictionvel_inst + type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst + type(atm2lnd_type) :: atm2lnd_inst + type(temperature_type) :: temperature_inst + type(soilstate_type) :: soilstate_inst + type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst + type(wateratm2lnd_type) :: wateratm2lnd_inst + type(canopystate_type) :: canopystate_inst + type(solarabs_type) :: solarabs_inst + type(surfalb_type) :: surfalb_inst + type(ozone_base_type) :: ozone_inst + type(pftcon_type) :: pftcon + type(waterflux_type) :: waterflux_inst + type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst + type(cn_products_type) :: c_products_inst + type(cn_products_type) :: n_products_inst + type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst + type(cnveg_state_type) :: cnveg_state_inst + type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst + type(gridcell_type) :: grc + type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst + type(ch4_type) :: ch4_inst + type(crop_type) :: crop_inst + type(dgvs_type) :: dgvs_inst + type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst + type(energyflux_type) :: energyflux_inst + type(waterstatebulk_type) :: waterstatebulk_inst + type(waterstate_type) :: waterstate_inst + type(frictionvel_type) :: frictionvel_inst type(cn_vegetation_type) :: bgc_vegetation_inst character(300) :: paramfile @@ -173,17 +173,17 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call init_clm_varctl() - call init_bounds (nch, bounds) + call bounds%Init (nch) ! initialize subrgid types - call patch%init_patch_type (bounds, nch, ityp, fveg) + call patch%Init (bounds, nch, ityp, fveg) - call col%init_column_type (bounds, nch) + call col%Init (bounds, nch) - call lun%init_landunit_type (bounds, nch) + call lun%Init (bounds, nch) - call grc%init_gridcell_type (bounds, nch, cnpft, lats, lons) + call grc%Init (bounds, nch, cnpft, lats, lons) ! create subgrid structure From aa0d8016da2763db3c5c1b73dbccbcbabe33c5c3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 10:27:36 -0500 Subject: [PATCH 370/589] bug fix --- .../CLM51/CNCLM_WaterFluxBulkType.F90 | 3 +-- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 9 +++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 index 5e10746e1..400afbff1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -26,8 +26,7 @@ module WaterFluxBulkType real(r8), pointer :: qflx_ev_h2osfc_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm] real(r8), pointer :: qflx_ev_h2osfc_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm] - real(r8), pointer :: qflx_adv_col (:,:) ! col advective flux across different soil layer interfaces [mm H2O/s] [+ downward] - real(r8), pointer :: qflx_rootsoi_col (:,:) ! col root and soil water exchange [mm H2O/s] [+ into root] + real(r8), pointer :: qflx_hydr_redist_patch (:) ! patch hydraulic redistribution [mm H2O/s] real(r8), pointer :: qflx_sat_excess_surf_col (:) ! col surface runoff due to saturated surface (mm H2O /s) real(r8), pointer :: qflx_infl_excess_col (:) ! col infiltration excess runoff (mm H2O /s) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index bf2a4217c..3a588bd7c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -112,9 +112,9 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) !LOCAL type(bounds_type) :: bounds - type(patch_type) :: patch - type(column_type) :: col - type(landunit_type) :: lun +! type(patch_type) :: patch +! type(column_type) :: col +! type(landunit_type) :: lun type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(atm2lnd_type) :: atm2lnd_inst @@ -127,7 +127,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) type(solarabs_type) :: solarabs_inst type(surfalb_type) :: surfalb_inst type(ozone_base_type) :: ozone_inst - type(pftcon_type) :: pftcon +! type(pftcon_type) :: pftcon type(waterflux_type) :: waterflux_inst type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst @@ -149,6 +149,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) type(waterstate_type) :: waterstate_inst type(frictionvel_type) :: frictionvel_inst type(cn_vegetation_type) :: bgc_vegetation_inst + type(waterfluxbulk_type) :: waterfluxbulk_inst character(300) :: paramfile character(300) :: NLFilename From 5478bc35a74cd2406dca8fb74cdbd85c58b57d25 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 10:45:08 -0500 Subject: [PATCH 371/589] add missing variables --- .../CLM51/CNCLM_WaterFluxBulkType.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 index 400afbff1..5e10746e1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -26,7 +26,8 @@ module WaterFluxBulkType real(r8), pointer :: qflx_ev_h2osfc_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm] real(r8), pointer :: qflx_ev_h2osfc_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm] - + real(r8), pointer :: qflx_adv_col (:,:) ! col advective flux across different soil layer interfaces [mm H2O/s] [+ downward] + real(r8), pointer :: qflx_rootsoi_col (:,:) ! col root and soil water exchange [mm H2O/s] [+ into root] real(r8), pointer :: qflx_hydr_redist_patch (:) ! patch hydraulic redistribution [mm H2O/s] real(r8), pointer :: qflx_sat_excess_surf_col (:) ! col surface runoff due to saturated surface (mm H2O /s) real(r8), pointer :: qflx_infl_excess_col (:) ! col infiltration excess runoff (mm H2O /s) From 4e7454ee75e61240dd12d9df4fccae7c8830dbce Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 11:07:43 -0500 Subject: [PATCH 372/589] correct ncid%open statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 3a588bd7c..60cb0fb70 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -137,7 +137,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) type(cnveg_state_type) :: cnveg_state_inst type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst - type(gridcell_type) :: grc + !type(gridcell_type) :: grc type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst type(ch4_type) :: ch4_inst @@ -150,6 +150,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) type(frictionvel_type) :: frictionvel_inst type(cn_vegetation_type) :: bgc_vegetation_inst type(waterfluxbulk_type) :: waterfluxbulk_inst + type(active_layer_type) :: active_layer_inst character(300) :: paramfile character(300) :: NLFilename @@ -295,7 +296,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' - call ncid%open(trim(paramfile),pFIO_READ, __RC__) + call ncid%open(trim(paramfile),pFIO_READ, RC=status) call readCNMRespParams(ncid) call CNParamsReadShared(ncid) ! this is called CN params but really is for the soil biogeochem parameters @@ -318,7 +319,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call bgc_vegetation_inst%cn_balance_inst%Init (bounds) call create_cnfire_method( bgc_vegetation_inst%cnfire_method) - call ncid%open(trim(paramfile),pFIO_READ, __RC__) + call ncid%open(trim(paramfile),pFIO_READ, RC=status) call bgc_vegetation_inst%cnfire_method%CNFireReadParams( ncid ) call ncid%close(rc=status) From 90867e0026657629d038a3176653c22d9f466c67 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 13:07:40 -0500 Subject: [PATCH 373/589] change function name to match naming convention --- .../CLM51/CNCLM_CanopyStateType.F90 | 6 +++--- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 97d6e7120..e0607e926 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -55,7 +55,7 @@ module CanopyStateType contains - procedure, public :: init_canopystate_type + procedure, public :: Init end type canopystate_type type(canopystate_type), public, target :: canopystate_inst @@ -63,7 +63,7 @@ module CanopyStateType contains !-------------------------------------------------------------- - subroutine init_canopystate_type(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) + subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) ! !DESCRIPTION: ! Initialize CTSM canopy state type needed for calling CTSM routines @@ -185,6 +185,6 @@ subroutine init_canopystate_type(this, bounds, nch, ityp, fveg, cncol, cnpft, cn end do ! nz end do ! nc - end subroutine init_canopystate_type + end subroutine Init end module CanopyStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 60cb0fb70..4c19141bf 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -220,7 +220,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call wateratm2lnd_inst%Init (bounds) - call canopystate_inst%init_canopystate_type (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) + call canopystate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) call solarabs_inst%Init (bounds) From 834788bdaac366c7ea706b74bf4d13e1fc3c924e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 13:20:55 -0500 Subject: [PATCH 374/589] rearrange type statements --- .../CLM51/CN_init_mod.F90 | 122 ++++++++++++------ 1 file changed, 82 insertions(+), 40 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 4c19141bf..4ea1dec71 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -86,6 +86,48 @@ module CN_initMod class(fire_method_type), allocatable :: cnfire_method type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst + type(bounds_type), public :: bounds +! type(patch_type) :: patch +! type(column_type) :: col +! type(landunit_type) :: lun + type(cnveg_nitrogenstate_type), public :: cnveg_nitrogenstate_inst + type(cnveg_carbonstate_type), public :: cnveg_carbonstate_inst + type(atm2lnd_type), public :: atm2lnd_inst + type(temperature_type), public :: temperature_inst + type(soilstate_type), public :: soilstate_inst + type(waterdiagnosticbulk_type), public :: waterdiagnosticbulk_inst + type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst + type(wateratm2lnd_type), public :: wateratm2lnd_inst + type(canopystate_type), public :: canopystate_inst + type(solarabs_type), public :: solarabs_inst + type(surfalb_type), public :: surfalb_inst + type(ozone_base_type), public :: ozone_inst +! type(pftcon_type) :: pftcon + type(waterflux_type), public :: waterflux_inst + type(soilbiogeochem_carbonstate_type), public :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type), public :: soilbiogeochem_nitrogenstate_inst + type(cn_products_type), public :: c_products_inst + type(cn_products_type), public :: n_products_inst + type(soilbiogeochem_state_type), public :: soilbiogeochem_state_inst + type(cnveg_state_type), public :: cnveg_state_inst + type(cnveg_carbonflux_type), public :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type), public :: cnveg_nitrogenflux_inst + !type(gridcell_type) :: grc + type(soilbiogeochem_carbonflux_type), public :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type), public :: soilbiogeochem_nitrogenflux_inst + type(ch4_type), public :: ch4_inst + type(crop_type), public :: crop_inst + type(dgvs_type), public :: dgvs_inst + type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst + type(energyflux_type), public :: energyflux_inst + type(waterstatebulk_type), public :: waterstatebulk_inst + type(waterstate_type), public :: waterstate_inst + type(frictionvel_type), public :: frictionvel_inst + type(cn_vegetation_type), public :: bgc_vegetation_inst + type(waterfluxbulk_type), public :: waterfluxbulk_inst + type(active_layer_type), public :: active_layer_inst + + ! !PUBLIC MEMBER FUNCTIONS: public :: CN_init @@ -111,46 +153,46 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) !LOCAL - type(bounds_type) :: bounds -! type(patch_type) :: patch -! type(column_type) :: col -! type(landunit_type) :: lun - type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst - type(atm2lnd_type) :: atm2lnd_inst - type(temperature_type) :: temperature_inst - type(soilstate_type) :: soilstate_inst - type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst - type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst - type(wateratm2lnd_type) :: wateratm2lnd_inst - type(canopystate_type) :: canopystate_inst - type(solarabs_type) :: solarabs_inst - type(surfalb_type) :: surfalb_inst - type(ozone_base_type) :: ozone_inst -! type(pftcon_type) :: pftcon - type(waterflux_type) :: waterflux_inst - type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst - type(cn_products_type) :: c_products_inst - type(cn_products_type) :: n_products_inst - type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst - type(cnveg_state_type) :: cnveg_state_inst - type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst - type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst - !type(gridcell_type) :: grc - type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst - type(ch4_type) :: ch4_inst - type(crop_type) :: crop_inst - type(dgvs_type) :: dgvs_inst - type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst - type(energyflux_type) :: energyflux_inst - type(waterstatebulk_type) :: waterstatebulk_inst - type(waterstate_type) :: waterstate_inst - type(frictionvel_type) :: frictionvel_inst - type(cn_vegetation_type) :: bgc_vegetation_inst - type(waterfluxbulk_type) :: waterfluxbulk_inst - type(active_layer_type) :: active_layer_inst +! type(bounds_type) :: bounds +!! type(patch_type) :: patch +!! type(column_type) :: col +!! type(landunit_type) :: lun +! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst +! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst +! type(atm2lnd_type) :: atm2lnd_inst +! type(temperature_type) :: temperature_inst +! type(soilstate_type) :: soilstate_inst +! type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst +! type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst +! type(wateratm2lnd_type) :: wateratm2lnd_inst +! type(canopystate_type) :: canopystate_inst +! type(solarabs_type) :: solarabs_inst +! type(surfalb_type) :: surfalb_inst +! type(ozone_base_type) :: ozone_inst +!! type(pftcon_type) :: pftcon +! type(waterflux_type) :: waterflux_inst +! type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst +! type(cn_products_type) :: c_products_inst +! type(cn_products_type) :: n_products_inst +! type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst +! type(cnveg_state_type) :: cnveg_state_inst +! type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst +! type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst +! !type(gridcell_type) :: grc +! type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst +! type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst +! type(ch4_type) :: ch4_inst +! type(crop_type) :: crop_inst +! type(dgvs_type) :: dgvs_inst +! type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst +! type(energyflux_type) :: energyflux_inst +! type(waterstatebulk_type) :: waterstatebulk_inst +! type(waterstate_type) :: waterstate_inst +! type(frictionvel_type) :: frictionvel_inst +! type(cn_vegetation_type) :: bgc_vegetation_inst +! type(waterfluxbulk_type) :: waterfluxbulk_inst +! type(active_layer_type) :: active_layer_inst character(300) :: paramfile character(300) :: NLFilename From 76d942e7be73abf3a2db2cc30d5ba8c801029f1a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Mar 2023 13:30:38 -0500 Subject: [PATCH 375/589] remove duplicate statements --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 4ea1dec71..f78c1fbc3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -96,7 +96,6 @@ module CN_initMod type(temperature_type), public :: temperature_inst type(soilstate_type), public :: soilstate_inst type(waterdiagnosticbulk_type), public :: waterdiagnosticbulk_inst - type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst type(wateratm2lnd_type), public :: wateratm2lnd_inst type(canopystate_type), public :: canopystate_inst type(solarabs_type), public :: solarabs_inst @@ -118,7 +117,6 @@ module CN_initMod type(ch4_type), public :: ch4_inst type(crop_type), public :: crop_inst type(dgvs_type), public :: dgvs_inst - type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst type(energyflux_type), public :: energyflux_inst type(waterstatebulk_type), public :: waterstatebulk_inst type(waterstate_type), public :: waterstate_inst From bdd13f16b323fc8cdf2a7b4513c96f5624bb8049 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 6 Mar 2023 08:15:25 -0500 Subject: [PATCH 376/589] pointer bug fix test --- .../CLM51/CNCLM_DriverMod.F90 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index ae5d5c475..54d48963b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -30,7 +30,7 @@ module CNCLM_DriverMod use FrictionVelocityMod , only : frictionvel_type use ActiveLayerMod , only : active_layer_type use SoilBiogeochemStateType , only : soilbiogeochem_state_type - use CanopyStateType , only : canopystate_type + !use CanopyStateType , only : canopystate_type use CropType , only : crop_type use ch4Mod , only : ch4_type use PhotosynthesisMod , only : photosyns_type @@ -189,7 +189,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst - type(canopystate_type) :: canopystate_inst +! type(canopystate_type) :: canopystate_inst type(crop_type) :: crop_inst type(ch4_type) :: ch4_inst type(photosyns_type) :: photosyns_inst @@ -497,7 +497,7 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst - type(canopystate_type) :: canopystate_inst + !type(canopystate_type) :: canopystate_inst type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst @@ -649,7 +649,7 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) ! ARGUMENTS - use CanopyStateType , only : canopystate_inst + use CanopyStateType ! INPUT/OUTPUT integer, intent(in) :: nch ! number of tiles @@ -662,7 +662,12 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) ! LOCAL integer :: n, p, nv, nc, nz, np + + real, pointer :: elai_clm(:) !------------------------------ + + elai_clm => canopystate_inst%elai_patch + elai = 0. if(present(esai)) esai = 0. if(present(tlai)) tlai = 0. @@ -680,7 +685,7 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) ! extract LAI & SAI from CN clmtype ! --------------------------------- if(ityp(nc,nv,nz)==p .and. ityp(nc,nv,nz)>0 .and. fveg(nc,nv,nz)>1.e-4) then - elai(nc,nv,nz) = canopystate_inst%elai_patch(np) + elai(nc,nv,nz) = elai_clm(np) if(present(esai)) esai(nc,nv,nz) = canopystate_inst%esai_patch(np) if(present(tlai)) tlai(nc,nv,nz) = canopystate_inst%tlai_patch(np) if(present(tsai)) tsai(nc,nv,nz) = canopystate_inst%tsai_patch(np) From e817ec5cdb2c489016d340c13f29a0a034cdb594 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 6 Mar 2023 09:41:57 -0500 Subject: [PATCH 377/589] changing variable type --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 54d48963b..0ec301f73 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -663,7 +663,7 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) ! LOCAL integer :: n, p, nv, nc, nz, np - real, pointer :: elai_clm(:) + real(r8), pointer :: elai_clm(:) !------------------------------ elai_clm => canopystate_inst%elai_patch From 0efddce7a933653996c69372133020f7b6366775 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 6 Mar 2023 12:40:15 -0500 Subject: [PATCH 378/589] pointer bug fix test --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 0ec301f73..895065650 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -30,7 +30,7 @@ module CNCLM_DriverMod use FrictionVelocityMod , only : frictionvel_type use ActiveLayerMod , only : active_layer_type use SoilBiogeochemStateType , only : soilbiogeochem_state_type - !use CanopyStateType , only : canopystate_type + use CanopyStateType use CropType , only : crop_type use ch4Mod , only : ch4_type use PhotosynthesisMod , only : photosyns_type @@ -189,7 +189,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst -! type(canopystate_type) :: canopystate_inst type(crop_type) :: crop_inst type(ch4_type) :: ch4_inst type(photosyns_type) :: photosyns_inst @@ -497,7 +496,6 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst - !type(canopystate_type) :: canopystate_inst type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst @@ -649,8 +647,6 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) ! ARGUMENTS - use CanopyStateType - ! INPUT/OUTPUT integer, intent(in) :: nch ! number of tiles integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index From c85bdb9728f81c646b76bb896fb2051df476c430 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 7 Mar 2023 13:00:25 -0500 Subject: [PATCH 379/589] pointer bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index e0607e926..238d52432 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -58,7 +58,7 @@ module CanopyStateType procedure, public :: Init end type canopystate_type - type(canopystate_type), public, target :: canopystate_inst + type(canopystate_type), public, target, save :: canopystate_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index f78c1fbc3..2cb633378 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -16,7 +16,7 @@ module CN_initMod use TemperatureType, only : temperature_type use SoilStateType, only : soilstate_type use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type - use CanopyStateType, only : canopystate_type + use CanopyStateType use SolarAbsorbedType, only : solarabs_type use SurfaceAlbedoType, only : surfalb_type use OzoneBaseMod, only : ozone_base_type @@ -97,7 +97,7 @@ module CN_initMod type(soilstate_type), public :: soilstate_inst type(waterdiagnosticbulk_type), public :: waterdiagnosticbulk_inst type(wateratm2lnd_type), public :: wateratm2lnd_inst - type(canopystate_type), public :: canopystate_inst + ! type(canopystate_type), public :: canopystate_inst type(solarabs_type), public :: solarabs_inst type(surfalb_type), public :: surfalb_inst type(ozone_base_type), public :: ozone_inst From 4d3f07b980a935589eff99e4d60b681a7eb6e50b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 7 Mar 2023 16:10:30 -0500 Subject: [PATCH 380/589] change initialization --- .../CLM51/CNCLM_ActiveLayerMod.F90 | 2 +- .../CLM51/CNCLM_CNDVType.F90 | 2 +- .../CLM51/CNCLM_CNProductsMod.F90 | 2 +- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 2 +- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 2 +- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 2 +- .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 2 +- .../CLM51/CNCLM_CNVegStateType.F90 | 2 +- .../CLM51/CNCLM_CropType.F90 | 2 +- .../CLM51/CNCLM_DriverMod.F90 | 87 ++++++----- .../CLM51/CNCLM_EnergyFluxType.F90 | 2 +- .../CLM51/CNCLM_FrictionVelocityMod.F90 | 2 +- .../CLM51/CNCLM_OzoneBaseMod.F90 | 2 +- .../CNCLM_SoilBiogeochemCarbonFluxType.F90 | 2 +- .../CNCLM_SoilBiogeochemCarbonStateType.F90 | 2 +- .../CNCLM_SoilBiogeochemNitrogenFluxType.F90 | 2 +- .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 2 +- .../CLM51/CNCLM_SoilStateType.F90 | 2 +- .../CLM51/CNCLM_SolarAbsorbedType.F90 | 2 +- .../CLM51/CNCLM_SurfaceAlbedoType.F90 | 2 +- .../CLM51/CNCLM_TemperatureType.F90 | 2 +- .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 2 +- .../CLM51/CNCLM_WaterFluxType.F90 | 2 +- .../CLM51/CNCLM_WaterStateBulkType.F90 | 2 +- .../CLM51/CNCLM_WaterStateType.F90 | 2 +- .../CLM51/CNCLM_Wateratm2lndType.F90 | 2 +- .../CLM51/CNCLM_atm2lndType.F90 | 2 +- .../CLM51/CNCLM_ch4Mod.F90 | 2 +- .../CLM51/CNCLM_decompMod.F90 | 2 +- .../CLM51/CNCLM_pftconMod.F90 | 2 +- .../CLM51/CN_init_mod.F90 | 144 +++++++++--------- 32 files changed, 149 insertions(+), 142 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 index cf4759d9e..84b3bc687 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ActiveLayerMod.F90 @@ -39,7 +39,7 @@ module ActiveLayerMod procedure , public :: Init end type active_layer_type - type(active_layer_type), public, target :: active_layer_inst + type(active_layer_type), public, target, save :: active_layer_inst !--------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 index e333dd87b..d9f528bbf 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNDVType.F90 @@ -57,7 +57,7 @@ module CNDVType procedure , public :: Init end type dgvs_type - type(dgvs_type), public, target :: dgvs_inst + type(dgvs_type), public, target, save :: dgvs_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index 66ae215db..c5b3c0cd0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -67,7 +67,7 @@ module CNProductsMod procedure, public :: Init end type cn_products_type - type(cn_products_type), public, target :: cn_products_inst + type(cn_products_type), public, target, save :: cn_products_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 4b5cbe114..c6d2085e6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -481,7 +481,7 @@ module CNVegCarbonFluxType end type cnveg_carbonflux_type -type(cnveg_carbonflux_type), public, target :: cnveg_carbonflux_inst +type(cnveg_carbonflux_type), public, target, save :: cnveg_carbonflux_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index c5b5a760f..e9f043d17 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -203,7 +203,7 @@ module CNVegCarbonStateType end type cnveg_carbonstate_type -type(cnveg_carbonstate_type), public, target :: cnveg_carbonstate_inst +type(cnveg_carbonstate_type), public, target, save :: cnveg_carbonstate_inst real(r8), public :: spinup_factor_deadwood = 1.0_r8 ! Spinup factor used for this simulation real(r8), public :: spinup_factor_AD = 10.0_r8 ! Spinup factor used when in Accelerated Decomposition mode diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index 92f9b5213..c0bae0f35 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -365,7 +365,7 @@ module CNVegNitrogenFluxType end type cnveg_nitrogenflux_type -type(cnveg_nitrogenflux_type), public, target :: cnveg_nitrogenflux_inst +type(cnveg_nitrogenflux_type), public, target, save :: cnveg_nitrogenflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index 6a8b7f952..fb2626c8a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -210,7 +210,7 @@ module CNVegNitrogenStateType procedure , public :: Init end type cnveg_nitrogenstate_type -type(cnveg_nitrogenstate_type), public, target :: cnveg_nitrogenstate_inst +type(cnveg_nitrogenstate_type), public, target, save :: cnveg_nitrogenstate_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index 696fbf091..9f1867498 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -103,7 +103,7 @@ module CNVegStateType end type cnveg_state_type - type(cnveg_state_type), public, target :: cnveg_state_inst + type(cnveg_state_type), public, target, public :: cnveg_state_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 index c86a589af..6a223ae63 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CropType.F90 @@ -32,7 +32,7 @@ module CropType procedure , public :: Init end type crop_type - type(crop_type), public, target :: crop_inst + type(crop_type), public, target, save :: crop_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 895065650..81155ebc0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -165,42 +165,42 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! jkolassa: not sure the below type declarations are necessary or whether use statements ! above are enough - type(bounds_type) :: bounds - type(clumpfilter) :: filter - type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonflux_type) :: c13_soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonflux_type) :: c14_soilbiogeochem_carbonflux_inst - type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst - type(gridcell_type) :: grc - type(cn_vegetation_type) :: bgc_vegetation_inst - type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst - type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst - type(soilstate_type) :: soilstate_inst - type(atm2lnd_type) :: atm2lnd_inst - type(temperature_type) :: temperature_inst - type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst - type(cnveg_state_type) :: cnveg_state_inst - type(waterstatebulk_type) :: waterstatebulk_inst - type(waterfluxbulk_type) :: waterfluxbulk_inst - type(frictionvel_type) :: frictionvel_inst - type(active_layer_type) :: active_layer_inst - type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_carbonstate_type) :: c13_soilbiogeochem_carbonstate_inst - type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst - type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst - type(crop_type) :: crop_inst - type(ch4_type) :: ch4_inst - type(photosyns_type) :: photosyns_inst - type(energyflux_type) :: energyflux_inst - type(fireemis_type) :: fireemis_inst - type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst - type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst - type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst - type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - type(cnfire_li2014_type) :: cnfire_li2014_inst - type(cnfire_li2016_type) :: cnfire_li2016_inst - type(cnfire_li2021_type) :: cnfire_li2021_inst +! type(bounds_type) :: bounds +! type(clumpfilter) :: filter +! type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst +! type(soilbiogeochem_carbonflux_type) :: c13_soilbiogeochem_carbonflux_inst +! type(soilbiogeochem_carbonflux_type) :: c14_soilbiogeochem_carbonflux_inst +! type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst +! type(gridcell_type) :: grc +! type(cn_vegetation_type) :: bgc_vegetation_inst +! type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst +! type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst +! type(soilstate_type) :: soilstate_inst +! type(atm2lnd_type) :: atm2lnd_inst +! type(temperature_type) :: temperature_inst +! type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst +! type(cnveg_state_type) :: cnveg_state_inst +! type(waterstatebulk_type) :: waterstatebulk_inst +! type(waterfluxbulk_type) :: waterfluxbulk_inst +! type(frictionvel_type) :: frictionvel_inst +! type(active_layer_type) :: active_layer_inst +! type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_carbonstate_type) :: c13_soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst +! type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst +! type(crop_type) :: crop_inst +! type(ch4_type) :: ch4_inst +! type(photosyns_type) :: photosyns_inst +! type(energyflux_type) :: energyflux_inst +! type(fireemis_type) :: fireemis_inst +! type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst +! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst +! type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst +! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst +! type(cnfire_li2014_type) :: cnfire_li2014_inst +! type(cnfire_li2016_type) :: cnfire_li2016_inst +! type(cnfire_li2021_type) :: cnfire_li2021_inst real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions @@ -660,10 +660,17 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) integer :: n, p, nv, nc, nz, np real(r8), pointer :: elai_clm(:) + real(r8), pointer :: esai_clm(:) + real(r8), pointer :: tlai_clm(:) + real(r8), pointer :: tsai_clm(:) + !------------------------------ elai_clm => canopystate_inst%elai_patch - + esai_clm => canopystate_inst%esai_patch + tlai_clm => canopystate_inst%tlai_patch + tsai_clm => canopystate_inst%tsai_patch + elai = 0. if(present(esai)) esai = 0. if(present(tlai)) tlai = 0. @@ -682,9 +689,9 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) ! --------------------------------- if(ityp(nc,nv,nz)==p .and. ityp(nc,nv,nz)>0 .and. fveg(nc,nv,nz)>1.e-4) then elai(nc,nv,nz) = elai_clm(np) - if(present(esai)) esai(nc,nv,nz) = canopystate_inst%esai_patch(np) - if(present(tlai)) tlai(nc,nv,nz) = canopystate_inst%tlai_patch(np) - if(present(tsai)) tsai(nc,nv,nz) = canopystate_inst%tsai_patch(np) + if(present(esai)) esai(nc,nv,nz) = esai_clm(np) + if(present(tlai)) tlai(nc,nv,nz) = tlai_clm(np) + if(present(tsai)) tsai(nc,nv,nz) = tsai_clm(np) endif end do ! defined veg loop diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 index 32878e130..8d4b00da1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_EnergyFluxType.F90 @@ -126,7 +126,7 @@ module EnergyFluxType procedure , public :: Init end type energyflux_type - type(energyflux_type), public, target :: energyflux_inst + type(energyflux_type), public, target, save :: energyflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 index 0f50da08a..5cfa4db40 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FrictionVelocityMod.F90 @@ -79,7 +79,7 @@ module FrictionVelocityMod procedure , public :: Init end type frictionvel_type - type(frictionvel_type), public, target :: frictionvel_inst + type(frictionvel_type), public, target, save :: frictionvel_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 index 8fa0dee37..b7f8a775f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_OzoneBaseMod.F90 @@ -25,7 +25,7 @@ module OzoneBaseMod procedure, public :: Init end type ozone_base_type - type(ozone_base_type), public, target :: ozone_inst + type(ozone_base_type), public, target, save :: ozone_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index 5023a3f2f..32f2d0db2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -79,7 +79,7 @@ module SoilBiogeochemCarbonFluxType procedure , public :: Init end type soilbiogeochem_carbonflux_type - type(soilbiogeochem_carbonflux_type), public, target :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type), public, target, save :: soilbiogeochem_carbonflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index 69fc51aae..99f1ec109 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -62,7 +62,7 @@ module SoilBiogeochemCarbonStateType end type soilbiogeochem_carbonstate_type - type(soilbiogeochem_carbonstate_type), public, target :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type), public, target, save :: soilbiogeochem_carbonstate_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 index ef9e96180..df2af17a6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenFluxType.F90 @@ -144,7 +144,7 @@ module SoilBiogeochemNitrogenFluxType procedure , public :: Init end type soilbiogeochem_nitrogenflux_type - type(soilbiogeochem_nitrogenflux_type), public, target :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type), public, target, save :: soilbiogeochem_nitrogenflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index 06ccdfde5..c8cfb9ab1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -74,7 +74,7 @@ module SoilBiogeochemNitrogenStateType procedure , public :: Init end type soilbiogeochem_nitrogenstate_type - type(soilbiogeochem_nitrogenstate_type), public, target :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type), public, target, save :: soilbiogeochem_nitrogenstate_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 17e79b7df..1af287447 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -45,7 +45,7 @@ module SoilBiogeochemStateType procedure, public :: Init end type soilbiogeochem_state_type - type(soilbiogeochem_state_type), public, target :: soilbiogeochem_state_inst + type(soilbiogeochem_state_type), public, target, save :: soilbiogeochem_state_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index 031afd0a4..bdf160355 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -77,7 +77,7 @@ module SoilStateType procedure, public :: Init end type soilstate_type -type(soilstate_type), public, target :: soilstate_inst +type(soilstate_type), public, target, save :: soilstate_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 index e5fe4ea00..9a5a6c28b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SolarAbsorbedType.F90 @@ -71,7 +71,7 @@ module SolarAbsorbedType procedure, public :: Init end type solarabs_type - type(solarabs_type), public, target :: solarabs_inst + type(solarabs_type), public, target, save :: solarabs_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index 0caa83d9d..c68b4aa7a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -67,7 +67,7 @@ module SurfaceAlbedoType procedure, public :: Init end type surfalb_type -type(surfalb_type), public, target :: surfalb_inst +type(surfalb_type), public, target, save :: surfalb_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 index 8516d164e..337caa2d3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_TemperatureType.F90 @@ -119,7 +119,7 @@ module TemperatureType procedure, public :: Init end type temperature_type -type(temperature_type), public, target :: temperature_inst +type(temperature_type), public, target, save :: temperature_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index 0ba2a262d..ddedb1a41 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -62,7 +62,7 @@ module WaterDiagnosticBulkType procedure, public :: Init end type waterdiagnosticbulk_type -type(waterdiagnosticbulk_type), public, target :: waterdiagnosticbulk_inst +type(waterdiagnosticbulk_type), public, target, save :: waterdiagnosticbulk_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index 4cfc04829..e7a753c1e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -106,7 +106,7 @@ module WaterFluxType procedure, public :: Init end type waterflux_type - type(waterflux_type), public, target :: waterflux_inst + type(waterflux_type), public, target, save :: waterflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 index 39648a283..96601e2ce 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 @@ -34,7 +34,7 @@ module WaterStateBulkType procedure , public :: Init end type waterstatebulk_type - type(waterstatebulk_type), public, target :: waterstatebulk_inst + type(waterstatebulk_type), public, target, save :: waterstatebulk_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 index 67ad563ce..3864dcab0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 @@ -52,7 +52,7 @@ module WaterStateType procedure , public :: Init end type waterstate_type - type(waterstate_type), public, target :: waterstate_inst + type(waterstate_type), public, target, save :: waterstate_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 index ccb9ed14d..f1023341a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 @@ -36,7 +36,7 @@ module Wateratm2lndType procedure, public :: Init end type wateratm2lnd_type - type(wateratm2lnd_type), public, target :: wateratm2lnd_inst + type(wateratm2lnd_type), public, target, save :: wateratm2lnd_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 index f6b07a8f2..3478e1977 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_atm2lndType.F90 @@ -66,7 +66,7 @@ module atm2lndType procedure, public :: Init end type atm2lnd_type -type(atm2lnd_type), public, target :: atm2lnd_inst +type(atm2lnd_type), public, target, save :: atm2lnd_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 index 2255e003d..838fd21aa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ch4Mod.F90 @@ -110,7 +110,7 @@ module ch4Mod end type ch4_type -type(ch4_type), public, target :: ch4_inst +type(ch4_type), public, target, save :: ch4_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 index 21cf36a43..0f7f812b4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_decompMod.F90 @@ -35,7 +35,7 @@ module decompMod procedure, public :: Init end type bounds_type - type(bounds_type), public :: bounds + type(bounds_type), public, target, save :: bounds contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index a2c866b95..af69468ba 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -285,7 +285,7 @@ module pftconMod end type pftcon_type -type(pftcon_type), public :: pftcon +type(pftcon_type), public, target, save :: pftcon integer, public, parameter :: pftname_len = 40 ! max length of pftname character(len=pftname_len), public :: pftname(0:mxpft) ! PFT description diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 2cb633378..0c0c701d4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -8,53 +8,53 @@ module CN_initMod use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init use clm_varctl , only : use_century_decomp, init_clm_varctl use clm_time_manager , only : get_step_size - use decompMod , only : bounds_type + use decompMod use filterMod - use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type - use CNVegCarbonStateType, only : cnveg_carbonstate_type - use atm2lndType, only : atm2lnd_type - use TemperatureType, only : temperature_type - use SoilStateType, only : soilstate_type - use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type + use CNVegNitrogenStateType + use CNVegCarbonStateType + use atm2lndType + use TemperatureType + use SoilStateType + use WaterDiagnosticBulkType use CanopyStateType - use SolarAbsorbedType, only : solarabs_type - use SurfaceAlbedoType, only : surfalb_type - use OzoneBaseMod, only : ozone_base_type - use pftconMod , only : pftcon - use WaterFluxType, only : waterflux_type - use SoilBiogeochemCarbonStateType, only : soilbiogeochem_carbonstate_type - use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type - use CNProductsMod, only : cn_products_type - use SoilBiogeochemStateType, only : soilbiogeochem_state_type - use CNVegStateType, only : cnveg_state_type - use CNVegCarbonFluxType, only : cnveg_carbonflux_type - use CNVegNitrogenFluxType, only : cnveg_nitrogenflux_type - use GridcellType , only : grc - use WaterFluxBulkType, only : waterfluxbulk_type - use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type - use SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type - use PatchType , only : patch - use ColumnType , only : col - use ch4Mod, only : ch4_type - use SoilBiogeochemDecompCascadeConType, only : decomp_cascade_type, init_decomp_cascade_constants - use ActiveLayerMod, only : active_layer_type - use CropType, only : crop_type - use CNDVType, only : dgvs_type + use SolarAbsorbedType + use SurfaceAlbedoType + use OzoneBaseMod + use pftconMod + use WaterFluxType + use SoilBiogeochemCarbonStateType + use SoilBiogeochemNitrogenStateType + use CNProductsMod + use SoilBiogeochemStateType + use CNVegStateType + use CNVegCarbonFluxType + use CNVegNitrogenFluxType + use GridcellType + use WaterFluxBulkType + use SoilBiogeochemCarbonFluxType + use SoilBiogeochemNitrogenFluxType + use PatchType + use ColumnType + use ch4Mod + use SoilBiogeochemDecompCascadeConType, only : init_decomp_cascade_constants + use ActiveLayerMod + use CropType + use CNDVType use LandunitType , only : lun use RootBiophysMod use CNMRespMod , only : readCNMRespParams => readParams use CNSharedParamsMod , only : CNParamsReadShared use spmdMod - use Wateratm2lndBulkType, only : wateratm2lndbulk_type - use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type - use Wateratm2lndType, only : wateratm2lnd_type - use EnergyFluxType, only : energyflux_type - use SaturatedExcessRunoffMod, only : saturated_excess_runoff_type - use WaterStateBulkType, only : waterstatebulk_type - use WaterStateType, only : waterstate_type - use FrictionVelocityMod, only : frictionvel_type + use Wateratm2lndBulkType + use WaterDiagnosticBulkType + use Wateratm2lndType + use EnergyFluxType + use SaturatedExcessRunoffMod + use WaterStateBulkType + use WaterStateType + use FrictionVelocityMod use PhotosynthesisMod - use CNVegetationFacade, only : cn_vegetation_type + use CNVegetationFacade use initSubgridMod use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc @@ -84,46 +84,46 @@ module CN_initMod type(photosyns_type), public :: photosyns_inst class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method class(fire_method_type), allocatable :: cnfire_method - type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst - type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst - type(bounds_type), public :: bounds +! type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst +! type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst +! type(bounds_type), public :: bounds ! type(patch_type) :: patch ! type(column_type) :: col ! type(landunit_type) :: lun - type(cnveg_nitrogenstate_type), public :: cnveg_nitrogenstate_inst - type(cnveg_carbonstate_type), public :: cnveg_carbonstate_inst - type(atm2lnd_type), public :: atm2lnd_inst - type(temperature_type), public :: temperature_inst - type(soilstate_type), public :: soilstate_inst - type(waterdiagnosticbulk_type), public :: waterdiagnosticbulk_inst - type(wateratm2lnd_type), public :: wateratm2lnd_inst +! type(cnveg_nitrogenstate_type), public :: cnveg_nitrogenstate_inst +! type(cnveg_carbonstate_type), public :: cnveg_carbonstate_inst +! type(atm2lnd_type), public :: atm2lnd_inst +! type(temperature_type), public :: temperature_inst +! type(soilstate_type), public :: soilstate_inst +! type(waterdiagnosticbulk_type), public :: waterdiagnosticbulk_inst +! type(wateratm2lnd_type), public :: wateratm2lnd_inst ! type(canopystate_type), public :: canopystate_inst - type(solarabs_type), public :: solarabs_inst - type(surfalb_type), public :: surfalb_inst - type(ozone_base_type), public :: ozone_inst + ! type(solarabs_type), public :: solarabs_inst +! type(surfalb_type), public :: surfalb_inst +! type(ozone_base_type), public :: ozone_inst ! type(pftcon_type) :: pftcon - type(waterflux_type), public :: waterflux_inst - type(soilbiogeochem_carbonstate_type), public :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenstate_type), public :: soilbiogeochem_nitrogenstate_inst - type(cn_products_type), public :: c_products_inst - type(cn_products_type), public :: n_products_inst - type(soilbiogeochem_state_type), public :: soilbiogeochem_state_inst - type(cnveg_state_type), public :: cnveg_state_inst - type(cnveg_carbonflux_type), public :: cnveg_carbonflux_inst - type(cnveg_nitrogenflux_type), public :: cnveg_nitrogenflux_inst +! type(waterflux_type), public :: waterflux_inst +! type(soilbiogeochem_carbonstate_type), public :: soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_nitrogenstate_type), public :: soilbiogeochem_nitrogenstate_inst +! type(cn_products_type), public :: c_products_inst +! type(cn_products_type), public :: n_products_inst +! type(soilbiogeochem_state_type), public :: soilbiogeochem_state_inst +! type(cnveg_state_type), public :: cnveg_state_inst +! type(cnveg_carbonflux_type), public :: cnveg_carbonflux_inst +! type(cnveg_nitrogenflux_type), public :: cnveg_nitrogenflux_inst !type(gridcell_type) :: grc - type(soilbiogeochem_carbonflux_type), public :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_nitrogenflux_type), public :: soilbiogeochem_nitrogenflux_inst - type(ch4_type), public :: ch4_inst - type(crop_type), public :: crop_inst - type(dgvs_type), public :: dgvs_inst - type(energyflux_type), public :: energyflux_inst - type(waterstatebulk_type), public :: waterstatebulk_inst - type(waterstate_type), public :: waterstate_inst - type(frictionvel_type), public :: frictionvel_inst +! type(soilbiogeochem_carbonflux_type), public :: soilbiogeochem_carbonflux_inst +! type(soilbiogeochem_nitrogenflux_type), public :: soilbiogeochem_nitrogenflux_inst +! type(ch4_type), public :: ch4_inst +! type(crop_type), public :: crop_inst +! type(dgvs_type), public :: dgvs_inst +! type(energyflux_type), public :: energyflux_inst +! type(waterstatebulk_type), public :: waterstatebulk_inst +! type(waterstate_type), public :: waterstate_inst +! type(frictionvel_type), public :: frictionvel_inst type(cn_vegetation_type), public :: bgc_vegetation_inst - type(waterfluxbulk_type), public :: waterfluxbulk_inst - type(active_layer_type), public :: active_layer_inst +! type(waterfluxbulk_type), public :: waterfluxbulk_inst + ! type(active_layer_type), public :: active_layer_inst From d00f9e153bce5c1eaa253f63040c521db77c428c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 07:11:05 -0500 Subject: [PATCH 381/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index 9f1867498..38c477e69 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -103,7 +103,7 @@ module CNVegStateType end type cnveg_state_type - type(cnveg_state_type), public, target, public :: cnveg_state_inst + type(cnveg_state_type), public, target, save :: cnveg_state_inst contains From a3bd89fb8d84bd039118747c8370e7869e6fe7b4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 09:07:39 -0500 Subject: [PATCH 382/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 0c0c701d4..8854f8cd4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -84,8 +84,8 @@ module CN_initMod type(photosyns_type), public :: photosyns_inst class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method class(fire_method_type), allocatable :: cnfire_method -! type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst -! type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst + type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst + type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst ! type(bounds_type), public :: bounds ! type(patch_type) :: patch ! type(column_type) :: col From 06537b6b8658525867811a8b2ce3bfba8dcaa08c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 09:20:50 -0500 Subject: [PATCH 383/589] correct type import --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 81155ebc0..c42d16ab1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -19,12 +19,11 @@ module CNCLM_DriverMod use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use atm2lndType , only : atm2lnd_type use Wateratm2lndBulkType , only : wateratm2lndbulk_type - use CNVegStateType , only : cnveg_state_type + use CNVegStateType use WaterStateBulkType , only : waterstatebulk_type use SoilStateType , only : soilstate_type use TemperatureType , only : temperature_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type - use CNVegStateType , only : cnveg_state_type use WaterStateBulkType , only : waterstatebulk_type use WaterFluxBulkType , only : waterfluxbulk_type use FrictionVelocityMod , only : frictionvel_type @@ -492,7 +491,7 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst type(gridcell_type) :: grc type(cn_vegetation_type) :: bgc_vegetation_inst - type(cnveg_state_type) :: cnveg_state_inst +! type(cnveg_state_type) :: cnveg_state_inst type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst From 0591eacf1dd98826301acffd0c775fb0a836f353 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 10:04:48 -0500 Subject: [PATCH 384/589] changing imports --- .../CLM51/CNCLM51_Photosynthesis.F90 | 32 ++++---- .../CLM51/CNCLM_DriverMod.F90 | 76 +++++++++---------- 2 files changed, 54 insertions(+), 54 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 68728fac0..25d7c6f5c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -19,7 +19,7 @@ module CNCLM_Photosynthesis use OzoneBaseMod use PhotosynthesisMod use WaterFluxBulkType - use WaterStateType, only : waterstate_type + use WaterStateType implicit none @@ -80,21 +80,21 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! LOCAL ! CLM variables - type(bounds_type) :: bounds - type(atm2lnd_type) :: atm2lnd_inst - type(temperature_type) :: temperature_inst - type(soilstate_type) :: soilstate_inst - type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst - type(surfalb_type) :: surfalb_inst - type(solarabs_type) :: solarabs_inst - type(canopystate_type) :: canopystate_inst - type(ozone_base_type) :: ozone_inst - type(photosyns_type) :: photosyns_inst - type(waterfluxbulk_type) :: waterfluxbulk_inst - type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst - type(waterstate_type) :: waterstate_inst - type(clumpfilter) :: filter +! type(bounds_type) :: bounds +! type(atm2lnd_type) :: atm2lnd_inst +! type(temperature_type) :: temperature_inst +! type(soilstate_type) :: soilstate_inst +! type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst +! type(surfalb_type) :: surfalb_inst +! type(solarabs_type) :: solarabs_inst +! type(canopystate_type) :: canopystate_inst +! type(ozone_base_type) :: ozone_inst +! type(photosyns_type) :: photosyns_inst +! type(waterfluxbulk_type) :: waterfluxbulk_inst +! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst +! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst +! type(waterstate_type) :: waterstate_inst +! type(clumpfilter) :: filter ! temporary and loop variables integer :: n, p, pft_num, nv, nc, nz, np, ib, nl diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index c42d16ab1..d294fbbde 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -6,46 +6,46 @@ module CNCLM_DriverMod use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& var_col, var_pft, nlevgrnd, numpft, ndecomp_pools use clm_varcon , only : grav, denh2o - use decompMod, only : bounds_type - use filterMod, only : clumpfilter - use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type - use SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type - use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type - use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type - use ActiveLayerMod , only : active_layer_type - use GridcellType , only : gridcell_type - use FireMethodType , only : fire_method_type - use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type - use atm2lndType , only : atm2lnd_type - use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use decompMod + use filterMod + use SoilBiogeochemCarbonFluxType + use SoilBiogeochemNitrogenFluxType + use SoilBiogeochemCarbonStateType + use SoilBiogeochemNitrogenStateType + use ActiveLayerMod + use GridcellType + use FireMethodType + use SaturatedExcessRunoffMod + use WaterDiagnosticBulkType + use atm2lndType + use Wateratm2lndBulkType use CNVegStateType - use WaterStateBulkType , only : waterstatebulk_type - use SoilStateType , only : soilstate_type - use TemperatureType , only : temperature_type - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type - use WaterStateBulkType , only : waterstatebulk_type - use WaterFluxBulkType , only : waterfluxbulk_type - use FrictionVelocityMod , only : frictionvel_type - use ActiveLayerMod , only : active_layer_type - use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use WaterStateBulkType + use SoilStateType + use TemperatureType + use WaterDiagnosticBulkType + use WaterStateBulkType + use WaterFluxBulkType + use FrictionVelocityMod + use ActiveLayerMod + use SoilBiogeochemStateType use CanopyStateType - use CropType , only : crop_type - use ch4Mod , only : ch4_type - use PhotosynthesisMod , only : photosyns_type - use EnergyFluxType , only : energyflux_type - use CNFireEmissionsMod , only : fireemis_type - use CN_initMod , only : nutrient_competition_method - use CNVegCarbonFluxType , only : cnveg_carbonflux_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type - use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type - use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type - use CNProductsMod , only : cn_products_type - use CNFireFactoryMod , only : create_cnfire_method - use FireDataBaseType , only : fire_base_type - use CNFireLi2014Mod , only : cnfire_li2014_type - use CNFireLi2016Mod , only : cnfire_li2016_type - use CNFireLi2021Mod , only : cnfire_li2021_type + use CropType + use ch4Mod + use PhotosynthesisMod + use EnergyFluxType + use CNFireEmissionsMod + use CN_initMod + use CNVegCarbonFluxType + use CNVegCarbonStateType + use CNVegNitrogenFluxType + use CNVegNitrogenStateType + use CNProductsMod + use CNFireFactoryMod + use FireDataBaseType + use CNFireLi2014Mod + use CNFireLi2016Mod + use CNFireLi2021Mod implicit none private From 50ff221791c2f7190cdb45906eb36e5aabf9f166 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 12:54:34 -0500 Subject: [PATCH 385/589] fixing imports --- .../CLM51/CNCLM51_Photosynthesis.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 25d7c6f5c..397726fc3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -2,9 +2,9 @@ module CNCLM_Photosynthesis use MAPL_ConstantsMod use clm_varpar, only : numpft, numrad, num_veg, num_zon - use decompMod, only : bounds_type - use PatchType, only : patch - use filterMod, only : clumpfilter + use decompMod + use PatchType + use filterMod use CNVegNitrogenstateType use CNVegCarbonstateType From 83464c3820778846b17e7b5e936063a1b335397b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 15:36:11 -0500 Subject: [PATCH 386/589] correct filter import and type declaration --- .../CLM51/CNCLM51_Photosynthesis.F90 | 20 +++++++++++++------ .../CLM51/CN_init_mod.F90 | 2 +- .../CLM51/PhotosynthesisMod.F90 | 1 + 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 397726fc3..a270ca91b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -151,6 +151,10 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, pointer :: leafn(:) ! leaf N (gN/m2) real, pointer :: froot_carbon(:) ! fine root carbon (gC/m2) [pft] real, pointer :: croot_carbon(:) ! live coarse root carbon (gC/m2) [pft] + integer, pointer :: filter_nourbanp + integer, pointer :: filter_num_nourbanp + integer, pointer :: filter_exposedvegp + integer, pointer :: filter_num_exposedvegp ! local outputs from Photosynthesis routine real(r8) , allocatable, dimension(:) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) @@ -172,7 +176,11 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & froot_carbon => cnveg_carbonstate_inst%frootc_patch , & croot_carbon => cnveg_carbonstate_inst%livecrootc_patch, & elai => canopystate_inst%elai_patch , & - esai => canopystate_inst%esai_patch & + esai => canopystate_inst%esai_patch , & + filter_nourbanp => filter(1)%nourbanp , & + filter_num_nourbanp => filter(1)%num_nourbanp , & + filter_exposedvegp => filter(1)%exposedvegp , & + filter_num_exposedvegp => filter(1)%num_exposedvegp , & ) ! allocate filters @@ -345,7 +353,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst) ! compute canopy shaded and sunlit variables (jk: needed to fill solarabs_inst before PHS call) - call CanopySunShadeFracs(filter%nourbanp, filter%num_nourbanp, & + call CanopySunShadeFracs(filter_nourbanp, filter_num_nourbanp, & atm2lnd_inst, surfalb_inst, & canopystate_inst, solarabs_inst) @@ -358,7 +366,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & eair_pert(:) = eair_clm(:) + dea - call PhotosynthesisHydraulicStress ( bounds, filter%num_exposedvegp, filter%exposedvegp, & + call PhotosynthesisHydraulicStress ( bounds, filter(1)%num_exposedvegp, filter(1)%exposedvegp, & esat_tv_clm, eair_pert, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & @@ -376,7 +384,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & temperature_inst%t_veg_patch = temperature_inst%t_veg_patch + dtc esat_tv_pert(:) = esat_tv_clm(:) + deldT_clm(:)*dtc - call PhotosynthesisHydraulicStress ( bounds, filter%num_exposedvegp, filter%exposedvegp, & + call PhotosynthesisHydraulicStress ( bounds, filter(1)%num_exposedvegp, filter(1)%exposedvegp, & esat_tv_pert, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & @@ -392,7 +400,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & temperature_inst%t_veg_patch = temp_unpert ! reset canopy temperature to unperturbed value - call PhotosynthesisHydraulicStress ( bounds, filter%num_exposedvegp, filter%exposedvegp, & + call PhotosynthesisHydraulicStress ( bounds, filter(1)%num_exposedvegp, filter(1)%exposedvegp, & esat_tv_clm, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & @@ -404,7 +412,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & rssun = photosyns_inst%rssun_patch rssha = photosyns_inst%rssha_patch - call PhotosynthesisTotal (filter%num_exposedvegp, filter%exposedvegp, & + call PhotosynthesisTotal (filter(1)%num_exposedvegp, filter(1)%exposedvegp, & atm2lnd_inst, canopystate_inst, photosyns_inst) np = 0 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 8854f8cd4..138bce238 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -81,7 +81,7 @@ module CN_initMod implicit none private - type(photosyns_type), public :: photosyns_inst + !type(photosyns_type), public :: photosyns_inst class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method class(fire_method_type), allocatable :: cnfire_method type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 2047bd3d8..cb43e550f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -222,6 +222,7 @@ module PhotosynthesisMod procedure, public :: ReadParams end type photosyns_type + type(photosyns_type), public, target, save :: photosyns_inst character(len=*), parameter, private :: sourcefile = & __FILE__ From 02926c1ae2c714d0bc8764658c50021124abe18a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 15:53:56 -0500 Subject: [PATCH 387/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index a270ca91b..cb7ee72b9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -180,7 +180,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_nourbanp => filter(1)%nourbanp , & filter_num_nourbanp => filter(1)%num_nourbanp , & filter_exposedvegp => filter(1)%exposedvegp , & - filter_num_exposedvegp => filter(1)%num_exposedvegp , & + filter_num_exposedvegp => filter(1)%num_exposedvegp & ) ! allocate filters From 4810c5ab9697d23fbb57d7ca16e79bd9d4c1da4d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 16:20:32 -0500 Subject: [PATCH 388/589] correct filter reference --- .../CLM51/CNCLM_DriverMod.F90 | 40 +++++++++---------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index d294fbbde..776c318c9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -278,22 +278,22 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! call CLM routines that are needed prior to Ecosystem Dynamics call - call active_layer_inst%alt_calc(filter%num_soilc, filter%soilc, & + call active_layer_inst%alt_calc(filter(1)%num_soilc, filter(1)%soilc, & temperature_inst) call bgc_vegetation_inst%InitGridcellBalance(bounds, & - filter%num_allc, filter%allc, & - filter%num_soilc, filter%soilc, & - filter%num_soilp, filter%soilp, & + filter(1)%num_allc, filter(1)%allc, & + filter(1)%num_soilc, filter(1)%soilc, & + filter(1)%num_soilp, filter(1)%soilp, & soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, & soilbiogeochem_nitrogenstate_inst) call bgc_vegetation_inst%InitColumnBalance(bounds, & - filter%num_allc, filter%allc, & - filter%num_soilc, filter%soilc, & - filter%num_soilp, filter%soilp, & + filter(1)%num_allc, filter(1)%allc, & + filter(1)%num_soilc, filter(1)%soilc, & + filter(1)%num_soilp, filter(1)%soilp, & soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, & @@ -304,13 +304,13 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! calculations, including soil biogeochemistry, carbon/nitrogen state and ! flux updates, fire, etc. call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds, & - filter%num_soilc, filter%soilc, & - filter%num_soilp, filter%soilp, & - filter%num_actfirec, filter%actfirec, & - filter%num_actfirep, filter%actfirep, & - filter%num_pcropp, filter%pcropp, & - filter%num_exposedvegp, filter%exposedvegp, & - filter%num_noexposedvegp, filter%noexposedvegp, & + filter(1)%num_soilc, filter(1)%soilc, & + filter(1)%num_soilp, filter(1)%soilp, & + filter(1)%num_actfirec, filter(1)%actfirec, & + filter(1)%num_actfirep, filter(1)%actfirep, & + filter(1)%num_pcropp, filter(1)%pcropp, & + filter(1)%num_exposedvegp, filter(1)%exposedvegp, & + filter(1)%num_noexposedvegp, filter(1)%noexposedvegp, & doalb, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & @@ -329,11 +329,11 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! jkolassa: This call is mostly to compute the nitrogen leaching, summary states and fluxes ! and the vegetation structural updates call bgc_vegetation_inst%EcosystemDynamicsPostDrainage(bounds, & - filter%num_allc, filter%allc, & - filter%num_soilc, filter%soilc, & - filter%num_soilp, filter%soilp, & - filter%num_actfirec, filter%actfirec, & - filter%num_actfirep, filter%actfirep, & + filter(1)%num_allc, filter(1)%allc, & + filter(1)%num_soilc, filter(1)%soilc, & + filter(1)%num_soilp, filter(1)%soilp, & + filter(1)%num_actfirec, filter(1)%actfirec, & + filter(1)%num_actfirep, filter(1)%actfirep, & doalb, crop_inst, & soilstate_inst, soilbiogeochem_state_inst, & waterstatebulk_inst, waterdiagnosticbulk_inst, & @@ -347,7 +347,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! check carbon and nitrogen balances except on first time step if(.not.first) then call bgc_vegetation_inst%BalanceCheck( & - bounds, filter%num_soilc, filter%soilc, & + bounds, filter(1)%num_soilc, filter(1)%soilc, & soilbiogeochem_carbonflux_inst, & soilbiogeochem_nitrogenflux_inst, atm2lnd_inst ) else From 856e511aef0e2483eac86e589ddd891904726a30 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 16:58:05 -0500 Subject: [PATCH 389/589] bug fix --- .../CLM51/CNCLM_DriverMod.F90 | 20 ++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 776c318c9..85a6eb7f4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -658,17 +658,18 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) ! LOCAL integer :: n, p, nv, nc, nz, np - real(r8), pointer :: elai_clm(:) - real(r8), pointer :: esai_clm(:) - real(r8), pointer :: tlai_clm(:) - real(r8), pointer :: tsai_clm(:) +! real(r8), pointer :: elai_clm(:) +! real(r8), pointer :: esai_clm(:) +! real(r8), pointer :: tlai_clm(:) +! real(r8), pointer :: tsai_clm(:) !------------------------------ - - elai_clm => canopystate_inst%elai_patch - esai_clm => canopystate_inst%esai_patch - tlai_clm => canopystate_inst%tlai_patch - tsai_clm => canopystate_inst%tsai_patch + associate(& + elai_clm => canopystate_inst%elai_patch , & + esai_clm => canopystate_inst%esai_patch , & + tlai_clm => canopystate_inst%tlai_patch , & + tsai_clm => canopystate_inst%tsai_patch & + ) elai = 0. if(present(esai)) esai = 0. @@ -698,6 +699,7 @@ subroutine get_CN_LAI(nch,ityp,fveg,elai,esai,tlai,tsai) end do ! CN zone loop end do ! catchment tile loop + end associate end subroutine get_CN_LAI !--------------------------- From 4ba271918ed4bf0f9e5bf462e228214eb42b1722 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Mar 2023 19:14:25 -0500 Subject: [PATCH 390/589] change forcing assignment for cnfire_type --- .../CLM51/CNCLM_DriverMod.F90 | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 85a6eb7f4..63caa7bfd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -1,6 +1,5 @@ module CNCLM_DriverMod - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan use CNVegetationFacade, only : cn_vegetation_type use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& @@ -197,7 +196,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst ! type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst ! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst -! type(cnfire_li2014_type) :: cnfire_li2014_inst + !type(cnfire_li2014_type) :: cnfire_li2014_inst ! type(cnfire_li2016_type) :: cnfire_li2016_inst ! type(cnfire_li2021_type) :: cnfire_li2021_inst @@ -218,12 +217,12 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - cnfire_li2014_inst%forc_hdm(nc) = hdm(nc) - cnfire_li2014_inst%forc_lnfm(nc) = lnfm(nc) - cnfire_li2016_inst%forc_hdm(nc) = hdm(nc) - cnfire_li2016_inst%forc_lnfm(nc) = lnfm(nc) - cnfire_li2021_inst%forc_hdm(nc) = hdm(nc) - cnfire_li2021_inst%forc_lnfm(nc) = lnfm(nc) + bgc_vegetation_inst%cnfire_method%forc_hdm(nc) = hdm(nc) + bgc_vegetation_inst%cnfire_method%forc_lnfm(nc) = lnfm(nc) + ! cnfire_li2016_inst%forc_hdm(nc) = hdm(nc) + ! cnfire_li2016_inst%forc_lnfm(nc) = lnfm(nc) + ! cnfire_li2021_inst%forc_hdm(nc) = hdm(nc) + ! cnfire_li2021_inst%forc_lnfm(nc) = lnfm(nc) do nz = 1,num_zon ! CN zone loop From 3161b0981d3c54a8824e0cb0994f012a22d05796 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Mar 2023 07:42:16 -0500 Subject: [PATCH 391/589] fix pointers --- .../CLM51/CNCLM_CNFireBaseMod.F90 | 1 + .../CLM51/CNCLM_DriverMod.F90 | 13 +++++++------ .../CLM51/CNCLM_FireDataBaseType.F90 | 2 ++ 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 index dd8b32f33..0de42c7bd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -97,6 +97,7 @@ module CNFireBaseMod ! procedure, private :: InitHistory ! History file assignment of fire ! end type cnfire_base_type + type(cnfire_base_type), public, target, save :: cnfire_base_inst !----------------------------------------------------------------------- abstract interface diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 63caa7bfd..1314bb22b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -45,7 +45,8 @@ module CNCLM_DriverMod use CNFireLi2014Mod use CNFireLi2016Mod use CNFireLi2021Mod - + use CNFireBaseMod + implicit none private @@ -217,8 +218,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - bgc_vegetation_inst%cnfire_method%forc_hdm(nc) = hdm(nc) - bgc_vegetation_inst%cnfire_method%forc_lnfm(nc) = lnfm(nc) + fire_base_inst%forc_hdm(nc) = hdm(nc) + fire_base_inst%cnfire_method%forc_lnfm(nc) = lnfm(nc) ! cnfire_li2016_inst%forc_hdm(nc) = hdm(nc) ! cnfire_li2016_inst%forc_lnfm(nc) = lnfm(nc) ! cnfire_li2021_inst%forc_hdm(nc) = hdm(nc) @@ -262,9 +263,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m temperature_inst%t_ref2m_patch(p) = tairm(nc) temperature_inst%soila10_patch(p) = tg10d(nc) temperature_inst%t_a5min_patch(p) = t2m5d(nc) - cnfire_li2014_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) - cnfire_li2016_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) - cnfire_li2021_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + cnfire_base_inst%btran2_patch(p) = btran_fire(nc,nz) + ! cnfire_li2016_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + ! cnfire_li2021_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 index a416be6f7..5363b56b3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 @@ -39,6 +39,8 @@ module FireDataBaseType need_lightning_and_popdens ! Returns true if need lightning & popdens ! end type fire_base_type + + type(fire_base_type), public, target, save :: fire_base_inst !----------------------------------------------------------------------- abstract interface From c74bab30a7bc40cdd1247f4c9dc33c6723ac44d6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Mar 2023 10:36:52 -0500 Subject: [PATCH 392/589] code changes to pass Catchment information to fire code --- .../CLM51/CNCLM_DriverMod.F90 | 18 +++++++++--------- .../CLM51/CNFireLi2014Mod.F90 | 1 + .../CLM51/CNFireLi2016Mod.F90 | 2 +- .../CLM51/CNFireLi2021Mod.F90 | 2 +- 4 files changed, 12 insertions(+), 11 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 1314bb22b..0db0af121 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -218,12 +218,12 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - fire_base_inst%forc_hdm(nc) = hdm(nc) - fire_base_inst%cnfire_method%forc_lnfm(nc) = lnfm(nc) - ! cnfire_li2016_inst%forc_hdm(nc) = hdm(nc) - ! cnfire_li2016_inst%forc_lnfm(nc) = lnfm(nc) - ! cnfire_li2021_inst%forc_hdm(nc) = hdm(nc) - ! cnfire_li2021_inst%forc_lnfm(nc) = lnfm(nc) + cnfire_base_inst%forc_hdm(nc) = hdm(nc) + cnfire_base_inst%cnfire_method%forc_lnfm(nc) = lnfm(nc) + ! cnfire_li2016_inst%forc_hdm(nc) = hdm(nc) + ! cnfire_li2016_inst%forc_lnfm(nc) = lnfm(nc) + ! cnfire_li2021_inst%forc_hdm(nc) = hdm(nc) + ! cnfire_li2021_inst%forc_lnfm(nc) = lnfm(nc) do nz = 1,num_zon ! CN zone loop @@ -263,9 +263,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m temperature_inst%t_ref2m_patch(p) = tairm(nc) temperature_inst%soila10_patch(p) = tg10d(nc) temperature_inst%t_a5min_patch(p) = t2m5d(nc) - cnfire_base_inst%btran2_patch(p) = btran_fire(nc,nz) - ! cnfire_li2016_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) - ! cnfire_li2021_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + cnfire_li2014_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + cnfire_li2016_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + cnfire_li2021_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 index e7cddf019..341438bc1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 @@ -62,6 +62,7 @@ module CNFireLi2014Mod procedure, public :: CNFireArea ! Calculate fire area procedure, public :: CNFireFluxes end type cnfire_li2014_type + type(cnfire_li2014_type), public, target, save :: cnfire_li2014_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 index d7b44b0dc..34c3812fc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 @@ -60,7 +60,7 @@ module CNFireLi2016Mod procedure, public :: need_lightning_and_popdens procedure, public :: CNFireArea ! Calculate fire area end type cnfire_li2016_type - + type(cnfire_li2016_type), public, target, save :: cnfire_li2016_inst ! ! !PRIVATE MEMBER DATA: !----------------------------------------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 index a6b0c70b9..d69961366 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 @@ -60,7 +60,7 @@ module CNFireLi2021Mod procedure, public :: need_lightning_and_popdens procedure, public :: CNFireArea ! Calculate fire area end type cnfire_li2021_type - + type(cnfire_li2021_type), public, target, save :: cnfire_li2021_inst ! ! !PRIVATE MEMBER DATA: !----------------------------------------------------------------------- From c73b74f98fda684b46c95477d3248a277d69687e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Mar 2023 10:46:23 -0500 Subject: [PATCH 393/589] remove redundant declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 index 5363b56b3..5804be555 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 @@ -40,8 +40,7 @@ module FireDataBaseType ! end type fire_base_type - type(fire_base_type), public, target, save :: fire_base_inst - !----------------------------------------------------------------------- + !------------------------------------------------------------------------- abstract interface !----------------------------------------------------------------------- From 8410aaa195f334debdf51efbb48337687af9204b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Mar 2023 12:40:57 -0500 Subject: [PATCH 394/589] add new cn2clm_type to pass Catchment information to CLM nested fire types --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/CN2CLMType.F90 | 61 +++++++++++++++++++ .../CLM51/CNCLM_DriverMod.F90 | 11 ++-- .../CLM51/CNFireLi2014Mod.F90 | 12 ++++ .../CLM51/CNFireLi2016Mod.F90 | 9 +++ .../CLM51/CNFireLi2021Mod.F90 | 9 +++ .../CLM51/CN_init_mod.F90 | 5 ++ 7 files changed, 103 insertions(+), 5 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 29b6ed17d..a500e53b8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -18,6 +18,7 @@ set (srcs clm_varcon.F90 clm_varctl.F90 clm_varpar.F90 + CN2CLMType.F90 CNAnnualUpdateMod.F90 CNBalanceCheckMod.F90 CNCLM51_Photosynthesis.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 new file mode 100755 index 000000000..cd1bad0ba --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 @@ -0,0 +1,61 @@ +#include "MAPL_Generic.h" + +module CN2CLMType + + use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 + use nanMod , only : nan + use decompMod , only : bounds_type + use MAPL_ExceptionHandling + + ! !PUBLIC TYPES: + implicit none + save + +! +! !PUBLIC MEMBER FUNCTIONS: + + type, public :: cn2clm_type + + real(r8), pointer :: forc_hdm_cn2clm(:) ! Human population density + real(r8), pointer :: forc_lnfm_cn2clm(:) ! Lightning frequency + real(r8), pointer :: btran2_patch_cn2clm(:) ! patch root zone soil wetness factor (0 to 1) + contains + + procedure, public :: Init + + end type cn2clm_type + type(cn2clm_type), public, target, save :: cn2clm_inst + +contains + +!-------------------------------------------------------------- + subroutine Init(this, bounds) + + ! !DESCRIPTION: + ! Initialize CTSM canopy state type needed for calling CTSM routines + ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made + ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect + ! + ! !ARGUMENTS: + implicit none + ! INPUT/OUTPUT + type(bounds_type), intent(in) :: bounds + class(cn2clm_type) :: this + + ! LOCAL + integer :: begp, endp + integer :: begg, endg + + !--------------------------------- + + begp = bounds%begp ; endp = bounds%endp + begg = bounds%begg ; endg = bounds%endg + + + allocate(this%forc_hdm_cn2clm (begg:endg)) ; this%forc_hdm_cn2clm (:) = nan + allocate(this%forc_lnfm_cn2clm (begg:endg)) ; this%forc_lnfm_cn2clm (:) = nan + allocate(this%btran2_patch_cn2clm (begp:endp)) ; this%btran2_patch_cn2clm (:) = nan + + end subroutine Init + +end module CN2CLMType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 0db0af121..b801f5c37 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -46,6 +46,7 @@ module CNCLM_DriverMod use CNFireLi2016Mod use CNFireLi2021Mod use CNFireBaseMod + use CN2CLMType implicit none private @@ -218,8 +219,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) - cnfire_base_inst%forc_hdm(nc) = hdm(nc) - cnfire_base_inst%cnfire_method%forc_lnfm(nc) = lnfm(nc) + cn2clm_inst%forc_hdm_cn2clm(nc) = hdm(nc) + cn2clm_inst%forc_lnfm_cn2clm(nc) = lnfm(nc) ! cnfire_li2016_inst%forc_hdm(nc) = hdm(nc) ! cnfire_li2016_inst%forc_lnfm(nc) = lnfm(nc) ! cnfire_li2021_inst%forc_hdm(nc) = hdm(nc) @@ -263,9 +264,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m temperature_inst%t_ref2m_patch(p) = tairm(nc) temperature_inst%soila10_patch(p) = tg10d(nc) temperature_inst%t_a5min_patch(p) = t2m5d(nc) - cnfire_li2014_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) - cnfire_li2016_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) - cnfire_li2021_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + cn2clm_inst%btran2_patch_cn2clm(p) = btran_fire(nc,nz) + ! cnfire_li2016_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) + ! cnfire_li2021_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 index 341438bc1..ec8f4a922 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 @@ -45,6 +45,7 @@ module CNFireLi2014Mod use PatchType , only : patch use FireMethodType , only : fire_method_type use CNFireBaseMod , only : cnfire_base_type, cnfire_const, cnfire_params + use CN2CLMType ! use CNVegMatrixMod , only : matrix_update_fic, matrix_update_fin ! implicit none @@ -231,7 +232,12 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ fuelc => cnveg_carbonstate_inst%fuelc_col , & ! Output: [real(r8) (:) ] fuel avalability factor for Reg.C fuelc_crop => cnveg_carbonstate_inst%fuelc_crop_col & ! Output: [real(r8) (:) ] fuel avalability factor for Reg.A ) + + ! jkolassa Mar 2023: insert Catch values in CLM types + this%forc_hdm = cn2clm_inst%forc_hdm_cn2clm + this%forc_lnfm = cn2clm_inst%forc_lnfm_cn2clm + transient_landcover = run_has_transient_landcover() !pft to column average @@ -333,6 +339,11 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ ! call this%CNFire_calc_fire_root_wetness_Li2014(bounds, & ! num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & ! waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + + ! jkolassa Mar 2023: insert Catchment btran2 + + btran2 = cn2clm_inst%btran2_patch_cn2clm + do fp = 1, num_exposedvegp p = filter_exposedvegp(fp) c = patch%column(p) @@ -561,6 +572,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ c = filter_soilc(fc) g = col%gridcell(c) hdmlf=this%forc_hdm(g) + nfire(c) = 0._r8 if( cropf_col(c) < 1.0 )then if (trotr1_col(c)+trotr2_col(c)>0.6_r8) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 index 34c3812fc..17c38a1e3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 @@ -45,6 +45,7 @@ module CNFireLi2016Mod use SoilBiogeochemStateType , only : get_spinup_latitude_term use FireMethodType , only : fire_method_type use CNFireBaseMod , only : cnfire_base_type, cnfire_const, cnfire_params + use CN2CLMType ! implicit none private @@ -240,6 +241,10 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ fuelc => cnveg_carbonstate_inst%fuelc_col , & ! Output: [real(r8) (:) ] fuel load coutside cropland fuelc_crop => cnveg_carbonstate_inst%fuelc_crop_col & ! Output: [real(r8) (:) ] fuel load for cropland ) + + ! jkolassa Mar 2023: insert Catch values in CLM types + this%forc_hdm = cn2clm_inst%forc_hdm_cn2clm + this%forc_lnfm = cn2clm_inst%forc_lnfm_cn2clm transient_landcover = run_has_transient_landcover() @@ -351,6 +356,10 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ ! call this%CNFire_calc_fire_root_wetness_Li2014(bounds, & ! num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & ! waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + + ! jkolassa Mar 2023: insert Catchment btran2 + btran2 = cn2clm_inst%btran2_patch_cn2clm + do fp = 1, num_exposedvegp p = filter_exposedvegp(fp) c = patch%column(p) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 index d69961366..a55f105f9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 @@ -45,6 +45,7 @@ module CNFireLi2021Mod use SoilBiogeochemStateType , only : get_spinup_latitude_term use FireMethodType , only : fire_method_type use CNFireBaseMod , only : cnfire_base_type, cnfire_const, cnfire_params + use CN2CLMType ! implicit none private @@ -239,6 +240,10 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ fuelc => cnveg_carbonstate_inst%fuelc_col , & ! Output: [real(r8) (:) ] fuel load coutside cropland fuelc_crop => cnveg_carbonstate_inst%fuelc_crop_col & ! Output: [real(r8) (:) ] fuel load for cropland ) + + ! jkolassa Mar 2023: insert Catch values in CLM types + this%forc_hdm = cn2clm_inst%forc_hdm_cn2clm + this%forc_lnfm = cn2clm_inst%forc_lnfm_cn2clm transient_landcover = run_has_transient_landcover() @@ -350,6 +355,10 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ ! call this%CNFire_calc_fire_root_wetness_Li2021(bounds, & ! num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & ! waterstatebulk_inst, soilstate_inst, soil_water_retention_curve) + + ! jkolassa Mar 2023: insert Catchment btran2 + btran2 = cn2clm_inst%btran2_patch_cn2clm + do fp = 1, num_exposedvegp p = filter_exposedvegp(fp) c = patch%column(p) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 138bce238..1b4cba092 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -56,6 +56,7 @@ module CN_initMod use PhotosynthesisMod use CNVegetationFacade use initSubgridMod + use CN2CLMType use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn @@ -378,6 +379,10 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call init_decompcascade_cn(bounds, soilbiogeochem_state_inst) end if + ! initialize custom type used to pass Catchment information to nested CLM fire types + + call cn2clm_inst%Init (bounds) + end subroutine CN_init end module CN_initMod From a1cd89bf731b7dda36e54169570890c961a14cee Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Mar 2023 12:45:49 -0500 Subject: [PATCH 395/589] remove obsolete type declarations --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 | 1 - .../GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 | 1 - .../GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 | 2 +- 4 files changed, 2 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 index 0de42c7bd..168671f1f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -97,7 +97,7 @@ module CNFireBaseMod ! procedure, private :: InitHistory ! History file assignment of fire ! end type cnfire_base_type - type(cnfire_base_type), public, target, save :: cnfire_base_inst + !----------------------------------------------------------------------- abstract interface diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 index ec8f4a922..62185163b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2014Mod.F90 @@ -63,7 +63,6 @@ module CNFireLi2014Mod procedure, public :: CNFireArea ! Calculate fire area procedure, public :: CNFireFluxes end type cnfire_li2014_type - type(cnfire_li2014_type), public, target, save :: cnfire_li2014_inst character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 index 17c38a1e3..2fd6b4c58 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2016Mod.F90 @@ -61,7 +61,6 @@ module CNFireLi2016Mod procedure, public :: need_lightning_and_popdens procedure, public :: CNFireArea ! Calculate fire area end type cnfire_li2016_type - type(cnfire_li2016_type), public, target, save :: cnfire_li2016_inst ! ! !PRIVATE MEMBER DATA: !----------------------------------------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 index a55f105f9..21c87b792 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireLi2021Mod.F90 @@ -61,7 +61,7 @@ module CNFireLi2021Mod procedure, public :: need_lightning_and_popdens procedure, public :: CNFireArea ! Calculate fire area end type cnfire_li2021_type - type(cnfire_li2021_type), public, target, save :: cnfire_li2021_inst + ! ! !PRIVATE MEMBER DATA: !----------------------------------------------------------------------- From 39a1efe8dd6087b9a0a243d66c9ee05bef29e936 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Mar 2023 13:17:45 -0500 Subject: [PATCH 396/589] use consistent r8 definition --- .../GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 index cd1bad0ba..27d17a222 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN2CLMType.F90 @@ -2,7 +2,7 @@ module CN2CLMType - use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 + use shr_kind_mod , only : r8 => shr_kind_r8 use nanMod , only : nan use decompMod , only : bounds_type use MAPL_ExceptionHandling From 1dc1642d8073cd6229e4271ce66214a031d136cf Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Mar 2023 13:34:46 -0500 Subject: [PATCH 397/589] declare fireemis_inst --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index b801f5c37..b895f6c03 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -193,7 +193,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! type(ch4_type) :: ch4_inst ! type(photosyns_type) :: photosyns_inst ! type(energyflux_type) :: energyflux_inst -! type(fireemis_type) :: fireemis_inst + type(fireemis_type) :: fireemis_inst ! type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst ! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst ! type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst From a1fc663352fcd02db2b726213fbe34ff652ec996 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 9 Mar 2023 13:53:32 -0500 Subject: [PATCH 398/589] declare isotope types --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index b895f6c03..8d345a961 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -168,8 +168,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! type(bounds_type) :: bounds ! type(clumpfilter) :: filter ! type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst -! type(soilbiogeochem_carbonflux_type) :: c13_soilbiogeochem_carbonflux_inst -! type(soilbiogeochem_carbonflux_type) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type) :: c14_soilbiogeochem_carbonflux_inst ! type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst ! type(gridcell_type) :: grc ! type(cn_vegetation_type) :: bgc_vegetation_inst @@ -185,8 +185,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! type(frictionvel_type) :: frictionvel_inst ! type(active_layer_type) :: active_layer_inst ! type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst -! type(soilbiogeochem_carbonstate_type) :: c13_soilbiogeochem_carbonstate_inst -! type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst ! type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst ! type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst ! type(crop_type) :: crop_inst From c0ea79a21c5bae11ac46cea4c1395d6251e44b02 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 10 Mar 2023 15:10:40 -0500 Subject: [PATCH 399/589] fix dimensions of PSN pointers --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 08dfccf3b..3b6e203eb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -4717,8 +4717,8 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: ar1m real, dimension(:), pointer :: tpm real, dimension(:), pointer :: cnsum - real, dimension(:), pointer :: psnsunm - real, dimension(:), pointer :: psnsham + real, dimension(:,:,:), pointer :: psnsunm + real, dimension(:,:,:), pointer :: psnsham real, dimension(:), pointer :: sndzm real, dimension(:), pointer :: sndzm5d real, dimension(:), pointer :: asnowm From 68a9ac303a85457577beca1043f41528ee47fda3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 13 Mar 2023 11:40:08 -0400 Subject: [PATCH 400/589] corrent saturated zone moisture computation --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 3b6e203eb..161bebcb1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -6400,7 +6400,7 @@ subroutine Driver ( RC ) ! "btran" in the catchment zones; map into CN zones ! ------------------------------------------------- - sm(n,fsat) = 1.0 + sm(:,fsat) = 1.0 ! gkw: bt2 is unstressed region only (subtract saturated and wilting areas) do n = 1,ntiles From e8a77bd5a1681a5327ad6a9a72c565db80a98001 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 13 Mar 2023 13:21:34 -0400 Subject: [PATCH 401/589] correct TA_MIN initialization and add photosynthesis use statement --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 161bebcb1..22d409242 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -35,6 +35,7 @@ module GEOS_CatchCNCLM51GridCompMod use DragCoefficientsMod use CATCHMENT_CN_MODEL use CNCLM_DriverMod + use CNCLM_Photosynthesis use CN_initMod USE STIEGLITZSNOW, ONLY : & snow_albedo, StieglitzSnow_calc_tpsnow, N_CONSTIT, & @@ -6544,6 +6545,7 @@ subroutine Driver ( RC ) ! -------------------------------------------------------------------- istep = istep + 1 + TA_MIN(:) = 1000. ! running mean - reset accumulation period until greater than nstep ! fzeng & gkw: may not be exactly 2m, but it is consistent with t_ref2m in CN model From 2df27e01ab485f0f2745ae8d343ff7fc9d7e9494 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 13 Mar 2023 15:13:07 -0400 Subject: [PATCH 402/589] add function to compute leaf specific humidity --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/CNCLM51_Photosynthesis.F90 | 2 +- .../CLM51/QSatMod.F90 | 129 ++++++++++++++++++ 3 files changed, 131 insertions(+), 1 deletion(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/QSatMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index a500e53b8..02e390aa1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -106,6 +106,7 @@ set (srcs paramUtilMod.F90 perf_mod.F90 PhotosynthesisMod.F90 + QSatMod.F90 quadraticMod.F90 RootBiophysMod.F90 shr_abort_mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index cb7ee72b9..ddda87922 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -36,7 +36,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & lmrsha_out,parabs,btran_out) use MAPL_SatVaporMod - + use QSatMod , only: QSat ! INPUTS integer, intent(in) :: nch ! vector length diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/QSatMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/QSatMod.F90 new file mode 100755 index 000000000..9a17ce700 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/QSatMod.F90 @@ -0,0 +1,129 @@ +module QSatMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Computes saturation mixing ratio and the change in saturation + ! + ! !PUBLIC TYPES: + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: QSat + !----------------------------------------------------------------------- + + ! For water vapor (temperature range 0C-100C) + real(r8), parameter :: a0 = 6.11213476_r8 + real(r8), parameter :: a1 = 0.444007856_r8 + real(r8), parameter :: a2 = 0.143064234e-01_r8 + real(r8), parameter :: a3 = 0.264461437e-03_r8 + real(r8), parameter :: a4 = 0.305903558e-05_r8 + real(r8), parameter :: a5 = 0.196237241e-07_r8 + real(r8), parameter :: a6 = 0.892344772e-10_r8 + real(r8), parameter :: a7 = -0.373208410e-12_r8 + real(r8), parameter :: a8 = 0.209339997e-15_r8 + ! For derivative:water vapor + real(r8), parameter :: b0 = 0.444017302_r8 + real(r8), parameter :: b1 = 0.286064092e-01_r8 + real(r8), parameter :: b2 = 0.794683137e-03_r8 + real(r8), parameter :: b3 = 0.121211669e-04_r8 + real(r8), parameter :: b4 = 0.103354611e-06_r8 + real(r8), parameter :: b5 = 0.404125005e-09_r8 + real(r8), parameter :: b6 = -0.788037859e-12_r8 + real(r8), parameter :: b7 = -0.114596802e-13_r8 + real(r8), parameter :: b8 = 0.381294516e-16_r8 + ! For ice (temperature range -75C-0C) + real(r8), parameter :: c0 = 6.11123516_r8 + real(r8), parameter :: c1 = 0.503109514_r8 + real(r8), parameter :: c2 = 0.188369801e-01_r8 + real(r8), parameter :: c3 = 0.420547422e-03_r8 + real(r8), parameter :: c4 = 0.614396778e-05_r8 + real(r8), parameter :: c5 = 0.602780717e-07_r8 + real(r8), parameter :: c6 = 0.387940929e-09_r8 + real(r8), parameter :: c7 = 0.149436277e-11_r8 + real(r8), parameter :: c8 = 0.262655803e-14_r8 + ! For derivative:ice + real(r8), parameter :: d0 = 0.503277922_r8 + real(r8), parameter :: d1 = 0.377289173e-01_r8 + real(r8), parameter :: d2 = 0.126801703e-02_r8 + real(r8), parameter :: d3 = 0.249468427e-04_r8 + real(r8), parameter :: d4 = 0.313703411e-06_r8 + real(r8), parameter :: d5 = 0.257180651e-08_r8 + real(r8), parameter :: d6 = 0.133268878e-10_r8 + real(r8), parameter :: d7 = 0.394116744e-13_r8 + real(r8), parameter :: d8 = 0.498070196e-16_r8 + +contains + + !----------------------------------------------------------------------- + subroutine QSat (T, p, qs, es, qsdT, esdT) + ! + ! !DESCRIPTION: + ! Computes saturation mixing ratio and (optionally) the change in saturation mixing + ! ratio with respect to temperature. Mixing ratio and specific humidity are + ! approximately equal and can be treated as the same. + ! Reference: Polynomial approximations from: + ! Piotr J. Flatau, et al.,1992: Polynomial fits to saturation + ! vapor pressure. Journal of Applied Meteorology, 31, 1507-1513. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_TKFRZ + ! + ! !ARGUMENTS: + implicit none + real(r8), intent(in) :: T ! temperature (K) + real(r8), intent(in) :: p ! surface atmospheric pressure (pa) + real(r8), intent(out) :: qs ! humidity (kg/kg) + real(r8), intent(out), optional :: es ! vapor pressure (pa) + real(r8), intent(out), optional :: qsdT ! d(qs)/d(T) + real(r8), intent(out), optional :: esdT ! d(es)/d(T) + ! + ! !LOCAL VARIABLES: + real(r8) :: es_local ! local version of es (in case es is not present) + real(r8) :: esdT_local ! local version of esdT (in case esdT is not present) + real(r8) :: td,vp,vp1,vp2 + !----------------------------------------------------------------------- + + td = min(100.0_r8, max(-75.0_r8, T - SHR_CONST_TKFRZ)) + + if (td >= 0.0_r8) then + es_local = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 & + + td*(a5 + td*(a6 + td*(a7 + td*a8))))))) + else + es_local = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 & + + td*(c5 + td*(c6 + td*(c7 + td*c8))))))) + endif + + es_local = es_local * 100._r8 ! pa + vp = 1.0_r8 / (p - 0.378_r8*es_local) + vp1 = 0.622_r8 * vp + qs = es_local * vp1 ! kg/kg + if (present(es)) then + es = es_local + end if + + if (present(qsdT) .or. present(esdT)) then + if (td >= 0.0_r8) then + esdT_local = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 & + + td*(b5 + td*(b6 + td*(b7 + td*b8))))))) + else + esdT_local = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 & + + td*(d5 + td*(d6 + td*(d7 + td*d8))))))) + end if + + esdT_local = esdT_local * 100._r8 ! pa/K + vp2 = vp1 * vp + if (present(qsdT)) then + qsdT = esdT_local * vp2 * p ! 1 / K + end if + if (present(esdT)) then + esdT = esdT_local + end if + end if + + end subroutine QSat + +end module QSatMod From f585f1e598d0e0c03006aa754ab597436d239b14 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 13 Mar 2023 21:36:11 -0400 Subject: [PATCH 403/589] change QSat input types --- .../CLM51/CNCLM51_Photosynthesis.F90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index ddda87922..2bb76a829 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -125,11 +125,13 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, dimension (nch) :: oair ! Atmospheric O2 partial pressure (Pa) real, dimension (nch) :: deldT ! d(es)/d(T) real, dimension (nch) :: cair ! compute CO2 partial pressure - real, dimension (nch) :: rb ! boundary layer resistance (s/m) - real, dimension (nch) :: el ! vapor pressure on leaf surface [pa] - real, dimension (nch, NUM_ZON) :: qsatl ! leaf specific humidity [kg/kg] - real, dimension (nch, NUM_ZON) :: qsatldT ! derivative of "qsatl" on "t_veg" + real(r8), dimension (nch) :: rb ! boundary layer resistance (s/m) + real(r8), dimension (nch) :: el ! vapor pressure on leaf surface [pa] + real(r8), dimension (nch, NUM_ZON) :: qsatl ! leaf specific humidity [kg/kg] + real(r8), dimension (nch, NUM_ZON) :: qsatldT ! derivative of "qsatl" on "t_veg" real, dimension (nch, NUM_ZON) :: qaf ! canopy air humidity [kg/kg] + real(r8), dimension(nch,num_zon) :: tc_in + real(r8), dimension(nch) :: pbot_in ! local inputs to Photosynthesis in CLM space real(r8), dimension(nch*NUM_ZON*(numpft+1)) :: coszen_clm ! cosine solar zenith angle for next time step in CLM dimensions @@ -233,9 +235,13 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! leaf specific humidity !------------------------ + + tc_in = tc + pbot_in = pbot + do n = 1,nch do nz = 1,NUM_ZON - call QSat(tc(n,nz), pbot(n), qsatl(n,nz), & + call QSat(tc_in(n,nz), pbot_in(n), qsatl(n,nz), & el(n), & qsatldT(n,nz)) end do From b332ffc40a71c4cdd273e7fabac6ab27ae599ec6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 14 Mar 2023 11:33:02 -0400 Subject: [PATCH 404/589] prevent floating point exception at wetness 0 --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 2bb76a829..690fa94bb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -274,7 +274,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! and converted to [mm/s] soilstate_inst%hk_l_col (n,1:nlevgrnd) = 1000.*COND(nc)*(wet3(nc)**(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space ! and converted to [mm/s] - soilstate_inst%smp_l_col (n,1:nlevgrnd) = 1000.*PSIS(nc)*(wet3(nc)**(-bee(nc))) ! actual soil matric potential mapped to CLM space + soilstate_inst%smp_l_col (n,1:nlevgrnd) = 1000.*PSIS(nc)*(max(1.e-06_r8,wet3(nc))**(-bee(nc))) ! actual soil matric potential mapped to CLM space ! and converted to [mm] soilstate_inst%bsw_col (n,1:nlevgrnd) = bee(nc) ! Clapp-Hornberger 'b' soilstate_inst%sucsat_col (n,1:nlevgrnd) = 1000.*psis(nc)*(-1) ! minimum soil suction [mm] From 5e65a323138b4e63334dcaa1ffc38ea8ce0094fd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 14 Mar 2023 12:57:24 -0400 Subject: [PATCH 405/589] initialize LAI an SAI variables as 0 --- .../CLM51/CNCLM_CanopyStateType.F90 | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 238d52432..0fd61a59a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -108,17 +108,17 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) allocate(this%frac_veg_nosno_patch (begp:endp)) ; this%frac_veg_nosno_patch (:) = huge(1) allocate(this%frac_veg_nosno_alb_patch (begp:endp)) ; this%frac_veg_nosno_alb_patch (:) = 0 - allocate(this%tlai_patch (begp:endp)) ; this%tlai_patch (:) = nan - allocate(this%tsai_patch (begp:endp)) ; this%tsai_patch (:) = nan - allocate(this%elai_patch (begp:endp)) ; this%elai_patch (:) = nan - allocate(this%elai240_patch (begp:endp)) ; this%elai240_patch (:) = nan - allocate(this%esai_patch (begp:endp)) ; this%esai_patch (:) = nan - allocate(this%laisun_patch (begp:endp)) ; this%laisun_patch (:) = nan - allocate(this%laisha_patch (begp:endp)) ; this%laisha_patch (:) = nan - allocate(this%laisun_z_patch (begp:endp,1:nlevcan)) ; this%laisun_z_patch (:,:) = nan - allocate(this%laisha_z_patch (begp:endp,1:nlevcan)) ; this%laisha_z_patch (:,:) = nan - allocate(this%mlaidiff_patch (begp:endp)) ; this%mlaidiff_patch (:) = nan - allocate(this%annlai_patch (12,begp:endp)) ; this%annlai_patch (:,:) = nan + allocate(this%tlai_patch (begp:endp)) ; this%tlai_patch (:) = 0. + allocate(this%tsai_patch (begp:endp)) ; this%tsai_patch (:) = 0. + allocate(this%elai_patch (begp:endp)) ; this%elai_patch (:) = 0. + allocate(this%elai240_patch (begp:endp)) ; this%elai240_patch (:) = 0. + allocate(this%esai_patch (begp:endp)) ; this%esai_patch (:) = 0. + allocate(this%laisun_patch (begp:endp)) ; this%laisun_patch (:) = 0. + allocate(this%laisha_patch (begp:endp)) ; this%laisha_patch (:) = 0. + allocate(this%laisun_z_patch (begp:endp,1:nlevcan)) ; this%laisun_z_patch (:,:) = 0. + allocate(this%laisha_z_patch (begp:endp,1:nlevcan)) ; this%laisha_z_patch (:,:) = 0. + allocate(this%mlaidiff_patch (begp:endp)) ; this%mlaidiff_patch (:) = 0. + allocate(this%annlai_patch (12,begp:endp)) ; this%annlai_patch (:,:) = 0. allocate(this%stem_biomass_patch (begp:endp)) ; this%stem_biomass_patch (:) = nan allocate(this%leaf_biomass_patch (begp:endp)) ; this%leaf_biomass_patch (:) = nan allocate(this%htop_patch (begp:endp)) ; this%htop_patch (:) = nan From e3a09799cb65b7e888bb2bf39b016883ae7c6dd1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 14 Mar 2023 14:08:40 -0400 Subject: [PATCH 406/589] prevent floating point exception when LAI is 0 --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 690fa94bb..e5e98bec7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -340,7 +340,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_novegsol(num_novegsol) = p end if - waterdiagnosticbulk_inst%fdry_patch(p) = (1-fwet(nc))*elai(p)/(elai(p)+esai(p)) + waterdiagnosticbulk_inst%fdry_patch(p) = (1-fwet(nc))*elai(p)/max( elai(p)+esai(p), 1.e-06_r8 ) waterdiagnosticbulk_inst%fwet_patch(p) = fwet(nc) waterdiagnosticbulk_inst%fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet end do From 15fbab1a1a47e09c5a540cccd0bbb1929c35e6c0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 14 Mar 2023 14:46:51 -0400 Subject: [PATCH 407/589] add TwoStream function and fix use statements --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/CNCLM51_Photosynthesis.F90 | 4 +- .../CLM51/SurfaceAlbedoMod.F90 | 1699 +++++++++++++++++ 3 files changed, 1703 insertions(+), 1 deletion(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 02e390aa1..f1cb9b390 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -131,6 +131,7 @@ set (srcs SoilWaterRetentionCurveMod.F90 spmdMod.F90 subgridAveMod.F90 + SurfaceAlbedoMod.F90 SurfaceRadiationMod.F90 TridiagonalMod.F90 update_model_para4cn.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index e5e98bec7..dc6b339f2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -36,7 +36,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & lmrsha_out,parabs,btran_out) use MAPL_SatVaporMod - use QSatMod , only: QSat + use QSatMod , only : QSat + use SurfaceAlbedoMod , only : TwoStream + use SurfaceRadiationMod , only : CanopySunShadeFracs ! INPUTS integer, intent(in) :: nch ! vector length diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 new file mode 100755 index 000000000..32f1c5ce6 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 @@ -0,0 +1,1699 @@ +module SurfaceAlbedoMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Performs surface albedo calculations + ! + ! !PUBLIC TYPES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use landunit_varcon , only : istsoil, istcrop, istdlak + use clm_varcon , only : grlnd, namep + use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan + use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE + use pftconMod , only : pftcon + use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC + use AerosolMod , only : aerosol_type + use CanopyStateType , only : canopystate_type + use LakeStateType , only : lakestate_type + use SurfaceAlbedoType , only : surfalb_type + use TemperatureType , only : temperature_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + ! public :: SurfaceAlbedo_readnl + ! public :: SurfaceAlbedoInitTimeConst + ! public :: SurfaceAlbedo ! Surface albedo and two-stream fluxes + ! + ! !PRIVATE MEMBER FUNCTIONS: + ! private :: SoilAlbedo ! Determine ground surface albedo + public :: TwoStream ! Two-stream fluxes for canopy radiative transfer + ! + ! !PUBLIC DATA MEMBERS: + ! The CLM default albice values are too high. + ! Full-spectral albedo for land ice is ~0.5 (Paterson, Physics of Glaciers, 1994, p. 59) + ! This is the value used in CAM3 by Pritchard et al., GRL, 35, 2008. + + ! albedo land ice by waveband (1=vis, 2=nir) + real(r8), public :: albice(numrad) = (/ 0.80_r8, 0.55_r8 /) + + ! namelist default setting for inputting alblakwi + real(r8), public :: lake_melt_icealb(numrad) = (/ 0.10_r8, 0.10_r8/) + + ! albedo frozen lakes by waveband (1=vis, 2=nir) + ! unclear what the reference is for this + real(r8), private :: alblak(numrad) = (/0.60_r8, 0.40_r8/) + + ! albedo of melting lakes due to puddling, open water, or white ice + ! From D. Mironov (2010) Boreal Env. Research + ! To revert albedo of melting lakes to the cold snow-free value, set + ! lake_melt_icealb namelist to 0.60, 0.40 like alblak above. + real(r8), private :: alblakwi(numrad) + + ! Coefficient for calculating ice "fraction" for lake surface albedo + ! From D. Mironov (2010) Boreal Env. Research + real(r8), parameter :: calb = 95.6_r8 + + ! + ! !PRIVATE DATA MEMBERS: + logical, private :: snowveg_affects_radiation = .true. ! Whether snow on the vegetation canopy affects the radiation/albedo calculations + + ! + ! !PRIVATE DATA FUNCTIONS: + real(r8), allocatable, private :: albsat(:,:) ! wet soil albedo by color class and waveband (1=vis,2=nir) + real(r8), allocatable, private :: albdry(:,:) ! dry soil albedo by color class and waveband (1=vis,2=nir) + integer , allocatable, private :: isoicol(:) ! column soil color class + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- +! subroutine SurfaceAlbedo_readnl( NLFilename ) +! ! +! ! !DESCRIPTION: +! ! Read the namelist for SurfaceAlbedo +! ! +! ! !USES: +! use spmdMod , only : masterproc, mpicom +! use fileutils , only : getavu, relavu, opnfil +! use shr_nl_mod , only : shr_nl_find_group_name +! use shr_mpi_mod , only : shr_mpi_bcast +! ! +! ! !ARGUMENTS: +! character(len=*), intent(in) :: NLFilename ! Namelist filename +! ! +! ! !LOCAL VARIABLES: +! integer :: ierr ! error code +! integer :: unitn ! unit for namelist file +! character(len=*), parameter :: nmlname = "surfacealbedo_inparm" +! +! character(len=*), parameter :: subname = 'SurfaceAlbedo_readnl' +! !----------------------------------------------------------------------- +! +! namelist /surfacealbedo_inparm/ snowveg_affects_radiation +! +! if (masterproc) then +! unitn = getavu() +! write(iulog,*) 'Read in '//nmlname//' namelist' +! call opnfil (NLFilename, unitn, 'F') +! call shr_nl_find_group_name(unitn, nmlname, status=ierr) +! if (ierr == 0) then +! read(unitn, nml=surfacealbedo_inparm, iostat=ierr) +! if (ierr /= 0) then +! call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) +! end if +! else +! call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) +! end if +! call relavu( unitn ) +! end if +! +! call shr_mpi_bcast(snowveg_affects_radiation, mpicom) +! +! if (masterproc) then +! write(iulog,*) +! write(iulog,*) nmlname, ' settings' +! write(iulog,nml=surfacealbedo_inparm) +! write(iulog,*) +! end if +! +! end subroutine SurfaceAlbedo_readnl +! +! +! !----------------------------------------------------------------------- +! subroutine SurfaceAlbedoInitTimeConst(bounds) +! ! +! ! !DESCRIPTION: +! ! Initialize module time constant variables +! ! +! ! !USES: +! use shr_log_mod, only : errMsg => shr_log_errMsg +! use fileutils , only : getfil +! use abortutils , only : endrun +! use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_pio_openfile, ncd_pio_closefile +! use spmdMod , only : masterproc +! ! +! ! !ARGUMENTS: +! type(bounds_type), intent(in) :: bounds +! ! +! ! !LOCAL VARIABLES: +! integer :: c,g ! indices +! integer :: mxsoil_color ! maximum number of soil color classes +! type(file_desc_t) :: ncid ! netcdf id +! character(len=256) :: locfn ! local filename +! integer :: ier ! error status +! logical :: readvar +! integer ,pointer :: soic2d (:) ! read in - soil color +! !--------------------------------------------------------------------- +! +! ! Allocate module variable for soil color +! +! allocate(isoicol(bounds%begc:bounds%endc)) +! +! ! Determine soil color and number of soil color classes +! +! call getfil (fsurdat, locfn, 0) +! call ncd_pio_openfile (ncid, locfn, 0) +! +! call ncd_io(ncid=ncid, varname='mxsoil_color', flag='read', data=mxsoil_color, readvar=readvar) +! if ( .not. readvar ) then +! call endrun(msg=' ERROR: mxsoil_color NOT on surfdata file '//errMsg(sourcefile, __LINE__)) +! end if +! +! allocate(soic2d(bounds%begg:bounds%endg)) +! call ncd_io(ncid=ncid, varname='SOIL_COLOR', flag='read', data=soic2d, dim1name=grlnd, readvar=readvar) +! if (.not. readvar) then +! call endrun(msg=' ERROR: SOIL_COLOR NOT on surfdata file'//errMsg(sourcefile, __LINE__)) +! end if +! do c = bounds%begc, bounds%endc +! g = col%gridcell(c) +! isoicol(c) = soic2d(g) +! end do +! deallocate(soic2d) +! +! call ncd_pio_closefile(ncid) +! +! ! Determine saturated and dry soil albedos for n color classes and +! ! numrad wavebands (1=vis, 2=nir) +! +! allocate(albsat(mxsoil_color,numrad), albdry(mxsoil_color,numrad), stat=ier) +! if (ier /= 0) then +! write(iulog,*)'allocation error for albsat, albdry' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! if (masterproc) then +! write(iulog,*) 'Attempting to read soil colo data .....' +! end if +! +! if (mxsoil_color == 8) then +! albsat(1:8,1) = (/0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8/) +! albsat(1:8,2) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) +! albdry(1:8,1) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) +! albdry(1:8,2) = (/0.48_r8,0.44_r8,0.40_r8,0.36_r8,0.32_r8,0.28_r8,0.24_r8,0.20_r8/) +! else if (mxsoil_color == 20) then +! albsat(1:20,1) = (/0.25_r8,0.23_r8,0.21_r8,0.20_r8,0.19_r8,0.18_r8,0.17_r8,0.16_r8,& +! 0.15_r8,0.14_r8,0.13_r8,0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8,0.04_r8/) +! albsat(1:20,2) = (/0.50_r8,0.46_r8,0.42_r8,0.40_r8,0.38_r8,0.36_r8,0.34_r8,0.32_r8,& +! 0.30_r8,0.28_r8,0.26_r8,0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) +! albdry(1:20,1) = (/0.36_r8,0.34_r8,0.32_r8,0.31_r8,0.30_r8,0.29_r8,0.28_r8,0.27_r8,& +! 0.26_r8,0.25_r8,0.24_r8,0.23_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) +! albdry(1:20,2) = (/0.61_r8,0.57_r8,0.53_r8,0.51_r8,0.49_r8,0.48_r8,0.45_r8,0.43_r8,& +! 0.41_r8,0.39_r8,0.37_r8,0.35_r8,0.33_r8,0.31_r8,0.29_r8,0.27_r8,0.25_r8,0.23_r8,0.21_r8,0.16_r8/) +! else +! write(iulog,*)'maximum color class = ',mxsoil_color,' is not supported' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if +! +! ! Set alblakwi +! alblakwi(:) = lake_melt_icealb(:) +! +! end subroutine SurfaceAlbedoInitTimeConst +! +! !----------------------------------------------------------------------- +! subroutine SurfaceAlbedo(bounds,nc, & +! num_nourbanc, filter_nourbanc, & +! num_nourbanp, filter_nourbanp, & +! num_urbanc , filter_urbanc, & +! num_urbanp , filter_urbanp, & +! nextsw_cday , declinp1, & +! clm_fates, & +! aerosol_inst, canopystate_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, & +! lakestate_inst, temperature_inst, surfalb_inst) +! ! +! ! !DESCRIPTION: +! ! Surface albedo and two-stream fluxes +! ! Surface albedos. Also fluxes (per unit incoming direct and diffuse +! ! radiation) reflected, transmitted, and absorbed by vegetation. +! ! Calculate sunlit and shaded fluxes as described by +! ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to +! ! a multi-layer canopy to calculate APAR profile +! ! +! ! The calling sequence is: +! ! -> SurfaceAlbedo: albedos for next time step +! ! -> SoilAlbedo: soil/lake/glacier/wetland albedos +! ! -> SNICAR_RT: snow albedos: direct beam (SNICAR) +! ! -> SNICAR_RT: snow albedos: diffuse (SNICAR) +! ! -> TwoStream: absorbed, reflected, transmitted solar fluxes (vis dir,vis dif, nir dir, nir dif) +! ! +! ! Note that this is called with the "inactive_and_active" version of the filters, because +! ! the variables computed here are needed over inactive points that might later become +! ! active (due to landuse change). Thus, this routine cannot depend on variables that are +! ! only computed over active points. +! ! +! ! !USES: +! use shr_orb_mod +! use clm_time_manager , only : get_nstep +! use abortutils , only : endrun +! use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, use_fates +! use CLMFatesInterfaceMod, only : hlm_fates_interface_type +! +! ! !ARGUMENTS: +! type(bounds_type) , intent(in) :: bounds ! bounds +! integer , intent(in) :: nc ! clump index +! integer , intent(in) :: num_nourbanc ! number of columns in non-urban filter +! integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points +! integer , intent(in) :: num_nourbanp ! number of patches in non-urban filter +! integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points +! integer , intent(in) :: num_urbanc ! number of columns in urban filter +! integer , intent(in) :: filter_urbanc(:) ! column filter for urban points +! integer , intent(in) :: num_urbanp ! number of patches in urban filter +! integer , intent(in) :: filter_urbanp(:) ! patch filter for rban points +! real(r8) , intent(in) :: nextsw_cday ! calendar day at Greenwich (1.00, ..., days/year) +! real(r8) , intent(in) :: declinp1 ! declination angle (radians) for next time step +! type(hlm_fates_interface_type), intent(inout) :: clm_fates +! type(aerosol_type) , intent(in) :: aerosol_inst +! type(canopystate_type) , intent(in) :: canopystate_inst +! type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst +! type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst +! type(lakestate_type) , intent(in) :: lakestate_inst +! type(temperature_type) , intent(in) :: temperature_inst +! type(surfalb_type) , intent(inout) :: surfalb_inst +! ! +! ! !LOCAL VARIABLES: +! integer :: i ! index for layers [idx] +! integer :: aer ! index for sno_nbr_aer +! real(r8) :: extkn ! nitrogen allocation coefficient +! integer :: fp,fc,g,c,p,iv ! indices +! integer :: ib ! band index +! integer :: ic ! 0=unit incoming direct; 1=unit incoming diffuse +! real(r8) :: dinc ! lai+sai increment for canopy layer +! real(r8) :: dincmax ! maximum lai+sai increment for canopy layer +! real(r8) :: dincmax_sum ! cumulative sum of maximum lai+sai increment for canopy layer +! real(r8) :: laisum ! sum of canopy layer lai for error check +! real(r8) :: saisum ! sum of canopy layer sai for error check +! integer :: flg_slr ! flag for SNICAR (=1 if direct, =2 if diffuse) +! integer :: flg_snw_ice ! flag for SNICAR (=1 when called from CLM, =2 when called from sea-ice) +! integer :: num_vegsol ! number of vegetated patches where coszen>0 +! integer :: num_novegsol ! number of vegetated patches where coszen>0 +! integer :: filter_vegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 +! integer :: filter_novegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 +! real(r8) :: wl (bounds%begp:bounds%endp) ! fraction of LAI+SAI that is LAI +! real(r8) :: ws (bounds%begp:bounds%endp) ! fraction of LAI+SAI that is SAI +! real(r8) :: blai(bounds%begp:bounds%endp) ! lai buried by snow: tlai - elai +! real(r8) :: bsai(bounds%begp:bounds%endp) ! sai buried by snow: tsai - esai +! real(r8) :: coszen_gcell (bounds%begg:bounds%endg) ! cosine solar zenith angle for next time step (grc) +! real(r8) :: coszen_patch (bounds%begp:bounds%endp) ! cosine solar zenith angle for next time step (patch) +! real(r8) :: rho(bounds%begp:bounds%endp,numrad) ! leaf/stem refl weighted by fraction LAI and SAI +! real(r8) :: tau(bounds%begp:bounds%endp,numrad) ! leaf/stem tran weighted by fraction LAI and SAI +! real(r8) :: h2osno_total (bounds%begc:bounds%endc) ! total snow water (mm H2O) +! real(r8) :: albsfc (bounds%begc:bounds%endc,numrad) ! albedo of surface underneath snow (col,bnd) +! real(r8) :: albsnd(bounds%begc:bounds%endc,numrad) ! snow albedo (direct) +! real(r8) :: albsni(bounds%begc:bounds%endc,numrad) ! snow albedo (diffuse) +! real(r8) :: albsnd_pur (bounds%begc:bounds%endc,numrad) ! direct pure snow albedo (radiative forcing) +! real(r8) :: albsni_pur (bounds%begc:bounds%endc,numrad) ! diffuse pure snow albedo (radiative forcing) +! real(r8) :: albsnd_bc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without BC (radiative forcing) +! real(r8) :: albsni_bc (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without BC (radiative forcing) +! real(r8) :: albsnd_oc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without OC (radiative forcing) +! real(r8) :: albsni_oc (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without OC (radiative forcing) +! real(r8) :: albsnd_dst (bounds%begc:bounds%endc,numrad) ! direct snow albedo without dust (radiative forcing) +! real(r8) :: albsni_dst (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without dust (radiative forcing) +! real(r8) :: flx_absd_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (direct) [frc] +! real(r8) :: flx_absi_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (diffuse) [frc] +! real(r8) :: foo_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! dummy array for forcing calls +! real(r8) :: h2osno_liq (bounds%begc:bounds%endc,-nlevsno+1:0) ! liquid snow content (col,lyr) [kg m-2] +! real(r8) :: h2osno_ice (bounds%begc:bounds%endc,-nlevsno+1:0) ! ice content in snow (col,lyr) [kg m-2] +! integer :: snw_rds_in (bounds%begc:bounds%endc,-nlevsno+1:0) ! snow grain size sent to SNICAR (col,lyr) [microns] +! real(r8) :: mss_cnc_aer_in_frc_pur (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for forcing calculation (zero) (col,lyr,aer) [kg kg-1] +! real(r8) :: mss_cnc_aer_in_frc_bc (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for BC forcing (col,lyr,aer) [kg kg-1] +! real(r8) :: mss_cnc_aer_in_frc_oc (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for OC forcing (col,lyr,aer) [kg kg-1] +! real(r8) :: mss_cnc_aer_in_frc_dst (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for dust forcing (col,lyr,aer) [kg kg-1] +! real(r8) :: mss_cnc_aer_in_fdb (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of all aerosol species for feedback calculation (col,lyr,aer) [kg kg-1] +! real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero +! integer , parameter :: nband =numrad ! number of solar radiation waveband classes +! !----------------------------------------------------------------------- +! +! associate(& +! rhol => pftcon%rhol , & ! Input: leaf reflectance: 1=vis, 2=nir +! rhos => pftcon%rhos , & ! Input: stem reflectance: 1=vis, 2=nir +! taul => pftcon%taul , & ! Input: leaf transmittance: 1=vis, 2=nir +! taus => pftcon%taus , & ! Input: stem transmittance: 1=vis, 2=nir +! +! tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow +! tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index, no burying by snow +! elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow +! esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow +! +! frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) +! h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water content (col,lyr) [kg/m2] +! h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens content (col,lyr) [kg/m2] +! snw_rds => waterdiagnosticbulk_inst%snw_rds_col , & ! Input: [real(r8) (:,:) ] snow grain radius (col,lyr) [microns] +! +! mss_cnc_bcphi => aerosol_inst%mss_cnc_bcphi_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophilic BC (col,lyr) [kg/kg] +! mss_cnc_bcpho => aerosol_inst%mss_cnc_bcpho_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophobic BC (col,lyr) [kg/kg] +! mss_cnc_ocphi => aerosol_inst%mss_cnc_ocphi_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophilic OC (col,lyr) [kg/kg] +! mss_cnc_ocpho => aerosol_inst%mss_cnc_ocpho_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophobic OC (col,lyr) [kg/kg] +! mss_cnc_dst1 => aerosol_inst%mss_cnc_dst1_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 1 (col,lyr) [kg/kg] +! mss_cnc_dst2 => aerosol_inst%mss_cnc_dst2_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 2 (col,lyr) [kg/kg] +! mss_cnc_dst3 => aerosol_inst%mss_cnc_dst3_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 3 (col,lyr) [kg/kg] +! mss_cnc_dst4 => aerosol_inst%mss_cnc_dst4_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 4 (col,lyr) [kg/kg] +! +! fsun_z => surfalb_inst%fsun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer +! tlai_z => surfalb_inst%tlai_z_patch , & ! Output: [real(r8) (:,:) ] tlai increment for canopy layer +! tsai_z => surfalb_inst%tsai_z_patch , & ! Output: [real(r8) (:,:) ] tsai increment for canopy layer +! vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, sunlit leaf vcmax +! vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, shaded leaf vcmax +! ncan => surfalb_inst%ncan_patch , & ! Output: [integer (:) ] number of canopy layers +! nrad => surfalb_inst%nrad_patch , & ! Output: [integer (:) ] number of canopy layers, above snow for radiative transfer +! coszen_col => surfalb_inst%coszen_col , & ! Output: [real(r8) (:) ] cosine of solar zenith angle +! albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) +! albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) +! albsod => surfalb_inst%albsod_col , & ! Output: [real(r8) (:,:) ] direct-beam soil albedo (col,bnd) [frc] +! albsoi => surfalb_inst%albsoi_col , & ! Output: [real(r8) (:,:) ] diffuse soil albedo (col,bnd) [frc] +! albgrd_pur => surfalb_inst%albgrd_pur_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (direct) +! albgri_pur => surfalb_inst%albgri_pur_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (diffuse) +! albgrd_bc => surfalb_inst%albgrd_bc_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (direct) +! albgri_bc => surfalb_inst%albgri_bc_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (diffuse) +! albgrd_oc => surfalb_inst%albgrd_oc_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (direct) +! albgri_oc => surfalb_inst%albgri_oc_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (diffuse) +! albgrd_dst => surfalb_inst%albgrd_dst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (direct) +! albgri_dst => surfalb_inst%albgri_dst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (diffuse) +! albsnd_hst => surfalb_inst%albsnd_hst_col , & ! Output: [real(r8) (:,:) ] snow albedo, direct, for history files (col,bnd) [frc] +! albsni_hst => surfalb_inst%albsni_hst_col , & ! Output: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd) [frc] +! albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) +! albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) +! albdSF => surfalb_inst%albdSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (direct) +! albiSF => surfalb_inst%albiSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (diffuse) +! fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux +! fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux +! fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux +! fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux +! fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux +! fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux +! ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flux +! ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flux +! ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flux +! flx_absdv => surfalb_inst%flx_absdv_col , & ! Output: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): VIS [frc] +! flx_absdn => surfalb_inst%flx_absdn_col , & ! Output: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): NIR [frc] +! flx_absiv => surfalb_inst%flx_absiv_col , & ! Output: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): VIS [frc] +! flx_absin => surfalb_inst%flx_absin_col , & ! Output: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): NIR [frc] +! fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer +! fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer +! fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer +! fabi_sha_z => surfalb_inst%fabi_sha_z_patch & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer +! ) +! +! ! Cosine solar zenith angle for next time step +! +! do g = bounds%begg,bounds%endg +! coszen_gcell(g) = shr_orb_cosz (nextsw_cday, grc%lat(g), grc%lon(g), declinp1) +! end do +! do c = bounds%begc,bounds%endc +! g = col%gridcell(c) +! coszen_col(c) = coszen_gcell(g) +! end do +! do fp = 1,num_nourbanp +! p = filter_nourbanp(fp) +! g = patch%gridcell(p) +! coszen_patch(p) = coszen_gcell(g) +! end do +! +! ! Initialize output because solar radiation only done if coszen > 0 +! +! do ib = 1, numrad +! do fc = 1,num_nourbanc +! c = filter_nourbanc(fc) +! albsod(c,ib) = 0._r8 +! albsoi(c,ib) = 0._r8 +! albgrd(c,ib) = 0._r8 +! albgri(c,ib) = 0._r8 +! albgrd_pur(c,ib) = 0._r8 +! albgri_pur(c,ib) = 0._r8 +! albgrd_bc(c,ib) = 0._r8 +! albgri_bc(c,ib) = 0._r8 +! albgrd_oc(c,ib) = 0._r8 +! albgri_oc(c,ib) = 0._r8 +! albgrd_dst(c,ib) = 0._r8 +! albgri_dst(c,ib) = 0._r8 +! do i=-nlevsno+1,1,1 +! flx_absdv(c,i) = 0._r8 +! flx_absdn(c,i) = 0._r8 +! flx_absiv(c,i) = 0._r8 +! flx_absin(c,i) = 0._r8 +! enddo +! end do +! +! do fp = 1,num_nourbanp +! p = filter_nourbanp(fp) +! albd(p,ib) = 1._r8 +! albi(p,ib) = 1._r8 +! if (use_SSRE) then +! albdSF(p,ib) = 1._r8 +! albiSF(p,ib) = 1._r8 +! end if +! fabd(p,ib) = 0._r8 +! fabd_sun(p,ib) = 0._r8 +! fabd_sha(p,ib) = 0._r8 +! fabi(p,ib) = 0._r8 +! fabi_sun(p,ib) = 0._r8 +! fabi_sha(p,ib) = 0._r8 +! ftdd(p,ib) = 0._r8 +! ftid(p,ib) = 0._r8 +! ftii(p,ib) = 0._r8 +! end do +! +! end do ! end of numrad loop +! +! ! SoilAlbedo called before SNICAR_RT +! ! so that reflectance of soil beneath snow column is known +! ! ahead of time for snow RT calculation. +! +! ! Snow albedos +! ! Note that snow albedo routine will only compute nonzero snow albedos +! ! where h2osno> 0 and coszen > 0 +! +! ! Ground surface albedos +! ! Note that ground albedo routine will only compute nonzero snow albedos +! ! where coszen > 0 +! +! call SoilAlbedo(bounds, & +! num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! albsnd(bounds%begc:bounds%endc, :), & +! albsni(bounds%begc:bounds%endc, :), & +! lakestate_inst, temperature_inst, waterstatebulk_inst, surfalb_inst) +! +! ! set variables to pass to SNICAR. +! +! flg_snw_ice = 1 ! calling from CLM, not CSIM +! do c=bounds%begc,bounds%endc +! albsfc(c,:) = albsoi(c,:) +! h2osno_liq(c,:) = h2osoi_liq(c,-nlevsno+1:0) +! h2osno_ice(c,:) = h2osoi_ice(c,-nlevsno+1:0) +! snw_rds_in(c,:) = nint(snw_rds(c,:)) +! end do +! +! ! zero aerosol input arrays +! do aer = 1, sno_nbr_aer +! do i = -nlevsno+1, 0 +! do c = bounds%begc, bounds%endc +! mss_cnc_aer_in_frc_pur(c,i,aer) = 0._r8 +! mss_cnc_aer_in_frc_bc(c,i,aer) = 0._r8 +! mss_cnc_aer_in_frc_oc(c,i,aer) = 0._r8 +! mss_cnc_aer_in_frc_dst(c,i,aer) = 0._r8 +! mss_cnc_aer_in_fdb(c,i,aer) = 0._r8 +! end do +! end do +! end do +! +! ! Set aerosol input arrays +! ! feedback input arrays have been zeroed +! ! set soot and dust aerosol concentrations: +! if (DO_SNO_AER) then +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) +! +! ! DO_SNO_OC is set in SNICAR_varpar. Default case is to ignore OC concentrations because: +! ! 1) Knowledge of their optical properties is primitive +! ! 2) When 'water-soluble' OPAC optical properties are applied to OC in snow, +! ! it has a negligible darkening effect. +! if (DO_SNO_OC) then +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) +! endif +! +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) +! endif +! +! call waterstatebulk_inst%CalculateTotalH2osno(bounds, num_nourbanc, filter_nourbanc, & +! caller = 'SurfaceAlbedo', & +! h2osno_total = h2osno_total(bounds%begc:bounds%endc)) +! +! ! If radiative forcing is being calculated, first estimate clean-snow albedo +! +! if (use_snicar_frc) then +! ! 1. BC input array: +! ! set dust and (optionally) OC concentrations, so BC_FRC=[(BC+OC+dust)-(OC+dust)] +! mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) +! if (DO_SNO_OC) then +! mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) +! endif +! +! ! BC FORCING CALCULATIONS +! flg_slr = 1; ! direct-beam +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsnd_bc(bounds%begc:bounds%endc, :), & +! foo_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! +! flg_slr = 2; ! diffuse +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsni_bc(bounds%begc:bounds%endc, :), & +! foo_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! +! ! 2. OC input array: +! ! set BC and dust concentrations, so OC_FRC=[(BC+OC+dust)-(BC+dust)] +! if (DO_SNO_OC) then +! mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) +! +! ! OC FORCING CALCULATIONS +! flg_slr = 1; ! direct-beam +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsnd_oc(bounds%begc:bounds%endc, :), & +! foo_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! +! flg_slr = 2; ! diffuse +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsni_oc(bounds%begc:bounds%endc, :), & +! foo_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! endif +! +! ! 3. DUST input array: +! ! set BC and OC concentrations, so DST_FRC=[(BC+OC+dust)-(BC+OC)] +! mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) +! if (DO_SNO_OC) then +! mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) +! mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) +! endif +! +! ! DUST FORCING CALCULATIONS +! flg_slr = 1; ! direct-beam +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsnd_dst(bounds%begc:bounds%endc, :), & +! foo_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! +! flg_slr = 2; ! diffuse +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsni_dst(bounds%begc:bounds%endc, :), & +! foo_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! +! ! 4. ALL AEROSOL FORCING CALCULATION +! ! (pure snow albedo) +! flg_slr = 1; ! direct-beam +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_frc_pur(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsnd_pur(bounds%begc:bounds%endc, :), & +! foo_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! +! flg_slr = 2; ! diffuse +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_frc_pur(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsni_pur(bounds%begc:bounds%endc, :), & +! foo_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! end if +! +! ! CLIMATE FEEDBACK CALCULATIONS, ALL AEROSOLS: +! flg_slr = 1; ! direct-beam +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsnd(bounds%begc:bounds%endc, :), & +! flx_absd_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! +! flg_slr = 2; ! diffuse +! call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & +! coszen_col(bounds%begc:bounds%endc), & +! flg_slr, & +! h2osno_liq(bounds%begc:bounds%endc, :), & +! h2osno_ice(bounds%begc:bounds%endc, :), & +! h2osno_total(bounds%begc:bounds%endc), & +! snw_rds_in(bounds%begc:bounds%endc, :), & +! mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & +! albsfc(bounds%begc:bounds%endc, :), & +! albsni(bounds%begc:bounds%endc, :), & +! flx_absi_snw(bounds%begc:bounds%endc, :, :), & +! waterdiagnosticbulk_inst) +! +! ! ground albedos and snow-fraction weighting of snow absorption factors +! do ib = 1, nband +! do fc = 1,num_nourbanc +! c = filter_nourbanc(fc) +! if (coszen_col(c) > 0._r8) then +! ! ground albedo was originally computed in SoilAlbedo, but is now computed here +! ! because the order of SoilAlbedo and SNICAR_RT was switched for SNICAR. +! albgrd(c,ib) = albsod(c,ib)*(1._r8-frac_sno(c)) + albsnd(c,ib)*frac_sno(c) +! albgri(c,ib) = albsoi(c,ib)*(1._r8-frac_sno(c)) + albsni(c,ib)*frac_sno(c) +! +! ! albedos for radiative forcing calculations: +! if (use_snicar_frc) then +! ! BC forcing albedo +! albgrd_bc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_bc(c,ib)*frac_sno(c) +! albgri_bc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_bc(c,ib)*frac_sno(c) +! +! if (DO_SNO_OC) then +! ! OC forcing albedo +! albgrd_oc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_oc(c,ib)*frac_sno(c) +! albgri_oc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_oc(c,ib)*frac_sno(c) +! endif +! +! ! dust forcing albedo +! albgrd_dst(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_dst(c,ib)*frac_sno(c) +! albgri_dst(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_dst(c,ib)*frac_sno(c) +! +! ! pure snow albedo for all-aerosol radiative forcing +! albgrd_pur(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_pur(c,ib)*frac_sno(c) +! albgri_pur(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_pur(c,ib)*frac_sno(c) +! end if +! +! ! also in this loop (but optionally in a different loop for vectorized code) +! ! weight snow layer radiative absorption factors based on snow fraction and soil albedo +! ! (NEEDED FOR ENERGY CONSERVATION) +! do i = -nlevsno+1,1,1 +! if (.not. use_subgrid_fluxes .or. lun%itype(col%landunit(c)) == istdlak) then +! if (ib == 1) then +! flx_absdv(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & +! ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) +! flx_absiv(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & +! ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) +! elseif (ib == 2) then +! flx_absdn(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & +! ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) +! flx_absin(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & +! ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) +! endif +! else +! if (ib == 1) then +! flx_absdv(c,i) = flx_absd_snw(c,i,ib) +! flx_absiv(c,i) = flx_absi_snw(c,i,ib) +! elseif (ib == 2) then +! flx_absdn(c,i) = flx_absd_snw(c,i,ib) +! flx_absin(c,i) = flx_absi_snw(c,i,ib) +! endif +! endif +! enddo +! endif +! enddo +! enddo +! +! ! For diagnostics, set snow albedo to spval over non-snow non-urban points +! ! so that it is not averaged in history buffer (OPTIONAL) +! ! TODO - this is set to 0 not spval - seems wrong since it will be averaged in +! +! do ib = 1, nband +! do fc = 1,num_nourbanc +! c = filter_nourbanc(fc) +! if ((coszen_col(c) > 0._r8) .and. (h2osno_total(c) > 0._r8)) then +! albsnd_hst(c,ib) = albsnd(c,ib) +! albsni_hst(c,ib) = albsni(c,ib) +! else +! albsnd_hst(c,ib) = 0._r8 +! albsni_hst(c,ib) = 0._r8 +! endif +! enddo +! enddo +! +! ! Create solar-vegetated filter for the following calculations +! +! num_vegsol = 0 +! num_novegsol = 0 +! do fp = 1,num_nourbanp +! p = filter_nourbanp(fp) +! if (coszen_patch(p) > 0._r8) then +! if ((lun%itype(patch%landunit(p)) == istsoil .or. & +! lun%itype(patch%landunit(p)) == istcrop ) & +! .and. (elai(p) + esai(p)) > 0._r8) then +! num_vegsol = num_vegsol + 1 +! filter_vegsol(num_vegsol) = p +! else +! num_novegsol = num_novegsol + 1 +! filter_novegsol(num_novegsol) = p +! end if +! end if +! end do +! +! ! Weight reflectance/transmittance by lai and sai +! ! Only perform on vegetated patches where coszen > 0 +! +! do fp = 1,num_vegsol +! p = filter_vegsol(fp) +! wl(p) = elai(p) / max( elai(p)+esai(p), mpe ) +! ws(p) = esai(p) / max( elai(p)+esai(p), mpe ) +! end do +! +! do ib = 1, numrad +! do fp = 1,num_vegsol +! p = filter_vegsol(fp) +! rho(p,ib) = max( rhol(patch%itype(p),ib)*wl(p) + rhos(patch%itype(p),ib)*ws(p), mpe ) +! tau(p,ib) = max( taul(patch%itype(p),ib)*wl(p) + taus(patch%itype(p),ib)*ws(p), mpe ) +! end do +! end do +! +! ! Diagnose number of canopy layers for radiative transfer, in increments of dincmax. +! ! Add to number of layers so long as cumulative leaf+stem area does not exceed total +! ! leaf+stem area. Then add any remaining leaf+stem area to next layer and exit the loop. +! ! Do this first for elai and esai (not buried by snow) and then for the part of the +! ! canopy that is buried by snow. +! ! ------------------ +! ! tlai_z = leaf area increment for a layer +! ! tsai_z = stem area increment for a layer +! ! nrad = number of canopy layers above snow +! ! ncan = total number of canopy layers +! ! +! ! tlai_z summed from 1 to nrad = elai +! ! tlai_z summed from 1 to ncan = tlai +! +! ! tsai_z summed from 1 to nrad = esai +! ! tsai_z summed from 1 to ncan = tsai +! ! ------------------ +! ! +! ! Canopy layering needs to be done for all "num_nourbanp" not "num_vegsol" +! ! because layering is needed for all time steps regardless of radiation +! ! +! ! Sun/shade big leaf code uses only one layer (nrad = ncan = 1), triggered by +! ! nlevcan = 1 +! +! dincmax = 0.25_r8 +! do fp = 1,num_nourbanp +! p = filter_nourbanp(fp) +! +! if (nlevcan == 1) then +! nrad(p) = 1 +! ncan(p) = 1 +! tlai_z(p,1) = elai(p) +! tsai_z(p,1) = esai(p) +! else if (nlevcan > 1) then +! if (elai(p)+esai(p) == 0._r8) then +! nrad(p) = 0 +! else +! dincmax_sum = 0._r8 +! do iv = 1, nlevcan +! dincmax_sum = dincmax_sum + dincmax +! if (((elai(p)+esai(p))-dincmax_sum) > 1.e-06_r8) then +! nrad(p) = iv +! dinc = dincmax +! tlai_z(p,iv) = dinc * elai(p) / max(elai(p)+esai(p), mpe) +! tsai_z(p,iv) = dinc * esai(p) / max(elai(p)+esai(p), mpe) +! else +! nrad(p) = iv +! dinc = dincmax - (dincmax_sum - (elai(p)+esai(p))) +! tlai_z(p,iv) = dinc * elai(p) / max(elai(p)+esai(p), mpe) +! tsai_z(p,iv) = dinc * esai(p) / max(elai(p)+esai(p), mpe) +! exit +! end if +! end do +! +! ! Mimumum of 4 canopy layers +! +! if (nrad(p) < 4) then +! nrad(p) = 4 +! do iv = 1, nrad(p) +! tlai_z(p,iv) = elai(p) / nrad(p) +! tsai_z(p,iv) = esai(p) / nrad(p) +! end do +! end if +! end if +! end if +! +! ! Error check: make sure cumulative of increments does not exceed total +! +! laisum = 0._r8 +! saisum = 0._r8 +! do iv = 1, nrad(p) +! laisum = laisum + tlai_z(p,iv) +! saisum = saisum + tsai_z(p,iv) +! end do +! if (abs(laisum-elai(p)) > 1.e-06_r8 .or. abs(saisum-esai(p)) > 1.e-06_r8) then +! write (iulog,*) 'multi-layer canopy error 01 in SurfaceAlbedo: ',& +! nrad(p),elai(p),laisum,esai(p),saisum +! call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) +! end if +! +! ! Repeat to find canopy layers buried by snow +! +! if (nlevcan > 1) then +! blai(p) = tlai(p) - elai(p) +! bsai(p) = tsai(p) - esai(p) +! if (blai(p)+bsai(p) == 0._r8) then +! ncan(p) = nrad(p) +! else +! dincmax_sum = 0._r8 +! do iv = nrad(p)+1, nlevcan +! dincmax_sum = dincmax_sum + dincmax +! if (((blai(p)+bsai(p))-dincmax_sum) > 1.e-06_r8) then +! ncan(p) = iv +! dinc = dincmax +! tlai_z(p,iv) = dinc * blai(p) / max(blai(p)+bsai(p), mpe) +! tsai_z(p,iv) = dinc * bsai(p) / max(blai(p)+bsai(p), mpe) +! else +! ncan(p) = iv +! dinc = dincmax - (dincmax_sum - (blai(p)+bsai(p))) +! tlai_z(p,iv) = dinc * blai(p) / max(blai(p)+bsai(p), mpe) +! tsai_z(p,iv) = dinc * bsai(p) / max(blai(p)+bsai(p), mpe) +! exit +! end if +! end do +! end if +! +! ! Error check: make sure cumulative of increments does not exceed total +! +! laisum = 0._r8 +! saisum = 0._r8 +! do iv = 1, ncan(p) +! laisum = laisum + tlai_z(p,iv) +! saisum = saisum + tsai_z(p,iv) +! end do +! if (abs(laisum-tlai(p)) > 1.e-06_r8 .or. abs(saisum-tsai(p)) > 1.e-06_r8) then +! write (iulog,*) 'multi-layer canopy error 02 in SurfaceAlbedo: ',nrad(p),ncan(p) +! write (iulog,*) tlai(p),elai(p),blai(p),laisum,tsai(p),esai(p),bsai(p),saisum +! call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) +! end if +! end if +! +! end do +! +! ! Zero fluxes for active canopy layers +! +! do fp = 1,num_nourbanp +! p = filter_nourbanp(fp) +! do iv = 1, nrad(p) +! fabd_sun_z(p,iv) = 0._r8 +! fabd_sha_z(p,iv) = 0._r8 +! fabi_sun_z(p,iv) = 0._r8 +! fabi_sha_z(p,iv) = 0._r8 +! fsun_z(p,iv) = 0._r8 +! end do +! end do +! +! ! Default leaf to canopy scaling coefficients, used when coszen <= 0. +! ! This is the leaf nitrogen profile integrated over the full canopy. +! ! Integrate exp(-kn*x) over x=0 to x=elai and assign to shaded canopy, +! ! because sunlit fraction is 0. Canopy scaling coefficients are set in +! ! TwoStream for coszen > 0. So kn must be set here and in TwoStream. +! +! extkn = 0.30_r8 +! do fp = 1,num_nourbanp +! p = filter_nourbanp(fp) +! if (nlevcan == 1) then +! vcmaxcintsun(p) = 0._r8 +! vcmaxcintsha(p) = (1._r8 - exp(-extkn*elai(p))) / extkn +! if (elai(p) > 0._r8) then +! vcmaxcintsha(p) = vcmaxcintsha(p) / elai(p) +! else +! vcmaxcintsha(p) = 0._r8 +! end if +! else if (nlevcan > 1) then +! vcmaxcintsun(p) = 0._r8 +! vcmaxcintsha(p) = 0._r8 +! end if +! end do +! +! ! Calculate surface albedos and fluxes +! ! Only perform on vegetated pfts where coszen > 0 +! +! if (use_fates) then +! +! call clm_fates%wrap_canopy_radiation(bounds, nc, & +! num_vegsol, filter_vegsol, & +! coszen_patch(bounds%begp:bounds%endp), surfalb_inst) +! +! else +! +! call TwoStream (bounds, filter_vegsol, num_vegsol, & +! coszen_patch(bounds%begp:bounds%endp), & +! rho(bounds%begp:bounds%endp, :), & +! tau(bounds%begp:bounds%endp, :), & +! canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst) +! ! Run TwoStream again just to calculate the Snow Free (SF) albedo's +! if (use_SSRE) then +! if ( nlevcan > 1 )then +! call endrun( 'ERROR: use_ssre option was NOT developed with allowance for multi-layer canopy: '// & +! 'nlevcan can ONLY be 1 in when use_ssre is on') +! end if +! call TwoStream (bounds, filter_vegsol, num_vegsol, & +! coszen_patch(bounds%begp:bounds%endp), & +! rho(bounds%begp:bounds%endp, :), & +! tau(bounds%begp:bounds%endp, :), & +! canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst, & +! SFonly=.true.) +! end if +! +! endif +! +! ! Determine values for non-vegetated patches where coszen > 0 +! +! do ib = 1,numrad +! do fp = 1,num_novegsol +! p = filter_novegsol(fp) +! c = patch%column(p) +! fabd(p,ib) = 0._r8 +! fabd_sun(p,ib) = 0._r8 +! fabd_sha(p,ib) = 0._r8 +! fabi(p,ib) = 0._r8 +! fabi_sun(p,ib) = 0._r8 +! fabi_sha(p,ib) = 0._r8 +! ftdd(p,ib) = 1._r8 +! ftid(p,ib) = 0._r8 +! ftii(p,ib) = 1._r8 +! albd(p,ib) = albgrd(c,ib) +! albi(p,ib) = albgri(c,ib) +! if (use_SSRE) then +! albdSF(p,ib) = albsod(c,ib) +! albiSF(p,ib) = albsoi(c,ib) +! end if +! end do +! end do +! +! end associate +! +! end subroutine SurfaceAlbedo +! +! !----------------------------------------------------------------------- +! subroutine SoilAlbedo (bounds, & +! num_nourbanc, filter_nourbanc, & +! coszen, albsnd, albsni, & +! lakestate_inst, temperature_inst, waterstatebulk_inst, surfalb_inst) +! ! +! ! !DESCRIPTION: +! ! Determine ground surface albedo, accounting for snow +! ! +! ! !USES: +! use clm_varpar , only : numrad +! use clm_varcon , only : tfrz +! use landunit_varcon , only : istice_mec, istdlak +! use LakeCon , only : lakepuddling +! ! +! ! !ARGUMENTS: +! type(bounds_type) , intent(in) :: bounds +! integer , intent(in) :: num_nourbanc ! number of columns in non-urban points in column filter +! integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points +! real(r8), intent(in) :: coszen( bounds%begc: ) ! cos solar zenith angle next time step [col] +! real(r8), intent(in) :: albsnd( bounds%begc: , 1: ) ! snow albedo (direct) [col, numrad] +! real(r8), intent(in) :: albsni( bounds%begc: , 1: ) ! snow albedo (diffuse) [col, numrad] +! type(temperature_type) , intent(in) :: temperature_inst +! type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst +! type(lakestate_type) , intent(in) :: lakestate_inst +! type(surfalb_type) , intent(inout) :: surfalb_inst +! ! +! ! !LOCAL VARIABLES: +! ! +! integer, parameter :: nband =numrad ! number of solar radiation waveband classes +! integer :: fc ! non-urban filter column index +! integer :: c,l ! indices +! integer :: ib ! waveband number (1=vis, 2=nir) +! real(r8) :: inc ! soil water correction factor for soil albedo +! integer :: soilcol ! soilcolor +! real(r8) :: sicefr ! Lake surface ice fraction (based on D. Mironov 2010) +! !----------------------------------------------------------------------- +! +! ! Enforce expected array sizes +! SHR_ASSERT_ALL_FL((ubound(coszen) == (/bounds%endc/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(albsnd) == (/bounds%endc, numrad/)), sourcefile, __LINE__) +! SHR_ASSERT_ALL_FL((ubound(albsni) == (/bounds%endc, numrad/)), sourcefile, __LINE__) +! +! associate(& +! snl => col%snl , & ! Input: [integer (:) ] number of snow layers +! +! t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) +! +! h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water [m3/m3] +! +! lake_icefrac => lakestate_inst%lake_icefrac_col , & ! Input: [real(r8) (:,:) ] mass fraction of lake layer that is frozen +! +! albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) +! albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) +! albsod => surfalb_inst%albsod_col , & ! Output: [real(r8) (:,:) ] soil albedo (direct) +! albsoi => surfalb_inst%albsoi_col & ! Output: [real(r8) (:,:) ] soil albedo (diffuse) +! ) +! +! ! Compute soil albedos +! +! do ib = 1, nband +! do fc = 1,num_nourbanc +! c = filter_nourbanc(fc) +! if (coszen(c) > 0._r8) then +! l = col%landunit(c) +! +! if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then ! soil +! inc = max(0.11_r8-0.40_r8*h2osoi_vol(c,1), 0._r8) +! soilcol = isoicol(c) +! ! changed from local variable to clm_type: +! !albsod = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) +! !albsoi = albsod +! albsod(c,ib) = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) +! albsoi(c,ib) = albsod(c,ib) +! else if (lun%itype(l) == istice_mec) then ! land ice +! ! changed from local variable to clm_type: +! !albsod = albice(ib) +! !albsoi = albsod +! albsod(c,ib) = albice(ib) +! albsoi(c,ib) = albsod(c,ib) +! ! unfrozen lake, wetland +! else if (t_grnd(c) > tfrz .or. (lakepuddling .and. lun%itype(l) == istdlak .and. t_grnd(c) == tfrz .and. & +! lake_icefrac(c,1) < 1._r8 .and. lake_icefrac(c,2) > 0._r8) ) then +! +! albsod(c,ib) = 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8) +! ! This expression is apparently from BATS according to Yongjiu Dai. +! +! ! The diffuse albedo should be an average over the whole sky of an angular-dependent direct expression. +! ! The expression above may have been derived to encompass both (e.g. Henderson-Sellers 1986), +! ! but I'll assume it applies more appropriately to the direct form for now. +! +! ! ZMS: Attn EK, currently restoring this for wetlands even though it is wrong in order to try to get +! ! bfb baseline comparison when no lakes are present. I'm assuming wetlands will be phased out anyway. +! if (lun%itype(l) == istdlak) then +! albsoi(c,ib) = 0.10_r8 +! else +! albsoi(c,ib) = albsod(c,ib) +! end if +! +! else ! frozen lake, wetland +! ! Introduce crude surface frozen fraction according to D. Mironov (2010) +! ! Attn EK: This formulation is probably just as good for "wetlands" if they are not phased out. +! ! Tenatively I'm restricting this to lakes because I haven't tested it for wetlands. But if anything +! ! the albedo should be lower when melting over frozen ground than a solid frozen lake. +! ! +! if (lun%itype(l) == istdlak .and. .not. lakepuddling .and. snl(c) == 0) then +! ! Need to reference snow layers here because t_grnd could be over snow or ice +! ! but we really want the ice surface temperature with no snow +! sicefr = 1._r8 - exp(-calb * (tfrz - t_grnd(c))/tfrz) +! albsod(c,ib) = sicefr*alblak(ib) + (1._r8-sicefr)*max(alblakwi(ib), & +! 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8)) +! albsoi(c,ib) = sicefr*alblak(ib) + (1._r8-sicefr)*max(alblakwi(ib), 0.10_r8) +! ! Make sure this is no less than the open water albedo above. +! ! Setting lake_melt_icealb(:) = alblak(:) in namelist reverts the melting albedo to the cold +! ! snow-free value. +! else +! albsod(c,ib) = alblak(ib) +! albsoi(c,ib) = albsod(c,ib) +! end if +! end if +! +! ! Weighting is done in SurfaceAlbedo, after the call to SNICAR_RT +! ! This had to be done, because SoilAlbedo is called before SNICAR_RT, so at +! ! this point, snow albedo is not yet known. +! end if +! end do +! end do +! +! end associate +! end subroutine SoilAlbedo +! + !----------------------------------------------------------------------- + subroutine TwoStream (bounds, & + filter_vegsol, num_vegsol, & + coszen, rho, tau, & + canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst, & + SFonly) + ! + ! !DESCRIPTION: + ! Two-stream fluxes for canopy radiative transfer + ! Use two-stream approximation of Dickinson (1983) Adv Geophysics + ! 25:305-353 and Sellers (1985) Int J Remote Sensing 6:1335-1372 + ! to calculate fluxes absorbed by vegetation, reflected by vegetation, + ! and transmitted through vegetation for unit incoming direct or diffuse + ! flux given an underlying surface with known albedo. + ! Calculate sunlit and shaded fluxes as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy to calculate APAR profile + ! + ! !USES: + use clm_varpar, only : numrad, nlevcan + use clm_varcon, only : omegas, tfrz, betads, betais + use clm_varctl, only : iulog + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: filter_vegsol (:) ! filter for vegetated patches with coszen>0 + integer , intent(in) :: num_vegsol ! number of vegetated patches where coszen>0 + real(r8), intent(in) :: coszen( bounds%begp: ) ! cosine solar zenith angle for next time step [pft] + real(r8), intent(in) :: rho( bounds%begp: , 1: ) ! leaf/stem refl weighted by fraction LAI and SAI [pft, numrad] + real(r8), intent(in) :: tau( bounds%begp: , 1: ) ! leaf/stem tran weighted by fraction LAI and SAI [pft, numrad] + type(canopystate_type) , intent(in) :: canopystate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(surfalb_type) , intent(inout) :: surfalb_inst + logical, optional , intent(in) :: SFonly ! If should just calculate the Snow Free albedos + ! + ! !LOCAL VARIABLES: + integer :: fp,p,c,iv ! array indices + integer :: ib ! waveband number + real(r8) :: cosz ! 0.001 <= coszen <= 1.000 + real(r8) :: asu ! single scattering albedo + real(r8) :: chil(bounds%begp:bounds%endp) ! -0.4 <= xl <= 0.6 + real(r8) :: gdir(bounds%begp:bounds%endp) ! leaf projection in solar direction (0 to 1) + real(r8) :: twostext(bounds%begp:bounds%endp)! optical depth of direct beam per unit leaf area + real(r8) :: avmu(bounds%begp:bounds%endp) ! average diffuse optical depth + real(r8) :: omega(bounds%begp:bounds%endp,numrad) ! fraction of intercepted radiation that is scattered (0 to 1) + real(r8) :: omegal ! omega for leaves + real(r8) :: betai ! upscatter parameter for diffuse radiation + real(r8) :: betail ! betai for leaves + real(r8) :: betad ! upscatter parameter for direct beam radiation + real(r8) :: betadl ! betad for leaves + real(r8) :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 ! temporary + real(r8) :: p1,p2,p3,p4,s1,s2,u1,u2,u3 ! temporary + real(r8) :: b,c1,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 ! temporary + real(r8) :: phi1,phi2,sigma ! temporary + real(r8) :: temp1 ! temporary + real(r8) :: temp0 (bounds%begp:bounds%endp) ! temporary + real(r8) :: temp2(bounds%begp:bounds%endp) ! temporary + real(r8) :: t1 ! temporary + real(r8) :: a1,a2 ! parameter for sunlit/shaded leaf radiation absorption + real(r8) :: v,dv,u,du ! temporary for flux derivatives + real(r8) :: dh2,dh3,dh5,dh6,dh7,dh8,dh9,dh10 ! temporary for flux derivatives + real(r8) :: da1,da2 ! temporary for flux derivatives + real(r8) :: d_ftid,d_ftii ! ftid, ftii derivative with respect to lai+sai + real(r8) :: d_fabd,d_fabi ! fabd, fabi derivative with respect to lai+sai + real(r8) :: d_fabd_sun,d_fabd_sha ! fabd_sun, fabd_sha derivative with respect to lai+sai + real(r8) :: d_fabi_sun,d_fabi_sha ! fabi_sun, fabi_sha derivative with respect to lai+sai + real(r8) :: laisum ! cumulative lai+sai for canopy layer (at middle of layer) + real(r8) :: extkb ! direct beam extinction coefficient + real(r8) :: extkn ! nitrogen allocation coefficient + logical :: lSFonly ! Local version of SFonly (Snow Free) flag + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL_FL((ubound(coszen) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(rho) == (/bounds%endp, numrad/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(tau) == (/bounds%endp, numrad/)), sourcefile, __LINE__) + + if ( present(SFonly) )then + lSFonly = SFonly + else + lSFonly = .false. + end if + + associate(& + xl => pftcon%xl , & ! Input: ecophys const - leaf/stem orientation index + + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + + fwet => waterdiagnosticbulk_inst%fwet_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is wet (0 to 1) + fcansno => waterdiagnosticbulk_inst%fcansno_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is snow-covered (0 to 1) + + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + + tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] tlai increment for canopy layer + tsai_z => surfalb_inst%tsai_z_patch , & ! Input: [real(r8) (:,:) ] tsai increment for canopy layer + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer + albgrd => surfalb_inst%albgrd_col , & ! Input: [real(r8) (:,:) ] ground albedo (direct) (column-level) + albgri => surfalb_inst%albgri_col , & ! Input: [real(r8) (:,:) ] ground albedo (diffuse)(column-level) + + ! For non-Snow Free + fsun_z => surfalb_inst%fsun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer + vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, sunlit leaf vcmax + vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, shaded leaf vcmax + fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + fabi_sha_z => surfalb_inst%fabi_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) + fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flx + ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flx + ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flx + + ! Needed for SF Snow free case + albsod => surfalb_inst%albsod_col , & ! Input: [real(r8) (:,:) ] soil albedo (direct) + albsoi => surfalb_inst%albsoi_col , & ! Input: [real(r8) (:,:) ] soil albedo (diffuse) + albdSF => surfalb_inst%albdSF_patch , & ! Output: [real(r8) (:,:) ] Snow Free surface albedo (direct) + albiSF => surfalb_inst%albiSF_patch & ! Output: [real(r8) (:,:) ] Snow Free surface albedo (diffuse) + ) + + ! Calculate two-stream parameters that are independent of waveband: + ! chil, gdir, twostext, avmu, and temp0 and temp2 (used for asu) + + do fp = 1,num_vegsol + p = filter_vegsol(fp) + + ! note that the following limit only acts on cosz values > 0 and less than + ! 0.001, not on values cosz = 0, since these zero have already been filtered + ! out in filter_vegsol + cosz = max(0.001_r8, coszen(p)) + + chil(p) = min( max(xl(patch%itype(p)), -0.4_r8), 0.6_r8 ) + if (abs(chil(p)) <= 0.01_r8) chil(p) = 0.01_r8 + phi1 = 0.5_r8 - 0.633_r8*chil(p) - 0.330_r8*chil(p)*chil(p) + phi2 = 0.877_r8 * (1._r8-2._r8*phi1) + gdir(p) = phi1 + phi2*cosz + twostext(p) = gdir(p)/cosz + avmu(p) = ( 1._r8 - phi1/phi2 * log((phi1+phi2)/phi1) ) / phi2 + ! Restrict this calculation of temp0. We have seen cases where small temp0 + ! can cause unrealistic single scattering albedo (asu) associated with the + ! log calculation in temp2 below, thereby eventually causing a negative soil albedo + ! See bugzilla bug 2431: http://bugs.cgd.ucar.edu/show_bug.cgi?id=2431 + temp0(p) = max(gdir(p) + phi2*cosz,1.e-6_r8) + temp1 = phi1*cosz + temp2(p) = ( 1._r8 - temp1/temp0(p) * log((temp1+temp0(p))/temp1) ) + end do + + ! Loop over all wavebands to calculate for the full canopy the scattered fluxes + ! reflected upward and transmitted downward by the canopy and the flux absorbed by the + ! canopy for a unit incoming direct beam and diffuse flux at the top of the canopy given + ! an underlying surface of known albedo. + ! + ! Output: + ! ------------------ + ! Direct beam fluxes + ! ------------------ + ! albd - Upward scattered flux above canopy (per unit direct beam flux) + ! ftid - Downward scattered flux below canopy (per unit direct beam flux) + ! ftdd - Transmitted direct beam flux below canopy (per unit direct beam flux) + ! fabd - Flux absorbed by canopy (per unit direct beam flux) + ! fabd_sun - Sunlit portion of fabd + ! fabd_sha - Shaded portion of fabd + ! fabd_sun_z - absorbed sunlit leaf direct PAR (per unit sunlit lai+sai) for each canopy layer + ! fabd_sha_z - absorbed shaded leaf direct PAR (per unit shaded lai+sai) for each canopy layer + ! ------------------ + ! Diffuse fluxes + ! ------------------ + ! albi - Upward scattered flux above canopy (per unit diffuse flux) + ! ftii - Downward scattered flux below canopy (per unit diffuse flux) + ! fabi - Flux absorbed by canopy (per unit diffuse flux) + ! fabi_sun - Sunlit portion of fabi + ! fabi_sha - Shaded portion of fabi + ! fabi_sun_z - absorbed sunlit leaf diffuse PAR (per unit sunlit lai+sai) for each canopy layer + ! fabi_sha_z - absorbed shaded leaf diffuse PAR (per unit shaded lai+sai) for each canopy layer + + do ib = 1, numrad + do fp = 1,num_vegsol + p = filter_vegsol(fp) + c = patch%column(p) + + ! Calculate two-stream parameters omega, betad, and betai. + ! Omega, betad, betai are adjusted for snow. Values for omega*betad + ! and omega*betai are calculated and then divided by the new omega + ! because the product omega*betai, omega*betad is used in solution. + ! Also, the transmittances and reflectances (tau, rho) are linear + ! weights of leaf and stem values. + + omegal = rho(p,ib) + tau(p,ib) + asu = 0.5_r8*omegal*gdir(p)/temp0(p) *temp2(p) + betadl = (1._r8+avmu(p)*twostext(p))/(omegal*avmu(p)*twostext(p))*asu + betail = 0.5_r8 * ((rho(p,ib)+tau(p,ib)) + (rho(p,ib)-tau(p,ib)) & + * ((1._r8+chil(p))/2._r8)**2) / omegal + + if ( lSFonly .or. ( (.not. snowveg_affects_radiation) .and. (t_veg(p) > tfrz) ) ) then + ! Keep omega, betad, and betai as they are (for Snow free case or + ! when there is no snow + tmp0 = omegal + tmp1 = betadl + tmp2 = betail + else + ! Adjust omega, betad, and betai for intercepted snow + if (snowveg_affects_radiation) then + tmp0 = (1._r8-fcansno(p))*omegal + fcansno(p)*omegas(ib) + tmp1 = ( (1._r8-fcansno(p))*omegal*betadl + fcansno(p)*omegas(ib)*betads ) / tmp0 + tmp2 = ( (1._r8-fcansno(p))*omegal*betail + fcansno(p)*omegas(ib)*betais ) / tmp0 + else + tmp0 = (1._r8-fwet(p))*omegal + fwet(p)*omegas(ib) + tmp1 = ( (1._r8-fwet(p))*omegal*betadl + fwet(p)*omegas(ib)*betads ) / tmp0 + tmp2 = ( (1._r8-fwet(p))*omegal*betail + fwet(p)*omegas(ib)*betais ) / tmp0 + end if + end if ! end Snow free + + omega(p,ib) = tmp0 + betad = tmp1 + betai = tmp2 + + ! Common terms + + b = 1._r8 - omega(p,ib) + omega(p,ib)*betai + c1 = omega(p,ib)*betai + tmp0 = avmu(p)*twostext(p) + d = tmp0 * omega(p,ib)*betad + f = tmp0 * omega(p,ib)*(1._r8-betad) + tmp1 = b*b - c1*c1 + h = sqrt(tmp1) / avmu(p) + sigma = tmp0*tmp0 - tmp1 + p1 = b + avmu(p)*h + p2 = b - avmu(p)*h + p3 = b + tmp0 + p4 = b - tmp0 + + ! Absorbed, reflected, transmitted fluxes per unit incoming radiation + ! for full canopy + + t1 = min(h*(elai(p)+esai(p)), 40._r8) + s1 = exp(-t1) + t1 = min(twostext(p)*(elai(p)+esai(p)), 40._r8) + s2 = exp(-t1) + + ! Direct beam + if ( .not. lSFonly )then + u1 = b - c1/albgrd(c,ib) + u2 = b - c1*albgrd(c,ib) + u3 = f + c1*albgrd(c,ib) + else + ! Snow Free (SF) only + ! albsod instead of albgrd here: + u1 = b - c1/albsod(c,ib) + u2 = b - c1*albsod(c,ib) + u3 = f + c1*albsod(c,ib) + end if + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h1 = -d*p4 - c1*f + tmp6 = d - h1*p3/sigma + tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2 + h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1 + h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1 + h4 = -f*p3 - c1*d + tmp8 = h4/sigma + tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2 + h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2 + h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2 + if ( .not. lSFonly )then + albd(p,ib) = h1/sigma + h2 + h3 + ftid(p,ib) = h4*s2/sigma + h5*s1 + h6/s1 + ftdd(p,ib) = s2 + fabd(p,ib) = 1._r8 - albd(p,ib) - (1._r8-albgrd(c,ib))*ftdd(p,ib) - (1._r8-albgri(c,ib))*ftid(p,ib) + else + albdSF(p,ib) = h1/sigma + h2 + h3 + end if + + + a1 = h1 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & + + h2 * (1._r8 - s2*s1) / (twostext(p) + h) & + + h3 * (1._r8 - s2/s1) / (twostext(p) - h) + + a2 = h4 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & + + h5 * (1._r8 - s2*s1) / (twostext(p) + h) & + + h6 * (1._r8 - s2/s1) / (twostext(p) - h) + if ( .not. lSFonly )then + fabd_sun(p,ib) = (1._r8 - omega(p,ib)) * ( 1._r8 - s2 + 1._r8 / avmu(p) * (a1 + a2) ) + fabd_sha(p,ib) = fabd(p,ib) - fabd_sun(p,ib) + end if + + ! Diffuse + if ( .not. lSFonly )then + u1 = b - c1/albgri(c,ib) + u2 = b - c1*albgri(c,ib) + else + ! Snow Free (SF) only + ! albsoi instead of albgri here: + u1 = b - c1/albsoi(c,ib) + u2 = b - c1*albsoi(c,ib) + end if + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h7 = (c1*tmp2) / (d1*s1) + h8 = (-c1*tmp3*s1) / d1 + h9 = tmp4 / (d2*s1) + h10 = (-tmp5*s1) / d2 + + + ! Final Snow Free albedo + if ( lSFonly )then + albiSF(p,ib) = h7 + h8 + else + ! For non snow Free case, adjustments continue + albi(p,ib) = h7 + h8 + ftii(p,ib) = h9*s1 + h10/s1 + fabi(p,ib) = 1._r8 - albi(p,ib) - (1._r8-albgri(c,ib))*ftii(p,ib) + + a1 = h7 * (1._r8 - s2*s1) / (twostext(p) + h) + h8 * (1._r8 - s2/s1) / (twostext(p) - h) + a2 = h9 * (1._r8 - s2*s1) / (twostext(p) + h) + h10 * (1._r8 - s2/s1) / (twostext(p) - h) + + fabi_sun(p,ib) = (1._r8 - omega(p,ib)) / avmu(p) * (a1 + a2) + fabi_sha(p,ib) = fabi(p,ib) - fabi_sun(p,ib) + + ! Repeat two-stream calculations for each canopy layer to calculate derivatives. + ! tlai_z and tsai_z are the leaf+stem area increment for a layer. Derivatives are + ! calculated at the center of the layer. Derivatives are needed only for the + ! visible waveband to calculate absorbed PAR (per unit lai+sai) for each canopy layer. + ! Derivatives are calculated first per unit lai+sai and then normalized for sunlit + ! or shaded fraction of canopy layer. + + ! Sun/shade big leaf code uses only one layer, with canopy integrated values from above + ! and also canopy-integrated scaling coefficients + + if (ib == 1) then + if (nlevcan == 1) then + + ! sunlit fraction of canopy + fsun_z(p,1) = (1._r8 - s2) / t1 + + ! absorbed PAR (per unit sun/shade lai+sai) + laisum = elai(p)+esai(p) + fabd_sun_z(p,1) = fabd_sun(p,ib) / (fsun_z(p,1)*laisum) + fabi_sun_z(p,1) = fabi_sun(p,ib) / (fsun_z(p,1)*laisum) + fabd_sha_z(p,1) = fabd_sha(p,ib) / ((1._r8 - fsun_z(p,1))*laisum) + fabi_sha_z(p,1) = fabi_sha(p,ib) / ((1._r8 - fsun_z(p,1))*laisum) + + ! leaf to canopy scaling coefficients + extkn = 0.30_r8 + extkb = twostext(p) + vcmaxcintsun(p) = (1._r8 - exp(-(extkn+extkb)*elai(p))) / (extkn + extkb) + vcmaxcintsha(p) = (1._r8 - exp(-extkn*elai(p))) / extkn - vcmaxcintsun(p) + if (elai(p) > 0._r8) then + vcmaxcintsun(p) = vcmaxcintsun(p) / (fsun_z(p,1)*elai(p)) + vcmaxcintsha(p) = vcmaxcintsha(p) / ((1._r8 - fsun_z(p,1))*elai(p)) + else + vcmaxcintsun(p) = 0._r8 + vcmaxcintsha(p) = 0._r8 + end if + + else if (nlevcan > 1)then + do iv = 1, nrad(p) + + ! Cumulative lai+sai at center of layer + + if (iv == 1) then + laisum = 0.5_r8 * (tlai_z(p,iv)+tsai_z(p,iv)) + else + laisum = laisum + 0.5_r8 * ((tlai_z(p,iv-1)+tsai_z(p,iv-1))+(tlai_z(p,iv)+tsai_z(p,iv))) + end if + + ! Coefficients s1 and s2 depend on cumulative lai+sai. s2 is the sunlit fraction + + t1 = min(h*laisum, 40._r8) + s1 = exp(-t1) + t1 = min(twostext(p)*laisum, 40._r8) + s2 = exp(-t1) + fsun_z(p,iv) = s2 + + ! =============== + ! Direct beam + ! =============== + + ! Coefficients h1-h6 and a1,a2 depend of cumulative lai+sai + + u1 = b - c1/albgrd(c,ib) + u2 = b - c1*albgrd(c,ib) + u3 = f + c1*albgrd(c,ib) + + ! Derivatives for h2, h3, h5, h6 and a1, a2 + + v = d1 + dv = h * p1 * tmp2 / s1 + h * p2 * tmp3 * s1 + + u = tmp6 * tmp2 / s1 - p2 * tmp7 + du = h * tmp6 * tmp2 / s1 + twostext(p) * p2 * tmp7 + dh2 = (v * du - u * dv) / (v * v) + + u = -tmp6 * tmp3 * s1 + p1 * tmp7 + du = h * tmp6 * tmp3 * s1 - twostext(p) * p1 * tmp7 + dh3 = (v * du - u * dv) / (v * v) + + v = d2 + dv = h * tmp4 / s1 + h * tmp5 * s1 + + u = -h4/sigma * tmp4 / s1 - tmp9 + du = -h * h4/sigma * tmp4 / s1 + twostext(p) * tmp9 + dh5 = (v * du - u * dv) / (v * v) + + u = h4/sigma * tmp5 * s1 + tmp9 + du = -h * h4/sigma * tmp5 * s1 - twostext(p) * tmp9 + dh6 = (v * du - u * dv) / (v * v) + + da1 = h1/sigma * s2*s2 + h2 * s2*s1 + h3 * s2/s1 & + + (1._r8 - s2*s1) / (twostext(p) + h) * dh2 & + + (1._r8 - s2/s1) / (twostext(p) - h) * dh3 + da2 = h4/sigma * s2*s2 + h5 * s2*s1 + h6 * s2/s1 & + + (1._r8 - s2*s1) / (twostext(p) + h) * dh5 & + + (1._r8 - s2/s1) / (twostext(p) - h) * dh6 + + ! Flux derivatives + + d_ftid = -twostext(p)*h4/sigma*s2 - h*h5*s1 + h*h6/s1 + dh5*s1 + dh6/s1 + d_fabd = -(dh2+dh3) + (1._r8-albgrd(c,ib))*twostext(p)*s2 - (1._r8-albgri(c,ib))*d_ftid + d_fabd_sun = (1._r8 - omega(p,ib)) * (twostext(p)*s2 + 1._r8 / avmu(p) * (da1 + da2)) + d_fabd_sha = d_fabd - d_fabd_sun + + fabd_sun_z(p,iv) = max(d_fabd_sun, 0._r8) + fabd_sha_z(p,iv) = max(d_fabd_sha, 0._r8) + + ! Flux derivatives are APARsun and APARsha per unit (LAI+SAI). Need + ! to normalize derivatives by sunlit or shaded fraction to get + ! APARsun per unit (LAI+SAI)sun and APARsha per unit (LAI+SAI)sha + + fabd_sun_z(p,iv) = fabd_sun_z(p,iv) / fsun_z(p,iv) + fabd_sha_z(p,iv) = fabd_sha_z(p,iv) / (1._r8 - fsun_z(p,iv)) + + ! =============== + ! Diffuse + ! =============== + + ! Coefficients h7-h10 and a1,a2 depend of cumulative lai+sai + + u1 = b - c1/albgri(c,ib) + u2 = b - c1*albgri(c,ib) + + a1 = h7 * (1._r8 - s2*s1) / (twostext(p) + h) + h8 * (1._r8 - s2/s1) / (twostext(p) - h) + a2 = h9 * (1._r8 - s2*s1) / (twostext(p) + h) + h10 * (1._r8 - s2/s1) / (twostext(p) - h) + + ! Derivatives for h7, h8, h9, h10 and a1, a2 + + v = d1 + dv = h * p1 * tmp2 / s1 + h * p2 * tmp3 * s1 + + u = c1 * tmp2 / s1 + du = h * c1 * tmp2 / s1 + dh7 = (v * du - u * dv) / (v * v) + + u = -c1 * tmp3 * s1 + du = h * c1 * tmp3 * s1 + dh8 = (v * du - u * dv) / (v * v) + + v = d2 + dv = h * tmp4 / s1 + h * tmp5 * s1 + + u = tmp4 / s1 + du = h * tmp4 / s1 + dh9 = (v * du - u * dv) / (v * v) + + u = -tmp5 * s1 + du = h * tmp5 * s1 + dh10 = (v * du - u * dv) / (v * v) + + da1 = h7*s2*s1 + h8*s2/s1 + (1._r8-s2*s1)/(twostext(p)+h)*dh7 + (1._r8-s2/s1)/(twostext(p)-h)*dh8 + da2 = h9*s2*s1 + h10*s2/s1 + (1._r8-s2*s1)/(twostext(p)+h)*dh9 + (1._r8-s2/s1)/(twostext(p)-h)*dh10 + + ! Flux derivatives + + d_ftii = -h * h9 * s1 + h * h10 / s1 + dh9 * s1 + dh10 / s1 + d_fabi = -(dh7+dh8) - (1._r8-albgri(c,ib))*d_ftii + d_fabi_sun = (1._r8 - omega(p,ib)) / avmu(p) * (da1 + da2) + d_fabi_sha = d_fabi - d_fabi_sun + + fabi_sun_z(p,iv) = max(d_fabi_sun, 0._r8) + fabi_sha_z(p,iv) = max(d_fabi_sha, 0._r8) + + ! Flux derivatives are APARsun and APARsha per unit (LAI+SAI). Need + ! to normalize derivatives by sunlit or shaded fraction to get + ! APARsun per unit (LAI+SAI)sun and APARsha per unit (LAI+SAI)sha + + fabi_sun_z(p,iv) = fabi_sun_z(p,iv) / fsun_z(p,iv) + fabi_sha_z(p,iv) = fabi_sha_z(p,iv) / (1._r8 - fsun_z(p,iv)) + + end do ! end of iv loop + end if ! nlevcan + end if ! first band + end if ! NOT lSFonly + + end do ! end of pft loop + end do ! end of radiation band loop + + end associate + +end subroutine TwoStream + +end module SurfaceAlbedoMod From 4ab38f2559cd336f2183c0a9878d6a756053caa4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 14 Mar 2023 15:37:10 -0400 Subject: [PATCH 408/589] correct use statements and add missing constants --- .../CLM51/SurfaceAlbedoMod.F90 | 10 +++++----- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 11 ++++++++++- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 index 32f1c5ce6..0bf57a3fd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 @@ -11,15 +11,15 @@ module SurfaceAlbedoMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun - use landunit_varcon , only : istsoil, istcrop, istdlak - use clm_varcon , only : grlnd, namep +! use landunit_varcon , only : istsoil, istcrop, istdlak +! use clm_varcon , only : grlnd, namep use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE use pftconMod , only : pftcon - use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC - use AerosolMod , only : aerosol_type +! use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC +! use AerosolMod , only : aerosol_type use CanopyStateType , only : canopystate_type - use LakeStateType , only : lakestate_type +! use LakeStateType , only : lakestate_type use SurfaceAlbedoType , only : surfalb_type use TemperatureType , only : temperature_type use WaterStateBulkType , only : waterstatebulk_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index 5a3d54def..5d9a98a29 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -17,7 +17,7 @@ module clm_varcon SHR_CONST_RGAS, & SHR_CONST_PI, & SHR_CONST_PDB - use clm_varpar , only: nlevgrnd, nlevdecomp_full + use clm_varpar , only: nlevgrnd, nlevdecomp_full, numrad ! !PUBLIC TYPES: implicit none @@ -71,6 +71,15 @@ module clm_varcon character(len=16), public, parameter :: namep = 'pft' ! name of patches character(len=16), public, parameter :: nameCohort = 'cohort' ! name of cohorts (ED specific) + !------------------------------------------------------------------ + ! Initialize miscellaneous radiation constants + !------------------------------------------------------------------ + + real(r8), public :: betads = 0.5_r8 ! two-stream parameter betad for snow + real(r8), public :: betais = 0.5_r8 ! two-stream parameter betai for snow + real(r8), public :: omegas(numrad) ! two-stream parameter omega for snow by band + data (omegas(i),i=1,numrad) /0.8_r8, 0.4_r8/ + integer, parameter, public :: max_lunit = 9 !maximum value that lun%itype can have ! typical del13C for C3 photosynthesis (permil, relative to PDB) From 112aaf30b5fc218798be69f0969b5f15667cedbe Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 14 Mar 2023 17:10:13 -0400 Subject: [PATCH 409/589] bug fix --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index 5d9a98a29..fe3439423 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -77,8 +77,7 @@ module clm_varcon real(r8), public :: betads = 0.5_r8 ! two-stream parameter betad for snow real(r8), public :: betais = 0.5_r8 ! two-stream parameter betai for snow - real(r8), public :: omegas(numrad) ! two-stream parameter omega for snow by band - data (omegas(i),i=1,numrad) /0.8_r8, 0.4_r8/ + real(r8), public :: omegas(numrad) = /0.8_r8, 0.4_r8/ ! two-stream parameter omega for snow by band integer, parameter, public :: max_lunit = 9 !maximum value that lun%itype can have From 493e6edf53197d91e00abee559677d5c39a7bf56 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 08:27:37 -0400 Subject: [PATCH 410/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index fe3439423..dad5bcffe 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -77,7 +77,7 @@ module clm_varcon real(r8), public :: betads = 0.5_r8 ! two-stream parameter betad for snow real(r8), public :: betais = 0.5_r8 ! two-stream parameter betai for snow - real(r8), public :: omegas(numrad) = /0.8_r8, 0.4_r8/ ! two-stream parameter omega for snow by band + real(r8), public :: omegas(numrad) = (/0.8_r8, 0.4_r8/) ! two-stream parameter omega for snow by band integer, parameter, public :: max_lunit = 9 !maximum value that lun%itype can have From 23a9b26e944e6db54a011980c1c4409c53e1ca88 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 08:37:11 -0400 Subject: [PATCH 411/589] remove obsolete function imports --- .../GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 index 0bf57a3fd..039e86cbf 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 @@ -14,7 +14,7 @@ module SurfaceAlbedoMod ! use landunit_varcon , only : istsoil, istcrop, istdlak ! use clm_varcon , only : grlnd, namep use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan - use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE + use clm_varctl , only : iulog use pftconMod , only : pftcon ! use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC ! use AerosolMod , only : aerosol_type From 2c8b26ac7fa22b81901e33be3c6610d3a4fec8d3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 08:49:53 -0400 Subject: [PATCH 412/589] adjust data type to match CLM --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index dc6b339f2..46d608179 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -121,7 +121,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! local variables to compute Photosynthesis inputs real :: ws, wl - real, allocatable, dimension(:,:) :: rho, tau + real(r8), allocatable, dimension(:,:) :: rho, tau real, dimension (nch, NUM_ZON) :: esat_tv ! vapor pressure inside leaf (sat vapor press at tc) (Pa) real, dimension (nch, NUM_ZON) :: eair ! vapor pressure of canopy air real, dimension (nch) :: oair ! Atmospheric O2 partial pressure (Pa) From 5f8ebbb7f4aac40c7630258f333ed0a5ac235201 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 09:46:34 -0400 Subject: [PATCH 413/589] initialize TLAI/TSAI to 0 when NaN to avoid floating point exception --- .../CLM51/CNCLM_SurfaceAlbedoType.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index c68b4aa7a..34374bb3e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -155,7 +155,13 @@ subroutine Init(this, bounds, nch, cncol, cnpft) do nv = 1,num_veg ! defined veg loop do n = 1,nlevcan this%tlai_z_patch(np,n) = cnpft(nc,nz,nv, 73) + if (isnan(this%tlai_z_patch(np,n))) then + this%tlai_z_patch(np,n) = 0. + end if this%tsai_z_patch(np,n) = cnpft(nc,nz,nv, 74) + if (isnan(this%tsai_z_patch(np,n))) then + this%tsai_z_patch(np,n) = 0. + end if end do end do !nv end do ! p From 8798adf9cf22b275837c4538a21e3e5b1d071b8a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 10:43:09 -0400 Subject: [PATCH 414/589] bug fixes --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 46d608179..3b1f820bb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -92,7 +92,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! type(canopystate_type) :: canopystate_inst ! type(ozone_base_type) :: ozone_inst ! type(photosyns_type) :: photosyns_inst -! type(waterfluxbulk_type) :: waterfluxbulk_inst + type(waterfluxbulk_type) :: waterfluxbulk_inst ! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst ! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst ! type(waterstate_type) :: waterstate_inst diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 index 5e10746e1..770d2e712 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -50,7 +50,7 @@ module WaterFluxBulkType procedure , public :: Init end type waterfluxbulk_type - type(waterfluxbulk_type), public, target, save :: waterfluxbulk_inst +! type(waterfluxbulk_type), public, target, save :: waterfluxbulk_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 1b4cba092..9003af784 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -123,7 +123,7 @@ module CN_initMod ! type(waterstate_type), public :: waterstate_inst ! type(frictionvel_type), public :: frictionvel_inst type(cn_vegetation_type), public :: bgc_vegetation_inst -! type(waterfluxbulk_type), public :: waterfluxbulk_inst + type(waterfluxbulk_type), public :: waterfluxbulk_inst ! type(active_layer_type), public :: active_layer_inst From fec60e6a049e941ada81cc631ec5a5694ed369b0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 13:03:01 -0400 Subject: [PATCH 415/589] rework handling of water types --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 2 +- .../CLM51/CNCLM_WaterFluxType.F90 | 2 +- .../CLM51/CNCLM_WaterStateBulkType.F90 | 2 +- .../CLM51/CNCLM_WaterStateType.F90 | 2 +- .../CLM51/CNCLM_WaterType.F90 | 198 ++++++++++++++++++ .../CLM51/CNCLM_Wateratm2lndType.F90 | 2 +- .../CLM51/CN_init_mod.F90 | 19 +- 8 files changed, 208 insertions(+), 20 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index f1cb9b390..7d217cd38 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -68,6 +68,7 @@ set (srcs CNCLM_WaterFluxType.F90 CNCLM_WaterStateBulkType.F90 CNCLM_WaterStateType.F90 + CNCLM_WaterType.F90 CNCStateUpdate1Mod.F90 CNCStateUpdate2Mod.F90 CNCStateUpdate3Mod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index ddedb1a41..57484cd72 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -62,7 +62,7 @@ module WaterDiagnosticBulkType procedure, public :: Init end type waterdiagnosticbulk_type -type(waterdiagnosticbulk_type), public, target, save :: waterdiagnosticbulk_inst +!type(waterdiagnosticbulk_type), public, target, save :: waterdiagnosticbulk_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index e7a753c1e..38e49c821 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -106,7 +106,7 @@ module WaterFluxType procedure, public :: Init end type waterflux_type - type(waterflux_type), public, target, save :: waterflux_inst + !type(waterflux_type), public, target, save :: waterflux_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 index 96601e2ce..59261a29a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 @@ -34,7 +34,7 @@ module WaterStateBulkType procedure , public :: Init end type waterstatebulk_type - type(waterstatebulk_type), public, target, save :: waterstatebulk_inst +! type(waterstatebulk_type), public, target, save :: waterstatebulk_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 index 3864dcab0..b03651f39 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 @@ -52,7 +52,7 @@ module WaterStateType procedure , public :: Init end type waterstate_type - type(waterstate_type), public, target, save :: waterstate_inst + ! type(waterstate_type), public, target, save :: waterstate_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 new file mode 100755 index 000000000..ad59540a4 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 @@ -0,0 +1,198 @@ +module WaterType + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Container for derived types relating to water, both for bulk water and for isotopes + ! and other tracers. + ! + ! Variables pertaining to bulk water can be accessed in two ways: + ! + ! (1) Using water_inst%water*bulk_inst + ! + ! (2) As one of the indices in water_inst%bulk_and_tracers(:)%water*_inst + ! + ! Method (1) is greatly preferable when you are just operating on bulk water. Method + ! (2) is just meant to be used when you are doing the same operation on bulk water + ! and all water tracers. + ! + ! To loop through bulk and all tracers, use code like this: + ! do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end + ! associate( & + ! waterflux_inst => water_inst%bulk_and_tracers(i)%waterflux_inst, & + ! [and other associations, as necessary]) + ! [Do calculations involving waterflux_inst, etc.] + ! end associate + ! end do + ! + ! To loop through all tracers (not bulk), use code like this: + ! do i = water_inst%tracers_beg, water_inst%tracers_end + ! associate( & + ! waterflux_inst => water_inst%bulk_and_tracers(i)%waterflux_inst, & + ! [and other associations, as necessary]) + ! [Do calculations involving waterflux_inst, etc.] + ! end associate + ! end do + ! + ! To loop through all isotopes (not bulk or other water tracers), use code like this: + ! type(water_info_isotope_type), pointer :: iso_info + ! + ! do i = water_inst%tracers_beg, water_inst%tracers_end + ! if (water_inst%IsIsotope(i)) then + ! call water_inst%GetIsotopeInfo(i, iso_info) + ! associate( & + ! waterflux_inst => water_inst%bulk_and_tracers(i)%waterflux_inst, & + ! [and other associations, as necessary]) + ! [Do calculations involving iso_info, waterflux_inst, etc.] + ! end associate + ! end if + ! end do + ! + ! The associate statements given above aren't crucial. If the block of code refers to + ! multiple instances (waterstate, waterflux, etc.), but only refers to each one once or + ! twice, it can be best to just have: + ! associate(bulk_or_tracer => water_inst%bulk_and_tracers(i)) + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use clm_varctl , only : iulog + use clm_varpar , only : nlevsno + use ncdio_pio , only : file_desc_t + use WaterFluxBulkType , only : waterfluxbulk_type + use WaterFluxType , only : waterflux_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterStateType , only : waterstate_type +! use WaterDiagnosticType , only : waterdiagnostic_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type +! use WaterBalanceType , only : waterbalance_type +! use WaterInfoBaseType , only : water_info_base_type +! use WaterInfoBulkType , only : water_info_bulk_type +! use WaterInfoTracerType , only : water_info_tracer_type +! use WaterInfoIsotopeType , only : water_info_isotope_type +! use Waterlnd2atmType , only : waterlnd2atm_type +! use Waterlnd2atmBulkType , only : waterlnd2atmbulk_type + use Wateratm2lndType , only : wateratm2lnd_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + ! use WaterTracerContainerType , only : water_tracer_container_type + ! use WaterTracerUtils , only : CompareBulkToTracer, SetTracerToBulkTimesRatio + + implicit none + private + + ! + ! !PRIVATE TYPES: + + ! This type holds instances needed for bulk water or for a single tracer + type, private :: bulk_or_tracer_type + private + + ! ------------------------------------------------------------------------ + ! Public data members + ! ------------------------------------------------------------------------ + + class(waterflux_type) , pointer, public :: waterflux_inst + class(waterstate_type) , pointer, public :: waterstate_inst + ! class(waterdiagnostic_type) , pointer, public :: waterdiagnostic_inst + ! class(waterbalance_type) , pointer, public :: waterbalance_inst + ! class(waterlnd2atm_type) , pointer, public :: waterlnd2atm_inst + class(wateratm2lnd_type) , pointer, public :: wateratm2lnd_inst + + ! ------------------------------------------------------------------------ + ! Private data members + ! ------------------------------------------------------------------------ + + ! logical :: is_isotope = .false. + ! class(water_info_base_type) , pointer :: info + ! type(water_tracer_container_type) :: vars + + end type bulk_or_tracer_type + + ! + ! !PUBLIC TYPES: + +! ! water_params_type is public for the sake of unit tests +! type, public :: water_params_type +! private +! +! ! Whether we add tracers that are used for the tracer consistency checks +! logical :: enable_consistency_checks +! +! ! Whether we add tracers that are used for isotopes +! logical :: enable_isotopes +! end type water_params_type + + type, public :: water_type + private + + ! ------------------------------------------------------------------------ + ! Public data members + ! ------------------------------------------------------------------------ + + ! indices into the bulk_and_tracers array + integer, public :: bulk_and_tracers_beg ! first index when looping over bulk & tracers + integer, public :: bulk_and_tracers_end ! last index when looping over bulk & tracers + integer, public :: tracers_beg ! first index when looping over just tracers + integer, public :: tracers_end ! last index when looping over just tracers + integer, public :: i_bulk ! index of bulk in arrays that contain both bulk and tracers + + type(waterfluxbulk_type), pointer, public :: waterfluxbulk_inst + type(waterstatebulk_type), pointer, public :: waterstatebulk_inst + type(waterdiagnosticbulk_type), pointer, public :: waterdiagnosticbulk_inst + ! type(waterbalance_type), pointer, public :: waterbalancebulk_inst + ! type(waterlnd2atmbulk_type), pointer, public :: waterlnd2atmbulk_inst + type(wateratm2lndbulk_type), pointer, public :: wateratm2lndbulk_inst + + type(bulk_or_tracer_type), allocatable, public :: bulk_and_tracers(:) + + ! ------------------------------------------------------------------------ + ! Private data members + ! ------------------------------------------------------------------------ + + ! type(water_params_type) :: params + integer :: bulk_tracer_index ! index of the tracer that replicates bulk water (-1 if it doesn't exist) + + contains + ! Public routines + procedure, public :: Init + + end type water_type + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + + !----------------------------------------------------------------------- + subroutine Init(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize all water variables + ! + ! !ARGUMENTS: + class(water_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'Init' + !----------------------------------------------------------------------- + + call waterflux_inst%Init (bounds) + call waterfluxbulk_inst%Init (bounds) + call waterdiagnosticbulk_inst%Init (bounds) + call wateratm2lndbulk_inst%Init (bounds) + call wateratm2lnd_inst%Init (bounds) + call waterstatebulk_inst%Init (bounds) + call waterstate_inst%Init (bounds) + + + end subroutine Init + + !----------------------------------------------------------------------- + + +end module WaterType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 index f1023341a..d4308ab62 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 @@ -36,7 +36,7 @@ module Wateratm2lndType procedure, public :: Init end type wateratm2lnd_type - type(wateratm2lnd_type), public, target, save :: wateratm2lnd_inst +! type(wateratm2lnd_type), public, target, save :: wateratm2lnd_inst contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 9003af784..01302b27a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -57,6 +57,7 @@ module CN_initMod use CNVegetationFacade use initSubgridMod use CN2CLMType + use WaterType , only : water_type use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn @@ -86,7 +87,7 @@ module CN_initMod class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method class(fire_method_type), allocatable :: cnfire_method type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst - type(wateratm2lndbulk_type), public :: wateratm2lndbulk_inst + type(water_type), public :: water_inst ! type(bounds_type), public :: bounds ! type(patch_type) :: patch ! type(column_type) :: col @@ -103,7 +104,7 @@ module CN_initMod ! type(surfalb_type), public :: surfalb_inst ! type(ozone_base_type), public :: ozone_inst ! type(pftcon_type) :: pftcon -! type(waterflux_type), public :: waterflux_inst + type(waterflux_type), public :: waterflux_inst ! type(soilbiogeochem_carbonstate_type), public :: soilbiogeochem_carbonstate_inst ! type(soilbiogeochem_nitrogenstate_type), public :: soilbiogeochem_nitrogenstate_inst ! type(cn_products_type), public :: c_products_inst @@ -255,11 +256,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call soilstate_inst%Init (bounds) - call waterdiagnosticbulk_inst%Init (bounds) - - call wateratm2lndbulk_inst%Init (bounds) - - call wateratm2lnd_inst%Init (bounds) + call water_inst%Init (bounds) call canopystate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) @@ -273,8 +270,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call pftcon%init_pftcon_type () - call waterflux_inst%Init (bounds) - call soilbiogeochem_carbonstate_inst%Init(bounds, nch, cncol) call soilbiogeochem_nitrogenstate_inst%Init(bounds, nch, cncol) @@ -287,8 +282,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call cnveg_nitrogenflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) - call waterfluxbulk_inst%Init (bounds) - call soilbiogeochem_carbonflux_inst%Init (bounds) call soilbiogeochem_nitrogenflux_inst%Init(bounds) @@ -307,10 +300,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) call energyflux_inst%Init (bounds) - call waterstatebulk_inst%Init (bounds) - - call waterstate_inst%Init (bounds) - call frictionvel_inst%Init (bounds) ! calls to original CTSM initialization routines From 02fbc6b3645d47d53e4284caba95800a729e8308 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 13:42:56 -0400 Subject: [PATCH 416/589] adding allocation --- .../CLM51/CNCLM_WaterType.F90 | 43 ++++++++++++++----- 1 file changed, 33 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 index ad59540a4..eed9cb086 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 @@ -145,7 +145,7 @@ module WaterType ! type(waterlnd2atmbulk_type), pointer, public :: waterlnd2atmbulk_inst type(wateratm2lndbulk_type), pointer, public :: wateratm2lndbulk_inst - type(bulk_or_tracer_type), allocatable, public :: bulk_and_tracers(:) + type(bulk_or_tracer_type), public :: bulk_and_tracers(1) ! ------------------------------------------------------------------------ ! Private data members @@ -181,18 +181,41 @@ subroutine Init(this, bounds) character(len=*), parameter :: subname = 'Init' !----------------------------------------------------------------------- - call waterflux_inst%Init (bounds) - call waterfluxbulk_inst%Init (bounds) - call waterdiagnosticbulk_inst%Init (bounds) - call wateratm2lndbulk_inst%Init (bounds) - call wateratm2lnd_inst%Init (bounds) - call waterstatebulk_inst%Init (bounds) - call waterstate_inst%Init (bounds) + allocate(this%waterfluxbulk_inst) + this%bulk_and_tracers(1)%waterflux_inst => this%waterfluxbulk_inst + allocate(this%waterstatebulk_inst) + this%bulk_and_tracers(1)%waterstate_inst => this%waterstatebulk_inst - end subroutine Init + allocate(this%waterdiagnosticbulk_inst) + this%bulk_and_tracers(1)%waterdiagnostic_inst => this%waterdiagnosticbulk_inst - !----------------------------------------------------------------------- + allocate(this%waterbalancebulk_inst) + this%bulk_and_tracers(1)%waterbalance_inst => this%waterbalancebulk_inst + + allocate(this%waterlnd2atmbulk_inst) + this%bulk_and_tracers(1)%waterlnd2atm_inst => this%waterlnd2atmbulk_inst + + allocate(this%wateratm2lndbulk_inst) + this%bulk_and_tracers(1)%wateratm2lnd_inst => this%wateratm2lndbulk_inst + + allocate(waterflux_type :: this%bulk_and_tracers(1)%waterflux_inst) + allocate(waterstate_type :: this%bulk_and_tracers(1)%waterstate_inst) + allocate(waterdiagnostic_type :: this%bulk_and_tracers(1)%waterdiagnostic_inst) + allocate(waterbalance_type :: this%bulk_and_tracers(1)%waterbalance_inst) + allocate(waterlnd2atm_type :: this%bulk_and_tracers(1)%waterlnd2atm_inst) + allocate(wateratm2lnd_type :: this%bulk_and_tracers(1)%wateratm2lnd_inst) + + call this%bulk_and_tracers(1)%waterflux_inst%Init (bounds) + call this%waterfluxbulk_inst%Init (bounds) + call this%waterdiagnosticbulk_inst%Init (bounds) + call this%wateratm2lndbulk_inst%Init (bounds) + call this%bulk_and_tracers(1)%wateratm2lnd_inst%Init (bounds) + call this%waterstatebulk_inst%Init (bounds) + call this%bulk_and_tracers(1)%waterstate_inst%Init (bounds) + + + end subroutine Init end module WaterType From 6920f3f5da5b25bab20ef2a42a2a16cab8babe07 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 14:21:36 -0400 Subject: [PATCH 417/589] add waterdiagnostic_type --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/CNCLM_WaterDiagnosticType.F90 | 98 +++++++++++++++++++ .../CLM51/CNCLM_WaterType.F90 | 11 +-- 3 files changed, 102 insertions(+), 8 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 7d217cd38..e4008864c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -63,6 +63,7 @@ set (srcs CNCLM_TemperatureType.F90 CNCLM_Wateratm2lndBulkType.F90 CNCLM_Wateratm2lndType.F90 + CNCLM_WaterDiagnosticType.F90 CNCLM_WaterDiagnosticBulkType.F90 CNCLM_WaterFluxBulkType.F90 CNCLM_WaterFluxType.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 new file mode 100755 index 000000000..18bc1f5f8 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 @@ -0,0 +1,98 @@ +module WaterDiagnosticType + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Defines a derived type containing water diagnostic variables that apply to both bulk + ! water and water tracers. Diagnostic variables are neither fundamental state variables + ! nor fluxes between those fundamental states, but are typically derived from those + ! states and/or fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varcon , only : spval + use LandunitType , only : lun + use WaterStateType, only : waterstate_type + use WaterFluxType, only : waterflux_type + ! + implicit none + save + private + ! + ! !PUBLIC TYPES: + type, public :: waterdiagnostic_type + + real(r8), pointer :: snowice_col (:) ! col average snow ice lens + real(r8), pointer :: snowliq_col (:) ! col average snow liquid water + + real(r8), pointer :: h2ocan_patch (:) ! patch total canopy water (liq+ice) (mm H2O) + real(r8), pointer :: total_plant_stored_h2o_col(:) ! col water that is bound in plants, including roots, sapwood, leaves, etc + ! in most cases, the vegetation scheme does not have a dynamic + ! water storage in plants, and thus 0.0 is a suitable for the trivial case. + ! When FATES is coupled in with plant hydraulics turned on, this storage + ! term is set to non-zero. (kg/m2 H2O) + + real(r8), pointer :: h2osoi_liqice_10cm_col (:) ! col liquid water + ice lens in top 10cm of soil (kg/m2) + real(r8), pointer :: tws_grc (:) ! grc total water storage (mm H2O) + real(r8), pointer :: q_ref2m_patch (:) ! patch 2 m height surface specific humidity (kg/kg) + real(r8), pointer :: qg_snow_col (:) ! col ground specific humidity [kg/kg] + real(r8), pointer :: qg_soil_col (:) ! col ground specific humidity [kg/kg] + real(r8), pointer :: qg_h2osfc_col (:) ! col ground specific humidity [kg/kg] + real(r8), pointer :: qg_col (:) ! col ground specific humidity [kg/kg] + real(r8), pointer :: qaf_lun (:) ! lun urban canopy air specific humidity (kg/kg) + + contains + + procedure :: Init + + end type waterdiagnostic_type + + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + ! !ARGUMENTS: + class(waterdiagnostic_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + allocate(this%h2ocan_patch (begp:endp)) + this%h2ocan_patch(begp:endp) = spval + + allocate(this%h2osoi_liqice_10cm_col (begc:endc)) + this%h2osoi_liqice_10cm_col(begc:endc) = spval + + allocate(this%tws_grc (begg:endg)) + this%tws_grc(begg:endg) = spval + + allocate(this%q_ref2m_patch (begp:endp)) + this%q_ref2m_patch(begp:endp) = spval + + ! Snow properties - these will be vertically averaged over the snow profile + + allocate(this%snowliq_col( (begc:endc)) + this%snowliq_col(begc:endc) = spval + + allocate(this%snowice_col( (begc:endc)) + this%snowice_col(begc:endc) = spval + + end subroutine Init + +end module WaterDiagnosticType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 index eed9cb086..7a067674e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 @@ -65,7 +65,7 @@ module WaterType use WaterFluxType , only : waterflux_type use WaterStateBulkType , only : waterstatebulk_type use WaterStateType , only : waterstate_type -! use WaterDiagnosticType , only : waterdiagnostic_type + use WaterDiagnosticType , only : waterdiagnostic_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type ! use WaterBalanceType , only : waterbalance_type ! use WaterInfoBaseType , only : water_info_base_type @@ -95,7 +95,7 @@ module WaterType class(waterflux_type) , pointer, public :: waterflux_inst class(waterstate_type) , pointer, public :: waterstate_inst - ! class(waterdiagnostic_type) , pointer, public :: waterdiagnostic_inst + class(waterdiagnostic_type) , pointer, public :: waterdiagnostic_inst ! class(waterbalance_type) , pointer, public :: waterbalance_inst ! class(waterlnd2atm_type) , pointer, public :: waterlnd2atm_inst class(wateratm2lnd_type) , pointer, public :: wateratm2lnd_inst @@ -190,9 +190,6 @@ subroutine Init(this, bounds) allocate(this%waterdiagnosticbulk_inst) this%bulk_and_tracers(1)%waterdiagnostic_inst => this%waterdiagnosticbulk_inst - allocate(this%waterbalancebulk_inst) - this%bulk_and_tracers(1)%waterbalance_inst => this%waterbalancebulk_inst - allocate(this%waterlnd2atmbulk_inst) this%bulk_and_tracers(1)%waterlnd2atm_inst => this%waterlnd2atmbulk_inst @@ -200,10 +197,8 @@ subroutine Init(this, bounds) this%bulk_and_tracers(1)%wateratm2lnd_inst => this%wateratm2lndbulk_inst allocate(waterflux_type :: this%bulk_and_tracers(1)%waterflux_inst) - allocate(waterstate_type :: this%bulk_and_tracers(1)%waterstate_inst) allocate(waterdiagnostic_type :: this%bulk_and_tracers(1)%waterdiagnostic_inst) - allocate(waterbalance_type :: this%bulk_and_tracers(1)%waterbalance_inst) - allocate(waterlnd2atm_type :: this%bulk_and_tracers(1)%waterlnd2atm_inst) + allocate(waterstate_type :: this%bulk_and_tracers(1)%waterstate_inst) allocate(wateratm2lnd_type :: this%bulk_and_tracers(1)%wateratm2lnd_inst) call this%bulk_and_tracers(1)%waterflux_inst%Init (bounds) From 23c9d99deadc4cd6ae4713a17b1ec22727b5dec4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 Mar 2023 16:17:59 -0400 Subject: [PATCH 418/589] typo fix --- .../CLM51/CNCLM_WaterDiagnosticType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 index 18bc1f5f8..944934bd3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 @@ -87,10 +87,10 @@ subroutine Init(this, bounds) ! Snow properties - these will be vertically averaged over the snow profile - allocate(this%snowliq_col( (begc:endc)) + allocate(this%snowliq_col (begc:endc)) this%snowliq_col(begc:endc) = spval - allocate(this%snowice_col( (begc:endc)) + allocate(this%snowice_col (begc:endc)) this%snowice_col(begc:endc) = spval end subroutine Init From 38cb0ba70360abc05b5d2d92bc73db8115230f31 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 16 Mar 2023 08:14:50 -0400 Subject: [PATCH 419/589] add waterdiagnostic_type dependencies --- .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 4 +++- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 | 3 --- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index 57484cd72..3afc4a824 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -5,6 +5,7 @@ module WaterDiagnosticBulkType use clm_varcon , only : spval use nanMod , only : nan use decompMod , only : bounds_type + use WaterDiagnosticType, only : waterdiagnostic_type ! !PUBLIC TYPES: implicit none @@ -13,7 +14,8 @@ module WaterDiagnosticBulkType ! !PUBLIC MEMBER FUNCTIONS: ! - type, public :: waterdiagnosticbulk_type + type, extends(waterdiagnostic_type), public :: waterdiagnosticbulk_type + real(r8), pointer :: h2osno_total_col (:) ! col total snow water (mm H2O) real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m) real(r8), pointer :: snow_5day_col (:) ! col snow height 5 day avg diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 index 7a067674e..947b0cdd0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 @@ -190,9 +190,6 @@ subroutine Init(this, bounds) allocate(this%waterdiagnosticbulk_inst) this%bulk_and_tracers(1)%waterdiagnostic_inst => this%waterdiagnosticbulk_inst - allocate(this%waterlnd2atmbulk_inst) - this%bulk_and_tracers(1)%waterlnd2atm_inst => this%waterlnd2atmbulk_inst - allocate(this%wateratm2lndbulk_inst) this%bulk_and_tracers(1)%wateratm2lnd_inst => this%wateratm2lndbulk_inst From ae843ea6989dce80e9b6ed8299f8e3187e6a486a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 16 Mar 2023 08:29:06 -0400 Subject: [PATCH 420/589] make initialization procedure public --- .../CLM51/CNCLM_WaterDiagnosticType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 index 944934bd3..6287c1db7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 @@ -45,7 +45,7 @@ module WaterDiagnosticType contains - procedure :: Init + procedure, public :: Init end type waterdiagnostic_type From 6919c58afb98e89fb6e6827a859981ad1d37ced8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 16 Mar 2023 08:55:28 -0400 Subject: [PATCH 421/589] update water type initialization --- .../CLM51/CNCLM_WaterDiagnosticBulkType.F90 | 11 ++++++----- .../CLM51/CNCLM_WaterDiagnosticType.F90 | 2 +- .../CLM51/CNCLM_WaterFluxBulkType.F90 | 9 +++++---- .../CLM51/CNCLM_WaterFluxType.F90 | 2 +- .../CLM51/CNCLM_WaterStateBulkType.F90 | 10 ++++++---- .../CLM51/CNCLM_WaterStateType.F90 | 2 +- .../CLM51/CNCLM_WaterType.F90 | 14 +++++++------- .../CLM51/CNCLM_Wateratm2lndBulkType.F90 | 10 ++++++---- .../CLM51/CNCLM_Wateratm2lndType.F90 | 2 +- 9 files changed, 34 insertions(+), 28 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 index 3afc4a824..41d77879d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticBulkType.F90 @@ -61,7 +61,7 @@ module WaterDiagnosticBulkType contains - procedure, public :: Init + procedure, public :: InitBulk end type waterdiagnosticbulk_type !type(waterdiagnosticbulk_type), public, target, save :: waterdiagnosticbulk_inst @@ -69,7 +69,7 @@ module WaterDiagnosticBulkType contains !----------------------------------------------- - subroutine Init(this, bounds) + subroutine InitBulk(this, bounds) ! !DESCRIPTION: ! Initialize CTSM type for water diagnostic variables that just apply to bulk water and are needed for calling CTSM routines @@ -80,7 +80,7 @@ subroutine Init(this, bounds) implicit none !INPUT type(bounds_type), intent(in) :: bounds - class(waterdiagnosticbulk_type) :: this + class(waterdiagnosticbulk_type), intent(inout) :: this !LOCAL integer :: begp, endp @@ -93,7 +93,8 @@ subroutine Init(this, bounds) begc = bounds%begc ; endc = bounds%endc begl = bounds%begl ; endl = bounds%endl begg = bounds%begg ; endg = bounds%endg - + + call this%Init(bounds) allocate(this%h2osno_total_col (begc:endc)) ; this%h2osno_total_col (:) = nan allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan @@ -134,6 +135,6 @@ subroutine Init(this, bounds) allocate(this%qflx_prec_intr_patch (begp:endp)) ; this%qflx_prec_intr_patch (:) = nan allocate(this%qflx_prec_grnd_col (begc:endc)) ; this%qflx_prec_grnd_col (:) = nan - end subroutine Init + end subroutine InitBulk end module WaterDiagnosticBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 index 6287c1db7..25536d7b3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterDiagnosticType.F90 @@ -60,7 +60,7 @@ module WaterDiagnosticType subroutine Init(this, bounds) ! !ARGUMENTS: - class(waterdiagnostic_type), intent(in) :: this + class(waterdiagnostic_type), intent(inout) :: this type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 index 770d2e712..6061a9a16 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxBulkType.F90 @@ -47,7 +47,7 @@ module WaterFluxBulkType contains - procedure , public :: Init + procedure , public :: InitBulk end type waterfluxbulk_type ! type(waterfluxbulk_type), public, target, save :: waterfluxbulk_inst @@ -55,7 +55,7 @@ module WaterFluxBulkType contains !--------------------------------------------- - subroutine Init(this, bounds) + subroutine InitBulk(this, bounds) ! !DESCRIPTION: ! Initialize CTSM type for water flux bulk variables that just apply to bulk water and are needed for calling CTSM routines @@ -66,7 +66,7 @@ subroutine Init(this, bounds) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - class(waterfluxbulk_type) :: this + class(waterfluxbulk_type), intent(inout) :: this !LOCAL integer :: begp, endp @@ -78,6 +78,7 @@ subroutine Init(this, bounds) begc = bounds%begc; endc= bounds%endc begg = bounds%begg; endg= bounds%endg + call this%Init(bounds) allocate(this%qflx_snowindunload_patch (begp:endp)) ; this%qflx_snowindunload_patch (:) = nan allocate(this%qflx_snotempunload_patch (begp:endp)) ; this%qflx_snotempunload_patch (:) = nan @@ -107,5 +108,5 @@ subroutine Init(this, bounds) allocate(this%qflx_deficit_col (begc:endc)) ; this%qflx_deficit_col (:) = nan allocate(this%AnnET (begc:endc)) ; this%AnnET (:) = nan - end subroutine Init + end subroutine InitBulk end module WaterFluxBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index 38e49c821..a4b0ebe50 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -122,7 +122,7 @@ subroutine Init(this, bounds) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - class(waterflux_type) :: this + class(waterflux_type), intent(inout) :: this !LOCAL integer :: begp, endp diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 index 59261a29a..4f9e59a03 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateBulkType.F90 @@ -31,7 +31,7 @@ module WaterStateBulkType contains - procedure , public :: Init + procedure , public :: InitBulk end type waterstatebulk_type ! type(waterstatebulk_type), public, target, save :: waterstatebulk_inst @@ -39,13 +39,13 @@ module WaterStateBulkType contains !--------------------------------------------- - subroutine Init(this, bounds) + subroutine InitBulk(this, bounds) ! !ARGUMENTS: implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - class(waterstatebulk_type) :: this + class(waterstatebulk_type), intent(inout) :: this !LOCAL integer :: begp, endp @@ -59,9 +59,11 @@ subroutine Init(this, bounds) begl = bounds%begl ; endl= bounds%endl begg = bounds%begg ; endg = bounds%endg + call this%Init(bounds) + allocate(this%snow_persistence_col (begc:endc)) ; this%snow_persistence_col (:) = nan allocate(this%int_snow_col (begc:endc)) ; this%int_snow_col (:) = nan - end subroutine Init + end subroutine InitBulk end module WaterStateBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 index b03651f39..fe0ba4f39 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterStateType.F90 @@ -63,7 +63,7 @@ subroutine Init(this, bounds) implicit none !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds - class(waterstate_type) :: this + class(waterstate_type), intent(inout) :: this !LOCAL integer :: begp, endp diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 index 947b0cdd0..0f44b3e49 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 @@ -198,13 +198,13 @@ subroutine Init(this, bounds) allocate(waterstate_type :: this%bulk_and_tracers(1)%waterstate_inst) allocate(wateratm2lnd_type :: this%bulk_and_tracers(1)%wateratm2lnd_inst) - call this%bulk_and_tracers(1)%waterflux_inst%Init (bounds) - call this%waterfluxbulk_inst%Init (bounds) - call this%waterdiagnosticbulk_inst%Init (bounds) - call this%wateratm2lndbulk_inst%Init (bounds) - call this%bulk_and_tracers(1)%wateratm2lnd_inst%Init (bounds) - call this%waterstatebulk_inst%Init (bounds) - call this%bulk_and_tracers(1)%waterstate_inst%Init (bounds) + call this%bulk_and_tracers(1)%waterflux_inst%InitBulk (bounds) + call this%waterfluxbulk_inst%InitBulk (bounds) + call this%waterdiagnosticbulk_inst%InitBulk (bounds) + call this%wateratm2lndbulk_inst%InitBulk (bounds) + call this%bulk_and_tracers(1)%wateratm2lnd_inst%InitBulk (bounds) + call this%waterstatebulk_inst%InitBulk (bounds) + call this%bulk_and_tracers(1)%waterstate_inst%InitBulk (bounds) end subroutine Init diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 index 9dcc8f4c2..b89d2269e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 @@ -39,14 +39,14 @@ module Wateratm2lndBulkType contains - procedure, public :: Init + procedure, public :: InitBulk end type wateratm2lndbulk_type contains !------------------------------------------------------------------------ - subroutine Init(this, bounds) + subroutine InitBulk(this, bounds) ! ! !DESCRIPTION: ! Initialize module data structure @@ -56,7 +56,7 @@ subroutine Init(this, bounds) ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds - class(wateratm2lndbulk_type) :: this + class(wateratm2lndbulk_type), intent(inout) :: this ! ! !LOCAL VARIABLES: @@ -70,6 +70,8 @@ subroutine Init(this, bounds) begc = bounds%begc; endc= bounds%endc begg = bounds%begg; endg= bounds%endg + call this%Init(bounds) + allocate(this%volr_grc (begg:endg)) ; this%volr_grc (:) = ival allocate(this%volrmch_grc (begg:endg)) ; this%volrmch_grc (:) = ival allocate(this%forc_rh_grc (begg:endg)) ; this%forc_rh_grc (:) = ival @@ -83,5 +85,5 @@ subroutine Init(this, bounds) end if - end subroutine Init + end subroutine InitBulk end module Wateratm2lndBulkType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 index d4308ab62..d70183036 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndType.F90 @@ -50,7 +50,7 @@ subroutine Init(this, bounds) ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds - class(wateratm2lnd_type) :: this + class(wateratm2lnd_type), intent(inout) :: this ! ! !LOCAL VARIABLES: integer :: begc, endc From 175f109878cd4c1b9c653082f3bc4c7e59ed0c8e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 16 Mar 2023 09:12:15 -0400 Subject: [PATCH 422/589] typo fix --- .../CLM51/CNCLM_WaterType.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 index 0f44b3e49..7163880c6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 @@ -198,13 +198,13 @@ subroutine Init(this, bounds) allocate(waterstate_type :: this%bulk_and_tracers(1)%waterstate_inst) allocate(wateratm2lnd_type :: this%bulk_and_tracers(1)%wateratm2lnd_inst) - call this%bulk_and_tracers(1)%waterflux_inst%InitBulk (bounds) - call this%waterfluxbulk_inst%InitBulk (bounds) - call this%waterdiagnosticbulk_inst%InitBulk (bounds) - call this%wateratm2lndbulk_inst%InitBulk (bounds) - call this%bulk_and_tracers(1)%wateratm2lnd_inst%InitBulk (bounds) + call this%bulk_and_tracers(1)%waterflux_inst%Init (bounds) + call this%bulk_and_tracers(1)%wateratm2lnd_inst%Init (bounds) + call this%bulk_and_tracers(1)%waterstate_inst%Init (bounds) + call this%waterfluxbulk_inst%InitBulk (bounds) + call this%waterdiagnosticbulk_inst%InitBulk (bounds) + call this%wateratm2lndbulk_inst%InitBulk (bounds) call this%waterstatebulk_inst%InitBulk (bounds) - call this%bulk_and_tracers(1)%waterstate_inst%InitBulk (bounds) end subroutine Init From 7b2d78f9ef415d2810b23068d21277be496888d7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 16 Mar 2023 09:35:00 -0400 Subject: [PATCH 423/589] add type declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 3b1f820bb..686019f41 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -86,7 +86,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! type(atm2lnd_type) :: atm2lnd_inst ! type(temperature_type) :: temperature_inst ! type(soilstate_type) :: soilstate_inst -! type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst + type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst ! type(surfalb_type) :: surfalb_inst ! type(solarabs_type) :: solarabs_inst ! type(canopystate_type) :: canopystate_inst From 02b750f9c813e8d8e1a9b3f493857d7865f1cfdd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 16 Mar 2023 11:20:41 -0400 Subject: [PATCH 424/589] add type declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 8d345a961..4eb2d8ba4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -174,7 +174,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! type(gridcell_type) :: grc ! type(cn_vegetation_type) :: bgc_vegetation_inst ! type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst -! type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst + type(wateratm2lndbulk_type) :: wateratm2lndbulk_inst ! type(soilstate_type) :: soilstate_inst ! type(atm2lnd_type) :: atm2lnd_inst ! type(temperature_type) :: temperature_inst From d4c3fd29b96f668bb3c18134ee2fb7fe0b7f22ff Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 16 Mar 2023 12:41:47 -0400 Subject: [PATCH 425/589] add type declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 4eb2d8ba4..abb9e9765 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -178,9 +178,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ! type(soilstate_type) :: soilstate_inst ! type(atm2lnd_type) :: atm2lnd_inst ! type(temperature_type) :: temperature_inst -! type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst + type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst ! type(cnveg_state_type) :: cnveg_state_inst -! type(waterstatebulk_type) :: waterstatebulk_inst + type(waterstatebulk_type) :: waterstatebulk_inst ! type(waterfluxbulk_type) :: waterfluxbulk_inst ! type(frictionvel_type) :: frictionvel_inst ! type(active_layer_type) :: active_layer_inst From 57e2503ef84875cefb53aeeafe99f8b33c60cdf3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 16 Mar 2023 18:39:37 -0400 Subject: [PATCH 426/589] use pointers --- .../CLM51/CNCLM51_Photosynthesis.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 686019f41..aef80a2b1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -184,7 +184,10 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_nourbanp => filter(1)%nourbanp , & filter_num_nourbanp => filter(1)%num_nourbanp , & filter_exposedvegp => filter(1)%exposedvegp , & - filter_num_exposedvegp => filter(1)%num_exposedvegp & + filter_num_exposedvegp => filter(1)%num_exposedvegp , & + fdry_patch => waterdiagnosticbulk_inst%fdry_patch , & + fwet_patch => waterdiagnosticbulk_inst%fwet_patch , & + fcansno_patch => waterdiagnosticbulk_inst%fcansno_patch & ) ! allocate filters @@ -342,9 +345,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_novegsol(num_novegsol) = p end if - waterdiagnosticbulk_inst%fdry_patch(p) = (1-fwet(nc))*elai(p)/max( elai(p)+esai(p), 1.e-06_r8 ) - waterdiagnosticbulk_inst%fwet_patch(p) = fwet(nc) - waterdiagnosticbulk_inst%fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet + fdry_patch(p) = (1-fwet(nc))*elai(p)/max( elai(p)+esai(p), 1.e-06_r8 ) + fwet_patch(p) = fwet(nc) + fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet end do end do end do From 5dfa6e42fb9ecf0822e28e6573a342ea2e23ffbb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 17 Mar 2023 13:56:59 -0400 Subject: [PATCH 427/589] revise water type initialization --- .../CLM51/CNCLM51_Photosynthesis.F90 | 30 +++++++++---------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index aef80a2b1..1d2801a86 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -20,6 +20,7 @@ module CNCLM_Photosynthesis use PhotosynthesisMod use WaterFluxBulkType use WaterStateType + use WaterType implicit none @@ -86,13 +87,13 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! type(atm2lnd_type) :: atm2lnd_inst ! type(temperature_type) :: temperature_inst ! type(soilstate_type) :: soilstate_inst - type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst +! type(waterdiagnosticbulk_type) :: waterdiagnosticbulk_inst ! type(surfalb_type) :: surfalb_inst ! type(solarabs_type) :: solarabs_inst ! type(canopystate_type) :: canopystate_inst ! type(ozone_base_type) :: ozone_inst ! type(photosyns_type) :: photosyns_inst - type(waterfluxbulk_type) :: waterfluxbulk_inst +! type(waterfluxbulk_type) :: waterfluxbulk_inst ! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst ! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst ! type(waterstate_type) :: waterstate_inst @@ -184,10 +185,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_nourbanp => filter(1)%nourbanp , & filter_num_nourbanp => filter(1)%num_nourbanp , & filter_exposedvegp => filter(1)%exposedvegp , & - filter_num_exposedvegp => filter(1)%num_exposedvegp , & - fdry_patch => waterdiagnosticbulk_inst%fdry_patch , & - fwet_patch => waterdiagnosticbulk_inst%fwet_patch , & - fcansno_patch => waterdiagnosticbulk_inst%fcansno_patch & + filter_num_exposedvegp => filter(1)%num_exposedvegp & ) ! allocate filters @@ -345,9 +343,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_novegsol(num_novegsol) = p end if - fdry_patch(p) = (1-fwet(nc))*elai(p)/max( elai(p)+esai(p), 1.e-06_r8 ) - fwet_patch(p) = fwet(nc) - fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet + water_inst%waterdiagnosticbulk_inst%fdry_patch(p) = (1-fwet(nc))*elai(p)/max( elai(p)+esai(p), 1.e-06_r8 ) + water_inst%waterdiagnosticbulk_inst%fwet_patch(p) = fwet(nc) + water_inst%waterdiagnosticbulk_inst%fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet end do end do end do @@ -361,7 +359,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call TwoStream(bounds, & filter_vegsol, num_vegsol, & coszen_clm, rho, tau, & - canopystate_inst, temperature_inst, waterdiagnosticbulk_inst, surfalb_inst) + canopystate_inst, temperature_inst, water_inst%waterdiagnosticbulk_inst, surfalb_inst) ! compute canopy shaded and sunlit variables (jk: needed to fill solarabs_inst before PHS call) call CanopySunShadeFracs(filter_nourbanp, filter_num_nourbanp, & @@ -380,9 +378,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call PhotosynthesisHydraulicStress ( bounds, filter(1)%num_exposedvegp, filter(1)%exposedvegp, & esat_tv_clm, eair_pert, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & - atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & + atm2lnd_inst, temperature_inst, soilstate_inst, water_inst%waterdiagnosticbulk_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & - photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) + photosyns_inst, water_inst%waterfluxbulk_inst, froot_carbon, croot_carbon) laisun_dea = canopystate_inst%laisun_patch laisha_dea = canopystate_inst%laisha_patch @@ -398,9 +396,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call PhotosynthesisHydraulicStress ( bounds, filter(1)%num_exposedvegp, filter(1)%exposedvegp, & esat_tv_pert, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & - atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & + atm2lnd_inst, temperature_inst, soilstate_inst, water_inst%waterdiagnosticbulk_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & - photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) + photosyns_inst, water_inst%waterfluxbulk_inst, froot_carbon, croot_carbon) laisun_dt = canopystate_inst%laisun_patch laisha_dt = canopystate_inst%laisha_patch @@ -414,9 +412,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call PhotosynthesisHydraulicStress ( bounds, filter(1)%num_exposedvegp, filter(1)%exposedvegp, & esat_tv_clm, eair_clm, oair_clm, cair_clm, rb_clm, bsun, bsha, btran, dayl_factor_clm, leafn, & qsatl_clm, qaf_clm, & - atm2lnd_inst, temperature_inst, soilstate_inst, waterdiagnosticbulk_inst, & + atm2lnd_inst, temperature_inst, soilstate_inst, water_inst%waterdiagnosticbulk_inst, & surfalb_inst, solarabs_inst, canopystate_inst, ozone_inst, & - photosyns_inst, waterfluxbulk_inst, froot_carbon, croot_carbon) + photosyns_inst, water_inst%waterfluxbulk_inst, froot_carbon, croot_carbon) laisun = canopystate_inst%laisun_patch laisha = canopystate_inst%laisha_patch From a2371474fa416ade113a45977f28946e545e5f81 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 17 Mar 2023 15:26:39 -0400 Subject: [PATCH 428/589] save water_type --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 index 7163880c6..7178e03a3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterType.F90 @@ -159,6 +159,7 @@ module WaterType procedure, public :: Init end type water_type + type(water_type), public, target, save :: water_inst character(len=*), parameter, private :: sourcefile = & __FILE__ From c3dcf254f3b323cf6d5c91f09c4a25fcc8bcbc50 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 20 Mar 2023 11:18:56 -0400 Subject: [PATCH 429/589] passing water types directly instead of importing them --- .../CLM51/CNCLM51_Photosynthesis.F90 | 4 +- .../CLM51/CNCLM_DriverMod.F90 | 43 ++++++++++--------- .../CLM51/CN_init_mod.F90 | 6 +-- .../GEOS_CatchCNCLM51GridComp.F90 | 7 +-- 4 files changed, 31 insertions(+), 29 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 1d2801a86..9676069d0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -32,7 +32,7 @@ module CNCLM_Photosynthesis !--------------------------------------------------- subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & t10,tm,cond,psis,wet3,bee,capac,fwet,coszen,ityp,& - pardir,pardif,albdir,albdif,dtc,dea,rc,rc_dea,rc_dt,& + pardir,pardif,albdir,albdif,dtc,dea,water_inst,rc,rc_dea,rc_dt,& laisun_out,laisha_out,psnsun_out,psnsha_out,lmrsun_out,& lmrsha_out,parabs,btran_out) @@ -65,7 +65,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, intent(in) :: albdif(nch,num_veg,num_zon,numrad) ! diffuse albedo real, intent(in) :: dtc ! canopy temperature perturbation (K) [approx 1:10000] real, intent(in) :: dea ! vapor pressure perturbation (Pa) [approx 1:10000] - + type(water_type),intent(in) :: water_inst ! OUTPUTS real, dimension(nch,num_zon), intent(out) :: rc ! unperturbed canopy stomatal resistance [s/m] diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index abb9e9765..2654d3842 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -47,6 +47,7 @@ module CNCLM_DriverMod use CNFireLi2021Mod use CNFireBaseMod use CN2CLMType + use WaterType implicit none private @@ -62,7 +63,7 @@ module CNCLM_DriverMod subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& - fsnow,tg10d,t2m5d,sndzn5d, & + fsnow,tg10d,t2m5d,sndzn5d,water_inst, & zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& @@ -109,7 +110,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: tg10d ! 10-day running mean of ground temperature [K] real, dimension(nch), intent(in) :: t2m5d ! 5-day running mean of daily minimum 2m temperature [K] real, dimension(nch), intent(in) :: sndzn5d ! 5-day running mean of total snow depth - + type(water_type), intent(in) :: water_inst ! OUTPUT @@ -216,7 +217,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m do nc = 1,nch ! catchment tile loop grc%dayl(nc) = dayl(nc) - wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) + water_inst%wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) cn2clm_inst%forc_hdm_cn2clm(nc) = hdm(nc) @@ -236,19 +237,19 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m soilstate_inst%soilpsi_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd) = poros(nc) atm2lnd_inst%forc_t_downscaled_col(n) = tairm(nc) - wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) - wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) - waterdiagnosticbulk_inst%wf_col(n) = sfm(nc,nz) - waterdiagnosticbulk_inst%wf2_col(n) = rzm(nc,nz) - waterdiagnosticbulk_inst%frac_sno_col(n) = fsnow(nc) - waterdiagnosticbulk_inst%snow_depth_col(n) = sndzn(nc) - waterdiagnosticbulk_inst%snow_5day_col(n) = sndzn5d(nc) + water_inst%wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) + water_inst%wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) + water_inst%waterdiagnosticbulk_inst%wf_col(n) = sfm(nc,nz) + water_inst%waterdiagnosticbulk_inst%wf2_col(n) = rzm(nc,nz) + water_inst%waterdiagnosticbulk_inst%frac_sno_col(n) = fsnow(nc) + water_inst%waterdiagnosticbulk_inst%snow_depth_col(n) = sndzn(nc) + water_inst%waterdiagnosticbulk_inst%snow_5day_col(n) = sndzn5d(nc) cnveg_state_inst%gdp_lf_col(n) = gdp(nc) cnveg_state_inst%abm_lf_col(n) = abm(nc) cnveg_state_inst%peatf_lf_col(n) = peatf(nc) - waterstatebulk_inst%h2osoi_liq_col(n,-nlevsno+1:nlevgrnd) = totwat(nc) - waterfluxbulk_inst%qflx_drain_col(n) = bflow(nc) - waterfluxbulk_inst%qflx_surf_col(n) = runsrf(nc) + water_inst%waterstatebulk_inst%h2osoi_liq_col(n,-nlevsno+1:nlevgrnd) = totwat(nc) + water_inst%waterfluxbulk_inst%qflx_drain_col(n) = bflow(nc) + water_inst%waterfluxbulk_inst%qflx_surf_col(n) = runsrf(nc) ! compute column-level saturated area fraction (water table at surface) if(nz==1) then @@ -267,9 +268,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m cn2clm_inst%btran2_patch_cn2clm(p) = btran_fire(nc,nz) ! cnfire_li2016_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) ! cnfire_li2021_inst%cnfire_base_type%btran2_patch(p) = btran_fire(nc,nz) - wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) - wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) - wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) + water_inst%wateratm2lndbulk_inst%prec60_patch(p) = prec60d(nc) + water_inst%wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) + water_inst%wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) frictionvel_inst%forc_hgt_u_patch(p) = 30. ! following CNCLM45 implementation, but this should be available from the GridComp end do ! np end do ! nz @@ -319,9 +320,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m soilbiogeochem_state_inst, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & active_layer_inst, & - atm2lnd_inst, waterstatebulk_inst, & - waterdiagnosticbulk_inst, waterfluxbulk_inst, & - wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + atm2lnd_inst, water_inst%waterstatebulk_inst, & + water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & + water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & crop_inst, ch4_inst, & photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & nutrient_competition_method, fireemis_inst) @@ -337,8 +338,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m filter(1)%num_actfirep, filter(1)%actfirep, & doalb, crop_inst, & soilstate_inst, soilbiogeochem_state_inst, & - waterstatebulk_inst, waterdiagnosticbulk_inst, & - waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & + water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & + water_inst%waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 01302b27a..cba58ea78 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -87,7 +87,7 @@ module CN_initMod class(nutrient_competition_method_type), public, allocatable :: nutrient_competition_method class(fire_method_type), allocatable :: cnfire_method type(saturated_excess_runoff_type), public :: saturated_excess_runoff_inst - type(water_type), public :: water_inst +! type(water_type), public :: water_inst ! type(bounds_type), public :: bounds ! type(patch_type) :: patch ! type(column_type) :: col @@ -135,7 +135,7 @@ module CN_initMod contains !------------------------------------------------------ - subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) + subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,cn5_cold_start) !ARGUMENTS implicit none @@ -149,7 +149,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,cn5_cold_start) real, dimension(nch), intent(in) :: lons ! Catchment tile longitudes [rad] real, intent(in) :: dtcn ! Catchment-CN step size logical, optional, intent(in) :: cn5_cold_start ! cold start for the CLM variables that are new in Catchment-CN5.0 - + type(water_type), intent(out) :: water_inst !LOCAL diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 22d409242..d34c28364 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -69,6 +69,7 @@ module GEOS_CatchCNCLM51GridCompMod gndtmp use update_model_para4cn, only : upd_curr_date_time + use WaterType implicit none private @@ -4231,7 +4232,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,DTCN,.true.) + call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,DTCN,water_inst,.true.) call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif @@ -6761,7 +6762,7 @@ subroutine Driver ( RC ) call catchcn_calc_rc(ntiles,fveg,TCx,QAx,PS,co2v,dayl_fac, & T2M10D,TA,cond,psis,wet3,bee,capac,fwet,ZTH,ityp,& - DRPAR,DFPAR,albdir,albdif,dtc,dea,rc00,rcdq,rcdt,& + DRPAR,DFPAR,albdir,albdif,dtc,dea,water_inst,rc00,rcdq,rcdt,& laisun,laisha,psnsun,psnsha,lmrsun,lmrsha,parzone,& btran) @@ -6913,7 +6914,7 @@ subroutine Driver ( RC ) call CN_Driver(ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& - asnowm,TG10D,T2MMIN5D,SNDZM5D, & + asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, & elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& fire_nloss,leafn,leafc,gross_nmin,net_nmin,& From a01cd655f2d5654d086b364d95c89914f9fb5c2e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 20 Mar 2023 11:28:37 -0400 Subject: [PATCH 430/589] avoid floating point exceptions whed rc is 0 --- .../CLM51/CNCLM51_Photosynthesis.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 9676069d0..1a0149d6f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -438,13 +438,13 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then ! stomatal resistances - rs = laisun(np)/rssun(np) + laisha(np)/rssha(np) + rs = laisun(np)/max(rssun(np), 1.e-06_r8 ) + laisha(np)/max(rssha(np), 1.e-06_r8 ) rcs = rcs + fveg(nc,nv,nz)*rs - rs_dea = laisun_dea(np)/rssun_dea(np) + laisha_dea(np)/rssha_dea(np) + rs_dea = laisun_dea(np)/max(rssun_dea(np), 1.e-06_r8 ) + laisha_dea(np)/max(rssha_dea(np), 1.e-06_r8 ) rcs_dea = rcs_dea + fveg(nc,nv,nz)*rs_dea - rs_dt = laisun_dt(np)/rssun_dt(np) + laisha_dt(np)/rssha_dt(np) + rs_dt = laisun_dt(np)/max(rssun_dt(np), 1.e-06_r8 ) + laisha_dt(np)/max(rssha_dt(np), 1.e-06_r8 ) rcs_dt = rcs_dt + fveg(nc,nv,nz)*rs_dt ! LAI From ab09677a51c196fe167f853f216979ec65a7bb9b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 20 Mar 2023 12:49:28 -0400 Subject: [PATCH 431/589] typo fix --- .../CLM51/CNCLM51_Photosynthesis.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 1a0149d6f..54c6dd17b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -476,9 +476,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & end if ! ityp = p end do !nv end do ! p - rc(n,nz) = 1./max(rcs,5.e-5) + rb(n) ! rc: unperturbed stomatal resistance (rs is stomatal conductance) - rc_dea(n,nz) = 1./max(rcs_dea,5.e-5) + rb(n) ! rc_dea: stomatal resistance with vapor pressure perturbation - rc_dt(n,nz) = 1./max(rcs_dt,5.e-5) + rb(n) ! rc_dt: stomatal resistance with canopy temperature perturbation + rc(nc,nz) = 1./max(rcs,5.e-5) + rb(nc) ! rc: unperturbed stomatal resistance (rs is stomatal conductance) + rc_dea(nc,nz) = 1./max(rcs_dea,5.e-5) + rb(nc) ! rc_dea: stomatal resistance with vapor pressure perturbation + rc_dt(nc,nz) = 1./max(rcs_dt,5.e-5) + rb(nc) ! rc_dt: stomatal resistance with canopy temperature perturbation end do ! nz end do ! nc From c19c0340a3cff64a6e347779699a7bc2f4ab7c72 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 21 Mar 2023 11:53:06 -0400 Subject: [PATCH 432/589] only compute PAR when vegetation is present --- .../GEOS_CatchCNCLM51GridComp.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index d34c28364..ff6dcb5c5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -6769,10 +6769,14 @@ subroutine Driver ( RC ) para(:) = 0. ! zero out absorbed PAR summing array do nz = 1,nzone do nv = 1,nveg - para(:) = para(:) + parzone(:,nv,nz)*wtzone(:,nz)*fveg(:,nv,nz) - if(associated(BTRANT)) then - btrant(:) = btrant(:) + btran(:,nv,nz)*fveg(:,nv,nz)*wtzone(:,nz) - end if + do n = 1,ntiles + if (fveg(nc,nv,nz)>1.e-4) then ! account for fact that parzone is undefined if fveg = 0 + para(n) = para(n) + parzone(n,nv,nz)*wtzone(n,nz)*fveg(n,nv,nz) + if(associated(BTRANT)) then + btrant(n) = btrant(n) + btran(n,nv,nz)*fveg(n,nv,nz)*wtzone(n,nz) + end if + end if + end do end do end do From d05497602d3493435d90b1ee2b5e930ee25beb59 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 21 Mar 2023 12:13:45 -0400 Subject: [PATCH 433/589] typo fix --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index ff6dcb5c5..ed2556026 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -6770,7 +6770,7 @@ subroutine Driver ( RC ) do nz = 1,nzone do nv = 1,nveg do n = 1,ntiles - if (fveg(nc,nv,nz)>1.e-4) then ! account for fact that parzone is undefined if fveg = 0 + if (fveg(n,nv,nz)>1.e-4) then ! account for fact that parzone is undefined if fveg = 0 para(n) = para(n) + parzone(n,nv,nz)*wtzone(n,nz)*fveg(n,nv,nz) if(associated(BTRANT)) then btrant(n) = btrant(n) + btran(n,nv,nz)*fveg(n,nv,nz)*wtzone(n,nz) From 65dd9fa613f730f55dad67f368f09e91dddf3264 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 22 Mar 2023 13:43:38 -0400 Subject: [PATCH 434/589] rework bgc_vegetation_inst initialization --- .../CLM51/CNCLM_DriverMod.F90 | 8 +- .../CLM51/CNVegetationFacade.F90 | 93 ++++++++++++++++++- .../CLM51/CN_init_mod.F90 | 29 +----- 3 files changed, 100 insertions(+), 30 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 2654d3842..0b20130cb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -1,7 +1,7 @@ module CNCLM_DriverMod use nanMod , only : nan - use CNVegetationFacade, only : cn_vegetation_type + use CNVegetationFacade use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& var_col, var_pft, nlevgrnd, numpft, ndecomp_pools use clm_varcon , only : grav, denh2o @@ -244,9 +244,9 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m water_inst%waterdiagnosticbulk_inst%frac_sno_col(n) = fsnow(nc) water_inst%waterdiagnosticbulk_inst%snow_depth_col(n) = sndzn(nc) water_inst%waterdiagnosticbulk_inst%snow_5day_col(n) = sndzn5d(nc) - cnveg_state_inst%gdp_lf_col(n) = gdp(nc) - cnveg_state_inst%abm_lf_col(n) = abm(nc) - cnveg_state_inst%peatf_lf_col(n) = peatf(nc) + bgc_vegetation_inst%cnveg_state_inst%gdp_lf_col(n) = gdp(nc) + bgc_vegetation_inst%cnveg_state_inst%abm_lf_col(n) = abm(nc) + bgc_vegetation_inst%cnveg_state_inst%peatf_lf_col(n) = peatf(nc) water_inst%waterstatebulk_inst%h2osoi_liq_col(n,-nlevsno+1:nlevgrnd) = totwat(nc) water_inst%waterfluxbulk_inst%qflx_drain_col(n) = bflow(nc) water_inst%waterfluxbulk_inst%qflx_surf_col(n) = runsrf(nc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index b66c4927b..2028b18d9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -152,7 +152,7 @@ module CNVegetationFacade ! - drydepvel_inst contains - ! procedure, public :: Init + procedure, public :: Init ! procedure, public :: InitAccBuffer ! procedure, public :: InitAccVars ! procedure, public :: UpdateAccVars @@ -193,6 +193,97 @@ module CNVegetationFacade contains + !----------------------------------------------------------------------- + subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold_start) + + ! + ! !DESCRIPTION: + ! Initialize a CNVeg object. + ! + ! Should be called regardless of whether use_cn is true + ! + ! !USES: + use CNFireFactoryMod , only : create_cnfire_method + use clm_varcon , only : c13ratio, c14ratio + use MAPL , only : NetCDF4_FileFormatter, pFIO_READ + use clm_varpar , only : num_zon, num_veg, & + var_col, var_pft + + ! + ! !ARGUMENTS: + class(cn_vegetation_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: ityp ! PFT index + real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction + real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart + character(300), intent(in) :: paramfile + logical, optional, intent(in) :: cn5_cold_start + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: rc, status + type(Netcdf4_fileformatter) :: ncid + + character(len=*), parameter :: subname = 'Init' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + ! Note - always initialize the memory for cnveg_state_inst (used in biogeophys/) + call this%cnveg_state_inst%Init(bounds, nch, ityp, fveg, cncol, cnpft) + + + if (use_cn) then + + ! Read in the general CN namelist + ! call this%CNReadNML( NLFilename ) ! MUST be called first as passes down control information to others + + call this%cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + + if (use_c13) then + call this%c13_cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + end if + if (use_c14) then + call this%c14_cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + end if + call this%cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) + if (use_c13) then + call this%c13_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) + end if + if (use_c14) then + call this%c14_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) + end if + call this%cnveg_nitrogenstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + call this%cnveg_nitrogenflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + + call this%c_products_inst%Init (bounds, nch, cncol, 'C') + if (use_c13) then + call this%c13_products_inst%Init (bounds, nch, cncol, 'C') + end if + if (use_c14) then + call this%c14_products_inst%Init (bounds, nch, cncol, 'C') + end if + call this%n_products_inst%Init (bounds, nch, cncol, 'N') + + call this%cn_balance_inst%Init(bounds) + + ! Initialize the memory for the dgvs_inst data structure regardless of whether + ! use_cndv is true so that it can be used in associate statements (nag compiler + ! complains otherwise) + call this%dgvs_inst%Init(bounds) + end if + + call create_cnfire_method(this%cnfire_method) + + call ncid%open(trim(paramfile),pFIO_READ, RC=status) + call this%cnfire_method%CNFireReadParams( ncid ) + call ncid%close(rc=status) + + end subroutine Init + !----------------------------------------------------------------------- ! subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) ! ! diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index cba58ea78..fc6876b07 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -202,6 +202,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,cn5_cold_ integer, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function !----------------------------------------- + paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' + ! initialize CN step size ndt = get_step_size( nint(dtcn) ) @@ -246,9 +248,9 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,cn5_cold_ ! initialize states and fluxes - call cnveg_nitrogenstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + call pftcon%init_pftcon_type () - call cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + call bgc_vegetation_inst%Init(bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold_start) call atm2lnd_inst%Init (bounds) @@ -268,20 +270,12 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,cn5_cold_ call photosyns_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) - call pftcon%init_pftcon_type () - call soilbiogeochem_carbonstate_inst%Init(bounds, nch, cncol) call soilbiogeochem_nitrogenstate_inst%Init(bounds, nch, cncol) call soilbiogeochem_state_inst%Init (bounds, nch, cncol) - call cnveg_state_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) - - call cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) - - call cnveg_nitrogenflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) - call soilbiogeochem_carbonflux_inst%Init (bounds) call soilbiogeochem_nitrogenflux_inst%Init(bounds) @@ -324,8 +318,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,cn5_cold_ ! initialize CLM parameters from parameter file - paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' - call ncid%open(trim(paramfile),pFIO_READ, RC=status) call readCNMRespParams(ncid) @@ -346,19 +338,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,cn5_cold_ call CNPhenologyInit (bounds) - call bgc_vegetation_inst%cn_balance_inst%Init (bounds) - call create_cnfire_method( bgc_vegetation_inst%cnfire_method) - - call ncid%open(trim(paramfile),pFIO_READ, RC=status) - call bgc_vegetation_inst%cnfire_method%CNFireReadParams( ncid ) - call ncid%close(rc=status) - - call bgc_vegetation_inst%cnfire_method%FireInit(bounds) - - call bgc_vegetation_inst%c_products_inst%Init (bounds, nch, cncol, 'C') - - call bgc_vegetation_inst%n_products_inst%Init (bounds, nch, cncol, 'N') - ! call FireMethodInit(bounds,paramfile) if (use_century_decomp) then From 00ae6cff6ec3ae199c7928c1666f311860c2fcb2 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 22 Mar 2023 14:40:35 -0400 Subject: [PATCH 435/589] correct pointer assignment --- .../CLM51/CNCLM51_Photosynthesis.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 54c6dd17b..3db4cfee0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -177,9 +177,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & f_sun_z => surfalb_inst%fsun_z_patch , & xl => pftcon%xl , & - leafn => cnveg_nitrogenstate_inst%leafn_patch , & - froot_carbon => cnveg_carbonstate_inst%frootc_patch , & - croot_carbon => cnveg_carbonstate_inst%livecrootc_patch, & + leafn => bgc_vegetation_inst%cnveg_nitrogenstate_inst%leafn_patch , & + froot_carbon => bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_patch , & + croot_carbon => bgc_vegetation_inst%cnveg_carbonstate_inst%livecrootc_patch, & elai => canopystate_inst%elai_patch , & esai => canopystate_inst%esai_patch , & filter_nourbanp => filter(1)%nourbanp , & From 6f792bb3d1b8ffb79223ef03f1dd30f514674307 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 22 Mar 2023 15:53:17 -0400 Subject: [PATCH 436/589] pass bgc_vegetation_type directly as input to catchcn_calc_rc --- .../CLM51/CNCLM51_Photosynthesis.F90 | 3 ++- .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 1 + .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 6 +++--- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 5 +++-- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 3db4cfee0..7e3dc848d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -32,7 +32,7 @@ module CNCLM_Photosynthesis !--------------------------------------------------- subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & t10,tm,cond,psis,wet3,bee,capac,fwet,coszen,ityp,& - pardir,pardif,albdir,albdif,dtc,dea,water_inst,rc,rc_dea,rc_dt,& + pardir,pardif,albdir,albdif,dtc,dea,water_inst,bgc_vegetation_inst,rc,rc_dea,rc_dt,& laisun_out,laisha_out,psnsun_out,psnsha_out,lmrsun_out,& lmrsha_out,parabs,btran_out) @@ -66,6 +66,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, intent(in) :: dtc ! canopy temperature perturbation (K) [approx 1:10000] real, intent(in) :: dea ! vapor pressure perturbation (Pa) [approx 1:10000] type(water_type),intent(in) :: water_inst + type(cn_vegetation_type), intent(in) :: bgc_vegetation_inst ! OUTPUTS real, dimension(nch,num_zon), intent(out) :: rc ! unperturbed canopy stomatal resistance [s/m] diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 2028b18d9..1af8aea88 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -184,6 +184,7 @@ module CNVegetationFacade procedure, private :: CNReadNML ! Read in the CN general namelist end type cn_vegetation_type + type(cn_vegetation_type), public, target, save :: bgc_vegetation_type ! !PRIVATE DATA MEMBERS: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index fc6876b07..3008d1c1e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -123,7 +123,7 @@ module CN_initMod ! type(waterstatebulk_type), public :: waterstatebulk_inst ! type(waterstate_type), public :: waterstate_inst ! type(frictionvel_type), public :: frictionvel_inst - type(cn_vegetation_type), public :: bgc_vegetation_inst +! type(cn_vegetation_type), public :: bgc_vegetation_inst type(waterfluxbulk_type), public :: waterfluxbulk_inst ! type(active_layer_type), public :: active_layer_inst @@ -135,7 +135,7 @@ module CN_initMod contains !------------------------------------------------------ - subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,cn5_cold_start) + subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_vegetation_inst,cn5_cold_start) !ARGUMENTS implicit none @@ -150,7 +150,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,cn5_cold_ real, intent(in) :: dtcn ! Catchment-CN step size logical, optional, intent(in) :: cn5_cold_start ! cold start for the CLM variables that are new in Catchment-CN5.0 type(water_type), intent(out) :: water_inst - + type(cn_vegetation_type), intent(out) :: bgc_vegetation_inst !LOCAL ! type(bounds_type) :: bounds diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index ed2556026..49571f136 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -70,6 +70,7 @@ module GEOS_CatchCNCLM51GridCompMod use update_model_para4cn, only : upd_curr_date_time use WaterType + use CNVegetationFacade implicit none private @@ -4232,7 +4233,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,DTCN,water_inst,.true.) + call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,DTCN,water_inst,bgc_vegetation_inst,.true.) call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif @@ -6762,7 +6763,7 @@ subroutine Driver ( RC ) call catchcn_calc_rc(ntiles,fveg,TCx,QAx,PS,co2v,dayl_fac, & T2M10D,TA,cond,psis,wet3,bee,capac,fwet,ZTH,ityp,& - DRPAR,DFPAR,albdir,albdif,dtc,dea,water_inst,rc00,rcdq,rcdt,& + DRPAR,DFPAR,albdir,albdif,dtc,dea,water_inst,bgc_vegetation_inst,rc00,rcdq,rcdt,& laisun,laisha,psnsun,psnsha,lmrsun,lmrsha,parzone,& btran) From 0ee8eda70ce80e089177d2d7b201836fe590027b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 22 Mar 2023 16:07:59 -0400 Subject: [PATCH 437/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 7e3dc848d..5e6e05664 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -21,6 +21,7 @@ module CNCLM_Photosynthesis use WaterFluxBulkType use WaterStateType use WaterType + use CNVegetationFacade implicit none From 49825d3834b7b85ffd76aee91e1f59d57967daba Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 22 Mar 2023 19:26:49 -0400 Subject: [PATCH 438/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 1af8aea88..d2aad7de2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -184,7 +184,7 @@ module CNVegetationFacade procedure, private :: CNReadNML ! Read in the CN general namelist end type cn_vegetation_type - type(cn_vegetation_type), public, target, save :: bgc_vegetation_type + type(cn_vegetation_type), public, target, save :: bgc_vegetation_inst ! !PRIVATE DATA MEMBERS: From 3fc7f814913f57c5f6d4300f735365996544e1ce Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 22 Mar 2023 20:22:28 -0400 Subject: [PATCH 439/589] enable scaling functions --- .../CLM51/subgridAveMod.F90 | 198 +++++++++--------- 1 file changed, 99 insertions(+), 99 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 index 4e46d6b00..310e772ff 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/subgridAveMod.F90 @@ -61,8 +61,8 @@ module subgridAveMod ! end interface ! ! !PRIVATE MEMBER FUNCTIONS: -! private :: build_scale_l2g -! private :: create_scale_l2g_lookup + private :: build_scale_l2g + private :: create_scale_l2g_lookup ! Note about the urban scaling types used for c2l_scale_type (urbanf / urbans), from ! Bill Sacks and Keith Oleson: These names originally meant to distinguish between @@ -1260,104 +1260,104 @@ end subroutine c2g_2d ! end subroutine l2g_2d ! ! !----------------------------------------------------------------------- -! subroutine build_scale_l2g(bounds, l2g_scale_type, scale_l2g) -! ! -! ! !DESCRIPTION: -! ! Fill the scale_l2g(bounds%begl:bounds%endl) array with appropriate values for the given l2g_scale_type. -! ! This array can later be used to scale each landunit in forming grid cell averages. -! ! -! ! !USES: -! use landunit_varcon, only : max_lunit -! ! -! ! !ARGUMENTS: -! type(bounds_type), intent(in) :: bounds -! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging -! real(r8) , intent(out) :: scale_l2g( bounds%begl: ) ! scale factor -! ! -! ! !LOCAL VARIABLES: -! real(r8) :: scale_lookup(max_lunit) ! scale factor for each landunit type -! integer :: l ! index -! !----------------------------------------------------------------------- -! -! SHR_ASSERT_ALL_FL((ubound(scale_l2g) == (/bounds%endl/)), sourcefile, __LINE__) -! -! ! TODO(wjs, 2017-03-09) If this routine is a performance problem (which it may be, -! ! because I think it's called a lot), then a simple optimization would be to treat -! ! l2g_scale_type = 'unity' specially, rather than using the more general-purpose code -! ! for this special case. -! -! call create_scale_l2g_lookup(l2g_scale_type, scale_lookup) -! -! do l = bounds%begl,bounds%endl -! scale_l2g(l) = scale_lookup(lun%itype(l)) -! end do -! -! end subroutine build_scale_l2g + subroutine build_scale_l2g(bounds, l2g_scale_type, scale_l2g) + ! + ! !DESCRIPTION: + ! Fill the scale_l2g(bounds%begl:bounds%endl) array with appropriate values for the given l2g_scale_type. + ! This array can later be used to scale each landunit in forming grid cell averages. + ! + ! !USES: + use landunit_varcon, only : max_lunit + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + real(r8) , intent(out) :: scale_l2g( bounds%begl: ) ! scale factor + ! + ! !LOCAL VARIABLES: + real(r8) :: scale_lookup(max_lunit) ! scale factor for each landunit type + integer :: l ! index + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(scale_l2g) == (/bounds%endl/)), sourcefile, __LINE__) + + ! TODO(wjs, 2017-03-09) If this routine is a performance problem (which it may be, + ! because I think it's called a lot), then a simple optimization would be to treat + ! l2g_scale_type = 'unity' specially, rather than using the more general-purpose code + ! for this special case. + + call create_scale_l2g_lookup(l2g_scale_type, scale_lookup) + + do l = bounds%begl,bounds%endl + scale_l2g(l) = scale_lookup(lun%itype(l)) + end do + + end subroutine build_scale_l2g ! ! !----------------------------------------------------------------------- -! subroutine create_scale_l2g_lookup(l2g_scale_type, scale_lookup) -! ! -! ! DESCRIPTION: -! ! Create a lookup array, scale_lookup(1..max_lunit), which gives the scale factor for -! ! each landunit type depending on l2g_scale_type -! ! -! ! !USES: -! use landunit_varcon, only : istsoil, istcrop, istice_mec, istdlak -! use landunit_varcon, only : isturb_MIN, isturb_MAX, max_lunit -! ! -! ! !ARGUMENTS: -! character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging -! real(r8) , intent(out) :: scale_lookup(max_lunit) ! scale factor for each landunit type -! !----------------------------------------------------------------------- -! -! ! ------------ WJS (10-14-11): IMPORTANT GENERAL NOTES ------------ -! ! -! ! Since scale_l2g is not currently included in the sumwt accumulations, you need to -! ! be careful about the scale values you use. Values of 1 and spval are safe -! ! (including having multiple landunits with value 1), but only use other values if -! ! you know what you are doing! For example, using a value of 0 is NOT the correct way -! ! to exclude a landunit from the average, because the normalization will be done -! ! incorrectly in this case: instead, use spval to exclude a landunit from the -! ! average. Similarly, using a value of 2 is NOT the correct way to give a landunit -! ! double relative weight in general, because the normalization won't be done -! ! correctly in this case, either. -! ! -! ! In the longer-term, I believe that the correct solution to this problem is to -! ! include scale_l2g (and the other scale factors) in the sumwt accumulations -! ! (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but that -! ! requires some more thought to (1) make sure that is correct, and (2) make sure it -! ! doesn't break the urban scaling. -! ! -! ! ----------------------------------------------------------------- -! -! -! ! Initialize scale_lookup to spval for all landunits. Thus, any landunit that keeps -! ! the default value will be excluded from grid cell averages. -! scale_lookup(:) = spval -! -! if (l2g_scale_type == 'unity') then -! scale_lookup(:) = 1.0_r8 -! else if (l2g_scale_type == 'natveg') then -! scale_lookup(istsoil) = 1.0_r8 -! else if (l2g_scale_type == 'veg') then -! scale_lookup(istsoil) = 1.0_r8 -! scale_lookup(istcrop) = 1.0_r8 -! else if (l2g_scale_type == 'ice') then -! scale_lookup(istice_mec) = 1.0_r8 -! else if (l2g_scale_type == 'nonurb') then -! scale_lookup(:) = 1.0_r8 -! scale_lookup(isturb_MIN:isturb_MAX) = spval -! else if (l2g_scale_type == 'lake') then -! scale_lookup(istdlak) = 1.0_r8 -! else if (l2g_scale_type == 'veg_plus_lake') then -! scale_lookup(istsoil) = 1.0_r8 -! scale_lookup(istcrop) = 1.0_r8 -! scale_lookup(istdlak) = 1.0_r8 -! else -! write(iulog,*)'scale_l2g_lookup_array error: scale type ',l2g_scale_type,' not supported' -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if -! -! end subroutine create_scale_l2g_lookup + subroutine create_scale_l2g_lookup(l2g_scale_type, scale_lookup) + ! + ! DESCRIPTION: + ! Create a lookup array, scale_lookup(1..max_lunit), which gives the scale factor for + ! each landunit type depending on l2g_scale_type + ! + ! !USES: + use landunit_varcon, only : istsoil, istcrop, istice_mec, istdlak + use landunit_varcon, only : isturb_MIN, isturb_MAX, max_lunit + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + real(r8) , intent(out) :: scale_lookup(max_lunit) ! scale factor for each landunit type + !----------------------------------------------------------------------- + + ! ------------ WJS (10-14-11): IMPORTANT GENERAL NOTES ------------ + ! + ! Since scale_l2g is not currently included in the sumwt accumulations, you need to + ! be careful about the scale values you use. Values of 1 and spval are safe + ! (including having multiple landunits with value 1), but only use other values if + ! you know what you are doing! For example, using a value of 0 is NOT the correct way + ! to exclude a landunit from the average, because the normalization will be done + ! incorrectly in this case: instead, use spval to exclude a landunit from the + ! average. Similarly, using a value of 2 is NOT the correct way to give a landunit + ! double relative weight in general, because the normalization won't be done + ! correctly in this case, either. + ! + ! In the longer-term, I believe that the correct solution to this problem is to + ! include scale_l2g (and the other scale factors) in the sumwt accumulations + ! (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but that + ! requires some more thought to (1) make sure that is correct, and (2) make sure it + ! doesn't break the urban scaling. + ! + ! ----------------------------------------------------------------- + + + ! Initialize scale_lookup to spval for all landunits. Thus, any landunit that keeps + ! the default value will be excluded from grid cell averages. + scale_lookup(:) = spval + + if (l2g_scale_type == 'unity') then + scale_lookup(:) = 1.0_r8 + else if (l2g_scale_type == 'natveg') then + scale_lookup(istsoil) = 1.0_r8 + else if (l2g_scale_type == 'veg') then + scale_lookup(istsoil) = 1.0_r8 + scale_lookup(istcrop) = 1.0_r8 + else if (l2g_scale_type == 'ice') then + scale_lookup(istice_mec) = 1.0_r8 + else if (l2g_scale_type == 'nonurb') then + scale_lookup(:) = 1.0_r8 + scale_lookup(isturb_MIN:isturb_MAX) = spval + else if (l2g_scale_type == 'lake') then + scale_lookup(istdlak) = 1.0_r8 + else if (l2g_scale_type == 'veg_plus_lake') then + scale_lookup(istsoil) = 1.0_r8 + scale_lookup(istcrop) = 1.0_r8 + scale_lookup(istdlak) = 1.0_r8 + else + write(iulog,*)'scale_l2g_lookup_array error: scale type ',l2g_scale_type,' not supported' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end subroutine create_scale_l2g_lookup end module subgridAveMod From 4524f7d0b288eeb45d5e78c6a6b10a29d3141e04 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 23 Mar 2023 09:36:21 -0400 Subject: [PATCH 440/589] fix AnnualFluxDribbler call --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 33 +++++++++++++++++++ .../CLM51/CNVegetationFacade.F90 | 6 ++-- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index c6d2085e6..8f0d37da3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -506,6 +506,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart + character(len=*) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] logical, optional, intent(in) :: cn5_cold_start class(cnveg_carbonflux_type) :: this integer, optional, intent(out) :: rc @@ -516,6 +517,8 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) integer :: begg, endg integer :: np, nc, nz, p, nv, n logical :: cold_start = .false. + logical :: allows_non_annual_delta + character(len=:), allocatable :: carbon_type_suffix !-------------------------------------------------------- ! check whether a cn5_cold_start option was set and change cold_start accordingly @@ -1124,6 +1127,36 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) end do ! nz end do ! nc + ! Construct restart field names consistently to what is done in SpeciesNonIsotope & + ! SpeciesIsotope, to aid future migration to that infrastructure + if (carbon_type == 'c12') then + carbon_type_suffix = 'c' + else if (carbon_type == 'c13') then + carbon_type_suffix = 'c_13' + else if (carbon_type == 'c14') then + carbon_type_suffix = 'c_14' + else + write(iulog,*) 'CNVegCarbonFluxType InitAllocate: Unknown carbon_type: ', trim(carbon_type) + call endrun(msg='CNVegCarbonFluxType InitAllocate: Unknown carbon_type: ' // & + errMsg(sourcefile, __LINE__)) + end if + + if (use_cndv) then + allows_non_annual_delta = .true. + else + allows_non_annual_delta = .false. + end if + this%dwt_conv_cflux_dribbler = annual_flux_dribbler_gridcell( & + bounds = bounds, & + name = 'dwt_conv_flux_' // carbon_type_suffix, & + units = 'gC/m^2', & + allows_non_annual_delta = allows_non_annual_delta) + this%hrv_xsmrpool_to_atm_dribbler = annual_flux_dribbler_gridcell( & + bounds = bounds, & + name = 'hrv_xsmrpool_to_atm_' // carbon_type_suffix, & + units = 'gC/m^2', & + allows_non_annual_delta = .false.) + end subroutine Init !----------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index d2aad7de2..fcf8e1aef 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -250,12 +250,12 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold if (use_c14) then call this%c14_cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) end if - call this%cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) + call this%cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, carbon_type='c12') if (use_c13) then - call this%c13_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) + call this%c13_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, carbon_type='c13') end if if (use_c14) then - call this%c14_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) + call this%c14_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, carbon_type='c14') end if call this%cnveg_nitrogenstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) call this%cnveg_nitrogenflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) From 1d0336cbc83c57e5b79b92e71d7aca241adf0a01 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 23 Mar 2023 10:17:54 -0400 Subject: [PATCH 441/589] add missing use statements --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 8f0d37da3..d3119fe7f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -18,7 +18,7 @@ module CNVegCarbonFluxType igrain,igrain_st,igrain_xf,ioutc use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight - use clm_varctl , only : use_crop, use_matrixcn, use_cndv, use_grainproduct + use clm_varctl , only : use_crop, use_matrixcn, use_cndv, use_grainproduct, iulog use clm_varcon , only : dzsoi_decomp use pftconMod , only : npcropmin use clm_varcon , only : spval @@ -26,6 +26,8 @@ module CNVegCarbonFluxType use PatchType , only : patch use AnnualFluxDribbler , only : annual_flux_dribbler_type, annual_flux_dribbler_gridcell use MAPL_ExceptionHandling + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg ! !PUBLIC TYPES: implicit none @@ -489,7 +491,7 @@ module CNVegCarbonFluxType contains !--------------------------------------- - subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) + subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_cold_start, rc) ! !DESCRIPTION: ! Initialize CTSM carbon fluxes From 543b9ffa25c877b8fed546d227fc40b14a23d0d1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 23 Mar 2023 10:30:17 -0400 Subject: [PATCH 442/589] fix order of arguments in function call --- .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index fcf8e1aef..a854c278e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -250,12 +250,12 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold if (use_c14) then call this%c14_cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) end if - call this%cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, carbon_type='c12') + call this%cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, carbon_type='c12', cn5_cold_start) if (use_c13) then - call this%c13_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, carbon_type='c13') + call this%c13_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, carbon_type='c13', cn5_cold_start) end if if (use_c14) then - call this%c14_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, carbon_type='c14') + call this%c14_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, carbon_type='c14', cn5_cold_start) end if call this%cnveg_nitrogenstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) call this%cnveg_nitrogenflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) From e4a4995ecda2d26d587d9f0855d78c08595a8802 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 23 Mar 2023 10:54:17 -0400 Subject: [PATCH 443/589] make arguments not keyword --- .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index a854c278e..28de55e9c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -250,12 +250,12 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold if (use_c14) then call this%c14_cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) end if - call this%cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, carbon_type='c12', cn5_cold_start) + call this%cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, 'c12', cn5_cold_start) if (use_c13) then - call this%c13_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, carbon_type='c13', cn5_cold_start) + call this%c13_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, 'c13', cn5_cold_start) end if if (use_c14) then - call this%c14_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, carbon_type='c14', cn5_cold_start) + call this%c14_cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, 'c14', cn5_cold_start) end if call this%cnveg_nitrogenstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) call this%cnveg_nitrogenflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) From 9f418ae79826d66fd93ac46e0c3c3b3d87dc3185 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Mar 2023 13:31:37 -0400 Subject: [PATCH 444/589] account for changes in number of PFTs and variables --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 40 +++++++++++++++---- 1 file changed, 32 insertions(+), 8 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 552692de6..5eb2a265b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -9,13 +9,17 @@ module CatchmentCNRstMod use CatchmentRstMod, only : CatchmentRst use clm_varpar_shared , only : nzone => NUM_ZON_CN, nveg => NUM_VEG_CN, & VAR_COL_40, VAR_PFT_40, VAR_COL_45, VAR_PFT_45, & - npft => numpft_CN + VAR_COL_51, VAR_PFT_51, & + npft => numpft_CN, npft_51 => numpft_CN51 use nanMod , only : nan implicit none real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value - integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) + integer :: iclass_40(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) + integer :: iclass_45(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) + integer :: iclass_51(npft_51) = (/1,1,2,3,3,4,5,5,6,7,9,10,11,11,11/) + integer, allocatable :: iclass type, extends(CatchmentRst) :: CatchmentCNRst logical :: isCLM45 @@ -645,7 +649,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) AGCM_MI, AGCM_S, dofyr real, allocatable, dimension(:,:) :: fveg_offl, ityp_offl, tg_tmp real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:), var_out(:), var_psn(:,:,:) - integer :: status, in_ntiles, out_ntiles, numprocs + integer :: status, in_ntiles, out_ntiles, numprocs, npft_int logical :: root_proc integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft real, allocatable, dimension(:) :: lat_tmp @@ -653,7 +657,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) type(ESMF_Time) :: CURRENT_TIME type(ESMF_TimeInterval) :: timeStep type(ESMF_Clock) :: CLOCK - type(ESMF_Config) :: CF + type(ESMF_Config) :: CFgg character(*), parameter :: Iam = "CatchmentCN::Re_tile" @@ -755,9 +759,15 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) ityp_offl = this%cnity fveg_offl = this%fvg + if ((this%isCLM40) .or. (this%isCLM45)) then + npft_in = npft + elseif (this%isCLM51) then + npft_in = npft_51 + end if + do n = 1, in_ntiles do nv = 1,nveg - if(ityp_offl(n,nv)<0 .or. ityp_offl(n,nv)>npft) stop 'ityp' + if(ityp_offl(n,nv)<0 .or. ityp_offl(n,nv)>npft_in) stop 'ityp' if(fveg_offl(n,nv)<0..or. fveg_offl(n,nv)>1.00001) stop 'fveg' end do @@ -951,8 +961,21 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) print *, 'calculating regridded carbn' + if (this%isCLM40) then + allocate(iclass(npft)) + iclass = iclass_40 + elseif (this%isCLM45) then + allocate(iclass(npft)) + iclass = iclass_45 + elseif (this%isCLM51) then + allocate(iclass(npft_51)) + iclass = iclass_51 + end if + + + call regrid_carbon (out_NTILES, in_ntiles,id_glb_cn, & - DAYX, var_off_col,var_off_pft, ityp_offl, fveg_offl) + DAYX, var_off_col,var_off_pft, ityp_offl, fveg_offl, iclass) deallocate (var_off_col,var_off_pft) endif call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -961,13 +984,14 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) contains SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & - DAYX, var_off_col, var_off_pft, ityp_offl, fveg_offl) + DAYX, var_off_col, var_off_pft, ityp_offl, fveg_offl,iclass_in) ! write out regridded carbon variables implicit none integer, intent (in) :: NTILES, in_ntiles,id_glb (ntiles,nveg) real, intent (in) :: DAYX (NTILES), var_off_col(in_ntiles,NZONE,var_col), var_off_pft(in_ntiles,NZONE, NVEG, var_pft) real, intent (in), dimension(in_ntiles,nveg) :: fveg_offl, ityp_offl + integer, intent(in), dimension(:) :: iclass_in real, allocatable, dimension (:) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, var_dum real, allocatable :: var_col_out (:,:,:), var_pft_out (:,:,:,:) @@ -1029,7 +1053,7 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & iv = nv ! same type fraction (primary of secondary) else if(ityp_new == ityp_offl (offl_cell,nx) .and. fveg_offl (offl_cell,nx)> fmin) then iv = nx ! not same fraction - else if(iclass(ityp_new)==iclass(ityp_offl(offl_cell,nv)) .and. fveg_offl (offl_cell,nv)> fmin) then + else if(iclass_in(ityp_new)==iclass_in(ityp_offl(offl_cell,nv)) .and. fveg_offl (offl_cell,nv)> fmin) then iv = nv ! primary, other type (same class) else if(fveg_offl (offl_cell,nx)> fmin) then iv = nx ! secondary, other type (same class) From c2d6bd8729a8c44503c7155d7ad2f0f0af24fb61 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Mar 2023 13:43:55 -0400 Subject: [PATCH 445/589] fix iclass allocation --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 5eb2a265b..53dca31f4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -19,7 +19,7 @@ module CatchmentCNRstMod integer :: iclass_40(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) integer :: iclass_45(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) integer :: iclass_51(npft_51) = (/1,1,2,3,3,4,5,5,6,7,9,10,11,11,11/) - integer, allocatable :: iclass + integer, dimension(:), allocatable :: iclass type, extends(CatchmentRst) :: CatchmentCNRst logical :: isCLM45 @@ -962,13 +962,13 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) print *, 'calculating regridded carbn' if (this%isCLM40) then - allocate(iclass(npft)) + allocate(iclass(1:npft)) iclass = iclass_40 elseif (this%isCLM45) then - allocate(iclass(npft)) + allocate(iclass(1:npft)) iclass = iclass_45 elseif (this%isCLM51) then - allocate(iclass(npft_51)) + allocate(iclass(1:npft_51)) iclass = iclass_51 end if From 439bccc1d1a8f8f0f2eb510954e1f9356df8df37 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 24 Mar 2023 15:47:53 -0400 Subject: [PATCH 446/589] typo fix --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 53dca31f4..b8608e2e2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -129,8 +129,8 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) catch%VAR_PFT = VAR_PFT_45 endif if (index(cnclm, '51') /=0) then - catch%VAR_COL = VAR_COL_CLM51 - catch%VAR_PFT = VAR_PFT_CLM51 + catch%VAR_COL = VAR_COL_51 + catch%VAR_PFT = VAR_PFT_51 catch%isCLM51 = .true. endif @@ -252,8 +252,8 @@ function CatchmentCNRst_empty(meta, cnclm, time, rc) result (catch) catch%VAR_PFT = VAR_PFT_45 endif if (index(cnclm, '51') /=0) then - catch%VAR_COL = VAR_COL_CLM51 - catch%VAR_PFT = VAR_PFT_CLM51 + catch%VAR_COL = VAR_COL_51 + catch%VAR_PFT = VAR_PFT_51 catch%isCLM51 = .true. endif @@ -760,14 +760,14 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) fveg_offl = this%fvg if ((this%isCLM40) .or. (this%isCLM45)) then - npft_in = npft + npft_int = npft elseif (this%isCLM51) then - npft_in = npft_51 + npft_int = npft_51 end if do n = 1, in_ntiles do nv = 1,nveg - if(ityp_offl(n,nv)<0 .or. ityp_offl(n,nv)>npft_in) stop 'ityp' + if(ityp_offl(n,nv)<0 .or. ityp_offl(n,nv)>npft_int) stop 'ityp' if(fveg_offl(n,nv)<0..or. fveg_offl(n,nv)>1.00001) stop 'fveg' end do From 49d472af336f46c3c3c982601f448755f77a228c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Mar 2023 10:45:26 -0400 Subject: [PATCH 447/589] typo fix --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index b8608e2e2..f0d7d2c84 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -657,7 +657,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) type(ESMF_Time) :: CURRENT_TIME type(ESMF_TimeInterval) :: timeStep type(ESMF_Clock) :: CLOCK - type(ESMF_Config) :: CFgg + type(ESMF_Config) :: CF character(*), parameter :: Iam = "CatchmentCN::Re_tile" From 31988af88a2b8ba91fe7ad920aca8ff6208eca55 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 27 Mar 2023 15:07:42 -0400 Subject: [PATCH 448/589] manual updates to match latest develop --- .../GEOS_CatchCNCLM51GridComp.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 49571f136..d5a0c199b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -5205,13 +5205,12 @@ subroutine Driver ( RC ) ! Variables for FPAR real , allocatable, dimension (:,:,:) :: parzone + character(len=ESMF_MAXSTR) :: Co2_CycleFile IAm=trim(COMP_NAME)//"::RUN2::Driver" ! Begin - IAm=trim(COMP_NAME)//"Driver" - ! -------------------------------------------------------------------------- ! Get time step from configuration ! -------------------------------------------------------------------------- @@ -5713,7 +5712,11 @@ subroutine Driver ( RC ) call MPI_Info_create(info, STATUS); VERIFY_(status) call MPI_Info_set(info, "romio_cb_read", "automatic", STATUS); VERIFY_(status) - STATUS = NF_OPEN ('CO2_MonthlyMean_DiurnalCycle.nc4', NF_NOWRITE, CTfile); VERIFY_(status) + call MAPL_GetResource (MAPL, CO2_CycleFile, label = 'CO2_MonthlyMean_DiurnalCycle_FILE:', & + default = 'CO2_MonthlyMean_DiurnalCycle.nc4', RC=STATUS ) + VERIFY_(STATUS) + + STATUS = NF_OPEN (trim(CO2_CycleFile), NF_NOWRITE, CTfile); VERIFY_(status) allocate (CT_CO2V (1: NUNQ, 1:12, 1:8)) allocate (CTCO2_TMP (1:CT_grid_N_lon, 1:CT_grid_N_lat, 1:12, 1:8)) From 91c31e91ccc00cf0b9f21118b872675a9b15ab0d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 Mar 2023 13:24:03 -0400 Subject: [PATCH 449/589] compute wetness manually --- .../GEOS_CatchCNCLM51GridComp.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index d5a0c199b..eee395bb1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -5076,7 +5076,7 @@ subroutine Driver ( RC ) integer, parameter :: nveg = num_veg ! number of vegetation types integer, parameter :: nzone = num_zon ! number of stress zones - real, allocatable, dimension(:) :: wgt, wpp, fwet + real, allocatable, dimension(:) :: wgt, wpp, fwet, wet_in real, allocatable, dimension(:,:) :: sm ! soil water as frac of WHC for the 3 dydrological zones at root depth real, allocatable, dimension(:) :: SWSRF1, SWSRF2, SWSRF4 ! soil water as frac of WHC for the 3 dydrological zones at surface soil real, allocatable, dimension(:,:) :: tcx, qax @@ -6257,6 +6257,7 @@ subroutine Driver ( RC ) allocate( wgt(ntiles) ) allocate( wpp(ntiles) ) allocate( fwet(ntiles) ) + allocate( wet_in(ntiles) ) allocate( bt(ntiles,fsat:fwlt)) allocate( sm(ntiles,fsat:fwlt)) allocate( SWSRF1(ntiles) ) @@ -6764,8 +6765,10 @@ subroutine Driver ( RC ) end do ! nv end do ! nz + wet_in = max(min(PRMC / POROS,1.0),0.0) + call catchcn_calc_rc(ntiles,fveg,TCx,QAx,PS,co2v,dayl_fac, & - T2M10D,TA,cond,psis,wet3,bee,capac,fwet,ZTH,ityp,& + T2M10D,TA,cond,psis,wet_in,bee,capac,fwet,ZTH,ityp,& DRPAR,DFPAR,albdir,albdif,dtc,dea,water_inst,bgc_vegetation_inst,rc00,rcdq,rcdt,& laisun,laisha,psnsun,psnsha,lmrsun,lmrsha,parzone,& btran) @@ -7886,6 +7889,7 @@ subroutine Driver ( RC ) deallocate( wgt ) deallocate( wpp ) deallocate( fwet ) + deallocate( wet_in ) deallocate( sm ) deallocate( SWSRF1 ) deallocate( SWSRF2 ) From 7348dd5469d2c73a3812148e06ae2fd782e13b47 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 Mar 2023 13:43:26 -0400 Subject: [PATCH 450/589] limit soil decomposition levels to number of soil levels --- .../GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 index 81c2588d4..237e6509e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -6,6 +6,7 @@ module CNSharedParamsMod use shr_kind_mod , only: r8 => shr_kind_r8 use ncdio_pio , only : file_desc_t use ncdio_pio , only : ncd_io + use clm_varpar , only : nlevgrnd implicit none @@ -28,7 +29,7 @@ module CNSharedParamsMod type(CNParamsShareType), protected :: CNParamsShareInst logical, public :: use_fun = .false. ! Use the FUN2.0 model - integer, public :: nlev_soildecomp_standard = 5 + integer, public :: nlev_soildecomp_standard = nlevgrnd character(len=*), parameter, private :: sourcefile = & __FILE__ From 24f36c678618cb3a3c08769350ae36323687a4e3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 30 Mar 2023 09:30:26 -0400 Subject: [PATCH 451/589] update to newest develop --- .github/workflows/enforce-labels.yml | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/GWD_GridComp.rc | 0 .../GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_rdg.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF2020.F90 | 0 .../GEOSmoist_GridComp/ConvPar_GF_Shared.F90 | 0 .../GEOSmoist_GridComp/GEOS_BACM_1M_InterfaceMod.F90 | 0 .../GEOSmoist_GridComp/GEOS_GFDL_1M_InterfaceMod.F90 | 0 .../GEOSmoist_GridComp/GEOS_GF_InterfaceMod.F90 | 0 .../GEOSmoist_GridComp/GEOS_MGB2_2M_InterfaceMod.F90 | 0 .../GEOSmoist_GridComp/GEOS_RAS_InterfaceMod.F90 | 0 .../GEOSmoist_GridComp/GEOS_UW_InterfaceMod.F90 | 0 .../GEOSphysics_GridComp/GEOSmoist_GridComp/Process_Library.F90 | 0 .../CLM51/SoilBiogeochemDecompCascadeCNMod.F90 | 2 +- .../GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 | 0 .../GEOSland_GridComp/GEOSigni_GridComp/CMakeLists.txt | 0 .../GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 | 0 .../GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.rc | 0 .../GEOSland_GridComp/GEOSigni_GridComp/tests/Makefile | 0 .../GEOSsurface_GridComp/Utils/Raster/makebcs/EASE_conv.F90 | 0 .../GEOSsurface_GridComp/Utils/Raster/misc/README | 0 .../GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt | 0 .../GEOSsurface_GridComp/Utils/Raster/preproc/README | 0 .../Utils/Raster/preproc/soil/CMakeLists.txt | 0 .../GEOSdataseaice_GridComp/GEOS_DataSeaIceGridComp_ExtData.F90 | 0 24 files changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 .github/workflows/enforce-labels.yml mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GWD_GridComp.rc mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_rdg.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF2020.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF_Shared.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_BACM_1M_InterfaceMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GFDL_1M_InterfaceMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GF_InterfaceMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MGB2_2M_InterfaceMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_RAS_InterfaceMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_UW_InterfaceMod.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/Process_Library.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.rc mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/Makefile mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/EASE_conv.F90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/README mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/README mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/CMakeLists.txt mode change 100644 => 100755 GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/GEOS_DataSeaIceGridComp_ExtData.F90 diff --git a/.github/workflows/enforce-labels.yml b/.github/workflows/enforce-labels.yml old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GWD_GridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/GWD_GridComp.rc old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_rdg.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_rdg.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF2020.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF2020.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF_Shared.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/ConvPar_GF_Shared.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_BACM_1M_InterfaceMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_BACM_1M_InterfaceMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GFDL_1M_InterfaceMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GFDL_1M_InterfaceMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GF_InterfaceMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_GF_InterfaceMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MGB2_2M_InterfaceMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MGB2_2M_InterfaceMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_RAS_InterfaceMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_RAS_InterfaceMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_UW_InterfaceMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_UW_InterfaceMod.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/Process_Library.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/Process_Library.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 index a61a6fddd..54ea95761 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeCNMod.F90 @@ -751,7 +751,7 @@ subroutine decomp_rate_constants_cn(bounds, & ! the following normalizes values in fr so that they ! sum to 1.0 across top nlevdecomp levels on a column frw(bounds%begc:bounds%endc) = 0._r8 - nlev_soildecomp_standard=5 + !nlev_soildecomp_standard=5 allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard)) do j=1,nlev_soildecomp_standard do fc = 1,num_soilc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.rc b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.rc old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/Makefile b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/tests/Makefile old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/EASE_conv.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/EASE_conv.F90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/README b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/misc/README old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/README b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/README old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/soil/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/GEOS_DataSeaIceGridComp_ExtData.F90 b/GEOSogcm_GridComp/GEOSseaice_GridComp/GEOSdataseaice_GridComp/GEOS_DataSeaIceGridComp_ExtData.F90 old mode 100644 new mode 100755 From 0eea87892f15fb95255630acac63b7b01d6fc9e9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 30 Mar 2023 14:38:03 -0400 Subject: [PATCH 452/589] add parenthesis to force order of operations --- .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index cb43e550f..6a1a44d6e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -3727,7 +3727,7 @@ function plc(x,p,c,level,plc_method) select case (plc_method) !possible to add other methods later case (vegetation_weibull) - plc=2._r8**(-(x/params_inst%psi50(ivt(p),level))**params_inst%ck(ivt(p),level)) + plc=2._r8**(-((x/params_inst%psi50(ivt(p),level))**params_inst%ck(ivt(p),level))) if ( plc < 0.005_r8) plc = 0._r8 case default print *,'must choose plc method' From 701682a779e6658814deab0d72447c37d8b53dc1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 6 Apr 2023 10:33:41 -0400 Subject: [PATCH 453/589] remove unused cold_start option --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index 1af287447..cb0d75f33 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -50,7 +50,7 @@ module SoilBiogeochemStateType contains !--------------------------------------- - subroutine Init(this, bounds, nch, cncol, cn5_cold_start, rc) + subroutine Init(this, bounds, nch, cncol, rc) ! ! !ARGUMENTS: @@ -58,7 +58,6 @@ subroutine Init(this, bounds, nch, cncol, cn5_cold_start, rc) type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of tiles real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart - logical, optional, intent(in) :: cn5_cold_start class(soilbiogeochem_state_type) :: this integer, optional, intent(out) :: rc ! @@ -66,21 +65,11 @@ subroutine Init(this, bounds, nch, cncol, cn5_cold_start, rc) integer :: begp, endp integer :: begc,endc integer :: n, nc, nz, np - logical :: cold_start = .false. !----------------------------------- begp = bounds%begp; endp= bounds%endp begc = bounds%begc; endc= bounds%endc - ! check whether a cn5_cold_start option was set and change cold_start accordingly - if (present(cn5_cold_start) .and. (cn5_cold_start.eqv..true.)) then - cold_start = .true. - end if - - ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort - if ((cold_start.eqv..false.) .and. (size(cncol,3).ne.var_col)) then - _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') - end if allocate(this%leaf_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%leaf_prof_patch (:,:) = spval allocate(this%froot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%froot_prof_patch (:,:) = spval From 7a8bcbf18d66d8e814d585deefe0428344340eb8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 08:35:28 -0400 Subject: [PATCH 454/589] remove initialization of root fraction as it is initialized in CN_init --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 5e6e05664..1ea824c52 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -310,8 +310,6 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & temperature_inst%t_veg_patch(p) = tc(nc,nz) temperature_inst%t_a10_patch(p) = t10(nc) temperature_inst%thm_patch(p) = tm(nc) - - soilstate_inst%rootfr_patch(p,1) = 0. ! map Photosynthesis inputs to CLM space esat_tv_clm (p) = esat_tv(nc,nz) From ce017675784fe6ff6dffdd59d8e03e9a01673f4a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 08:36:09 -0400 Subject: [PATCH 455/589] set accumulation flag to true until we have a spun-up CNCLM51 restart file --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index eee395bb1..bfdde4ea9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -5179,7 +5179,7 @@ subroutine Driver ( RC ) ! NOTE: In CNPhenologyMod.F90, init_gdd20 is always set to .false. as well. For GEOS-5 runs, need to discard at least the first 2 years. ! This is not a problem for offline runs because we always spin up the model whenever we change meterology. fzeng, July 2017 ! -------------------------------------------------------------------------------------------------------------------------------------- - logical, parameter :: init_accum = .false.! Always set to .FALSE.!! Will spin up and discard at least 2 years anyways. fzeng, July 2017 + logical, parameter :: init_accum = .true.! jkolassa May 2023: needs to be set to true if no CNCLM51 restart is available integer, save :: istep ! model time step index integer :: accper ! number of time steps accumulated in a period of XX days, increases from 1 to nXXd in the first XX days, ! and remains as nXXd thereafter From ff6170c8fd712171f930e48dae719cee8b31c4c4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 08:40:30 -0400 Subject: [PATCH 456/589] add cold start initialization for water flux variables --- .../CLM51/CNCLM_WaterFluxType.F90 | 39 +++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index a4b0ebe50..f124e8af6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -178,6 +178,11 @@ subroutine Init(this, bounds) allocate(this%qflx_irrig_drip_patch(begp:endp)) allocate(this%qflx_irrig_sprinkler_patch(begp:endp)) + allocate(this%qflx_liqevap_from_top_layer_col(begc:endc)) + allocate(this%qflx_liqdew_to_top_layer_col(begc:endc)) + allocate(this%qflx_soliddew_to_top_layer_col(begc:endc)) + allocate(this%qflx_ice_runoff_xs_col(begc:endc)) + allocate(this%qflx_glcice_dyn_water_flux_col(begc:endc)) this%qflx_through_liq_patch(begp:endp) = spval this%qflx_through_snow_patch(begp:endp) = spval @@ -223,6 +228,40 @@ subroutine Init(this, bounds) this%qflx_irrig_drip_patch(begp:endp) = spval this%qflx_irrig_sprinkler_patch(begp:endp) = spval + ! assign cold start values for variables where it is needed + + this%qflx_snocanfall_patch(bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_liqcanfall_patch(bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_snow_unload_patch(bounds%begp:bounds%endp) = 0.0_r8 + + this%qflx_liqevap_from_top_layer_patch(bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_liqdew_to_top_layer_patch(bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_soliddew_to_top_layer_patch (bounds%begp:bounds%endp) = 0.0_r8 + + this%qflx_sfc_irrig_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_gw_uncon_irrig_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_gw_uncon_irrig_lyr_col(bounds%begc:bounds%endc,:) = 0.0_r8 + this%qflx_gw_con_irrig_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_irrig_drip_patch (bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_irrig_sprinkler_patch (bounds%begp:bounds%endp) = 0.0_r8 + + this%qflx_liqevap_from_top_layer_col(bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_liqdew_to_top_layer_col(bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_soliddew_to_top_layer_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8 + this%qflx_ice_runoff_xs_col(bounds%begc:bounds%endc) = 0._r8 + this%qflx_glcice_dyn_water_flux_col(bounds%begc:bounds%endc) = 0._r8 + this%qflx_tran_veg_patch(bounds%begp:bounds%endp) = 0._r8 + this%qflx_evap_veg_patch(bounds%begp:bounds%endp) = 0._r8 + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%qflx_drain_col(c) = 0._r8 + this%qflx_surf_col(c) = 0._r8 + end if + end do + end subroutine Init end module WaterFluxType From 6a95628b33dfe9b2c7c56a3cb586392cd76719a2 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 12:16:19 -0400 Subject: [PATCH 457/589] add initialization of soil biogeochemical competition --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 3008d1c1e..d0910a766 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -73,6 +73,7 @@ module CN_initMod use FireMethodType , only : fire_method_type use SoilBiogeochemNLeachingMod , only : readSoilBiogeochemNLeachingParams => readParams use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams + use SoilBiogeochemCompetitionMod , only : SoilBiogeochemCompetitionInit use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & @@ -337,6 +338,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget ! initialize types that depend on parameters call CNPhenologyInit (bounds) + call SoilBiogeochemCompetitionInit (bounds) ! call FireMethodInit(bounds,paramfile) From 2b10a160902ace8f16dca09f7073f7f3c3940110 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 12:33:48 -0400 Subject: [PATCH 458/589] add missing local variables --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index f124e8af6..1687d71b7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -128,6 +128,7 @@ subroutine Init(this, bounds) integer :: begp, endp integer :: begc, endc integer :: begg, endg + integer :: c, l !-------------------- begp = bounds%begp ; endp = bounds%endp From 1325120a347670f61536242753d4571a6901fcc9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 12:50:32 -0400 Subject: [PATCH 459/589] add missing use statements --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index 1687d71b7..a8e3513e1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -4,6 +4,8 @@ module WaterFluxType use nanMod , only : nan use clm_varpar , only : nlevsno use clm_varcon , only : spval + use LandunitType , only : lun + use ColumnType , only : col use netcdf use MAPL_ExceptionHandling use decompMod , only : bounds_type From b6bee989efc3080018e47e2bcdad7f5230926640 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 13:00:02 -0400 Subject: [PATCH 460/589] add missing use statements --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index a8e3513e1..fd56da9ad 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -119,7 +119,10 @@ subroutine Init(this, bounds) ! Initialize CTSM type for water flux variables that just apply to bulk water and are needed for calling CTSM routines ! jk Oct 2021: type is allocated and initialized to NaN; values are assigned from Catchment states before calls to CLM subroutines are made ! this type is only used to be able to pass Catchment states and fluxes to CLM subroutines in the format they expect - ! + ! + + ! !USES: + use landunit_varcon, only : istsoil, istcrop ! !ARGUMENTS: implicit none !INPUT/OUTPUT From 2cb8e45f7e82bb88ece46707e2c1ba414e17fee9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 14:06:52 -0400 Subject: [PATCH 461/589] add allocation for missing variables --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index fd56da9ad..dd3a475c8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -189,6 +189,7 @@ subroutine Init(this, bounds) allocate(this%qflx_soliddew_to_top_layer_col(begc:endc)) allocate(this%qflx_ice_runoff_xs_col(begc:endc)) allocate(this%qflx_glcice_dyn_water_flux_col(begc:endc)) + allocate(this%qflx_gw_uncon_irrig_lyr_col(begc:endc)) this%qflx_through_liq_patch(begp:endp) = spval this%qflx_through_snow_patch(begp:endp) = spval From e5ac923ec1177dcbaa749a77b127b77143da5d3c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 14:26:00 -0400 Subject: [PATCH 462/589] correct allocation --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 index dd3a475c8..7bf885cc0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_WaterFluxType.F90 @@ -2,7 +2,7 @@ module WaterFluxType use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use nanMod , only : nan - use clm_varpar , only : nlevsno + use clm_varpar , only : nlevsno, nlevsoi use clm_varcon , only : spval use LandunitType , only : lun use ColumnType , only : col @@ -189,7 +189,7 @@ subroutine Init(this, bounds) allocate(this%qflx_soliddew_to_top_layer_col(begc:endc)) allocate(this%qflx_ice_runoff_xs_col(begc:endc)) allocate(this%qflx_glcice_dyn_water_flux_col(begc:endc)) - allocate(this%qflx_gw_uncon_irrig_lyr_col(begc:endc)) + allocate(this%qflx_gw_uncon_irrig_lyr_col(begc:endc,1:nlevsoi)) this%qflx_through_liq_patch(begp:endp) = spval this%qflx_through_snow_patch(begp:endp) = spval From e86a68ced589fef019a399ef13a10f06d3832335 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 15:04:52 -0400 Subject: [PATCH 463/589] add fire method initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 28de55e9c..1856cb42a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -278,6 +278,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold end if call create_cnfire_method(this%cnfire_method) + call this%cnfire_method%FireInit(bounds) call ncid%open(trim(paramfile),pFIO_READ, RC=status) call this%cnfire_method%CNFireReadParams( ncid ) From a6ffdab8496847e5c4451ba50a2a6c96962d497c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 9 May 2023 16:49:56 -0400 Subject: [PATCH 464/589] move dt initialization for CN to before CN routines are called --- .../GEOS_CatchCNCLM51GridComp.F90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index bfdde4ea9..a11e924e2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -3921,6 +3921,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) real :: bare logical, save :: first = .true. integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline + real :: ndt ! Offline mode @@ -4230,6 +4231,11 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) wtzone(:,nz) = CN_zone_weight(nz) end do +! call to set CN time step before any other CN routines are called (jkolassa May 2023) +! ------------------------------------------------------------------------------------------ + dtcn = min(dtcn,14400.) + ndt = get_step_size( nint(dtcn) ) + ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then @@ -5166,7 +5172,7 @@ subroutine Driver ( RC ) real, allocatable, dimension(:) :: lnfm character(len=ESMF_MAXSTR) :: LNFMFile - integer :: ntile, nv, dpy, ierr, iok, ndt + integer :: ntile, nv, dpy, ierr, iok integer, save :: year_prev = -9999 integer, save :: n1d ! number of land model steps in a 1-day period @@ -6868,8 +6874,6 @@ subroutine Driver ( RC ) dtcn = min(dtcn,14400.) if(mod(dtcn,dt) /= 0) stop 'dtcn' - ndt = get_step_size( nint(dtcn) ) ! gkw: get_step_size must be called here to set CN model time step - ! sum over interval for CN ! ------------------------ From b149a3b3e44c47c9547549b0da7eda108b930278 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 10 May 2023 12:53:21 -0400 Subject: [PATCH 465/589] add nstep initialization --- .../GEOS_CatchCNCLM51GridComp.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index a11e924e2..1f03da7ee 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -62,7 +62,7 @@ module GEOS_CatchCNCLM51GridCompMod USE MAPL use MAPL_ConstantsMod,only: Tzero => MAPL_TICE, pi => MAPL_PI - use clm_time_manager, only: get_days_per_year, get_step_size + use clm_time_manager, only: get_days_per_year, get_step_size, get_nstep use pftconMod, only: noveg USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & catch_calc_zbar, catch_calc_peatclsm_waterlevel, irrigation_rate, & @@ -3922,6 +3922,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) logical, save :: first = .true. integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline real :: ndt + integer :: nstep_cn ! Offline mode @@ -4236,6 +4237,10 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) dtcn = min(dtcn,14400.) ndt = get_step_size( nint(dtcn) ) +! update CN time step number +! -------------------------- + nstep_cn = get_nstep(istep_cn) + ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then From d7269820013e9a9f05d92b3d28f9aec62fae65f6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 11 May 2023 07:17:34 -0400 Subject: [PATCH 466/589] include first_step detection needed for CLM annual routines --- .../CLM51/CNCLM_DriverMod.F90 | 2 ++ .../CLM51/CN_init_mod.F90 | 6 ++++++ .../CLM51/clm_time_manager.F90 | 14 +++++++++++--- 3 files changed, 19 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 0b20130cb..099e27906 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -206,6 +206,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. + logical :: first_cn integer :: n, p, nc, nz, np, nv !------------------------------- @@ -354,6 +355,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m soilbiogeochem_nitrogenflux_inst, atm2lnd_inst ) else first = .false. + first_cn = is_first_step(first) ! this call is neede to globally set is_first_step to false; first_cn is not used end if grc%prev_dayl = grc%dayl ! set previous day length for following time steps (dayl itself is computed in GridComp) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index d0910a766..864f565f4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -75,6 +75,7 @@ module CN_initMod use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams use SoilBiogeochemCompetitionMod , only : SoilBiogeochemCompetitionInit use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams + use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControlInit use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -340,6 +341,11 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call CNPhenologyInit (bounds) call SoilBiogeochemCompetitionInit (bounds) + ! Initialize precision control for soil biogeochemistry (use soilbiogeochem_carbonstate three times, since we do not currently use isotopes) + call SoilBiogeochemPrecisionControlInit( soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst) + + ! call FireMethodInit(bounds,paramfile) if (use_century_decomp) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 4dd741954..ffb3abd4d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -246,10 +246,18 @@ end function is_end_curr_day !========================================================================================= -function is_first_step( ) - +logical function is_first_step(first) + ! Return value - logical :: is_first_step + logical, optional, intent(in) :: first ! set to this time step + + logical, save :: is_first_default = .true. + + if ( present(first) ) then + is_first_default = first + end if + + is_first_step = is_first_default end function is_first_step From bd54e2ac4ce48b20b6d07decb9b9d799ff8c418c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 11 May 2023 07:29:57 -0400 Subject: [PATCH 467/589] change referencing of CNVeg states --- .../CLM51/CNCLM_DriverMod.F90 | 62 +++++++++---------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 099e27906..e930726f4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -403,21 +403,21 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m cwdcg(nc) = 0. xsmr(nc) = 0. - neeg(nc) = cnveg_carbonflux_inst%nee_grc(nc) + neeg(nc) = bgc_vegetation_inst%cnveg_carbonflux_inst%nee_grc(nc) do nz = 1,num_zon ! CN zone loop n = n + 1 - colc(nc,nz) = cnveg_carbonstate_inst%totc_col(n) - srg(nc) = srg(nc) + cnveg_carbonflux_inst%sr_col(n)*CN_zone_weight(nz) - burn(nc) = burn(nc) + cnveg_state_inst%farea_burned_col(n)*CN_zone_weight(nz) - closs(nc) = closs(nc) + cnveg_carbonflux_inst%fire_closs_col(n)*CN_zone_weight(nz) + colc(nc,nz) = bgc_vegetation_inst%cnveg_carbonstate_inst%totc_col(n) + srg(nc) = srg(nc) + bgc_vegetation_inst%cnveg_carbonflux_inst%sr_col(n)*CN_zone_weight(nz) + burn(nc) = burn(nc) + bgc_vegetation_inst%cnveg_state_inst%farea_burned_col(n)*CN_zone_weight(nz) + closs(nc) = closs(nc) + bgc_vegetation_inst%cnveg_carbonflux_inst%fire_closs_col(n)*CN_zone_weight(nz) som_closs(nc) = som_closs(nc) + soilbiogeochem_carbonflux_inst%somc_fire_col(n)*CN_zone_weight(nz) - nfire(nc) = nfire(nc) + cnveg_state_inst%nfire_col(n)*CN_zone_weight(nz) + nfire(nc) = nfire(nc) + bgc_vegetation_inst%cnveg_state_inst%nfire_col(n)*CN_zone_weight(nz) denitg(nc) = denitg(nc) + soilbiogeochem_nitrogenflux_inst%denit_col(n)*CN_zone_weight(nz) sminn_leachedg(nc) = sminn_leachedg(nc) + soilbiogeochem_nitrogenflux_inst%sminn_leached_col(n)*CN_zone_weight(nz) sminng(nc) = sminng(nc) + soilbiogeochem_nitrogenstate_inst%sminn_col(n)*CN_zone_weight(nz) - col_fire_nlossg(nc) = col_fire_nlossg(nc) + cnveg_nitrogenflux_inst%fire_nloss_col(n)*CN_zone_weight(nz) + col_fire_nlossg(nc) = col_fire_nlossg(nc) + bgc_vegetation_inst%cnveg_nitrogenflux_inst%fire_nloss_col(n)*CN_zone_weight(nz) gross_nming(nc) = gross_nming(nc) + soilbiogeochem_nitrogenflux_inst%gross_nmin_col(n)*CN_zone_weight(nz) net_nming(nc) = net_nming(nc) + soilbiogeochem_nitrogenflux_inst%net_nmin_col(n)*CN_zone_weight(nz) nfix_to_sminng(nc) = nfix_to_sminng(nc) + soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col(n)*CN_zone_weight(nz) @@ -428,7 +428,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ndep_to_sminng(nc) = ndep_to_sminng(nc) + soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col(n)*CN_zone_weight(nz) totlitng(nc) = totlitng(nc) + soilbiogeochem_nitrogenstate_inst%totlitn_col(n)*CN_zone_weight(nz) totsomng(nc) = totsomng(nc) + soilbiogeochem_nitrogenstate_inst%totsomn_col(n)*CN_zone_weight(nz) - fuelcg(nc) = fuelcg(nc) + cnveg_carbonstate_inst%fuelc_col(n)*CN_zone_weight(nz) + fuelcg(nc) = fuelcg(nc) + bgc_vegetation_inst%cnveg_carbonstate_inst%fuelc_col(n)*CN_zone_weight(nz) totlitcg(nc) = totlitcg(nc) + soilbiogeochem_carbonstate_inst%totlitc_col(n)*CN_zone_weight(nz) cwdcg(nc) = cwdcg(nc) + soilbiogeochem_carbonstate_inst%cwdc_col(n)*CN_zone_weight(nz) @@ -442,32 +442,32 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m ztai(nc,nv,nz) = canopystate_inst%tlai_patch(p) pwtgcell = fveg(nc,nv,nz)*CN_zone_weight(nz) ! PFT weight in catchment tile - nppg(nc) = nppg(nc) + cnveg_carbonflux_inst%npp_patch(p)*pwtgcell - gppg(nc) = gppg(nc) + cnveg_carbonflux_inst%gpp_patch(p)*pwtgcell - root(nc) = root(nc) + (cnveg_carbonstate_inst%frootc_patch(p) & - + cnveg_carbonstate_inst%frootc_storage_patch(p) & - + cnveg_carbonstate_inst%frootc_xfer_patch(p) & + nppg(nc) = nppg(nc) + bgc_vegetation_inst%cnveg_carbonflux_inst%npp_patch(p)*pwtgcell + gppg(nc) = gppg(nc) + bgc_vegetation_inst%cnveg_carbonflux_inst%gpp_patch(p)*pwtgcell + root(nc) = root(nc) + (bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_storage_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_xfer_patch(p) & )*pwtgcell - vegc(nc) = vegc(nc) + cnveg_carbonstate_inst%totvegc_patch(p)*pwtgcell - ndeployg(nc) = ndeployg(nc) + cnveg_nitrogenflux_inst%ndeploy_patch(p)*pwtgcell - leafng(nc) = leafng(nc) + cnveg_nitrogenstate_inst%leafn_patch(p)*pwtgcell - leafcg(nc) = leafcg(nc) + cnveg_carbonstate_inst%leafc_patch(p)*pwtgcell - sminn_to_npoolg(nc) = sminn_to_npoolg(nc) + cnveg_nitrogenflux_inst%sminn_to_npool_patch(p)*pwtgcell - totvegng(nc) = totvegng(nc) + cnveg_nitrogenstate_inst%totvegn_patch(p)*pwtgcell - retransng(nc) = retransng(nc) + cnveg_nitrogenstate_inst%retransn_patch(p)*pwtgcell - retransn_to_npoolg(nc) = retransn_to_npoolg(nc) + cnveg_nitrogenflux_inst%retransn_to_npool_patch(p)*pwtgcell - rootcg(nc) = rootcg(nc) + (cnveg_carbonstate_inst%frootc_patch(p) & - + cnveg_carbonstate_inst%frootc_storage_patch(p) & - + cnveg_carbonstate_inst%frootc_xfer_patch(p) & - + cnveg_carbonstate_inst%livecrootc_patch(p) & - + cnveg_carbonstate_inst%livecrootc_storage_patch(p) & - + cnveg_carbonstate_inst%livecrootc_xfer_patch(p) & - + cnveg_carbonstate_inst%deadcrootc_patch(p) & - + cnveg_carbonstate_inst%deadcrootc_storage_patch(p) & - + cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) & + vegc(nc) = vegc(nc) + bgc_vegetation_inst%cnveg_carbonstate_inst%totvegc_patch(p)*pwtgcell + ndeployg(nc) = ndeployg(nc) + bgc_vegetation_inst%cnveg_nitrogenflux_inst%ndeploy_patch(p)*pwtgcell + leafng(nc) = leafng(nc) + bgc_vegetation_inst%cnveg_nitrogenstate_inst%leafn_patch(p)*pwtgcell + leafcg(nc) = leafcg(nc) + bgc_vegetation_inst%cnveg_carbonstate_inst%leafc_patch(p)*pwtgcell + sminn_to_npoolg(nc) = sminn_to_npoolg(nc) + bgc_vegetation_inst%cnveg_nitrogenflux_inst%sminn_to_npool_patch(p)*pwtgcell + totvegng(nc) = totvegng(nc) + bgc_vegetation_inst%cnveg_nitrogenstate_inst%totvegn_patch(p)*pwtgcell + retransng(nc) = retransng(nc) + bgc_vegetation_inst%cnveg_nitrogenstate_inst%retransn_patch(p)*pwtgcell + retransn_to_npoolg(nc) = retransn_to_npoolg(nc) + bgc_vegetation_inst%cnveg_nitrogenflux_inst%retransn_to_npool_patch(p)*pwtgcell + rootcg(nc) = rootcg(nc) + (bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_storage_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_xfer_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%livecrootc_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%livecrootc_storage_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%livecrootc_xfer_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%deadcrootc_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%deadcrootc_storage_patch(p) & + + bgc_vegetation_inst%cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) & )*pwtgcell - xsmr(nc) = xsmr(nc) + cnveg_carbonstate_inst%xsmrpool_patch(p)*pwtgcell + xsmr(nc) = xsmr(nc) + bgc_vegetation_inst%cnveg_carbonstate_inst%xsmrpool_patch(p)*pwtgcell end if end do ! nv end do !np From dc98d42391d69b99f09c49220d375e722d5785f8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 11 May 2023 07:59:23 -0400 Subject: [PATCH 468/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index e930726f4..5b511094a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -5,6 +5,7 @@ module CNCLM_DriverMod use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& var_col, var_pft, nlevgrnd, numpft, ndecomp_pools use clm_varcon , only : grav, denh2o + use clm_time_manager , only : is_first_step use decompMod use filterMod use SoilBiogeochemCarbonFluxType From dfdf180fe042f18fd1856e53216abf9b1580e96f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 11 May 2023 10:06:59 -0400 Subject: [PATCH 469/589] add subroutine to get date at beginning of time step --- .../CLM51/clm_time_manager.F90 | 24 ++++++++++++++++++- .../CLM51/update_model_para4cn.F90 | 15 ++++++++++-- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index ffb3abd4d..b9e5813cc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -4,7 +4,8 @@ module clm_time_manager #include "shr_assert.h" use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 - use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec + use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec, & + prev_year,prev_month,prev_day,prev_dofyr,prev_hour,prev_min,prev_sec use clm_varctl , only: iulog use MAPL_ExceptionHandling use ESMF @@ -21,6 +22,7 @@ module clm_time_manager get_nstep, &! return CN timestep number get_curr_date, &! return date components at end of current timestep + get_prev_date, &! return date components at beginning of current timestep ! get_curr_ESMF_Time, &! get current time in terms of the ESMF_Time ! get_start_date, &! return components of the start date ! get_driver_start_ymd, &! return year/month/day (as integer in YYYYMMDD format) of driver start date @@ -130,6 +132,26 @@ subroutine get_curr_date(yr, mon, day, tod, offset) end subroutine get_curr_date !========================================================================================= + subroutine get_prev_date(yr, mon, day, tod) + + ! Return date components valid at beginning of current timestep. + + implicit none + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + !--------------------------------------------- + + yr = prev_year + mon = prev_month + day = prev_day + tod = 3600*prev_hour + 60*prev_min + prev_sec + + end subroutine get_prev_date +!========================================================================================= + function get_curr_calday(offset) ! Return calendar day at end of current timestep with optional offset. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 index 570596ea5..59b81ef68 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/update_model_para4cn.F90 @@ -5,8 +5,11 @@ MODULE update_model_para4cn private INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: LocalTileID INTEGER, PUBLIC :: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec + INTEGER, PUBLIC :: prev_year,prev_month,prev_day,prev_dofyr,prev_hour,prev_min,prev_sec - SAVE curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec, LocalTileID + SAVE curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec, & + prev_year,prev_month,prev_day,prev_dofyr,prev_hour,prev_min,prev_sec, & + LocalTileID public :: upd_curr_date_time, upd_tileid @@ -34,7 +37,15 @@ subroutine upd_curr_date_time( year,month,day,dofyr,hour,min,sec ) implicit none integer, intent(in) :: year,month,day,dofyr,hour,min,sec - + + prev_year = curr_year + prev_month = curr_month + prev_day = curr_day + prev_dofyr = curr_dofyr + prev_hour = curr_hour + prev_min = curr_min + prev_sec = curr_sec + curr_year = year curr_month = month curr_day = day From afba6a759f372c90a9e063526b54f01a51a3d116 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 11 May 2023 11:13:35 -0400 Subject: [PATCH 470/589] add missing use statement --- .../GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 index 1c7413592..5729551a7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/AnnualFluxDribbler.F90 @@ -65,7 +65,7 @@ module AnnualFluxDribbler use decompMod , only : BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_PATCH use clm_varcon , only : secspday, nameg, namep use clm_time_manager , only : get_days_per_year, get_step_size_real, is_beg_curr_year - use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac + use clm_time_manager , only : get_curr_yearfrac, get_prev_yearfrac, get_prev_date use clm_time_manager , only : is_first_step ! implicit none From b791cc09f75013644682bc870c482379bd5be85b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 11 May 2023 14:43:09 -0400 Subject: [PATCH 471/589] create first time step check for CN --- .../CLM51/CNCLM_DriverMod.F90 | 2 -- .../GEOS_CatchCNCLM51GridComp.F90 | 15 ++++++++++++++- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 5b511094a..e017ea2aa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -207,7 +207,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions logical, save :: first = .true. - logical :: first_cn integer :: n, p, nc, nz, np, nv !------------------------------- @@ -356,7 +355,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m soilbiogeochem_nitrogenflux_inst, atm2lnd_inst ) else first = .false. - first_cn = is_first_step(first) ! this call is neede to globally set is_first_step to false; first_cn is not used end if grc%prev_dayl = grc%dayl ! set previous day length for following time steps (dayl itself is computed in GridComp) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 1f03da7ee..09c68e8b8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -62,7 +62,7 @@ module GEOS_CatchCNCLM51GridCompMod USE MAPL use MAPL_ConstantsMod,only: Tzero => MAPL_TICE, pi => MAPL_PI - use clm_time_manager, only: get_days_per_year, get_step_size, get_nstep + use clm_time_manager, only: get_days_per_year, get_step_size, get_nstep, is_first_step use pftconMod, only: noveg USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & catch_calc_zbar, catch_calc_peatclsm_waterlevel, irrigation_rate, & @@ -5218,6 +5218,9 @@ subroutine Driver ( RC ) real , allocatable, dimension (:,:,:) :: parzone character(len=ESMF_MAXSTR) :: Co2_CycleFile + integer :: cn_count = 0 + logical :: first_cn + IAm=trim(COMP_NAME)//"::RUN2::Driver" ! Begin @@ -6907,6 +6910,16 @@ subroutine Driver ( RC ) if(mod(AGCM_S_ofday,nint(dtcn)) == 0) then + cn_count = cn_count + 1 + + ! check whether CN is on its first 1.5 hours; since CN_Driver is called once right at the beginning, we set this variable to true when CN_Driver is called for the second time + if (cn_count .le. 2) then + first_cn = is_first_step(.true.) + else + first_cn = is_first_step(.false.) + end if + print *, 'first_cn: ', first_cn + ! fzeng: pass current date_time to the CN routines. call upd_curr_date_time( AGCM_YY, AGCM_MM, AGCM_DD, dofyr, & AGCM_HH, AGCM_MI, AGCM_S ) From e93c917cd101c5564f5dd5ad6a10e91e008c98f6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 16 May 2023 09:15:51 -0400 Subject: [PATCH 472/589] add cold start initialization for some CN product variables --- .../CLM51/CNCLM_CNProductsMod.F90 | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index c5b3c0cd0..4b8b10d05 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -7,7 +7,7 @@ module CNProductsMod use MAPL_ExceptionHandling use nanMod , only : nan use decompMod , only : bounds_type - use clm_varpar , only : num_zon, var_col, cn_zone_weight + use clm_varpar , only : num_zon, var_col, cn_zone_weight, numpft use clm_time_manager , only : get_step_size_real use PatchType , only : patch @@ -95,7 +95,7 @@ subroutine Init(this, bounds, nch, cncol, species, rc) ! LOCAL integer :: begp, endp integer :: begg, endg - integer :: nc, nz + integer :: nc, nz, p, np !--------------------------------- begp = bounds%begp ; endp = bounds%endp @@ -132,8 +132,10 @@ subroutine Init(this, bounds, nch, cncol, species, rc) do nc = 1,nch ! catchment tile loop - this%prod100_grc(nc) = 0 - this%prod10_grc(nc) = 0 + this%prod100_grc(nc) = 0._r8 + this%prod10_grc(nc) = 0._r8 + this%cropprod1_grc(nc) = 0._r8 + this%tot_woodprod_grc(nc) = 0._r8 do nz = 1,num_zon ! CN zone loop @@ -147,6 +149,12 @@ subroutine Init(this, bounds, nch, cncol, species, rc) _ASSERT(.FALSE.,'unknown species') end if + do p = 0,numpft ! PFT index loop + np = np + 1 + this%hrv_deadstem_to_prod10_patch(np) = 0._r8 + this%hrv_deadstem_to_prod100_patch(np) = 0._r8 + this%grain_to_cropprod1_patch(np) = 0._r8 + end do ! p end do ! nz end do ! nc end subroutine Init From e97250f7c00a7319079770f62dcd88f67cb9e8e7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 16 May 2023 09:28:52 -0400 Subject: [PATCH 473/589] add cold start initialization for more carbon flux variables --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 20 ++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index d3119fe7f..5e305aa5c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -517,7 +517,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co integer :: begp, endp integer :: begc, endc integer :: begg, endg - integer :: np, nc, nz, p, nv, n + integer :: np, nc, nz, p, nv, n, nl logical :: cold_start = .false. logical :: allows_non_annual_delta character(len=:), allocatable :: carbon_type_suffix @@ -1089,6 +1089,10 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co ! initialize variables from restart file or set to cold start value + + this%dwt_conv_cflux_dribbled_grc(begg:endg) = spval + + n = 0 np = 0 do nc = 1,nch ! catchment tile loop @@ -1097,6 +1101,16 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co this%annsum_npp_col (n) = cncol(nc,nz, 33) + + do nl = 1, nlevdecomp_full + this%dwt_frootc_to_litr_met_c_col(n,nl) = 0._r8 + this%dwt_frootc_to_litr_cel_c_col(n,nl) = 0._r8 + this%dwt_frootc_to_litr_lig_c_col(n,nl) = 0._r8 + this%dwt_livecrootc_to_cwdc_col(n,nl) = 0._r8 + this%dwt_deadcrootc_to_cwdc_col(n,nl) = 0._r8 + end do + + do p = 0,numpft ! PFT index loop np = np + 1 do nv = 1,num_veg ! defined veg loop @@ -1123,6 +1137,10 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co _ASSERT(.FALSE.,'missing CNCLM50_cold_start setting') end if + this%excess_cflux_patch(np) = 0._r8 + this%leafc_to_litter_fun_patch(np) = 0._r8 + this%plant_calloc_patch(np) = 0._r8 + end if end do !nv end do ! p From f6111bf0647a5cd58b8ad5d0a8837f54ea9e7501 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 16 May 2023 10:13:44 -0400 Subject: [PATCH 474/589] initialize index variable --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index 4b8b10d05..410a23a8c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -130,6 +130,7 @@ subroutine Init(this, bounds, nch, cncol, species, rc) ! initialize variables from restart file or set to cold start value + np = 0 do nc = 1,nch ! catchment tile loop this%prod100_grc(nc) = 0._r8 From 779368aff3675148e9ab9ecbebb6478a5511cac5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 16 May 2023 16:21:47 -0400 Subject: [PATCH 475/589] adding cold start initializations --- .../CLM51/CNCLM_CNProductsMod.F90 | 4 ++++ .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 15 +++++++++------ 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index 410a23a8c..f4f89260a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -10,6 +10,7 @@ module CNProductsMod use clm_varpar , only : num_zon, var_col, cn_zone_weight, numpft use clm_time_manager , only : get_step_size_real use PatchType , only : patch + use clm_varcon , only : spval ! !PUBLIC TYPES: implicit none @@ -127,6 +128,9 @@ subroutine Init(this, bounds, nch, cncol, species, rc) allocate(this%tot_woodprod_loss_grc(begg:endg)) ; this%tot_woodprod_loss_grc(:) = nan allocate(this%product_loss_grc(begg:endg)) ; this%product_loss_grc(:) = nan + this%dwt_cropprod1_gain_grc(begg:endg) = spval + this%dwt_prod10_gain_grc(begg:endg) = spval + this%dwt_prod100_gain_grc(begg:endg) = spval ! initialize variables from restart file or set to cold start value diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 5e305aa5c..b40c7cd58 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1091,6 +1091,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co ! initialize variables from restart file or set to cold start value this%dwt_conv_cflux_dribbled_grc(begg:endg) = spval + this%dwt_conv_cflux_grc(begg:endg) = spval n = 0 @@ -1122,8 +1123,6 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co this%prev_leafc_to_litter_patch (np) = cnpft(nc,nz,nv, 42) this%tempsum_npp_patch (np) = cnpft(nc,nz,nv, 45) this%xsmrpool_recover_patch (np) = cnpft(nc,nz,nv, 47) - this%dwt_wood_productc_gain_patch(np) = 0. ! following CNCLM45 setting - this%dwt_crop_productc_gain_patch(np) = 0. ! following CNCLM45 setting ! "new" variables: introduced in CNCLM50 @@ -1137,12 +1136,16 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co _ASSERT(.FALSE.,'missing CNCLM50_cold_start setting') end if - this%excess_cflux_patch(np) = 0._r8 - this%leafc_to_litter_fun_patch(np) = 0._r8 - this%plant_calloc_patch(np) = 0._r8 - end if end do !nv + + this%excess_cflux_patch(np) = 0._r8 + this%leafc_to_litter_fun_patch(np) = 0._r8 + this%plant_calloc_patch(np) = 0._r8 + this%dwt_wood_productc_gain_patch(np) = 0._r8 ! following CNCLM45 setting + this%dwt_crop_productc_gain_patch(np) = 0._r8 ! following CNCLM45 setting + + end do ! p end do ! nz end do ! nc From 06a96c682bc3ea6e1024d8c8675498069c9a7b9a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 17 May 2023 09:11:40 -0400 Subject: [PATCH 476/589] fix initialization of fluxes --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 8 ++++---- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 2 ++ 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index b40c7cd58..550689f34 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1090,8 +1090,8 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co ! initialize variables from restart file or set to cold start value - this%dwt_conv_cflux_dribbled_grc(begg:endg) = spval - this%dwt_conv_cflux_grc(begg:endg) = spval + this%dwt_conv_cflux_dribbled_grc(begg:endg) = 0._r8 + this%dwt_conv_cflux_grc(begg:endg) = 0._r8 n = 0 @@ -1130,8 +1130,8 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co this%annsum_litfall_patch(np) = cnpft(nc,nz,nv, 82) this%tempsum_litfall_patch(np) = cnpft(nc,nz,nv, 83) elseif (cold_start) then - this%annsum_litfall_patch(np) = spval - this%tempsum_litfall_patch(np) = spval + this%annsum_litfall_patch(np) = 0._r8 + this%tempsum_litfall_patch(np) = 0._r8 else _ASSERT(.FALSE.,'missing CNCLM50_cold_start setting') end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index e017ea2aa..939e4e3f4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -302,6 +302,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m c14_soilbiogeochem_carbonstate_inst, & soilbiogeochem_nitrogenstate_inst) + call bgc_vegetation_inst%InitEachTimeStep(bounds, filter(1)%num_soilc, filter(1)%soilc) + ! Ecosystem Dynamics calculations ! jkolassa: This call contains most of the CLM ecosystem dynamics ! calculations, including soil biogeochemistry, carbon/nitrogen state and From 2b3b4795cc70612f49e8029947caf565bec5a231 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 17 May 2023 09:46:17 -0400 Subject: [PATCH 477/589] add CN balance type initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 864f565f4..4d7ca6639 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -58,6 +58,7 @@ module CN_initMod use initSubgridMod use CN2CLMType use WaterType , only : water_type + use CNBalanceCheckMod use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn @@ -298,6 +299,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call frictionvel_inst%Init (bounds) + call cn_balance_inst%Init (bounds) + ! calls to original CTSM initialization routines ! initialize rooting profile with default values From fd7c8aac745ad1efb0c7b1310315a03c8942eafb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 17 May 2023 10:09:20 -0400 Subject: [PATCH 478/589] update balance type save --- .../GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 index 81831df6b..cbd132b38 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 @@ -49,6 +49,7 @@ module CNBalanceCheckMod procedure , public :: CBalanceCheck procedure , public :: NBalanceCheck end type cn_balance_type + type(cn_balance_type), public, target, save :: cn_balance_inst ! character(len=*), parameter, private :: sourcefile = & From 6b8ffb041bba0d7af579fc36b3c91218ee2310e7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 17 May 2023 11:01:38 -0400 Subject: [PATCH 479/589] adjusting order of initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 939e4e3f4..aef94014e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -284,6 +284,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m call active_layer_inst%alt_calc(filter(1)%num_soilc, filter(1)%soilc, & temperature_inst) + call bgc_vegetation_inst%InitEachTimeStep(bounds, filter(1)%num_soilc, filter(1)%soilc) + call bgc_vegetation_inst%InitGridcellBalance(bounds, & filter(1)%num_allc, filter(1)%allc, & filter(1)%num_soilc, filter(1)%soilc, & @@ -302,8 +304,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m c14_soilbiogeochem_carbonstate_inst, & soilbiogeochem_nitrogenstate_inst) - call bgc_vegetation_inst%InitEachTimeStep(bounds, filter(1)%num_soilc, filter(1)%soilc) - ! Ecosystem Dynamics calculations ! jkolassa: This call contains most of the CLM ecosystem dynamics ! calculations, including soil biogeochemistry, carbon/nitrogen state and From d20b4ced83fc76f3421276050a597aa06a5de34b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 17 May 2023 20:41:46 -0400 Subject: [PATCH 480/589] fix initializations --- .../CLM51/CNCLM_CNProductsMod.F90 | 8 +++++--- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 | 1 + 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index f4f89260a..c0dc96f89 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -128,9 +128,11 @@ subroutine Init(this, bounds, nch, cncol, species, rc) allocate(this%tot_woodprod_loss_grc(begg:endg)) ; this%tot_woodprod_loss_grc(:) = nan allocate(this%product_loss_grc(begg:endg)) ; this%product_loss_grc(:) = nan - this%dwt_cropprod1_gain_grc(begg:endg) = spval - this%dwt_prod10_gain_grc(begg:endg) = spval - this%dwt_prod100_gain_grc(begg:endg) = spval + this%dwt_cropprod1_gain_grc(begg:endg) = 0._r8 + this%dwt_prod10_gain_grc(begg:endg) = 0._r8 + this%dwt_prod100_gain_grc(begg:endg) = 0._r8 + this%grain_to_cropprod1_grc(begg:endg) = 0._r8 + this%grain_to_cropprod1_patch(begp:endp) = 0._r8 ! initialize variables from restart file or set to cold start value diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 index 2d8c7087c..b403f34b6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_ColumnType.F90 @@ -162,6 +162,7 @@ subroutine Init(this, bounds,nch) do nc = 1,nch ! catchment tile loop do nz = 1,num_zon ! CN zone loop n = n + 1 + this%active(n) = .true. this%gridcell(n) = nc this%wtgcell(n) = CN_zone_weight(nz) this%landunit(n) = nc From 14c03c908897a5f700e561c708270041d3dee0b3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 18 May 2023 10:31:40 -0400 Subject: [PATCH 481/589] activate treatment of patches --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index da75b80e9..42ce16fba 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -131,6 +131,7 @@ subroutine Init(this, bounds, nch, ityp, fveg) do p = 0,numpft ! PFT index loop np = np + 1 do nv = 1,num_veg ! defined veg loop + this%active(np) = .true. this%itype(np) = ityp(nc,nv,nz) this%wtcol(np) = fveg(nc,nv,nz) this%column(np) = n From c768db15c1606d1dbd25900ee928a2ce9cb6b79f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 18 May 2023 13:42:28 -0400 Subject: [PATCH 482/589] compute column-level plant nitrogen demand from patch level demand --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 18 +++++++++++++++--- .../CLM51/CN_init_mod.F90 | 2 +- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index cb0d75f33..f64628063 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -7,7 +7,7 @@ module SoilBiogeochemStateType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan, & nlevsno, nlevgrnd, nlevlak use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi, & - VAR_COL, VAR_PFT, num_zon + VAR_COL, VAR_PFT, num_zon, num_veg, numpft use clm_varctl , only : use_cn use clm_varcon , only : spval use decompMod , only : bounds_type @@ -50,21 +50,24 @@ module SoilBiogeochemStateType contains !--------------------------------------- - subroutine Init(this, bounds, nch, cncol, rc) + subroutine Init(this, bounds, nch, cncol, cnpft, ityp, fveg, rc) ! ! !ARGUMENTS: !INPUT/OUTPUT type(bounds_type), intent(in) :: bounds integer, intent(in) :: nch ! number of tiles + integer, dimension(nch,NUM_VEG,NUM_ZON),intent(in) :: ityp ! PFT index + real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction real, dimension(nch,NUM_ZON,VAR_COL), intent(in) :: cncol ! gkw: column CN restart + real, dimension(nch,NUM_ZON,NUM_VEG,VAR_PFT), intent(in) :: cnpft ! gkw: PFT CN restart class(soilbiogeochem_state_type) :: this integer, optional, intent(out) :: rc ! ! !LOCAL VARIABLES: integer :: begp, endp integer :: begc,endc - integer :: n, nc, nz, np + integer :: n, nc, nz, np, nv, np !----------------------------------- begp = bounds%begp; endp= bounds%endp @@ -102,6 +105,15 @@ subroutine Init(this, bounds, nch, cncol, rc) do np = 1,nlevdecomp_full this%fpi_vr_col(n,np) = cncol(nc,nz, 35) end do + + this%plant_ndemand_col(n) = 0._r8 + do p = 0,numpft ! PFT index loop + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + this%plant_ndemand_col(n) = this%plant_ndemand_col(n) + cnpft(nc,nz,nv, 75) + end if + end do ! nv + end do ! p end do !nz end do ! nc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 4d7ca6639..a23b02287 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -277,7 +277,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call soilbiogeochem_nitrogenstate_inst%Init(bounds, nch, cncol) - call soilbiogeochem_state_inst%Init (bounds, nch, cncol) + call soilbiogeochem_state_inst%Init (bounds, nch, cncol, cnpft, ityp, fveg) call soilbiogeochem_carbonflux_inst%Init (bounds) From 20599e868f9cdb767e2b7324b152e97ceda6299c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 18 May 2023 14:15:09 -0400 Subject: [PATCH 483/589] initialize nitrogen demand to avoid NaN summation in column-level computation --- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index c0bae0f35..3888f2548 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -967,6 +967,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%cost_nretrans_patch (begp:endp)) ; this%cost_nretrans_patch (:) = nan allocate(this%nuptake_npp_fraction_patch (begp:endp)) ; this%nuptake_npp_fraction_patch (:) = nan + this%plant_ndemand_patch(begp:endp) = spval ! initialize variables from restart file or set to cold start value n = 0 From 58b1db35c35d414885b306edaa18c2e569272f28 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 19 May 2023 07:13:01 -0400 Subject: [PATCH 484/589] typo fix --- .../CLM51/CNCLM_SoilBiogeochemStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 index f64628063..2fd2b29bd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemStateType.F90 @@ -67,7 +67,7 @@ subroutine Init(this, bounds, nch, cncol, cnpft, ityp, fveg, rc) ! !LOCAL VARIABLES: integer :: begp, endp integer :: begc,endc - integer :: n, nc, nz, np, nv, np + integer :: n, nc, nz, np, nv, p !----------------------------------- begp = bounds%begp; endp= bounds%endp From 348beeb181f4c8757015e09e599a18bfd3d5d6d6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 19 May 2023 10:04:20 -0400 Subject: [PATCH 485/589] initialize pacth varaibles that go through p2c as spval --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 14 +++++++------- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 9 +++++---- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 8 +++----- .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 4 ++-- .../CLM51/CNCLM_CNVegStateType.F90 | 2 +- .../CLM51/CNCLM_Wateratm2lndBulkType.F90 | 6 +++--- 6 files changed, 21 insertions(+), 22 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 550689f34..5c9c7271c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1011,7 +1011,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co allocate(this%litterc_loss_col (begc:endc)) ; this%litterc_loss_col (:) =nan allocate(this%grainc_to_cropprodc_patch(begp:endp)) - this%grainc_to_cropprodc_patch(:) = nan + this%grainc_to_cropprodc_patch(:) = spval allocate(this%grainc_to_cropprodc_col(begc:endc)) this%grainc_to_cropprodc_col(:) = nan @@ -1028,11 +1028,11 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co allocate(this%m_decomp_cpools_to_fire_col(begc:endc,1:ndecomp_pools)) this%m_decomp_cpools_to_fire_col(:,:)= nan - allocate(this%rr_patch (begp:endp)) ; this%rr_patch (:) = nan + allocate(this%rr_patch (begp:endp)) ; this%rr_patch (:) = spval allocate(this%mr_patch (begp:endp)) ; this%mr_patch (:) = nan allocate(this%gr_patch (begp:endp)) ; this%gr_patch (:) = nan - allocate(this%ar_patch (begp:endp)) ; this%ar_patch (:) = nan - allocate(this%npp_patch (begp:endp)) ; this%npp_patch (:) = nan + allocate(this%ar_patch (begp:endp)) ; this%ar_patch (:) = spval + allocate(this%npp_patch (begp:endp)) ; this%npp_patch (:) = spval allocate(this%agnpp_patch (begp:endp)) ; this%agnpp_patch (:) = nan allocate(this%bgnpp_patch (begp:endp)) ; this%bgnpp_patch (:) = nan allocate(this%litfall_patch (begp:endp)) ; this%litfall_patch (:) = nan @@ -1040,8 +1040,8 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co allocate(this%slash_harvestc_patch (begp:endp)) ; this%slash_harvestc_patch (:) = nan allocate(this%cinputs_patch (begp:endp)) ; this%cinputs_patch (:) = nan allocate(this%coutputs_patch (begp:endp)) ; this%coutputs_patch (:) = nan - allocate(this%gpp_patch (begp:endp)) ; this%gpp_patch (:) = nan - allocate(this%fire_closs_patch (begp:endp)) ; this%fire_closs_patch (:) = nan + allocate(this%gpp_patch (begp:endp)) ; this%gpp_patch (:) = spval + allocate(this%fire_closs_patch (begp:endp)) ; this%fire_closs_patch (:) = spval allocate(this%sr_col (begc:endc)) ; this%sr_col (:) = nan allocate(this%er_col (begc:endc)) ; this%er_col (:) = nan allocate(this%litfire_col (begc:endc)) ; this%litfire_col (:) = nan @@ -1056,7 +1056,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co allocate(this%wood_harvestc_col (begc:endc)) ; this%wood_harvestc_col (:) = nan allocate(this%hrv_xsmrpool_to_atm_col (begc:endc)) ; this%hrv_xsmrpool_to_atm_col (:) = 0.0_r8 allocate(this%tempsum_npp_patch (begp:endp)) ; this%tempsum_npp_patch (:) = nan - allocate(this%annsum_npp_patch (begp:endp)) ; this%annsum_npp_patch (:) = nan + allocate(this%annsum_npp_patch (begp:endp)) ; this%annsum_npp_patch (:) = spval allocate(this%tempsum_litfall_patch (begp:endp)) ; this%tempsum_litfall_patch (:) = nan allocate(this%annsum_litfall_patch (begp:endp)) ; this%annsum_litfall_patch (:) = nan allocate(this%annsum_npp_col (begc:endc)) ; this%annsum_npp_col (:) = nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index e9f043d17..468264d95 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -6,6 +6,7 @@ module CNVegCarbonStateType use clm_varctl , only : iulog, use_cndv, use_crop, use_matrixcn use clm_varpar , only : numpft, num_zon, num_veg, & var_col, var_pft, CN_zone_weight + use clm_varcon , only : spval use nanMod , only : nan use decompMod , only : bounds_type use pftconMod , only : noveg, npcropmin, pftcon @@ -252,7 +253,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) begg = bounds%begg ; endg = bounds%endg begc = bounds%begc ; endc = bounds%endc - allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan + allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = spval allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan allocate(this%leafc_xfer_patch (begp:endp)) ; this%leafc_xfer_patch (:) = nan if(use_matrixcn)then @@ -278,7 +279,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%matrix_cap_livestemc_storage_patch (begp:endp)) ; this%matrix_cap_livestemc_storage_patch (:) = nan allocate(this%matrix_cap_livestemc_xfer_patch (begp:endp)) ; this%matrix_cap_livestemc_xfer_patch (:) = nan end if - allocate(this%deadstemc_patch (begp:endp)) ; this%deadstemc_patch (:) = nan + allocate(this%deadstemc_patch (begp:endp)) ; this%deadstemc_patch (:) = spval allocate(this%deadstemc_storage_patch (begp:endp)) ; this%deadstemc_storage_patch (:) = nan allocate(this%deadstemc_xfer_patch (begp:endp)) ; this%deadstemc_xfer_patch (:) = nan if(use_matrixcn)then @@ -311,7 +312,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%dispvegc_patch (begp:endp)) ; this%dispvegc_patch (:) = nan allocate(this%storvegc_patch (begp:endp)) ; this%storvegc_patch (:) = nan allocate(this%leafcmax_patch (begp:endp)) ; this%leafcmax_patch (:) = nan - allocate(this%totc_patch (begp:endp)) ; this%totc_patch (:) = nan + allocate(this%totc_patch (begp:endp)) ; this%totc_patch (:) = spval allocate(this%grainc_patch (begp:endp)) ; this%grainc_patch (:) = nan allocate(this%grainc_storage_patch (begp:endp)) ; this%grainc_storage_patch (:) = nan allocate(this%grainc_xfer_patch (begp:endp)) ; this%grainc_xfer_patch (:) = nan @@ -445,7 +446,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%fuelc_col (begc:endc)) ; this%fuelc_col (:) = nan allocate(this%fuelc_crop_col (begc:endc)) ; this%fuelc_crop_col (:) = nan - allocate(this%totvegc_patch (begp:endp)) ; this%totvegc_patch (:) = nan + allocate(this%totvegc_patch (begp:endp)) ; this%totvegc_patch (:) = spval allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan allocate(this%totc_p2c_col (begc:endc)) ; this%totc_p2c_col (:) = nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index 3888f2548..fabf3ace8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -855,7 +855,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%livecrootn_to_retransn_patch (begp:endp)) ; this%livecrootn_to_retransn_patch (:) = nan allocate(this%ndeploy_patch (begp:endp)) ; this%ndeploy_patch (:) = nan allocate(this%wood_harvestn_patch (begp:endp)) ; this%wood_harvestn_patch (:) = nan - allocate(this%fire_nloss_patch (begp:endp)) ; this%fire_nloss_patch (:) = nan + allocate(this%fire_nloss_patch (begp:endp)) ; this%fire_nloss_patch (:) = spval allocate(this%npool_to_grainn_patch (begp:endp)) ; this%npool_to_grainn_patch (:) = nan allocate(this%npool_to_grainn_storage_patch (begp:endp)) ; this%npool_to_grainn_storage_patch (:) = nan allocate(this%livestemn_to_litter_patch (begp:endp)) ; this%livestemn_to_litter_patch (:) = nan @@ -869,7 +869,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%fert_counter_patch (begp:endp)) ; this%fert_counter_patch (:) = nan allocate(this%soyfixn_patch (begp:endp)) ; this%soyfixn_patch (:) = nan - allocate(this%grainn_to_cropprodn_patch (begp:endp)) ; this%grainn_to_cropprodn_patch (:) = nan + allocate(this%grainn_to_cropprodn_patch (begp:endp)) ; this%grainn_to_cropprodn_patch (:) = spval allocate(this%grainn_to_cropprodn_col (begc:endc)) ; this%grainn_to_cropprodn_col (:) = nan allocate(this%fire_nloss_col (begc:endc)) ; this%fire_nloss_col (:) = nan @@ -929,7 +929,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) this%harvest_n_to_litr_lig_n_col (:,:) = nan this%harvest_n_to_cwdn_col (:,:) = nan - allocate(this%plant_ndemand_patch (begp:endp)) ; this%plant_ndemand_patch (:) = nan + allocate(this%plant_ndemand_patch (begp:endp)) ; this%plant_ndemand_patch (:) = spval allocate(this%avail_retransn_patch (begp:endp)) ; this%avail_retransn_patch (:) = nan allocate(this%plant_nalloc_patch (begp:endp)) ; this%plant_nalloc_patch (:) = nan @@ -967,8 +967,6 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%cost_nretrans_patch (begp:endp)) ; this%cost_nretrans_patch (:) = nan allocate(this%nuptake_npp_fraction_patch (begp:endp)) ; this%nuptake_npp_fraction_patch (:) = nan - this%plant_ndemand_patch(begp:endp) = spval - ! initialize variables from restart file or set to cold start value n = 0 np = 0 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index fb2626c8a..4dca61155 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -302,8 +302,8 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%ntrunc_patch (begp:endp)) ; this%ntrunc_patch (:) = nan allocate(this%dispvegn_patch (begp:endp)) ; this%dispvegn_patch (:) = nan allocate(this%storvegn_patch (begp:endp)) ; this%storvegn_patch (:) = nan - allocate(this%totvegn_patch (begp:endp)) ; this%totvegn_patch (:) = nan - allocate(this%totn_patch (begp:endp)) ; this%totn_patch (:) = nan + allocate(this%totvegn_patch (begp:endp)) ; this%totvegn_patch (:) = spval + allocate(this%totn_patch (begp:endp)) ; this%totn_patch (:) = spval allocate(this%cropseedn_deficit_patch (begp:endp)) ; this%cropseedn_deficit_patch (:) = nan allocate(this%seedn_grc (begg:endg)) ; this%seedn_grc (:) = nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 index 38c477e69..3d7135a4f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegStateType.F90 @@ -165,7 +165,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%tempavg_t2m_patch (begp:endp)) ; this%tempavg_t2m_patch (:) = nan allocate(this%annsum_counter_col (begc:endc)) ; this%annsum_counter_col (:) = nan allocate(this%annavg_t2m_col (begc:endc)) ; this%annavg_t2m_col (:) = nan - allocate(this%annavg_t2m_patch (begp:endp)) ; this%annavg_t2m_patch (:) = nan + allocate(this%annavg_t2m_patch (begp:endp)) ; this%annavg_t2m_patch (:) = spval allocate(this%nfire_col (begc:endc)) ; this%nfire_col (:) = spval allocate(this%fsr_col (begc:endc)) ; this%fsr_col (:) = nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 index b89d2269e..8f92193b0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_Wateratm2lndBulkType.F90 @@ -76,9 +76,9 @@ subroutine InitBulk(this, bounds) allocate(this%volrmch_grc (begg:endg)) ; this%volrmch_grc (:) = ival allocate(this%forc_rh_grc (begg:endg)) ; this%forc_rh_grc (:) = ival allocate(this%prec365_col (begc:endc)) ; this%prec365_col (:) = nan - allocate(this%prec60_patch (begp:endp)) ; this%prec60_patch(:) = nan - allocate(this%prec10_patch (begp:endp)) ; this%prec10_patch(:) = nan - allocate(this%rh30_patch (begp:endp)) ; this%rh30_patch (:) = nan + allocate(this%prec60_patch (begp:endp)) ; this%prec60_patch(:) = spval + allocate(this%prec10_patch (begp:endp)) ; this%prec10_patch(:) = spval + allocate(this%rh30_patch (begp:endp)) ; this%rh30_patch (:) = spval if (use_fates) then allocate(this%prec24_patch (begp:endp)) ; this%prec24_patch(:) = nan allocate(this%rh24_patch (begp:endp)) ; this%rh24_patch (:) = nan From 582abd243774b4d0e9086fe1df7cb0fbd82888a8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 19 May 2023 10:19:32 -0400 Subject: [PATCH 486/589] initialize pacth varaibles that go through p2c as spval --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 4 ++-- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 2 +- .../CLM51/CNCLM_CNVegNitrogenStateType.F90 | 2 +- .../CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 5c9c7271c..a2824716d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1052,7 +1052,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co allocate(this%gpp_col (begc:endc)) ; this%gpp_col (:) = nan allocate(this%npp_col (begc:endc)) ; this%npp_col (:) = nan allocate(this%fire_closs_p2c_col (begc:endc)) ; this%fire_closs_p2c_col (:) = nan - allocate(this%fire_closs_col (begc:endc)) ; this%fire_closs_col (:) = nan + allocate(this%fire_closs_col (begc:endc)) ; this%fire_closs_col (:) = spval allocate(this%wood_harvestc_col (begc:endc)) ; this%wood_harvestc_col (:) = nan allocate(this%hrv_xsmrpool_to_atm_col (begc:endc)) ; this%hrv_xsmrpool_to_atm_col (:) = 0.0_r8 allocate(this%tempsum_npp_patch (begp:endp)) ; this%tempsum_npp_patch (:) = nan @@ -1063,7 +1063,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co allocate(this%lag_npp_col (begc:endc)) ; this%lag_npp_col (:) = spval - allocate(this%nep_col (begc:endc)) ; this%nep_col (:) = nan + allocate(this%nep_col (begc:endc)) ; this%nep_col (:) = spval allocate(this%nbp_grc (begg:endg)) ; this%nbp_grc (:) = nan allocate(this%nee_grc (begg:endg)) ; this%nee_grc (:) = nan allocate(this%landuseflux_grc (begg:endg)) ; this%landuseflux_grc (:) = nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 468264d95..3305328e5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -450,7 +450,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan allocate(this%totc_p2c_col (begc:endc)) ; this%totc_p2c_col (:) = nan - allocate(this%totc_col (begc:endc)) ; this%totc_col (:) = nan + allocate(this%totc_col (begc:endc)) ; this%totc_col (:) = spval allocate(this%totecosysc_col (begc:endc)) ; this%totecosysc_col (:) = nan allocate(this%totc_grc (begg:endg)) ; this%totc_grc (:) = nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 index 4dca61155..c22587391 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenStateType.F90 @@ -309,7 +309,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) allocate(this%seedn_grc (begg:endg)) ; this%seedn_grc (:) = nan allocate(this%totvegn_col (begc:endc)) ; this%totvegn_col (:) = nan allocate(this%totn_p2c_col (begc:endc)) ; this%totn_p2c_col (:) = nan - allocate(this%totn_col (begc:endc)) ; this%totn_col (:) = nan + allocate(this%totn_col (begc:endc)) ; this%totn_col (:) = spval allocate(this%totecosysn_col (begc:endc)) ; this%totecosysn_col (:) = nan allocate(this%totn_grc (begg:endg)) ; this%totn_grc (:) = nan diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index 32f2d0db2..1e52ec427 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -103,7 +103,7 @@ subroutine Init(this, bounds) allocate(this%o_scalar_col (begc:endc,1:nlevdecomp_full)); this%o_scalar_col (:,:) =spval allocate(this%phr_vr_col (begc:endc,1:nlevdecomp_full)); this%phr_vr_col (:,:) =nan allocate(this%fphr_col (begc:endc,1:nlevgrnd)) ; this%fphr_col (:,:) =nan - allocate(this%som_c_leached_col (begc:endc)) ; this%som_c_leached_col (:) =nan + allocate(this%som_c_leached_col (begc:endc)) ; this%som_c_leached_col (:) =spval allocate(this%somc_fire_col (begc:endc)) ; this%somc_fire_col (:) =nan allocate(this%hr_vr_col (begc:endc,1:nlevdecomp_full)); this%hr_vr_col (:,:) =nan From 98970e49bde6c43f6df9ee3bb45e8781a579c3bf Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 19 May 2023 15:25:01 -0400 Subject: [PATCH 487/589] initialize data to spval that is passed to p2g --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 index c0dc96f89..61fb40c82 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNProductsMod.F90 @@ -113,10 +113,10 @@ subroutine Init(this, bounds, nch, cncol, species, rc) allocate(this%dwt_cropprod1_gain_grc(begg:endg)) ; this%dwt_cropprod1_gain_grc(:) = nan - allocate(this%hrv_deadstem_to_prod10_patch(begp:endp)) ; this%hrv_deadstem_to_prod10_patch(:) = nan + allocate(this%hrv_deadstem_to_prod10_patch(begp:endp)) ; this%hrv_deadstem_to_prod10_patch(:) = spval allocate(this%hrv_deadstem_to_prod10_grc(begg:endg)) ; this%hrv_deadstem_to_prod10_grc(:) = nan - allocate(this%hrv_deadstem_to_prod100_patch(begp:endp)) ; this%hrv_deadstem_to_prod100_patch(:) = nan + allocate(this%hrv_deadstem_to_prod100_patch(begp:endp)) ; this%hrv_deadstem_to_prod100_patch(:) = spval allocate(this%hrv_deadstem_to_prod100_grc(begg:endg)) ; this%hrv_deadstem_to_prod100_grc(:) = nan allocate(this%grain_to_cropprod1_patch(begp:endp)) ; this%grain_to_cropprod1_patch(:) = nan @@ -132,7 +132,7 @@ subroutine Init(this, bounds, nch, cncol, species, rc) this%dwt_prod10_gain_grc(begg:endg) = 0._r8 this%dwt_prod100_gain_grc(begg:endg) = 0._r8 this%grain_to_cropprod1_grc(begg:endg) = 0._r8 - this%grain_to_cropprod1_patch(begp:endp) = 0._r8 + ! initialize variables from restart file or set to cold start value From 8fd029e7994c89d558e461289c7a3dbd4b786431 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 1 Jun 2023 09:13:35 -0400 Subject: [PATCH 488/589] fix initialization of weights at patch level --- .../CLM51/CNCLM_PatchType.F90 | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 42ce16fba..0acf90ffa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -129,16 +129,20 @@ subroutine Init(this, bounds, nch, ityp, fveg) do nz = 1,num_zon ! CN zone loop n = n + 1 do p = 0,numpft ! PFT index loop - np = np + 1 + this%itype(np) = p do nv = 1,num_veg ! defined veg loop - this%active(np) = .true. - this%itype(np) = ityp(nc,nv,nz) - this%wtcol(np) = fveg(nc,nv,nz) - this%column(np) = n + this%wtcol(np) = 0. + this%column(np) = n this%gridcell(np) = nc - this%wtgcell(np) = fveg(nc,nv,nz)*CN_zone_weight(nz) + this%wtgcell(np) = 0. this%landunit(np) = nc - this%wtlunit(np) = fveg(nc,nv,nz)*CN_zone_weight(nz) + this%wtlunit(np) = 0. + if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + this%active(np) = .true. + this%wtcol(np) = fveg(nc,nv,nz) + this%wtgcell(np) = fveg(nc,nv,nz)*CN_zone_weight(nz) + this%wtlunit(np) = fveg(nc,nv,nz)*CN_zone_weight(nz) + end if end do ! nv end do ! p end do ! nz From 35c1e4eebc4931b2a491030eef7c3307639ea6c4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 1 Jun 2023 10:00:22 -0400 Subject: [PATCH 489/589] add accidentally deleted line back --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index 0acf90ffa..d5a1e5b22 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -129,6 +129,7 @@ subroutine Init(this, bounds, nch, ityp, fveg) do nz = 1,num_zon ! CN zone loop n = n + 1 do p = 0,numpft ! PFT index loop + np = np + 1 this%itype(np) = p do nv = 1,num_veg ! defined veg loop this%wtcol(np) = 0. From f32eb3f48307266b4cbd0ef66524a3c3c524560f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 2 Jun 2023 13:58:05 -0400 Subject: [PATCH 490/589] add initialization for radiation time --- .../CLM51/CN_init_mod.F90 | 6 ++- .../CLM51/clm_time_manager.F90 | 40 +++++++++++++++++-- 2 files changed, 42 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index a23b02287..d4d69a6ed 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -7,7 +7,7 @@ module CN_initMod use clm_varcon , only : clm_varcon_init use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init use clm_varctl , only : use_century_decomp, init_clm_varctl - use clm_time_manager , only : get_step_size + use clm_time_manager , only : get_step_size, update_rad_dtime use decompMod use filterMod use CNVegNitrogenStateType @@ -362,6 +362,10 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call cn2clm_inst%Init (bounds) + ! initialize radiation time + + call update_rad_dtime(.true.) + end subroutine CN_init end module CN_initMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index b9e5813cc..f898caf0f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -44,10 +44,14 @@ module clm_time_manager is_restart, &! return true if this is a restart run is_first_step, & ! dummy function here, because it is loaded, but not used is_near_local_noon ! return true if near local noon + update_rad_dtime, &! track radiation interval via nstep integer, parameter :: uninit_int = -999999999 integer, save ::& dtime = uninit_int ! timestep in seconds + dtime_rad = uninit_int, &! radiation interval in seconds + nstep_rad_prev = uninit_int ! radiation interval in seconds + contains !========================================================================================= @@ -99,13 +103,43 @@ integer function get_nstep(istep) end function get_nstep !========================================================================================= + subroutine update_rad_dtime(doalb) + !--------------------------------------------------------------------------------- + ! called only on doalb timesteps to save off radiation nsteps + ! + ! Local Arguments + logical,intent(in) :: doalb + integer :: dtime,nstep + + if (doalb) then + + dtime=get_step_size() + nstep = get_nstep() + + if (nstep_rad_prev == uninit_int ) then + dtime_rad = dtime + nstep_rad_prev = nstep + else + dtime_rad = (nstep - nstep_rad_prev) * dtime + nstep_rad_prev = nstep + endif + end if + end subroutine update_rad_dtime + + !========================================================================================= integer function get_rad_step_size() - ! Return the step size in seconds. + character(len=*), parameter :: sub = 'clm::get_rad_step_size' + +! if ( .not. check_timemgr_initialized(sub) ) return + + if (nstep_rad_prev == uninit_int ) then + get_rad_step_size=get_step_size() + else + get_rad_step_size=dtime_rad + end if - get_rad_step_size = -999999999 ! gkw: to make sure this is not used - end function get_rad_step_size !========================================================================================= From 3cceabd6ae979fa457edc031611dc759e5d5a30f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 2 Jun 2023 14:12:55 -0400 Subject: [PATCH 491/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index f898caf0f..4a21063b0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -48,7 +48,7 @@ module clm_time_manager integer, parameter :: uninit_int = -999999999 integer, save ::& - dtime = uninit_int ! timestep in seconds + dtime = uninit_int, &! timestep in seconds dtime_rad = uninit_int, &! radiation interval in seconds nstep_rad_prev = uninit_int ! radiation interval in seconds From 3149a358dcf4180563d99b44f19640fdb52de59a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 2 Jun 2023 14:24:59 -0400 Subject: [PATCH 492/589] fixing variable declaration to account for compiler difference --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 4a21063b0..c5ab10fd9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -48,9 +48,9 @@ module clm_time_manager integer, parameter :: uninit_int = -999999999 integer, save ::& - dtime = uninit_int, &! timestep in seconds - dtime_rad = uninit_int, &! radiation interval in seconds - nstep_rad_prev = uninit_int ! radiation interval in seconds + dtime = -999999999, &! timestep in seconds + dtime_rad = -999999999, &! radiation interval in seconds + nstep_rad_prev = -999999999 ! radiation interval in seconds contains From 82a6d3daa9f26b9aaf350c0a0b622a3230dbc349 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 2 Jun 2023 14:34:01 -0400 Subject: [PATCH 493/589] typo fix --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index c5ab10fd9..233c480fc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -42,9 +42,9 @@ module clm_time_manager is_end_curr_day, &! return true on last timestep in current day is_beg_curr_year, &! return true on first timestep in current year is_restart, &! return true if this is a restart run - is_first_step, & ! dummy function here, because it is loaded, but not used - is_near_local_noon ! return true if near local noon - update_rad_dtime, &! track radiation interval via nstep + is_first_step, &! dummy function here, because it is loaded, but not used + is_near_local_noon, &! return true if near local noon + update_rad_dtime ! track radiation interval via nstep integer, parameter :: uninit_int = -999999999 integer, save ::& From 665f4579772bdc51aa5fcf873919803dbc703ce8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Jun 2023 08:10:05 -0400 Subject: [PATCH 494/589] correct weight calculation --- .../CLM51/CNCLM_PatchType.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 index d5a1e5b22..3d509ca30 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_PatchType.F90 @@ -131,18 +131,18 @@ subroutine Init(this, bounds, nch, ityp, fveg) do p = 0,numpft ! PFT index loop np = np + 1 this%itype(np) = p + this%wtcol(np) = 0. + this%column(np) = n + this%gridcell(np) = nc + this%wtgcell(np) = 0. + this%landunit(np) = nc + this%wtlunit(np) = 0. do nv = 1,num_veg ! defined veg loop - this%wtcol(np) = 0. - this%column(np) = n - this%gridcell(np) = nc - this%wtgcell(np) = 0. - this%landunit(np) = nc - this%wtlunit(np) = 0. if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then this%active(np) = .true. - this%wtcol(np) = fveg(nc,nv,nz) - this%wtgcell(np) = fveg(nc,nv,nz)*CN_zone_weight(nz) - this%wtlunit(np) = fveg(nc,nv,nz)*CN_zone_weight(nz) + this%wtcol(np) = this%wtcol(np) + fveg(nc,nv,nz) + this%wtgcell(np) = this%wtgcell(np) + (fveg(nc,nv,nz)*CN_zone_weight(nz)) + this%wtlunit(np) = this%wtlunit(np) + (fveg(nc,nv,nz)*CN_zone_weight(nz)) end if end do ! nv end do ! p From 4a38f0814cad391f618731259a0efb22e1e9be6e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 6 Jun 2023 11:38:50 -0400 Subject: [PATCH 495/589] pass first flag as an input argument to CN_Driver --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 6 +++--- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index aef94014e..e110b6ad5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -64,7 +64,7 @@ module CNCLM_DriverMod subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& - fsnow,tg10d,t2m5d,sndzn5d,water_inst, & + fsnow,tg10d,t2m5d,sndzn5d,water_inst,first, & zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& @@ -112,6 +112,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: t2m5d ! 5-day running mean of daily minimum 2m temperature [K] real, dimension(nch), intent(in) :: sndzn5d ! 5-day running mean of total snow depth type(water_type), intent(in) :: water_inst + logical, intent(in) :: first ! OUTPUT @@ -206,7 +207,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions - logical, save :: first = .true. integer :: n, p, nc, nz, np, nv !------------------------------- @@ -356,7 +356,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m soilbiogeochem_carbonflux_inst, & soilbiogeochem_nitrogenflux_inst, atm2lnd_inst ) else - first = .false. + !first = .false. end if grc%prev_dayl = grc%dayl ! set previous day length for following time steps (dayl itself is computed in GridComp) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 09c68e8b8..5e7a2af42 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -6947,7 +6947,7 @@ subroutine Driver ( RC ) call CN_Driver(ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& - asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, & + asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, first_cn, & elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& fire_nloss,leafn,leafc,gross_nmin,net_nmin,& From 92d15b555069acfd12716af54dcf8cc064ccacbe Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 15 Jun 2023 15:15:27 -0400 Subject: [PATCH 496/589] code changes to account for fewer PFTs per tile in CatchCN5.1 --- .../CLM51/clm_varpar.F90 | 2 +- .../Shared/clm_varpar_shared.F90 | 3 +- .../GEOSsurface_GridComp/Shared/getids.F90 | 80 ++++-- .../Utils/mk_restarts/CatchmentCNRst.F90 | 269 +++++++++++++----- 4 files changed, 259 insertions(+), 95 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index 9b8c2e3b3..cc977f185 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -12,7 +12,7 @@ module clm_varpar ! use clm_varpar_shared, only : VAR_COL =>VAR_COL_51, VAR_PFT => VAR_PFT_51, & numpft => numpft_CN51, NUM_ZON => NUM_ZON_CN, & - NUM_VEG => NUM_VEG_CN + NUM_VEG => NUM_VEG_CN51 ! !PUBLIC TYPES: implicit none diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 index 30b2ed4a1..c9e4e82b2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 @@ -20,7 +20,8 @@ module clm_varpar_shared integer, parameter :: numpft_CN51 = 15 ! actual # of pfts (without bare) for Catchment-CN5.1 integer, parameter, PUBLIC :: NUM_ZON_CN=3 ! number of CN hydrology zones per tile - integer, parameter, PUBLIC :: NUM_VEG_CN=4 ! number of CN PFTs per zone + integer, parameter, PUBLIC :: NUM_VEG_CN=4 ! number of CN PFTs per zone for Catchment-CN4.0 and Catchment-CN4.5 + integer, parameter, PUBLIC :: NUM_VEG_CN51 = 2 ! number of CN PFTs per zone for Catchment-CN5.1 integer, parameter, PUBLIC :: VAR_COL_40=40 ! number of CN column restart variables integer, parameter, PUBLIC :: VAR_PFT_40=74 ! number of CN PFT variables per column integer, parameter, PUBLIC :: VAR_COL_45=35 ! number of CN column restart variables diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 index 8ba3ede1b..0dfbb363d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 @@ -331,18 +331,21 @@ subroutine GetIds_accurate_mpi (loni,lati,lono,lato,Id, tid_in) deallocate (mask) end subroutine GetIds_accurate_mpi - + ! ***************************************************************************** subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & - fveg_offl, ityp_offl) - + fveg_offl, ityp_offl,isCLM51) + + use clm_varpar_shared , only : nveg_40 => NUM_VEG_CN, nveg_51 => NUM_VEG_CN51, & + npft => numpft_CN, npft_51 => numpft_CN51 implicit none - integer, parameter :: npft = 19 - integer, parameter :: nveg = 4 + integer :: nveg real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value - integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) + integer :: iclass_40_45(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) + integer :: iclass_51(npft_51) = (/1,1,2,3,3,4,5,5,6,7,9,10,11,11,11/) + integer, dimension(:), allocatable :: iclass integer :: NT_IN, NT_OUT, n, i, nplus,nv, nx, ityp_new integer, dimension (:), intent (in) :: tid_in integer, dimension (:,:), intent (inout) :: id @@ -350,6 +353,7 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & real, dimension (:), intent (in) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2 real, dimension(:,:), intent (in) :: fveg_offl, ityp_offl + logical, intent(in) :: isCLM51 logical :: tile_found logical, allocatable, dimension (:) :: mask integer, allocatable, dimension (:) :: sub_tid @@ -359,6 +363,16 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & NT_IN = SIZE (loni) NT_OUT = SIZE (lono) + + if (isCLM51) then + allocate(iclass(1:npft_51)) + iclass = iclass_51 + nveg = nveg_51 + elseif (.not.isCLM51) then + allocate(iclass(1:npft)) + iclass = iclass_40_45 + nveg = nveg_40 + end if allocate (mask (1: NT_IN)) @@ -410,23 +424,40 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & NV_LOOP: do nv = 1, nveg - if (nv == 1) ityp_new = CLMC_pt1(n) - if (nv == 1) fveg_new = CLMC_pf1(n) - if (nv == 2) ityp_new = CLMC_pt2(n) - if (nv == 2) fveg_new = CLMC_pf2(n) - if (nv == 3) ityp_new = CLMC_st1(n) - if (nv == 3) fveg_new = CLMC_sf1(n) - if (nv == 4) ityp_new = CLMC_st2(n) - if (nv == 4) fveg_new = CLMC_sf2(n) + if (isCLM51) then + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_st1(n) + if (nv == 2) fveg_new = CLMC_sf1(n) + + SEEK : if((Id (n, nv) < 0).and.(fveg_new > fmin)) then + + if(nv <= 1) then ! index for secondary PFT index if primary or primary if secondary + nx = nv + 1 + else + nx = nv - 1 + endif + + elseif (.not.isCLM51) then + + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_pt2(n) + if (nv == 2) fveg_new = CLMC_pf2(n) + if (nv == 3) ityp_new = CLMC_st1(n) + if (nv == 3) fveg_new = CLMC_sf1(n) + if (nv == 4) ityp_new = CLMC_st2(n) + if (nv == 4) fveg_new = CLMC_sf2(n) - SEEK : if((Id (n, nv) < 0).and.(fveg_new > fmin)) then + SEEK : if((Id (n, nv) < 0).and.(fveg_new > fmin)) then if(nv <= 2) then ! index for secondary PFT index if primary or primary if secondary nx = nv + 2 else nx = nv - 2 endif - + end if + sub_ityp1 = ityp_offl (sub_tid,nv) sub_fevg1 = fveg_offl (sub_tid,nv) sub_ityp2 = ityp_offl (sub_tid,nx) @@ -436,7 +467,7 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & icl_ityp1 = iclass(sub_ityp1) do i = 1,nplus - if((sub_ityp1(i)>fmin .and. (ityp_new ==sub_ityp1(i) .or. & + if((sub_fevg1(i)>fmin .and. (ityp_new ==sub_ityp1(i) .or. & iclass(ityp_new) ==iclass(sub_ityp1(i)))) .or. & (sub_fevg2(i)>fmin .and. (ityp_new ==sub_ityp2(i) .or. & iclass(ityp_new)==iclass(sub_ityp2(i))))) then @@ -472,11 +503,16 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & deallocate (sub_ityp1, sub_fevg1, sub_ityp2, sub_fevg2, rev_dist) tile_found = .true. - if((tile_found).and.((CLMC_pf1(n) > fmin).and.(Id(n,1) < 0))) tile_found = .false. - if((tile_found).and.((CLMC_pf2(n) > fmin).and.(Id(n,2) < 0))) tile_found = .false. - if((tile_found).and.((CLMC_sf1(n) > fmin).and.(Id(n,3) < 0))) tile_found = .false. - if((tile_found).and.((CLMC_sf2(n) > fmin).and.(Id(n,4) < 0))) tile_found = .false. - + if (isCLM51) then + if((tile_found).and.((CLMC_pf1(n) > fmin).and.(Id(n,1) < 0))) tile_found = .false. + if((tile_found).and.((CLMC_sf1(n) > fmin).and.(Id(n,2) < 0))) tile_found = .false. + elseif (.not.isCLM51) then + if((tile_found).and.((CLMC_pf1(n) > fmin).and.(Id(n,1) < 0))) tile_found = .false. + if((tile_found).and.((CLMC_pf2(n) > fmin).and.(Id(n,2) < 0))) tile_found = .false. + if((tile_found).and.((CLMC_sf1(n) > fmin).and.(Id(n,3) < 0))) tile_found = .false. + if((tile_found).and.((CLMC_sf2(n) > fmin).and.(Id(n,4) < 0))) tile_found = .false. + end if + if(tile_found) GO TO 100 ! if not increase the window size diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index f0d7d2c84..6699acf52 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -7,7 +7,7 @@ module CatchmentCNRstMod use ESMF use MAPL use CatchmentRstMod, only : CatchmentRst - use clm_varpar_shared , only : nzone => NUM_ZON_CN, nveg => NUM_VEG_CN, & + use clm_varpar_shared , only : nzone => NUM_ZON_CN, nveg_40 => NUM_VEG_CN, nveg_51 => NUM_VEG_CN51, & VAR_COL_40, VAR_PFT_40, VAR_COL_45, VAR_PFT_45, & VAR_COL_51, VAR_PFT_51, & npft => numpft_CN, npft_51 => numpft_CN51 @@ -28,6 +28,7 @@ module CatchmentCNRstMod integer :: VAR_COL integer :: VAR_PFT + integer :: NVEG real, allocatable :: cnity(:,:) real, allocatable :: fvg(:,:) real, allocatable :: tg(:,:) @@ -122,16 +123,19 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) catch%isCLM40 = .true. catch%VAR_COL = VAR_COL_40 catch%VAR_PFT = VAR_PFT_40 + catch%NVEG = nveg_40 endif if (index(cnclm, '45') /=0) then catch%isCLM45 = .true. catch%VAR_COL = VAR_COL_45 catch%VAR_PFT = VAR_PFT_45 + catch%nveg = nveg_40 endif if (index(cnclm, '51') /=0) then catch%VAR_COL = VAR_COL_51 catch%VAR_PFT = VAR_PFT_51 catch%isCLM51 = .true. + catch%nveg = nveg_51 endif if (myid == 0) then @@ -376,7 +380,9 @@ subroutine allocate_cn(this,rc) integer, optional, intent(out):: rc integer :: status integer :: ncol,npft, ntiles - + + + nveg = this%NVEG ntiles = this%ntiles ncol = nzone* this%VAR_COL npft = nzone*nveg*this%VAR_PFT @@ -454,16 +460,19 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) real, allocatable :: CLMC_pt1(:), CLMC_pt2(:), CLMC_st1(:), CLMC_st2(:) real, allocatable :: NDEP(:), BVISDR(:), BVISDF(:), BNIRDR(:), BNIRDF(:) real, allocatable :: T2(:), hdm(:), fc(:), gdp(:), peatf(:) - integer, allocatable :: ity(:), abm (:) +gg integer, allocatable :: ity(:), abm (:) integer :: STATUS, ntiles, unit27, unit28, unit29, unit30 integer :: idum, i,j,n, ib, nv real :: rdum, zdep1, zdep2, zdep3, zmet, term1, term2, bare,fvg(4) + integer, dimension(npft) :: map_pft logical :: NEWLAND logical :: file_exists type(NetCDF4_Fileformatter) :: CatchCNFmt character*256 :: Iam = "add_bcs" + nveg = this%nveg + open (10,file =trim(OutBcsDir)//"/clsm/catchment.def",status='old',form='formatted') read (10,*) ntiles close (10, status = 'keep') @@ -604,8 +613,49 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) endif enddo - this%cnity = reshape([CLMC_pt1,CLMC_pt2,CLMC_st1,CLMC_st2],[ntiles,4]) - this%fvg = reshape([CLMC_pf1,CLMC_pf2,CLMC_sf1,CLMC_sf2],[ntiles,4]) + ! if using Catchment-CN5.1, reduce down to 2 PFTs + ! step 1: map split PFTs to their parent type + ! step 2: add up area fractions + + if (this%isCLM51) then + + map_pft = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 10, 11, 12, 13, 13, 14, 14, 15, 15 /) + + do n = 1,ntiles + + ! map split PFTs to parent PFTs + CLMC_pt1(n) = map_pft(CLMC_pt1(n)) + CLMC_pt2(n) = map_pft(CLMC_pt2(n)) + CLMC_st1(n) = map_pft(CLMC_st1(n)) + CLMC_st2(n) = map_pft(CLMC_st2(n)) + + ! combine area fractions of same PFTs, + ! otherwise retain area fraction of single present PFT + + if (CLMC_pt1(n).eq.CLMC_pt2(n)) then + CLMC_pf1(n) = CLMC_pf1(n) + CLMC_pf2(n) + CLMC_pf2(n) = 0. + elseif (CLMC_pt1(n).ne.CLMC_pt2(n)) then + CLMC_pf1(n) = maxval((/ CLMC_pf1(n), CLMC_pf2(n) /)) + end if + + if (CLMC_st1(n).eq.CLMC_st2(n)) then + CLMC_sf1(n) = CLMC_sf1(n) + CLMC_sf2(n) + CLMC_sf2(n) = 0. + elseif (CLMC_st1(n).ne.CLMC_st2(n)) then + CLMC_sf1(n) = maxval((/ CLMC_sf1(n), CLMC_sf2(n) /)) + end if + end do + + end if + + if ((this%isCLM40).or.(this%isCLM45)) then + this%cnity = reshape([CLMC_pt1,CLMC_pt2,CLMC_st1,CLMC_st2],[ntiles,4]) + this%fvg = reshape([CLMC_pf1,CLMC_pf2,CLMC_sf1,CLMC_sf2],[ntiles,4]) + elseif (this%isCLM51) then + this%cnity = reshape([CLMC_pt1,CLMC_st1],[ntiles,2]) + this%fvg = reshape([CLMC_pf1,CLMC_sf1],[ntiles,2]) + end if this%ndep = ndep this%t2 = t2 @@ -661,7 +711,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) character(*), parameter :: Iam = "CatchmentCN::Re_tile" - + nveg = this%NVEG in_ntiles = this%ntiles var_pft = this%var_pft var_col = this%var_col @@ -773,18 +823,30 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) if (nint(this%tile_id(n)) /= n) stop ("cannot assign ity_offl to cnity and fvg_offl to fvg") - if((ityp_offl(N,3) == 0).and.(ityp_offl(N,4) == 0)) then - if(ityp_offl(N,1) /= 0) then - ityp_offl(N,3) = ityp_offl(N,1) - else - ityp_offl(N,3) = ityp_offl(N,2) + if ((this%isCLM40) .or. (this%isCLM45)) then + + if((ityp_offl(N,3) == 0).and.(ityp_offl(N,4) == 0)) then + if(ityp_offl(N,1) /= 0) then + ityp_offl(N,3) = ityp_offl(N,1) + else + ityp_offl(N,3) = ityp_offl(N,2) + endif endif - endif - if((ityp_offl(N,1) == 0).and.(ityp_offl(N,2) /= 0)) ityp_offl(N,1) = ityp_offl(N,2) - if((ityp_offl(N,2) == 0).and.(ityp_offl(N,1) /= 0)) ityp_offl(N,2) = ityp_offl(N,1) - if((ityp_offl(N,3) == 0).and.(ityp_offl(N,4) /= 0)) ityp_offl(N,3) = ityp_offl(N,4) - if((ityp_offl(N,4) == 0).and.(ityp_offl(N,3) /= 0)) ityp_offl(N,4) = ityp_offl(N,3) + if((ityp_offl(N,1) == 0).and.(ityp_offl(N,2) /= 0)) ityp_offl(N,1) = ityp_offl(N,2) + if((ityp_offl(N,2) == 0).and.(ityp_offl(N,1) /= 0)) ityp_offl(N,2) = ityp_offl(N,1) + if((ityp_offl(N,3) == 0).and.(ityp_offl(N,4) /= 0)) ityp_offl(N,3) = ityp_offl(N,4) + if((ityp_offl(N,4) == 0).and.(ityp_offl(N,3) /= 0)) ityp_offl(N,4) = ityp_offl(N,3) + + elseif (this%isCLM51) then + + if((ityp_offl(N,1) == 0).and.(ityp_offl(N,2) /= 0)) then + ityp_offl(N,1) = ityp_offl(N,2) + elseif if((ityp_offl(N,2) == 0).and.(ityp_offl(N,1) /= 0)) then + ityp_offl(N,2) = ityp_offl(N,1) + end if + + end if end do endif @@ -800,36 +862,57 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) st = low_ind(i+1) l = nt_local(i+1) tag = i*numprocs - call MPI_send(this%cnity(st,1),l, MPI_REAL, i, tag, MPI_COMM_WORLD, mpierr) - call MPI_send(this%cnity(st,2),l, MPI_REAL, i, tag+1, MPI_COMM_WORLD, mpierr) - call MPI_send(this%cnity(st,3),l, MPI_REAL, i, tag+2, MPI_COMM_WORLD, mpierr) - call MPI_send(this%cnity(st,4),l, MPI_REAL, i, tag+3, MPI_COMM_WORLD, mpierr) - call MPI_send(this%fvg(st,1),l, MPI_REAL, i, tag+4, MPI_COMM_WORLD, mpierr) - call MPI_send(this%fvg(st,2),l, MPI_REAL, i, tag+5, MPI_COMM_WORLD, mpierr) - call MPI_send(this%fvg(st,3),l, MPI_REAL, i, tag+6, MPI_COMM_WORLD, mpierr) - call MPI_send(this%fvg(st,4),l, MPI_REAL, i, tag+7, MPI_COMM_WORLD, mpierr) + if ((this%isCLM40) .or. (this%isCLM45)) then + call MPI_send(this%cnity(st,1),l, MPI_REAL, i, tag, MPI_COMM_WORLD, mpierr) + call MPI_send(this%cnity(st,2),l, MPI_REAL, i, tag+1, MPI_COMM_WORLD, mpierr) + call MPI_send(this%cnity(st,3),l, MPI_REAL, i, tag+2, MPI_COMM_WORLD, mpierr) + call MPI_send(this%cnity(st,4),l, MPI_REAL, i, tag+3, MPI_COMM_WORLD, mpierr) + call MPI_send(this%fvg(st,1),l, MPI_REAL, i, tag+4, MPI_COMM_WORLD, mpierr) + call MPI_send(this%fvg(st,2),l, MPI_REAL, i, tag+5, MPI_COMM_WORLD, mpierr) + call MPI_send(this%fvg(st,3),l, MPI_REAL, i, tag+6, MPI_COMM_WORLD, mpierr) + call MPI_send(this%fvg(st,4),l, MPI_REAL, i, tag+7, MPI_COMM_WORLD, mpierr) + elseif (this%isCLM51) then + call MPI_send(this%cnity(st,1),l, MPI_REAL, i, tag, MPI_COMM_WORLD, mpierr) + call MPI_send(this%cnity(st,2),l, MPI_REAL, i, tag+1, MPI_COMM_WORLD, mpierr) + call MPI_send(this%fvg(st,1),l, MPI_REAL, i, tag+2, MPI_COMM_WORLD, mpierr) + call MPI_send(this%fvg(st,2),l, MPI_REAL, i, tag+3, MPI_COMM_WORLD, mpierr) + end if enddo st = low_ind(1) l = nt_local(1) ed = st + l -1 - CLMC_pt1 = this%cnity(st:ed,1) - CLMC_pt2 = this%cnity(st:ed,2) - CLMC_st1 = this%cnity(st:ed,3) - CLMC_st2 = this%cnity(st:ed,4) - CLMC_pf1 = this%fvg(st:ed,1) - CLMC_pf2 = this%fvg(st:ed,2) - CLMC_sf1 = this%fvg(st:ed,3) - CLMC_sf2 = this%fvg(st:ed,4) + if ((this%isCLM40) .or. (this%isCLM45)) then + CLMC_pt1 = this%cnity(st:ed,1) + CLMC_pt2 = this%cnity(st:ed,2) + CLMC_st1 = this%cnity(st:ed,3) + CLMC_st2 = this%cnity(st:ed,4) + CLMC_pf1 = this%fvg(st:ed,1) + CLMC_pf2 = this%fvg(st:ed,2) + CLMC_sf1 = this%fvg(st:ed,3) + CLMC_sf2 = this%fvg(st:ed,4) + elseif (this%isCLM51) then + CLMC_pt1 = this%cnity(st:ed,1) + CLMC_st1 = this%cnity(st:ed,2) + CLMC_pf1 = this%fvg(st:ed,1) + CLMC_sf1 = this%fvg(st:ed,2) + end if else tag = myid*numprocs - call MPI_RECV(CLMC_pt1,nt_local(myid+1) , MPI_REAL, 0, tag, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) - call MPI_RECV(CLMC_pt2,nt_local(myid+1) , MPI_REAL, 0, tag+1, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) - call MPI_RECV(CLMC_st1,nt_local(myid+1) , MPI_REAL, 0, tag+2, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) - call MPI_RECV(CLMC_st2,nt_local(myid+1) , MPI_REAL, 0, tag+3, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) - call MPI_RECV(CLMC_pf1,nt_local(myid+1) , MPI_REAL, 0, tag+4, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) - call MPI_RECV(CLMC_pf2,nt_local(myid+1) , MPI_REAL, 0, tag+5, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) - call MPI_RECV(CLMC_sf1,nt_local(myid+1) , MPI_REAL, 0, tag+6, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) - call MPI_RECV(CLMC_sf2,nt_local(myid+1) , MPI_REAL, 0, tag+7, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + if ((this%isCLM40) .or. (this%isCLM45)) then + call MPI_RECV(CLMC_pt1,nt_local(myid+1) , MPI_REAL, 0, tag, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_pt2,nt_local(myid+1) , MPI_REAL, 0, tag+1, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_st1,nt_local(myid+1) , MPI_REAL, 0, tag+2, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_st2,nt_local(myid+1) , MPI_REAL, 0, tag+3, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_pf1,nt_local(myid+1) , MPI_REAL, 0, tag+4, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_pf2,nt_local(myid+1) , MPI_REAL, 0, tag+5, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_sf1,nt_local(myid+1) , MPI_REAL, 0, tag+6, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_sf2,nt_local(myid+1) , MPI_REAL, 0, tag+7, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + elseif (this%isCLM51) then + call MPI_RECV(CLMC_pt1,nt_local(myid+1) , MPI_REAL, 0, tag, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_st1,nt_local(myid+1) , MPI_REAL, 0, tag+1, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_pf1,nt_local(myid+1) , MPI_REAL, 0, tag+2, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + call MPI_RECV(CLMC_sf1,nt_local(myid+1) , MPI_REAL, 0, tag+3, MPI_COMM_WORLD,MPI_STATUS_IGNORE,mpierr) + end if endif call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -838,7 +921,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) call GetIds(this%lonc,this%latc,this%lonn,this%latt,id_loc_cn, tid_offl, & CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & - fveg_offl, ityp_offl) + fveg_offl, ityp_offl,this%isCLM51) call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -884,6 +967,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) tg_tmp(:,i) = this%tg(this%id_glb(:),i) enddo this%tg = tg_tmp + deallocate(tg_tmp) var_out = this%bflowm (this%id_glb(:)) this%bflowm = var_out @@ -936,6 +1020,10 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) this%tprec60d= var_out var_out = this%t2m10d (this%id_glb(:)) this%t2m10d = var_out + do nz = 1, nzone + var_out_zone(:,nz) = this%sfmm(this%id_glb(:), nz) + enddo + this%sfmm = var_out_zone endif i = 1 @@ -1010,14 +1098,27 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & allocate (CLMC_st2(NTILES)) allocate (VAR_DUM (NTILES)) - CLMC_pt1 = this%cnity(:,1) - CLMC_pt2 = this%cnity(:,2) - CLMC_st1 = this%cnity(:,3) - CLMC_st2 = this%cnity(:,4) - CLMC_pf1 = this%fvg(:,1) - CLMC_pf2 = this%fvg(:,2) - CLMC_sf1 = this%fvg(:,3) - CLMC_sf2 = this%fvg(:,4) + if ((this%isCLM40).or.(this%isCLM45)) then + CLMC_pt1 = this%cnity(:,1) + CLMC_pt2 = this%cnity(:,2) + CLMC_st1 = this%cnity(:,3) + CLMC_st2 = this%cnity(:,4) + CLMC_pf1 = this%fvg(:,1) + CLMC_pf2 = this%fvg(:,2) + CLMC_sf1 = this%fvg(:,3) + CLMC_sf2 = this%fvg(:,4) + + elseif (this%isCLM51) then + + CLMC_pt1 = this%cnity(:,1) + CLMC_st1 = this%cnity(:,3) + CLMC_st2 = this%cnity(:,4) + CLMC_pf1 = this%fvg(:,1) + CLMC_pf2 = this%fvg(:,2) + CLMC_sf1 = this%fvg(:,3) + CLMC_sf2 = this%fvg(:,4) + + end if allocate (var_col_out (1: NTILES, 1 : nzone,1 : var_col)) allocate (var_pft_out (1: NTILES, 1 : nzone,1 : nveg, 1 : var_pft)) @@ -1031,20 +1132,38 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & NVLOOP2 : do nv = 1, nveg - if(nv <= 2) then ! index for secondary PFT index if primary or primary if secondary - nx = nv + 2 - else - nx = nv - 2 - endif + if ((this%isCLM40).or.(this%isCLM45)) then + + if(nv <= 2) then ! index for secondary PFT index if primary or primary if secondary + nx = nv + 2 + else + nx = nv - 2 + endif + + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_pt2(n) + if (nv == 2) fveg_new = CLMC_pf2(n) + if (nv == 3) ityp_new = CLMC_st1(n) + if (nv == 3) fveg_new = CLMC_sf1(n) + if (nv == 4) ityp_new = CLMC_st2(n) + if (nv == 4) fveg_new = CLMC_sf2(n) + + elseif (this%isCLM51) then + + if(nv <= 1) then ! index for secondary PFT index if primary or primary if secondary + nx = nv + 1 + else + nx = nv - 1 + endif + + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_st1(n) + if (nv == 2) fveg_new = CLMC_sf1(n) + + end if - if (nv == 1) ityp_new = CLMC_pt1(n) - if (nv == 1) fveg_new = CLMC_pf1(n) - if (nv == 2) ityp_new = CLMC_pt2(n) - if (nv == 2) fveg_new = CLMC_pf2(n) - if (nv == 3) ityp_new = CLMC_st1(n) - if (nv == 3) fveg_new = CLMC_sf1(n) - if (nv == 4) ityp_new = CLMC_st2(n) - if (nv == 4) fveg_new = CLMC_sf2(n) if (fveg_new > fmin) then offl_cell = Id_glb(n,nv) @@ -1112,15 +1231,21 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & var_col_out(n, nz,29) = max(var_col_out(n, nz,29), 0.) NVLOOP3 : do nv = 1,nveg - - if (nv == 1) ityp_new = CLMC_pt1(n) - if (nv == 1) fveg_new = CLMC_pf1(n) - if (nv == 2) ityp_new = CLMC_pt2(n) - if (nv == 2) fveg_new = CLMC_pf2(n) - if (nv == 3) ityp_new = CLMC_st1(n) - if (nv == 3) fveg_new = CLMC_sf1(n) - if (nv == 4) ityp_new = CLMC_st2(n) - if (nv == 4) fveg_new = CLMC_sf2(n) + if ((this%isCLM40).or.(this%isCLM45)) then + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_pt2(n) + if (nv == 2) fveg_new = CLMC_pf2(n) + if (nv == 3) ityp_new = CLMC_st1(n) + if (nv == 3) fveg_new = CLMC_sf1(n) + if (nv == 4) ityp_new = CLMC_st2(n) + if (nv == 4) fveg_new = CLMC_sf2(n) + elseif (this%isCLM51) then + if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) fveg_new = CLMC_pf1(n) + if (nv == 2) ityp_new = CLMC_st1(n) + if (nv == 2) fveg_new = CLMC_sf1(n) + end if if(fveg_new > fmin) then var_pft_out(n, nz,nv, 1) = max(var_pft_out(n, nz,nv, 1),0.) @@ -1201,6 +1326,8 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & var_pft_out(n, nz,nv,79) = max(var_pft_out(n, nz,nv,79),0.) var_pft_out(n, nz,nv,80) = max(var_pft_out(n, nz,nv,80),0.) var_pft_out(n, nz,nv,81) = max(var_pft_out(n, nz,nv,81),0.) + var_pft_out(n, nz,nv,82) = max(var_pft_out(n, nz,nv,82),0.) + var_pft_out(n, nz,nv,83) = max(var_pft_out(n, nz,nv,83),0.) end if endif end do NVLOOP3 ! end veg loop From 91d2ade28d2ff9fb5dc64486ec19010ecd420aab Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 15 Jun 2023 15:40:38 -0400 Subject: [PATCH 497/589] move getids.F90 and cleanup (PR#770) --- .../GEOSsurface_GridComp/Shared/CMakeLists.txt | 1 - .../GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt | 1 + .../{Shared => Utils/mk_restarts}/getids.F90 | 8 ++++---- 3 files changed, 5 insertions(+), 5 deletions(-) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/{Shared => Utils/mk_restarts}/getids.F90 (98%) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/CMakeLists.txt index 24e12a4ee..7abedf76c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/CMakeLists.txt @@ -10,7 +10,6 @@ install( FILES ${resource_files} ) set (srcs - getids.F90 StieglitzSnow.F90 SurfParams.F90) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt index d073187a8..c79294aa5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt @@ -3,6 +3,7 @@ esma_set_this () set(srcs CatchmentRst.F90 CatchmentCNRst.F90 + getids.F90 ) set (exe_srcs diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 similarity index 98% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 index 0dfbb363d..948d538b8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/getids.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 @@ -467,10 +467,10 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & icl_ityp1 = iclass(sub_ityp1) do i = 1,nplus - if((sub_fevg1(i)>fmin .and. (ityp_new ==sub_ityp1(i) .or. & - iclass(ityp_new) ==iclass(sub_ityp1(i)))) .or. & - (sub_fevg2(i)>fmin .and. (ityp_new ==sub_ityp2(i) .or. & - iclass(ityp_new)==iclass(sub_ityp2(i))))) then + if( ( sub_fevg1(i)>fmin .and. ( ityp_new==sub_ityp1(i) .or. iclass(ityp_new)==iclass(sub_ityp1(i)) ) ) & + .or. & + ( sub_fevg2(i)>fmin .and. ( ityp_new==sub_ityp2(i) .or. iclass(ityp_new)==iclass(sub_ityp2(i)) ) ) & + ) then sub_dist = haversine(to_radian(lato(n)), to_radian(lono(n)), & sub_lat(i), sub_lon(i)) From c447481afbc78f9b0daa5924ac75d9223f0797a1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 15 Jun 2023 16:04:13 -0400 Subject: [PATCH 498/589] typo fixes --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 28 +++++++++---------- .../Utils/mk_restarts/getids.F90 | 8 +++--- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 6699acf52..3ca8593c8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -635,19 +635,19 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) if (CLMC_pt1(n).eq.CLMC_pt2(n)) then CLMC_pf1(n) = CLMC_pf1(n) + CLMC_pf2(n) CLMC_pf2(n) = 0. - elseif (CLMC_pt1(n).ne.CLMC_pt2(n)) then + else if (CLMC_pt1(n).ne.CLMC_pt2(n)) then CLMC_pf1(n) = maxval((/ CLMC_pf1(n), CLMC_pf2(n) /)) - end if + endif if (CLMC_st1(n).eq.CLMC_st2(n)) then CLMC_sf1(n) = CLMC_sf1(n) + CLMC_sf2(n) CLMC_sf2(n) = 0. - elseif (CLMC_st1(n).ne.CLMC_st2(n)) then + else if (CLMC_st1(n).ne.CLMC_st2(n)) then CLMC_sf1(n) = maxval((/ CLMC_sf1(n), CLMC_sf2(n) /)) - end if + endif end do - end if + endif if ((this%isCLM40).or.(this%isCLM45)) then this%cnity = reshape([CLMC_pt1,CLMC_pt2,CLMC_st1,CLMC_st2],[ntiles,4]) @@ -655,7 +655,7 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) elseif (this%isCLM51) then this%cnity = reshape([CLMC_pt1,CLMC_st1],[ntiles,2]) this%fvg = reshape([CLMC_pf1,CLMC_sf1],[ntiles,2]) - end if + endif this%ndep = ndep this%t2 = t2 @@ -811,9 +811,9 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) if ((this%isCLM40) .or. (this%isCLM45)) then npft_int = npft - elseif (this%isCLM51) then + else if (this%isCLM51) then npft_int = npft_51 - end if + endif do n = 1, in_ntiles do nv = 1,nveg @@ -842,11 +842,11 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) if((ityp_offl(N,1) == 0).and.(ityp_offl(N,2) /= 0)) then ityp_offl(N,1) = ityp_offl(N,2) - elseif if((ityp_offl(N,2) == 0).and.(ityp_offl(N,1) /= 0)) then + else if((ityp_offl(N,2) == 0).and.(ityp_offl(N,1) /= 0)) then ityp_offl(N,2) = ityp_offl(N,1) - end if + endif - end if + endif end do endif @@ -871,12 +871,12 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) call MPI_send(this%fvg(st,2),l, MPI_REAL, i, tag+5, MPI_COMM_WORLD, mpierr) call MPI_send(this%fvg(st,3),l, MPI_REAL, i, tag+6, MPI_COMM_WORLD, mpierr) call MPI_send(this%fvg(st,4),l, MPI_REAL, i, tag+7, MPI_COMM_WORLD, mpierr) - elseif (this%isCLM51) then + else if (this%isCLM51) then call MPI_send(this%cnity(st,1),l, MPI_REAL, i, tag, MPI_COMM_WORLD, mpierr) call MPI_send(this%cnity(st,2),l, MPI_REAL, i, tag+1, MPI_COMM_WORLD, mpierr) call MPI_send(this%fvg(st,1),l, MPI_REAL, i, tag+2, MPI_COMM_WORLD, mpierr) call MPI_send(this%fvg(st,2),l, MPI_REAL, i, tag+3, MPI_COMM_WORLD, mpierr) - end if + endif enddo st = low_ind(1) l = nt_local(1) @@ -895,7 +895,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) CLMC_st1 = this%cnity(st:ed,2) CLMC_pf1 = this%fvg(st:ed,1) CLMC_sf1 = this%fvg(st:ed,2) - end if + endif else tag = myid*numprocs if ((this%isCLM40) .or. (this%isCLM45)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 index 948d538b8..44b40ec99 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 @@ -438,7 +438,7 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & nx = nv - 1 endif - elseif (.not.isCLM51) then + else if (.not.isCLM51) then if (nv == 1) ityp_new = CLMC_pt1(n) if (nv == 1) fveg_new = CLMC_pf1(n) @@ -456,7 +456,7 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & else nx = nv - 2 endif - end if + endif sub_ityp1 = ityp_offl (sub_tid,nv) sub_fevg1 = fveg_offl (sub_tid,nv) @@ -506,12 +506,12 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & if (isCLM51) then if((tile_found).and.((CLMC_pf1(n) > fmin).and.(Id(n,1) < 0))) tile_found = .false. if((tile_found).and.((CLMC_sf1(n) > fmin).and.(Id(n,2) < 0))) tile_found = .false. - elseif (.not.isCLM51) then + else if (.not.isCLM51) then if((tile_found).and.((CLMC_pf1(n) > fmin).and.(Id(n,1) < 0))) tile_found = .false. if((tile_found).and.((CLMC_pf2(n) > fmin).and.(Id(n,2) < 0))) tile_found = .false. if((tile_found).and.((CLMC_sf1(n) > fmin).and.(Id(n,3) < 0))) tile_found = .false. if((tile_found).and.((CLMC_sf2(n) > fmin).and.(Id(n,4) < 0))) tile_found = .false. - end if + endif if(tile_found) GO TO 100 From e85bb56641672e0311abf6c868ea8051a3620e51 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Jun 2023 11:18:06 -0400 Subject: [PATCH 499/589] change order of if-statements --- .../Utils/mk_restarts/getids.F90 | 40 ++++++++++--------- 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 index 44b40ec99..cb6550b7e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/getids.F90 @@ -430,33 +430,37 @@ subroutine GetIds_carbon (loni,lati,lono,lato,Id, tid_in, & if (nv == 2) ityp_new = CLMC_st1(n) if (nv == 2) fveg_new = CLMC_sf1(n) - SEEK : if((Id (n, nv) < 0).and.(fveg_new > fmin)) then - - if(nv <= 1) then ! index for secondary PFT index if primary or primary if secondary - nx = nv + 1 - else - nx = nv - 1 - endif - - else if (.not.isCLM51) then + else if (.not.isCLM51) then - if (nv == 1) ityp_new = CLMC_pt1(n) + if (nv == 1) ityp_new = CLMC_pt1(n) if (nv == 1) fveg_new = CLMC_pf1(n) if (nv == 2) ityp_new = CLMC_pt2(n) if (nv == 2) fveg_new = CLMC_pf2(n) if (nv == 3) ityp_new = CLMC_st1(n) if (nv == 3) fveg_new = CLMC_sf1(n) - if (nv == 4) ityp_new = CLMC_st2(n) + if (nv == 4) ityp_new = CLMC_st2(n) if (nv == 4) fveg_new = CLMC_sf2(n) - + + end if + + SEEK : if((Id (n, nv) < 0).and.(fveg_new > fmin)) then - - if(nv <= 2) then ! index for secondary PFT index if primary or primary if secondary + + if (isCLM51) then + if(nv <= 1) then ! index for secondary PFT index if primary or primary if secondary + nx = nv + 1 + else + nx = nv - 1 + endif + + else if (.not.isCLM51) then + + if(nv <= 2) then ! index for secondary PFT index if primary or primary if secondary nx = nv + 2 - else - nx = nv - 2 - endif - endif + else + nx = nv - 2 + endif + endif sub_ityp1 = ityp_offl (sub_tid,nv) sub_fevg1 = fveg_offl (sub_tid,nv) From 0bba4d3c3119caad948e7284c1c5881f2a629f24 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Jun 2023 12:11:12 -0400 Subject: [PATCH 500/589] typo fix --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 3ca8593c8..097b88f62 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -460,7 +460,7 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) real, allocatable :: CLMC_pt1(:), CLMC_pt2(:), CLMC_st1(:), CLMC_st2(:) real, allocatable :: NDEP(:), BVISDR(:), BVISDF(:), BNIRDR(:), BNIRDF(:) real, allocatable :: T2(:), hdm(:), fc(:), gdp(:), peatf(:) -gg integer, allocatable :: ity(:), abm (:) + integer, allocatable :: ity(:), abm (:) integer :: STATUS, ntiles, unit27, unit28, unit29, unit30 integer :: idum, i,j,n, ib, nv real :: rdum, zdep1, zdep2, zdep3, zmet, term1, term2, bare,fvg(4) From 9c96eb760d9033d47af2de1ad6f2e6fb6ccd06e5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Jun 2023 14:15:02 -0400 Subject: [PATCH 501/589] cleanup after develop merge --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 81 ++++++++----------- 1 file changed, 32 insertions(+), 49 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index b443725e4..d7be96cf7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -321,20 +321,20 @@ subroutine write_nc4(this, filename, rc) call MAPL_VarWrite(formatter,"HDM", this%HDM ) call MAPL_VarWrite(formatter,"GDP", this%GDP ) call MAPL_VarWrite(formatter,"PEATF", this%PEATF ) - call MAPL_VarWrite(formatter,"RHM", var) - call MAPL_VarWrite(formatter,"WINDM", var) - call MAPL_VarWrite(formatter,"RAINFM", var) - call MAPL_VarWrite(formatter,"SNOWFM", var) - call MAPL_VarWrite(formatter,"RUNSRFM", var) - call MAPL_VarWrite(formatter,"AR1M", var) - call MAPL_VarWrite(formatter,"T2M10D", var) - call MAPL_VarWrite(formatter,"RH30D", var) - call MAPL_VarWrite(formatter,"TPREC10D",var) - call MAPL_VarWrite(formatter,"TPREC60D",var) + + call MAPL_VarWrite(formatter,"RHM", this%rhm ) + call MAPL_VarWrite(formatter,"WINDM", this%windm ) + call MAPL_VarWrite(formatter,"RAINFM", this%rainfm ) + call MAPL_VarWrite(formatter,"SNOWFM", this%snowfm ) + call MAPL_VarWrite(formatter,"RUNSRFM", this%runsrfm ) + call MAPL_VarWrite(formatter,"AR1M", this%ar1m ) + call MAPL_VarWrite(formatter,"T2M10D", this%t2m10d ) + call MAPL_VarWrite(formatter,"TPREC10D",this%tprec10d ) + call MAPL_VarWrite(formatter,"TPREC60D",this%tprec60d ) + elseif (this%isCLM51) then - do j=1,dim1 - call MAPL_VarWrite(formatter,"SFMM", var,offset1=j) - enddo + + call MAPL_VarWrite(formatter,"SFMM", this%sfmm) call MAPL_VarWrite(formatter,"ABM", this%ABM, rc =rc ) call MAPL_VarWrite(formatter,"FIELDCAP",this%FIELDCAP) @@ -354,17 +354,6 @@ subroutine write_nc4(this, filename, rc) call MAPL_VarWrite(formatter,"RH30D", this%RH30D) call MAPL_VarWrite(formatter,"TPREC10D",this%TPREC10D) call MAPL_VarWrite(formatter,"TPREC60D",this%TPREC60D) - else - call MAPL_VarWrite(formatter,"SFMCM", var) - call MAPL_VarWrite(formatter,"RHM", this%rhm ) - call MAPL_VarWrite(formatter,"WINDM", this%windm ) - call MAPL_VarWrite(formatter,"RAINFM", this%rainfm ) - call MAPL_VarWrite(formatter,"SNOWFM", this%snowfm ) - call MAPL_VarWrite(formatter,"RUNSRFM", this%runsrfm ) - call MAPL_VarWrite(formatter,"AR1M", this%ar1m ) - call MAPL_VarWrite(formatter,"T2M10D", this%t2m10d ) - call MAPL_VarWrite(formatter,"TPREC10D",this%tprec10d ) - call MAPL_VarWrite(formatter,"TPREC60D",this%tprec60d ) endif @@ -410,19 +399,6 @@ subroutine allocate_cn(this,rc) allocate(this%HDM(ntiles)) allocate(this%GDP(ntiles)) allocate(this%PEATF(ntiles)) - allocate(this%RHM(ntiles)) - allocate(this%WINDM(ntiles)) - allocate(this%RAINFM(ntiles)) - allocate(this%SNOWFM(ntiles)) - allocate(this%RUNSRFM(ntiles)) - allocate(this%AR1M(ntiles)) - allocate(this%RH30D(ntiles)) - allocate(this%TG10D(ntiles)) - allocate(this%T2M10D(ntiles)) - allocate(this%T2MMIN5D(ntiles)) - allocate(this%TPREC10D(ntiles)) - allocate(this%TPREC60D(ntiles)) - allocate(this%SNDZM5D(ntiles)) allocate(this%bflowm (ntiles)) allocate(this%totwatm (ntiles)) @@ -436,7 +412,6 @@ subroutine allocate_cn(this,rc) allocate(this%rzmm (ntiles,nzone)) allocate(this%tgwm (ntiles,nzone)) - if (this%isCLM40) then allocate(this%sfmcm (ntiles)) endif @@ -452,6 +427,22 @@ subroutine allocate_cn(this,rc) allocate(this%t2m10d (ntiles)) allocate(this%sfmm (ntiles,nzone)) endif + if (this%isCLM51) + allocate(this%ar1m (ntiles)) + allocate(this%rainfm (ntiles)) + allocate(this%rhm (ntiles)) + allocate(this%runsrfm (ntiles)) + allocate(this%snowfm (ntiles)) + allocate(this%windm (ntiles)) + allocate(this%tprec10d(ntiles)) + allocate(this%tprec60d(ntiles)) + allocate(this%t2m10d (ntiles)) + allocate(this%sfmm (ntiles,nzone)) + allocate(this%rh30d (ntiles)) + allocate(this%tg10d (ntiles)) + allocate(this%t2mmin5d(ntiles)) + allocate(this%sndzm5d (ntiles)) + endif _RETURN(_SUCCESS) end subroutine allocate_cn @@ -702,16 +693,11 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2 integer :: AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR=0,AGCM_DATE, & AGCM_MI, AGCM_S, dofyr -<<<<<<< HEAD - real, allocatable, dimension(:,:) :: fveg_offl, ityp_offl, tg_tmp - real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:), var_out(:), var_psn(:,:,:) - integer :: status, in_ntiles, out_ntiles, numprocs, npft_int -======= + real, allocatable, dimension(:,:) :: fveg_offl, ityp_offl, tg_tmp, dummy_tmp real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:), var_out(:), var_psn(:,:,:), & var_out_zone(:,:) - integer :: status, in_ntiles, out_ntiles, numprocs ->>>>>>> develop + integer :: status, in_ntiles, out_ntiles, numprocs, npft_int logical :: root_proc integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft real, allocatable, dimension(:) :: lat_tmp @@ -981,11 +967,8 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) enddo this%tg = tg_tmp deallocate(tg_tmp) -<<<<<<< HEAD - -======= ->>>>>>> develop + var_out = this%bflowm (this%id_glb(:)) this%bflowm = var_out var_out = this%totwatm(this%id_glb(:)) From 922aa4963564e52f8feb95d3350bf35c0af32ed7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Jun 2023 14:39:57 -0400 Subject: [PATCH 502/589] add missing variable declaration --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index d7be96cf7..2fb9d83e6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -371,7 +371,7 @@ subroutine allocate_cn(this,rc) class(CatchmentCNRst), intent(inout) :: this integer, optional, intent(out):: rc integer :: status - integer :: ncol,npft, ntiles + integer :: ncol,npft, ntiles, nveg nveg = this%NVEG From 436ec643fc51a04a0ea94d42e06d4ab7746a9e58 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Jun 2023 15:01:21 -0400 Subject: [PATCH 503/589] add missing variable declaration --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 2fb9d83e6..e46d1ae10 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -458,7 +458,7 @@ SUBROUTINE add_bcs_to_cnrst (this, SURFLAY, OutBcsDir,rc) real, allocatable :: T2(:), hdm(:), fc(:), gdp(:), peatf(:) integer, allocatable :: ity(:), abm (:) integer :: STATUS, ntiles, unit27, unit28, unit29, unit30 - integer :: idum, i,j,n, ib, nv + integer :: idum, i,j,n, ib, nv, nveg real :: rdum, zdep1, zdep2, zdep3, zmet, term1, term2, bare,fvg(4) integer, dimension(npft) :: map_pft logical :: NEWLAND From d51912b87fbbbb0b104529c4a8c9685fd2893159 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Jun 2023 15:34:47 -0400 Subject: [PATCH 504/589] add missing variable declaration --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index e46d1ae10..3d29ba68e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -699,7 +699,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) var_out_zone(:,:) integer :: status, in_ntiles, out_ntiles, numprocs, npft_int logical :: root_proc - integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft + integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft, nveg real, allocatable, dimension(:) :: lat_tmp type(MAPL_SunOrbit) :: ORBIT type(ESMF_Time) :: CURRENT_TIME From b539c5330bfb096b650a26a8fc93e7e1259bd1f8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 16 Jun 2023 15:45:11 -0400 Subject: [PATCH 505/589] fixing if-statement --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 3d29ba68e..4c34f8f43 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -427,7 +427,7 @@ subroutine allocate_cn(this,rc) allocate(this%t2m10d (ntiles)) allocate(this%sfmm (ntiles,nzone)) endif - if (this%isCLM51) + if (this%isCLM51) then allocate(this%ar1m (ntiles)) allocate(this%rainfm (ntiles)) allocate(this%rhm (ntiles)) From 3c7c065fc1f0bfba4c2c5f43b1f5624b51459666 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Jun 2023 08:30:52 -0400 Subject: [PATCH 506/589] hardcode CatchCN4.0/4.5 (not 5.1) option in soon to be obsolete mk_GEOSldasRestarts.F90 --- .../Utils/mk_restarts/mk_GEOSldasRestarts.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 index 0eb79c634..016cd1fb1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 @@ -651,7 +651,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MOD call GetIds(lonc,latc,lonn,latt,id_loc_cn, tid_offl, & CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & - fveg_offl, ityp_offl) + fveg_offl, ityp_offl,.false.) !jkolassa June 2023: logical argument hardcoded at end means this code does not work for Catchment-CN5.1; acceptable since mk_GEOSldasRestarts.F90 will be replaced if(root_proc) allocate (id_glb_cn (ntiles,nveg)) @@ -2086,7 +2086,7 @@ SUBROUTINE regrid_carbon_vars (NTILES, model) call GetIds(lonc,latc,lonn,latt,id_loc, tid_offl, & CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & - fveg_offl, ityp_offl) + fveg_offl, ityp_offl,.false.) !jkolassa June 2023: logical input argument hardcoded at end means that this code does not work for Catchment-CN5.1, which is considered acceptable, since mk_GEOSldasRestarts.F90 is about to be replaced with code that doe swork for Catchment-CN5.1 ! update id_glb in root From 64fbc1e90704d7d1d913c34637e451e577655e70 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Jun 2023 09:36:14 -0400 Subject: [PATCH 507/589] hardcoding CatchCN4.0/4.5 versions in soon to be obsolete restart routines --- .../Utils/mk_restarts/mk_CatchCNRestarts.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index abf5e507e..8fe9d6faf 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -1314,7 +1314,7 @@ SUBROUTINE regrid_carbon_vars ( & call GetIds(lonc,latc,lonn,latt,id_loc, tid_offl, & CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2, & - fveg_offl, ityp_offl) + fveg_offl, ityp_offl,.false.) ! jkolassa June 2023: hardocding to work for CatchCN4.0/4.5 for now (not 5.1), since this routine will be replaced by one that works for all CatchCN versions shortly. deallocate (CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2,lonc,latc,lonn,latt) ! update id_glb in root From c64c1ef874b40679569997f726f743aef402f67c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Jun 2023 10:03:06 -0400 Subject: [PATCH 508/589] correct LONG_NAME for absorbed and emitted longwave flux --- .../GEOS_CatchCNCLM51GridComp.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 5e7a2af42..104f236d5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -475,7 +475,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'surface_downwelling_longwave_flux',& + LONG_NAME = 'surface_absorbed_longwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'LWDNSRF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -484,7 +484,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'linearization_of_surface_upwelling_longwave_flux',& + LONG_NAME = 'linearization_of_surface_emitted_longwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'ALW' ,& DIMS = MAPL_DimsTileOnly ,& @@ -493,7 +493,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'linearization_of_surface_upwelling_longwave_flux',& + LONG_NAME = 'linearization_of_surface_emitted_longwave_flux',& UNITS = 'W_m-2 K-1' ,& SHORT_NAME = 'BLW' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2292,7 +2292,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_outgoing_longwave_flux',& + LONG_NAME = 'surface_emitted_longwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'HLWUP' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2982,7 +2982,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LWUPSNOW', & - LONG_NAME = 'Net_longwave_snow', & + LONG_NAME = 'surface_emitted_longwave_flux_snow', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2991,7 +2991,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LWDNSNOW', & - LONG_NAME = 'Net_longwave_snow', & + LONG_NAME = 'surface_absorbed_longwave_flux_snow', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -7453,7 +7453,7 @@ subroutine Driver ( RC ) RA(:,FSAT), RA(:,FTRN), RA(:,FWLT), RA(:,FSNW) ,& - ZTH, SWNETFREE, SWNETSNOW, LWDNSRF ,& + ZTH, SWNETFREE, SWNETSNOW, LWDNSRF ,& ! LWDNSRF = *absorbed* longwave only (excl reflected) PS*.01 ,& @@ -7483,7 +7483,7 @@ subroutine Driver ( RC ) BFLOW ,& RUNSURF ,& SMELT ,& - HLWUP ,& + HLWUP ,& ! *emitted* longwave only (excl reflected) SWNDSRF ,& HLATN ,& QINFIL ,& From 50e706b6b80d5a70c1ffed2d432695aa30016cfe Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Jun 2023 11:14:37 -0400 Subject: [PATCH 509/589] changing hardcoded references to 4 PFTs to 2 PFTs --- .../GEOS_CatchCNCLM51GridComp.F90 | 38 +++++++------------ 1 file changed, 13 insertions(+), 25 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 104f236d5..44f280190 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -4191,13 +4191,9 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) where(ITY(:,1) > 0.) VEG1 = map_cat(nint(ITY(:,1))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 - elsewhere - VEG1 = map_cat(nint(ITY(:,2))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 endwhere - where(ITY(:,3) > 0.) - VEG2 = map_cat(nint(ITY(:,3))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 - elsewhere - VEG2 = map_cat(nint(ITY(:,4))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + where(ITY(:,2) > 0.) + VEG2 = map_cat(nint(ITY(:,2))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 endwhere _ASSERT((count(VEG1>NTYPS.or.VEG1<1)==0),'needs informative message') _ASSERT((count(VEG2>NTYPS.or.VEG2<1)==0),'needs informative message') @@ -4221,8 +4217,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) END DO - FVG1 = fvg(:,1) + fvg(:,2) ! gkw: primary vegetation fraction - FVG2 = fvg(:,3) + fvg(:,4) ! gkw: secondary vegetation fraction + FVG1 = fvg(:,1) + FVG2 = fvg(:,2) ! set CLM CN PFT & fraction, set carbon zone weights ! -------------------------------------------------- @@ -5868,19 +5864,15 @@ subroutine Driver ( RC ) CAT_ID = nint(tile_id) - where(ITY(:,1) > 0.) ! gkw: account for "split" types + where(ITY(:,1) > 0.) VEG1 = map_cat(nint(ITY(:,1))) ! map primary CN PFT to catchment type - elsewhere - VEG1 = map_cat(nint(ITY(:,2))) ! map primary CN PFT to catchment type endwhere - where(ITY(:,3) > 0.) - VEG2 = map_cat(nint(ITY(:,3))) ! map secondary CN PFT to catchment type - elsewhere - VEG2 = map_cat(nint(ITY(:,4))) ! map secondary CN PFT to catchment type + where(ITY(:,2) > 0.) + VEG2 = map_cat(nint(ITY(:,2))) ! map secondary CN PFT to catchment type endwhere - fveg1(:) = fvg(:,1) + fvg(:,2) ! sum veg fractions (primary) gkw: NVEG specific - fveg2(:) = fvg(:,3) + fvg(:,4) ! sum veg fractions (secondary) gkw: fveg1+fveg2=1 + fveg1(:) = fvg(:,1) + fveg2(:) = fvg(:,2) allocate ( lai1(ntiles) ) allocate ( lai2(ntiles) ) @@ -8359,18 +8351,14 @@ subroutine RUN0(gc, import, export, clock, rc) where(ITY(:,1) > 0.) VEG1 = map_cat(nint(ITY(:,1))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 - elsewhere - VEG1 = map_cat(nint(ITY(:,2))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 endwhere - where(ITY(:,3) > 0.) - VEG2 = map_cat(nint(ITY(:,3))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 - elsewhere - VEG2 = map_cat(nint(ITY(:,4))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + where(ITY(:,2) > 0.) + VEG2 = map_cat(nint(ITY(:,2))) ! gkw: secondary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 endwhere _ASSERT((count(VEG1>NTYPS.or.VEG1<1)==0),'needs informative message') _ASSERT((count(VEG2>NTYPS.or.VEG2<1)==0),'needs informative message') - fveg1(:) = fvg(:,1) + fvg(:,2) ! sum veg fractions (primary) gkw: NUM_VEG specific - fveg2(:) = fvg(:,3) + fvg(:,4) ! sum veg fractions (secondary) gkw: fveg1+fveg2=1 + fveg1(:) = fvg(:,1) + fveg2(:) = fvg(:,2) ! Compute ASNOW and EMIS allocate(wesnn(3,ntiles), stat=status) From 24b1b1c13510a594b0a0f863c6a660e359fc6974 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Jun 2023 12:13:05 -0400 Subject: [PATCH 510/589] change hardcoded references to 4 PFTs to 2 --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 44f280190..ed67f71e2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -8323,7 +8323,7 @@ subroutine RUN0(gc, import, export, clock, rc) lai1 = 0. wght = 0. do nz = 1,num_zon - do nv = 1,2 + do nv = 1 lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do @@ -8333,7 +8333,7 @@ subroutine RUN0(gc, import, export, clock, rc) lai2 = 0. wght = 0. do nz = 1,num_zon - do nv = 3,4 + do nv = 2 lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do From 7b2f73916ed3314f552d7c2d4d9fbfc248b27720 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Jun 2023 12:31:34 -0400 Subject: [PATCH 511/589] change hardcoded references to 4 PFTs to 2 --- .../GEOS_CatchCNCLM51GridComp.F90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index ed67f71e2..b36419cfc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -8323,20 +8323,18 @@ subroutine RUN0(gc, import, export, clock, rc) lai1 = 0. wght = 0. do nz = 1,num_zon - do nv = 1 - lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) - wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) - end do + nv = 1 + lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do lai1 = lai1 / max(wght,1.e-8) ! LAI for primary vegetation type lai2 = 0. wght = 0. do nz = 1,num_zon - do nv = 2 - lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) - wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) - end do + nv = 2 + lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do lai2 = lai2 / max(wght,1.e-8) ! LAI for secondary vegetation type From a750f5c7dc1ff32c588dacfaaf1414084eb756f6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Jun 2023 13:36:13 -0400 Subject: [PATCH 512/589] change hardcoded references to 4 PFTs to 2 --- .../GEOS_CatchCNCLM51GridComp.F90 | 42 ++++++++----------- 1 file changed, 18 insertions(+), 24 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index b36419cfc..025cb86a8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -4260,20 +4260,18 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) lai1 = 0. wght = 0. do nz = 1,nzone - do nv = 1,2 - lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) - wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) - end do + nv = 1 + lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do lai1 = lai1 / max(wght,1.e-8) ! LAI for primary vegetation type lai2 = 0. wght = 0. do nz = 1,nzone - do nv = 3,4 - lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) - wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) - end do + nv = 2 + lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do lai2 = lai2 / max(wght,1.e-8) ! LAI for secondary vegetation type @@ -5881,20 +5879,18 @@ subroutine Driver ( RC ) lai1 = 0. wght = 0. do nz = 1,nzone - do nv = 1,2 - lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) - wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) - end do + nv = 1 + lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do lai1 = lai1 / max(wght,1.e-8) ! LAI for primary vegetation type lai2 = 0. wght = 0. do nz = 1,nzone - do nv = 3,4 - lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) - wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) - end do + nv = 2 + lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do lai2 = lai2 / max(wght,1.e-8) ! LAI for secondary vegetation type @@ -7115,20 +7111,18 @@ subroutine Driver ( RC ) lai1 = 0. wght = 0. do nz = 1,nzone - do nv = 1,2 - lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) - wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) - end do + nv = 1 + lai1(:) = lai1(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do lai1 = lai1 / max(wght,1.e-8) ! LAI for primary vegetation type lai2 = 0. wght = 0. do nz = 1,nzone - do nv = 3,4 - lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) - wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) - end do + nv = 2 + lai2(:) = lai2(:) + max(elai(:,nv,nz),0.)*fveg(:,nv,nz)*wtzone(:,nz) + wght(:) = wght(:) + fveg(:,nv,nz)*wtzone(:,nz) end do lai2 = lai2 / max(wght,1.e-8) ! LAI for secondary vegetation type From b02ef7650369abcf12f9a00ad664e620e5cb675b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 26 Jun 2023 13:08:35 -0400 Subject: [PATCH 513/589] initialize nitrogen product fluxes to zero in all patches --- .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index fabf3ace8..e2f59ebf5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -982,11 +982,11 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then this%plant_ndemand_patch (np) = cnpft(nc,nz,nv, 75) - this%dwt_wood_productn_gain_patch(np) = 0. ! following CNCLM45 setting - this%dwt_crop_productn_gain_patch(np) = 0. ! following CNCLM45 setting - + end if end do !nv + this%dwt_wood_productn_gain_patch(np) = 0. ! following CNCLM45 setting + this%dwt_crop_productn_gain_patch(np) = 0. ! following CNCLM45 setting end do ! p end do ! nz end do ! nc From 0f173fc7d2987c19703c90d7483bb0403ce661ba Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 30 Jun 2023 11:26:25 -0400 Subject: [PATCH 514/589] initialize vcmax to cold start value of 1 in active patches --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 index 34374bb3e..02527c4bf 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SurfaceAlbedoType.F90 @@ -162,6 +162,8 @@ subroutine Init(this, bounds, nch, cncol, cnpft) if (isnan(this%tsai_z_patch(np,n))) then this%tsai_z_patch(np,n) = 0. end if + this%vcmaxcintsha_patch(np) = 1._r8 + this%vcmaxcintsun_patch(np) = 1._r8 end do end do !nv end do ! p From f4cabf9d959f9ba5a59437309e09b41ecdc6f32f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 30 Jun 2023 13:06:04 -0400 Subject: [PATCH 515/589] add initialization for photosynthesis variables at every time step --- .../CLM51/CNCLM51_Photosynthesis.F90 | 5 ++++- .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 1 + 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 1ea824c52..84865d012 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -372,7 +372,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! going forward. ! compute resistance with small delta ea - + call photosyns_inst%TimeStepInit(bounds) eair_pert(:) = eair_clm(:) + dea call PhotosynthesisHydraulicStress ( bounds, filter(1)%num_exposedvegp, filter(1)%exposedvegp, & @@ -389,6 +389,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! compute resistance with small delta Tc + call photosyns_inst%TimeStepInit(bounds) temp_unpert = temperature_inst%t_veg_patch temperature_inst%t_veg_patch = temperature_inst%t_veg_patch + dtc esat_tv_pert(:) = esat_tv_clm(:) + deldT_clm(:)*dtc @@ -407,6 +408,8 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! compute unperturbed resistance + call photosyns_inst%TimeStepInit(bounds) + temperature_inst%t_veg_patch = temp_unpert ! reset canopy temperature to unperturbed value call PhotosynthesisHydraulicStress ( bounds, filter(1)%num_exposedvegp, filter(1)%exposedvegp, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 6a1a44d6e..1c2519407 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -220,6 +220,7 @@ module PhotosynthesisMod ! Public procedures procedure, public :: Init procedure, public :: ReadParams + procedure, public :: TimeStepInit end type photosyns_type type(photosyns_type), public, target, save :: photosyns_inst From d6b30a731b8e074e16769a4456bd13468fab2d31 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 30 Jun 2023 13:46:17 -0400 Subject: [PATCH 516/589] only add vegetated patches to soil patch filter --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 index 6677be405..12b115400 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_filterMod.F90 @@ -223,6 +223,8 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) np = np + 1 do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p) then + + if (fveg(nc,nv,nz)>1.e-4) then this_filter(1)%num_nourbanp = this_filter(1)%num_nourbanp + 1 this_filter(1)%nourbanp(this_filter(1)%num_nourbanp) = np @@ -237,7 +239,7 @@ subroutine init_filter_type(bounds, nch, ityp, fveg, this_filter) endif - if (fveg(nc,nv,nz)>1.e-4) then +! if (fveg(nc,nv,nz)>1.e-4) then this_filter(1)%num_exposedvegp = this_filter(1)%num_exposedvegp + 1 this_filter(1)%exposedvegp(this_filter(1)%num_exposedvegp) = np From b51fb7c7e85e8edcf61a4ee1854231d828599c5e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 6 Jul 2023 08:51:14 -0400 Subject: [PATCH 517/589] fix restart variable size check --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index a2824716d..f0ef2db23 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -530,7 +530,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort if ((cold_start.eqv..false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) then + (size(cnpft,4).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 0fd61a59a..11d384e5d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -102,7 +102,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort if ((cold_start.eqv..false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) then + (size(cnpft,4).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 1c2519407..01d3b5861 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -263,7 +263,7 @@ subroutine Init(this,bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,rc) ! jkolassa: if cold_start is false, check that both CNCOL and CNPFT have the expected size for CNCLM50, else abort if ((cold_start.eqv..false.) .and. ((size(cncol,3).ne.var_col) .or. & - (size(cnpft,3).ne.var_pft))) then + (size(cnpft,4).ne.var_pft))) then _ASSERT(.FALSE.,'option CNCLM50_cold_start = .FALSE. requires a CNCLM50 restart file') end if From 2b1e551691ebeb8549f9618f32ab5c264f814914 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 6 Jul 2023 09:55:57 -0400 Subject: [PATCH 518/589] remove print statement that is no longer needed --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 025cb86a8..fcfba305b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -6906,7 +6906,6 @@ subroutine Driver ( RC ) else first_cn = is_first_step(.false.) end if - print *, 'first_cn: ', first_cn ! fzeng: pass current date_time to the CN routines. call upd_curr_date_time( AGCM_YY, AGCM_MM, AGCM_DD, dofyr, & From 0421a806267bae7928c5fb313f03be5fc0f438dc Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 11 Jul 2023 14:57:56 -0400 Subject: [PATCH 519/589] bug fix in aggregation to gridcell level --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 5 +++++ .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index f0ef2db23..811eae567 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1117,6 +1117,11 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, carbon_type, cn5_co do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + this%gpp_patch(p) = 0._r8 + this%excess_cflux_patch(p) = 0._r8 + this%leafc_to_litter_fun_patch(p) = 0._r8 + this%plant_calloc_patch(p) = 0._r8 + ! "old" variables: CNCLM45 and before this%annsum_npp_patch (np) = cnpft(nc,nz,nv, 26) this%prev_frootc_to_litter_patch (np) = cnpft(nc,nz,nv, 41) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index e110b6ad5..3f6389c1f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -436,7 +436,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m do np = 0,numpft ! PFT index loop p = p + 1 do nv = 1,num_veg ! defined veg loop - if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then + if(ityp(nc,nv,nz)==np .and. fveg(nc,nv,nz)>1.e-4) then zlai(nc,nv,nz) = canopystate_inst%elai_patch(p) zsai(nc,nv,nz) = canopystate_inst%esai_patch(p) From b7c8845306e59458efc0f9a619eedeef3d96e279 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 12 Sep 2023 08:25:40 -0400 Subject: [PATCH 520/589] change calculation of soil to root conductance in first soil layer --- .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 01d3b5861..a9d6deb43 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -1674,7 +1674,8 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & if(rai(j)*rootfr(p,j) > 0._r8 .and. j > 1) then k_soil_root(p,j) = 1._r8/rs_resis else - k_soil_root(p,j) = 0. + !k_soil_root(p,j) = 0. + k_soil_root(p,j) = 1._r8/rs_resis endif end do From b0f5214aa0650d64cfb4b7a3615ad93c831055d1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 12 Sep 2023 09:03:24 -0400 Subject: [PATCH 521/589] change long_name for CDCR2 --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index fcfba305b..10e88f9af 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -916,7 +916,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'max_water_content' ,& + LONG_NAME = 'max_soil_water_content_above_wilting_point' ,& UNITS = 'kg m-2' ,& SHORT_NAME = 'CDCR2' ,& FRIENDLYTO = trim(COMP_NAME) ,& From aa710dcb0c800a6e2385f491380c6c8945afb2a5 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 12 Sep 2023 14:04:10 -0400 Subject: [PATCH 522/589] manually add wrapper and other missing changes --- .../GEOS_CatchCNCLM51GridComp.F90 | 349 ++++++++++-------- 1 file changed, 193 insertions(+), 156 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 10e88f9af..f03588f21 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -71,6 +71,7 @@ module GEOS_CatchCNCLM51GridCompMod use update_model_para4cn, only : upd_curr_date_time use WaterType use CNVegetationFacade + use catch_wrap_stateMod implicit none private @@ -168,26 +169,6 @@ module GEOS_CatchCNCLM51GridCompMod ! index map for CLM PFTs --> catchment veg types -! pchakrab: save the logical variable OFFLINE -! Internal state and its wrapper -type T_OFFLINE_MODE - private - integer :: CATCH_OFFLINE -end type T_OFFLINE_MODE -type OFFLINE_WRAP - type(T_OFFLINE_MODE), pointer :: ptr=>null() -end type OFFLINE_WRAP - -integer :: RUN_IRRIG, USE_ASCATZ0, Z0_FORMULATION, IRRIG_METHOD, AEROSOL_DEPOSITION, N_CONST_LAND4SNWALB -integer :: ATM_CO2, CHOOSEMOSFC -real :: SURFLAY ! Default (Ganymed-3 and earlier) SURFLAY=20.0 for Old Soil Params - ! (Ganymed-4 and later ) SURFLAY=50.0 for New Soil Params -real :: CO2 -integer :: CO2_YEAR_IN ! years when atmospheric carbon dioxide concentration increases, starting from 1850 -real :: DTCN ! Time step for carbon/nitrogen routines in CatchmentCN model (default 5400) -real :: FWETC, FWETL -logical :: USE_FWET_FOR_RUNOFF - contains !BOP @@ -218,9 +199,7 @@ subroutine SetServices ( GC, RC ) ! Local Variables type(MAPL_MetaComp), pointer :: MAPL=>null() - type(T_OFFLINE_MODE), pointer :: internal=>null() - type(OFFLINE_WRAP) :: wrap - integer :: OFFLINE_MODE + integer :: OFFLINE_MODE, RUN_IRRIG, ATM_CO2, N_CONST_LAND4SNWALB integer :: RESTART character(len=ESMF_MAXSTR) :: SURFRC type(ESMF_Config) :: SCF @@ -241,65 +220,14 @@ subroutine SetServices ( GC, RC ) ! unusual to read resource file in SetServices, but we need to know ! at this stage where we are running Catch in the offline mode or not - allocate(internal, stat=status) - VERIFY_(status) - wrap%ptr => internal - call ESMF_UserCompSetInternalState(gc, 'OfflineMode', wrap, status) - call MAPL_GetObjectFromGC(gc, MAPL, rc=status) VERIFY_(status) - call MAPL_GetResource ( MAPL, OFFLINE_MODE, Label="CATCHMENT_OFFLINE:", DEFAULT=0, RC=STATUS) - VERIFY_(STATUS) - wrap%ptr%CATCH_OFFLINE = OFFLINE_MODE - - call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetResource (MAPL, SURFRC, label = 'SURFRC:', default = 'GEOS_SurfaceGridComp.rc', RC=STATUS) ; VERIFY_(STATUS) - SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) - call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) - - call MAPL_GetResource (SCF, SURFLAY, label='SURFLAY:', DEFAULT=50., __RC__ ) - call MAPL_GetResource (SCF, Z0_FORMULATION, label='Z0_FORMULATION:', DEFAULT=4, __RC__ ) - call MAPL_GetResource (SCF, USE_ASCATZ0, label='USE_ASCATZ0:', DEFAULT=0, __RC__ ) - call MAPL_GetResource (SCF, RUN_IRRIG, label='RUN_IRRIG:', DEFAULT=0, __RC__ ) - call MAPL_GetResource (SCF, IRRIG_METHOD, label='IRRIG_METHOD:', DEFAULT=0, __RC__ ) - call MAPL_GetResource (SCF, CHOOSEMOSFC, label='CHOOSEMOSFC:', DEFAULT=1, __RC__ ) - call MAPL_GetResource (SCF, USE_FWET_FOR_RUNOFF, label='USE_FWET_FOR_RUNOFF:', DEFAULT=.FALSE., __RC__ ) - - if (.NOT. USE_FWET_FOR_RUNOFF) then - call MAPL_GetResource (SCF, FWETC, label='FWETC:', DEFAULT= 0.02, __RC__ ) - call MAPL_GetResource (SCF, FWETL, label='FWETL:', DEFAULT= 0.02, __RC__ ) - else - call MAPL_GetResource (SCF, FWETC, label='FWETC:', DEFAULT=0.005, __RC__ ) - call MAPL_GetResource (SCF, FWETL, label='FWETL:', DEFAULT=0.025, __RC__ ) - endif - - ! GOSWIM ANOW_ALBEDO - ! 0 : GOSWIM snow albedo scheme is turned off - ! 9 : i.e. N_CONSTIT in Stieglitz to turn on GOSWIM snow albedo scheme - call MAPL_GetResource (SCF, N_CONST_LAND4SNWALB, label='N_CONST_LAND4SNWALB:', DEFAULT=0 , __RC__ ) - - ! Get parameters to zero the deposition rate - ! 1: Use all GOCART aerosol values, 0: turn OFF everythying, - ! 2: turn off dust ONLY,3: turn off Black Carbon ONLY,4: turn off Organic Carbon ONLY - ! __________________________________________ - call MAPL_GetResource (SCF, AEROSOL_DEPOSITION, label='AEROSOL_DEPOSITION:' , DEFAULT=0 , __RC__ ) - - ! CATCHCN - call MAPL_GetResource (SCF, DTCN, label='DTCN:', DEFAULT=5400. , __RC__ ) - ! ATM_CO2 - ! 0: uses a fix value defined by CO2 - ! 1: CT tracker monthly mean diurnal cycle - ! 2: CT tracker monthly mean diurnal cycle scaled to match EEA global average CO2 - ! 3: spatially fixed interannually varyiing CMIP from getco2.F90 look up table (AGCM only) - ! 4: import AGCM model CO2 (AGCM only) - call MAPL_GetResource (SCF, ATM_CO2, label='ATM_CO2:', DEFAULT=2 , __RC__ ) - - ! Global mean CO2 - call MAPL_GetResource (SCF, CO2, label='CO2:', DEFAULT=350.e-6, __RC__ ) - call MAPL_GetResource (SCF, CO2_YEAR_IN, label='CO2_YEAR:', DEFAULT= -9999, __RC__ ) - call ESMF_ConfigDestroy(SCF, __RC__) + call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, _RC) + call MAPL_GetResource ( MAPL, OFFLINE_MODE, Label="CATCHMENT_OFFLINE:", DEFAULT=0, _RC) + call MAPL_GetResource ( MAPL, ATM_CO2, Label="ATM_CO2:", _RC) + call MAPL_GetResource ( MAPL, N_CONST_LAND4SNWALB, Label="N_CONST_LAND4SNWALB:", _RC) + call MAPL_GetResource ( MAPL, RUN_IRRIG, Label="RUN_IRRIG:", _RC) ! Set the Run entry points ! ------------------------ @@ -1839,6 +1767,28 @@ subroutine SetServices ( GC, RC ) RESTART = MAPL_RestartOptional ,& RC=STATUS ) VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for sunlit leaf maintenance respiration',& + UNITS = 'umol CO2 m-2 s-1' ,& + SHORT_NAME = 'LMRSUNM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_VEG,NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for shaded leaf maintenance respiration',& + UNITS = 'umol CO2 m-2 s-1' ,& + SHORT_NAME = 'LMRSHAM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_VEG,NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for snow depth' ,& @@ -1930,6 +1880,17 @@ subroutine SetServices ( GC, RC ) RESTART = MAPL_RestartOptional ,& RC=STATUS ) VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC, & + LONG_NAME = 'overland_runoff_including_throughflow' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'RUNSURF' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) !---------- GOSWIM snow impurity related variables ---------- @@ -3926,7 +3887,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Offline mode - type(OFFLINE_WRAP) :: wrap + type(CATCHCN_WRAP) :: wrap + type(T_CATCHCN_STATE), pointer :: catchcn_internal integer :: OFFLINE_MODE, CHOOSEZ0 !============================================================================= @@ -3943,9 +3905,10 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) Iam=trim(COMP_NAME)//"::RUN1" ! Get component's offline mode from its pvt internal state - call ESMF_UserCompGetInternalState(gc, 'OfflineMode', wrap, status) + call ESMF_UserCompGetInternalState(gc, 'CatchcnInternal', wrap, status) VERIFY_(status) - OFFLINE_MODE = wrap%ptr%CATCH_OFFLINE + catchcn_internal=>wrap%ptr + OFFLINE_MODE = catchcn_internal%CATCH_OFFLINE call ESMF_VMGetCurrent ( VM, RC=STATUS ) ! if (MAPL_AM_I_Root(VM)) print *, trim(Iam)//'::OFFLINE mode: ', is_OFFLINE @@ -4324,7 +4287,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! are the same for all subtiles. Z0T(:,N) = Z0_BY_ZVEG*ZVG - IF (USE_ASCATZ0 == 1) THEN + IF (catchcn_internal%USE_ASCATZ0 == 1) THEN WHERE (NDVI <= 0.2) Z0T(:,N) = ASCATZ0 END WHERE @@ -4340,13 +4303,13 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) !------------------------------------------------- call MAPL_TimerOn(MAPL,"-SURF") - if(CHOOSEMOSFC.eq.0) then + if(catchcn_internal%CHOOSEMOSFC.eq.0) then WW(:,N) = 0. CM(:,N) = 0. call louissurface(3,N,UU,WW,PS,TA,TC,QA,QC,PCU,LAI,Z0T,DZE,CM,CN,RIB,ZT,ZQ,CH,CQ,UUU,UCN,RE,DCH,DCQ) - elseif (CHOOSEMOSFC.eq.1)then + elseif (catchcn_internal%CHOOSEMOSFC.eq.1)then niter = 6 ! number of internal iterations in the helfand MO surface layer routine IWATER = 3 @@ -4727,6 +4690,8 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: cnsum real, dimension(:,:,:), pointer :: psnsunm real, dimension(:,:,:), pointer :: psnsham + real, dimension(:,:,:), pointer :: lmrsunm + real, dimension(:,:,:), pointer :: lmrsham real, dimension(:), pointer :: sndzm real, dimension(:), pointer :: sndzm5d real, dimension(:), pointer :: asnowm @@ -5010,7 +4975,7 @@ subroutine Driver ( RC ) type(ESMF_Config) :: CF type(MAPL_SunOrbit) :: ORBIT - type(ESMF_Time) :: CURRENT_TIME, StopTime, NextTime + type(ESMF_Time) :: CURRENT_TIME, StopTime, NextTime, NextRecordTime type(ESMF_Time) :: BEFORE type(ESMF_Time) :: NOW type(ESMF_Time) :: MODELSTART @@ -5048,14 +5013,18 @@ subroutine Driver ( RC ) ! Offline case - type(OFFLINE_WRAP) :: wrap + type(CATCHCN_WRAP) :: wrap + type(T_CATCHCN_STATE), pointer :: catchcn_internal integer :: OFFLINE_MODE real,dimension(:,:),allocatable :: ALWN, BLWN - ! un-adelterated TC's and QC's + ! unadulterated TC's and QC's real, pointer :: TC1_0(:), TC2_0(:), TC4_0(:) real, pointer :: QA1_0(:), QA2_0(:), QA4_0(:) real, pointer :: PLSIN(:) + ! CATCHMENT_SPINUP + integer :: CurrMonth, CurrDay, CurrHour, CurrMin, CurrSec + ! -------------------------------------------------------------------------- ! Lookup tables ! -------------------------------------------------------------------------- @@ -5148,7 +5117,6 @@ subroutine Driver ( RC ) real, allocatable, dimension(:) :: totwat ! total soil liquid water (kg/m2) real, save :: ashift = 0. ! for baseflow. gkw: this should match value in routine "base" in catchment - real, allocatable, dimension(:), save :: runsrf ! surface runoff (kg/m2/s) real :: Qair_sat ! saturated specific humidity (kg/kg) real, allocatable, dimension(:) :: Qair_relative ! relative humidity (%) @@ -5161,7 +5129,6 @@ subroutine Driver ( RC ) ! static summing arrays for CN ! ---------------------------- - real, allocatable, dimension(:,:,:), save :: lmrsunm, lmrsham real, allocatable, dimension(:) :: ht, tp, soilice real :: zbar, frice @@ -5169,9 +5136,9 @@ subroutine Driver ( RC ) real, allocatable, dimension(:,:,:) :: pft real, allocatable, dimension(:) :: lnfm - character(len=ESMF_MAXSTR) :: LNFMFile + character(len=ESMF_MAXSTR) :: LNFMFile, CO2_CycleFile - integer :: ntile, nv, dpy, ierr, iok + integer :: ntile, nv, dpy, ierr, iok, ndt integer, save :: year_prev = -9999 integer, save :: n1d ! number of land model steps in a 1-day period @@ -5208,9 +5175,11 @@ subroutine Driver ( RC ) real, allocatable, dimension(:) :: ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp real, allocatable, dimension(:) :: SNOVR_tmp, SNONR_tmp, SNOVF_tmp, SNONF_tmp + logical :: record + type(ESMF_Alarm) :: RecordAlarm + ! Variables for FPAR real , allocatable, dimension (:,:,:) :: parzone - character(len=ESMF_MAXSTR) :: Co2_CycleFile integer :: cn_count = 0 logical :: first_cn @@ -5219,6 +5188,8 @@ subroutine Driver ( RC ) ! Begin + IAm=trim(COMP_NAME)//"Driver" + ! -------------------------------------------------------------------------- ! Get time step from configuration ! -------------------------------------------------------------------------- @@ -5243,13 +5214,13 @@ subroutine Driver ( RC ) VERIFY_(STATUS) ! Get component's private internal state - call ESMF_UserCompGetInternalState(gc, 'OfflineMode', wrap, status) + call ESMF_UserCompGetInternalState(gc, 'CatchcnInternal', wrap, status) VERIFY_(status) + catchcn_internal => wrap%ptr + OFFLINE_MODE = catchcn_internal%CATCH_OFFLINE + ! if (MAPL_AM_I_Root(VM)) print *, trim(Iam)//'::OFFLINE mode: ', is_OFFLINE call ESMF_VMGetCurrent ( VM, RC=STATUS ) - ! Component's offline mode - OFFLINE_MODE = wrap%ptr%CATCH_OFFLINE - ! if (MAPL_AM_I_Root(VM)) print *, trim(Iam)//'::OFFLINE mode: ', is_OFFLINE ! -------------------------------------------------------------------------- ! Get parameters from generic state. @@ -5297,7 +5268,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(IMPORT,QHATM ,'QHATM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,CTATM ,'CTATM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,CQATM ,'CQATM' ,RC=STATUS); VERIFY_(STATUS) - IF (ATM_CO2 == 4) call MAPL_GetPointer(IMPORT,CO2SC ,'CO2SC' ,RC=STATUS); VERIFY_(STATUS) + IF (catchcn_internal%ATM_CO2 == 4) call MAPL_GetPointer(IMPORT,CO2SC ,'CO2SC' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,LAI ,'LAI' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,GRN ,'GRN' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT,ROOTL ,'ROOTL' ,RC=STATUS); VERIFY_(STATUS) @@ -5419,6 +5390,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,CNSUM ,'CNSUM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,PSNSUNM ,'PSNSUNM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,PSNSHAM ,'PSNSHAM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,LMRSUNM ,'LMRSUNM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,LMRSHAM ,'LMRSHAM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,SNDZM ,'SNDZM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,SNDZM5D ,'SNDZM5D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,ASNOWM ,'ASNOWM' ,RC=STATUS); VERIFY_(STATUS) @@ -5428,8 +5401,9 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,RH30D ,'RH30D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC10D ,'TPREC10D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC60D ,'TPREC60D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,RUNSURF ,'RUNSURF' ,RC=STATUS); VERIFY_(STATUS) - if (N_CONST_LAND4SNWALB /= 0) then + if (catchcn_internal%N_CONST_LAND4SNWALB /= 0) then call MAPL_GetPointer(INTERNAL,RDU001 ,'RDU001' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,RDU002 ,'RDU002' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,RDU003 ,'RDU003' , RC=STATUS); VERIFY_(STATUS) @@ -5441,7 +5415,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,ROC002 ,'ROC002' , RC=STATUS); VERIFY_(STATUS) endif - IF (RUN_IRRIG /= 0) THEN + IF (catchcn_internal%RUN_IRRIG /= 0) THEN call MAPL_GetPointer(INTERNAL,IRRIGFRAC ,'IRRIGFRAC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,PADDYFRAC ,'PADDYFRAC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,LAIMAX ,'LAIMAX' , RC=STATUS); VERIFY_(STATUS) @@ -5606,7 +5580,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,PEATCLSM_WATERLEVEL,'PEATCLSM_WATERLEVEL' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,PEATCLSM_FSWCHANGE ,'PEATCLSM_FSWCHANGE' , RC=STATUS); VERIFY_(STATUS) - IF (RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) + IF (catchcn_internal%RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) NTILES = size(PS) @@ -5638,13 +5612,13 @@ subroutine Driver ( RC ) ! variables used for summing CN inputs over multiple land model calls; not saved on restart ! fzeng: run must end on a CN call step ! ----------------------------------------------------------------------------------------- - allocate( lmrsunm(ntiles,nveg,nzone) ) - allocate( lmrsham(ntiles,nveg,nzone) ) - allocate( runsrf(ntiles) ) - - lmrsunm = 0. - lmrsham = 0. - runsrf = 0. +! allocate( lmrsunm(ntiles,nveg,nzone) ) +! allocate( lmrsham(ntiles,nveg,nzone) ) +! allocate( runsrf(ntiles) ) +! +! lmrsunm = 0. +! lmrsham = 0. +! runsrf = 0. first = .false. @@ -5665,7 +5639,7 @@ subroutine Driver ( RC ) ! OPTIONAL IMPOSE MONTHLY MEAN DIURNAL CYCLE FROM NOAA CARBON TRACKER ! ------------------------------------------------------------------- - IF ((ATM_CO2 == 1).OR.(ATM_CO2 == 2)) THEN + IF ((catchcn_internal%ATM_CO2 == 1).OR.(catchcn_internal%ATM_CO2 == 2)) THEN READ_CT_CO2: IF(first_ct) THEN ! Carbon Tracker grid tiles mapping @@ -5720,9 +5694,8 @@ subroutine Driver ( RC ) call MPI_Info_create(info, STATUS); VERIFY_(status) call MPI_Info_set(info, "romio_cb_read", "automatic", STATUS); VERIFY_(status) - call MAPL_GetResource (MAPL, CO2_CycleFile, label = 'CO2_MonthlyMean_DiurnalCycle_FILE:', & - default = 'CO2_MonthlyMean_DiurnalCycle.nc4', RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GetResource (MAPL, CO2_CycleFile, label = 'CO2_MonthlyMean_DiurnalCycle_FILE:', default = 'CO2_MonthlyMean_DiurnalCycle.nc4', RC=STATUS ) + VERIFY_(STATUS) STATUS = NF_OPEN (trim(CO2_CycleFile), NF_NOWRITE, CTfile); VERIFY_(status) @@ -5856,6 +5829,73 @@ subroutine Driver ( RC ) allocate(ta_count (NTILES)) call ESMF_VMGetCurrent ( VM, RC=STATUS ) + + debugzth = .false. + + ! -------------------------------------------------------------------------- + ! Get the current time. + ! -------------------------------------------------------------------------- + + call ESMF_ClockGet( CLOCK, currTime=CURRENT_TIME, startTime=MODELSTART, TIMESTEP=DELT, RC=STATUS ) + VERIFY_(STATUS) + if (MAPL_AM_I_Root(VM).and.debugzth) then + print *,' start time of clock ' + CALL ESMF_TimePrint ( MODELSTART, OPTIONS="string", RC=STATUS ) + endif + + ! -------------------------------------------------------------------------- + ! Offline land spin-up. + ! -------------------------------------------------------------------------- + + if (CATCHCN_INTERNAL%CATCH_SPINUP /= 0) then + + ! remove snow every Aug 1, 0z (Northern Hemisphere) or Feb 1, 0z (Southern Hemisphere) + ! + ! assumes that CURRENT_TIME actually hits 0z on first of month (which seems safe enough) + + call ESMF_TimeGet(CURRENT_TIME, mm=CurrMonth, dd=CurrDay, h=CurrHour, m=CurrMin, s=CurrSec, rc=STATUS) + VERIFY_(STATUS) + + if (CurrDay==1 .and. CurrHour==0 .and. CurrMin==0 .and. CurrSec==0) then + + if (CurrMonth==8) then + + where ( LATS >= 0. ) ! [radians] + + WESNN1 = 0. + WESNN2 = 0. + WESNN3 = 0. + HTSNNN1 = 0. + HTSNNN2 = 0. + HTSNNN3 = 0. + SNDZN1 = 0. + SNDZN2 = 0. + SNDZN3 = 0. + + end where + + else if (CurrMonth==2) then + + where ( LATS < 0. ) ! [radians] + + WESNN1 = 0. + WESNN2 = 0. + WESNN3 = 0. + HTSNNN1 = 0. + HTSNNN2 = 0. + HTSNNN3 = 0. + SNDZN1 = 0. + SNDZN2 = 0. + SNDZN3 = 0. + + end where + + end if + + end if ! 0z on first of month + + end if ! if (CATCHCN_INTERNAL%CATCH_SPINUP /= 0) + ! -------------------------------------------------------------------------- ! Catchment Id and vegetation types used to index into tables ! -------------------------------------------------------------------------- @@ -5902,7 +5942,7 @@ subroutine Driver ( RC ) ! surface layer depth for soil moisture ! -------------------------------------------------------------------------- - DZSF( :) = SURFLAY + DZSF( :) = catchcn_internal%SURFLAY ! -------------------------------------------------------------------------- ! build arrays from internal state @@ -5927,19 +5967,6 @@ subroutine Driver ( RC ) SNDZN (2,:) = SNDZN2 SNDZN (3,:) = SNDZN3 - debugzth = .false. - - ! -------------------------------------------------------------------------- - ! Get the current time. - ! -------------------------------------------------------------------------- - - call ESMF_ClockGet( CLOCK, currTime=CURRENT_TIME, startTime=MODELSTART, TIMESTEP=DELT, RC=STATUS ) - VERIFY_(STATUS) - if (MAPL_AM_I_Root(VM).and.debugzth) then - print *,' start time of clock ' - CALL ESMF_TimePrint ( MODELSTART, OPTIONS="string", RC=STATUS ) - endif - ! -------------------------------------------------------------------------- ! retrieve the zenith angle ! -------------------------------------------------------------------------- @@ -6007,7 +6034,7 @@ subroutine Driver ( RC ) !--------------------------------------------------- Z0 = Z0_BY_ZVEG*ZVG - IF (USE_ASCATZ0 == 1) WHERE (NDVI <= 0.2) Z0 = ASCATZ0 + IF (catchcn_internal%USE_ASCATZ0 == 1) WHERE (NDVI <= 0.2) Z0 = ASCATZ0 D0 = D0_BY_ZVEG*ZVG UUU = max(UU,MAPL_USMIN) * (log((ZVG-D0+Z0)/Z0) & @@ -6022,7 +6049,7 @@ subroutine Driver ( RC ) ! Zero the light-absorbing aerosol (LAA) deposition rates from GOCART: - select case (AEROSOL_DEPOSITION) + select case (catchcn_internal%AEROSOL_DEPOSITION) case (0) DUDP(:,:)=0. DUSV(:,:)=0. @@ -6095,7 +6122,7 @@ subroutine Driver ( RC ) ! --------------- GOSWIM PROGRNOSTICS --------------------------- - if (N_CONST_LAND4SNWALB /= 0) then + if (catchcn_internal%N_CONST_LAND4SNWALB /= 0) then ! Conversion of the masses of the snow impurities ! Note: Explanations of each variable @@ -6183,7 +6210,7 @@ subroutine Driver ( RC ) ALWN(:,N) = -3.0*BLWN(:,N)*TC(:,N) BLWN(:,N) = 4.0*BLWN(:,N) end do - if(CHOOSEMOSFC==0 .and. incl_Louis_extra_derivs ==1) then + if(catchcn_internal%CHOOSEMOSFC==0 .and. incl_Louis_extra_derivs ==1) then do N=1,NUM_SUBTILES DEVSBT(:,N)=CQ(:,N)+max(0.0,-DCQ(:,N)*MAPL_VIREPS*TC(:,N)*(QC(:,N)-QA)) DEDTC(:,N) =max(0.0,-DCQ(:,N)*(1.+MAPL_VIREPS*QC(:,N))*(QC(:,N)-QA)) @@ -6367,7 +6394,7 @@ subroutine Driver ( RC ) ! Thus moved reading lnfm here ! ------------------------------------------------ - if(mod(AGCM_S_ofday,nint(dtcn)) == 0) then + if(mod(AGCM_S_ofday,nint(catchcn_internal%DTCN)) == 0) then ! Get lightening frequency clim file name from configuration call MAPL_GetResource ( MAPL, LNFMFILE, label = 'LNFM_FILE:', default = 'lnfm.dat', RC=STATUS ) VERIFY_(STATUS) @@ -6625,14 +6652,14 @@ subroutine Driver ( RC ) ! get CO2 ! ------- - if(ATM_CO2 == 3) CO2 = GETCO2(AGCM_YY,dofyr) + if(catchcn_internal%ATM_CO2 == 3) catchcn_internal%CO2 = GETCO2(AGCM_YY,dofyr) - CO2V (:) = CO2 + CO2V (:) = catchcn_internal%CO2 ! use CO2SC from GOCART/CO2 ! ------------------------- - IF (ATM_CO2 == 4) THEN + IF (catchcn_internal%ATM_CO2 == 4) THEN where ((CO2SC >= 0.) .and. (CO2SC <= 1000.)) CO2V = CO2SC * 1e-6 @@ -6640,13 +6667,13 @@ subroutine Driver ( RC ) endif - IF(ATM_CO2 == 1) co2g = 1. ! DO NOT SCALE USE CT CLIMATOLOGY + IF(catchcn_internal%ATM_CO2 == 1) co2g = 1. ! DO NOT SCALE USE CT CLIMATOLOGY - CALC_CTCO2_SF: IF(ATM_CO2 == 2) THEN + CALC_CTCO2_SF: IF(catchcn_internal%ATM_CO2 == 2) THEN ! Compute scale factor to scale CarbonTracker CO2 monthly mean diurnal cycle (3-hourly) CO2_YEAR = AGCM_YY - IF(CO2_YEAR_IN > 0) CO2_YEAR = CO2_YEAR_IN + IF(catchcn_internal%CO2_YEAR_IN > 0) CO2_YEAR = catchcn_internal%CO2_YEAR_IN ! update EEA global average CO2 and co2 scalar at the beginning of each year, fz, 26 Sep 2016 ! ------------------------------------------------------------------------------------------- @@ -6665,7 +6692,7 @@ subroutine Driver ( RC ) ENDIF CALC_CTCO2_SF - USE_CT_CO2: IF((ATM_CO2 == 1).OR.(ATM_CO2 == 2)) THEN + USE_CT_CO2: IF((catchcn_internal%ATM_CO2 == 1).OR.(catchcn_internal%ATM_CO2 == 2)) THEN IF(AGCM_DD < 16) THEN @@ -6738,7 +6765,7 @@ subroutine Driver ( RC ) BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo ALBVR, ALBNR, ALBVF, ALBNF, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles - call SNOW_ALBEDO(ntiles, N_snow, N_CONST_LAND4SNWALB, ityp_tmp, & + call SNOW_ALBEDO(ntiles, N_snow, catchcn_internal%N_CONST_LAND4SNWALB, ityp_tmp, & elai(:,nv,nz), ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & @@ -6816,7 +6843,7 @@ subroutine Driver ( RC ) call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSNNN(1,:), WESNN(1,:), TPSN1OUT1, FICE1) TPSN1OUT1 = TPSN1OUT1 + Tzero - call SNOW_ALBEDO(NTILES,N_snow, N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & + call SNOW_ALBEDO(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & WESNN, HTSNNN, SNDZN, & @@ -6828,7 +6855,7 @@ subroutine Driver ( RC ) BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles - call SNOW_ALBEDO(NTILES,N_snow, N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & + call SNOW_ALBEDO(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & WESNN, HTSNNN, SNDZN, & @@ -6867,8 +6894,8 @@ subroutine Driver ( RC ) ! CN time step over 4 hours may fail; limit to 4 hours; verify that DTCN is a multiple of DT ! ------------------------------------------------------------------------------------------ - dtcn = min(dtcn,14400.) - if(mod(dtcn,dt) /= 0) stop 'dtcn' + catchcn_internal%DTCN = min(catchcn_internal%DTCN,14400.) + if(mod(catchcn_internal%DTCN,dt) /= 0) stop 'dtcn' ! sum over interval for CN ! ------------------------ @@ -6896,7 +6923,7 @@ subroutine Driver ( RC ) ! call CN model every DTCN seconds ! -------------------------------- - if(mod(AGCM_S_ofday,nint(dtcn)) == 0) then + if(mod(AGCM_S_ofday,nint(catchcn_internal%DTCN)) == 0) then cn_count = cn_count + 1 @@ -7088,6 +7115,13 @@ subroutine Driver ( RC ) ! copy CN_restart vars to catch_internal_rst gkw: only do if stopping ! ------------------------------------------ + record = .false. + call ESMF_ClockGetAlarm ( CLOCK, alarmname="RecordAlarm001", ALARM=RecordAlarm, RC=STATUS ) + if (status == 0) then + call ESMF_AlarmGet( RecordAlarm, RingTime = NextRecordTime, _RC) + if (NextTime == NextRecordTime) record = .true. + endif + if(NextTime == StopTime) then call CN_exit(ntile,ityp,fveg,cncol,cnpft) @@ -7221,14 +7255,14 @@ subroutine Driver ( RC ) ! Call Irrigation Model ! -------------------------------------------------------------------------- - IF ((RUN_IRRIG /= 0).AND.(ntiles >0)) THEN + IF ((catchcn_internal%RUN_IRRIG /= 0).AND.(ntiles >0)) THEN CALL CATCH_CALC_SOIL_MOIST ( & NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, CAR1, CAR2, CAR4, sfmc, rzmc, prmc) - call irrigation_rate (IRRIG_METHOD, & + call irrigation_rate (catchcn_internal%IRRIG_METHOD, & NTILES, AGCM_HH, AGCM_MI, AGCM_S, lons, IRRIGFRAC, PADDYFRAC, & CLMPT,CLMST, CLMPF, CLMSF, LAIMAX, LAIMIN, LAI0, & POROS, WPWET, VGWMAX, RZMC, IRRIGRATE) @@ -7335,7 +7369,7 @@ subroutine Driver ( RC ) call WRITE_PARALLEL(NT_GLOBAL, UNIT) call WRITE_PARALLEL(DT, UNIT) - call WRITE_PARALLEL(USE_FWET_FOR_RUNOFF, UNIT) + call WRITE_PARALLEL(catchcn_internal%USE_FWET_FOR_RUNOFF, UNIT) call MAPL_VarWrite(unit, tilegrid, LONS, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, LATS, mask=mask, rc=status); VERIFY_(STATUS) call MAPL_VarWrite(unit, tilegrid, VEG1, mask=mask, rc=status); VERIFY_(STATUS) @@ -7420,8 +7454,8 @@ subroutine Driver ( RC ) ! ----------------------- if (ntiles > 0) then - call CATCHCN ( NTILES, LONS, LATS, DT,USE_FWET_FOR_RUNOFF, & - FWETC, FWETL, cat_id, VEG1,VEG2,FVEG1,FVEG2,DZSF ,& + call CATCHCN ( NTILES, LONS, LATS, DT,catchcn_internal%USE_FWET_FOR_RUNOFF, & + catchcn_internal%FWETC, catchcn_internal%FWETL, cat_id, VEG1,VEG2,FVEG1,FVEG2,DZSF ,& PCU , PLSIN , SNO, ICE, FRZR ,& UUU ,& @@ -7503,9 +7537,6 @@ subroutine Driver ( RC ) TP5 = TP5 + MAPL_TICE TP6 = TP6 + MAPL_TICE - - runsrf = RUNSURF ! for N leaching, fzeng - end if if (OFFLINE_MODE /=0) then @@ -7552,7 +7583,7 @@ subroutine Driver ( RC ) call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSNNN(1,:), WESNN(1,:), TPSN1OUT1, FICE1) TPSN1OUT1 = TPSN1OUT1 + Tzero - call SNOW_ALBEDO(NTILES,N_snow, N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & + call SNOW_ALBEDO(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & WESNN, HTSNNN, SNDZN, & @@ -7565,7 +7596,7 @@ subroutine Driver ( RC ) ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles - call SNOW_ALBEDO(NTILES,N_snow, N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & + call SNOW_ALBEDO(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & WESNN, HTSNNN, SNDZN, & @@ -7771,7 +7802,7 @@ subroutine Driver ( RC ) SNDZN2 = SNDZN (2,:) SNDZN3 = SNDZN (3,:) - if (N_CONST_LAND4SNWALB /= 0) then + if (catchcn_internal%N_CONST_LAND4SNWALB /= 0) then RDU001(:,:) = RCONSTIT(:,:,1) RDU002(:,:) = RCONSTIT(:,:,2) RDU003(:,:) = RCONSTIT(:,:,3) @@ -8181,6 +8212,9 @@ subroutine RUN0(gc, import, export, clock, rc) real, allocatable :: fveg(:,:,:), elai(:,:,:), esai(:,:,:), wtzone(:,:), lai1(:), lai2(:), wght(:) real, allocatable,dimension(:) :: fveg1, fveg2 + type(T_CATCHCN_STATE), pointer :: catchcn_internal + type(CATCHCN_WRAP) :: wrap + ! Begin... ! Get component name and setup traceback handle @@ -8196,6 +8230,9 @@ subroutine RUN0(gc, import, export, clock, rc) call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) VERIFY_(status) + call ESMF_UserCompGetInternalState(gc, 'CatchcnInternal', wrap, status) + VERIFY_(status) + catchcn_internal => wrap%ptr ! Pointers to IMPORTs call MAPL_GetPointer(import, ps, 'PS', rc=status) VERIFY_(status) @@ -8372,7 +8409,7 @@ subroutine RUN0(gc, import, export, clock, rc) ! -step-1- allocate(dzsf(ntiles), stat=status) VERIFY_(status) - dzsf = SURFLAY + dzsf = catchcn_internal%SURFLAY ! -step-2- allocate(ar1(ntiles), stat=status) From 73ce2cb4aa474f8753e42089f36a503b3de37b14 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 12 Sep 2023 14:46:02 -0400 Subject: [PATCH 523/589] bug fixes --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index f03588f21..ba1b8f38e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -201,8 +201,6 @@ subroutine SetServices ( GC, RC ) type(MAPL_MetaComp), pointer :: MAPL=>null() integer :: OFFLINE_MODE, RUN_IRRIG, ATM_CO2, N_CONST_LAND4SNWALB integer :: RESTART - character(len=ESMF_MAXSTR) :: SURFRC - type(ESMF_Config) :: SCF ! Begin... ! -------- @@ -6912,7 +6910,7 @@ subroutine Driver ( RC ) windm = windm + UU rainfm = rainfm + (PCU + PLS) snowfm = snowfm + SNO - runsrfm = runsrfm + runsrf + runsrfm = runsrfm + RUNSURF ar1m = ar1m + car1 do n = 1,N_snow sndzm(:) = sndzm(:) + sndzn(n,:) From 88554333559db163d1298ed4b5fc13c9411921fe Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 12 Sep 2023 15:44:37 -0400 Subject: [PATCH 524/589] fix dtcn bug --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index ba1b8f38e..51485a2e0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -4191,8 +4191,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! call to set CN time step before any other CN routines are called (jkolassa May 2023) ! ------------------------------------------------------------------------------------------ - dtcn = min(dtcn,14400.) - ndt = get_step_size( nint(dtcn) ) + catchcn_internal%DTCN = min(catchcn_internal%DTCN,14400.) + ndt = get_step_size( nint(catchcn_internal%DTCN) ) ! gkw: get_step_size must be called here to set CN model time step ! update CN time step number ! -------------------------- @@ -4201,7 +4201,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! initialize CN model and transfer restart variables on startup ! ------------------------------------------------------------- if(first) then - call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,DTCN,water_inst,bgc_vegetation_inst,.true.) + call CN_init(nt,ityp,fveg,cncol,cnpft,lats,lons,catchcn_internal%DTCN,water_inst,bgc_vegetation_inst,.true.) call get_CN_LAI(nt,ityp,fveg,elai,esai=esai) first = .false. endif From 843c4dd95c4040099786ec8d52d64ad8ce22cc38 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 13 Sep 2023 08:49:30 -0400 Subject: [PATCH 525/589] remove RUNSURF as export variable since it is now included in the restart file --- .../GEOS_CatchCNCLM51GridComp.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 51485a2e0..6ea838f5e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -2232,15 +2232,6 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - call MAPL_AddExportSpec(GC, & - LONG_NAME = 'overland_runoff_including_throughflow' ,& - UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'RUNSURF' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - VERIFY_(STATUS) - call MAPL_AddExportSpec(GC, & LONG_NAME = 'snowmelt_flux' ,& UNITS = 'kg m-2 s-1' ,& @@ -5441,7 +5432,6 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,ICESOI , 'ICESOI' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,EVPSNO , 'EVPSNO' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,BFLOW , 'BASEFLOW',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RUNSURF , 'RUNSURF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SMELT , 'SMELT' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,HLWUP , 'HLWUP' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SWNDSRF , 'SWNDSRF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) From c4d95cc6d8da30e519a06c6001bed66effb184ef Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 13 Sep 2023 12:52:21 -0400 Subject: [PATCH 526/589] add psn and lmr variables back for now --- .../GEOS_CatchCNCLM51GridComp.F90 | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 6ea838f5e..3399acd43 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -6902,6 +6902,10 @@ subroutine Driver ( RC ) snowfm = snowfm + SNO runsrfm = runsrfm + RUNSURF ar1m = ar1m + car1 + psnsunm = psnsunm + psnsun*laisun + psnsham = psnsham + psnsha*laisha + lmrsunm = lmrsunm + lmrsun*laisun + lmrsham = lmrsham + lmrsha*laisha do n = 1,N_snow sndzm(:) = sndzm(:) + sndzn(n,:) end do @@ -6932,6 +6936,12 @@ subroutine Driver ( RC ) tgwm(:,nz) = tgwm(:,nz) / cnsum(:) rzmm(:,nz) = rzmm(:,nz) / cnsum(:) sfmm(:,nz) = sfmm(:,nz) / cnsum(:) + do nv = 1,nveg + psnsunm(:,nv,nz) = psnsunm(:,nv,nz) / cnsum(:) + psnsham(:,nv,nz) = psnsham(:,nv,nz) / cnsum(:) + lmrsunm(:,nv,nz) = lmrsunm(:,nv,nz) / cnsum(:) + lmrsham(:,nv,nz) = lmrsham(:,nv,nz) / cnsum(:) + end do end do tpm = tpm / cnsum bflowm = bflowm / cnsum @@ -7046,6 +7056,10 @@ subroutine Driver ( RC ) snowfm = 0. runsrfm = 0. ar1m = 0. + psnsunm = 0. + psnsham = 0. + lmrsunm = 0. + lmrsham = 0. sndzm = 0. asnowm = 0. cnsum = 0. @@ -7110,7 +7124,7 @@ subroutine Driver ( RC ) if (NextTime == NextRecordTime) record = .true. endif - if(NextTime == StopTime) then + if(NextTime == StopTime .or. record) then call CN_exit(ntile,ityp,fveg,cncol,cnpft) i = 1 From da0960ed99b0ec2d9ea3f73a27022814884c47f9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Sep 2023 12:39:57 -0400 Subject: [PATCH 527/589] initialize all used canopy state values to suggested cold start values --- .../CLM51/CNCLM_CanopyStateType.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 11d384e5d..1204010ee 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -119,13 +119,13 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) allocate(this%laisha_z_patch (begp:endp,1:nlevcan)) ; this%laisha_z_patch (:,:) = 0. allocate(this%mlaidiff_patch (begp:endp)) ; this%mlaidiff_patch (:) = 0. allocate(this%annlai_patch (12,begp:endp)) ; this%annlai_patch (:,:) = 0. - allocate(this%stem_biomass_patch (begp:endp)) ; this%stem_biomass_patch (:) = nan - allocate(this%leaf_biomass_patch (begp:endp)) ; this%leaf_biomass_patch (:) = nan - allocate(this%htop_patch (begp:endp)) ; this%htop_patch (:) = nan - allocate(this%hbot_patch (begp:endp)) ; this%hbot_patch (:) = nan + allocate(this%stem_biomass_patch (begp:endp)) ; this%stem_biomass_patch (:) = 0. + allocate(this%leaf_biomass_patch (begp:endp)) ; this%leaf_biomass_patch (:) = 0. + allocate(this%htop_patch (begp:endp)) ; this%htop_patch (:) = 0. + allocate(this%hbot_patch (begp:endp)) ; this%hbot_patch (:) = 0. allocate(this%z0m_patch (begp:endp)) ; this%z0m_patch (:) = nan allocate(this%displa_patch (begp:endp)) ; this%displa_patch (:) = nan - allocate(this%fsun_patch (begp:endp)) ; this%fsun_patch (:) = nan + allocate(this%fsun_patch (begp:endp)) ; this%fsun_patch (:) = spval allocate(this%fsun24_patch (begp:endp)) ; this%fsun24_patch (:) = nan allocate(this%fsun240_patch (begp:endp)) ; this%fsun240_patch (:) = nan From 13ce44fbe24da3864948be3e57f0a88391d3e28a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Sep 2023 13:28:48 -0400 Subject: [PATCH 528/589] change leaf_mr_vcm parameter to one corresponding to leaf maintenance respiration method --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 1204010ee..1ed191a0f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -138,7 +138,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) ! set parameters to default values or read from parameter file - this%leaf_mr_vcm = 0.015 ! jkolassa Mar 2022: default value in CTSM5.1 + this%leaf_mr_vcm = 0.032 !0.015 ! jkolassa Mar 2022: 0.015 is default value in CTSM5.1, but accoring to ChangeLog 0.032 should be used for Atkin leaf respiration method, which we are using ! initialize variables from restart file or set to cold start value From 35172ad53f26f3af61473e443db675ec054f1589 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Sep 2023 13:42:47 -0400 Subject: [PATCH 529/589] change cold start initialization of alphapsn --- .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index a9d6deb43..9cd2d346a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -379,8 +379,8 @@ subroutine Init(this,bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,rc) do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then if (cold_start) then - this%alphapsnsun_patch(np) = 0._r8 - this%alphapsnsha_patch(np) = 0._r8 + this%alphapsnsun_patch(np) = spval + this%alphapsnsha_patch(np) = spval else if (cold_start.eqv..false.) then this%alphapsnsun_patch(np) = cnpft(nc,nz,nv, 76) this%alphapsnsha_patch(np) = cnpft(nc,nz,nv, 77) From a256fccd985c2cb0bd519e46259d0877c02dc93b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Nov 2023 09:45:43 -0400 Subject: [PATCH 530/589] bug fix in density calculation and setting NaN output to 0 --- .../CLM51/CNCLM51_Photosynthesis.F90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 84865d012..5c69c0a46 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -273,7 +273,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & do nz = 1,num_zon n = n + 1 atm2lnd_inst%forc_pbot_downscaled_col (n) = pbot(nc) - atm2lnd_inst%forc_rho_downscaled_col (n) = pbot(nc)-0.378*eair(nc,nz)/(rair*tc(nc,nz)) + atm2lnd_inst%forc_rho_downscaled_col (n) = (pbot(nc)-0.378*eair(nc,nz))/(rair*tc(nc,nz)) soilstate_inst%hksat_col (n,1:nlevgrnd) = 1000.*COND(nc) ! saturated hydraulic conductivity mapped to CLM space ! and converted to [mm/s] @@ -427,6 +427,13 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & call PhotosynthesisTotal (filter(1)%num_exposedvegp, filter(1)%exposedvegp, & atm2lnd_inst, canopystate_inst, photosyns_inst) + laisun_out = 0. + laisha_out = 0. + psnsun_out = 0. + psnsha_out = 0. + lmrsun_out = 0. + lmrsha_out = 0. + np = 0 do nc = 1,nch ! catchment tile loop do nz = 1,num_zon ! CN zone loop @@ -454,14 +461,23 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & laisun_out(nc,nv,nz) = laisun(np) laisha_out(nc,nv,nz) = laisha(np) + if (isnan(laisun(np))) laisun_out(nc,nv,nz) = 0. + if (isnan(laisha(np))) laisha_out(nc,nv,nz) = 0. + ! Photosynthesis psnsun_out(nc,nv,nz) = photosyns_inst%psnsun_patch(np) psnsha_out(nc,nv,nz) = photosyns_inst%psnsha_patch(np) + if (isnan(psnsun_out(nc,nv,nz))) psnsun_out(nc,nv,nz) = 0. + if (isnan(psnsha_out(nc,nv,nz))) psnsha_out(nc,nv,nz) = 0. + ! Leaf maintenance respiration lmrsun_out(nc,nv,nz) = photosyns_inst%lmrsun_patch(np) lmrsha_out(nc,nv,nz) = photosyns_inst%lmrsha_patch(np) + if (isnan(lmrsun_out(nc,nv,nz))) lmrsun_out(nc,nv,nz) = 0. + if (isnan(lmrsha_out(nc,nv,nz))) lmrsha_out(nc,nv,nz) = 0. + ! total absorbed PAR tmp_parsun = 0. tmp_parsha = 0. From a479597bbb724d552ae7b358b978c7a1c20d20b8 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Nov 2023 12:01:22 -0400 Subject: [PATCH 531/589] manually added snow albedo changes in GC --- .../GEOS_CatchCNCLM51GridComp.F90 | 130 +++++++++++++++--- 1 file changed, 108 insertions(+), 22 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 3399acd43..f5db3e663 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -38,7 +38,7 @@ module GEOS_CatchCNCLM51GridCompMod use CNCLM_Photosynthesis use CN_initMod USE STIEGLITZSNOW, ONLY : & - snow_albedo, StieglitzSnow_calc_tpsnow, N_CONSTIT, & + StieglitzSnow_snow_albedo, StieglitzSnow_calc_tpsnow, N_CONSTIT, & NUM_DUDP, NUM_DUSV, NUM_DUWT, NUM_DUSD, & NUM_BCDP, NUM_BCSV, NUM_BCWT, NUM_BCSD, & NUM_OCDP, NUM_OCSV, NUM_OCWT, NUM_OCSD, & @@ -49,10 +49,10 @@ module GEOS_CatchCNCLM51GridCompMod USE CATCH_CONSTANTS, ONLY : & N_GT => CATCH_N_GT, & N_SNOW => CATCH_N_SNOW, & - RHOFS => CATCH_SNWALB_RHOFS, & - SNWALB_VISMAX => CATCH_SNWALB_VISMAX, & - SNWALB_NIRMAX => CATCH_SNWALB_NIRMAX, & - SLOPE => CATCH_SNWALB_SLOPE, & + RHOFS => CATCH_SNOW_RHOFS, & + SNWALB_VISMAX => CATCH_SNOW_VISMAX, & + SNWALB_NIRMAX => CATCH_SNOW_NIRMAX, & + SLOPE => CATCH_SNOW_SLOPE, & PEATCLSM_POROS_THRESHOLD @@ -200,7 +200,7 @@ subroutine SetServices ( GC, RC ) type(MAPL_MetaComp), pointer :: MAPL=>null() integer :: OFFLINE_MODE, RUN_IRRIG, ATM_CO2, N_CONST_LAND4SNWALB - integer :: RESTART + integer :: RESTART, SNOW_ALBEDO_INFO ! Begin... ! -------- @@ -226,6 +226,7 @@ subroutine SetServices ( GC, RC ) call MAPL_GetResource ( MAPL, ATM_CO2, Label="ATM_CO2:", _RC) call MAPL_GetResource ( MAPL, N_CONST_LAND4SNWALB, Label="N_CONST_LAND4SNWALB:", _RC) call MAPL_GetResource ( MAPL, RUN_IRRIG, Label="RUN_IRRIG:", _RC) + call MAPL_GetResource ( MAPL, SNOW_ALBEDO_INFO, Label="SNOW_ALBEDO_INFO:", _RC) ! Set the Run entry points ! ------------------------ @@ -1382,6 +1383,19 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + if (SNOW_ALBEDO_INFO == 1) then + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'effective_snow_albedo' ,& + UNITS = '1' ,& + SHORT_NAME = 'SNOWALB' ,& + FRIENDLYTO = trim(COMP_NAME) ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartRequired ,& + RC=STATUS ) + VERIFY_(STATUS) + endif + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'surface_heat_exchange_coefficient',& UNITS = 'kg m-2 s-1' ,& @@ -2241,6 +2255,33 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'snow_frozen_fraction_layer_1' ,& + UNITS = '1' ,& + SHORT_NAME = 'FICE1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'snow_frozen_fraction_layer_2' ,& + UNITS = '1' ,& + SHORT_NAME = 'FICE2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'snow_frozen_fraction_layer_3' ,& + UNITS = '1' ,& + SHORT_NAME = 'FICE3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_emitted_longwave_flux',& UNITS = 'W m-2' ,& @@ -4598,6 +4639,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: psis real, dimension(:), pointer :: bee real, dimension(:), pointer :: poros + real, dimension(:), pointer :: snowalb real, dimension(:), pointer :: wpwet real, dimension(:), pointer :: cond real, dimension(:), pointer :: gnu @@ -4724,6 +4766,9 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: bflow real, dimension(:), pointer :: runsurf real, dimension(:), pointer :: smelt + real, dimension(:), pointer :: fice1 + real, dimension(:), pointer :: fice2 + real, dimension(:), pointer :: fice3 real, dimension(:), pointer :: accum real, dimension(:), pointer :: hlwup real, dimension(:), pointer :: swndsrf @@ -4903,7 +4948,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: ALWX, BLWX real,pointer,dimension(:) :: LHACC, SUMEV real,pointer,dimension(:) :: fveg1, fveg2 - real,pointer,dimension(:) :: FICE1 + real,pointer,dimension(:) :: FICE1TMP real,pointer,dimension(:) :: SLDTOT ! real*8,pointer,dimension(:) :: fsum @@ -4912,6 +4957,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:,:) :: wesnn real,pointer,dimension(:,:) :: htsnnn real,pointer,dimension(:,:) :: sndzn + real,pointer,dimension(:,:) :: ficesout real,pointer,dimension(:,:) :: shsbt real,pointer,dimension(:,:) :: dshsbt real,pointer,dimension(:,:) :: evsbt @@ -5433,6 +5479,9 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,EVPSNO , 'EVPSNO' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,BFLOW , 'BASEFLOW',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SMELT , 'SMELT' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FICE1 , 'FICE1' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FICE2 , 'FICE2' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FICE3 , 'FICE3' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,HLWUP , 'HLWUP' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,SWNDSRF , 'SWNDSRF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,LWNDSRF , 'LWNDSRF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) @@ -5715,10 +5764,12 @@ subroutine Driver ( RC ) ! ALLOCATE LOCAL POINTERS ! -------------------------------------------------------------------------- - allocate(GHTCNT (6,NTILES)) - allocate(WESNN (3,NTILES)) - allocate(HTSNNN (3,NTILES)) - allocate(SNDZN (3,NTILES)) + allocate(GHTCNT (N_GT, NTILES)) + allocate(WESNN (N_SNOW,NTILES)) + allocate(HTSNNN (N_SNOW,NTILES)) + allocate(SNDZN (N_SNOW,NTILES)) + allocate(FICESOUT(N_SNOW,NTILES)) + allocate(TILEZERO (NTILES)) allocate(DZSF (NTILES)) allocate(SWNETFREE(NTILES)) @@ -5783,8 +5834,8 @@ subroutine Driver ( RC ) allocate(SUMEV (NTILES)) allocate(fveg1 (NTILES)) allocate(fveg2 (NTILES)) - allocate(FICE1 (NTILES)) - allocate(SLDTOT (NTILES)) + allocate(FICE1TMP (NTILES)) + allocate(SLDTOT (NTILES)) ! total solid precip allocate(FSW_CHANGE(NTILES)) allocate(SHSBT (NTILES,NUM_SUBTILES)) @@ -6753,7 +6804,7 @@ subroutine Driver ( RC ) BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo ALBVR, ALBNR, ALBVF, ALBNF, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles - call SNOW_ALBEDO(ntiles, N_snow, catchcn_internal%N_CONST_LAND4SNWALB, ityp_tmp, & + call StieglitzSnow_snow_albedo(ntiles, N_snow, catchcn_internal%N_CONST_LAND4SNWALB, ityp_tmp, & elai(:,nv,nz), ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & @@ -6828,10 +6879,10 @@ subroutine Driver ( RC ) ALBVR, ALBNR, ALBVF, ALBNF, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles - call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSNNN(1,:), WESNN(1,:), TPSN1OUT1, FICE1) + call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSNNN(1,:), WESNN(1,:), TPSN1OUT1, FICE1TMP) TPSN1OUT1 = TPSN1OUT1 + Tzero - call SNOW_ALBEDO(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & + call StieglitzSnow_snow_albedo(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & WESNN, HTSNNN, SNDZN, & @@ -6843,7 +6894,7 @@ subroutine Driver ( RC ) BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles - call SNOW_ALBEDO(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & + call StieglitzSnow_snow_albedo(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & WESNN, HTSNNN, SNDZN, & @@ -6861,6 +6912,22 @@ subroutine Driver ( RC ) SNOVF(:) = SNOVF(:)*fveg1(:) + SNOVF_tmp(:)*fveg2(:) SNONF(:) = SNONF(:)*fveg1(:) + SNONF_tmp(:)*fveg2(:) + if (catchcn_internal%SNOW_ALBEDO_INFO == 1) then + + ! use MODIS-derived snow albedo from bcs (via Catch restart) + ! + ! as a restart parameter from the bcs, snow albedo must not have no-data-values + ! (checks for unphysical values should be in the make_bcs package) + + call MAPL_GetPointer(INTERNAL,SNOWALB,'SNOWALB',RC=STATUS); VERIFY_(STATUS) + + SNOVR = SNOWALB + SNONR = SNOWALB + SNOVF = SNOWALB + SNONF = SNOWALB + + endif + ! -------------------------------------------------------------------------- ! albedo/swnet partitioning ! -------------------------------------------------------------------------- @@ -7521,7 +7588,7 @@ subroutine Driver ( RC ) TSURF ,& SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 ,& LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW ,& - TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE ,& + TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE, FICEOUT ,& TC1_0=TC1_0, TC2_0=TC2_0, TC4_0=TC4_0 ,& QA1_0=QA1_0, QA2_0=QA2_0, QA4_0=QA4_0 ,& RCONSTIT=RCONSTIT, RMELT=RMELT, TOTDEPOS=TOTDEPOS, LHACC=LHACC) @@ -7582,10 +7649,10 @@ subroutine Driver ( RC ) BGALBVR, BGALBVF, BGALBNR, BGALBNF, & ! gkw: MODIS soil background albedo ALBVR, ALBNR, ALBVF, ALBNF, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles - call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSNNN(1,:), WESNN(1,:), TPSN1OUT1, FICE1) + call STIEGLITZSNOW_CALC_TPSNOW(NTILES, HTSNNN(1,:), WESNN(1,:), TPSN1OUT1, FICE1TMP) TPSN1OUT1 = TPSN1OUT1 + Tzero - call SNOW_ALBEDO(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & + call StieglitzSnow_snow_albedo(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG1, LAI1, ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & WESNN, HTSNNN, SNDZN, & @@ -7598,7 +7665,7 @@ subroutine Driver ( RC ) ALBVR_tmp, ALBNR_tmp, ALBVF_tmp, ALBNF_tmp, MODIS_SCALE=.TRUE. ) ! instantaneous snow-free albedos on tiles - call SNOW_ALBEDO(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & + call StieglitzSnow_snow_albedo(NTILES,N_snow, catchcn_internal%N_CONST_LAND4SNWALB, VEG2, LAI2, ZTH, & RHOFS, & SNWALB_VISMAX, SNWALB_NIRMAX, SLOPE, & WESNN, HTSNNN, SNDZN, & @@ -7616,6 +7683,20 @@ subroutine Driver ( RC ) SNOVF(:) = SNOVF(:)*fveg1(:) + SNOVF_tmp(:)*fveg2(:) SNONF(:) = SNONF(:)*fveg1(:) + SNONF_tmp(:)*fveg2(:) + if (catchcn_internal%SNOW_ALBEDO_INFO == 1) then + + ! use MODIS-derived snow albedo from bcs (via Catch restart) + ! + ! as a restart parameter from the bcs, snow albedo must not have no-data-values + ! (checks for unphysical values should be in the make_bcs package) + + SNOVR = SNOWALB + SNONR = SNOWALB + SNOVF = SNOWALB + SNONF = SNOWALB + + endif + ALBVR = ALBVR *(1.-ASNOW) + SNOVR *ASNOW ALBVF = ALBVF *(1.-ASNOW) + SNOVF *ASNOW ALBNR = ALBNR *(1.-ASNOW) + SNONR *ASNOW @@ -7719,6 +7800,10 @@ subroutine Driver ( RC ) if(associated(SNOMAS)) SNOMAS = WESNN (1,:) + WESNN (2,:) + WESNN (3,:) if(associated(SNOWDP)) SNOWDP = SNDZN (1,:) + SNDZN (2,:) + SNDZN (3,:) + if(associated(FICE1 )) FICE1 = max( min( FICESOUT(1,:),1.0 ), 0.0 ) + if(associated(FICE2 )) FICE2 = max( min( FICESOUT(2,:),1.0 ), 0.0 ) + if(associated(FICE3 )) FICE3 = max( min( FICESOUT(3,:),1.0 ), 0.0 ) + if(associated(RMELTDU001)) RMELTDU001 = RMELT(:,1) if(associated(RMELTDU002)) RMELTDU002 = RMELT(:,2) if(associated(RMELTDU003)) RMELTDU003 = RMELT(:,3) @@ -7834,6 +7919,7 @@ subroutine Driver ( RC ) deallocate(WESNN ) deallocate(HTSNNN ) deallocate(SNDZN ) + deallocate(FICESOUT ) deallocate(TILEZERO ) deallocate(DZSF ) deallocate(SWNETFREE) @@ -7922,7 +8008,7 @@ subroutine Driver ( RC ) deallocate(RCONSTIT ) deallocate(TOTDEPOS ) deallocate(RMELT ) - deallocate(FICE1 ) + deallocate(FICE1TMP ) deallocate(SLDTOT ) deallocate(FSW_CHANGE) deallocate( btran ) From 9ed1fffad340ddf53281c24dc867b90af240f8e1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 1 Nov 2023 14:06:22 -0400 Subject: [PATCH 532/589] typo fix --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index f5db3e663..bbaa2ff1a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -7588,7 +7588,7 @@ subroutine Driver ( RC ) TSURF ,& SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 ,& LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW ,& - TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE, FICEOUT ,& + TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE, FICESOUT ,& TC1_0=TC1_0, TC2_0=TC2_0, TC4_0=TC4_0 ,& QA1_0=QA1_0, QA2_0=QA2_0, QA4_0=QA4_0 ,& RCONSTIT=RCONSTIT, RMELT=RMELT, TOTDEPOS=TOTDEPOS, LHACC=LHACC) From da606ecbcaaca7033611202c23fc3ee22df29387 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 2 Nov 2023 14:21:03 -0400 Subject: [PATCH 533/589] assigning 90-minute avg photosynthesis variables to CLM types --- .../CLM51/CNCLM_DriverMod.F90 | 14 ++++++++++++++ .../GEOS_CatchCNCLM51GridComp.F90 | 1 + 2 files changed, 15 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 3f6389c1f..e25d90729 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -65,6 +65,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& fsnow,tg10d,t2m5d,sndzn5d,water_inst,first, & + psnsunm, psnsham, lmrsunm, lmrsham, & zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& @@ -113,6 +114,11 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: sndzn5d ! 5-day running mean of total snow depth type(water_type), intent(in) :: water_inst logical, intent(in) :: first + real, dimension(nch,num_veg,num_zon), intent(in) :: psnsunm + real, dimension(nch,num_veg,num_zon), intent(in) :: psnsham + real, dimension(nch,num_veg,num_zon), intent(in) :: lmrsunm + real, dimension(nch,num_veg,num_zon), intent(in) :: lmrsham + ! OUTPUT @@ -273,6 +279,14 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m water_inst%wateratm2lndbulk_inst%prec10_patch(p) = prec10d(nc) water_inst%wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) frictionvel_inst%forc_hgt_u_patch(p) = 30. ! following CNCLM45 implementation, but this should be available from the GridComp + + if(ityp(nc,nv,nz)==np .and. fveg(nc,nv,nz)>1.e-4) then + photosyns_inst%psnsun_patch(p) = psnsunm(nc) + photosyns_inst%psnsha_patch(p) = psnsham(nc) + photosyns_inst%lmrsun_patch(p) = lmrsunm(nc) + photosyns_inst%lmrsha_patch(p) = lmrsham(nc) + end if + end do ! np end do ! nz end do ! nc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index bbaa2ff1a..44ddae020 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -7027,6 +7027,7 @@ subroutine Driver ( RC ) rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, first_cn, & + psnsunm, psnsham, lmrsunm, lmrsham, & elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& fire_nloss,leafn,leafc,gross_nmin,net_nmin,& From 3d52042b13a9037577f9239661bd762984ef4a59 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 2 Nov 2023 14:35:53 -0400 Subject: [PATCH 534/589] fix indexing --- .../CLM51/CNCLM_DriverMod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index e25d90729..5189b3857 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -280,13 +280,14 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m water_inst%wateratm2lndbulk_inst%rh30_patch(p) = rh30(nc) frictionvel_inst%forc_hgt_u_patch(p) = 30. ! following CNCLM45 implementation, but this should be available from the GridComp - if(ityp(nc,nv,nz)==np .and. fveg(nc,nv,nz)>1.e-4) then - photosyns_inst%psnsun_patch(p) = psnsunm(nc) - photosyns_inst%psnsha_patch(p) = psnsham(nc) - photosyns_inst%lmrsun_patch(p) = lmrsunm(nc) - photosyns_inst%lmrsha_patch(p) = lmrsham(nc) - end if - + do nv = 1,num_veg ! defined veg loop + if(ityp(nc,nv,nz)==np .and. fveg(nc,nv,nz)>1.e-4) then + photosyns_inst%psnsun_patch(p) = psnsunm(nc,nv,nz) + photosyns_inst%psnsha_patch(p) = psnsham(nc,nv,nz) + photosyns_inst%lmrsun_patch(p) = lmrsunm(nc,nv,nz) + photosyns_inst%lmrsha_patch(p) = lmrsham(nc,nv,nz) + end if + end do ! nv end do ! np end do ! nz end do ! nc From 449c4e1be51301c8bd3288a0c1ccfeb650d79154 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 8 Nov 2023 11:04:42 -0500 Subject: [PATCH 535/589] add phenology calculations from albedo module --- .../CLM51/CNCLM51_Photosynthesis.F90 | 34 ++++++++++++++++--- 1 file changed, 29 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 5c69c0a46..48ac8de5d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -1,7 +1,8 @@ module CNCLM_Photosynthesis use MAPL_ConstantsMod - use clm_varpar, only : numpft, numrad, num_veg, num_zon + use clm_varpar, only : numpft, numrad, num_veg, num_zon, & + nlevcan use decompMod use PatchType use filterMod @@ -102,7 +103,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & ! type(clumpfilter) :: filter ! temporary and loop variables - integer :: n, p, pft_num, nv, nc, nz, np, ib, nl + integer :: n, p, pft_num, nv, nc, nz, np, ib, nl, iv real :: bare, tmp_albgrd_vis,tmp_albgrd_nir,& tmp_albgri_vis,tmp_albgri_nir, & tmp_parsun, tmp_parsha @@ -175,9 +176,6 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & rhos => pftcon%rhos , & ! Input: stem reflectance: 1=vis, 2=nir taul => pftcon%taul , & ! Input: leaf transmittance: 1=vis, 2=nir taus => pftcon%taus , & ! Input: stem transmittance: 1=vis, 2=nir - vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & - vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & - f_sun_z => surfalb_inst%fsun_z_patch , & xl => pftcon%xl , & leafn => bgc_vegetation_inst%cnveg_nitrogenstate_inst%leafn_patch , & froot_carbon => bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_patch , & @@ -343,6 +341,32 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & filter_novegsol(num_novegsol) = p end if + if (nlevcan == 1) then ! jk: currently only coded for one canopy layer + surfalb_inst%tlai_z_patch(p,1) = elai(p) + surfalb_inst%tsai_z_patch(p,1) = esai(p) + end if + + do iv = 1, surfalb_inst%nrad_patch(p) + surfalb_inst%fabd_sun_z_patch(p,iv) = 0._r8 + surfalb_inst%fabd_sha_z_patch(p,iv) = 0._r8 + surfalb_inst%fabi_sun_z_patch(p,iv) = 0._r8 + surfalb_inst%fabi_sha_z_patch(p,iv) = 0._r8 + surfalb_inst%fsun_z_patch(p,iv) = 0._r8 + end do + + if (nlevcan == 1) then + surfalb_inst%vcmaxcintsun_patch(p) = 0._r8 + surfalb_inst%vcmaxcintsha_patch(p) = (1._r8 - exp(-extkn*elai(p))) / extkn + if (elai(p) > 0._r8) then + surfalb_inst%vcmaxcintsha_patch(p) = surfalb_inst%vcmaxcintsha_patch(p) / elai(p) + else + surfalb_inst%vcmaxcintsha_patch(p) = 0._r8 + end if + else if (nlevcan > 1) then + surfalb_inst%vcmaxcintsun_patch(p) = 0._r8 + surfalb_inst%vcmaxcintsha_patch(p) = 0._r8 + end if + water_inst%waterdiagnosticbulk_inst%fdry_patch(p) = (1-fwet(nc))*elai(p)/max( elai(p)+esai(p), 1.e-06_r8 ) water_inst%waterdiagnosticbulk_inst%fwet_patch(p) = fwet(nc) water_inst%waterdiagnosticbulk_inst%fcansno_patch(p) = fwet(nc) !jk: This is not a mistake, see notes on why we set fcansno = fwet From e62698a010747f80e863195ebc2eea7b9ed28206 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Dec 2023 18:13:36 -0500 Subject: [PATCH 536/589] fix pointers in CN_exit and indexing of dayl --- .../CLM51/CNCLM_DriverMod.F90 | 198 +++++++++--------- 1 file changed, 99 insertions(+), 99 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 5189b3857..0dad1c69f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -506,21 +506,21 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) ! LOCAL - type(bounds_type) :: bounds - type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst - type(gridcell_type) :: grc - type(cn_vegetation_type) :: bgc_vegetation_inst -! type(cnveg_state_type) :: cnveg_state_inst - type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst - type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst - type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst - type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst - type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst - type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst - type(cn_products_type) :: c_products_inst - type(cn_products_type) :: n_products_inst +! type(bounds_type) :: bounds +! type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst +! type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst +! type(gridcell_type) :: grc +! type(cn_vegetation_type) :: bgc_vegetation_inst +!! type(cnveg_state_type) :: cnveg_state_inst +! type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst +! type(soilbiogeochem_nitrogenstate_type):: soilbiogeochem_nitrogenstate_inst +! type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst +! type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst +! type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst +! type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst +! type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst +! type(cn_products_type) :: c_products_inst +! type(cn_products_type) :: n_products_inst integer :: n, p, nv, nc, nz, np, nd integer, dimension(8) :: decomp_cpool_cncol_index = (/ 3, 4, 5, 2, 10, 11, 12, 13 /) @@ -541,27 +541,27 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) cncol(nc,nz,decomp_npool_cncol_index(nd)) = soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col (n,1,nd) end do - cncol(nc,nz, 6) = cnveg_carbonstate_inst%totvegc_col (n) + cncol(nc,nz, 6) = bgc_vegetation_inst%cnveg_carbonstate_inst%totvegc_col (n) ! jkolassa: variables below transitioned from being column-level to being gridcell-level in CLM; ! assuming here that quantities are spread over zones according to zone weight - cncol(nc,nz, 7) = c_products_inst%prod100_grc(nc)*CN_zone_weight(nz) - cncol(nc,nz, 8) = c_products_inst%prod100_grc(nc)*CN_zone_weight(nz) - cncol(nc,nz, 9) = cnveg_carbonstate_inst%seedc_grc(nc)*CN_zone_weight(nz) - cncol(nc,nz,14) = cnveg_carbonstate_inst%totc_col (n) + cncol(nc,nz, 7) = bgc_vegetation_inst%c_products_inst%prod100_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz, 8) = bgc_vegetation_inst%c_products_inst%prod100_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz, 9) = bgc_vegetation_inst%cnveg_carbonstate_inst%seedc_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz,14) = bgc_vegetation_inst%cnveg_carbonstate_inst%totc_col (n) cncol(nc,nz,15) = soilbiogeochem_carbonstate_inst%totlitc_col (n) cncol(nc,nz,16) = soilbiogeochem_nitrogenstate_inst%ntrunc_vr_col (n,1) - cncol(nc,nz,21) = n_products_inst%prod100_grc(nc)*CN_zone_weight(nz) - cncol(nc,nz,22) = n_products_inst%prod100_grc(nc)*CN_zone_weight(nz) - cncol(nc,nz,23) = cnveg_nitrogenstate_inst%seedn_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz,21) = bgc_vegetation_inst%n_products_inst%prod100_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz,22) = bgc_vegetation_inst%n_products_inst%prod100_grc(nc)*CN_zone_weight(nz) + cncol(nc,nz,23) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%seedn_grc(nc)*CN_zone_weight(nz) cncol(nc,nz,24) = soilbiogeochem_nitrogenstate_inst%sminn_vr_col (n,1) - cncol(nc,nz,29) = cnveg_nitrogenstate_inst%totn_col (n) + cncol(nc,nz,29) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%totn_col (n) cncol(nc,nz,30) = soilbiogeochem_state_inst%fpg_col (n) - cncol(nc,nz,31) = cnveg_state_inst%annsum_counter_col (n) - cncol(nc,nz,32) = cnveg_state_inst%annavg_t2m_col (n) - cncol(nc,nz,33) = cnveg_carbonflux_inst%annsum_npp_col (n) - cncol(nc,nz,34) = cnveg_state_inst%farea_burned_col (n) + cncol(nc,nz,31) = bgc_vegetation_inst%cnveg_state_inst%annsum_counter_col (n) + cncol(nc,nz,32) = bgc_vegetation_inst%cnveg_state_inst%annavg_t2m_col (n) + cncol(nc,nz,33) = bgc_vegetation_inst%cnveg_carbonflux_inst%annsum_npp_col (n) + cncol(nc,nz,34) = bgc_vegetation_inst%cnveg_state_inst%farea_burned_col (n) cncol(nc,nz,35) = soilbiogeochem_state_inst%fpi_col (n) do p = 0,numpft ! PFT index loop @@ -569,87 +569,87 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) do nv = 1,num_veg ! defined veg loop if(ityp(nc,nv,nz)==p .and. fveg(nc,nv,nz)>1.e-4) then - cnpft(nc,nz,nv, 1) = cnveg_carbonstate_inst%cpool_patch (np) - cnpft(nc,nz,nv, 2) = cnveg_carbonstate_inst%deadcrootc_patch (np) - cnpft(nc,nz,nv, 3) = cnveg_carbonstate_inst%deadcrootc_storage_patch (np) - cnpft(nc,nz,nv, 4) = cnveg_carbonstate_inst%deadcrootc_xfer_patch (np) - cnpft(nc,nz,nv, 5) = cnveg_carbonstate_inst%deadstemc_patch (np) - cnpft(nc,nz,nv, 6) = cnveg_carbonstate_inst%deadstemc_storage_patch (np) - cnpft(nc,nz,nv, 7) = cnveg_carbonstate_inst%deadstemc_xfer_patch (np) - cnpft(nc,nz,nv, 8) = cnveg_carbonstate_inst%frootc_patch (np) - cnpft(nc,nz,nv, 9) = cnveg_carbonstate_inst%frootc_storage_patch (np) - cnpft(nc,nz,nv, 10) = cnveg_carbonstate_inst%frootc_xfer_patch (np) - cnpft(nc,nz,nv, 11) = cnveg_carbonstate_inst%gresp_storage_patch (np) - cnpft(nc,nz,nv, 12) = cnveg_carbonstate_inst%gresp_xfer_patch (np) - cnpft(nc,nz,nv, 13) = cnveg_carbonstate_inst%leafc_patch (np) - cnpft(nc,nz,nv, 14) = cnveg_carbonstate_inst%leafc_storage_patch (np) - cnpft(nc,nz,nv, 15) = cnveg_carbonstate_inst%leafc_xfer_patch (np) - cnpft(nc,nz,nv, 16) = cnveg_carbonstate_inst%livecrootc_patch (np) - cnpft(nc,nz,nv, 17) = cnveg_carbonstate_inst%livecrootc_storage_patch (np) - cnpft(nc,nz,nv, 18) = cnveg_carbonstate_inst%livecrootc_xfer_patch (np) - cnpft(nc,nz,nv, 19) = cnveg_carbonstate_inst%livestemc_patch (np) - cnpft(nc,nz,nv, 20) = cnveg_carbonstate_inst%livestemc_storage_patch (np) - cnpft(nc,nz,nv, 21) = cnveg_carbonstate_inst%livestemc_xfer_patch (np) - cnpft(nc,nz,nv, 22) = cnveg_carbonstate_inst%ctrunc_patch (np) - cnpft(nc,nz,nv, 23) = cnveg_carbonstate_inst%xsmrpool_patch (np) - cnpft(nc,nz,nv, 24) = cnveg_state_inst%annavg_t2m_patch (np) - cnpft(nc,nz,nv, 25) = cnveg_state_inst%annmax_retransn_patch (np) - cnpft(nc,nz,nv, 26) = cnveg_carbonflux_inst%annsum_npp_patch (np) - cnpft(nc,nz,nv, 27) = cnveg_state_inst%annsum_potential_gpp_patch (np) - cnpft(nc,nz,nv, 28) = grc%dayl (np) - cnpft(nc,nz,nv, 29) = cnveg_state_inst%days_active_patch (np) - cnpft(nc,nz,nv, 30) = cnveg_state_inst%dormant_flag_patch (np) - cnpft(nc,nz,nv, 31) = cnveg_state_inst%offset_counter_patch (np) - cnpft(nc,nz,nv, 32) = cnveg_state_inst%offset_fdd_patch (np) - cnpft(nc,nz,nv, 33) = cnveg_state_inst%offset_flag_patch (np) - cnpft(nc,nz,nv, 34) = cnveg_state_inst%offset_swi_patch (np) - cnpft(nc,nz,nv, 35) = cnveg_state_inst%onset_counter_patch (np) - cnpft(nc,nz,nv, 36) = cnveg_state_inst%onset_fdd_patch (np) - cnpft(nc,nz,nv, 37) = cnveg_state_inst%onset_flag_patch (np) - cnpft(nc,nz,nv, 38) = cnveg_state_inst%onset_gdd_patch (np) - cnpft(nc,nz,nv, 39) = cnveg_state_inst%onset_gddflag_patch (np) - cnpft(nc,nz,nv, 40) = cnveg_state_inst%onset_swi_patch (np) - cnpft(nc,nz,nv, 41) = cnveg_carbonflux_inst%prev_frootc_to_litter_patch (np) - cnpft(nc,nz,nv, 42) = cnveg_carbonflux_inst%prev_leafc_to_litter_patch (np) - cnpft(nc,nz,nv, 43) = cnveg_state_inst%tempavg_t2m_patch (np) - cnpft(nc,nz,nv, 44) = cnveg_state_inst%tempmax_retransn_patch (np) - cnpft(nc,nz,nv, 45) = cnveg_carbonflux_inst%tempsum_npp_patch (np) - cnpft(nc,nz,nv, 46) = cnveg_state_inst%tempsum_potential_gpp_patch (np) - cnpft(nc,nz,nv, 47) = cnveg_carbonflux_inst%xsmrpool_recover_patch (np) - cnpft(nc,nz,nv, 48) = cnveg_nitrogenstate_inst%deadcrootn_patch (np) - cnpft(nc,nz,nv, 49) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch (np) - cnpft(nc,nz,nv, 50) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch (np) - cnpft(nc,nz,nv, 51) = cnveg_nitrogenstate_inst%deadstemn_patch (np) - cnpft(nc,nz,nv, 52) = cnveg_nitrogenstate_inst%deadstemn_storage_patch (np) - cnpft(nc,nz,nv, 53) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch (np) - cnpft(nc,nz,nv, 54) = cnveg_nitrogenstate_inst%frootn_patch (np) - cnpft(nc,nz,nv, 55) = cnveg_nitrogenstate_inst%frootn_storage_patch (np) - cnpft(nc,nz,nv, 56) = cnveg_nitrogenstate_inst%frootn_xfer_patch (np) - cnpft(nc,nz,nv, 57) = cnveg_nitrogenstate_inst%leafn_patch (np) - cnpft(nc,nz,nv, 58) = cnveg_nitrogenstate_inst%leafn_storage_patch (np) - cnpft(nc,nz,nv, 59) = cnveg_nitrogenstate_inst%leafn_xfer_patch (np) - cnpft(nc,nz,nv, 60) = cnveg_nitrogenstate_inst%livecrootn_patch (np) - cnpft(nc,nz,nv, 61) = cnveg_nitrogenstate_inst%livecrootn_storage_patch (np) - cnpft(nc,nz,nv, 62) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch (np) - cnpft(nc,nz,nv, 63) = cnveg_nitrogenstate_inst%livestemn_patch (np) - cnpft(nc,nz,nv, 64) = cnveg_nitrogenstate_inst%livestemn_storage_patch (np) - cnpft(nc,nz,nv, 65) = cnveg_nitrogenstate_inst%livestemn_xfer_patch (np) - cnpft(nc,nz,nv, 66) = cnveg_nitrogenstate_inst%npool_patch (np) - cnpft(nc,nz,nv, 67) = cnveg_nitrogenstate_inst%ntrunc_patch (np) - cnpft(nc,nz,nv, 68) = cnveg_nitrogenstate_inst%retransn_patch (np) + cnpft(nc,nz,nv, 1) = bgc_vegetation_inst%cnveg_carbonstate_inst%cpool_patch (np) + cnpft(nc,nz,nv, 2) = bgc_vegetation_inst%cnveg_carbonstate_inst%deadcrootc_patch (np) + cnpft(nc,nz,nv, 3) = bgc_vegetation_inst%cnveg_carbonstate_inst%deadcrootc_storage_patch (np) + cnpft(nc,nz,nv, 4) = bgc_vegetation_inst%cnveg_carbonstate_inst%deadcrootc_xfer_patch (np) + cnpft(nc,nz,nv, 5) = bgc_vegetation_inst%cnveg_carbonstate_inst%deadstemc_patch (np) + cnpft(nc,nz,nv, 6) = bgc_vegetation_inst%cnveg_carbonstate_inst%deadstemc_storage_patch (np) + cnpft(nc,nz,nv, 7) = bgc_vegetation_inst%cnveg_carbonstate_inst%deadstemc_xfer_patch (np) + cnpft(nc,nz,nv, 8) = bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_patch (np) + cnpft(nc,nz,nv, 9) = bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_storage_patch (np) + cnpft(nc,nz,nv, 10) = bgc_vegetation_inst%cnveg_carbonstate_inst%frootc_xfer_patch (np) + cnpft(nc,nz,nv, 11) = bgc_vegetation_inst%cnveg_carbonstate_inst%gresp_storage_patch (np) + cnpft(nc,nz,nv, 12) = bgc_vegetation_inst%cnveg_carbonstate_inst%gresp_xfer_patch (np) + cnpft(nc,nz,nv, 13) = bgc_vegetation_inst%cnveg_carbonstate_inst%leafc_patch (np) + cnpft(nc,nz,nv, 14) = bgc_vegetation_inst%cnveg_carbonstate_inst%leafc_storage_patch (np) + cnpft(nc,nz,nv, 15) = bgc_vegetation_inst%cnveg_carbonstate_inst%leafc_xfer_patch (np) + cnpft(nc,nz,nv, 16) = bgc_vegetation_inst%cnveg_carbonstate_inst%livecrootc_patch (np) + cnpft(nc,nz,nv, 17) = bgc_vegetation_inst%cnveg_carbonstate_inst%livecrootc_storage_patch (np) + cnpft(nc,nz,nv, 18) = bgc_vegetation_inst%cnveg_carbonstate_inst%livecrootc_xfer_patch (np) + cnpft(nc,nz,nv, 19) = bgc_vegetation_inst%cnveg_carbonstate_inst%livestemc_patch (np) + cnpft(nc,nz,nv, 20) = bgc_vegetation_inst%cnveg_carbonstate_inst%livestemc_storage_patch (np) + cnpft(nc,nz,nv, 21) = bgc_vegetation_inst%cnveg_carbonstate_inst%livestemc_xfer_patch (np) + cnpft(nc,nz,nv, 22) = bgc_vegetation_inst%cnveg_carbonstate_inst%ctrunc_patch (np) + cnpft(nc,nz,nv, 23) = bgc_vegetation_inst%cnveg_carbonstate_inst%xsmrpool_patch (np) + cnpft(nc,nz,nv, 24) = bgc_vegetation_inst%cnveg_state_inst%annavg_t2m_patch (np) + cnpft(nc,nz,nv, 25) = bgc_vegetation_inst%cnveg_state_inst%annmax_retransn_patch (np) + cnpft(nc,nz,nv, 26) = bgc_vegetation_inst%cnveg_carbonflux_inst%annsum_npp_patch (np) + cnpft(nc,nz,nv, 27) = bgc_vegetation_inst%cnveg_state_inst%annsum_potential_gpp_patch (np) + cnpft(nc,nz,nv, 28) = grc%dayl (nc) ! jkolassa Dec 2023: dayl is a gridcell =-level variable in CLM, but is stored as patch-level variable in CatcCN restart + cnpft(nc,nz,nv, 29) = bgc_vegetation_inst%cnveg_state_inst%days_active_patch (np) + cnpft(nc,nz,nv, 30) = bgc_vegetation_inst%cnveg_state_inst%dormant_flag_patch (np) + cnpft(nc,nz,nv, 31) = bgc_vegetation_inst%cnveg_state_inst%offset_counter_patch (np) + cnpft(nc,nz,nv, 32) = bgc_vegetation_inst%cnveg_state_inst%offset_fdd_patch (np) + cnpft(nc,nz,nv, 33) = bgc_vegetation_inst%cnveg_state_inst%offset_flag_patch (np) + cnpft(nc,nz,nv, 34) = bgc_vegetation_inst%cnveg_state_inst%offset_swi_patch (np) + cnpft(nc,nz,nv, 35) = bgc_vegetation_inst%cnveg_state_inst%onset_counter_patch (np) + cnpft(nc,nz,nv, 36) = bgc_vegetation_inst%cnveg_state_inst%onset_fdd_patch (np) + cnpft(nc,nz,nv, 37) = bgc_vegetation_inst%cnveg_state_inst%onset_flag_patch (np) + cnpft(nc,nz,nv, 38) = bgc_vegetation_inst%cnveg_state_inst%onset_gdd_patch (np) + cnpft(nc,nz,nv, 39) = bgc_vegetation_inst%cnveg_state_inst%onset_gddflag_patch (np) + cnpft(nc,nz,nv, 40) = bgc_vegetation_inst%cnveg_state_inst%onset_swi_patch (np) + cnpft(nc,nz,nv, 41) = bgc_vegetation_inst%cnveg_carbonflux_inst%prev_frootc_to_litter_patch (np) + cnpft(nc,nz,nv, 42) = bgc_vegetation_inst%cnveg_carbonflux_inst%prev_leafc_to_litter_patch (np) + cnpft(nc,nz,nv, 43) = bgc_vegetation_inst%cnveg_state_inst%tempavg_t2m_patch (np) + cnpft(nc,nz,nv, 44) = bgc_vegetation_inst%cnveg_state_inst%tempmax_retransn_patch (np) + cnpft(nc,nz,nv, 45) = bgc_vegetation_inst%cnveg_carbonflux_inst%tempsum_npp_patch (np) + cnpft(nc,nz,nv, 46) = bgc_vegetation_inst%cnveg_state_inst%tempsum_potential_gpp_patch (np) + cnpft(nc,nz,nv, 47) = bgc_vegetation_inst%cnveg_carbonflux_inst%xsmrpool_recover_patch (np) + cnpft(nc,nz,nv, 48) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%deadcrootn_patch (np) + cnpft(nc,nz,nv, 49) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%deadcrootn_storage_patch (np) + cnpft(nc,nz,nv, 50) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%deadcrootn_xfer_patch (np) + cnpft(nc,nz,nv, 51) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%deadstemn_patch (np) + cnpft(nc,nz,nv, 52) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%deadstemn_storage_patch (np) + cnpft(nc,nz,nv, 53) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%deadstemn_xfer_patch (np) + cnpft(nc,nz,nv, 54) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%frootn_patch (np) + cnpft(nc,nz,nv, 55) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%frootn_storage_patch (np) + cnpft(nc,nz,nv, 56) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%frootn_xfer_patch (np) + cnpft(nc,nz,nv, 57) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%leafn_patch (np) + cnpft(nc,nz,nv, 58) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%leafn_storage_patch (np) + cnpft(nc,nz,nv, 59) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%leafn_xfer_patch (np) + cnpft(nc,nz,nv, 60) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%livecrootn_patch (np) + cnpft(nc,nz,nv, 61) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%livecrootn_storage_patch (np) + cnpft(nc,nz,nv, 62) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%livecrootn_xfer_patch (np) + cnpft(nc,nz,nv, 63) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%livestemn_patch (np) + cnpft(nc,nz,nv, 64) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%livestemn_storage_patch (np) + cnpft(nc,nz,nv, 65) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%livestemn_xfer_patch (np) + cnpft(nc,nz,nv, 66) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%npool_patch (np) + cnpft(nc,nz,nv, 67) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%ntrunc_patch (np) + cnpft(nc,nz,nv, 68) = bgc_vegetation_inst%cnveg_nitrogenstate_inst%retransn_patch (np) cnpft(nc,nz,nv, 69) = canopystate_inst%elai_patch (np) cnpft(nc,nz,nv, 70) = canopystate_inst%esai_patch (np) cnpft(nc,nz,nv, 71) = canopystate_inst%hbot_patch (np) cnpft(nc,nz,nv, 72) = canopystate_inst%htop_patch (np) cnpft(nc,nz,nv, 73) = canopystate_inst%tlai_patch (np) cnpft(nc,nz,nv, 74) = canopystate_inst%tsai_patch (np) - cnpft(nc,nz,nv, 75) = cnveg_nitrogenflux_inst%plant_ndemand_patch (np) + cnpft(nc,nz,nv, 75) = bgc_vegetation_inst%cnveg_nitrogenflux_inst%plant_ndemand_patch (np) cnpft(nc,nz,nv, 76) = canopystate_inst%vegwp_patch (np,1) cnpft(nc,nz,nv, 77) = canopystate_inst%vegwp_patch (np,2) cnpft(nc,nz,nv, 78) = canopystate_inst%vegwp_patch (np,3) cnpft(nc,nz,nv, 79) = canopystate_inst%vegwp_patch (np,4) - cnpft(nc,nz,nv, 80) = cnveg_carbonflux_inst%annsum_litfall_patch (np) - cnpft(nc,nz,nv, 81) = cnveg_carbonflux_inst%tempsum_litfall_patch (np) + cnpft(nc,nz,nv, 80) = bgc_vegetation_inst%cnveg_carbonflux_inst%annsum_litfall_patch (np) + cnpft(nc,nz,nv, 81) = bgc_vegetation_inst%cnveg_carbonflux_inst%tempsum_litfall_patch (np) endif end do ! defined veg loop From 31f18a89ccd63f2e56dcd948b34b6bcbcba6dc28 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Dec 2023 18:13:59 -0500 Subject: [PATCH 537/589] fix typo in CN_exit call --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 44ddae020..56fa77568 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -7194,7 +7194,7 @@ subroutine Driver ( RC ) if(NextTime == StopTime .or. record) then - call CN_exit(ntile,ityp,fveg,cncol,cnpft) + call CN_exit(ntiles,ityp,fveg,cncol,cnpft) i = 1 do iv = 1,VAR_PFT do nv = 1,NUM_VEG From 2539bdea56137f0befaea958ab694102660c31e7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 10 Apr 2024 12:49:07 -0400 Subject: [PATCH 538/589] adjust longitude values to [0 360] convention for CLM --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 index 606a95d8a..9b2d7524e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_GridcellType.F90 @@ -97,6 +97,7 @@ subroutine Init(this, bounds, nch, cnpft, lats, lons) this%lon (nc) = lons(nc) this%latdeg (nc) = lats(nc) / MAPL_PI * 180. this%londeg (nc) = lons(nc) / MAPL_PI * 180. + this%londeg (nc) = this%londeg(nc)+180 ! convert from [-180 180] to [0 360] this%dayl (nc) = cnpft (nc,1,1, 28) ! variable used to be patch level and is now gridcell level; assume all patches in gridcell have same day length this%prev_dayl(nc) = this%dayl(nc) ! following previous Catchment-CN versions, daylength of previous day is initialized as daylength of current day; changed for subsequent time steps in CN_DriverMod From abd21e3d2c3f85025288e50241760f1cdff62453 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 15 May 2024 09:27:05 -0400 Subject: [PATCH 539/589] keep Catchment-CN5.1 as LSM_CHOICE=4 --- .../GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 | 2 +- .../GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 | 4 ++-- .../GEOSsurface_GridComp/Shared/SurfParams.F90 | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index 529255ad6..276455e17 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -255,7 +255,7 @@ subroutine SetServices ( GC, RC ) call MAPL_GetResource (SCF, LAND_PARAMS, label='LAND_PARAMS:', DEFAULT="NRv7.2", __RC__ ) elseif (LSM_CHOICE.eq.2) then call MAPL_GetResource (SCF, LAND_PARAMS, label='LAND_PARAMS:', DEFAULT="CN_CLM40", __RC__ ) - elseif (LSM_CHOICE.eq.3) then + elseif (LSM_CHOICE.eq.4) then call MAPL_GetResource (SCF, LAND_PARAMS, label='LAND_PARAMS:', DEFAULT="CN_CLM51", __RC__ ) else _ASSERT(.FALSE.,'unknown LSM_CHOICE') diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 3118fff59..b3ad1c50f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -113,11 +113,11 @@ subroutine SetServices ( GC, RC ) if ( LSM_CHOICE == 2 ) then CATCHCN = MAPL_AddChild('CATCHCNCLM40'//trim(tmp), 'setservices_', parentGC=GC, sharedObj='libGEOScatchCNCLM40_GridComp.so', RC=STATUS) VERIFY_(STATUS) - else if ( LSM_CHOICE == 3 ) then + else if ( LSM_CHOICE == 4 ) then CATCHCN = MAPL_AddChild('CATCHCNCLM51'//trim(tmp), 'setservices_', parentGC=GC, sharedObj='libGEOScatchCNCLM51_GridComp.so', RC=STATUS) VERIFY_(STATUS) else - _ASSERT( .false., " LSM_CHOICE should equal 2 (CLM40) or 3 (CLM51)") + _ASSERT( .false., " LSM_CHOICE should equal 2 (CLM40) or 4 (CLM51)") endif wrap%ptr =>CATCHCN_INTERNAL_STATE diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 index e6356cc09..4bfe5deca 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 @@ -109,7 +109,7 @@ subroutine SurfParams_init(LAND_PARAMS,LSM_CHOICE, rc) _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') end select - else if (LSM_CHOICE==3) then + else if (LSM_CHOICE==4) then select case (LAND_PARAMS) case ("CN_CLM51") From c35e04ffc734654baca924dc37ff71a73664af82 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 28 May 2024 11:24:08 -0400 Subject: [PATCH 540/589] add missing read for mortality parameters --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index d4d69a6ed..b55462bd9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -76,6 +76,8 @@ module CN_initMod use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams use SoilBiogeochemCompetitionMod , only : SoilBiogeochemCompetitionInit use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams + use CNGapMortalityMod , only : readCNGapMortalityParams => readParams + use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControlInit use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & @@ -336,6 +338,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call readSoilBiogeochemNLeachingParams(ncid) call readSoilBiogeochemCompetitionParams(ncid) call readSoilBiogeochemPotentialParams(ncid) + call readCNGapMortalityParams(ncid) call ncid%close(rc=status) From cc3f396b01ed01c32cb73785e8a4cfc6b8ea7d7f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 12 Jun 2024 09:09:23 -0400 Subject: [PATCH 541/589] replace constant water stress threshold with dependence on local wilting point --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 1 + .../CLM51/CNCLM_SoilStateType.F90 | 2 ++ .../GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 | 7 +++++++ 3 files changed, 10 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 0dad1c69f..8c5e1fe9c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -242,6 +242,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m temperature_inst%t_grnd_col(n) = temperature_inst%t_soisno_col(n,1) temperature_inst%t_soi17cm_col(n) = temperature_inst%t_grnd_col(n) soilstate_inst%soilpsi_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point + soilstate_inst%psiwilt_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*wpwet(nc)**(-bee(nc)) ! jkolassa: soil water potential at wilting point (not a CLM variable, but added to use instead of constant threshold to determine water stress) soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd) = poros(nc) atm2lnd_inst%forc_t_downscaled_col(n) = tairm(nc) water_inst%wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index bdf160355..4c6cff281 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -43,6 +43,7 @@ module SoilStateType real(r8), pointer :: soilalpha_col (:) ! col factor that reduces ground saturated specific humidity (-) real(r8), pointer :: soilalpha_u_col (:) ! col urban factor that reduces ground saturated specific humidity (-) real(r8), pointer :: soilpsi_col (:,:) ! col soil water potential in each soil layer (MPa) (CN) + real(r8), pointer :: psiwilt_col (:,:) ! col soil water potential at wilting point (added by jkolassa to use for assessing water stress instead of globally constant value) real(r8), pointer :: wtfact_col (:) ! col maximum saturated fraction for a gridcell real(r8), pointer :: porosity_col (:,:) ! col soil porisity (1-bulk_density/soil_density) (VIC) real(r8), pointer :: eff_porosity_col (:,:) ! col effective porosity = porosity - vol_ice (nlevgrnd) @@ -129,6 +130,7 @@ subroutine Init(this, bounds) allocate(this%soilalpha_col (begc:endc)) ; this%soilalpha_col (:) = nan allocate(this%soilalpha_u_col (begc:endc)) ; this%soilalpha_u_col (:) = nan allocate(this%soilpsi_col (begc:endc,nlevgrnd)) ; this%soilpsi_col (:,:) = nan + allocate(this%psiwilt_col (begc:endc,nlevgrnd)) ; this%psiwilt_col (:,:) = nan allocate(this%wtfact_col (begc:endc)) ; this%wtfact_col (:) = nan allocate(this%porosity_col (begc:endc,nlayer)) ; this%porosity_col (:,:) = spval allocate(this%eff_porosity_col (begc:endc,nlevgrnd)) ; this%eff_porosity_col (:,:) = spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 index a5e537345..a25db441c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNPhenologyMod.F90 @@ -1330,6 +1330,13 @@ subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & c = patch%column(p) g = patch%gridcell(p) + ! jkolassa Jun 2024: make water stress threshold depedent on the wilting point + ! at a given location instead of using global constant value + ! (following similar implementation in older versions of + ! Catchment-CN) + soilpsi_on = soilstate_inst%psiwilt_col(c,1) + soilpsi_off = soilstate_inst%psiwilt_col(c,1) + if (stress_decid(ivt(p)) == 1._r8) then soilt = t_soisno(c, phenology_soil_layer) psi = soilpsi(c, phenology_soil_layer) From 5096e6fc99c57b7a65e8cabe4f90f16d3535e42c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 12 Jun 2024 09:13:55 -0400 Subject: [PATCH 542/589] set fcur and leaf_long parameters for non-evergreen types to values used in Catchment-CN4.0 and 4.5 --- .../CLM51/CNCLM_pftconMod.F90 | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 index af69468ba..bf52e3aab 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_pftconMod.F90 @@ -320,7 +320,7 @@ subroutine init_pftcon_type(this) class(pftcon_type) :: this - integer :: ierr, clm_varid, status, m + integer :: ierr, clm_varid, status, m, n logical :: readv ! has variable been read in or not type(Netcdf4_fileformatter) :: ncid @@ -593,6 +593,12 @@ subroutine init_pftcon_type(this) call ncd_io('fcur', this%fcur, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + do n = 0,mxpft + if (this%fcur(n)==0.) then + this%fcur(n) = 0.5 + end if + end do + call ncd_io('fcurdv', this%fcurdv, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) @@ -617,6 +623,13 @@ subroutine init_pftcon_type(this) call ncd_io('leaf_long', this%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + do n = 0,mxpft + if (this%leaf_long(n) .lt. 1.) then + this%leaf_long(n) = 1. + end if + end do + + call ncd_io('evergreen', this%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) From 557865257bac041eb0ddcc02f2dd45ff59fc3b8b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 12 Jun 2024 09:26:29 -0400 Subject: [PATCH 543/589] pass psn, lmr, and lai as separate variables to CLM routines instead of passing their product --- .../CLM51/CNCLM_DriverMod.F90 | 6 +++++- .../GEOS_CatchCNCLM51GridComp.F90 | 18 +++++++++++++----- 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 8c5e1fe9c..cd00dad4f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -65,7 +65,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& fsnow,tg10d,t2m5d,sndzn5d,water_inst,first, & - psnsunm, psnsham, lmrsunm, lmrsham, & + psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, & zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& @@ -118,6 +118,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch,num_veg,num_zon), intent(in) :: psnsham real, dimension(nch,num_veg,num_zon), intent(in) :: lmrsunm real, dimension(nch,num_veg,num_zon), intent(in) :: lmrsham + real, dimension(nch,num_veg,num_zon), intent(in) :: laisunm + real, dimension(nch,num_veg,num_zon), intent(in) :: laisham ! OUTPUT @@ -287,6 +289,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m photosyns_inst%psnsha_patch(p) = psnsham(nc,nv,nz) photosyns_inst%lmrsun_patch(p) = lmrsunm(nc,nv,nz) photosyns_inst%lmrsha_patch(p) = lmrsham(nc,nv,nz) + canopystate_inst%laisun_patch(p) = laisunm(nc,nv,nz) + canopystate_inst%laisha_patch(p) = laisham(nc,nv,nz) end if end do ! nv end do ! np diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 56fa77568..fb05f3871 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -4723,6 +4723,8 @@ subroutine Driver ( RC ) real, dimension(:,:,:), pointer :: psnsham real, dimension(:,:,:), pointer :: lmrsunm real, dimension(:,:,:), pointer :: lmrsham + real, dimension(:,:,:), pointer :: laisunm + real, dimension(:,:,:), pointer :: laisham real, dimension(:), pointer :: sndzm real, dimension(:), pointer :: sndzm5d real, dimension(:), pointer :: asnowm @@ -6969,10 +6971,12 @@ subroutine Driver ( RC ) snowfm = snowfm + SNO runsrfm = runsrfm + RUNSURF ar1m = ar1m + car1 - psnsunm = psnsunm + psnsun*laisun - psnsham = psnsham + psnsha*laisha - lmrsunm = lmrsunm + lmrsun*laisun - lmrsham = lmrsham + lmrsha*laisha + psnsunm = psnsunm + psnsun + psnsham = psnsham + psnsha + lmrsunm = lmrsunm + lmrsun + lmrsham = lmrsham + lmrsha + laisunm = laisunm + laisun + laisham = laisham + laisha do n = 1,N_snow sndzm(:) = sndzm(:) + sndzn(n,:) end do @@ -7008,6 +7012,8 @@ subroutine Driver ( RC ) psnsham(:,nv,nz) = psnsham(:,nv,nz) / cnsum(:) lmrsunm(:,nv,nz) = lmrsunm(:,nv,nz) / cnsum(:) lmrsham(:,nv,nz) = lmrsham(:,nv,nz) / cnsum(:) + laisunm(:,nv,nz) = laisunm(:,nv,nz) / cnsum(:) + laisham(:,nv,nz) = laisham(:,nv,nz) / cnsum(:) end do end do tpm = tpm / cnsum @@ -7027,7 +7033,7 @@ subroutine Driver ( RC ) rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, first_cn, & - psnsunm, psnsham, lmrsunm, lmrsham, & + psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, & elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& fire_nloss,leafn,leafc,gross_nmin,net_nmin,& @@ -7128,6 +7134,8 @@ subroutine Driver ( RC ) psnsham = 0. lmrsunm = 0. lmrsham = 0. + laisunm = 0. + laisham = 0. sndzm = 0. asnowm = 0. cnsum = 0. From 319c1633a83e7cd78d317dbf8113eaf192461006 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 12 Jun 2024 10:16:58 -0400 Subject: [PATCH 544/589] add wpwet as input to CN_Driver --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 3 ++- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index cd00dad4f..c8d996700 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -65,7 +65,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& fsnow,tg10d,t2m5d,sndzn5d,water_inst,first, & - psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, & + psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, wpwet, & zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& @@ -120,6 +120,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch,num_veg,num_zon), intent(in) :: lmrsham real, dimension(nch,num_veg,num_zon), intent(in) :: laisunm real, dimension(nch,num_veg,num_zon), intent(in) :: laisham + real, dimension(nch), intent(in) :: wpwet ! wetness at wilting point ! OUTPUT diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index fb05f3871..50269c673 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -7033,7 +7033,7 @@ subroutine Driver ( RC ) rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, first_cn, & - psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, & + psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, wpwet, & elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& fire_nloss,leafn,leafc,gross_nmin,net_nmin,& From 70e6df508fb5ea2f294ff19d36d4612811f63ed9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 12 Jun 2024 15:24:50 -0400 Subject: [PATCH 545/589] adding LAI sum fo CN as restart variable --- .../GEOS_CatchCNCLM51GridComp.F90 | 25 ++++++++++ .../Utils/mk_restarts/CatchmentCNRst.F90 | 49 ++++++++++++++++++- 2 files changed, 73 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 50269c673..631c70815 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -1801,6 +1801,29 @@ subroutine SetServices ( GC, RC ) RESTART = MAPL_RestartOptional ,& RC=STATUS ) VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for sunlit leaf area index',& + UNITS = '1' ,& + SHORT_NAME = 'LAISUNM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_VEG,NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = 'CN sum for shaded leaf area index',& + UNITS = '1' ,& + SHORT_NAME = 'LAISHAM' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + UNGRIDDED_DIMS = (/NUM_VEG,NUM_ZON/) ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'CN sum for snow depth' ,& @@ -5429,6 +5452,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,PSNSHAM ,'PSNSHAM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,LMRSUNM ,'LMRSUNM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,LMRSHAM ,'LMRSHAM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,LAISUNM ,'LAISUNM' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,LAISHAM ,'LAISHAM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,SNDZM ,'SNDZM' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,SNDZM5D ,'SNDZM5D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,ASNOWM ,'ASNOWM' ,RC=STATUS); VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 4c34f8f43..93931b570 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -69,6 +69,10 @@ module CatchmentCNRstMod real, allocatable :: sfmcm(:) real, allocatable :: psnsunm(:,:,:) real, allocatable :: psnsham(:,:,:) + real, allocatable :: lmrsunm(:,:,:) + real, allocatable :: lmrsham(:,:,:) + real, allocatable :: laisunm(:,:,:) + real, allocatable :: laisham(:,:,:) real, allocatable :: rh30d(:) real, allocatable :: tg10d(:) real, allocatable :: t2mmin5d(:) @@ -223,6 +227,10 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) call MAPL_VarRead(formatter, "ASNOWM", catch%asnowm ,_RC) call MAPL_VarRead(formatter, "PSNSUNM", catch%psnsunm,_RC) call MAPL_VarRead(formatter, "PSNSHAM", catch%psnsham,_RC) + call MAPL_VarRead(formatter, "LMRSUNM", catch%lmrsunm,_RC) + call MAPL_VarRead(formatter, "LMRSHAM", catch%lmrsham,_RC) + call MAPL_VarRead(formatter, "LAISUNM", catch%psnsunm,_RC) + call MAPL_VarRead(formatter, "LAISHAM", catch%psnsham,_RC) call MAPL_VarRead(formatter, "RZMM", catch%rzmm ,_RC) call MAPL_VarRead(formatter, "TGWM", catch%tgwm ,_RC) endif @@ -331,6 +339,8 @@ subroutine write_nc4(this, filename, rc) call MAPL_VarWrite(formatter,"T2M10D", this%t2m10d ) call MAPL_VarWrite(formatter,"TPREC10D",this%tprec10d ) call MAPL_VarWrite(formatter,"TPREC60D",this%tprec60d ) + call MAPL_VarWrite(formatter,"LMRSUNM", this%LMRSUNM ) + call MAPL_VarWrite(formatter,"LMRSHAM", this%LMRSHAM ) elseif (this%isCLM51) then @@ -354,6 +364,10 @@ subroutine write_nc4(this, filename, rc) call MAPL_VarWrite(formatter,"RH30D", this%RH30D) call MAPL_VarWrite(formatter,"TPREC10D",this%TPREC10D) call MAPL_VarWrite(formatter,"TPREC60D",this%TPREC60D) + call MAPL_VarWrite(formatter,"LMRSUNM", this%LMRSUNM ) + call MAPL_VarWrite(formatter,"LMRSHAM", this%LMRSHAM ) + call MAPL_VarWrite(formatter,"LAISUNM", this%LAISUNM ) + call MAPL_VarWrite(formatter,"LAISHAM", this%LAISHAM ) endif @@ -409,6 +423,10 @@ subroutine allocate_cn(this,rc) allocate(this%asnowm (ntiles)) allocate(this%psnsunm(ntiles,nveg,nzone)) allocate(this%psnsham(ntiles,nveg,nzone)) + allocate(this%lmrsunm(ntiles,nveg,nzone)) + allocate(this%lmrsham(ntiles,nveg,nzone)) + allocate(this%laisunm(ntiles,nveg,nzone)) + allocate(this%laisham(ntiles,nveg,nzone)) allocate(this%rzmm (ntiles,nzone)) allocate(this%tgwm (ntiles,nzone)) @@ -696,7 +714,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) real, allocatable, dimension(:,:) :: fveg_offl, ityp_offl, tg_tmp, dummy_tmp real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:), var_out(:), var_psn(:,:,:), & - var_out_zone(:,:) + var_out_zone(:,:), var_lmr(:,:,:), var_lai(:,:,:) integer :: status, in_ntiles, out_ntiles, numprocs, npft_int logical :: root_proc integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft, nveg @@ -997,6 +1015,35 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) enddo this%psnsham = var_psn + do nz = 1, nzone + do nv = 1, nveg + var_lmr(:,nv,nz) = this%lmrsunm(this%id_glb(:), nv,nz) + enddo + enddo + this%lmrsunm= var_lmr + + do nz = 1, nzone + do nv = 1, nveg + var_lmr(:,nv,nz) = this%lmrsham(this%id_glb(:), nv,nz) + enddo + enddo + this%lmrsham = var_lmr + + do nz = 1, nzone + do nv = 1, nveg + var_lai(:,nv,nz) = this%laisunm(this%id_glb(:), nv,nz) + enddo + enddo + this%psnlai= var_lai + + do nz = 1, nzone + do nv = 1, nveg + var_lai(:,nv,nz) = this%laisham(this%id_glb(:), nv,nz) + enddo + enddo + this%laisham = var_lai + + do nz = 1, nzone var_out_zone(:,nz) = this%rzmm(this%id_glb(:), nz) enddo From 398fda1aa969e8596b5edb4c3aeffc34aee57843 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 12 Jun 2024 16:51:40 -0400 Subject: [PATCH 546/589] typo fix --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 93931b570..e98bae6c4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -1034,7 +1034,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) var_lai(:,nv,nz) = this%laisunm(this%id_glb(:), nv,nz) enddo enddo - this%psnlai= var_lai + this%laisunm= var_lai do nz = 1, nzone do nv = 1, nveg From d8a9a258591b41fca242bf0c1a9eeafcd41c4652 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Aug 2024 15:31:14 -0400 Subject: [PATCH 547/589] add autotrophic and heterotrophic respiration as outputs --- .../GEOS_SurfaceGridComp.F90 | 51 ++++++++++++++++++- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 4 ++ .../GEOS_CatchCNGridComp.F90 | 6 ++- .../CLM51/CNCLM_DriverMod.F90 | 8 ++- .../GEOS_CatchCNCLM51GridComp.F90 | 31 ++++++++++- 5 files changed, 95 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index 276455e17..030c2c6d9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -2884,6 +2884,24 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_autotrophic_respiration' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNAR' ,& + DIMS = MAPL_DimsHorzOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_heterotrophic_respiration' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNHR' ,& + DIMS = MAPL_DimsHorzOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'CN_net_ecosystem_exchange' ,& @@ -5472,6 +5490,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: CNNPP => NULL() real, pointer, dimension(:,:) :: CNGPP => NULL() real, pointer, dimension(:,:) :: CNSR => NULL() + real, pointer, dimension(:,:) :: CNAR => NULL() + real, pointer, dimension(:,:) :: CNHR => NULL() real, pointer, dimension(:,:) :: CNNEE => NULL() real, pointer, dimension(:,:) :: CNXSMR => NULL() real, pointer, dimension(:,:) :: CNADD => NULL() @@ -5760,6 +5780,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:) :: CNNPPTILE => NULL() real, pointer, dimension(:) :: CNGPPTILE => NULL() real, pointer, dimension(:) :: CNSRTILE => NULL() + real, pointer, dimension(:) :: CNARTILE => NULL() + real, pointer, dimension(:) :: CNHRTILE => NULL() real, pointer, dimension(:) :: CNNEETILE => NULL() real, pointer, dimension(:) :: CNXSMRTILE => NULL() real, pointer, dimension(:) :: CNADDTILE => NULL() @@ -6626,6 +6648,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , CNROOT , 'CNROOT' , RC=STATUS); VERIFY_(STATUS) if (LSM_CHOICE >= 3) then call MAPL_GetPointer(EXPORT , CNFROOTC, 'CNFROOTC' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , CNAR, 'CNAR' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , CNHR, 'CNHR' ,RC=STATUS); VERIFY_(STATUS) endif call MAPL_GetPointer(EXPORT , CNNPP , 'CNNPP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , CNGPP , 'CNGPP' , RC=STATUS); VERIFY_(STATUS) @@ -7232,7 +7256,9 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MKTILE(CNVEGC ,CNVEGCTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(CNROOT ,CNROOTTILE ,NT,RC=STATUS); VERIFY_(STATUS) if (LSM_CHOICE >= 3) then - call MKTILE(CNFROOTC,CNFROOTCTILE ,NT,RC=STATUS);VERIFY_(STATUS) + call MKTILE(CNFROOTC,CNFROOTCTILE ,NT,RC=STATUS); VERIFY_(STATUS) + call MKTILE(CNAR ,CNARTILE ,NT,RC=STATUS); VERIFY_(STATUS) + call MKTILE(CNHR ,CNHRTILE ,NT,RC=STATUS); VERIFY_(STATUS) endif call MKTILE(CNNPP ,CNNPPTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(CNGPP ,CNGPPTILE ,NT,RC=STATUS); VERIFY_(STATUS) @@ -8151,6 +8177,14 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_LocStreamTransform( LOCSTREAM,CNSR ,CNSRTILE , RC=STATUS) VERIFY_(STATUS) endif + if(associated(CNAR)) then + call MAPL_LocStreamTransform( LOCSTREAM,CNAR ,CNARTILE , RC=STATUS) + VERIFY_(STATUS) + endif + if(associated(CNHR)) then + call MAPL_LocStreamTransform( LOCSTREAM,CNHR ,CNHRTILE , RC=STATUS) + VERIFY_(STATUS) + endif if(associated(CNNEE)) then call MAPL_LocStreamTransform( LOCSTREAM,CNNEE ,CNNEETILE , RC=STATUS) VERIFY_(STATUS) @@ -8764,6 +8798,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) if(associated(CNNPPTILE )) deallocate(CNNPPTILE ) if(associated(CNGPPTILE )) deallocate(CNGPPTILE ) if(associated(CNSRTILE )) deallocate(CNSRTILE ) + if(associated(CNARTILE )) deallocate(CNARTILE ) + if(associated(CNHRTILE )) deallocate(CNHRTILE ) if(associated(CNNEETILE )) deallocate(CNNEETILE ) if(associated(CNXSMRTILE )) deallocate(CNXSMRTILE ) if(associated(CNADDTILE )) deallocate(CNADDTILE ) @@ -9106,6 +9142,11 @@ subroutine DOTYPE(type,RC) VERIFY_(STATUS) if (LSM_CHOICE >= 3) then call MAPL_GetPointer(GEX(type), dum, 'CNFROOTC' , ALLOC=associated(CNFROOTCTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'CNAR' , ALLOC=associated(CNARTILE ), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'CNHR' , ALLOC=associated(CNHRTILE ), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) endif VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'CNNPP' , ALLOC=associated(CNNPPTILE ), notFoundOK=.true., RC=STATUS) @@ -9754,6 +9795,14 @@ subroutine DOTYPE(type,RC) call FILLOUT_TILE(GEX(type), 'CNSR' , CNSRTILE , XFORM, RC=STATUS) VERIFY_(STATUS) end if + if(associated(CNARTILE)) then + call FILLOUT_TILE(GEX(type), 'CNAR' , CNARTILE , XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + if(associated(CNHRTILE)) then + call FILLOUT_TILE(GEX(type), 'CNHR' , CNHRTILE , XFORM, RC=STATUS) + VERIFY_(STATUS) + end if if(associated(CNNEETILE)) then call FILLOUT_TILE(GEX(type), 'CNNEE' , CNNEETILE , XFORM, RC=STATUS) VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index ec63347c3..b18090885 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -1216,6 +1216,10 @@ subroutine SetServices ( GC, RC ) if (LSM_CHOICE >= 3) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNFROOTC' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNAR' , CHILD_ID = CATCHCN(1), RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNHR' , CHILD_ID = CATCHCN(1), RC=STATUS ) + VERIFY_(STATUS) endif call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNNPP' , CHILD_ID = CATCHCN(1), RC=STATUS ) VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index b3ad1c50f..27c28bd24 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -936,9 +936,13 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNROOT' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) - if (LSM_CHOICE >= 3) then ! jkolassa: needed for CNCLM45 and CNCLM51 + if (LSM_CHOICE >= 3) then ! jkolassa: needed for CNCLM51 call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNFROOTC' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNAR' , CHILD_ID = CATCHCN, RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNHR' , CHILD_ID = CATCHCN, RC=STATUS ) + VERIFY_(STATUS) endif call MAPL_AddExportSpec ( GC, SHORT_NAME = 'CNNPP' , CHILD_ID = CATCHCN, RC=STATUS ) VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index c8d996700..ca26d2673 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -66,7 +66,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& fsnow,tg10d,t2m5d,sndzn5d,water_inst,first, & psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, wpwet, & - zlai,zsai,ztai,colc,nppg,gppg,srg,neeg,burn,closs,nfire,& + zlai,zsai,ztai,colc,nppg,gppg,srg,arg,hrg,neeg,burn,closs,nfire,& som_closs,root,vegc,xsmr,ndeployg,denitg,sminn_leachedg,sminng,& col_fire_nlossg,leafng,leafcg,gross_nming,net_nming,& nfix_to_sminng,actual_immobg,fpgg,fpig,sminn_to_plantg,& @@ -134,6 +134,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(out) :: gppg ! (gC/m2/s) gross primary production [PFT] real, dimension(nch), intent(out) :: srg ! (gC/m2/s) total soil respiration (HR + root resp) [column] + real, dimension(nch), intent(out) :: arg ! (gC/m2/s) autotrophic respiration [column] + real, dimension(nch), intent(out) :: hrg ! (gC/m2/s) heterotrophic respiration [column] real, dimension(nch), intent(out) :: neeg ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, landuse, harvest, and hrv_xsmrpool flux, positive for source [column] real, dimension(nch), intent(out) :: fuelcg ! fuel avalability for non-crop areas outside tropical closed broadleaf evergreen closed forests (gC/m2) @@ -392,6 +394,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m nppg(nc) = 0. gppg(nc) = 0. srg(nc) = 0. + arg(nc) = 0. + hrg(nc) = 0. burn(nc) = 0. closs(nc) = 0. som_closs(nc) = 0. @@ -432,6 +436,8 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m colc(nc,nz) = bgc_vegetation_inst%cnveg_carbonstate_inst%totc_col(n) srg(nc) = srg(nc) + bgc_vegetation_inst%cnveg_carbonflux_inst%sr_col(n)*CN_zone_weight(nz) + arg(nc) = arg(nc) + bgc_vegetation_inst%cnveg_carbonflux_inst%ar_col(n)*CN_zone_weight(nz) + hrg(nc) = hrg(nc) + soilbiogeochem_carbonflux_inst%hr_col(n)*CN_zone_weight(nz) burn(nc) = burn(nc) + bgc_vegetation_inst%cnveg_state_inst%farea_burned_col(n)*CN_zone_weight(nz) closs(nc) = closs(nc) + bgc_vegetation_inst%cnveg_carbonflux_inst%fire_closs_col(n)*CN_zone_weight(nz) som_closs(nc) = som_closs(nc) + soilbiogeochem_carbonflux_inst%somc_fire_col(n)*CN_zone_weight(nz) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 631c70815..83f777f78 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -3288,6 +3288,25 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_autotrophic_respiration' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNAR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'CN_heterotrophic_respiration' ,& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'CNHR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& LONG_NAME = 'CN_net_ecosystem_exchange' ,& UNITS = 'kg m-2 s-1' ,& @@ -4880,6 +4899,8 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: CNNPP real, dimension(:), pointer :: CNGPP real, dimension(:), pointer :: CNSR + real, dimension(:), pointer :: CNAR + real, dimension(:), pointer :: CNHR real, dimension(:), pointer :: CNNEE real, dimension(:), pointer :: CNXSMR real, dimension(:), pointer :: CNADD @@ -5122,7 +5143,7 @@ subroutine Driver ( RC ) real, allocatable, dimension(:) :: para real, allocatable, dimension(:) :: rcxdt, rcxdq real, allocatable, dimension(:) :: dayl, dayl_fac - real, allocatable, dimension(:), save :: nee, npp, gpp, sr, padd, frootc, vegc, xsmr,burn, closs + real, allocatable, dimension(:), save :: nee, npp, gpp, sr, aresp, hresp, padd, frootc, vegc, xsmr,burn, closs real, allocatable, dimension(:) :: nfire, som_closs, fsnow real, allocatable, dimension(:) :: ndeploy, denit, sminn_leached, sminn, fire_nloss real, allocatable, dimension(:) :: leafn, leafc, gross_nmin, net_nmin, nfix_to_sminn, actual_immob @@ -5592,6 +5613,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,CNNPP , 'CNNPP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNGPP , 'CNGPP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNSR , 'CNSR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNAR , 'CNAR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNHR , 'CNHR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNNEE , 'CNNEE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNXSMR , 'CNXSMR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNADD , 'CNADD' , RC=STATUS); VERIFY_(STATUS) @@ -6371,6 +6394,8 @@ subroutine Driver ( RC ) if(.not. allocated(npp )) allocate( npp(ntiles) ) if(.not. allocated(gpp )) allocate( gpp(ntiles) ) if(.not. allocated(sr )) allocate( sr(ntiles) ) + if(.not. allocated(aresp)) allocate( aresp(ntiles) ) + if(.not. allocated(hresp)) allocate( hresp(ntiles) ) if(.not. allocated(nee )) allocate( nee(ntiles) ) if(.not. allocated(padd)) allocate( padd(ntiles) ) if(.not. allocated(frootc)) allocate(frootc(ntiles) ) @@ -7059,7 +7084,7 @@ subroutine Driver ( RC ) abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, first_cn, & psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, wpwet, & - elai,esai,tlai,totcolc,npp,gpp,sr,nee,burn,closs,nfire,& + elai,esai,tlai,totcolc,npp,gpp,sr,aresp,hresp,nee,burn,closs,nfire,& som_closs,frootc,vegc,xsmr,ndeploy,denit,sminn_leached,sminn,& fire_nloss,leafn,leafc,gross_nmin,net_nmin,& nfix_to_sminn,actual_immob,fpg,fpi,sminn_to_plant,& @@ -7210,6 +7235,8 @@ subroutine Driver ( RC ) if(associated(CNNPP )) cnnpp = 1.e-3*npp ! * cnsum if(associated(CNGPP )) cngpp = 1.e-3*gpp ! * cnsum if(associated(CNSR )) cnsr = 1.e-3*sr ! * cnsum + if(associated(CNAR )) cnar = 1.e-3*aresp ! * cnsum + if(associated(CNHR )) cnhr = 1.e-3*hresp ! * cnsum if(associated(CNNEE )) cnnee = 1.e-3*nee ! * cnsum if(associated(CNXSMR)) cnxsmr = 1.e-3*xsmr ! * cnsum if(associated(CNADD )) cnadd = 1.e-3*padd ! * cnsum From c38cb29f63ec12d64bce923fdeaf728738a3191f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 22 Oct 2024 11:20:39 -0400 Subject: [PATCH 548/589] enabling use_felxibleCN --- .../NutrientCompetitionFlexibleCNMod.F90 | 14 +++++----- .../CLM51/clm_varctl.F90 | 27 ++++++++++++------- 2 files changed, 25 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 index dd75aea2b..668cd9672 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFlexibleCNMod.F90 @@ -53,7 +53,7 @@ module NutrientCompetitionFlexibleCNMod ! interface nutrient_competition_FlexibleCN_type ! initialize a new nutrient_competition_FlexibleCN_type object - ! module procedure constructor + module procedure constructor end interface nutrient_competition_FlexibleCN_type ! @@ -66,12 +66,12 @@ module NutrientCompetitionFlexibleCNMod contains !------------------------------------------------------------------------ -! type(nutrient_competition_FlexibleCN_type) function constructor() -! ! -! ! !DESCRIPTION: -! ! Creates an object of type nutrient_competition_FlexibleCN_type. -! ! For now, this is simply a place-holder. -! end function constructor + type(nutrient_competition_FlexibleCN_type) function constructor() + ! + ! !DESCRIPTION: + ! Creates an object of type nutrient_competition_FlexibleCN_type. + ! For now, this is simply a place-holder. + end function constructor !------------------------------------------------------------------------ subroutine Init(this, bounds) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index ab8e327c6..7ed54c03d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -41,13 +41,17 @@ module clm_varctl logical, public :: use_biomass_heat_storage = .false. logical, public :: use_fertilizer = .false. - logical, public :: downreg_opt = .true. + ! logical, public :: downreg_opt = .true. + logical, public :: downreg_opt = .false. logical, public :: nscalar_opt = .true. - integer, public :: plant_ndemand_opt = 0 + ! integer, public :: plant_ndemand_opt = 0 + integer, public :: plant_ndemand_opt = 3 logical, public :: substrate_term_opt = .true. logical, public :: temp_scalar_opt = .true. - integer, public :: CN_residual_opt = 0 - integer, public :: CN_partition_opt = 0 + ! integer, public :: CN_residual_opt = 0 + integer, public :: CN_residual_opt = 1 + ! integer, public :: CN_partition_opt = 0 + integer, public :: CN_partition_opt = 1 logical, public :: use_c13 = .false. ! true => use C-13 model logical, public :: use_c14 = .false. ! true => use C-14 model @@ -77,12 +81,17 @@ module clm_varctl !---------------------------------------------------------- ! flexibleCN !---------------------------------------------------------- - logical, public :: use_flexibleCN = .false. - logical, public :: CNratio_floating = .false. - integer, public :: CN_evergreen_phenology_opt = 0 - logical, public :: lnc_opt = .false. + !logical, public :: use_flexibleCN = .false. + logical, public :: use_flexibleCN = .true. + !logical, public :: CNratio_floating = .false. + logical, public :: CNratio_floating = .true. + !integer, public :: CN_evergreen_phenology_opt = 0 + integer, public :: CN_evergreen_phenology_opt = 1 + !logical, public :: lnc_opt = .false. + logical, public :: lnc_opt = .true. logical, public :: reduce_dayl_factor = .false. - integer, public :: vcmax_opt = 0 + !integer, public :: vcmax_opt = 0 + integer, public :: vcmax_opt = 3 !---------------------------------------------------------- ! BGC logic and datasets From 3a474973efeefd864d10b05bd55e3df2a84361c7 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 22 Oct 2024 14:03:34 -0400 Subject: [PATCH 549/589] enable allocation of felxible_CN nutrient competition method --- .../CLM51/NutrientCompetitionFactoryMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 index bba2746bd..99daa738f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/NutrientCompetitionFactoryMod.F90 @@ -72,8 +72,8 @@ function create_nutrient_competition_method(bounds) result(nutrient_competition_ source=nutrient_competition_clm45default_type()) case ("flexible_cn") - ! allocate(nutrient_competition_method, & - ! source=nutrient_competition_FlexibleCN_type()) + allocate(nutrient_competition_method, & + source=nutrient_competition_FlexibleCN_type()) case default write(iulog,*) subname//' ERROR: unknown method: ', method From 5c5706de003e0ea11efc79e4331230b46733e78e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 23 Oct 2024 15:39:33 -0400 Subject: [PATCH 550/589] provide wetness from hydrological zones mapped to carbon zones to photosynthesis routines --- .../CLM51/CNCLM51_Photosynthesis.F90 | 6 +++--- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 index 48ac8de5d..30c5900c1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM51_Photosynthesis.F90 @@ -55,7 +55,7 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & real, intent(in) :: tm(nch) ! air temperature at agcm reference height (K) real, intent(in) :: cond(nch) ! saturated hydraulic conductivity (m/s) real, intent(in) :: psis(nch) ! saturated matric potential [m] - real, intent(in) :: wet3(nch) ! average soil profile wetness [-] + real, intent(in) :: wet3(nch,num_zon) ! average soil profile wetness [-] real, intent(in) :: bee(nch) ! Clapp-Hornberger 'b' [-] real, intent(in) :: capac(nch) ! interception reservoir capacity [kg m^-2] real, intent(in) :: fwet(nch) ! fraction of canopy that is wet (0-1) @@ -275,9 +275,9 @@ subroutine catchcn_calc_rc(nch,fveg,tc,qa,pbot,co2v,dayl_factor, & soilstate_inst%hksat_col (n,1:nlevgrnd) = 1000.*COND(nc) ! saturated hydraulic conductivity mapped to CLM space ! and converted to [mm/s] - soilstate_inst%hk_l_col (n,1:nlevgrnd) = 1000.*COND(nc)*(wet3(nc)**(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space + soilstate_inst%hk_l_col (n,1:nlevgrnd) = 1000.*COND(nc)*(wet3(nc,nz)**(2*bee(nc)+3)) ! actual hydraulic conductivity mapped to CLM space ! and converted to [mm/s] - soilstate_inst%smp_l_col (n,1:nlevgrnd) = 1000.*PSIS(nc)*(max(1.e-06_r8,wet3(nc))**(-bee(nc))) ! actual soil matric potential mapped to CLM space + soilstate_inst%smp_l_col (n,1:nlevgrnd) = 1000.*PSIS(nc)*(max(1.e-06_r8,wet3(nc,nz))**(-bee(nc))) ! actual soil matric potential mapped to CLM space ! and converted to [mm] soilstate_inst%bsw_col (n,1:nlevgrnd) = bee(nc) ! Clapp-Hornberger 'b' soilstate_inst%sucsat_col (n,1:nlevgrnd) = 1000.*psis(nc)*(-1) ! minimum soil suction [mm] diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 83f777f78..ca4ac4756 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -6888,7 +6888,7 @@ subroutine Driver ( RC ) wet_in = max(min(PRMC / POROS,1.0),0.0) call catchcn_calc_rc(ntiles,fveg,TCx,QAx,PS,co2v,dayl_fac, & - T2M10D,TA,cond,psis,wet_in,bee,capac,fwet,ZTH,ityp,& + T2M10D,TA,cond,psis,rzm,bee,capac,fwet,ZTH,ityp,& DRPAR,DFPAR,albdir,albdif,dtc,dea,water_inst,bgc_vegetation_inst,rc00,rcdq,rcdt,& laisun,laisha,psnsun,psnsha,lmrsun,lmrsha,parzone,& btran) From 6b670b4265221a12a93bbff9fa1442aec930e118 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 28 Oct 2024 11:12:53 -0400 Subject: [PATCH 551/589] change default configuration --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 7ed54c03d..44ebc2ef0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -29,17 +29,17 @@ module clm_varctl logical, public :: use_crop = .false. logical, public :: use_lch4 = .false. - logical, public :: use_nitrif_denitrif = .false. - logical, public :: use_vertsoilc = .false. - logical, public :: use_century_decomp = .false. + logical, public :: use_nitrif_denitrif = .true. + logical, public :: use_vertsoilc = .true. + logical, public :: use_century_decomp = .true. logical, public :: use_cn = .true. logical, public :: use_cndv = .false. logical, public :: use_grainproduct = .false. logical, public :: use_dynroot = .false. - logical, public :: use_bedrock = .false. ! true => use spatially variable soil depth + logical, public :: use_bedrock = .true. ! true => use spatially variable soil depth logical, public :: use_extralakelayers = .false. logical, public :: use_biomass_heat_storage = .false. - logical, public :: use_fertilizer = .false. + logical, public :: use_fertilizer = .true. ! logical, public :: downreg_opt = .true. logical, public :: downreg_opt = .false. From eee124f2de63391e9367b8489c9b9252f9042911 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 4 Nov 2024 12:19:25 -0500 Subject: [PATCH 552/589] count for number of time steps starts at 0 to be consistent with CLM --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 233c480fc..9de9ebc78 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -99,7 +99,8 @@ integer function get_nstep(istep) if(istep_default < 0) stop 'CN: istep_default < 0' get_nstep = istep_default ! for FireMod - + + get_nstep = get_nstep - 1 end function get_nstep !========================================================================================= From 2b59af64abc21c36eefd005aeb97b3053edb94a1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 6 Nov 2024 09:10:56 -0500 Subject: [PATCH 553/589] fix ndep assignment --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index ca26d2673..728b7062b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -231,6 +231,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m grc%dayl(nc) = dayl(nc) water_inst%wateratm2lndbulk_inst%forc_rh_grc(nc) = rhm(nc) atm2lnd_inst%forc_wind_grc(nc) = windm(nc) + atm2lnd_inst%forc_ndep_grc(nc) = ndep(nc) cn2clm_inst%forc_hdm_cn2clm(nc) = hdm(nc) cn2clm_inst%forc_lnfm_cn2clm(nc) = lnfm(nc) From a2e94f4411235d52b853a7b29ccffe748d823d18 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 13 Nov 2024 08:52:03 -0500 Subject: [PATCH 554/589] enable use of FUN model --- .../CLM51/CMakeLists.txt | 4 + .../CLM51/CNCLM_CNVegNitrogenFluxType.F90 | 60 +- .../CLM51/CNFUNMod.F90 | 1811 ++++++++ .../CLM51/CNSharedParamsMod.F90 | 2 +- .../CLM51/CNVegMatrixMod.F90 | 3839 +++++++++++++++++ .../CLM51/MatrixMod.F90 | 144 + .../CLM51/SPMMod.F90 | 1234 ++++++ .../CLM51/clm_varcon.F90 | 4 + 8 files changed, 7096 insertions(+), 2 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegMatrixMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/MatrixMod.F90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SPMMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index e4008864c..cebfcc7bb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -80,6 +80,7 @@ set (srcs CNFireLi2016Mod.F90 CNFireLi2021Mod.F90 CNFireNoFireMod.F90 + CNFUNMod.F90 CNGapMortalityMod.F90 CNGRespMod.F90 CN_init_mod.F90 @@ -93,6 +94,7 @@ set (srcs CNRootDynMod.F90 CNSharedParamsMod.F90 CNVegetationFacade.F90 + CNVegMatrixMod.F90 CNVegStructUpdateMod.F90 column_varcon.F90 fileutils.F90 @@ -100,6 +102,7 @@ set (srcs FireMethodType.F90 initSubgridMod.F90 landunit_varcon.F90 + MatrixMod.F90 ncdio_pio.F90 NutrientCompetitionCLM45defaultMod.F90 NutrientCompetitionFactoryMod.F90 @@ -132,6 +135,7 @@ set (srcs SoilBiogeochemVerticalProfileMod.F90 SoilWaterRetentionCurveMod.F90 spmdMod.F90 + SPMMod.F90 subgridAveMod.F90 SurfaceAlbedoMod.F90 SurfaceRadiationMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 index e2f59ebf5..b7d31f842 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegNitrogenFluxType.F90 @@ -19,6 +19,10 @@ module CNVegNitrogenFluxType use clm_varcon , only : spval, ispval, dzsoi_decomp use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_matrixcn use PatchType , only : patch + use CNSharedParamsMod , only : use_fun + use LandunitType , only : lun + use landunit_varcon , only : istsoil, istcrop + ! !PUBLIC TYPES: implicit none @@ -393,7 +397,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) integer :: begp, endp integer :: begc, endc integer :: begg, endg - integer :: np, nc, nz, p, nv, n + integer :: np, nc, nz, p, nv, n, l, j !-------------------------------- allocate(this%matrix_nphtransfer_doner_patch(1:37)) @@ -991,6 +995,60 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) end do ! nz end do ! nc + do p = begp,endp + l = patch%landunit(p) + + if ( use_crop )then + this%fert_counter_patch(p) = spval + this%fert_patch(p) = 0._r8 + this%soyfixn_patch(p) = 0._r8 + end if + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%fert_counter_patch(p) = 0._r8 + end if + if ( use_fun ) then !previously set to spval for special land units + if (lun%ifspecial(l)) then + this%plant_ndemand_patch(p) = 0._r8 + this%avail_retransn_patch(p) = 0._r8 + this%plant_nalloc_patch(p) = 0._r8 + this%Npassive_patch(p) = 0._r8 + this%Nactive_patch(p) = 0._r8 + this%Nnonmyc_patch(p) = 0._r8 + this%Nam_patch(p) = 0._r8 + this%Necm_patch(p) = 0._r8 + if (use_nitrif_denitrif) then + this%Nactive_no3_patch(p) = 0._r8 + this%Nactive_nh4_patch(p) = 0._r8 + this%Nnonmyc_no3_patch(p) = 0._r8 + this%Nnonmyc_nh4_patch(p) = 0._r8 + this%Nam_no3_patch(p) = 0._r8 + this%Nam_nh4_patch(p) = 0._r8 + this%Necm_no3_patch(p) = 0._r8 + this%Necm_nh4_patch(p) = 0._r8 + end if + this%Nfix_patch(p) = 0._r8 + this%Nretrans_patch(p) = 0._r8 + this%Nretrans_org_patch(p) = 0._r8 + this%Nretrans_season_patch(p) = 0._r8 + this%Nretrans_stress_patch(p) = 0._r8 + this%Nuptake_patch(p) = 0._r8 + this%sminn_to_plant_fun_patch(p) = 0._r8 + this%cost_nfix_patch = 0._r8 + this%cost_nactive_patch = 0._r8 + this%cost_nretrans_patch = 0._r8 + this%nuptake_npp_fraction_patch = 0._r8 + + do j = 1, nlevdecomp + this%sminn_to_plant_fun_vr_patch(p,j) = 0._r8 + this%sminn_to_plant_fun_no3_vr_patch(p,j) = 0._r8 + this%sminn_to_plant_fun_nh4_vr_patch(p,j) = 0._r8 + end do + end if + end if + end do + + end subroutine Init !------------------------------------------ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 new file mode 100755 index 000000000..12dbda862 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 @@ -0,0 +1,1811 @@ +module CNFUNMod +!-------------------------------------------------------------------- + !--- +! ! DESCRIPTION +! ! The FUN model developed by Fisher et al. 2010 and +! ! end Brzostek et al. 2014. Coded by Mingjie Shi 2015. +! ! Coding logic and structure altered by Rosie Fisher. October 2015. +! ! Critically, this removes the 'FUN-resistors' idea of Brzostek et + ! al. 2014 +! ! and replaces it with uptake that is proportional to the N/C + ! exchange rate. +! ! and adjusts the logic so that FUN does not depends upon the + ! CLM4.0 'FPG' downregulation idea +! ! and instead it takes C spent on N uptake away from growth. +! ! The critical output so fthis code are sminn_to_plant_fun and + ! npp_Nuptake, which are the N +! ! available to the plant for grwoth, and the C spent on obtaining + ! it. + +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use PatchType , only : patch + use ColumnType , only : col + use pftconMod , only : pftcon, npcropmin + use decompMod , only : bounds_type + use clm_varctl , only : use_nitrif_denitrif,use_flexiblecn,use_matrixcn + use abortutils , only : endrun + use CNVegstateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type + use CNVegnitrogenfluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use TemperatureType , only : temperature_type + use SoilStateType , only : soilstate_type + use CanopyStateType , only : canopystate_type + use perf_mod , only : t_startf, t_stopf + + implicit none + private +! +! !PUBLIC MEMBER FUNCTIONS: + public:: readParams ! Read in parameters needed for FUN + public:: CNFUNInit ! FUN calculation initialization + public:: CNFUN ! Run FUN + + type, private :: params_type + real(r8) :: ndays_on ! number of days to complete leaf onset + real(r8) :: ndays_off ! number of days to complete leaf offset + end type params_type + + ! + type(params_type), private :: params_inst ! params_inst is + ! populated in readParamsMod + ! + ! + ! !PRIVATE DATA MEMBERS: + real(r8) :: dt ! decomp timestep (seconds) + real(r8) :: ndays_on ! number of days to complete onset + real(r8) :: ndays_off ! number of days to complete offset + + integer, private, parameter :: COST_METHOD = 2 !new way of doing the N uptake + ! resistances. see teamwork thread on over-cheap uptake in N + ! resistors. + integer, private, parameter :: nstp = 2 ! Number of + ! calculation part + integer, private, parameter :: ncost6 = 6 ! Number of + ! N transport pathways + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +! +!-------------------------------------------------------------------- + !--- + contains +!-------------------------------------------------------------------- + !--- + subroutine readParams ( ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNFUNParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading +!-------------------------------------------------------------------- + !--- + + ! read in parameters + + tString='ndays_on' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%ndays_on=tempr + + tString='ndays_off' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%ndays_off=tempr + + + end subroutine readParams + +!-------------------------------------------------------------------- + !--- + subroutine CNFUNInit (bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! + ! !USES: + use clm_varcon , only: secspday, fun_period + use clm_time_manager, only: get_step_size_real,get_nstep,get_curr_date,get_days_per_year + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type), intent(inout) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: dayspyr ! days per year (days) + real(r8) :: timestep_fun ! Timestep length for + ! FUN (s) + real(r8) :: numofyear ! number of days per + ! year + integer :: nstep ! time step number + integer :: nstep_fun ! Number of + ! atmospheric timesteps between calls to FUN + character(len=32) :: subname = 'CNFUNInit' +!-------------------------------------------------------------------- + !--- + +! Set local pointers + associate(ivt => patch%itype , & ! Input: [integer (:) ] p + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + leafcn_offset => cnveg_state_inst%leafcn_offset_patch , & ! Output: + ! [real(r8) (:) ] Leaf C:N used by FUN + leafc_storage_xfer_acc => cnveg_carbonstate_inst%leafc_storage_xfer_acc_patch , & ! Output: [real(r8) (:) + ! ] Accmulated leaf C transfer (gC/m2) + storage_cdemand => cnveg_carbonstate_inst%storage_cdemand_patch , & ! Output: [real(r8) (:) + ! ] C use from the C storage pool + leafn_storage_xfer_acc => cnveg_nitrogenstate_inst%leafn_storage_xfer_acc_patch, & ! Output: [real(r8) (:) + ! ] Accmulated leaf N transfer (gC/m2) + storage_ndemand => cnveg_nitrogenstate_inst%storage_ndemand_patch & ! Output: [real(r8) (:) + ! ] N demand during the offset period + ) + !-------------------------------------------------------------------- + !--- + ! Calculate some timestep-related values. + !-------------------------------------------------------------------- + !--- + ! set time steps + dt = get_step_size_real() + dayspyr = get_days_per_year() + nstep = get_nstep() + timestep_fun = real(secspday * fun_period) + nstep_fun = int(secspday * dayspyr / dt) + + ndays_on = params_inst%ndays_on + ndays_off = params_inst%ndays_off + + !-------------------------------------------------------------------- + !--- + ! Decide if FUN will be called on this timestep. + !-------------------------------------------------------------------- + !--- + numofyear = nstep/nstep_fun + if (mod(nstep,nstep_fun) == 0) then + leafcn_offset(bounds%begp:bounds%endp) = leafcn(ivt(bounds%begp:bounds%endp)) + storage_cdemand(bounds%begp:bounds%endp) = 0._r8 + storage_ndemand(bounds%begp:bounds%endp) = 0._r8 + leafn_storage_xfer_acc(bounds%begp:bounds%endp) = 0._r8 + leafc_storage_xfer_acc(bounds%begp:bounds%endp) = 0._r8 + end if +!-------------------------------------------------------------------- + !--- + end associate + end subroutine CNFUNInit +!-------------------------------------------------------------------- + !--- + + !-------------------------------------------------------------------- + !--- + ! Start the CNFUN subroutine + !-------------------------------------------------------------------- + !--- + subroutine CNFUN(bounds,num_soilc, filter_soilc,num_soilp& + &,filter_soilp,waterstatebulk_inst, & + & waterfluxbulk_inst,temperature_inst,soilstate_inst& + &,cnveg_state_inst,cnveg_carbonstate_inst,& + & cnveg_carbonflux_inst,cnveg_nitrogenstate_inst& + &,cnveg_nitrogenflux_inst ,& + & soilbiogeochem_nitrogenflux_inst& + &,soilbiogeochem_carbonflux_inst,canopystate_inst,& + & soilbiogeochem_nitrogenstate_inst) + +! !USES: + use clm_time_manager, only : get_step_size_real, get_curr_date, get_days_per_year + use clm_varpar , only : nlevdecomp + use clm_varcon , only : secspday, smallValue, fun_period, tfrz, dzsoi_decomp, spval + use clm_varctl , only : use_nitrif_denitrif + use PatchType , only : patch + use subgridAveMod , only : p2c + use pftconMod , only : npcropmin + use CNVegMatrixMod , only : matrix_update_phn +! +! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + type(temperature_type) , intent(in) :: temperature_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + ! local pointers to implicit in arrays + ! + !-------------------------------------------------------------------- + ! ------------ + ! Integer parameters + !-------------------------------------------------------------------- + !----------- + integer, parameter :: icostFix = 1 ! Process + ! number for fixing. + integer, parameter :: icostRetrans = 2 ! Process + ! number for retranslocation. + integer, parameter :: icostActiveNO3 = 3 ! Process + ! number for mycorrhizal uptake of NO3. + integer, parameter :: icostActiveNH4 = 4 ! Process + ! number for mycorrhizal uptake of NH4 + integer, parameter :: icostnonmyc_no3 = 5 ! Process + ! number for nonmyc uptake of NO3. + integer, parameter :: icostnonmyc_nh4 = 6 ! Process + ! number for nonmyc uptake of NH4. + real(r8), parameter :: big_cost = 1000000000._r8! An arbitrarily large cost + + ! array index when plant is fixing + integer, parameter :: plants_are_fixing = 1 + integer, parameter :: plants_not_fixing = 2 + + ! array index for ECM step versus AM step + integer, parameter :: ecm_step = 1 + integer, parameter :: am_step = 2 + ! arbitrary large cost (gC/gN). + !-------------------------------------------------------------------- + !----------------------------------------------- + ! Local Real variables. + !-------------------------------------------------------------------- + !----------------------------------------------- + real(r8) :: excess ! excess N taken up by transpiration (gN/m2) + real(r8) :: steppday ! model time steps in each day (-) + real(r8) :: rootc_dens_step ! root C for each PFT in each soil layer(gC/m2) + real(r8) :: retrans_limit1 ! a temporary variable for leafn (gN/m2) + real(r8) :: qflx_tran_veg_layer ! transpiration in each soil layer (mm H2O/S) + real(r8) :: dn ! Increment of N (gN/m2) + real(r8) :: dn_retrans ! Increment of N (gN/m2) + real(r8) :: dnpp ! Increment of NPP (gC/m2) + real(r8) :: dnpp_retrans ! Increment of NPP (gC/m2) + real(r8) :: rootc_dens(bounds%begp:bounds%endp,1:nlevdecomp) ! the root carbon density (gC/m2) + real(r8) :: rootC(bounds%begp:bounds%endp) ! root biomass (gC/m2) + real(r8) :: permyc(bounds%begp:bounds%endp,1:nstp) ! the arrary for the ECM and AM ratio (-) + real(r8) :: kc_active(bounds%begp:bounds%endp,1:nstp) ! the kc_active parameter (gC/m2) + real(r8) :: kn_active(bounds%begp:bounds%endp,1:nstp) ! the kn_active parameter (gC/m2) + real(r8) :: availc_pool(bounds%begp:bounds%endp) ! The avaible C pool for allocation (gC/m2) + real(r8) :: plantN(bounds%begp:bounds%endp) ! Plant N (gN/m2) + real(r8) :: plant_ndemand_pool(bounds%begp:bounds%endp) ! The N demand pool (gN/m2) + real(r8) :: plant_ndemand_pool_step(bounds%begp:bounds%endp,1:nstp) ! the N demand pool (gN/m2) + real(r8) :: leafn_step(bounds%begp:bounds%endp,1:nstp) ! N loss based for deciduous trees (gN/m2) + real(r8) :: leafn_retrans_step(bounds%begp:bounds%endp,1:nstp) ! N loss based for deciduous trees (gN/m2) + real(r8) :: litterfall_n(bounds%begp:bounds%endp) ! N loss based on the leafc to litter (gN/m2) + real(r8) :: litterfall_n_step(bounds%begp:bounds%endp,1:nstp) ! N loss based on the leafc to litter (gN/m2) + real(r8) :: litterfall_c_step(bounds%begp:bounds%endp,1:nstp) ! N loss based on the leafc to litter (gN/m2) + real(r8) :: tc_soisno(bounds%begc:bounds%endc,1:nlevdecomp) ! Soil temperature (degrees Celsius) + real(r8) :: npp_remaining(bounds%begp:bounds%endp,1:nstp) ! A temporary variable for npp_remaining(gC/m2) + real(r8) :: n_passive_step(bounds%begp:bounds%endp,1:nstp) ! N taken up by transpiration at substep(gN/m2) + real(r8) :: n_passive_acc(bounds%begp:bounds%endp) ! N acquired by passive uptake (gN/m2) + real(r8) :: cost_retran(bounds%begp:bounds%endp,1:nlevdecomp) ! cost of retran (gC/gN) + real(r8) :: cost_fix(bounds%begp:bounds%endp,1:nlevdecomp) ! cost of fixation (gC/gN) + real(r8) :: cost_resis(bounds%begp:bounds%endp,1:nlevdecomp) ! cost of resis (gC/gN) + real(r8) :: cost_res_resis(bounds%begp:bounds%endp,1:nlevdecomp) ! The cost of resis (gN/gC) + real(r8) :: n_fix_acc(bounds%begp:bounds%endp,1:nstp) ! N acquired by fixation (gN/m2) + real(r8) :: n_fix_acc_total(bounds%begp:bounds%endp) ! N acquired by fixation (gN/m2) + real(r8) :: npp_fix_acc(bounds%begp:bounds%endp,1:nstp) ! Amount of NPP used by fixation (gC/m2) + real(r8) :: npp_fix_acc_total(bounds%begp:bounds%endp) ! Amount of NPP used by fixation (gC/m2) + real(r8) :: n_retrans_acc(bounds%begp:bounds%endp,1:nstp) ! N acquired by retranslocation (gN/m2) + real(r8) :: n_retrans_acc_total(bounds%begp:bounds%endp) ! N acquired by retranslocation (gN/m2) + real(r8) :: free_nretrans_acc(bounds%begp:bounds%endp,1:nstp) ! N acquired by retranslocation (gN/m2) + real(r8) :: npp_retrans_acc(bounds%begp:bounds%endp,1:nstp) ! NPP used for the extraction (gC/m2) + real(r8) :: npp_retrans_acc_total(bounds%begp:bounds%endp) ! NPP used for the extraction (gC/m2) + real(r8) :: nt_uptake(bounds%begp:bounds%endp,1:nstp) ! N uptake from retrans, active, and fix(gN/m2) + real(r8) :: npp_uptake(bounds%begp:bounds%endp,1:nstp) ! NPP used by the uptakes (gC/m2) + + !----------NITRIF_DENITRIF-------------! + + real(r8) :: sminn_no3_diff ! A temporary limit for N uptake (gN/m2) + real(r8) :: sminn_nh4_diff ! A temporary limit for N uptake (gN/m2) + real(r8) :: active_no3_limit1 ! A temporary limit for N uptake (gN/m2) + real(r8) :: active_nh4_limit1 ! A temporary limit for N uptake (gN/m2) + real(r8) :: cost_active_no3(bounds%begp:bounds%endp,1:nlevdecomp) ! cost of mycorrhizal (gC/gN) + real(r8) :: cost_active_nh4(bounds%begp:bounds%endp,1:nlevdecomp) ! cost of mycorrhizal (gC/gN) + real(r8) :: cost_nonmyc_no3(bounds%begp:bounds%endp,1:nlevdecomp) ! cost of nonmyc (gC/gN) + real(r8) :: cost_nonmyc_nh4(bounds%begp:bounds%endp,1:nlevdecomp) ! cost of nonmyc (gC/gN) + + real(r8) :: sminn_no3_conc(bounds%begc:bounds%endc,1:nlevdecomp) ! Concentration of no3 in soil water (gN/gH2O) + real(r8) :: sminn_no3_conc_step(bounds%begp:bounds%endp,1:nlevdecomp,1:nstp) ! A temporary variable for soil mineral N (gN/gH2O) + real(r8) :: sminn_no3_layer(bounds%begc:bounds%endc,1:nlevdecomp) ! Available no3 in each soil layer (gN/m2) + real(r8) :: sminn_no3_layer_step(bounds%begp:bounds%endp,1:nlevdecomp,1:nstp)! A temporary variable for soil no3 (gN/m2) + real(r8) :: sminn_no3_uptake(bounds%begp:bounds%endp,1:nlevdecomp,1:nstp) ! A temporary variable for soil mineral N (gN/m2/s) + real(r8) :: sminn_nh4_conc(bounds%begc:bounds%endc,1:nlevdecomp) ! Concentration of nh4 in soil water (gN/gH2O) + real(r8) :: sminn_nh4_conc_step(bounds%begp:bounds%endp,1:nlevdecomp,1:nstp) ! A temporary variable for soil mineral N (gN/gH2O) + real(r8) :: sminn_nh4_layer(bounds%begc:bounds%endc,1:nlevdecomp) ! Available nh4 in each soil layer (gN/m2) + real(r8) :: sminn_nh4_layer_step(bounds%begp:bounds%endp,1:nlevdecomp,1:nstp)! A temporary variable for soil mineral N (gN/m2) + real(r8) :: sminn_nh4_uptake(bounds%begp:bounds%endp,1:nlevdecomp,1:nstp) ! A temporary variable for soil mineral N (gN/m2/s) + + real(r8) :: active_no3_uptake1(bounds%begp:bounds%endp,1:nlevdecomp) ! no3 mycorrhizal uptake (gN/m2) + real(r8) :: active_nh4_uptake1(bounds%begp:bounds%endp,1:nlevdecomp) ! nh4 mycorrhizal uptake (gN/m2) + real(r8) :: nonmyc_no3_uptake1(bounds%begp:bounds%endp,1:nlevdecomp) ! no3 non-mycorrhizal uptake (gN/m2) + real(r8) :: nonmyc_nh4_uptake1(bounds%begp:bounds%endp,1:nlevdecomp) ! nh4 non-mycorrhizal uptake (gN/m2) + real(r8) :: active_no3_uptake2(bounds%begp:bounds%endp,1:nlevdecomp) ! no3 mycorrhizal uptake (gN/m2) + real(r8) :: active_nh4_uptake2(bounds%begp:bounds%endp,1:nlevdecomp) ! nh4 mycorrhizal uptake (gN/m2) + real(r8) :: nonmyc_no3_uptake2(bounds%begp:bounds%endp,1:nlevdecomp) ! no3 non-mycorrhizal uptake (gN/m2) + real(r8) :: nonmyc_nh4_uptake2(bounds%begp:bounds%endp,1:nlevdecomp) ! nh4 non-mycorrhizal uptake (gN/m2) + real(r8) :: n_am_no3_acc(bounds%begp:bounds%endp) ! AM no3 uptake (gN/m2) + real(r8) :: n_am_nh4_acc(bounds%begp:bounds%endp) ! AM nh4 uptake (gN/m2) + real(r8) :: n_ecm_no3_acc(bounds%begp:bounds%endp) ! ECM no3 uptake (gN/m2) + real(r8) :: n_ecm_nh4_acc(bounds%begp:bounds%endp) ! ECM nh4 uptake (gN/m2) + real(r8) :: n_active_no3_acc(bounds%begp:bounds%endp,1:nstp) ! Mycorrhizal no3 uptake (gN/m2) + real(r8) :: n_active_nh4_acc(bounds%begp:bounds%endp,1:nstp) ! Mycorrhizal nh4 uptake (gN/m2) + real(r8) :: n_nonmyc_no3_acc(bounds%begp:bounds%endp,1:nstp) ! Non-myc no3 uptake (gN/m2) + real(r8) :: n_nonmyc_nh4_acc(bounds%begp:bounds%endp,1:nstp) ! Non-myc nh4 uptake (gN/m2) + real(r8) :: n_active_no3_acc_total(bounds%begp:bounds%endp) ! Mycorrhizal no3 uptake (gN/m2) + real(r8) :: n_active_nh4_acc_total(bounds%begp:bounds%endp) ! Mycorrhizal no3 uptake (gN/m2) + + real(r8) :: n_nonmyc_no3_acc_total(bounds%begp:bounds%endp) ! Non-myc no3 uptake (gN/m2) + real(r8) :: n_nonmyc_nh4_acc_total(bounds%begp:bounds%endp) ! Non-myc no3 uptake (gN/m2) + real(r8) :: npp_active_no3_acc(bounds%begp:bounds%endp,1:nstp) ! Mycorrhizal no3 uptake used C (gC/m2) + real(r8) :: npp_active_nh4_acc(bounds%begp:bounds%endp,1:nstp) ! Mycorrhizal nh4 uptake used C (gC/m2) + real(r8) :: npp_nonmyc_no3_acc(bounds%begp:bounds%endp,1:nstp) ! Non-myc no3 uptake used C (gC/m2) + real(r8) :: npp_nonmyc_nh4_acc(bounds%begp:bounds%endp,1:nstp) ! Non-myc nh4 uptake used C (gC/m2) + real(r8) :: npp_active_no3_acc_total(bounds%begp:bounds%endp) ! Mycorrhizal no3 uptake used C (gC/m2) + real(r8) :: npp_active_nh4_acc_total(bounds%begp:bounds%endp) ! Mycorrhizal nh4 uptake used C (gC/m2) + real(r8) :: npp_nonmyc_no3_acc_total(bounds%begp:bounds%endp) ! Non-myc no3 uptake used C (gC/m2) + real(r8) :: npp_nonmyc_nh4_acc_total(bounds%begp:bounds%endp) ! Non-myc nh4 uptake used C (gC/m2) + real(r8) :: n_am_no3_retrans(bounds%begp:bounds%endp) ! AM no3 uptake for offset (gN/m2) + real(r8) :: n_am_nh4_retrans(bounds%begp:bounds%endp) ! AM nh4 uptake for offset (gN/m2) + real(r8) :: n_ecm_no3_retrans(bounds%begp:bounds%endp) ! ECM no3 uptake for offset (gN/m2) + real(r8) :: n_ecm_nh4_retrans(bounds%begp:bounds%endp) ! ECM nh4 uptake for offset (gN/m2) + real(r8) :: n_active_no3_retrans(bounds%begp:bounds%endp,1:nstp) ! Mycorrhizal no3 for offset (gN/m2) + real(r8) :: n_active_nh4_retrans(bounds%begp:bounds%endp,1:nstp) ! Mycorrhizal nh4 for offset (gN/m2) + real(r8) :: n_nonmyc_no3_retrans(bounds%begp:bounds%endp,1:nstp) ! Non-myc no3 for offset (gN/m2) + real(r8) :: n_nonmyc_nh4_retrans(bounds%begp:bounds%endp,1:nstp) ! Non-myc nh4 for offset (gN/m2) + real(r8) :: n_active_no3_retrans_total(bounds%begp:bounds%endp) ! Mycorrhizal no3 for offset (gN/m2) + real(r8) :: n_active_nh4_retrans_total(bounds%begp:bounds%endp) ! Mycorrhizal nh4 for offset (gN/m2) + real(r8) :: n_nonmyc_no3_retrans_total(bounds%begp:bounds%endp) ! Non-myc no3 for offset (gN/m2) + real(r8) :: n_nonmyc_nh4_retrans_total(bounds%begp:bounds%endp) ! Non-myc nh4 for offset (gN/m2) + real(r8) :: n_passive_no3_vr(bounds%begp:bounds%endp,1:nlevdecomp) ! Layer passive no3 uptake (gN/m2) + real(r8) :: n_passive_nh4_vr(bounds%begp:bounds%endp,1:nlevdecomp) ! Layer passive nh4 uptake (gN/m2) + real(r8) :: n_fix_no3_vr(bounds%begp:bounds%endp,1:nlevdecomp) ! Layer fixation no3 uptake (gN/m2) + real(r8) :: n_fix_nh4_vr(bounds%begp:bounds%endp,1:nlevdecomp) ! Layer fixation nh4 uptake (gN/m2) + real(r8) :: n_active_no3_vr(bounds%begp:bounds%endp,1:nlevdecomp) ! Layer mycorrhizal no3 uptake (gN/m2) + real(r8) :: n_nonmyc_no3_vr(bounds%begp:bounds%endp,1:nlevdecomp) ! Layer non-myc no3 uptake (gN/m2) + real(r8) :: n_active_nh4_vr(bounds%begp:bounds%endp,1:nlevdecomp) ! Layer mycorrhizal nh4 uptake (gN/m2) + real(r8) :: n_nonmyc_nh4_vr(bounds%begp:bounds%endp,1:nlevdecomp) ! Layer non-myc nh4 uptake (gN/m2) + real(r8) :: npp_active_no3_retrans(bounds%begp:bounds%endp,1:nstp) ! Mycorrhizal no3 uptake used C for offset (gN/m2) + real(r8) :: npp_active_nh4_retrans(bounds%begp:bounds%endp,1:nstp) ! Mycorrhizal nh4 uptake used C for offset (gN/m2) + real(r8) :: npp_nonmyc_no3_retrans(bounds%begp:bounds%endp,1:nstp) ! Non-myc no3 uptake used C for offset (gN/m2) + real(r8) :: npp_nonmyc_nh4_retrans(bounds%begp:bounds%endp,1:nstp) ! Non-myc nh4 uptake used C for offset (gN/m2) + real(r8) :: npp_active_no3_retrans_total(bounds%begp:bounds%endp) ! Mycorrhizal no3 uptake used C for offset (gN/m2) + real(r8) :: npp_active_nh4_retrans_total(bounds%begp:bounds%endp) ! Mycorrhizal nh4 uptake used C for offset (gN/m2) + real(r8) :: npp_nonmyc_no3_retrans_total(bounds%begp:bounds%endp) ! Non-myc no3 uptake used C for offset (gN/m2) + real(r8) :: npp_nonmyc_nh4_retrans_total(bounds%begp:bounds%endp) ! Non-myc nh4 uptake used C for offset (gN/m2) + + + real(r8) :: costNit(1:nlevdecomp,ncost6) ! Cost of N via each process (gC/gN) + + ! Uptake fluxes for COST_METHOD=2 + ! actual npp to each layer for each uptake process + real(r8) :: npp_to_fixation(1:nlevdecomp) + real(r8) :: npp_to_retrans(1:nlevdecomp) + real(r8) :: npp_to_active_nh4(1:nlevdecomp) + real(r8) :: npp_to_nonmyc_nh4(1:nlevdecomp) + real(r8) :: npp_to_active_no3(1:nlevdecomp) + real(r8) :: npp_to_nonmyc_no3 (1:nlevdecomp) + + ! fraction of carbon to each uptake process + real(r8) :: npp_frac_to_fixation(1:nlevdecomp) + real(r8) :: npp_frac_to_retrans(1:nlevdecomp) + real(r8) :: npp_frac_to_active_nh4(1:nlevdecomp) + real(r8) :: npp_frac_to_nonmyc_nh4(1:nlevdecomp) + real(r8) :: npp_frac_to_active_no3(1:nlevdecomp) + real(r8) :: npp_frac_to_nonmyc_no3 (1:nlevdecomp) + + ! hypothetical fluxes on N in each layer + real(r8) :: n_exch_fixation(1:nlevdecomp) ! N aquired from one unit of C for fixation (unitless) + real(r8) :: n_exch_retrans(1:nlevdecomp) ! N aquired from one unit of C for retrans (unitless) + real(r8) :: n_exch_active_nh4(1:nlevdecomp) ! N aquired from one unit of C for act nh4(unitless) + real(r8) :: n_exch_nonmyc_nh4(1:nlevdecomp) ! N aquired from one unit of C for nonmy nh4 (unitless) + real(r8) :: n_exch_active_no3(1:nlevdecomp) ! N aquired from one unit of C for act no3 (unitless) + real(r8) :: n_exch_nonmyc_no3(1:nlevdecomp) ! N aquired from one unit of C for nonmyc no3 (unitless) + + !actual fluxes of N in each layer + real(r8) :: n_from_fixation(1:nlevdecomp) ! N aquired in each layer for fixation (gN m-2 s-1) + real(r8) :: n_from_retrans(1:nlevdecomp) ! N aquired in each layer of C for retrans (gN m-2 s-1) + real(r8) :: n_from_active_nh4(1:nlevdecomp) ! N aquired in each layer of C for act nh4 (gN m-2 s-1) + real(r8) :: n_from_nonmyc_nh4(1:nlevdecomp) ! N aquired in each layer of C for nonmy nh4 (gN m-2 s-1) + real(r8) :: n_from_active_no3(1:nlevdecomp) ! N aquired in each layer of C for act no3 (gN m-2 s-1) + real(r8) :: n_from_nonmyc_no3(1:nlevdecomp) ! N aquired in each layer of C for nonmyc no3 (gN m-2 s-1) + + real(r8) :: free_Nretrans(bounds%begp:bounds%endp) ! the total amount of NO3 and NH4 (gN/m3/s) + + ! Uptake fluxes for COST_METHOD=2 + !actual fluxes of N in each layer + real(r8) :: frac_ideal_C_use ! How much less C do we use for 'buying' N than that + ! needed to get to the ideal ratio? fraction. + + real(r8) :: N_acquired + real(r8) :: C_spent + real(r8) :: leaf_narea ! leaf n per unit leaf + ! area in gN/m2 (averaged across canopy, which is OK for the cost + ! calculation) + + + real(r8) :: sum_n_acquired ! Sum N aquired from one unit of C (unitless) + real(r8) :: burned_off_carbon ! carbon wasted by poor allocation algorithm. If + ! this is too big, we need a better iteration. + real(r8) :: temp_n_flux + real(r8) :: delta_cn ! difference between 'ideal' leaf CN ration and + ! actual leaf C:N ratio. C/N + real(r8) :: excess_carbon ! how much carbon goes into the leaf C + ! pool on account of the flexibleCN modifications. + real(r8) :: excess_carbon_acc ! excess accumulated over layers. + ! WITHOUT GROWTH RESP + real(r8) :: fixerfrac ! what fraction of plants can fix? + real(r8) :: npp_to_spend ! how much carbon do we need to get + ! rid of? + real(r8) :: soil_n_extraction ! calculates total N pullled from + ! soil + real(r8) :: total_N_conductance !inverse of C to of N for whole soil + ! -leaf pathway + real(r8) :: total_N_resistance ! C to of N for whole soil -leaf + ! pathway + real(r8) :: free_RT_frac=0.0_r8 !fraction of N retranslocation which is automatic/free. + ! SHould be made into a PFT parameter. + + real(r8) :: paid_for_n_retrans + real(r8) :: free_n_retrans + real(r8) :: total_c_spent_retrans + real(r8) :: total_c_accounted_retrans + + + !------end of not_use_nitrif_denitrif------! + !-------------------------------------------------------------------- + !------------ + ! Local Integer variables + !-------------------------------------------------------------------- + !------------ + integer :: fn ! number of values + ! in pft filter + integer :: fp ! lake filter pft + ! index + integer :: fc ! lake filter column + ! index + integer :: p, c ! pft index + integer :: g, l ! indices + integer :: j, i, k ! soil/snow level + ! index + integer :: istp ! Loop counters/work + integer :: icost ! a local index + integer :: fixer ! 0 = non-fixer, 1 + ! =fixer + logical :: unmetDemand ! True while there + ! is still demand for N + logical :: local_use_flexibleCN ! local version of use_flexCN + integer :: FIX ! for loop. 1 for + ! fixers, 2 for non fixers. This will become redundant with the + ! 'fixer' parameter if it works. + + !-------------------------------------------------------------------- + !--------------------------------- + associate(ivt => patch%itype , & ! Input: [integer (:) ] p + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + lflitcn => pftcon%lflitcn , & ! Input: leaf litter C:N (gC/gN) + season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal + ! -deciduous leaf habit (0 or 1) + stress_decid => pftcon%stress_decid , & ! Input: binary flag for stress + ! -deciduous leaf habit (0 or 1) + a_fix => pftcon%a_fix , & ! Input: A BNF parameter + b_fix => pftcon%b_fix , & ! Input: A BNF parameter + c_fix => pftcon%c_fix , & ! Input: A BNF parameter + s_fix => pftcon%s_fix , & ! Input: A BNF parameter + akc_active => pftcon%akc_active , & ! Input: A mycorrhizal uptake + ! parameter + akn_active => pftcon%akn_active , & ! Input: A mycorrhizal uptake + ! parameter + ekc_active => pftcon%ekc_active , & ! Input: A mycorrhizal uptake + ! parameter + ekn_active => pftcon%ekn_active , & ! Input: A mycorrhizal upatke + ! parameter + kc_nonmyc => pftcon%kc_nonmyc , & ! Input: A non-mycorrhizal uptake + ! parameter + kn_nonmyc => pftcon%kn_nonmyc , & ! Input: A non-mycorrhizal uptake + ! parameter + perecm => pftcon%perecm , & ! Input: The fraction of ECM + ! -associated PFT + grperc => pftcon%grperc , & ! Input: growth percentage + fun_cn_flex_a => pftcon%fun_cn_flex_a , & ! Parameter a of FUN-flexcn link code (def 5) + fun_cn_flex_b => pftcon%fun_cn_flex_b , & ! Parameter b of FUN-flexcn link code (def 200) + fun_cn_flex_c => pftcon%fun_cn_flex_c , & ! Parameter b of FUN-flexcn link code (def 80) + FUN_fracfixers => pftcon%FUN_fracfixers , & ! Fraction of C that can be used for fixation. + leafcn_offset => cnveg_state_inst%leafcn_offset_patch , & ! Output: + ! [real(r8) (:)] Leaf C:N used by FUN + plantCN => cnveg_state_inst%plantCN_patch , & ! Output: [real(r8) (:)] Plant + ! C:N used by FUN + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Output: [real(r8) (:)] onset + ! flag + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Output: [real(r8) (:)] offset + ! flag + availc => cnveg_carbonflux_inst%availc_patch , & ! Iutput: [real(r8) (:)] C flux + ! available for allocation (gC/m2/s) + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:)] (gC/m2) + ! leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) + ! (:)] (gC/m2) leaf C storage + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) + ! (:)] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) + ! (:)] (gC/m2) fine root C storage + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) + ! (:)] (gC/m2) live stem C + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) + ! (:)] (gC/m2) live coarse root C + leafc_storage_xfer_acc => cnveg_carbonstate_inst%leafc_storage_xfer_acc_patch , & ! uutput: [real(r8) + ! (:)] Accmulated leaf C transfer (gC/m2) + storage_cdemand => cnveg_carbonstate_inst%storage_cdemand_patch , & ! Output: [real(r8) + ! (:)] C use f rom the C storage pool + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one + ! -sided leaf area index + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:)] + ! (gN/m2) leaf N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:)] + ! (gN/m2) fine root N + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:)] + ! (gN/m2) live stem N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:)] + ! (gN/m2) retranslocation N + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:)] + ! (gN/m2) live coarse root N + leafn_storage_xfer_acc => cnveg_nitrogenstate_inst%leafn_storage_xfer_acc_patch, & ! Output: [real(r8) (:)] + ! Accmulated leaf N transfer (gC/m2) + storage_ndemand => cnveg_nitrogenstate_inst%storage_ndemand_patch , & ! Output: [real(r8) (:)] + ! N demand during the offset period + leafc_to_litter => cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Output: [real(r8) + ! (:) ] leaf C litterfall (gC/m2/s) + leafc_to_litter_fun => cnveg_carbonflux_inst%leafc_to_litter_fun_patch , & ! Output: [real(r8) + ! (:) ] leaf C litterfall used by FUN (gC/m2/s) + prev_leafc_to_litter => cnveg_carbonflux_inst%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) + ! ] previous timestep leaf C litterfall flux (gC/m2/s) + leafc_storage_to_xfer => cnveg_carbonflux_inst%leafc_storage_to_xfer_patch , & ! Output: [real(r8) + ! (:) ] + npp_Nactive => cnveg_carbonflux_inst%npp_Nactive_patch , & ! Output: [real(r8) + ! (:) ] Mycorrhizal N uptake used C (gC/m2/s) + npp_Nnonmyc => cnveg_carbonflux_inst%npp_Nnonmyc_patch , & ! Output: [real(r8) + ! (:) ] Non-mycorrhizal N uptake use C (gC/m2/s) + npp_Nam => cnveg_carbonflux_inst%npp_Nam_patch , & ! Output: [real(r8) + ! (:) ] AM uptake use C (gC/m2/s) + npp_Necm => cnveg_carbonflux_inst%npp_Necm_patch , & ! Output: [real(r8) + ! (:) ] ECM uptake use C (gC/m2/s) + npp_Nactive_no3 => cnveg_carbonflux_inst%npp_Nactive_no3_patch , & ! Output: [real(r8) + ! (:) ] Mycorrhizal N uptake used C (gC/m2/s) + npp_Nnonmyc_no3 => cnveg_carbonflux_inst%npp_Nnonmyc_no3_patch , & ! Output: [real(r8) + ! (:) ] Non-myco uptake use C (gC/m2/s) rrhizal N uptake + ! (gN/m2/s) + npp_Nam_no3 => cnveg_carbonflux_inst%npp_Nam_no3_patch , & ! Output: [real(r8) + ! (:) ] AM uptake use C (gC/m2/s) + npp_Necm_no3 => cnveg_carbonflux_inst%npp_Necm_no3_patch , & ! Output: [real(r8) + ! (:) ] ECM uptake use C (gC/m2/s) + npp_Nactive_nh4 => cnveg_carbonflux_inst%npp_Nactive_nh4_patch , & ! Output: [real(r8) + ! (:) ] Mycorrhizal N uptake used C (gC/m2/s) + npp_Nnonmyc_nh4 => cnveg_carbonflux_inst%npp_Nnonmyc_nh4_patch , & ! Output: [real(r8) + ! (:) ] Non-mycorrhizal N uptake used C (gC/m2/s) + npp_Nam_nh4 => cnveg_carbonflux_inst%npp_Nam_nh4_patch , & ! Output: [real(r8) + ! (:) ] AM uptake used C(gC/m2/s) + npp_Necm_nh4 => cnveg_carbonflux_inst%npp_Necm_nh4_patch , & ! Output: [real(r8) + ! (:) ] ECM uptake used C (gC/m2/s) + npp_Nfix => cnveg_carbonflux_inst%npp_Nfix_patch , & ! Output: [real(r8) + ! (:) ] Symbiotic BNF used C (gC/m2/s) + npp_Nretrans => cnveg_carbonflux_inst%npp_Nretrans_patch , & ! Output: [real(r8) + ! (:) ] Retranslocation N uptake used C (gC/m2/s) + npp_Nuptake => cnveg_carbonflux_inst%npp_Nuptake_patch , & ! Output: [real(r8) + ! (:) ] Total N uptake of FUN used C (gC/m2/s) + npp_growth => cnveg_carbonflux_inst%npp_growth_patch , & ! Output: [real(r8) + ! (:) ] Total N uptake of FUN used C (gC/m2/s) + burnedoff_carbon => cnveg_carbonflux_inst%npp_burnedoff_patch , & ! Output: [real(r8) + ! (:) ] C that cannot be used for N uptake(gC/m2/s) + leafc_change => cnveg_carbonflux_inst%leafc_change_patch , & ! Output: [real(r8) + ! (:) ] Used C from the leaf (gC/m2/s) + leafn_storage_to_xfer => cnveg_nitrogenflux_inst%leafn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + iretransn_to_iout => cnveg_nitrogenflux_inst%iretransn_to_iout_ph , & ! Input: [integer] + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Iutput: [real(r8) (:) + ! ] N flux required to support initial GPP (gN/m2/s) + plant_ndemand_retrans => cnveg_nitrogenflux_inst%plant_ndemand_retrans_patch , & ! Output: [real(r8) (:) + ! ] N demand generated for FUN (gN/m2/s) + plant_ndemand_season => cnveg_nitrogenflux_inst%plant_ndemand_season_patch , & ! Output: [real(r8) (:) + ! ] N demand for seasonal deciduous forest (gN/m2/s) + plant_ndemand_stress => cnveg_nitrogenflux_inst%plant_ndemand_stress_patch , & ! Output: [real(r8) (:) + ! ] N demand for stress deciduous forest (gN/m2/s) + Nactive => cnveg_nitrogenflux_inst%Nactive_patch , & ! Output: [real(r8) (:) + ! ] Mycorrhizal N uptake (gN/m2/s) + Nnonmyc => cnveg_nitrogenflux_inst%Nnonmyc_patch , & ! Output: [real(r8) (:) + ! ] Non-mycorrhizal N uptake (gN/m2/s) + Nam => cnveg_nitrogenflux_inst%Nam_patch , & ! Output: [real(r8) (:) ] AM + ! uptake (gN/m2/s) + Necm => cnveg_nitrogenflux_inst%Necm_patch , & ! Output: [real(r8) (:) ] ECM + ! uptake (gN/m2/s) + Nactive_no3 => cnveg_nitrogenflux_inst%Nactive_no3_patch , & ! Output: [real(r8) (:) + ! ] Mycorrhizal N uptake (gN/m2/s) + Nnonmyc_no3 => cnveg_nitrogenflux_inst%Nnonmyc_no3_patch , & ! Output: [real(r8) (:) + ! ] Non-mycorrhizal N uptake (gN/m2/s) + Nam_no3 => cnveg_nitrogenflux_inst%Nam_no3_patch , & ! Output: [real(r8) (:) + ! ] AM uptake (gN/m2/s) + Necm_no3 => cnveg_nitrogenflux_inst%Necm_no3_patch , & ! Output: [real(r8) (:) + ! ] ECM uptake (gN/m2/s) + Nactive_nh4 => cnveg_nitrogenflux_inst%Nactive_nh4_patch , & ! Output: [real(r8) (:) + ! ] Mycorrhizal N uptake (gN/m2/s) + Nnonmyc_nh4 => cnveg_nitrogenflux_inst%Nnonmyc_nh4_patch , & ! Output: [real(r8) (:) + ! ] Non-mycorrhizal N uptake (gN/m2/s) + Nam_nh4 => cnveg_nitrogenflux_inst%Nam_nh4_patch , & ! Output: [real(r8) (:) + ! ] AM uptake (gN/m2/s) + Necm_nh4 => cnveg_nitrogenflux_inst%Necm_nh4_patch , & ! Output: [real(r8) (:) + ! ] ECM uptake (gN/m2/s) + Npassive => cnveg_nitrogenflux_inst%Npassive_patch , & ! Output: [real(r8) (:) + ! ] Passive N uptake (gN/m2/s) + Nfix => cnveg_nitrogenflux_inst%Nfix_patch , & ! Output: [real(r8) (:) ] + ! Symbiotic BNF (gN/m2/s) + cost_nfix => cnveg_nitrogenflux_inst%cost_Nfix_patch , & ! Output: [real(r8) (:) + ! ] Cost of fixation gC:gN + cost_nactive => cnveg_nitrogenflux_inst%cost_Nactive_patch , & ! Output: [real(r8) (:) ] + ! Cost of active uptake gC:gN + cost_nretrans => cnveg_nitrogenflux_inst%cost_Nretrans_patch , & ! Output: [real(r8) (:) ] + ! Cost of retranslocation gC:gN + nuptake_npp_fraction_patch => cnveg_nitrogenflux_inst%nuptake_npp_fraction_patch , & ! Output: [real(r8) (:) + ! ] frac of NPP in NUPTAKE + + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C + ! allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N + ! allocation index (DIM) + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) + ! ] (gN/m2) leaf N store + nfix_to_sminn => soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col , & ! Output: [real(r8) (:)] + ! symbiotic/asymbiotic N fixation to soil mineral N (gN/m2 + ! /s) + Nretrans => cnveg_nitrogenflux_inst%Nretrans_patch , & ! Output: [real(r8) (:) + ! ] Retranslocation N uptake (gN/m2/s) + Nretrans_season => cnveg_nitrogenflux_inst%Nretrans_season_patch , & ! Output: [real(r8) (:) + ! ] Retranslocation N uptake (gN/m2/s) + Nretrans_stress => cnveg_nitrogenflux_inst%Nretrans_stress_patch , & ! Output: [real(r8) (:) + ! ] Retranslocation N uptake (gN/m2/s) + Nuptake => cnveg_nitrogenflux_inst%Nuptake_patch , & ! Output: [real(r8) (:) + ! ] Total N uptake of FUN (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) + ! (:) ] deployment of retranslocated N (gN/m2/s) + free_retransn_to_npool => cnveg_nitrogenflux_inst%free_retransn_to_npool_patch , & ! Output: [real(r8) + ! uptake of free N from leaves (needed to allow RT during the night with no NPP + sminn_to_plant_fun => cnveg_nitrogenflux_inst%sminn_to_plant_fun_patch , & ! Output: + ! [real(r8) (:) ] Total soil N uptake of FUN (gN/m2/s) + sminn_to_plant_fun_vr => cnveg_nitrogenflux_inst%sminn_to_plant_fun_vr_patch , & ! Output: + ! [real(r8) (:) ] Total layer soil N uptake of FUN (gN/m2 + ! /s) + sminn_to_plant_fun_no3_vr => cnveg_nitrogenflux_inst%sminn_to_plant_fun_no3_vr_patch , & ! Output: [real(r8) + ! (:) ] Total layer no3 uptake of FUN (gN/m2/s) + sminn_to_plant_fun_nh4_vr => cnveg_nitrogenflux_inst%sminn_to_plant_fun_nh4_vr_patch , & ! Output: [real(r8) + ! (:) ] Total layer nh4 uptake of FUN (gN/m2/s) + sminn_to_plant_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_vr_col , & ! Output: [real(r8) (: + ! ,:) ] + smin_no3_to_plant_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_to_plant_vr_col , & ! Output: [real(r8) (: + ! ,:) ] + smin_nh4_to_plant_vr => soilbiogeochem_nitrogenflux_inst%smin_nh4_to_plant_vr_col , & ! Output: [real(r8) (: + ! ,:) ] + smin_vr_nh4 => soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral + ! NH4 + smin_vr_no3 => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral + ! NO3 + soilc_change => cnveg_carbonflux_inst%soilc_change_patch , & ! Output: [real(r8) + ! (:) ] Used C from the soil (gC/m2/s) + h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:)] + ! liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:)] + ! soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + crootfr => soilstate_inst%crootfr_patch & ! Input: [real(r8) (:,:)] + ! fraction of roots for carbon in each soil layer (nlevgrnd) + ) + !-------------------------------------------------------------------- + !----------- + ! Initialize output fluxes, which were also initialized in CNFUNMod. + !-------------------------------------------------------------------- + !----------- + local_use_flexibleCN = use_flexibleCN + steppday = 48._r8 + qflx_tran_veg_layer = 0._r8 + rootc_dens_step = 0._r8 + plant_ndemand_pool = 0._r8 + + call t_startf('CNFUNzeroarrays') + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + availc_pool(p) = 0._r8 + rootC(p) = 0._r8 + litterfall_n(p) = 0._r8 + burnedoff_carbon(p) = 0._r8 + end do + + + do j = 1, nlevdecomp + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + c = patch%column(p) + rootc_dens(p,j) = 0._r8 + cost_retran(p,j) = 0._r8 + cost_fix(p,j) = 0._r8 + cost_resis(p,j) = 0._r8 + cost_res_resis(p,j) = 0._r8 + cost_active_no3(p,j) = 0._r8 + cost_active_nh4(p,j) = 0._r8 + cost_nonmyc_no3(p,j) = 0._r8 + cost_nonmyc_nh4(p,j) = 0._r8 + + sminn_no3_conc(c,j) = 0._r8 + sminn_no3_layer(c,j) = 0._r8 + sminn_nh4_conc(c,j) = 0._r8 + sminn_nh4_layer(c,j) = 0._r8 + end do + end do + + do istp = 1, nstp + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + npp_remaining(p,istp) = 0._r8 + permyc(p,istp) = 0._r8 + plant_ndemand_pool_step(p,istp) = 0._r8 + nt_uptake(p,istp) = 0._r8 + npp_uptake(p,istp) = 0._r8 + leafn_step(p,istp) = 0._r8 + leafn_retrans_step(p,istp) = 0._r8 + litterfall_n_step(p,istp) = 0._r8 + litterfall_c_step(p,istp) = 0._r8 + end do + do j = 1, nlevdecomp + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + sminn_no3_conc_step(p,j,istp) = 0._r8 + sminn_no3_layer_step(p,j,istp) = 0._r8 + sminn_no3_uptake(p,j,istp) = 0._r8 + sminn_nh4_conc_step(p,j,istp) = 0._r8 + sminn_nh4_layer_step(p,j,istp) = 0._r8 + sminn_nh4_uptake(p,j,istp) = 0._r8 + end do + end do + end do + + do icost = 1, ncost6 + do j = 1, nlevdecomp + costNit(j,icost) = big_cost + end do + end do + + ! Time step of FUN + dt = get_step_size_real() + call t_stopf('CNFUNzeroarrays') + !-------------------------------------------------------------------- + !---------------------------- + ! Calculation starts + !-------------------------------------------------------------------- + call t_startf('CNFUNcalcs1') + !---------------------------- + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + + litterfall_n(p) = (leafc_to_litter_fun(p) / leafcn_offset(p)) * dt + rootC(p) = frootc(p) + + plantN(p) = leafn(p) + frootn(p) + livestemn(p) + livecrootn(p) + if (n_allometry(p).gt.0._r8) then + plantCN(p) = c_allometry(p)/n_allometry(p) !changed RF. + ! above code gives CN ratio too low. + else + plantCN(p) = 0._r8 + end if + end do ! PFT ends + do istp = 1, nstp + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + + if (istp.eq.ecm_step) then + permyc(p,istp) = perecm(ivt(p)) + kc_active(p,istp) = ekc_active(ivt(p)) + kn_active(p,istp) = ekn_active(ivt(p)) + else + permyc(p,istp) = 1._r8 - perecm(ivt(p)) + kc_active(p,istp) = akc_active(ivt(p)) + kn_active(p,istp) = akn_active(ivt(p)) + end if + + if(leafc(p)>0.0_r8)then + ! N available in leaf which fell off in this timestep. Same fraction loss as C. + litterfall_c_step(p,istp) = dt * permyc(p,istp) * leafc_to_litter_fun(p) + litterfall_n_step(p,istp) = dt * permyc(p,istp) * leafn(p) * leafc_to_litter_fun(p)/leafc(p) + endif + + if (season_decid(ivt(p)) == 1._r8.or.stress_decid(ivt(p)) == 1._r8) then + if (offset_flag(p) .ne. 1._r8) then + litterfall_n_step(p,istp) = 0.0_r8 + litterfall_c_step(p,istp) = 0.0_r8 + endif + endif + + end do + end do + + do j = 1, nlevdecomp + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + c = patch%column(p) + sminn_no3_layer(c,j)= smin_no3_to_plant_vr(c,j) * dzsoi_decomp(j) * dt + sminn_nh4_layer(c,j)= smin_nh4_to_plant_vr(c,j) * dzsoi_decomp(j) * dt + if (h2osoi_liq(c,j) < smallValue) then + sminn_no3_layer(c,j) = 0._r8 + sminn_nh4_layer(c,j) = 0._r8 + end if + sminn_no3_layer(c,j) = max(sminn_no3_layer(c,j),0._r8) + sminn_nh4_layer(c,j) = max(sminn_nh4_layer(c,j),0._r8) + if (h2osoi_liq(c,j) > smallValue) then + sminn_no3_conc(c,j) = sminn_no3_layer(c,j) / (h2osoi_liq(c,j) * 1000._r8) ! (gN/m2)/(gH2O/m2) (coverted from + ! kg2g) + sminn_nh4_conc(c,j) = sminn_nh4_layer(c,j) / (h2osoi_liq(c,j) * 1000._r8) ! (gN/m2)/(gH2O/m2) (coverted from + ! kg2g) + else + sminn_no3_conc(c,j) = 0._r8 + sminn_nh4_conc(c,j) = 0._r8 + end if + end do + end do + + do istp = 1, nstp + do j = 1, nlevdecomp + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + c = patch%column(p) + + sminn_no3_layer_step(p,j,istp) = sminn_no3_layer(c,j) * permyc(p,istp) + sminn_nh4_layer_step(p,j,istp) = sminn_nh4_layer(c,j) * permyc(p,istp) + sminn_no3_conc_step(p,j,istp) = sminn_no3_conc(c,j) * permyc(p,istp) + sminn_nh4_conc_step(p,j,istp) = sminn_nh4_conc(c,j) * permyc(p,istp) + end do + end do + end do + call t_stopf('CNFUNcalcs1') + + call t_startf('CNFUNzeroarrays2') + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + n_passive_acc(p) = 0._r8 + n_fix_acc_total(p) = 0._r8 + n_retrans_acc_total(p) = 0._r8 + npp_fix_acc_total(p) = 0._r8 + n_nonmyc_no3_retrans_total(p) = 0._r8 + n_nonmyc_nh4_retrans_total(p) = 0._r8 + npp_retrans_acc_total(p) = 0._r8 + n_am_no3_acc(p) = 0._r8 + n_am_nh4_acc(p) = 0._r8 + n_am_no3_retrans(p) = 0._r8 + n_am_nh4_retrans(p) = 0._r8 + n_ecm_no3_acc(p) = 0._r8 + n_ecm_nh4_acc(p) = 0._r8 + n_ecm_no3_retrans(p) = 0._r8 + n_ecm_nh4_retrans(p) = 0._r8 + n_active_no3_acc_total(p) = 0._r8 + n_active_nh4_acc_total(p) = 0._r8 + n_active_no3_retrans_total(p) = 0._r8 + n_active_nh4_retrans_total(p) = 0._r8 + n_nonmyc_no3_acc_total(p) = 0._r8 + n_nonmyc_nh4_acc_total(p) = 0._r8 + npp_active_no3_acc_total(p) = 0._r8 + npp_active_nh4_acc_total(p) = 0._r8 + npp_active_no3_retrans_total(p) = 0._r8 + npp_active_nh4_retrans_total(p) = 0._r8 + npp_nonmyc_no3_acc_total(p) = 0._r8 + npp_nonmyc_nh4_acc_total(p) = 0._r8 + npp_nonmyc_no3_retrans_total(p) = 0._r8 + npp_nonmyc_nh4_retrans_total(p) = 0._r8 + free_Nretrans(p) = 0._r8 + end do + + do j = 1, nlevdecomp + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + n_passive_no3_vr(p,j) = 0._r8 + n_passive_nh4_vr(p,j) = 0._r8 + n_active_no3_vr(p,j) = 0._r8 + n_nonmyc_no3_vr(p,j) = 0._r8 + n_active_nh4_vr(p,j) = 0._r8 + n_nonmyc_nh4_vr(p,j) = 0._r8 + end do + end do + do istp = 1, nstp + do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + n_passive_step(p,istp) = 0._r8 + n_fix_acc(p,istp) = 0._r8 + n_retrans_acc(p,istp) = 0._r8 + npp_fix_acc(p,istp) = 0._r8 + npp_retrans_acc(p,istp) = 0._r8 + n_active_no3_acc(p,istp) = 0._r8 + n_active_nh4_acc(p,istp) = 0._r8 + n_active_no3_retrans(p,istp) = 0._r8 + n_active_nh4_retrans(p,istp) = 0._r8 + n_nonmyc_no3_acc(p,istp) = 0._r8 + n_nonmyc_nh4_acc(p,istp) = 0._r8 + n_nonmyc_no3_retrans(p,istp) = 0._r8 + n_nonmyc_nh4_retrans(p,istp) = 0._r8 + npp_active_no3_acc(p,istp) = 0._r8 + npp_active_nh4_acc(p,istp) = 0._r8 + npp_active_no3_retrans(p,istp) = 0._r8 + npp_active_nh4_retrans(p,istp) = 0._r8 + npp_nonmyc_no3_acc(p,istp) = 0._r8 + npp_nonmyc_nh4_acc(p,istp) = 0._r8 + npp_nonmyc_no3_retrans(p,istp) = 0._r8 + npp_nonmyc_nh4_retrans(p,istp) = 0._r8 + end do + end do + + burned_off_carbon = 0._r8 + call t_stopf('CNFUNzeroarrays2') + + + call t_startf('CNFUNcalcs') +pft:do fp = 1,num_soilp ! PFT Starts + p = filter_soilp(fp) + c = patch%column(p) + excess_carbon_acc = 0.0_r8 + burned_off_carbon = 0.0_r8 + + sminn_to_plant_fun_nh4_vr(p,:) = 0._r8 + sminn_to_plant_fun_no3_vr(p,:) = 0._r8 + + ! I have turned off this r etranslocation functionality for now. To + ! be rolled back in to a new version later on once the rest of + ! th + ! mode is working OK. RF + + if (season_decid(ivt(p)) == 1._r8.or.stress_decid(ivt(p)) == 1._r8) then + if (onset_flag(p) == 1._r8) then + leafc_storage_xfer_acc(p) = leafc_storage_xfer_acc(p) + leafc_storage_to_xfer(p) * dt + leafn_storage_xfer_acc(p) = leafn_storage_xfer_acc(p) + leafn_storage_to_xfer(p) * dt + end if + if (offset_flag(p) == 1._r8) then + storage_cdemand(p) = leafc_storage(p) / (ndays_off * steppday) + storage_ndemand(p) = leafn_storage_xfer_acc(p) / (ndays_off * steppday) + storage_ndemand(p) = max(storage_ndemand(p),0._r8) + else + storage_cdemand(p) = 0._r8 + storage_ndemand(p) = 0._r8 + end if + else + storage_cdemand(p) = 0._r8 + storage_ndemand(p) = 0._r8 + end if ! end for deciduous + + !---------How much carbon is provided, to be used for either growth + ! or Nitrogen uptake?------------------- + availc_pool(p) = availc(p) * dt + + if (availc_pool(p) > 0._r8) then + do j = 1, nlevdecomp + rootc_dens(p,j) = crootfr(p,j) * rootC(p) + end do + end if + + plant_ndemand_pool(p) = plant_ndemand(p) * dt + plant_ndemand_pool(p) = max(plant_ndemand_pool(p),0._r8) + plant_ndemand_retrans(p) = storage_ndemand(p) + + !-------------------------------------------------------------------- + !---------- +stp: do istp = ecm_step, am_step ! TWO STEPS + retrans_limit1 = 0._r8 + dn = 0._r8 + dnpp = 0._r8 + + ! zero out all of the fluxes that get accumulated accross ISTP + sminn_no3_diff = 0._r8 + sminn_nh4_diff = 0._r8 + active_no3_limit1 = 0._r8 + active_nh4_limit1 = 0._r8 + + + n_from_active_no3(:) = 0.0_r8 + n_from_active_nh4(:) = 0.0_r8 + n_from_nonmyc_no3(:) = 0.0_r8 + n_from_nonmyc_nh4(:) = 0.0_r8 + n_from_fixation(:) = 0.0_r8 + n_from_retrans(:) = 0.0_r8 + + n_active_no3_acc(p,istp) = 0.0_r8 + n_active_nh4_acc(p,istp) = 0.0_r8 + n_nonmyc_no3_acc(p,istp) = 0.0_r8 + n_nonmyc_nh4_acc(p,istp) = 0.0_r8 + n_fix_acc(p,istp) = 0.0_r8 + n_retrans_acc(p,istp) = 0.0_r8 + free_nretrans_acc(p,istp) = 0.0_r8 + + npp_active_no3_acc(p,istp) = 0.0_r8 + npp_active_nh4_acc(p,istp) = 0.0_r8 + npp_nonmyc_no3_acc(p,istp) = 0.0_r8 + npp_nonmyc_no3_acc(p,istp) = 0.0_r8 + npp_fix_acc(p,istp) = 0.0_r8 + npp_retrans_acc(p,istp) = 0.0_r8 + + npp_to_active_no3(:) = 0.0_r8 + npp_to_active_nh4(:) = 0.0_r8 + npp_to_nonmyc_no3(:) = 0.0_r8 + npp_to_nonmyc_nh4(:) = 0.0_r8 + npp_to_fixation(:) = 0.0_r8 + npp_to_retrans(:) = 0.0_r8 + + + + unmetDemand = .TRUE. + plant_ndemand_pool_step(p,istp) = plant_ndemand_pool(p) * permyc(p,istp) + npp_remaining(p,istp) = availc_pool(p) * permyc(p,istp) + + + ! if (plant_ndemand_pool_step(p,istp) .gt. 0._r8) then ! + ! plant_ndemand_pool_step > 0.0 + + do j = 1, nlevdecomp + tc_soisno(c,j) = t_soisno(c,j) - tfrz + if(pftcon%c3psn(patch%itype(p)).eq.1)then + fixer=1 + else + fixer=0 + endif + costNit(j,icostFix) = fun_cost_fix(fixer,a_fix(ivt(p)),b_fix(ivt(p))& + ,c_fix(ivt(p)) ,big_cost,crootfr(p,j),s_fix(ivt(p)),tc_soisno(c,j)) + end do + cost_fix(p,1:nlevdecomp) = costNit(:,icostFix) + + + !-------------------------------------------------------------------- + !------------ + ! If passive uptake is insufficient, consider fixation, + ! mycorrhizal + ! non-mycorrhizal, storage, and retranslocation. + !-------------------------------------------------------------------- + !------------ + !-------------------------------------------------------------------- + !------------ + ! Costs of active uptake. + !-------------------------------------------------------------------- + !------------ + !------Mycorrhizal Uptake Cost-----------------! + do j = 1,nlevdecomp + rootc_dens_step = rootc_dens(p,j) * permyc(p,istp) + costNit(j,icostActiveNO3) = fun_cost_active(sminn_no3_layer_step(p,j,istp) & + ,big_cost,kc_active(p,istp),kn_active(p,istp) ,rootc_dens_step,crootfr(p,j),smallValue) + costNit(j,icostActiveNH4) = fun_cost_active(sminn_nh4_layer_step(p,j,istp) & + ,big_cost,kc_active(p,istp),kn_active(p,istp) ,rootc_dens_step,crootfr(p,j),smallValue) + end do + cost_active_no3(p,1:nlevdecomp) = costNit(:,icostActiveNO3) + cost_active_nh4(p,1:nlevdecomp) = costNit(:,icostActiveNH4) + + + !------Non-mycorrhizal Uptake Cost-------------! + do j = 1,nlevdecomp + rootc_dens_step = rootc_dens(p,j) * permyc(p,istp) + costNit(j,icostnonmyc_no3) = fun_cost_nonmyc(sminn_no3_layer_step(p,j,istp) & + ,big_cost,kc_nonmyc(ivt(p)),kn_nonmyc(ivt(p)) ,rootc_dens_step,crootfr(p,j),smallValue) + costNit(j,icostnonmyc_nh4) = fun_cost_nonmyc(sminn_nh4_layer_step(p,j,istp) & + ,big_cost,kc_nonmyc(ivt(p)),kn_nonmyc(ivt(p)) ,rootc_dens_step,crootfr(p,j),smallValue) + end do + cost_nonmyc_no3(p,1:nlevdecomp) = costNit(:,icostnonmyc_no3) + cost_nonmyc_nh4(p,1:nlevdecomp) = costNit(:,icostnonmyc_nh4) + + + ! Remove C required to pair with N from passive uptake + ! from the available pool. + npp_remaining(p,istp) = npp_remaining(p,istp) - n_passive_step(p,istp)*plantCN(p) + +fix_loop: do FIX =plants_are_fixing, plants_not_fixing !loop around percentages of fixers and non + ! fixers, with differnt costs. + if(FIX==plants_are_fixing)then ! How much of the carbon in this PFT can in principle be used for fixation? + ! This is analagous to fixing the % of fixers for a given PFT - may not be realistic in the long run + ! but prevents wholesale switching to fixer dominance during e.g. CO2 fertilization. + fixerfrac = FUN_fracfixers(ivt(p)) + else + fixerfrac = 1.0_r8 - FUN_fracfixers(ivt(p)) + endif + npp_to_spend = npp_remaining(p,istp) * fixerfrac !put parameter here. + + + + n_from_active_no3(1:nlevdecomp) = 0._r8 + n_from_active_nh4(1:nlevdecomp) = 0._r8 + n_from_nonmyc_no3(1:nlevdecomp) = 0._r8 + n_from_nonmyc_nh4(1:nlevdecomp) = 0._r8 + !-------------------------------------------------------------------- + !----------- + ! Calculate Integrated Resistance OF WHOLE SOIL COLUMN + !-------------------------------------------------------------------- + !----------- + + sum_n_acquired = 0.0_r8 + total_N_conductance = 0.0_r8 + do j = 1, nlevdecomp + !----------! + ! Method changed from FUN-resistors method to a method which + ! allocates fluxs based on conductance. rosief + !----------! + + ! Sum the conductances + total_N_conductance = total_N_conductance + 1._r8/ & + cost_active_no3(p,j) + 1._r8/cost_active_nh4(p,j) & + + 1._r8/cost_nonmyc_no3(p,j) & + + 1._r8/cost_nonmyc_nh4(p,j) + if(FIX==plants_are_fixing)then + total_N_conductance = total_N_conductance + 1.0_r8 * 1._r8/cost_fix(p,j) + end if + + end do + + do j = 1, nlevdecomp + ! Calculate npp allocation to pathways proportional to their exchange rate (N/C) + + npp_frac_to_active_nh4(j) = (1._r8/cost_active_nh4(p,j)) / total_N_conductance + npp_frac_to_nonmyc_nh4(j) = (1._r8/cost_nonmyc_nh4(p,j)) / total_N_conductance + npp_frac_to_active_no3(j) = (1._r8/cost_active_no3(p,j)) / total_N_conductance + npp_frac_to_nonmyc_no3(j) = (1._r8/cost_nonmyc_no3(p,j)) / total_N_conductance + if(FIX==plants_are_fixing)then + npp_frac_to_fixation(j) = (1.0_r8 * 1._r8/cost_fix(p,j)) / total_N_conductance + else + npp_frac_to_fixation(j) = 0.0_r8 + end if + + ! Calculate hypothetical N uptake from each source + if(FIX==plants_are_fixing)then + n_exch_fixation(j) = npp_frac_to_fixation(j) / cost_fix(p,j) + else + n_exch_fixation(j) = 0.0_r8 + end if + + n_exch_active_nh4(j) = npp_frac_to_active_nh4(j) / cost_active_nh4(p,j) + n_exch_nonmyc_nh4(j) = npp_frac_to_nonmyc_nh4(j) / cost_nonmyc_nh4(p,j) + n_exch_active_no3(j) = npp_frac_to_active_no3(j) / cost_active_no3(p,j) + n_exch_nonmyc_no3(j) = npp_frac_to_nonmyc_no3(j) / cost_nonmyc_no3(p,j) + + ! Total N aquired from one unit of carbon (N/C) + sum_n_acquired = sum_n_acquired + n_exch_active_nh4(j) +& + n_exch_nonmyc_nh4(j)+ n_exch_active_no3(j) + n_exch_nonmyc_no3(j) + + if(FIX==plants_are_fixing)then + sum_n_acquired= sum_n_acquired + n_exch_fixation(j) + end if + + end do !nlevdecomp + + total_N_resistance = 1.0_r8/sum_n_acquired + + !------------------------------------------------------------------------------- + ! Calculate appropriate degree of retranslocation + !------------------------------------------------------------------------------- + + if(leafc(p).gt.0.0_r8.and.litterfall_n_step(p,istp)* fixerfrac>0.0_r8.and.ivt(p) 0._r8 + end do stp ! NSTEP + + + !------------------------------------------------------------------------------- + ! Turn step level quantities back into fluxes per second. + !------------------------------------------------------------------------------- + + !---------------------------N fluxes--------------------! + Npassive(p) = n_passive_acc(p)/dt + Nfix(p) = n_fix_acc_total(p)/dt + retransn_to_npool(p) = n_retrans_acc_total(p)/dt + if(.not. use_matrixcn)then + free_retransn_to_npool(p) = free_nretrans(p)/dt + else + if(retransn(p) .gt. 0)then + free_retransn_to_npool(p) = retransn(p) * matrix_update_phn(p,iretransn_to_iout,free_nretrans(p)/dt/retransn(p),dt,cnveg_nitrogenflux_inst,.true.,.true.) + else + free_retransn_to_npool(p) = 0._r8 + end if + end if + ! this is the N that comes off leaves. + Nretrans(p) = retransn_to_npool(p) + free_retransn_to_npool(p) + + + + + !Extract active uptake N from soil pools. + do j = 1, nlevdecomp + !RF change. The N fixed doesn't actually come out of the soil mineral pools, it is 'new'... + sminn_to_plant_fun_no3_vr(p,j) = (n_passive_no3_vr(p,j) + n_active_no3_vr(p,j) & + + n_nonmyc_no3_vr(p,j))/(dzsoi_decomp(j)*dt) + sminn_to_plant_fun_nh4_vr(p,j) = (n_passive_nh4_vr(p,j) + n_active_nh4_vr(p,j) & + + n_nonmyc_nh4_vr(p,j))/(dzsoi_decomp(j)*dt) + + end do + + + + Nactive_no3(p) = n_active_no3_acc_total(p)/dt + n_active_no3_retrans_total(p)/dt + Nactive_nh4(p) = n_active_nh4_acc_total(p)/dt + n_active_nh4_retrans_total(p)/dt + + + + Necm_no3(p) = n_ecm_no3_acc(p)/dt + n_ecm_no3_retrans(p)/dt + Necm_nh4(p) = n_ecm_nh4_acc(p)/dt + n_ecm_nh4_retrans(p)/dt + Necm(p) = Necm_no3(p) + Necm_nh4(p) + Nam_no3(p) = n_am_no3_acc(p)/dt + n_am_no3_retrans(p)/dt + Nam_nh4(p) = n_am_nh4_acc(p)/dt + n_am_nh4_retrans(p)/dt + Nam(p) = Nam_no3(p) + Nam_nh4(p) + Nnonmyc_no3(p) = n_nonmyc_no3_acc_total(p)/dt + n_nonmyc_no3_retrans_total(p)/dt + Nnonmyc_nh4(p) = n_nonmyc_nh4_acc_total(p)/dt + n_nonmyc_nh4_retrans_total(p)/dt + Nnonmyc(p) = Nnonmyc_no3(p) + Nnonmyc_nh4(p) + plant_ndemand_retrans(p) = plant_ndemand_retrans(p)/dt + Nuptake(p) = Nactive_no3(p) + Nactive_nh4(p) + Nnonmyc_no3(p) & + + Nnonmyc_nh4(p) + Nfix(p) + Npassive(p) + & + retransn_to_npool(p)+free_retransn_to_npool(p) + Nactive(p) = Nactive_no3(p) + Nactive_nh4(p) + Nnonmyc_no3(p) + Nnonmyc_nh4(p) + + ! free N goes straight to the npool, not throught Nuptake... + sminn_to_plant_fun(p) = Nactive_no3(p) + Nactive_nh4(p) + Nnonmyc_no3(p) + Nnonmyc_nh4(p) + Nfix(p) + Npassive(p) + + + soil_n_extraction = ( sum(n_active_no3_vr(p,1: nlevdecomp))+sum(n_nonmyc_no3_vr(p,1: nlevdecomp))+& + sum(n_active_nh4_vr(p,1: nlevdecomp)) + sum(n_nonmyc_nh4_vr(p,1: nlevdecomp))) + + !---------------------------C fluxes--------------------! + + npp_Nactive_no3(p) = npp_active_no3_acc_total(p)/dt + npp_active_no3_retrans_total(p)/dt + npp_Nactive_nh4(p) = npp_active_nh4_acc_total(p)/dt + npp_active_nh4_retrans_total(p)/dt + + npp_Nnonmyc_no3(p) = npp_nonmyc_no3_acc_total(p)/dt + npp_nonmyc_no3_retrans_total(p)/dt + npp_Nnonmyc_nh4(p) = npp_nonmyc_nh4_acc_total(p)/dt + npp_nonmyc_nh4_retrans_total(p)/dt + npp_Nactive(p) = npp_Nactive_no3(p) + npp_Nactive_nh4(p) + npp_Nnonmyc_no3(p) + npp_Nnonmyc_nh4(p) + npp_Nnonmyc(p) = npp_Nnonmyc_no3(p) + npp_Nnonmyc_nh4(p) + npp_Nfix(p) = npp_fix_acc_total(p)/dt + npp_Nretrans(p) = npp_retrans_acc_total(p)/dt + + !---------------------------Extra Respiration Fluxes--------------------! + soilc_change(p) = (npp_active_no3_acc_total(p) + npp_active_nh4_acc_total(p) & + + npp_nonmyc_no3_acc_total(p) & + + npp_nonmyc_nh4_acc_total(p) + npp_fix_acc_total(p))/dt & + + npp_Nretrans(p) + soilc_change(p) = soilc_change(p) + burned_off_carbon / dt + burnedoff_carbon(p) = burned_off_carbon/dt + npp_Nuptake(p) = soilc_change(p) + ! how much carbon goes to growth of tissues? + npp_growth(p) = (Nuptake(p)- free_retransn_to_npool(p))*plantCN(p)+(excess_carbon_acc/dt) !does not include gresp, since this is calculated from growth + + + + !-----------------------Diagnostic Fluxes------------------------------! + if(availc(p).gt.0.0_r8)then !what happens in the night? + nuptake_npp_fraction_patch(p) = npp_Nuptake(p)/availc(p) + else + nuptake_npp_fraction_patch(p) = spval + endif + if(npp_Nfix(p).gt.0.0_r8)then + cost_nfix(p) = Nfix(p)/npp_Nfix(p) + else + cost_nfix(p) = spval + endif + if(npp_Nactive(p).gt.0.0_r8)then + cost_nactive(p) = Nactive(p)/npp_Nactive(p) + else + cost_nactive(p) = spval + endif + if(npp_Nretrans(p).gt.0.0_r8)then + cost_nretrans(p) = Nretrans(p)/npp_Nretrans(p) + else + cost_nretrans(p) = spval + endif + + + end do pft ! PFT Ends + + call t_stopf('CNFUNcalcs') + + call p2c(bounds, num_soilc, filter_soilc, & + cnveg_carbonflux_inst%soilc_change_patch(bounds%begp:bounds%endp), & + soilbiogeochem_carbonflux_inst%soilc_change_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + cnveg_nitrogenflux_inst%Nfix_patch(bounds%begp:bounds%endp), & + soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col(bounds%begc:bounds%endc)) + + end associate + end subroutine CNFUN +!========================================================================================= + real(r8) function fun_cost_fix(fixer,a_fix,b_fix,c_fix,big_cost,crootfr,s_fix, tc_soisno) + +! Description: +! Calculate the cost of fixing N by nodules. +! Code Description: +! This code is written to CLM4CN by Mingjie Shi on 06/27/2013 + + implicit none +!-------------------------------------------------------------------------- +! Function result. +!-------------------------------------------------------------------------- +! real(r8) , intent(out) :: cost_of_n !!! cost of fixing N (kgC/kgN) +!-------------------------------------------------------------------------- +! Scalar arguments with intent(in). +!-------------------------------------------------------------------------- + integer, intent(in) :: fixer ! flag indicating if plant is a fixer + ! 1=yes, otherwise no. + real(r8), intent(in) :: a_fix ! As in Houlton et al. (Nature) 2008 + real(r8), intent(in) :: b_fix ! As in Houlton et al. (Nature) 2008 + real(r8), intent(in) :: c_fix ! As in Houlton et al. (Nature) 2008 + real(r8), intent(in) :: big_cost ! an arbitrary large cost (gC/gN) + real(r8), intent(in) :: crootfr ! fraction of roots for carbon that are in this layer + real(r8), intent(in) :: s_fix ! Inverts Houlton et al. 2008 and constrains between 7.5 and 12.5 + real(r8), intent(in) :: tc_soisno ! soil temperature (degrees Celsius) + + if (fixer == 1 .and. crootfr > 1.e-6_r8) then + fun_cost_fix = s_fix * (exp(a_fix + b_fix * tc_soisno * (1._r8 - 0.5_r8 * tc_soisno / c_fix)) - 2._r8) + + + ! New term to directly account for Ben Houlton's temperature response function. + ! Assumes s_fix is -6. (RF, Jan 2015) + ! 1.25 converts from the Houlton temp response function to a 0-1 limitation factor. + ! The cost of N should probably be 6 gC/gN (or 9, including maintenance costs of nodules) + ! for 'optimal' temperatures. This cost should increase in a way that mirrors + ! Houlton et al's observations of temperautre limitations on the mirboial fixation rates. + ! We don't actually simulate the rate of fixation (and assume that N uptake is instantaneous) + ! here, so instead the limitation term is here rolled into the cost function. + + ! Here we invert the 'cost' to give the optimal N:C ratio (1/6 gN/gC) The amount of N + ! you get for a given C goes down as it gets colder, so this can be multiplied by + ! the temperature function to give a temperature-limited N:C of f/6. This number + ! can then be inverted to give a temperature limited C:N, as 1/(f/6). Which is the + ! same as 6/f, given here" + fun_cost_fix = (-1*s_fix) * 1.0_r8 / (1.25_r8* (exp(a_fix + b_fix * tc_soisno * (1._r8 - 0.5_r8 * tc_soisno / c_fix)) )) + else + fun_cost_fix = big_cost + end if ! ends up with the fixer or non-fixer decision + + end function fun_cost_fix +!========================================================================================= + real(r8) function fun_cost_active(sminn_layer,big_cost,kc_active,kn_active,rootc_dens,crootfr,smallValue) + +! Description: +! Calculate the cost of active uptake of N frm the soil. +! Code Description: +! This code is written to CLM4 by Mingjie Shi. + + implicit none +!-------------------------------------------------------------------------- +! Function result. +!-------------------------------------------------------------------------- + real(r8), intent(in) :: sminn_layer ! Amount of N (as NH4 or NO3) in the soil that is available to plants (gN/m2). + real(r8), intent(in) :: big_cost ! An arbitrary large cost (gC/gN). + real(r8), intent(in) :: kc_active ! Constant for cost of active uptake (gC/m2). + real(r8), intent(in) :: kn_active ! Constant for cost of active uptake (gC/m2). + real(r8), intent(in) :: rootc_dens ! Root carbon density in layer (gC/m3). + real(r8), intent(in) :: crootfr ! Fraction of roots that are in this layer. + real(r8), intent(in) :: smallValue ! A small number. + + if (rootc_dens > 1.e-6_r8.and.sminn_layer > smallValue) then + fun_cost_active = kn_active/sminn_layer + kc_active/rootc_dens + else +! There are very few roots in this layer. Set a high cost. + fun_cost_active = big_cost + end if + + end function fun_cost_active +!========================================================================================= + real(r8) function fun_cost_nonmyc(sminn_layer,big_cost,kc_nonmyc,kn_nonmyc,rootc_dens,crootfr,smallValue) + +! Description: +! Calculate the cost of nonmyc uptake of N frm the soil. +! Code Description: +! This code is written to CLM4 by Mingjie Shi. + + implicit none +!-------------------------------------------------------------------------- +! Function result. +!-------------------------------------------------------------------------- + real(r8), intent(in) :: sminn_layer ! Amount of N (as NH4 or NO3) in the soil that is available to plants (gN/m2). + real(r8), intent(in) :: big_cost ! An arbitrary large cost (gC/gN). + real(r8), intent(in) :: kc_nonmyc ! Constant for cost of nonmyc uptake (gC/m2). + real(r8), intent(in) :: kn_nonmyc ! Constant for cost of nonmyc uptake (gC/m2). + real(r8), intent(in) :: rootc_dens ! Root carbon density in layer (gC/m3). + real(r8), intent(in) :: crootfr ! Fraction of roots that are in this layer. + real(r8), intent(in) :: smallValue ! A small number. + + if (rootc_dens > 1.e-6_r8.and.sminn_layer > smallValue) then + fun_cost_nonmyc = kn_nonmyc / sminn_layer + kc_nonmyc / rootc_dens + else +! There are very few roots in this layer. Set a high cost. + fun_cost_nonmyc = big_cost + end if + + end function fun_cost_nonmyc + +!========================================================================== + + subroutine fun_retranslocation(p,dt,npp_to_spend,total_falling_leaf_c, & + total_falling_leaf_n, total_n_resistance, total_c_spent_retrans, & + total_c_accounted_retrans, free_n_retrans, paid_for_n_retrans, & + target_leafcn, grperc, plantCN) +! +! Description: +! This subroutine (should it be a function?) calculates the amount of N absorbed and C spent +! during retranslocation. +! Rosie Fisher. April 2016. +! !USES: + implicit none + +! !ARGUMENTS: + real(r8), intent(IN) :: total_falling_leaf_c ! INPUT gC/m2/timestep + real(r8), intent(IN) :: total_falling_leaf_n ! INPUT gC/m2/timestep + real(r8), intent(IN) :: total_n_resistance ! INPUT gC/gN + real(r8), intent(IN) :: npp_to_spend ! INPUT gN/m2/timestep + real(r8), intent(IN) :: target_leafcn ! INPUT gC/gN + real(r8), intent(IN) :: dt ! INPUT seconds + real(r8), intent(IN) :: grperc ! INPUT growth respiration fraction + real(r8), intent(IN) :: plantCN ! INPUT plant CN ratio + integer, intent(IN) :: p ! INPUT patch index + + real(r8), intent(OUT) :: total_c_spent_retrans ! OUTPUT gC/m2/timestep + real(r8), intent(OUT) :: total_c_accounted_retrans ! OUTPUT gC/m2/timestep + real(r8), intent(OUT) :: paid_for_n_retrans ! OUTPUT gN/m2/timestep + real(r8), intent(OUT) :: free_n_retrans ! OUTPUT gN/m2/timestep + + ! + ! !LOCAL VARIABLES: + real(r8) :: kresorb ! INTERNAL used factor + real(r8) :: falling_leaf_c ! INTERNAL gC/m2/timestep + real(r8) :: falling_leaf_n ! INTERNAL gN/m2/timestep + real(r8) :: falling_leaf_cn ! INTERNAL gC/gN + real(r8) :: cost_retrans_temp ! INTERNAL gC/gN + real(r8) :: leaf_n_ext ! INTERNAL gN/m2/timestep + real(r8) :: c_spent_retrans ! INTERNAL gC/m2/timestep + real(r8) :: c_accounted_retrans ! INTERNAL gC/m2/timestep + real(r8) :: npp_to_spend_temp ! INTERNAL gC/m2/timestep + real(r8) :: max_falling_leaf_cn ! INTERNAL gC/gN + real(r8) :: min_falling_leaf_cn ! INTERNAL gC/gN + real(r8) :: cost_escalation ! INTERNAL cost function parameter + integer :: iter ! INTERNAL + integer :: exitloop ! INTERNAL + ! ------------------------------------------------------------------------------- + + + ! ------------------ Initialize total fluxes. ------------------! + total_c_spent_retrans = 0.0_r8 + total_c_accounted_retrans = 0.0_r8 + c_accounted_retrans = 0.0_r8 + paid_for_n_retrans = 0.0_r8 + npp_to_spend_temp = npp_to_spend + + ! ------------------ Initial C and N pools in falling leaves. ------------------! + falling_leaf_c = total_falling_leaf_c + falling_leaf_n = total_falling_leaf_n + + ! ------------------ PARAMETERS ------------------ + max_falling_leaf_cn = target_leafcn * 3.0_r8 + min_falling_leaf_cn = target_leafcn * 1.5_r8 + cost_escalation = 1.3_r8 + + ! ------------------ Free uptake ------------------ + free_n_retrans = max(falling_leaf_n - (falling_leaf_c/min_falling_leaf_cn),0.0_r8) + falling_leaf_n = falling_leaf_n - free_n_retrans + + ! ------------------ Initial CN ratio and costs ------------------! + falling_leaf_cn = falling_leaf_c/falling_leaf_n + kresorb = (1.0_r8/target_leafcn) + cost_retrans_temp = kresorb / ((1.0_r8/falling_leaf_cn )**1.3_r8) + + ! ------------------ Iteration loops to figure out extraction limit ------------! + iter = 0 + exitloop = 0 + do while(exitloop==0.and.cost_retrans_temp .lt. total_n_resistance.and. & + falling_leaf_n.ge.0.0_r8.and.npp_to_spend.gt.0.0_r8) + ! ------------------ Spend some C on removing N ------------! + ! spend enough C to increase leaf C/N by 1 unit. + c_spent_retrans = cost_retrans_temp * (falling_leaf_n - falling_leaf_c / & + (falling_leaf_cn + 1.0_r8)) + ! don't spend more C than you have + c_spent_retrans = min(npp_to_spend_temp, c_spent_retrans) + ! N extracted, per this amount of C expenditure + leaf_n_ext = c_spent_retrans / cost_retrans_temp + ! Do not empty N pool + leaf_n_ext = min(falling_leaf_n, leaf_n_ext) + !How much C do you need to account for the N that got taken up? + c_accounted_retrans = leaf_n_ext * plantCN * (1.0_r8 + grperc) + + ! ------------------ Update leafCN, recalculate costs ------------! + falling_leaf_n = falling_leaf_n - leaf_n_ext ! remove N from falling leaves pool + if(falling_leaf_n.gt.0.0_r8)then + falling_leaf_cn = falling_leaf_c/falling_leaf_n ! C/N ratio + cost_retrans_temp = kresorb /((1.0_r8/falling_leaf_cn)**1.3_r8) ! cost function. PARAMETER + else + exitloop=1 + endif + + ! ------------------ Accumulate total fluxes ------------! + total_c_spent_retrans = total_c_spent_retrans + c_spent_retrans + total_c_accounted_retrans = total_c_accounted_retrans + c_accounted_retrans + paid_for_n_retrans = paid_for_n_retrans + leaf_n_ext + npp_to_spend_temp = npp_to_spend_temp - c_spent_retrans - c_accounted_retrans + iter = iter+1 + + ! run out of C or N + if(npp_to_spend_temp.le.0.0_r8)then + exitloop=1 + ! if we made a solving error on this (expenditure and n uptake should + ! really be solved simultaneously) + ! then remove the error from the expenditure. This changes the notional cost, + ! but only by a bit and prevents cpool errors. + + total_c_spent_retrans = total_c_spent_retrans + npp_to_spend_temp + endif + ! leaf CN is too high + if(falling_leaf_cn.ge.max_falling_leaf_cn)then + exitloop=1 + endif + ! safety check to prevent hanging code + if(iter.ge.150)then + exitloop=1 + endif + end do + + end subroutine fun_retranslocation + +!========================================================================== + +end module CNFUNMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 index 237e6509e..e448900bf 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -28,7 +28,7 @@ module CNSharedParamsMod type(CNParamsShareType), protected :: CNParamsShareInst - logical, public :: use_fun = .false. ! Use the FUN2.0 model + logical, public :: use_fun = .true. ! Use the FUN2.0 model integer, public :: nlev_soildecomp_standard = nlevgrnd character(len=*), parameter, private :: sourcefile = & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegMatrixMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegMatrixMod.F90 new file mode 100755 index 000000000..3bb68a9dc --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegMatrixMod.F90 @@ -0,0 +1,3839 @@ +module CNVegMatrixMod + + !--------------------------------------------------------------------------------------- + ! The matrix model of CLM5.0 was developed by Yiqi Luo EcoLab members, + ! Drs. Xingjie Lu, Yuanyuan Huang and Zhengguang Du, at Northern Arizona University + !--------------------------------------------------------------------------------------- + ! + ! DESCRIPTION: + ! Matrix solution for vegetation C and N cycles + ! The matrix equation + ! Xn+1 = Xn + B*I*dt + (Aph*Kph + Agm*Kgm + Afi*Kfi) * Xn*dt + ! Xn is the state variable of last time step n, and Xn+1 is the state variable of + ! the next time step n+1, I is the input to the vegetation, i.e. NPP in this case. + ! B is allocation fraction vector. + ! Aph, Agm and Afi represent transfer coefficient matrix A from phenology, gap mortality + ! and fire related C and N transfers. + ! Kph, Kgm and Kfi represent turnover rate matrix K from phenology, gap mortality + ! and fire related C and N transfers. + !--------------------------------------------------------------------------------------- + + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size,is_end_curr_year,is_first_step_of_this_run_segment,& + get_days_per_year,is_beg_curr_year,update_DA_nstep + use decompMod , only : bounds_type + use clm_varpar , only : nlevdecomp, nvegcpool, nvegnpool + use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& + ilivestem,ilivestem_st,ilivestem_xf,& + ideadstem,ideadstem_st,ideadstem_xf,& + ilivecroot,ilivecroot_st,ilivecroot_xf,& + ideadcroot,ideadcroot_st,ideadcroot_xf,& + igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn,& + ncphtrans,nnphtrans,ncgmtrans,nngmtrans,ncfitrans,nnfitrans,& + ncphouttrans,nnphouttrans,ncgmouttrans,nngmouttrans,ncfiouttrans,nnfiouttrans + use perf_mod , only : t_startf, t_stopf + use PatchType , only : patch + use clm_varcon , only : secspday + use pftconMod , only : pftcon,npcropmin + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type !include: callocation,ctransfer, cturnover + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegStateType , only : cnveg_state_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use clm_varctl , only : isspinup, is_outmatrix, nyr_forcing, nyr_SASU, iloop_avg + use clm_varctl , only : use_c13, use_c14 + use SPMMod , only : sparse_matrix_type,diag_matrix_type,vector_type + use MatrixMod , only : inverse + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CNVegMatrix + public:: matrix_update_phc,matrix_update_gmc,matrix_update_fic + public:: matrix_update_phn,matrix_update_gmn,matrix_update_fin + public:: CNVegMatrixRest + + ! ! PRIVATE MEMBER DATA: + integer,save, private :: iyr=0 ! Cycling year number into forcing sequence + integer,save, private :: iloop=0 ! The iloop^th forcing loop + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNVegMatrix(bounds,num_soilp,filter_soilp,num_actfirep,filter_actfirep,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst,& + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst,cnveg_state_inst,soilbiogeochem_nitrogenflux_inst, & + c13_cnveg_carbonstate_inst,c14_cnveg_carbonstate_inst,c13_cnveg_carbonflux_inst,& + c14_cnveg_carbonflux_inst) + ! !DESCRIPTION: + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_actfirep ! number of soil patches in filter + integer , intent(in) :: filter_actfirep(:) ! filter for soil patches + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + +! LOCAL VARIABLES: + integer :: fc,fp,j,i,k ! indices + integer :: p,c ! + + ! Temporary variables matrix A for different processes + real(r8),dimension(:,:) :: Aphconed(bounds%begp:bounds%endp,ncphtrans-ncphouttrans) + real(r8),dimension(:,:) :: Aphnoned(bounds%begp:bounds%endp,nnphtrans-nnphouttrans) + real(r8),dimension(:,:) :: Agmconed(bounds%begp:bounds%endp,ncgmtrans-ncgmouttrans) + real(r8),dimension(:,:) :: Agmnoned(bounds%begp:bounds%endp,nngmtrans-nngmouttrans) + real(r8),dimension(:,:) :: Aficoned(bounds%begp:bounds%endp,ncfitrans-ncfiouttrans) + real(r8),dimension(:,:) :: Afic14oned(bounds%begp:bounds%endp,ncfitrans-ncfiouttrans) + real(r8),dimension(:,:) :: Afinoned(bounds%begp:bounds%endp,nnfitrans-nnfiouttrans) + + ! Temporary variables saving row indices of all transfers in different processes + integer,dimension(:) :: AI_phc(ncphtrans-ncphouttrans) + integer,dimension(:) :: AI_phn(nnphtrans-nnphouttrans) + integer,dimension(:) :: AI_gmc(ncgmtrans-ncgmouttrans) + integer,dimension(:) :: AI_gmn(nngmtrans-nngmouttrans) + integer,dimension(:) :: AI_fic(ncfitrans-ncfiouttrans) + integer,dimension(:) :: AI_fic14(ncfitrans-ncfiouttrans) + integer,dimension(:) :: AI_fin(nnfitrans-nnfiouttrans) + + ! Temporary variables saving column indices of all transfers in different processes + integer,dimension(:) :: AJ_phc(ncphtrans-ncphouttrans) + integer,dimension(:) :: AJ_phn(nnphtrans-nnphouttrans) + integer,dimension(:) :: AJ_gmc(ncgmtrans-ncgmouttrans) + integer,dimension(:) :: AJ_gmn(nngmtrans-nngmouttrans) + integer,dimension(:) :: AJ_fic(ncfitrans-ncfiouttrans) + integer,dimension(:) :: AJ_fic14(ncfitrans-ncfiouttrans) + integer,dimension(:) :: AJ_fin(nnfitrans-nnfiouttrans) + + ! Temporary variables for matrix operation, which save C and N inputs to different vegetation compartments as a vector type. + type(vector_type) :: vegmatrixc_input + type(vector_type) :: vegmatrixc13_input + type(vector_type) :: vegmatrixc14_input + type(vector_type) :: vegmatrixn_input + + ! "init" indicators indicate whether A matrices have been initialized. + logical, save :: init_ready_aphc = .false. + logical, save :: init_ready_agmc = .false. + logical, save :: init_ready_afic = .false. + logical, save :: init_ready_afic14 = .false. + logical, save :: init_ready_aphn = .false. + logical, save :: init_ready_agmn = .false. + logical, save :: init_ready_afin = .false. + + ! "list" indicators indicate whether operation of sparse matrix plus SPMP_AB or SPMP_ABC has already been saved. + logical, save :: list_ready_phgmfic = .false. + logical, save :: list_ready_phgmfic14 = .false. + logical, save :: list_ready_phgmc = .false. + logical, save :: list_ready_phgmfin = .false. + logical, save :: list_ready_phgmn = .false. + + ! Temporary variables are only used at end of the year to calculate C and N storage capacity + real(r8),dimension(:) :: matrix_calloc_acc (1:nvegcpool) + real(r8),dimension(:) :: matrix_nalloc_acc (1:nvegnpool) + real(r8),dimension(:,:) :: matrix_ctransfer_acc (1:nvegcpool,1:nvegcpool) + real(r8),dimension(:,:) :: matrix_ntransfer_acc (1:nvegnpool,1:nvegnpool) + real(r8),dimension(:) :: matrix_c13alloc_acc (1:nvegcpool) + real(r8),dimension(:,:) :: matrix_c13transfer_acc (1:nvegcpool,1:nvegcpool) + real(r8),dimension(:) :: matrix_c14alloc_acc (1:nvegcpool) + real(r8),dimension(:,:) :: matrix_c14transfer_acc (1:nvegcpool,1:nvegcpool) + + ! Local variables for capacity calculation and spin up + real(r8),dimension(:) :: vegmatrixc_rt(1:nvegcpool) ! C storage capacity + real(r8),dimension(:) :: vegmatrixc13_rt(1:nvegcpool) ! C13 storage capacity + real(r8),dimension(:) :: vegmatrixc14_rt(1:nvegcpool) ! C14 storage capacity + real(r8),dimension(:) :: vegmatrixn_rt(1:nvegnpool) ! N storage capacity + real(r8),dimension(:,:) :: AKinvc(1:nvegcpool,1:nvegcpool),AKinvn(1:nvegnpool,1:nvegnpool) + real(r8):: epsi + + + real(r8):: dt ! time step (seconds) + real(r8):: secspyear ! time step (seconds) +#ifdef _OPENMP + integer, external :: OMP_GET_MAX_THREADS + integer :: nthreads ! Number of threads +#else + integer, parameter :: nthreads = 0 ! Number of threads +#endif + +fr: associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + cf13_veg => c13_cnveg_carbonflux_inst , & ! In + cf14_veg => c14_cnveg_carbonflux_inst , & ! In + cs13_veg => c13_cnveg_carbonstate_inst , & ! In/Output + cs14_veg => c14_cnveg_carbonstate_inst , & ! In/Output + + fire_closs => cnveg_carbonflux_inst%fire_closs_patch , & + + ! Original vegetation variables are updated by matrix operation in this module + leafc => cnveg_carbonstate_inst%leafc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf storage C + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf transfer C + frootc => cnveg_carbonstate_inst%frootc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root storage C + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root transfer C + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem C + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem storage C + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem transfer C + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem C + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem storage C + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem transfer C + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root storage C + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root transfer C + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root storage C + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root transfer C + grainc => cnveg_carbonstate_inst%grainc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain C + grainc_storage => cnveg_carbonstate_inst%grainc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain storage C + grainc_xfer => cnveg_carbonstate_inst%grainc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain transfer C + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf storage N + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf transfer N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root N + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root storage N + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root transfer N + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem N + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem storage N + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem transfer N + deadstemn => cnveg_nitrogenstate_inst%deadstemn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem N + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem storage N + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem transfer N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root N + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root storage N + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root transfer N + deadcrootn => cnveg_nitrogenstate_inst%deadcrootn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root N + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root storage N + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root transfer N + grainn => cnveg_nitrogenstate_inst%grainn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain N + grainn_storage => cnveg_nitrogenstate_inst%grainn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain storage N + grainn_xfer => cnveg_nitrogenstate_inst%grainn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain transfer N + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) plant retranslocated N + + leafc_SASUsave => cnveg_carbonstate_inst%leafc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C for SASU + leafc_storage_SASUsave => cnveg_carbonstate_inst%leafc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C for SASU + leafc_xfer_SASUsave => cnveg_carbonstate_inst%leafc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C for SASU + frootc_SASUsave => cnveg_carbonstate_inst%frootc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot C for SASU + frootc_storage_SASUsave => cnveg_carbonstate_inst%frootc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot C for SASU + frootc_xfer_SASUsave => cnveg_carbonstate_inst%frootc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot C for SASU + livestemc_SASUsave => cnveg_carbonstate_inst%livestemc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem C for SASU + livestemc_storage_SASUsave => cnveg_carbonstate_inst%livestemc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem C for SASU + livestemc_xfer_SASUsave => cnveg_carbonstate_inst%livestemc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem C for SASU + deadstemc_SASUsave => cnveg_carbonstate_inst%deadstemc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem C for SASU + deadstemc_storage_SASUsave => cnveg_carbonstate_inst%deadstemc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem C for SASU + deadstemc_xfer_SASUsave => cnveg_carbonstate_inst%deadstemc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem C for SASU + livecrootc_SASUsave => cnveg_carbonstate_inst%livecrootc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot C for SASU + livecrootc_storage_SASUsave => cnveg_carbonstate_inst%livecrootc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot C for SASU + livecrootc_xfer_SASUsave => cnveg_carbonstate_inst%livecrootc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot C for SASU + deadcrootc_SASUsave => cnveg_carbonstate_inst%deadcrootc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot C for SASU + deadcrootc_storage_SASUsave => cnveg_carbonstate_inst%deadcrootc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot C for SASU + deadcrootc_xfer_SASUsave => cnveg_carbonstate_inst%deadcrootc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot C for SASU + grainc_SASUsave => cnveg_carbonstate_inst%grainc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain C for SASU + grainc_storage_SASUsave => cnveg_carbonstate_inst%grainc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain storage C for SASU + + leafn_SASUsave => cnveg_nitrogenstate_inst%leafn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf N for SASU + leafn_storage_SASUsave => cnveg_nitrogenstate_inst%leafn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf N for SASU + leafn_xfer_SASUsave => cnveg_nitrogenstate_inst%leafn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf N for SASU + frootn_SASUsave => cnveg_nitrogenstate_inst%frootn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot N for SASU + frootn_storage_SASUsave => cnveg_nitrogenstate_inst%frootn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot N for SASU + frootn_xfer_SASUsave => cnveg_nitrogenstate_inst%frootn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot N for SASU + livestemn_SASUsave => cnveg_nitrogenstate_inst%livestemn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem N for SASU + livestemn_storage_SASUsave => cnveg_nitrogenstate_inst%livestemn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem N for SASU + livestemn_xfer_SASUsave => cnveg_nitrogenstate_inst%livestemn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem N for SASU + deadstemn_SASUsave => cnveg_nitrogenstate_inst%deadstemn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem N for SASU + deadstemn_storage_SASUsave => cnveg_nitrogenstate_inst%deadstemn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem N for SASU + deadstemn_xfer_SASUsave => cnveg_nitrogenstate_inst%deadstemn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem N for SASU + livecrootn_SASUsave => cnveg_nitrogenstate_inst%livecrootn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot N for SASU + livecrootn_storage_SASUsave => cnveg_nitrogenstate_inst%livecrootn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot N for SASU + livecrootn_xfer_SASUsave => cnveg_nitrogenstate_inst%livecrootn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot N for SASU + deadcrootn_SASUsave => cnveg_nitrogenstate_inst%deadcrootn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot N for SASU + deadcrootn_storage_SASUsave => cnveg_nitrogenstate_inst%deadcrootn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot N for SASU + deadcrootn_xfer_SASUsave => cnveg_nitrogenstate_inst%deadcrootn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot N for SASU + grainn_SASUsave => cnveg_nitrogenstate_inst%grainn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain N for SASU + grainn_storage_SASUsave => cnveg_nitrogenstate_inst%grainn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain storage N for SASU + + ! Vegetation capacity variables "matrix_cap_*", save the capacity of each vegetation compartment. + matrix_cap_leafc => cnveg_carbonstate_inst%matrix_cap_leafc_patch ,&!Output:[real(r8)(:)] (gC/m2) leaf C capacity + matrix_cap_leafc_storage => cnveg_carbonstate_inst%matrix_cap_leafc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) leaf storage C capacity + matrix_cap_leafc_xfer => cnveg_carbonstate_inst%matrix_cap_leafc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) leaf transfer C capacity + matrix_cap_frootc => cnveg_carbonstate_inst%matrix_cap_frootc_patch ,&!Output:[real(r8)(:)] (gC/m2) fine root C capacity + matrix_cap_frootc_storage => cnveg_carbonstate_inst%matrix_cap_frootc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) fine root storage C capacity + matrix_cap_frootc_xfer => cnveg_carbonstate_inst%matrix_cap_frootc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) fine root transfer C capacity + matrix_cap_livestemc => cnveg_carbonstate_inst%matrix_cap_livestemc_patch ,&!Output:[real(r8)(:)] (gC/m2) live stem C capacity + matrix_cap_livestemc_storage => cnveg_carbonstate_inst%matrix_cap_livestemc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) live stem storage C capacity + matrix_cap_livestemc_xfer => cnveg_carbonstate_inst%matrix_cap_livestemc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) live stem transfer C capacity + matrix_cap_deadstemc => cnveg_carbonstate_inst%matrix_cap_deadstemc_patch ,&!Output:[real(r8)(:)] (gC/m2) dead stem C capacity + matrix_cap_deadstemc_storage => cnveg_carbonstate_inst%matrix_cap_deadstemc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) dead stem storage C capaicty + matrix_cap_deadstemc_xfer => cnveg_carbonstate_inst%matrix_cap_deadstemc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) dead stem transfer C capacity + matrix_cap_livecrootc => cnveg_carbonstate_inst%matrix_cap_livecrootc_patch ,&!Output:[real(r8)(:)] (gC/m2) live coarse root C capacity + matrix_cap_livecrootc_storage => cnveg_carbonstate_inst%matrix_cap_livecrootc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) live coarse root storage C capacity + matrix_cap_livecrootc_xfer => cnveg_carbonstate_inst%matrix_cap_livecrootc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) live coarse root transfer C capacity + matrix_cap_deadcrootc => cnveg_carbonstate_inst%matrix_cap_deadcrootc_patch ,&!Output:[real(r8)(:)] (gC/m2) dead coarse root C capacity + matrix_cap_deadcrootc_storage => cnveg_carbonstate_inst%matrix_cap_deadcrootc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) dead coarse root storage C capacity + matrix_cap_deadcrootc_xfer => cnveg_carbonstate_inst%matrix_cap_deadcrootc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) dead coarse root transfer C capacity + matrix_cap_grainc => cnveg_carbonstate_inst%matrix_cap_grainc_patch ,&!Output:[real(r8)(:)] (gC/m2) grain C capacity + matrix_cap_grainc_storage => cnveg_carbonstate_inst%matrix_cap_grainc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) grain storage C capacity + matrix_cap_grainc_xfer => cnveg_carbonstate_inst%matrix_cap_grainc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) grain transfer C + + matrix_cap_leafn => cnveg_nitrogenstate_inst%matrix_cap_leafn_patch ,&!Output:[real(r8)(:)] (gN/m2) leaf N capacity + matrix_cap_leafn_storage => cnveg_nitrogenstate_inst%matrix_cap_leafn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) leaf storage N capacity + matrix_cap_leafn_xfer => cnveg_nitrogenstate_inst%matrix_cap_leafn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) leaf transfer N capacity + matrix_cap_frootn => cnveg_nitrogenstate_inst%matrix_cap_frootn_patch ,&!Output:[real(r8)(:)] (gN/m2) fine root N capacity + matrix_cap_frootn_storage => cnveg_nitrogenstate_inst%matrix_cap_frootn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) fine root storage N capacity + matrix_cap_frootn_xfer => cnveg_nitrogenstate_inst%matrix_cap_frootn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) fine root transfer N capacity + matrix_cap_livestemn => cnveg_nitrogenstate_inst%matrix_cap_livestemn_patch ,&!Output:[real(r8)(:)] (gN/m2) live stem N capacity + matrix_cap_livestemn_storage => cnveg_nitrogenstate_inst%matrix_cap_livestemn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) live stem storage N capacity + matrix_cap_livestemn_xfer => cnveg_nitrogenstate_inst%matrix_cap_livestemn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) live stem transfer N capacity + matrix_cap_deadstemn => cnveg_nitrogenstate_inst%matrix_cap_deadstemn_patch ,&!Output:[real(r8)(:)] (gN/m2) dead stem N capacity + matrix_cap_deadstemn_storage => cnveg_nitrogenstate_inst%matrix_cap_deadstemn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) dead stem storage N capacity + matrix_cap_deadstemn_xfer => cnveg_nitrogenstate_inst%matrix_cap_deadstemn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) dead stem transfer N capacity + matrix_cap_livecrootn => cnveg_nitrogenstate_inst%matrix_cap_livecrootn_patch ,&!Output:[real(r8)(:)] (gN/m2) live coarse root N capacity + matrix_cap_livecrootn_storage => cnveg_nitrogenstate_inst%matrix_cap_livecrootn_storage_patch,&!Output:[real(r8)(:)] (gN/m2) live coarse root storage N capacity + matrix_cap_livecrootn_xfer => cnveg_nitrogenstate_inst%matrix_cap_livecrootn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) live coarse root transfer N capacity + matrix_cap_deadcrootn => cnveg_nitrogenstate_inst%matrix_cap_deadcrootn_patch ,&!Output:[real(r8)(:)] (gN/m2) dead coarse root N capacity + matrix_cap_deadcrootn_storage => cnveg_nitrogenstate_inst%matrix_cap_deadcrootn_storage_patch,&!Output:[real(r8)(:)] (gN/m2) dead coarse root storage N capacity + matrix_cap_deadcrootn_xfer => cnveg_nitrogenstate_inst%matrix_cap_deadcrootn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) dead coarse root transfer N capacity + matrix_cap_grainn => cnveg_nitrogenstate_inst%matrix_cap_grainn_patch ,&!Output:[real(r8)(:)] (gN/m2) grain N capacity + matrix_cap_grainn_storage => cnveg_nitrogenstate_inst%matrix_cap_grainn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) grain storage N capacity + matrix_cap_grainn_xfer => cnveg_nitrogenstate_inst%matrix_cap_grainn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) grain transfer N capacity + + ! Variables matrix_calloc_*_acc, matrix_ctransfer_*_acc, and matrix_cturnover_*_acc are used to calculate the C capacity as the C steady state estimates in spin up. + ! These variables are all state variables, saving accumulated N transfers during the calendar year. + matrix_calloc_leaf_acc => cnveg_carbonstate_inst%matrix_calloc_leaf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to leaf during this year + matrix_calloc_leafst_acc => cnveg_carbonstate_inst%matrix_calloc_leafst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to leaf storage during this year + matrix_calloc_froot_acc => cnveg_carbonstate_inst%matrix_calloc_froot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to fine root during this year + matrix_calloc_frootst_acc => cnveg_carbonstate_inst%matrix_calloc_frootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to fine root storage during this year + matrix_calloc_livestem_acc => cnveg_carbonstate_inst%matrix_calloc_livestem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to live stem during this year + matrix_calloc_livestemst_acc => cnveg_carbonstate_inst%matrix_calloc_livestemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to live stem storage during this year + matrix_calloc_deadstem_acc => cnveg_carbonstate_inst%matrix_calloc_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to dead stem during this year + matrix_calloc_deadstemst_acc => cnveg_carbonstate_inst%matrix_calloc_deadstemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to dead stem storage during this year + matrix_calloc_livecroot_acc => cnveg_carbonstate_inst%matrix_calloc_livecroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to live corase root during this year + matrix_calloc_livecrootst_acc => cnveg_carbonstate_inst%matrix_calloc_livecrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to live corase root storage during this year + matrix_calloc_deadcroot_acc => cnveg_carbonstate_inst%matrix_calloc_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to dead corase root during this year + matrix_calloc_deadcrootst_acc => cnveg_carbonstate_inst%matrix_calloc_deadcrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to dead corase root storage during this year + matrix_calloc_grain_acc => cnveg_carbonstate_inst%matrix_calloc_grain_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to grain during this year + matrix_calloc_grainst_acc => cnveg_carbonstate_inst%matrix_calloc_grainst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to grain storage during this year + + matrix_ctransfer_leafst_to_leafxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_leafst_to_leafxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from leaf storage to leaf transfer pool during this year + matrix_ctransfer_leafxf_to_leaf_acc => cnveg_carbonstate_inst%matrix_ctransfer_leafxf_to_leaf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from leaf transfer to leaf pool during this year + matrix_ctransfer_frootst_to_frootxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_frootst_to_frootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from fine root storage to fine root transfer pool during this year + matrix_ctransfer_frootxf_to_froot_acc => cnveg_carbonstate_inst%matrix_ctransfer_frootxf_to_froot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from fine root transfer to fine root pool during this year + matrix_ctransfer_livestemst_to_livestemxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_livestemst_to_livestemxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live stem storage to live stem transfer pool during this year + matrix_ctransfer_livestemxf_to_livestem_acc => cnveg_carbonstate_inst%matrix_ctransfer_livestemxf_to_livestem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live stem transfer to live stem pool during this year + matrix_ctransfer_deadstemst_to_deadstemxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from dead stem storage to dead stem transfer pool during this year + matrix_ctransfer_deadstemxf_to_deadstem_acc => cnveg_carbonstate_inst%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from dead stem transfer to dead stem pool during this year + matrix_ctransfer_livecrootst_to_livecrootxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live coarse root storage to live coarse root transfer pool during this year + matrix_ctransfer_livecrootxf_to_livecroot_acc => cnveg_carbonstate_inst%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live coarse root transfer to live coarse root pool during this year + matrix_ctransfer_deadcrootst_to_deadcrootxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from dead coarse root storage to dead coarse root transfer pool during this year + matrix_ctransfer_deadcrootxf_to_deadcroot_acc => cnveg_carbonstate_inst%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from dead coarse root transfer to dead coarse root pool during this year + matrix_ctransfer_grainst_to_grainxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_grainst_to_grainxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from grain storage to grain transfer pool during this year + matrix_ctransfer_grainxf_to_grain_acc => cnveg_carbonstate_inst%matrix_ctransfer_grainxf_to_grain_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from grain transfer to grain pool during this year + matrix_ctransfer_livestem_to_deadstem_acc => cnveg_carbonstate_inst%matrix_ctransfer_livestem_to_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live stem to dead stem pool during this year + matrix_ctransfer_livecroot_to_deadcroot_acc => cnveg_carbonstate_inst%matrix_ctransfer_livecroot_to_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live coarse root to dead coarse root pool during this year + + matrix_cturnover_leaf_acc => cnveg_carbonstate_inst%matrix_cturnover_leaf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from leaf + matrix_cturnover_leafst_acc => cnveg_carbonstate_inst%matrix_cturnover_leafst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from leaf storage + matrix_cturnover_leafxf_acc => cnveg_carbonstate_inst%matrix_cturnover_leafxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from leaf transfer + matrix_cturnover_froot_acc => cnveg_carbonstate_inst%matrix_cturnover_froot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from fine root + matrix_cturnover_frootst_acc => cnveg_carbonstate_inst%matrix_cturnover_frootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from fine root storage + matrix_cturnover_frootxf_acc => cnveg_carbonstate_inst%matrix_cturnover_frootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from fine root transfer + matrix_cturnover_livestem_acc => cnveg_carbonstate_inst%matrix_cturnover_livestem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live stem + matrix_cturnover_livestemst_acc => cnveg_carbonstate_inst%matrix_cturnover_livestemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live stem storage + matrix_cturnover_livestemxf_acc => cnveg_carbonstate_inst%matrix_cturnover_livestemxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live stem transfer + matrix_cturnover_deadstem_acc => cnveg_carbonstate_inst%matrix_cturnover_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead stem + matrix_cturnover_deadstemst_acc => cnveg_carbonstate_inst%matrix_cturnover_deadstemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead stem storage + matrix_cturnover_deadstemxf_acc => cnveg_carbonstate_inst%matrix_cturnover_deadstemxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead stem transfer + matrix_cturnover_livecroot_acc => cnveg_carbonstate_inst%matrix_cturnover_livecroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live coarse root + matrix_cturnover_livecrootst_acc => cnveg_carbonstate_inst%matrix_cturnover_livecrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live coarse root storage + matrix_cturnover_livecrootxf_acc => cnveg_carbonstate_inst%matrix_cturnover_livecrootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live coarse root transfer + matrix_cturnover_deadcroot_acc => cnveg_carbonstate_inst%matrix_cturnover_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead coarse root + matrix_cturnover_deadcrootst_acc => cnveg_carbonstate_inst%matrix_cturnover_deadcrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead coarse root storage + matrix_cturnover_deadcrootxf_acc => cnveg_carbonstate_inst%matrix_cturnover_deadcrootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead coarse root transfer + matrix_cturnover_grain_acc => cnveg_carbonstate_inst%matrix_cturnover_grain_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from grain + matrix_cturnover_grainst_acc => cnveg_carbonstate_inst%matrix_cturnover_grainst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from grain storage + matrix_cturnover_grainxf_acc => cnveg_carbonstate_inst%matrix_cturnover_grainxf_acc_patch & + ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from grain transfer + ) +od: associate( & + + ! Variables matrix_nalloc_*_acc, matrix_ntransfer_*_acc, and matrix_nturnover_*_acc are used to calculate the N capacity as the N steady state estimates in spin up. + ! These variables are all state variables, saving accumulated N transfers during the calendar year. + matrix_nalloc_leaf_acc => cnveg_nitrogenstate_inst%matrix_nalloc_leaf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to leaf during this year + matrix_nalloc_leafst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_leafst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to leaf storage during this year + matrix_nalloc_froot_acc => cnveg_nitrogenstate_inst%matrix_nalloc_froot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to fine root during this year + matrix_nalloc_frootst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_frootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to fine root storage during this year + matrix_nalloc_livestem_acc => cnveg_nitrogenstate_inst%matrix_nalloc_livestem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to live stem during this year + matrix_nalloc_livestemst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_livestemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to live stem storage during this year + matrix_nalloc_deadstem_acc => cnveg_nitrogenstate_inst%matrix_nalloc_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to dead stem during this year + matrix_nalloc_deadstemst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_deadstemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to dead stem storage during this year + matrix_nalloc_livecroot_acc => cnveg_nitrogenstate_inst%matrix_nalloc_livecroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to live coarse root during this year + matrix_nalloc_livecrootst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_livecrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to live coarse root storage during this year + matrix_nalloc_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_nalloc_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to dead coarse root during this year + matrix_nalloc_deadcrootst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_deadcrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to dead coarse root storage during this year + matrix_nalloc_grain_acc => cnveg_nitrogenstate_inst%matrix_nalloc_grain_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to grain during this year + matrix_nalloc_grainst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_grainst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to grain storage during this year + + matrix_ntransfer_leafst_to_leafxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_leafst_to_leafxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from leaf storage to leaf transfer pool during this year + matrix_ntransfer_leafxf_to_leaf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_leafxf_to_leaf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from leaf transfer to leaf pool during this year + matrix_ntransfer_frootst_to_frootxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_frootst_to_frootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from fine root storage to fine root transfer pool during this year + matrix_ntransfer_frootxf_to_froot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_frootxf_to_froot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from fine root transfer to fine root pool during this year + matrix_ntransfer_livestemst_to_livestemxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livestemst_to_livestemxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live stem storage to live stem transfer pool during this year + matrix_ntransfer_livestemxf_to_livestem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livestemxf_to_livestem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live stem transfer to live stem pool during this year + matrix_ntransfer_deadstemst_to_deadstemxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_deadstemst_to_deadstemxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from dead stem storage to dead stem transfer pool during this year + matrix_ntransfer_deadstemxf_to_deadstem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_deadstemxf_to_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from dead stem transfer to dead stem pool during this year + matrix_ntransfer_livecrootst_to_livecrootxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livecrootst_to_livecrootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live coarese root storage to live coarese root transfer pool during this year + matrix_ntransfer_livecrootxf_to_livecroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livecrootxf_to_livecroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live coarese root transfer to live coarese root pool during this year + matrix_ntransfer_deadcrootst_to_deadcrootxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_deadcrootst_to_deadcrootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from dead coarse root storage to dead coarse root transfer pool during this year + matrix_ntransfer_deadcrootxf_to_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_deadcrootxf_to_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from dead coarse root transfer to dead coarse root pool during this year + matrix_ntransfer_grainst_to_grainxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_grainst_to_grainxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from grain storage to grain transfer pool during this year + matrix_ntransfer_grainxf_to_grain_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_grainxf_to_grain_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from grain transfer to grain pool during this year + matrix_ntransfer_livestem_to_deadstem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livestem_to_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live stem storage to dead stem transfer pool during this year + matrix_ntransfer_livecroot_to_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livecroot_to_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live coarse root to dead coarse root pool during this year + + matrix_ntransfer_retransn_to_leaf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_leaf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to leaf pool during this year + matrix_ntransfer_retransn_to_leafst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_leafst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to leaf storage pool during this year + matrix_ntransfer_retransn_to_froot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_froot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to fine root pool during this year + matrix_ntransfer_retransn_to_frootst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_frootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to fine root storage pool during this year + matrix_ntransfer_retransn_to_livestem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_livestem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to live stem pool during this year + matrix_ntransfer_retransn_to_livestemst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_livestemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to livestem storage pool during this year + matrix_ntransfer_retransn_to_deadstem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to dead stem pool during this year + matrix_ntransfer_retransn_to_deadstemst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_deadstemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to dead stem storage pool during this year + matrix_ntransfer_retransn_to_livecroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_livecroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to live coarse root pool during this year + matrix_ntransfer_retransn_to_livecrootst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_livecrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to live coarse root storage pool during this year + matrix_ntransfer_retransn_to_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to dead coarse root pool during this year + matrix_ntransfer_retransn_to_deadcrootst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_deadcrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to dead coarse root storage pool during this year + matrix_ntransfer_retransn_to_grain_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_grain_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to grain pool during this year + matrix_ntransfer_retransn_to_grainst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_grainst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to grain storage pool during this year + + matrix_ntransfer_leaf_to_retransn_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_leaf_to_retransn_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from leaf pool to retranslocated N pool during this year + matrix_ntransfer_froot_to_retransn_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_froot_to_retransn_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from fine root pool to retranslocated N pool during this year + matrix_ntransfer_livestem_to_retransn_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livestem_to_retransn_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live stem pool to retranslocated N pool during this year + matrix_ntransfer_livecroot_to_retransn_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livecroot_to_retransn_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live coarse root pool to retranslocated N pool during this year + + matrix_nturnover_leaf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_leaf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from leaf + matrix_nturnover_leafst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_leafst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from leaf storage + matrix_nturnover_leafxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_leafxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from leaf transfer + matrix_nturnover_froot_acc => cnveg_nitrogenstate_inst%matrix_nturnover_froot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from fine root + matrix_nturnover_frootst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_frootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from fine root storage + matrix_nturnover_frootxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_frootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from fine root transfer + matrix_nturnover_livestem_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livestem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live stem + matrix_nturnover_livestemst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livestemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live stem storage + matrix_nturnover_livestemxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livestemxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live stem transfer + matrix_nturnover_deadstem_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadstem_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead stem + matrix_nturnover_deadstemst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadstemst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead stem storage + matrix_nturnover_deadstemxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadstemxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead stem transfer + matrix_nturnover_livecroot_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livecroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live coarse root + matrix_nturnover_livecrootst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livecrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live coarse root storage + matrix_nturnover_livecrootxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livecrootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live coarse root transfer + matrix_nturnover_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadcroot_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead coarse root + matrix_nturnover_deadcrootst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadcrootst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead coarse root storage + matrix_nturnover_deadcrootxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadcrootxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead coarse root transfer + matrix_nturnover_grain_acc => cnveg_nitrogenstate_inst%matrix_nturnover_grain_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from grain + matrix_nturnover_grainst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_grainst_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from grain storage + matrix_nturnover_grainxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_grainxf_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from grain transfer + matrix_nturnover_retransn_acc => cnveg_nitrogenstate_inst%matrix_nturnover_retransn_acc_patch , & + ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from retranslocated N pool + + ! *c0* variables save vegetation pool size at beginning of each year as a base for capacity calculation. For examples, + ! C turnover rate of pool KC_leaf (yr-1) is calculated by C turnover during the calendar year: matrix_cturnover_leaf_acc (gC/m2/yr) / leafc0 (gC/m2) + leafc0 => cnveg_carbonstate_inst%leafc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C at begin of this year + leafc0_storage => cnveg_carbonstate_inst%leafc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf storage C at begin of this year + leafc0_xfer => cnveg_carbonstate_inst%leafc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf transfer C at begin of this year + frootc0 => cnveg_carbonstate_inst%frootc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root C at begin of this year + frootc0_storage => cnveg_carbonstate_inst%frootc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root storage C at begin of this year + frootc0_xfer => cnveg_carbonstate_inst%frootc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root transfer C at begin of this year + livestemc0 => cnveg_carbonstate_inst%livestemc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem C at begin of this year + livestemc0_storage => cnveg_carbonstate_inst%livestemc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem storage C at begin of this year + livestemc0_xfer => cnveg_carbonstate_inst%livestemc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem transfer C at begin of this year + deadstemc0 => cnveg_carbonstate_inst%deadstemc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem C at begin of this year + deadstemc0_storage => cnveg_carbonstate_inst%deadstemc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem storage C at begin of this year + deadstemc0_xfer => cnveg_carbonstate_inst%deadstemc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem transfer C at begin of this year + livecrootc0 => cnveg_carbonstate_inst%livecrootc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root C at begin of this year + livecrootc0_storage => cnveg_carbonstate_inst%livecrootc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root storage C at begin of this year + livecrootc0_xfer => cnveg_carbonstate_inst%livecrootc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root transfer C at begin of this year + deadcrootc0 => cnveg_carbonstate_inst%deadcrootc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root C at begin of this year + deadcrootc0_storage => cnveg_carbonstate_inst%deadcrootc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root storage C at begin of this year + deadcrootc0_xfer => cnveg_carbonstate_inst%deadcrootc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root transfer C at begin of this year + grainc0 => cnveg_carbonstate_inst%grainc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain C at begin of this year + grainc0_storage => cnveg_carbonstate_inst%grainc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain storage C at begin of this year + grainc0_xfer => cnveg_carbonstate_inst%grainc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain transfer C at begin of this year + + ! *n0* variables save vegetation pool size at beginning of each year as a base for capacity calculation. For examples, + ! N turnover rate of pool KN_leaf (yr-1) is calculated by N turnover during the calendar year matrix_nturnover_leaf_acc (gN/m2/yr) / leafn0 (gN/m2) + leafn0 => cnveg_nitrogenstate_inst%leafn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf N at begin of this year + leafn0_storage => cnveg_nitrogenstate_inst%leafn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf storage N at begin of this year + leafn0_xfer => cnveg_nitrogenstate_inst%leafn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf transfer N at begin of this year + frootn0 => cnveg_nitrogenstate_inst%frootn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root N at begin of this year + frootn0_storage => cnveg_nitrogenstate_inst%frootn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root storage N at begin of this year + frootn0_xfer => cnveg_nitrogenstate_inst%frootn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root transfer N at begin of this year + livestemn0 => cnveg_nitrogenstate_inst%livestemn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem N at begin of this year + livestemn0_storage => cnveg_nitrogenstate_inst%livestemn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem storage N at begin of this year + livestemn0_xfer => cnveg_nitrogenstate_inst%livestemn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem transfer N at begin of this year + deadstemn0 => cnveg_nitrogenstate_inst%deadstemn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem N at begin of this year + deadstemn0_storage => cnveg_nitrogenstate_inst%deadstemn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem storage N at begin of this year + deadstemn0_xfer => cnveg_nitrogenstate_inst%deadstemn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem transfer N at begin of this year + livecrootn0 => cnveg_nitrogenstate_inst%livecrootn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root N at begin of this year + livecrootn0_storage => cnveg_nitrogenstate_inst%livecrootn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root storage N at begin of this year + livecrootn0_xfer => cnveg_nitrogenstate_inst%livecrootn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root transfer N at begin of this year + deadcrootn0 => cnveg_nitrogenstate_inst%deadcrootn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root N at begin of this year + deadcrootn0_storage => cnveg_nitrogenstate_inst%deadcrootn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root storage N at begin of this year + deadcrootn0_xfer => cnveg_nitrogenstate_inst%deadcrootn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root transfer N at begin of this year + grainn0 => cnveg_nitrogenstate_inst%grainn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain N at begin of this year + grainn0_storage => cnveg_nitrogenstate_inst%grainn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain storage N at begin of this year + grainn0_xfer => cnveg_nitrogenstate_inst%grainn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain transfer N at begin of this year + retransn0 => cnveg_nitrogenstate_inst%retransn0_patch & ! In/Output: [real(r8) (:) ] (gN/m2) plant retranslocated N at begin of this year + ) +sd: associate( & + + ! Following variables save the C and N transfer rate of different processes at current time step. + ! Eg. ph: phenology, gm: gap mortality (including harvest), fi: fire. + matrix_alloc => cnveg_carbonflux_inst%matrix_alloc_patch , & ! Input: [real(r8) (:,:)] (gC/gC) input C allocation matrix, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod + matrix_nalloc => cnveg_nitrogenflux_inst%matrix_nalloc_patch , & ! Input: [real(r8) (:,:)] (gC/gC) input N allocation matrix, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod + matrix_phtransfer => cnveg_carbonflux_inst%matrix_phtransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from phenology processes, updated in CNPhenology + matrix_gmtransfer => cnveg_carbonflux_inst%matrix_gmtransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from gap mortality processes, updated in CNGapMortality + matrix_fitransfer => cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in CNFireBaseMod or CNFireLi2014Mod + matrix_phturnover => cnveg_carbonflux_inst%matrix_phturnover_patch , & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from phenology processes, updated in CNVegMatrixMod and dynHarvestMod + matrix_gmturnover => cnveg_carbonflux_inst%matrix_gmturnover_patch , & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from gap mortality processe, updated in CNVegMatrixMods + matrix_fiturnover => cnveg_carbonflux_inst%matrix_fiturnover_patch , & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods + + matrix_nphtransfer => cnveg_nitrogenflux_inst%matrix_nphtransfer_patch , & ! Input: [real(r8) (:,:)] (gN/m2/s) N transfer rate from phenology processes, updated in CNPhenology and (NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod) + matrix_ngmtransfer => cnveg_nitrogenflux_inst%matrix_ngmtransfer_patch , & ! Input: [real(r8) (:,:)] (gN/m2/s) N transfer rate from gap mortality processes, updated in CNGapMortality and dynHarvestMod + matrix_nfitransfer => cnveg_nitrogenflux_inst%matrix_nfitransfer_patch , & ! Input: [real(r8) (:,:)] (gN/m2/s) N transfer rate from fire processes, updated in CNFireBaseMod or CNFireLi2014Mod + matrix_nphturnover => cnveg_nitrogenflux_inst%matrix_nphturnover_patch , & ! Output: [real(r8) (:,:)] (gN/m2/step) N turnover rate from phenology processes, updated in CNVegMatrixMod + matrix_ngmturnover => cnveg_nitrogenflux_inst%matrix_ngmturnover_patch , & ! Output: [real(r8) (:,:)] (gN/m2/step) N turnover rate from gap mortality processes, updated in CNVegMatrixMod + matrix_nfiturnover => cnveg_nitrogenflux_inst%matrix_nfiturnover_patch , & ! Output: [real(r8) (:,:)] (gN/m2/step) N turnover rate from fire processes, updated in CNVegMatrixMod + + matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch , & ! Input: [real(r8) (:)] (gC/m2/s) C input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod + matrix_C13input => cnveg_carbonflux_inst%matrix_C13input_patch , & ! Input: [real(r8) (:)] (gC/m2/s) C13 input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod + matrix_C14input => cnveg_carbonflux_inst%matrix_C14input_patch , & ! Input: [real(r8) (:)] (gC/m2/s) C14 input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod + matrix_Ninput => cnveg_nitrogenflux_inst%matrix_Ninput_patch , & ! Input: [real(r8) (:)] (gN/m2/s) N input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod + + ! Doners and receivers of all transfers from different processes have been prescribed in following variables: + doner_phc => cnveg_carbonflux_inst%matrix_phtransfer_doner_patch , & ! Input: [integer (:)] Doners of phenology related C transfer + receiver_phc => cnveg_carbonflux_inst%matrix_phtransfer_receiver_patch , & ! Input: [integer (:)] Receiver of phenology related C transfer + doner_gmc => cnveg_carbonflux_inst%matrix_gmtransfer_doner_patch , & ! Input: [integer (:)] Doners of gap mortality related C transfer + receiver_gmc => cnveg_carbonflux_inst%matrix_gmtransfer_receiver_patch , & ! Input: [integer (:)] Receiver of gap mortality related C transfer + doner_fic => cnveg_carbonflux_inst%matrix_fitransfer_doner_patch , & ! Input: [integer (:)] Doners of fire related C transfer + receiver_fic => cnveg_carbonflux_inst%matrix_fitransfer_receiver_patch , & ! Input: [integer (:)] Receiver of fire related C transfer + doner_phn => cnveg_nitrogenflux_inst%matrix_nphtransfer_doner_patch , & ! Input: [integer (:)] Doners of phenology related N transfer + receiver_phn => cnveg_nitrogenflux_inst%matrix_nphtransfer_receiver_patch , & ! Input: [integer (:)] Receiver of phenology related N transfer + doner_gmn => cnveg_nitrogenflux_inst%matrix_ngmtransfer_doner_patch , & ! Input: [integer (:)] Doners of gap mortality related N transfer + receiver_gmn => cnveg_nitrogenflux_inst%matrix_ngmtransfer_receiver_patch , & ! Input: [integer (:)] Receiver of gap mortality related N transfer + doner_fin => cnveg_nitrogenflux_inst%matrix_nfitransfer_doner_patch , & ! Input: [integer (:)] Doners of fire related N transfer + receiver_fin => cnveg_nitrogenflux_inst%matrix_nfitransfer_receiver_patch , & ! Input: [integer (:)] Receiver of fire related N transfer + + ! Index of each processes related C transfers. See subroutine InitTransfer in CNVegCarbonFluxType.F90 for details. + ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to dead coarse root pool + ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools + igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools + ileaf_to_iout_gmc => cnveg_carbonflux_inst%ileaf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_gmc => cnveg_carbonflux_inst%ileafst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_gmc => cnveg_carbonflux_inst%ileafxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_gmc => cnveg_carbonflux_inst%ifroot_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_gmc => cnveg_carbonflux_inst%ifrootst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_gmc => cnveg_carbonflux_inst%ifrootxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from fine root transfer pool to outside of vegetation pools + ilivestem_to_iout_gmc => cnveg_carbonflux_inst%ilivestem_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_gmc => cnveg_carbonflux_inst%ilivestemst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_gmc => cnveg_carbonflux_inst%ilivestemxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_gmc => cnveg_carbonflux_inst%ideadstem_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_gmc => cnveg_carbonflux_inst%ideadstemst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_gmc => cnveg_carbonflux_inst%ideadstemxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_gmc => cnveg_carbonflux_inst%ilivecroot_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_gmc => cnveg_carbonflux_inst%ilivecrootst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_gmc => cnveg_carbonflux_inst%ilivecrootxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_gmc => cnveg_carbonflux_inst%ideadcroot_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_gmc => cnveg_carbonflux_inst%ideadcrootst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_gmc => cnveg_carbonflux_inst%ideadcrootxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root transfer pool to outside of vegetation pools + ileaf_to_iout_fic => cnveg_carbonflux_inst%ileaf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_fic => cnveg_carbonflux_inst%ileafst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_fic => cnveg_carbonflux_inst%ileafxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_fic => cnveg_carbonflux_inst%ifroot_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_fic => cnveg_carbonflux_inst%ifrootst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_fic => cnveg_carbonflux_inst%ifrootxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from fine root transfer pool to outside of vegetation pools + ilivestem_to_iout_fic => cnveg_carbonflux_inst%ilivestem_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_fic => cnveg_carbonflux_inst%ilivestemst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_fic => cnveg_carbonflux_inst%ilivestemxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_fic => cnveg_carbonflux_inst%ideadstem_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_fic => cnveg_carbonflux_inst%ideadstemst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_fic => cnveg_carbonflux_inst%ideadstemxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_fic => cnveg_carbonflux_inst%ilivecroot_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_fic => cnveg_carbonflux_inst%ilivecrootst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_fic => cnveg_carbonflux_inst%ilivecrootxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_fic => cnveg_carbonflux_inst%ideadcroot_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_fic => cnveg_carbonflux_inst%ideadcrootst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_fic => cnveg_carbonflux_inst%ideadcrootxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related C transfer from dead coarse root transfer pool to outside of vegetation pools + ilivestem_to_ideadstem_fic => cnveg_carbonflux_inst%ilivestem_to_ideadstem_fi , & + ! Input: [integer (:)] Index of fire related C transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_fic => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_fi , & + ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to dead coarse root pool + ! Index of each processes related N transfers. See subroutine InitTransfer in CNVegNitrogenFluxType.F90 for details. + ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from leaf storage pool to leaf transfer pool + ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from leaf transfer pool to leaf pool + ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from fine root storage pool to fine root transfer pool + ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from fine root transfer pool to fine root pool + ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from live stem storage pool to live stem transfer pool + ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from live stem transfer pool to live stem pool + ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from dead stem storage pool to dead stem transfer pool + ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from dead stem transfer pool to dead stem pool + ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph, & + ! Input: [integer (:)] Index of phenology related N transfer from live coarse root storage pool to live coarse root transfer pool + ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from live coarse root transfer pool to live coarse root pool + ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph, & + ! Input: [integer (:)] Index of phenology related N transfer from dead coarse root storage pool to dead coarse root transfer pool + ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from dead coarse root transfer pool to dead coarse root pool + ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from live stem pool to dead stem pool + ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from live coarse root pool to dead coarse root pool + ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from leaf pool to outside of vegetation pools + ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from fine root pool to outside of vegetation pools + ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from live stem pool to outside of vegetation pools + iretransn_to_iout_phn => cnveg_nitrogenflux_inst%iretransn_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to outside of vegetation pools + igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from grain pool to outside of vegetation pools + ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from leaf pool to retranslocated N pool + ifroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ifroot_to_iretransn_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from fine root pool to retranslocated N pool + ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from live stem pool to retranslocated N pool + ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from live coarse root pool to retranslocated N pool + iretransn_to_ileaf_phn => cnveg_nitrogenflux_inst%iretransn_to_ileaf_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to leaf pool + iretransn_to_ileafst_phn => cnveg_nitrogenflux_inst%iretransn_to_ileafst_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to leaf storage pool + iretransn_to_ifroot_phn => cnveg_nitrogenflux_inst%iretransn_to_ifroot_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to fine root pool + iretransn_to_ifrootst_phn => cnveg_nitrogenflux_inst%iretransn_to_ifrootst_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to fine root storage pool + iretransn_to_ilivestem_phn => cnveg_nitrogenflux_inst%iretransn_to_ilivestem_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to live stem pool + iretransn_to_ilivestemst_phn => cnveg_nitrogenflux_inst%iretransn_to_ilivestemst_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to live stem storage pool + iretransn_to_ideadstem_phn => cnveg_nitrogenflux_inst%iretransn_to_ideadstem_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to dead stem pool + iretransn_to_ideadstemst_phn => cnveg_nitrogenflux_inst%iretransn_to_ideadstemst_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to dead stem storage pool + iretransn_to_ilivecroot_phn => cnveg_nitrogenflux_inst%iretransn_to_ilivecroot_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to live coarse root pool + iretransn_to_ilivecrootst_phn => cnveg_nitrogenflux_inst%iretransn_to_ilivecrootst_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to live coarse root storage pool + iretransn_to_ideadcroot_phn => cnveg_nitrogenflux_inst%iretransn_to_ideadcroot_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to dead coarse root pool + iretransn_to_ideadcrootst_phn => cnveg_nitrogenflux_inst%iretransn_to_ideadcrootst_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to dead coarse root storage pool + iretransn_to_igrain_phn => cnveg_nitrogenflux_inst%iretransn_to_igrain_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to grain pool + iretransn_to_igrainst_phn => cnveg_nitrogenflux_inst%iretransn_to_igrainst_ph , & + ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to grain storage pool + ileaf_to_iout_gmn => cnveg_nitrogenflux_inst%ileaf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_gmn => cnveg_nitrogenflux_inst%ileafst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_gmn => cnveg_nitrogenflux_inst%ileafxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_gmn => cnveg_nitrogenflux_inst%ifroot_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ifrootst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ifrootxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from fine root transfer pool to outside of vegetation pools + ilivestem_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestem_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestemst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstem_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstemst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecroot_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcroot_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root transfer pool to outside of vegetation pools + iretransn_to_iout_gmn => cnveg_nitrogenflux_inst%iretransn_to_iout_gm , & + ! Input: [integer (:)] Index of gap mortality related N transfer from retranslocated N pool to outside of vegetation pools + ileaf_to_iout_fin => cnveg_nitrogenflux_inst%ileaf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from leaf pool to outside of vegetation pools + ileafst_to_iout_fin => cnveg_nitrogenflux_inst%ileafst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from leaf storage pool to outside of vegetation pools + ileafxf_to_iout_fin => cnveg_nitrogenflux_inst%ileafxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from leaf transfer pool to outside of vegetation pools + ifroot_to_iout_fin => cnveg_nitrogenflux_inst%ifroot_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from fine root pool to outside of vegetation pools + ifrootst_to_iout_fin => cnveg_nitrogenflux_inst%ifrootst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from fine root storage pool to outside of vegetation pools + ifrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ifrootxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from fine transfer pool to outside of vegetation pools + ilivestem_to_iout_fin => cnveg_nitrogenflux_inst%ilivestem_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from live stem pool to outside of vegetation pools + ilivestemst_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from live stem storage pool to outside of vegetation pools + ilivestemxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from live stem transfer pool to outside of vegetation pools + ideadstem_to_iout_fin => cnveg_nitrogenflux_inst%ideadstem_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from dead stem pool to outside of vegetation pools + ideadstemst_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from dead stem storage pool to outside of vegetation pools + ideadstemxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from dead stem transfer pool to outside of vegetation pools + ilivecroot_to_iout_fin => cnveg_nitrogenflux_inst%ilivecroot_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to outside of vegetation pools + ilivecrootst_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from live coarse root storage pool to outside of vegetation pools + ilivecrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from live coarse root transfer pool to outside of vegetation pools + ideadcroot_to_iout_fin => cnveg_nitrogenflux_inst%ideadcroot_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from dead coarse root pool to outside of vegetation pools + ideadcrootst_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from dead coarse root storage pool to outside of vegetation pools + ideadcrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_fi , & + ! Input: [integer (:)] Index of fire related N transfer from dead coarse root transfer pool to outside of vegetation pools + ilivestem_to_ideadstem_fin => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_fi , & + ! Input: [integer (:)] Index of fire related N transfer from live stem to dead stem pool + ilivecroot_to_ideadcroot_fin => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_fi , & + ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to dead coarse root pool + iretransn_to_iout_fin => cnveg_nitrogenflux_inst%iretransn_to_iout_fi & + ! Input: [integer (:)] Index of fire related N transfer from retranslocated N pool to outside of vegetation pools + ) +td: associate( & + + ! Sparse matrix type of A*K + AKphvegc => cnveg_carbonflux_inst%AKphvegc , & ! Aph*Kph for C cycle in sparse matrix format + AKgmvegc => cnveg_carbonflux_inst%AKgmvegc , & ! Agm*Kgm for C cycle in sparse matrix format + AKfivegc => cnveg_carbonflux_inst%AKfivegc , & ! Afi*Kfi for C cycle in sparse matrix format + AKallvegc => cnveg_carbonflux_inst%AKallvegc , & ! Aph*Kph + Agm*Kgm + Afi*Kfi for C cycle in sparse matrix format + NE_AKallvegc => cnveg_carbonflux_inst%NE_AKallvegc , & ! Number of entries in AKallvegc + RI_AKallvegc => cnveg_carbonflux_inst%RI_AKallvegc , & ! Row indices in Akallvegc + CI_AKallvegc => cnveg_carbonflux_inst%CI_AKallvegc , & ! Column indices in AKallvegc + Kvegc => cnveg_carbonflux_inst%Kvegc , & ! Temporary variable of Kph, Kgm or Kfi for C cycle in diagonal matrix format + Xvegc => cnveg_carbonflux_inst%Xvegc , & ! Vegetation C of each compartment in a vector format + AKphvegn => cnveg_nitrogenflux_inst%AKphvegn , & ! Aph*Kph for N cycle in sparse matrix format + AKgmvegn => cnveg_nitrogenflux_inst%AKgmvegn , & ! Agm*Kgm for N cycle in sparse matrix format + AKfivegn => cnveg_nitrogenflux_inst%AKfivegn , & ! Afi*Kfi for N cycle in sparse matrix format + AKallvegn => cnveg_nitrogenflux_inst%AKallvegn , & ! Aph*Kph + Agm*Kgm + Afi*Kfi for N cycle in sparse matrix format + NE_AKallvegn => cnveg_nitrogenflux_inst%NE_AKallvegn , & ! Number of entries in AKallvegn + RI_AKallvegn => cnveg_nitrogenflux_inst%RI_AKallvegn , & ! Row indices in Akallvegn + CI_AKallvegn => cnveg_nitrogenflux_inst%CI_AKallvegn , & ! Column indices in AKallvegn + Kvegn => cnveg_nitrogenflux_inst%Kvegn , & ! Temporary variable of Kph, Kgm or Kfi for N cycle in diagonal matrix format + Xvegn => cnveg_nitrogenflux_inst%Xvegn , & ! Vegetation N of each compartment in a vector format + Xveg13c => cnveg_carbonflux_inst%Xveg13c , & ! Vegetation C13 of each compartment in a vector format + Xveg14c => cnveg_carbonflux_inst%Xveg14c , & ! Vegetation C14 of each compartment in a vector format + + ! Row and column indices of A matrices + RI_phc => cnveg_carbonflux_inst%RI_phc , & ! Row indices of non-diagonal entires in Aph for C cycle + CI_phc => cnveg_carbonflux_inst%CI_phc , & ! Column indices of non-diagonal entries in Aph for C cycle + RI_gmc => cnveg_carbonflux_inst%RI_gmc , & ! Row indices of non-diagonal entires in Agm for C cycle + CI_gmc => cnveg_carbonflux_inst%CI_gmc , & ! Column indices of non-diagonal entries in Agm for C cycle + RI_fic => cnveg_carbonflux_inst%RI_fic , & ! Row indices of non-diagonal entires in Afi for C cycle + CI_fic => cnveg_carbonflux_inst%CI_fic , & ! Column indices of non-diagonal entries in Afi for C cycle + RI_phn => cnveg_nitrogenflux_inst%RI_phn , & ! Row indices of non-diagonal entires in Aph for N cycle + CI_phn => cnveg_nitrogenflux_inst%CI_phn , & ! Column indices of non-diagonal entries in Aph for N cycle + RI_gmn => cnveg_nitrogenflux_inst%RI_gmn , & ! Row indices of non-diagonal entires in Agm for N cycle + CI_gmn => cnveg_nitrogenflux_inst%CI_gmn , & ! Column indices of non-diagonal entries in Agm for N cycle + RI_fin => cnveg_nitrogenflux_inst%RI_fin , & ! Row indices of non-diagonal entires in Afi for N cycle + CI_fin => cnveg_nitrogenflux_inst%CI_fin , & ! Column indices of non-diagonal entries in Afi for N cycle + + ! Following list contains indices of non-diagonal entries in full sparse matrix + list_aphc => cnveg_carbonflux_inst%list_aphc , & ! Indices of non-diagnoal entries in full sparse matrix Aph for C cycle + list_agmc => cnveg_carbonflux_inst%list_agmc , & ! Indices of non-diagnoal entries in full sparse matrix Agm for C cycle + list_afic => cnveg_carbonflux_inst%list_afic , & ! Indices of non-diagnoal entries in full sparse matrix Afi for C cycle + list_aphn => cnveg_nitrogenflux_inst%list_aphn , & ! Indices of non-diagnoal entries in full sparse matrix Aph for N cycle + list_agmn => cnveg_nitrogenflux_inst%list_agmn , & ! Indices of non-diagnoal entries in full sparse matrix Agm for N cycle + list_afin => cnveg_nitrogenflux_inst%list_afin , & ! Indices of non-diagnoal entries in full sparse matrix Afi for N cycle + + ! For sparse matrix A, B and A + B, following list contains locations of entries in A or B or C mapped into matrix (A+B) or (A+B+C) + list_phc_phgm => cnveg_carbonflux_inst%list_phc_phgmc , & ! The locations of entries in AKphvegc mapped into (AKphvegc+AKgmvegc) + list_gmc_phgm => cnveg_carbonflux_inst%list_gmc_phgmc , & ! The locations of entries in AKgmvegc mapped into (AKphvegc+AKgmvegc) + list_phc_phgmfi => cnveg_carbonflux_inst%list_phc_phgmfic , & ! The locations of entries in AKphvegc mapped into (AKphvegc+AKgmvegc+AKfivegc) + list_gmc_phgmfi => cnveg_carbonflux_inst%list_gmc_phgmfic , & ! The locations of entries in AKgmvegc mapped into (AKphvegc+AKgmvegc+AKfivegc) + list_fic_phgmfi => cnveg_carbonflux_inst%list_fic_phgmfic , & ! The locations of entries in AKfivegc mapped into (AKphvegc+AKgmvegc+AKfivegc) + list_phn_phgm => cnveg_nitrogenflux_inst%list_phn_phgmn , & ! The locations of entries in AKphvegn mapped into (AKphvegn+AKgmvegn) + list_gmn_phgm => cnveg_nitrogenflux_inst%list_gmn_phgmn , & ! The locations of entries in AKgmvegn mapped into (AKphvegn+AKgmvegn) + list_phn_phgmfi => cnveg_nitrogenflux_inst%list_phn_phgmfin , & ! The locations of entries in AKphvegn mapped into (AKphvegn+AKgmvegn+AKfivegn) + list_gmn_phgmfi => cnveg_nitrogenflux_inst%list_gmn_phgmfin , & ! The locations of entries in AKgmvegn mapped into (AKphvegn+AKgmvegn+AKfivegn) + list_fin_phgmfi => cnveg_nitrogenflux_inst%list_fin_phgmfin & ! The locations of entries in AKfivegn mapped into (AKphvegn+AKgmvegn+AKfivegn) + ) +#ifdef _OPENMP + nthreads = OMP_GET_MAX_THREADS() +#endif + !----------------------------------------------------------------------- + ! set time steps + call t_startf('CN veg matrix-init') + dt = real( get_step_size(), r8 ) + secspyear = get_days_per_year() * secspday + + ! Initialize local variables + call vegmatrixc_input%InitV(nvegcpool,bounds%begp,bounds%endp) + if(use_c13)then + call vegmatrixc13_input%InitV(nvegcpool,bounds%begp,bounds%endp) + end if + if(use_c14)then + call vegmatrixc14_input%InitV(nvegcpool,bounds%begp,bounds%endp) + end if + call vegmatrixn_input%InitV(nvegnpool,bounds%begp,bounds%endp) + + matrix_calloc_acc (:) = 0._r8 + matrix_nalloc_acc (:) = 0._r8 + matrix_ctransfer_acc (:,:) = 0._r8 + matrix_ntransfer_acc (:,:) = 0._r8 + if(use_c13)then + matrix_c13alloc_acc (:) = 0._r8 + matrix_c13transfer_acc (:,:) = 0._r8 + end if + if(use_c14)then + matrix_c14alloc_acc (:) = 0._r8 + matrix_c14transfer_acc (:,:) = 0._r8 + end if + + AKinvc (:,:) = 0._r8 + AKinvn (:,:) = 0._r8 + + epsi = 1.e-30_r8 ! small number + + call t_stopf('CN veg matrix-init') + + call t_startf('CN veg matrix-assigning matrix') + + ! Calculate A matrices from C transfers and C turnovers + if(ncphtrans .gt. ncphouttrans)then + do k=1,ncphtrans-ncphouttrans + do fp = 1,num_soilp + p = filter_soilp(fp) + if(matrix_phturnover(p,doner_phc(k)) .ne. 0)then + Aphconed(p,k) = matrix_phtransfer(p,k) * dt / matrix_phturnover(p,doner_phc(k)) + else + Aphconed(p,k) = 0._r8 + end if + end do + end do + end if + + if(ncgmtrans .gt. ncgmouttrans)then + do k=1,ncgmtrans-ncgmouttrans + do fp = 1,num_soilp + p = filter_soilp(fp) + if(matrix_gmturnover(p,doner_gmc(k)) .ne. 0)then + Agmconed(p,k) = matrix_gmtransfer(p,k) * dt / matrix_gmturnover(p,doner_gmc(k)) + else + Agmconed(p,k) = 0._r8 + end if + end do + end do + end if + + if(ncfitrans .gt. ncfiouttrans)then + do k=1,ncfitrans-ncfiouttrans + do fp = 1,num_soilp + p = filter_soilp(fp) + if(matrix_fiturnover(p,doner_fic(k)) .ne. 0)then + Aficoned(p,k) = matrix_fitransfer(p,k) * dt / matrix_fiturnover(p,doner_fic(k)) + else + Aficoned(p,k) = 0._r8 + end if + if(use_c14)then + associate( & + matrix_c14fitransfer => c14_cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in (CNFireBaseMod or CNFireLi2014Mod) and CNC14decayMod + matrix_c14fiturnover => c14_cnveg_carbonflux_inst%matrix_fiturnover_patch & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods + ) + if(matrix_c14fiturnover(p,doner_fic(k)) .ne. 0)then + Afic14oned(p,k) = matrix_c14fitransfer(p,k) * dt / matrix_c14fiturnover(p,doner_fic(k)) + else + Afic14oned(p,k) = 0._r8 + end if + end associate + end if + end do + end do + end if + + if(nnphtrans .gt. nnphouttrans)then + do k=1,nnphtrans-nnphouttrans + do fp = 1,num_soilp + p = filter_soilp(fp) + if(matrix_nphturnover(p,doner_phn(k)) .ne. 0)then + Aphnoned(p,k) = matrix_nphtransfer(p,k) * dt / matrix_nphturnover(p,doner_phn(k)) + else + Aphnoned(p,k) = 0._r8 + end if + end do + end do + end if + + if(nngmtrans .gt. nngmouttrans)then + do k=1,nngmtrans-nngmouttrans + do fp = 1,num_soilp + p = filter_soilp(fp) + if(matrix_ngmturnover(p,doner_phn(k)) .ne. 0)then + Agmnoned(p,k) = matrix_ngmtransfer(p,k) * dt / matrix_ngmturnover(p,doner_phn(k)) + else + Agmnoned(p,k) = 0._r8 + end if + end do + end do + end if + + if(nnfitrans .gt. nnfiouttrans)then + do k=1,nnfitrans-nnfiouttrans + do fp = 1,num_soilp + p = filter_soilp(fp) + if(matrix_nfiturnover(p,doner_fin(k)) .ne. 0)then + Afinoned(p,k) = matrix_nfitransfer(p,k) * dt / matrix_nfiturnover(p,doner_fin(k)) + else + Afinoned(p,k) = 0._r8 + end if + end do + end do + end if + + call t_stopf('CN veg matrix-assigning matrix') + + ! Assign old state variables to vector Xveg* + call t_startf('CN veg matrix-set old value') + + do fp = 1,num_soilp + p = filter_soilp(fp) + Xvegc%V(p,ileaf) = leafc(p) + Xvegc%V(p,ileaf_st) = leafc_storage(p) + Xvegc%V(p,ileaf_xf) = leafc_xfer(p) + Xvegc%V(p,ifroot) = frootc(p) + Xvegc%V(p,ifroot_st) = frootc_storage(p) + Xvegc%V(p,ifroot_xf) = frootc_xfer(p) + Xvegc%V(p,ilivestem) = livestemc(p) + Xvegc%V(p,ilivestem_st) = livestemc_storage(p) + Xvegc%V(p,ilivestem_xf) = livestemc_xfer(p) + Xvegc%V(p,ideadstem) = deadstemc(p) + Xvegc%V(p,ideadstem_st) = deadstemc_storage(p) + Xvegc%V(p,ideadstem_xf) = deadstemc_xfer(p) + Xvegc%V(p,ilivecroot) = livecrootc(p) + Xvegc%V(p,ilivecroot_st) = livecrootc_storage(p) + Xvegc%V(p,ilivecroot_xf) = livecrootc_xfer(p) + Xvegc%V(p,ideadcroot) = deadcrootc(p) + Xvegc%V(p,ideadcroot_st) = deadcrootc_storage(p) + Xvegc%V(p,ideadcroot_xf) = deadcrootc_xfer(p) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + Xvegc%V(p,igrain) = grainc(p) + Xvegc%V(p,igrain_st) = grainc_storage(p) + Xvegc%V(p,igrain_xf) = grainc_xfer(p) + end if + end do + + if ( use_c13 )then + do fp = 1,num_soilp + p = filter_soilp(fp) + Xveg13c%V(p,ileaf) = cs13_veg%leafc_patch(p) + Xveg13c%V(p,ileaf_st) = cs13_veg%leafc_storage_patch(p) + Xveg13c%V(p,ileaf_xf) = cs13_veg%leafc_xfer_patch(p) + Xveg13c%V(p,ifroot) = cs13_veg%frootc_patch(p) + Xveg13c%V(p,ifroot_st) = cs13_veg%frootc_storage_patch(p) + Xveg13c%V(p,ifroot_xf) = cs13_veg%frootc_xfer_patch(p) + Xveg13c%V(p,ilivestem) = cs13_veg%livestemc_patch(p) + Xveg13c%V(p,ilivestem_st) = cs13_veg%livestemc_storage_patch(p) + Xveg13c%V(p,ilivestem_xf) = cs13_veg%livestemc_xfer_patch(p) + Xveg13c%V(p,ideadstem) = cs13_veg%deadstemc_patch(p) + Xveg13c%V(p,ideadstem_st) = cs13_veg%deadstemc_storage_patch(p) + Xveg13c%V(p,ideadstem_xf) = cs13_veg%deadstemc_xfer_patch(p) + Xveg13c%V(p,ilivecroot) = cs13_veg%livecrootc_patch(p) + Xveg13c%V(p,ilivecroot_st) = cs13_veg%livecrootc_storage_patch(p) + Xveg13c%V(p,ilivecroot_xf) = cs13_veg%livecrootc_xfer_patch(p) + Xveg13c%V(p,ideadcroot) = cs13_veg%deadcrootc_patch(p) + Xveg13c%V(p,ideadcroot_st) = cs13_veg%deadcrootc_storage_patch(p) + Xveg13c%V(p,ideadcroot_xf) = cs13_veg%deadcrootc_xfer_patch(p) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + Xveg13c%V(p,igrain) = cs13_veg%grainc_patch(p) + Xveg13c%V(p,igrain_st) = cs13_veg%grainc_storage_patch(p) + Xveg13c%V(p,igrain_xf) = cs13_veg%grainc_xfer_patch(p) + end if + end do + end if + + if ( use_c14 )then + do fp = 1,num_soilp + p = filter_soilp(fp) + Xveg14c%V(p,ileaf) = cs14_veg%leafc_patch(p) + Xveg14c%V(p,ileaf_st) = cs14_veg%leafc_storage_patch(p) + Xveg14c%V(p,ileaf_xf) = cs14_veg%leafc_xfer_patch(p) + Xveg14c%V(p,ifroot) = cs14_veg%frootc_patch(p) + Xveg14c%V(p,ifroot_st) = cs14_veg%frootc_storage_patch(p) + Xveg14c%V(p,ifroot_xf) = cs14_veg%frootc_xfer_patch(p) + Xveg14c%V(p,ilivestem) = cs14_veg%livestemc_patch(p) + Xveg14c%V(p,ilivestem_st) = cs14_veg%livestemc_storage_patch(p) + Xveg14c%V(p,ilivestem_xf) = cs14_veg%livestemc_xfer_patch(p) + Xveg14c%V(p,ideadstem) = cs14_veg%deadstemc_patch(p) + Xveg14c%V(p,ideadstem_st) = cs14_veg%deadstemc_storage_patch(p) + Xveg14c%V(p,ideadstem_xf) = cs14_veg%deadstemc_xfer_patch(p) + Xveg14c%V(p,ilivecroot) = cs14_veg%livecrootc_patch(p) + Xveg14c%V(p,ilivecroot_st) = cs14_veg%livecrootc_storage_patch(p) + Xveg14c%V(p,ilivecroot_xf) = cs14_veg%livecrootc_xfer_patch(p) + Xveg14c%V(p,ideadcroot) = cs14_veg%deadcrootc_patch(p) + Xveg14c%V(p,ideadcroot_st) = cs14_veg%deadcrootc_storage_patch(p) + Xveg14c%V(p,ideadcroot_xf) = cs14_veg%deadcrootc_xfer_patch(p) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + Xveg14c%V(p,igrain) = cs14_veg%grainc_patch(p) + Xveg14c%V(p,igrain_st) = cs14_veg%grainc_storage_patch(p) + Xveg14c%V(p,igrain_xf) = cs14_veg%grainc_xfer_patch(p) + end if + end do + end if + + do fp = 1,num_soilp + p = filter_soilp(fp) + Xvegn%V(p,ileaf) = leafn(p) + Xvegn%V(p,ileaf_st) = leafn_storage(p) + Xvegn%V(p,ileaf_xf) = leafn_xfer(p) + Xvegn%V(p,ifroot) = frootn(p) + Xvegn%V(p,ifroot_st) = frootn_storage(p) + Xvegn%V(p,ifroot_xf) = frootn_xfer(p) + Xvegn%V(p,ilivestem) = livestemn(p) + Xvegn%V(p,ilivestem_st) = livestemn_storage(p) + Xvegn%V(p,ilivestem_xf) = livestemn_xfer(p) + Xvegn%V(p,ideadstem) = deadstemn(p) + Xvegn%V(p,ideadstem_st) = deadstemn_storage(p) + Xvegn%V(p,ideadstem_xf) = deadstemn_xfer(p) + Xvegn%V(p,ilivecroot) = livecrootn(p) + Xvegn%V(p,ilivecroot_st) = livecrootn_storage(p) + Xvegn%V(p,ilivecroot_xf) = livecrootn_xfer(p) + Xvegn%V(p,ideadcroot) = deadcrootn(p) + Xvegn%V(p,ideadcroot_st) = deadcrootn_storage(p) + Xvegn%V(p,ideadcroot_xf) = deadcrootn_xfer(p) + Xvegn%V(p,iretransn) = retransn(p) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + Xvegn%V(p,igrain) = grainn(p) + Xvegn%V(p,igrain_st) = grainn_storage(p) + Xvegn%V(p,igrain_xf) = grainn_xfer(p) + end if + end do + + ! Save *c0* and *n0* variables at begin of each year. + if (is_beg_curr_year())then + iyr = iyr + 1 + if(mod(iyr-1,nyr_forcing) .eq. 0)then + iloop = iloop + 1 + end if + if(.not. isspinup .or. isspinup .and. mod(iyr-1,nyr_SASU) .eq. 0)then + do fp = 1,num_soilp + p = filter_soilp(fp) + leafc0(p) = max(leafc(p), epsi) + leafc0_storage(p) = max(leafc_storage(p), epsi) + leafc0_xfer(p) = max(leafc_xfer(p), epsi) + frootc0(p) = max(frootc(p), epsi) + frootc0_storage(p) = max(frootc_storage(p), epsi) + frootc0_xfer(p) = max(frootc_xfer(p), epsi) + livestemc0(p) = max(livestemc(p), epsi) + livestemc0_storage(p) = max(livestemc_storage(p), epsi) + livestemc0_xfer(p) = max(livestemc_xfer(p), epsi) + deadstemc0(p) = max(deadstemc(p), epsi) + deadstemc0_storage(p) = max(deadstemc_storage(p), epsi) + deadstemc0_xfer(p) = max(deadstemc_xfer(p), epsi) + livecrootc0(p) = max(livecrootc(p), epsi) + livecrootc0_storage(p) = max(livecrootc_storage(p), epsi) + livecrootc0_xfer(p) = max(livecrootc_xfer(p), epsi) + deadcrootc0(p) = max(deadcrootc(p), epsi) + deadcrootc0_storage(p) = max(deadcrootc_storage(p), epsi) + deadcrootc0_xfer(p) = max(deadcrootc_xfer(p), epsi) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + grainc0(p) = max(grainc(p), epsi) + grainc0_storage(p) = max(grainc_storage(p), epsi) + grainc0_xfer(p) = max(grainc_xfer(p), epsi) + end if + end do + + if(use_c13)then + do fp = 1,num_soilp + p = filter_soilp(fp) + cs13_veg%leafc0_patch(p) = max(cs13_veg%leafc_patch(p), epsi) + cs13_veg%leafc0_storage_patch(p) = max(cs13_veg%leafc_storage_patch(p), epsi) + cs13_veg%leafc0_xfer_patch(p) = max(cs13_veg%leafc_xfer_patch(p), epsi) + cs13_veg%frootc0_patch(p) = max(cs13_veg%frootc_patch(p), epsi) + cs13_veg%frootc0_storage_patch(p) = max(cs13_veg%frootc_storage_patch(p), epsi) + cs13_veg%frootc0_xfer_patch(p) = max(cs13_veg%frootc_xfer_patch(p), epsi) + cs13_veg%livestemc0_patch(p) = max(cs13_veg%livestemc_patch(p), epsi) + cs13_veg%livestemc0_storage_patch(p) = max(cs13_veg%livestemc_storage_patch(p), epsi) + cs13_veg%livestemc0_xfer_patch(p) = max(cs13_veg%livestemc_xfer_patch(p), epsi) + cs13_veg%deadstemc0_patch(p) = max(cs13_veg%deadstemc_patch(p), epsi) + cs13_veg%deadstemc0_storage_patch(p) = max(cs13_veg%deadstemc_storage_patch(p), epsi) + cs13_veg%deadstemc0_xfer_patch(p) = max(cs13_veg%deadstemc_xfer_patch(p), epsi) + cs13_veg%livecrootc0_patch(p) = max(cs13_veg%livecrootc_patch(p), epsi) + cs13_veg%livecrootc0_storage_patch(p) = max(cs13_veg%livecrootc_storage_patch(p), epsi) + cs13_veg%livecrootc0_xfer_patch(p) = max(cs13_veg%livecrootc_xfer_patch(p), epsi) + cs13_veg%deadcrootc0_patch(p) = max(cs13_veg%deadcrootc_patch(p), epsi) + cs13_veg%deadcrootc0_storage_patch(p) = max(cs13_veg%deadcrootc_storage_patch(p), epsi) + cs13_veg%deadcrootc0_xfer_patch(p) = max(cs13_veg%deadcrootc_xfer_patch(p), epsi) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + cs13_veg%grainc0_patch(p) = max(cs13_veg%grainc_patch(p), epsi) + cs13_veg%grainc0_storage_patch(p) = max(cs13_veg%grainc_storage_patch(p), epsi) + cs13_veg%grainc0_xfer_patch(p) = max(cs13_veg%grainc_xfer_patch(p), epsi) + end if + end do + end if + + if(use_c14)then + do fp = 1,num_soilp + p = filter_soilp(fp) + cs14_veg%leafc0_patch(p) = max(cs14_veg%leafc_patch(p), epsi) + cs14_veg%leafc0_storage_patch(p) = max(cs14_veg%leafc_storage_patch(p), epsi) + cs14_veg%leafc0_xfer_patch(p) = max(cs14_veg%leafc_xfer_patch(p), epsi) + cs14_veg%frootc0_patch(p) = max(cs14_veg%frootc_patch(p), epsi) + cs14_veg%frootc0_storage_patch(p) = max(cs14_veg%frootc_storage_patch(p), epsi) + cs14_veg%frootc0_xfer_patch(p) = max(cs14_veg%frootc_xfer_patch(p), epsi) + cs14_veg%livestemc0_patch(p) = max(cs14_veg%livestemc_patch(p), epsi) + cs14_veg%livestemc0_storage_patch(p) = max(cs14_veg%livestemc_storage_patch(p), epsi) + cs14_veg%livestemc0_xfer_patch(p) = max(cs14_veg%livestemc_xfer_patch(p), epsi) + cs14_veg%deadstemc0_patch(p) = max(cs14_veg%deadstemc_patch(p), epsi) + cs14_veg%deadstemc0_storage_patch(p) = max(cs14_veg%deadstemc_storage_patch(p), epsi) + cs14_veg%deadstemc0_xfer_patch(p) = max(cs14_veg%deadstemc_xfer_patch(p), epsi) + cs14_veg%livecrootc0_patch(p) = max(cs14_veg%livecrootc_patch(p), epsi) + cs14_veg%livecrootc0_storage_patch(p) = max(cs14_veg%livecrootc_storage_patch(p), epsi) + cs14_veg%livecrootc0_xfer_patch(p) = max(cs14_veg%livecrootc_xfer_patch(p), epsi) + cs14_veg%deadcrootc0_patch(p) = max(cs14_veg%deadcrootc_patch(p), epsi) + cs14_veg%deadcrootc0_storage_patch(p) = max(cs14_veg%deadcrootc_storage_patch(p), epsi) + cs14_veg%deadcrootc0_xfer_patch(p) = max(cs14_veg%deadcrootc_xfer_patch(p), epsi) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + cs14_veg%grainc0_patch(p) = max(cs14_veg%grainc_patch(p), epsi) + cs14_veg%grainc0_storage_patch(p) = max(cs14_veg%grainc_storage_patch(p), epsi) + cs14_veg%grainc0_xfer_patch(p) = max(cs14_veg%grainc_xfer_patch(p), epsi) + end if + end do + end if + + do fp = 1,num_soilp + p = filter_soilp(fp) + leafn0(p) = max(leafn(p), epsi) + leafn0_storage(p) = max(leafn_storage(p), epsi) + leafn0_xfer(p) = max(leafn_xfer(p), epsi) + frootn0(p) = max(frootn(p), epsi) + frootn0_storage(p) = max(frootn_storage(p), epsi) + frootn0_xfer(p) = max(frootn_xfer(p), epsi) + livestemn0(p) = max(livestemn(p), epsi) + livestemn0_storage(p) = max(livestemn_storage(p), epsi) + livestemn0_xfer(p) = max(livestemn_xfer(p), epsi) + deadstemn0(p) = max(deadstemn(p), epsi) + deadstemn0_storage(p) = max(deadstemn_storage(p), epsi) + deadstemn0_xfer(p) = max(deadstemn_xfer(p), epsi) + livecrootn0(p) = max(livecrootn(p), epsi) + livecrootn0_storage(p) = max(livecrootn_storage(p), epsi) + livecrootn0_xfer(p) = max(livecrootn_xfer(p), epsi) + deadcrootn0(p) = max(deadcrootn(p), epsi) + deadcrootn0_storage(p) = max(deadcrootn_storage(p), epsi) + deadcrootn0_xfer(p) = max(deadcrootn_xfer(p), epsi) + retransn0(p) = max(retransn(p), epsi) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + grainn0(p) = max(grainn(p), epsi) + grainn0_storage(p) = max(grainn_storage(p), epsi) + grainn0_xfer(p) = max(grainn_xfer(p), epsi) + end if + end do + end if + end if + + call t_stopf('CN veg matrix-set old value') + + call t_startf('CN veg matrix-matrix multi.') + + ! Start matrix operation + ! Calculate B*I + + do i=1,nvegcpool + do fp = 1,num_soilp + p = filter_soilp(fp) + vegmatrixc_input%V(p,i) = matrix_alloc(p,i) * matrix_Cinput(p) * dt + end do + end do + + ! Set up sparse matrix Aph_c from non-diagonal entires Aphconed, diagonal entries are all set to -1. + ! Note that AKphvegc here only represent A matrix instead of A * K + + if(ncphtrans .gt. ncphouttrans)then + AI_phc = receiver_phc(1:ncphtrans-ncphouttrans) + AJ_phc = doner_phc (1:ncphtrans-ncphouttrans) + call AKphvegc%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Aphconed,& + AI_phc,AJ_phc,ncphtrans-ncphouttrans,init_ready_aphc,list_aphc,RI_phc,CI_phc) + else + call AKphvegc%SetValueA_diag(num_soilp,filter_soilp,-1._r8) + end if + + ! Set up diagonal matrix Kph_c from diagonal entries matrix_phturnover + call Kvegc%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_phturnover(bounds%begp:bounds%endp,1:nvegcpool)) + + ! Calculate Aph_c*Kph_c using SPMM_AK. + call AKphvegc%SPMM_AK(num_soilp,filter_soilp,Kvegc) + + + + ! Set up sparse matrix Agm_c from non-diagonal entires Agmconed, diagonal entries are all set to -1. + ! Note that AKgmvegc here only represent A matrix instead of A * K + + if(ncgmtrans .gt. ncgmouttrans)then + AI_gmc = receiver_gmc(1:ncgmtrans-ncgmouttrans) + AJ_gmc = doner_gmc (1:ncgmtrans-ncgmouttrans) + call AKgmvegc%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Agmconed,& + AI_gmc,AJ_gmc,ncgmtrans-ncgmouttrans,init_ready_agmc,list_agmc,RI_gmc,CI_gmc) + else + call AKgmvegc%SetValueA_diag(num_soilp,filter_soilp,-1._r8) + end if + + ! Set up diagonal matrix Kgm_c from diagonal entries matrix_gmturnover + call Kvegc%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_gmturnover(bounds%begp:bounds%endp,1:nvegcpool)) + + ! Calculate Agm_c*Kgm_c using SPMM_AK. + call AKgmvegc%SPMM_AK(num_soilp,filter_soilp,Kvegc) + + + + ! Set up sparse matrix Afi_c from non-diagonal entires Aficoned, diagonal entries are all set to -1. + ! Note that AKfivegc here only represent A matrix instead of A * K + + if(ncfitrans .gt. ncfiouttrans)then + AI_fic = receiver_fic(1:ncfitrans-ncfiouttrans) + AJ_fic = doner_fic (1:ncfitrans-ncfiouttrans) + call AKfivegc%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Aficoned,& + AI_fic,AJ_fic,ncfitrans-ncfiouttrans,init_ready_afic,list_afic,RI_fic,CI_fic) + if(use_c14)then + associate( & + AKfivegc14 => c14_cnveg_carbonflux_inst%AKfivegc , & ! Afi*Kfi for C14 cycle in sparse matrix format + RI_fic14 => c14_cnveg_carbonflux_inst%RI_fic , & ! Row indices of non-diagonal entires in Afi for C cycle + CI_fic14 => c14_cnveg_carbonflux_inst%CI_fic , & ! Column indices of non-diagonal entries in Afi for C cycle + list_afic14 => c14_cnveg_carbonflux_inst%list_afic & ! Indices of non-diagnoal entries in full sparse matrix Afi for C cycle + ) + AI_fic14 = receiver_fic(1:ncfitrans-ncfiouttrans) + AJ_fic14 = doner_fic (1:ncfitrans-ncfiouttrans) + call AKfivegc14%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Afic14oned,& + AI_fic14,AJ_fic14,ncfitrans-ncfiouttrans,init_ready_afic14,list_afic14,RI_fic14,CI_fic14) + end associate + end if + else + call AKfivegc%SetValueA_diag(num_soilp,filter_soilp,-1._r8) + if(use_c14)then + associate( & + AKfivegc14 => c14_cnveg_carbonflux_inst%AKfivegc & ! Afi*Kfi for C14 cycle in sparse matrix format + ) + call AKfivegc14%SetValueA_diag(num_soilp,filter_soilp,-1._r8) + end associate + end if + end if + + ! Set up diagonal matrix Kfi_c from diagonal entries matrix_fiturnover + call Kvegc%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_fiturnover(bounds%begp:bounds%endp,1:nvegcpool)) + + ! Calculate Afi_c*Kfi_c using SPMM_AK. + call AKfivegc%SPMM_AK(num_soilp,filter_soilp,Kvegc) + + if(use_c14)then + associate( & + AKfivegc14 => c14_cnveg_carbonflux_inst%AKfivegc , & ! Afi*Kfi for C14 cycle in sparse matrix format + matrix_c14fitransfer => c14_cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in (CNFireBaseMod or CNFireLi2014Mod) and CNC14decayMod + matrix_c14fiturnover => c14_cnveg_carbonflux_inst%matrix_fiturnover_patch & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods + ) + ! Set up diagonal matrix Kfi_c from diagonal entries matrix_fiturnover + call Kvegc%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_c14fiturnover(bounds%begp:bounds%endp,1:nvegcpool)) + + ! Calculate Afi_c*Kfi_c using SPMM_AK. + call AKfivegc14%SPMM_AK(num_soilp,filter_soilp,Kvegc) + end associate + end if + + ! Caclulate AKallvegc = Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c + ! When no fire, Afi_c*Kfi_c = 0, AKallvegc = Aph_c*Kph_c + Agm_c*Kgm_c + ! When fire is on, AKallvegc = Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c + + if(num_actfirep .eq. 0 .and. nthreads < 2)then + call AKallvegc%SPMP_AB(num_soilp,filter_soilp,AKphvegc,AKgmvegc,list_ready_phgmc,list_A=list_phc_phgm,list_B=list_gmc_phgm,& + NE_AB=NE_AKallvegc,RI_AB=RI_AKallvegc,CI_AB=CI_AKallvegc) + else + call AKallvegc%SPMP_ABC(num_soilp,filter_soilp,AKphvegc,AKgmvegc,AKfivegc,list_ready_phgmfic,list_A=list_phc_phgmfi,& + list_B=list_gmc_phgmfi,list_C=list_fic_phgmfi,NE_ABC=NE_AKallvegc,RI_ABC=RI_AKallvegc,CI_ABC=CI_AKallvegc,& + use_actunit_list_C=.True.,num_actunit_C=num_actfirep,filter_actunit_C=filter_actfirep) + end if + + if(use_c14)then + associate( & + AKfivegc14 => c14_cnveg_carbonflux_inst%AKfivegc , & ! Afi*Kfi for C14 cycle in sparse matrix format + AKallvegc14 => c14_cnveg_carbonflux_inst%AKallvegc , & ! Aph*Kph + Agm*Kgm + Afi*Kfi for C14 cycle in sparse matrix format + NE_AKallvegc14 => c14_cnveg_carbonflux_inst%NE_AKallvegc , & ! Number of entries in AKallvegc + RI_AKallvegc14 => c14_cnveg_carbonflux_inst%RI_AKallvegc , & ! Row indices in Akallvegc + CI_AKallvegc14 => c14_cnveg_carbonflux_inst%CI_AKallvegc , & ! Column indices in AKallvegc + list_phc14_phgmfi => c14_cnveg_carbonflux_inst%list_phc_phgmfic , & ! The locations of entries in AKphvegc mapped into (AKphvegc+AKgmvegc+AKfivegc) + list_gmc14_phgmfi => c14_cnveg_carbonflux_inst%list_gmc_phgmfic , & ! The locations of entries in AKgmvegc mapped into (AKphvegc+AKgmvegc+AKfivegc) + list_fic14_phgmfi => c14_cnveg_carbonflux_inst%list_fic_phgmfic & ! The locations of entries in AKfivegc mapped into (AKphvegc+AKgmvegc+AKfivegc) + ) + call AKallvegc14%SPMP_ABC(num_soilp,filter_soilp,AKphvegc,AKgmvegc,AKfivegc14,list_ready_phgmfic14,list_A=list_phc14_phgmfi,& + list_B=list_gmc14_phgmfi,list_C=list_fic14_phgmfi,NE_ABC=NE_AKallvegc14,RI_ABC=RI_AKallvegc14,CI_ABC=CI_AKallvegc14) + end associate + end if + + + ! Xvegc_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xvegc_n + Xvegc_n + call Xvegc%SPMM_AX(num_soilp,filter_soilp,AKallvegc) + + ! Xvegc_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xvegc_n + Xvegc_n + B*I + do i = 1,nvegcpool + do fp = 1,num_soilp + p = filter_soilp(fp) + Xvegc%V(p,i) = Xvegc%V(p,i) + vegmatrixc_input%V(p,i) + end do + end do + + + if ( use_c13 ) then + ! Calculate B*I_C13 + do i=1,nvegcpool + do fp = 1,num_soilp + p = filter_soilp(fp) + vegmatrixc13_input%V(p,i) = matrix_alloc(p,i) * matrix_C13input(p) * dt + end do + end do + + ! Xveg13c_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xveg13c_n + Xveg13c_n + call Xveg13c%SPMM_AX(num_soilp,filter_soilp,AKallvegc) + + ! Xveg13c_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xveg13c_n + Xveg13c_n + B*I_C13 + do i=1,nvegcpool + do fp = 1,num_soilp + p = filter_soilp(fp) + Xveg13c%V(p,i) = Xveg13c%V(p,i) + vegmatrixc13_input%V(p,i) + end do + end do + end if + + + if ( use_c14 ) then + associate( & + matrix_C14input => cnveg_carbonflux_inst%matrix_C14input_patch, & ! Input: [real(r8) (:)] (gC/m2/s) C14 input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod + AKallvegc14 => c14_cnveg_carbonflux_inst%AKallvegc & ! Aph*Kph + Agm*Kgm + Afi*Kfi for C14 cycle in sparse matrix format + ) + ! Calculate B*I_C14 + do i=1,nvegcpool + do fp = 1,num_soilp + p = filter_soilp(fp) + vegmatrixc14_input%V(p,i) = matrix_alloc(p,i) * matrix_C14input(p) * dt + end do + end do + + ! Xveg14c_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xveg14c_n + Xveg14c_n + call Xveg14c%SPMM_AX(num_soilp,filter_soilp,AKallvegc14) + + ! Xveg14c_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xveg14c_n + Xveg14c_n + B*I_C14 + do i=1,nvegcpool + do fp = 1,num_soilp + p = filter_soilp(fp) + Xveg14c%V(p,i) = Xveg14c%V(p,i) + vegmatrixc14_input%V(p,i) + end do + end do + end associate + end if + + + + ! Calculate B_N*I_N + do i=1,nvegnpool + do fp = 1,num_soilp + p = filter_soilp(fp) + vegmatrixn_input%V(p,i) = matrix_nalloc(p,i) * matrix_Ninput(p) * dt + end do + end do + + + ! Set up sparse matrix Aph_n from non-diagonal entires Aficoned, diagonal entries are all set to -1. + ! Note that AKphvegn here only represent A matrix instead of A * K + + if(nnphtrans .gt. nnphouttrans)then + AI_phn = receiver_phn(1:nnphtrans-nnphouttrans) + AJ_phn = doner_phn (1:nnphtrans-nnphouttrans) + call AKphvegn%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Aphnoned,& + AI_phn,AJ_phn,nnphtrans-nnphouttrans,init_ready_aphn,list_aphn,RI_phn,CI_phn) + else + call AKphvegn%SetValueA_diag(num_soilp,filter_soilp,-1._r8) + end if + + ! Set up diagonal matrix Kph_n from diagonal entries matrix_nphturnover + call Kvegn%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_nphturnover(bounds%begp:bounds%endp,1:nvegnpool)) + + ! Calculate Aph_n*Kph_n using SPMM_AK. + call AKphvegn%SPMM_AK(num_soilp,filter_soilp,Kvegn) + + + ! Set up sparse matrix Agm_n from non-diagonal entires Aficoned, diagonal entries are all set to -1. + ! Note that AKgmvegn here only represent A matrix instead of A * K + + if(nngmtrans .gt. nngmouttrans)then + AI_gmn = receiver_gmn(1:nngmtrans-nngmouttrans) + AJ_gmn = doner_gmn (1:nngmtrans-nngmouttrans) + call AKgmvegn%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Agmnoned,& + AI_gmn,AJ_gmn,nngmtrans-nngmouttrans,init_ready_agmn,list_agmn,RI_gmn,CI_gmn) + else + call AKgmvegn%SetValueA_diag(num_soilp,filter_soilp,-1._r8) + end if + + ! Set up diagonal matrix Kgm_n from diagonal entries matrix_ngmturnover + call Kvegn%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_ngmturnover(bounds%begp:bounds%endp,1:nvegnpool)) + + ! Calculate Agm_n*Kgm_n using SPMM_AK. + call AKgmvegn%SPMM_AK(num_soilp,filter_soilp,Kvegn) + + + ! Set up sparse matrix Afi_n from non-diagonal entires Aficoned, diagonal entries are all set to -1. + ! Note that AKfivegn here only represent A matrix instead of A * K + + if(nnfitrans .gt. nnfiouttrans)then + AI_fin = receiver_fin(1:nnfitrans-nnfiouttrans) + AJ_fin = doner_fin (1:nnfitrans-nnfiouttrans) + call AKfivegn%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Afinoned,& + AI_fin,AJ_fin,nnfitrans-nnfiouttrans,init_ready_afin,list_afin,RI_fin,CI_fin) + else + call AKfivegn%SetValueA_diag(num_soilp,filter_soilp,-1._r8) + end if + + ! Set up diagonal matrix Kfi_n from diagonal entries matrix_nfiturnover + call Kvegn%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_nfiturnover(bounds%begp:bounds%endp,1:nvegnpool)) + + ! Calculate Afi_n*Kfi_n using SPMM_AK. + call AKfivegn%SPMM_AK(num_soilp,filter_soilp,Kvegn) + + + ! Caclulate AKallvegn = Aph_n*Kph_n + Agm_n*Kgm_n + Afi_n*Kfi_n + ! When no fire, Afi_n*Kfi_n = 0, AKallvegn = Aph_n*Kph_n + Agm_n*Kgm_n + ! When fire is on, AKallvegn = Aph_n*Kph_n + Agm_n*Kgm_n + Afi_n*Kfi_n + + if(num_actfirep .eq. 0 .and. nthreads < 2)then + call AKallvegn%SPMP_AB(num_soilp,filter_soilp,AKphvegn,AKgmvegn,list_ready_phgmn,list_A=list_phn_phgm,list_B=list_gmn_phgm,& + NE_AB=NE_AKallvegn,RI_AB=RI_AKallvegn,CI_AB=CI_AKallvegn) + else + call AKallvegn%SPMP_ABC(num_soilp,filter_soilp,AKphvegn,AKgmvegn,AKfivegn,list_ready_phgmfin,list_A=list_phn_phgmfi,& + list_B=list_gmn_phgmfi,list_C=list_fin_phgmfi,NE_ABC=NE_AKallvegn,RI_ABC=RI_AKallvegn,CI_ABC=CI_AKallvegn,& + use_actunit_list_C=.True.,num_actunit_C=num_actfirep,filter_actunit_C=filter_actfirep) + end if + + ! Xvegn_n+1 = (Aph_n*Kph_n + Agm_n*Kgm_n + Afi_n*Kfi_n) * Xvegc_n + Xvegc_n + call Xvegn%SPMM_AX(num_soilp,filter_soilp,AKallvegn) + + ! Xvegn_n+1 = (Aph_n*Kph_n + Agm_n*Kgm_n + Afi_n*Kfi_n) * Xvegc_n + Xvegc_n + B_N*I_N + do i=1,nvegnpool + do fp = 1,num_soilp + p = filter_soilp(fp) + Xvegn%V(p,i) = Xvegn%V(p,i) + vegmatrixn_input%V(p,i) + end do + end do + + call t_stopf('CN veg matrix-matrix multi.') + + + ! Accumulate transfers during the whole calendar year + + call t_startf('CN veg matrix-accum. trans.') + if(isspinup .or. is_outmatrix)then + do fp = 1,num_soilp + p = filter_soilp(fp) + matrix_calloc_leaf_acc(p) = matrix_calloc_leaf_acc(p) + vegmatrixc_input%V(p,ileaf) + matrix_calloc_leafst_acc(p) = matrix_calloc_leafst_acc(p) + vegmatrixc_input%V(p,ileaf_st) + matrix_calloc_froot_acc(p) = matrix_calloc_froot_acc(p) + vegmatrixc_input%V(p,ifroot) + matrix_calloc_frootst_acc(p) = matrix_calloc_frootst_acc(p) + vegmatrixc_input%V(p,ifroot_st) + matrix_calloc_livestem_acc(p) = matrix_calloc_livestem_acc(p) + vegmatrixc_input%V(p,ilivestem) + matrix_calloc_livestemst_acc(p) = matrix_calloc_livestemst_acc(p) + vegmatrixc_input%V(p,ilivestem_st) + matrix_calloc_deadstem_acc(p) = matrix_calloc_deadstem_acc(p) + vegmatrixc_input%V(p,ideadstem) + matrix_calloc_deadstemst_acc(p) = matrix_calloc_deadstemst_acc(p) + vegmatrixc_input%V(p,ideadstem_st) + matrix_calloc_livecroot_acc(p) = matrix_calloc_livecroot_acc(p) + vegmatrixc_input%V(p,ilivecroot) + matrix_calloc_livecrootst_acc(p) = matrix_calloc_livecrootst_acc(p) + vegmatrixc_input%V(p,ilivecroot_st) + matrix_calloc_deadcroot_acc(p) = matrix_calloc_deadcroot_acc(p) + vegmatrixc_input%V(p,ideadcroot) + matrix_calloc_deadcrootst_acc(p) = matrix_calloc_deadcrootst_acc(p) + vegmatrixc_input%V(p,ideadcroot_st) + if(use_c13)then + cs13_veg%matrix_calloc_leaf_acc_patch(p) = cs13_veg%matrix_calloc_leaf_acc_patch(p) + vegmatrixc13_input%V(p,ileaf) + cs13_veg%matrix_calloc_leafst_acc_patch(p) = cs13_veg%matrix_calloc_leafst_acc_patch(p) + vegmatrixc13_input%V(p,ileaf_st) + cs13_veg%matrix_calloc_froot_acc_patch(p) = cs13_veg%matrix_calloc_froot_acc_patch(p) + vegmatrixc13_input%V(p,ifroot) + cs13_veg%matrix_calloc_frootst_acc_patch(p) = cs13_veg%matrix_calloc_frootst_acc_patch(p) + vegmatrixc13_input%V(p,ifroot_st) + cs13_veg%matrix_calloc_livestem_acc_patch(p) = cs13_veg%matrix_calloc_livestem_acc_patch(p) + vegmatrixc13_input%V(p,ilivestem) + cs13_veg%matrix_calloc_livestemst_acc_patch(p) = cs13_veg%matrix_calloc_livestemst_acc_patch(p) + vegmatrixc13_input%V(p,ilivestem_st) + cs13_veg%matrix_calloc_deadstem_acc_patch(p) = cs13_veg%matrix_calloc_deadstem_acc_patch(p) + vegmatrixc13_input%V(p,ideadstem) + cs13_veg%matrix_calloc_deadstemst_acc_patch(p) = cs13_veg%matrix_calloc_deadstemst_acc_patch(p) + vegmatrixc13_input%V(p,ideadstem_st) + cs13_veg%matrix_calloc_livecroot_acc_patch(p) = cs13_veg%matrix_calloc_livecroot_acc_patch(p) + vegmatrixc13_input%V(p,ilivecroot) + cs13_veg%matrix_calloc_livecrootst_acc_patch(p) = cs13_veg%matrix_calloc_livecrootst_acc_patch(p) + vegmatrixc13_input%V(p,ilivecroot_st) + cs13_veg%matrix_calloc_deadcroot_acc_patch(p) = cs13_veg%matrix_calloc_deadcroot_acc_patch(p) + vegmatrixc13_input%V(p,ideadcroot) + cs13_veg%matrix_calloc_deadcrootst_acc_patch(p) = cs13_veg%matrix_calloc_deadcrootst_acc_patch(p) + vegmatrixc13_input%V(p,ideadcroot_st) + end if + if(use_c14)then + cs14_veg%matrix_calloc_leaf_acc_patch(p) = cs14_veg%matrix_calloc_leaf_acc_patch(p) + vegmatrixc14_input%V(p,ileaf) + cs14_veg%matrix_calloc_leafst_acc_patch(p) = cs14_veg%matrix_calloc_leafst_acc_patch(p) + vegmatrixc14_input%V(p,ileaf_st) + cs14_veg%matrix_calloc_froot_acc_patch(p) = cs14_veg%matrix_calloc_froot_acc_patch(p) + vegmatrixc14_input%V(p,ifroot) + cs14_veg%matrix_calloc_frootst_acc_patch(p) = cs14_veg%matrix_calloc_frootst_acc_patch(p) + vegmatrixc14_input%V(p,ifroot_st) + cs14_veg%matrix_calloc_livestem_acc_patch(p) = cs14_veg%matrix_calloc_livestem_acc_patch(p) + vegmatrixc14_input%V(p,ilivestem) + cs14_veg%matrix_calloc_livestemst_acc_patch(p) = cs14_veg%matrix_calloc_livestemst_acc_patch(p) + vegmatrixc14_input%V(p,ilivestem_st) + cs14_veg%matrix_calloc_deadstem_acc_patch(p) = cs14_veg%matrix_calloc_deadstem_acc_patch(p) + vegmatrixc14_input%V(p,ideadstem) + cs14_veg%matrix_calloc_deadstemst_acc_patch(p) = cs14_veg%matrix_calloc_deadstemst_acc_patch(p) + vegmatrixc14_input%V(p,ideadstem_st) + cs14_veg%matrix_calloc_livecroot_acc_patch(p) = cs14_veg%matrix_calloc_livecroot_acc_patch(p) + vegmatrixc14_input%V(p,ilivecroot) + cs14_veg%matrix_calloc_livecrootst_acc_patch(p) = cs14_veg%matrix_calloc_livecrootst_acc_patch(p) + vegmatrixc14_input%V(p,ilivecroot_st) + cs14_veg%matrix_calloc_deadcroot_acc_patch(p) = cs14_veg%matrix_calloc_deadcroot_acc_patch(p) + vegmatrixc14_input%V(p,ideadcroot) + cs14_veg%matrix_calloc_deadcrootst_acc_patch(p) = cs14_veg%matrix_calloc_deadcrootst_acc_patch(p) + vegmatrixc14_input%V(p,ideadcroot_st) + end if + end do + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + matrix_calloc_grain_acc(p) = matrix_calloc_grain_acc(p) + vegmatrixc_input%V(p,igrain) + matrix_calloc_grainst_acc(p) = matrix_calloc_grainst_acc(p) + vegmatrixc_input%V(p,igrain_st) + if(use_c13)then + cs13_veg%matrix_calloc_grain_acc_patch(p) = cs13_veg%matrix_calloc_grain_acc_patch(p) + vegmatrixc13_input%V(p,igrain) + cs13_veg%matrix_calloc_grainst_acc_patch(p) = cs13_veg%matrix_calloc_grainst_acc_patch(p) + vegmatrixc13_input%V(p,igrain_st) + end if + if(use_c14)then + cs14_veg%matrix_calloc_grain_acc_patch(p) = cs14_veg%matrix_calloc_grain_acc_patch(p) + vegmatrixc14_input%V(p,igrain) + cs14_veg%matrix_calloc_grainst_acc_patch(p) = cs14_veg%matrix_calloc_grainst_acc_patch(p) + vegmatrixc14_input%V(p,igrain_st) + end if + end if + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + matrix_ctransfer_leafst_to_leafxf_acc(p) = matrix_ctransfer_leafst_to_leafxf_acc(p) & + + matrix_phtransfer(p,ileafst_to_ileafxf_phc) & + * dt * leafc_storage(p) !matrix_phturnover(p,ileaf_st)*leafc_storage(p) + matrix_ctransfer_leafxf_to_leaf_acc(p) = matrix_ctransfer_leafxf_to_leaf_acc(p) & + + matrix_phtransfer(p,ileafxf_to_ileaf_phc) & + * dt * leafc_xfer(p)!matrix_phturnover(p,ileaf_xf)*leafc_xfer(p) + matrix_ctransfer_frootst_to_frootxf_acc(p) = matrix_ctransfer_frootst_to_frootxf_acc(p) & + + matrix_phtransfer(p,ifrootst_to_ifrootxf_phc) & + * dt * frootc_storage(p)!matrix_phturnover(p,ifroot_st)*frootc_storage(p) + matrix_ctransfer_frootxf_to_froot_acc(p) = matrix_ctransfer_frootxf_to_froot_acc(p) & + + matrix_phtransfer(p,ifrootxf_to_ifroot_phc) & + * dt * frootc_xfer(p)!matrix_phturnover(p,ifroot_xf)*frootc_xfer(p) + matrix_ctransfer_livestemst_to_livestemxf_acc(p) = matrix_ctransfer_livestemst_to_livestemxf_acc(p) & + + matrix_phtransfer(p,ilivestemst_to_ilivestemxf_phc) & + * dt * livestemc_storage(p)!matrix_phturnover(p,ilivestem_st)*livestemc_storage(p) + matrix_ctransfer_livestemxf_to_livestem_acc(p) = matrix_ctransfer_livestemxf_to_livestem_acc(p) & + + matrix_phtransfer(p,ilivestemxf_to_ilivestem_phc) & + * dt * livestemc_xfer(p)!matrix_phturnover(p,ilivestem_xf)*livestemc_xfer(p) + matrix_ctransfer_deadstemst_to_deadstemxf_acc(p) = matrix_ctransfer_deadstemst_to_deadstemxf_acc(p) & + + matrix_phtransfer(p,ideadstemst_to_ideadstemxf_phc) & + * dt * deadstemc_storage(p)!matrix_phturnover(p,ideadstem_st)*deadstemc_storage(p) + matrix_ctransfer_deadstemxf_to_deadstem_acc(p) = matrix_ctransfer_deadstemxf_to_deadstem_acc(p) & + + matrix_phtransfer(p,ideadstemxf_to_ideadstem_phc) & + * dt * deadstemc_xfer(p)!matrix_phturnover(p,ideadstem_xf)*deadstemc_xfer(p) + matrix_ctransfer_livecrootst_to_livecrootxf_acc(p) = matrix_ctransfer_livecrootst_to_livecrootxf_acc(p) & + + matrix_phtransfer(p,ilivecrootst_to_ilivecrootxf_phc) & + * dt * livecrootc_storage(p)!matrix_phturnover(p,ilivecroot_st)*livecrootc_storage(p) + matrix_ctransfer_livecrootxf_to_livecroot_acc(p) = matrix_ctransfer_livecrootxf_to_livecroot_acc(p) & + + matrix_phtransfer(p,ilivecrootxf_to_ilivecroot_phc) & + * dt * livecrootc_xfer(p)!matrix_phturnover(p,ilivecroot_xf)*livecrootc_xfer(p) + matrix_ctransfer_deadcrootst_to_deadcrootxf_acc(p) = matrix_ctransfer_deadcrootst_to_deadcrootxf_acc(p) & + + matrix_phtransfer(p,ideadcrootst_to_ideadcrootxf_phc) & + * dt * deadcrootc_storage(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_storage(p) + matrix_ctransfer_deadcrootxf_to_deadcroot_acc(p) = matrix_ctransfer_deadcrootxf_to_deadcroot_acc(p) & + + matrix_phtransfer(p,ideadcrootxf_to_ideadcroot_phc) & + * dt * deadcrootc_xfer(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_xfer(p) + matrix_ctransfer_livestem_to_deadstem_acc(p) = matrix_ctransfer_livestem_to_deadstem_acc(p) & + +(matrix_phtransfer(p,ilivestem_to_ideadstem_phc)&!matrix_phturnover(p,ilivestem) & + + matrix_fitransfer(p,ilivestem_to_ideadstem_fic))&!matrix_fiturnover(p,ilivestem))& + * dt * livestemc(p) + matrix_ctransfer_livecroot_to_deadcroot_acc(p) = matrix_ctransfer_livecroot_to_deadcroot_acc(p) & + +(matrix_phtransfer(p,ilivecroot_to_ideadcroot_phc)&!*matrix_phturnover(p,ilivecroot) & + + matrix_fitransfer(p,ilivecroot_to_ideadcroot_fic))&!*matrix_fiturnover(p,ilivecroot))& + * dt * livecrootc(p) + matrix_cturnover_leaf_acc(p) = matrix_cturnover_leaf_acc(p) & + + (matrix_phturnover(p,ileaf)+matrix_gmturnover(p,ileaf)+matrix_fiturnover(p,ileaf)) & + * leafc(p) + matrix_cturnover_leafst_acc(p) = matrix_cturnover_leafst_acc(p) & + + (matrix_phturnover(p,ileaf_st)+matrix_gmturnover(p,ileaf_st)+matrix_fiturnover(p,ileaf_st)) & + * leafc_storage(p) + matrix_cturnover_leafxf_acc(p) = matrix_cturnover_leafxf_acc(p) & + + (matrix_phturnover(p,ileaf_xf)+matrix_gmturnover(p,ileaf_xf)+matrix_fiturnover(p,ileaf_xf)) & + * leafc_xfer(p) + matrix_cturnover_froot_acc(p) = matrix_cturnover_froot_acc(p) & + + (matrix_phturnover(p,ifroot)+matrix_gmturnover(p,ifroot)+matrix_fiturnover(p,ifroot)) & + * frootc(p) + matrix_cturnover_frootst_acc(p) = matrix_cturnover_frootst_acc(p) & + + (matrix_phturnover(p,ifroot_st)+matrix_gmturnover(p,ifroot_st)+matrix_fiturnover(p,ifroot_st)) & + * frootc_storage(p) + matrix_cturnover_frootxf_acc(p) = matrix_cturnover_frootxf_acc(p) & + + (matrix_phturnover(p,ifroot_xf)+matrix_gmturnover(p,ifroot_xf)+matrix_fiturnover(p,ifroot_xf)) & + * frootc_xfer(p) + matrix_cturnover_livestem_acc(p) = matrix_cturnover_livestem_acc(p) & + + (matrix_phturnover(p,ilivestem)+matrix_gmturnover(p,ilivestem)+matrix_fiturnover(p,ilivestem)) & + * livestemc(p) + matrix_cturnover_livestemst_acc(p) = matrix_cturnover_livestemst_acc(p) & + + (matrix_phturnover(p,ilivestem_st)+matrix_gmturnover(p,ilivestem_st)+matrix_fiturnover(p,ilivestem_st)) & + * livestemc_storage(p) + matrix_cturnover_livestemxf_acc(p) = matrix_cturnover_livestemxf_acc(p) & + + (matrix_phturnover(p,ilivestem_xf)+matrix_gmturnover(p,ilivestem_xf)+matrix_fiturnover(p,ilivestem_xf)) & + * livestemc_xfer(p) + matrix_cturnover_deadstem_acc(p) = matrix_cturnover_deadstem_acc(p) & + + (matrix_phturnover(p,ideadstem)+matrix_gmturnover(p,ideadstem)+matrix_fiturnover(p,ideadstem)) & + * deadstemc(p) + matrix_cturnover_deadstemst_acc(p) = matrix_cturnover_deadstemst_acc(p) & + + (matrix_phturnover(p,ideadstem_st)+matrix_gmturnover(p,ideadstem_st)+matrix_fiturnover(p,ideadstem_st)) & + * deadstemc_storage(p) + matrix_cturnover_deadstemxf_acc(p) = matrix_cturnover_deadstemxf_acc(p) & + + (matrix_phturnover(p,ideadstem_xf)+matrix_gmturnover(p,ideadstem_xf)+matrix_fiturnover(p,ideadstem_xf)) & + * deadstemc_xfer(p) + matrix_cturnover_livecroot_acc(p) = matrix_cturnover_livecroot_acc(p) & + + (matrix_phturnover(p,ilivecroot)+matrix_gmturnover(p,ilivecroot)+matrix_fiturnover(p,ilivecroot)) & + * livecrootc(p) + matrix_cturnover_livecrootst_acc(p) = matrix_cturnover_livecrootst_acc(p) & + + (matrix_phturnover(p,ilivecroot_st)+matrix_gmturnover(p,ilivecroot_st)+matrix_fiturnover(p,ilivecroot_st)) & + * livecrootc_storage(p) + matrix_cturnover_livecrootxf_acc(p) = matrix_cturnover_livecrootxf_acc(p) & + + (matrix_phturnover(p,ilivecroot_xf)+matrix_gmturnover(p,ilivecroot_xf)+matrix_fiturnover(p,ilivecroot_xf)) & + * livecrootc_xfer(p) + matrix_cturnover_deadcroot_acc(p) = matrix_cturnover_deadcroot_acc(p) & + + (matrix_phturnover(p,ideadcroot)+matrix_gmturnover(p,ideadcroot)+matrix_fiturnover(p,ideadcroot)) & + * deadcrootc(p) + matrix_cturnover_deadcrootst_acc(p) = matrix_cturnover_deadcrootst_acc(p) & + + (matrix_phturnover(p,ideadcroot_st)+matrix_gmturnover(p,ideadcroot_st)+matrix_fiturnover(p,ideadcroot_st)) & + * deadcrootc_storage(p) + matrix_cturnover_deadcrootxf_acc(p) = matrix_cturnover_deadcrootxf_acc(p) & + + (matrix_phturnover(p,ideadcroot_xf)+matrix_gmturnover(p,ideadcroot_xf)+matrix_fiturnover(p,ideadcroot_xf)) & + * deadcrootc_xfer(p) + if(use_c13)then + cs13_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) = cs13_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) & + + matrix_phtransfer(p,ileafst_to_ileafxf_phc) & + * dt * cs13_veg%leafc_storage_patch(p) !matrix_phturnover(p,ileaf_st)*leafc_storage(p) + cs13_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) = cs13_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) & + + matrix_phtransfer(p,ileafxf_to_ileaf_phc) & + * dt * cs13_veg%leafc_xfer_patch(p)!matrix_phturnover(p,ileaf_xf)*leafc_xfer(p) + cs13_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) = cs13_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) & + + matrix_phtransfer(p,ifrootst_to_ifrootxf_phc) & + * dt * cs13_veg%frootc_storage_patch(p)!matrix_phturnover(p,ifroot_st)*frootc_storage(p) + cs13_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) = cs13_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) & + + matrix_phtransfer(p,ifrootxf_to_ifroot_phc) & + * dt * cs13_veg%frootc_xfer_patch(p)!matrix_phturnover(p,ifroot_xf)*frootc_xfer(p) + cs13_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) = cs13_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) & + + matrix_phtransfer(p,ilivestemst_to_ilivestemxf_phc) & + * dt * cs13_veg%livestemc_storage_patch(p)!matrix_phturnover(p,ilivestem_st)*livestemc_storage(p) + cs13_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) = cs13_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) & + + matrix_phtransfer(p,ilivestemxf_to_ilivestem_phc) & + * dt * cs13_veg%livestemc_xfer_patch(p)!matrix_phturnover(p,ilivestem_xf)*livestemc_xfer(p) + cs13_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) = cs13_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) & + + matrix_phtransfer(p,ideadstemst_to_ideadstemxf_phc) & + * dt * cs13_veg%deadstemc_storage_patch(p)!matrix_phturnover(p,ideadstem_st)*deadstemc_storage(p) + cs13_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) = cs13_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) & + + matrix_phtransfer(p,ideadstemxf_to_ideadstem_phc) & + * dt * cs13_veg%deadstemc_xfer_patch(p)!matrix_phturnover(p,ideadstem_xf)*deadstemc_xfer(p) + cs13_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) = cs13_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) & + + matrix_phtransfer(p,ilivecrootst_to_ilivecrootxf_phc) & + * dt * cs13_veg%livecrootc_storage_patch(p)!matrix_phturnover(p,ilivecroot_st)*livecrootc_storage(p) + cs13_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) = cs13_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) & + + matrix_phtransfer(p,ilivecrootxf_to_ilivecroot_phc) & + * dt * cs13_veg%livecrootc_xfer_patch(p)!matrix_phturnover(p,ilivecroot_xf)*livecrootc_xfer(p) + cs13_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) = cs13_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) & + + matrix_phtransfer(p,ideadcrootst_to_ideadcrootxf_phc) & + * dt * cs13_veg%deadcrootc_storage_patch(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_storage(p) + cs13_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) = cs13_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) & + + matrix_phtransfer(p,ideadcrootxf_to_ideadcroot_phc) & + * dt * cs13_veg%deadcrootc_xfer_patch(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_xfer(p) + cs13_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) = cs13_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) & + +(matrix_phtransfer(p,ilivestem_to_ideadstem_phc)&!matrix_phturnover(p,ilivestem) & + + matrix_fitransfer(p,ilivestem_to_ideadstem_fic))&!matrix_fiturnover(p,ilivestem))& + * dt * cs13_veg%livestemc_patch(p) + cs13_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) = cs13_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) & + +(matrix_phtransfer(p,ilivecroot_to_ideadcroot_phc)&!*matrix_phturnover(p,ilivecroot) & + + matrix_fitransfer(p,ilivecroot_to_ideadcroot_fic))&!*matrix_fiturnover(p,ilivecroot))& + * dt * cs13_veg%livecrootc_patch(p) + cs13_veg%matrix_cturnover_leaf_acc_patch(p) = cs13_veg%matrix_cturnover_leaf_acc_patch(p) & + + (matrix_phturnover(p,ileaf)+matrix_gmturnover(p,ileaf)+matrix_fiturnover(p,ileaf)) & + * cs13_veg%leafc_patch(p) + cs13_veg%matrix_cturnover_leafst_acc_patch(p) = cs13_veg%matrix_cturnover_leafst_acc_patch(p) & + + (matrix_phturnover(p,ileaf_st)+matrix_gmturnover(p,ileaf_st)+matrix_fiturnover(p,ileaf_st)) & + * cs13_veg%leafc_storage_patch(p) + cs13_veg%matrix_cturnover_leafxf_acc_patch(p) = cs13_veg%matrix_cturnover_leafxf_acc_patch(p) & + + (matrix_phturnover(p,ileaf_xf)+matrix_gmturnover(p,ileaf_xf)+matrix_fiturnover(p,ileaf_xf)) & + * cs13_veg%leafc_xfer_patch(p) + cs13_veg%matrix_cturnover_froot_acc_patch(p) = cs13_veg%matrix_cturnover_froot_acc_patch(p) & + + (matrix_phturnover(p,ifroot)+matrix_gmturnover(p,ifroot)+matrix_fiturnover(p,ifroot)) & + * cs13_veg%frootc_patch(p) + cs13_veg%matrix_cturnover_frootst_acc_patch(p) = cs13_veg%matrix_cturnover_frootst_acc_patch(p) & + + (matrix_phturnover(p,ifroot_st)+matrix_gmturnover(p,ifroot_st)+matrix_fiturnover(p,ifroot_st)) & + * cs13_veg%frootc_storage_patch(p) + cs13_veg%matrix_cturnover_frootxf_acc_patch(p) = cs13_veg%matrix_cturnover_frootxf_acc_patch(p) & + + (matrix_phturnover(p,ifroot_xf)+matrix_gmturnover(p,ifroot_xf)+matrix_fiturnover(p,ifroot_xf)) & + * cs13_veg%frootc_xfer_patch(p) + cs13_veg%matrix_cturnover_livestem_acc_patch(p) = cs13_veg%matrix_cturnover_livestem_acc_patch(p) & + + (matrix_phturnover(p,ilivestem)+matrix_gmturnover(p,ilivestem)+matrix_fiturnover(p,ilivestem)) & + * cs13_veg%livestemc_patch(p) + cs13_veg%matrix_cturnover_livestemst_acc_patch(p) = cs13_veg%matrix_cturnover_livestemst_acc_patch(p) & + + (matrix_phturnover(p,ilivestem_st)+matrix_gmturnover(p,ilivestem_st)+matrix_fiturnover(p,ilivestem_st)) & + * cs13_veg%livestemc_storage_patch(p) + cs13_veg%matrix_cturnover_livestemxf_acc_patch(p) = cs13_veg%matrix_cturnover_livestemxf_acc_patch(p) & + + (matrix_phturnover(p,ilivestem_xf)+matrix_gmturnover(p,ilivestem_xf)+matrix_fiturnover(p,ilivestem_xf)) & + * cs13_veg%livestemc_xfer_patch(p) + cs13_veg%matrix_cturnover_deadstem_acc_patch(p) = cs13_veg%matrix_cturnover_deadstem_acc_patch(p) & + + (matrix_phturnover(p,ideadstem)+matrix_gmturnover(p,ideadstem)+matrix_fiturnover(p,ideadstem)) & + * cs13_veg%deadstemc_patch(p) + cs13_veg%matrix_cturnover_deadstemst_acc_patch(p) = cs13_veg%matrix_cturnover_deadstemst_acc_patch(p) & + + (matrix_phturnover(p,ideadstem_st)+matrix_gmturnover(p,ideadstem_st)+matrix_fiturnover(p,ideadstem_st)) & + * cs13_veg%deadstemc_storage_patch(p) + cs13_veg%matrix_cturnover_deadstemxf_acc_patch(p) = cs13_veg%matrix_cturnover_deadstemxf_acc_patch(p) & + + (matrix_phturnover(p,ideadstem_xf)+matrix_gmturnover(p,ideadstem_xf)+matrix_fiturnover(p,ideadstem_xf)) & + * cs13_veg%deadstemc_xfer_patch(p) + cs13_veg%matrix_cturnover_livecroot_acc_patch(p) = cs13_veg%matrix_cturnover_livecroot_acc_patch(p) & + + (matrix_phturnover(p,ilivecroot)+matrix_gmturnover(p,ilivecroot)+matrix_fiturnover(p,ilivecroot)) & + * cs13_veg%livecrootc_patch(p) + cs13_veg%matrix_cturnover_livecrootst_acc_patch(p) = cs13_veg%matrix_cturnover_livecrootst_acc_patch(p) & + + (matrix_phturnover(p,ilivecroot_st)+matrix_gmturnover(p,ilivecroot_st)+matrix_fiturnover(p,ilivecroot_st)) & + * cs13_veg%livecrootc_storage_patch(p) + cs13_veg%matrix_cturnover_livecrootxf_acc_patch(p) = cs13_veg%matrix_cturnover_livecrootxf_acc_patch(p) & + + (matrix_phturnover(p,ilivecroot_xf)+matrix_gmturnover(p,ilivecroot_xf)+matrix_fiturnover(p,ilivecroot_xf)) & + * cs13_veg%livecrootc_xfer_patch(p) + cs13_veg%matrix_cturnover_deadcroot_acc_patch(p) = cs13_veg%matrix_cturnover_deadcroot_acc_patch(p) & + + (matrix_phturnover(p,ideadcroot)+matrix_gmturnover(p,ideadcroot)+matrix_fiturnover(p,ideadcroot)) & + * cs13_veg%deadcrootc_patch(p) + cs13_veg%matrix_cturnover_deadcrootst_acc_patch(p) = cs13_veg%matrix_cturnover_deadcrootst_acc_patch(p) & + + (matrix_phturnover(p,ideadcroot_st)+matrix_gmturnover(p,ideadcroot_st)+matrix_fiturnover(p,ideadcroot_st)) & + * cs13_veg%deadcrootc_storage_patch(p) + cs13_veg%matrix_cturnover_deadcrootxf_acc_patch(p) = cs13_veg%matrix_cturnover_deadcrootxf_acc_patch(p) & + + (matrix_phturnover(p,ideadcroot_xf)+matrix_gmturnover(p,ideadcroot_xf)+matrix_fiturnover(p,ideadcroot_xf)) & + * cs13_veg%deadcrootc_xfer_patch(p) + end if + if(use_c14)then + associate( & + matrix_c14fitransfer => c14_cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in (CNFireBaseMod or CNFireLi2014Mod) and CNC14decayMod + matrix_c14fiturnover => c14_cnveg_carbonflux_inst%matrix_fiturnover_patch & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods + ) + cs14_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) = cs14_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) & + + matrix_phtransfer(p,ileafst_to_ileafxf_phc) & + * dt * cs14_veg%leafc_storage_patch(p) !matrix_phturnover(p,ileaf_st)*leafc_storage(p) + cs14_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) = cs14_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) & + + matrix_phtransfer(p,ileafxf_to_ileaf_phc) & + * dt * cs14_veg%leafc_xfer_patch(p)!matrix_phturnover(p,ileaf_xf)*leafc_xfer(p) + cs14_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) = cs14_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) & + + matrix_phtransfer(p,ifrootst_to_ifrootxf_phc) & + * dt * cs14_veg%frootc_storage_patch(p)!matrix_phturnover(p,ifroot_st)*frootc_storage(p) + cs14_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) = cs14_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) & + + matrix_phtransfer(p,ifrootxf_to_ifroot_phc) & + * dt * cs14_veg%frootc_xfer_patch(p)!matrix_phturnover(p,ifroot_xf)*frootc_xfer(p) + cs14_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) = cs14_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) & + + matrix_phtransfer(p,ilivestemst_to_ilivestemxf_phc) & + * dt * cs14_veg%livestemc_storage_patch(p)!matrix_phturnover(p,ilivestem_st)*livestemc_storage(p) + cs14_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) = cs14_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) & + + matrix_phtransfer(p,ilivestemxf_to_ilivestem_phc) & + * dt * cs14_veg%livestemc_xfer_patch(p)!matrix_phturnover(p,ilivestem_xf)*livestemc_xfer(p) + cs14_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) = cs14_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) & + + matrix_phtransfer(p,ideadstemst_to_ideadstemxf_phc) & + * dt * cs14_veg%deadstemc_storage_patch(p)!matrix_phturnover(p,ideadstem_st)*deadstemc_storage(p) + cs14_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) = cs14_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) & + + matrix_phtransfer(p,ideadstemxf_to_ideadstem_phc) & + * dt * cs14_veg%deadstemc_xfer_patch(p)!matrix_phturnover(p,ideadstem_xf)*deadstemc_xfer(p) + cs14_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) = cs14_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) & + + matrix_phtransfer(p,ilivecrootst_to_ilivecrootxf_phc) & + * dt * cs14_veg%livecrootc_storage_patch(p)!matrix_phturnover(p,ilivecroot_st)*livecrootc_storage(p) + cs14_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) = cs14_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) & + + matrix_phtransfer(p,ilivecrootxf_to_ilivecroot_phc) & + * dt * cs14_veg%livecrootc_xfer_patch(p)!matrix_phturnover(p,ilivecroot_xf)*livecrootc_xfer(p) + cs14_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) = cs14_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) & + + matrix_phtransfer(p,ideadcrootst_to_ideadcrootxf_phc) & + * dt * cs14_veg%deadcrootc_storage_patch(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_storage(p) + cs14_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) = cs14_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) & + + matrix_phtransfer(p,ideadcrootxf_to_ideadcroot_phc) & + * dt * cs14_veg%deadcrootc_xfer_patch(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_xfer(p) + cs14_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) = cs14_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) & + +(matrix_phtransfer(p,ilivestem_to_ideadstem_phc)&!matrix_phturnover(p,ilivestem) & + + matrix_c14fitransfer(p,ilivestem_to_ideadstem_fic))&!matrix_fiturnover(p,ilivestem))& + * dt * cs14_veg%livestemc_patch(p) + cs14_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) = cs14_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) & + +(matrix_phtransfer(p,ilivecroot_to_ideadcroot_phc)&!*matrix_phturnover(p,ilivecroot) & + + matrix_c14fitransfer(p,ilivecroot_to_ideadcroot_fic))&!*matrix_fiturnover(p,ilivecroot))& + * dt * cs14_veg%livecrootc_patch(p) + cs14_veg%matrix_cturnover_leaf_acc_patch(p) = cs14_veg%matrix_cturnover_leaf_acc_patch(p) & + + (matrix_phturnover(p,ileaf)+matrix_gmturnover(p,ileaf)+matrix_c14fiturnover(p,ileaf)) & + * cs14_veg%leafc_patch(p) + cs14_veg%matrix_cturnover_leafst_acc_patch(p) = cs14_veg%matrix_cturnover_leafst_acc_patch(p) & + + (matrix_phturnover(p,ileaf_st)+matrix_gmturnover(p,ileaf_st)+matrix_c14fiturnover(p,ileaf_st)) & + * cs14_veg%leafc_storage_patch(p) + cs14_veg%matrix_cturnover_leafxf_acc_patch(p) = cs14_veg%matrix_cturnover_leafxf_acc_patch(p) & + + (matrix_phturnover(p,ileaf_xf)+matrix_gmturnover(p,ileaf_xf)+matrix_c14fiturnover(p,ileaf_xf)) & + * cs14_veg%leafc_xfer_patch(p) + cs14_veg%matrix_cturnover_froot_acc_patch(p) = cs14_veg%matrix_cturnover_froot_acc_patch(p) & + + (matrix_phturnover(p,ifroot)+matrix_gmturnover(p,ifroot)+matrix_c14fiturnover(p,ifroot)) & + * cs14_veg%frootc_patch(p) + cs14_veg%matrix_cturnover_frootst_acc_patch(p) = cs14_veg%matrix_cturnover_frootst_acc_patch(p) & + + (matrix_phturnover(p,ifroot_st)+matrix_gmturnover(p,ifroot_st)+matrix_c14fiturnover(p,ifroot_st)) & + * cs14_veg%frootc_storage_patch(p) + cs14_veg%matrix_cturnover_frootxf_acc_patch(p) = cs14_veg%matrix_cturnover_frootxf_acc_patch(p) & + + (matrix_phturnover(p,ifroot_xf)+matrix_gmturnover(p,ifroot_xf)+matrix_c14fiturnover(p,ifroot_xf)) & + * cs14_veg%frootc_xfer_patch(p) + cs14_veg%matrix_cturnover_livestem_acc_patch(p) = cs14_veg%matrix_cturnover_livestem_acc_patch(p) & + + (matrix_phturnover(p,ilivestem)+matrix_gmturnover(p,ilivestem)+matrix_c14fiturnover(p,ilivestem)) & + * cs14_veg%livestemc_patch(p) + cs14_veg%matrix_cturnover_livestemst_acc_patch(p) = cs14_veg%matrix_cturnover_livestemst_acc_patch(p) & + + (matrix_phturnover(p,ilivestem_st)+matrix_gmturnover(p,ilivestem_st)+matrix_c14fiturnover(p,ilivestem_st)) & + * cs14_veg%livestemc_storage_patch(p) + cs14_veg%matrix_cturnover_livestemxf_acc_patch(p) = cs14_veg%matrix_cturnover_livestemxf_acc_patch(p) & + + (matrix_phturnover(p,ilivestem_xf)+matrix_gmturnover(p,ilivestem_xf)+matrix_c14fiturnover(p,ilivestem_xf)) & + * cs14_veg%livestemc_xfer_patch(p) + cs14_veg%matrix_cturnover_deadstem_acc_patch(p) = cs14_veg%matrix_cturnover_deadstem_acc_patch(p) & + + (matrix_phturnover(p,ideadstem)+matrix_gmturnover(p,ideadstem)+matrix_c14fiturnover(p,ideadstem)) & + * cs14_veg%deadstemc_patch(p) + cs14_veg%matrix_cturnover_deadstemst_acc_patch(p) = cs14_veg%matrix_cturnover_deadstemst_acc_patch(p) & + + (matrix_phturnover(p,ideadstem_st)+matrix_gmturnover(p,ideadstem_st)+matrix_c14fiturnover(p,ideadstem_st)) & + * cs14_veg%deadstemc_storage_patch(p) + cs14_veg%matrix_cturnover_deadstemxf_acc_patch(p) = cs14_veg%matrix_cturnover_deadstemxf_acc_patch(p) & + + (matrix_phturnover(p,ideadstem_xf)+matrix_gmturnover(p,ideadstem_xf)+matrix_c14fiturnover(p,ideadstem_xf)) & + * cs14_veg%deadstemc_xfer_patch(p) + cs14_veg%matrix_cturnover_livecroot_acc_patch(p) = cs14_veg%matrix_cturnover_livecroot_acc_patch(p) & + + (matrix_phturnover(p,ilivecroot)+matrix_gmturnover(p,ilivecroot)+matrix_c14fiturnover(p,ilivecroot)) & + * cs14_veg%livecrootc_patch(p) + cs14_veg%matrix_cturnover_livecrootst_acc_patch(p) = cs14_veg%matrix_cturnover_livecrootst_acc_patch(p) & + + (matrix_phturnover(p,ilivecroot_st)+matrix_gmturnover(p,ilivecroot_st)+matrix_c14fiturnover(p,ilivecroot_st)) & + * cs14_veg%livecrootc_storage_patch(p) + cs14_veg%matrix_cturnover_livecrootxf_acc_patch(p) = cs14_veg%matrix_cturnover_livecrootxf_acc_patch(p) & + + (matrix_phturnover(p,ilivecroot_xf)+matrix_gmturnover(p,ilivecroot_xf)+matrix_c14fiturnover(p,ilivecroot_xf)) & + * cs14_veg%livecrootc_xfer_patch(p) + cs14_veg%matrix_cturnover_deadcroot_acc_patch(p) = cs14_veg%matrix_cturnover_deadcroot_acc_patch(p) & + + (matrix_phturnover(p,ideadcroot)+matrix_gmturnover(p,ideadcroot)+matrix_c14fiturnover(p,ideadcroot)) & + * cs14_veg%deadcrootc_patch(p) + cs14_veg%matrix_cturnover_deadcrootst_acc_patch(p) = cs14_veg%matrix_cturnover_deadcrootst_acc_patch(p) & + + (matrix_phturnover(p,ideadcroot_st)+matrix_gmturnover(p,ideadcroot_st)+matrix_c14fiturnover(p,ideadcroot_st)) & + * cs14_veg%deadcrootc_storage_patch(p) + cs14_veg%matrix_cturnover_deadcrootxf_acc_patch(p) = cs14_veg%matrix_cturnover_deadcrootxf_acc_patch(p) & + + (matrix_phturnover(p,ideadcroot_xf)+matrix_gmturnover(p,ideadcroot_xf)+matrix_c14fiturnover(p,ideadcroot_xf)) & + * cs14_veg%deadcrootc_xfer_patch(p) + end associate + end if + end do + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + matrix_cturnover_grain_acc(p) = matrix_cturnover_grain_acc(p) & + + (matrix_phturnover(p,igrain)+matrix_gmturnover(p,igrain)+matrix_fiturnover(p,igrain)) & + * grainc(p) + matrix_cturnover_grainst_acc(p) = matrix_cturnover_grainst_acc(p) & + + (matrix_phturnover(p,igrain_st)+matrix_gmturnover(p,igrain_st)+matrix_fiturnover(p,igrain_st)) & + * grainc_storage(p) + matrix_cturnover_grainxf_acc(p) = matrix_cturnover_grainxf_acc(p) & + + (matrix_phturnover(p,igrain_xf)+matrix_gmturnover(p,igrain_xf)+matrix_fiturnover(p,igrain_xf)) & + * grainc_xfer(p) + if(use_c13)then + cs13_veg%matrix_cturnover_grain_acc_patch(p) = cs13_veg%matrix_cturnover_grain_acc_patch(p) & + + (matrix_phturnover(p,igrain)+matrix_gmturnover(p,igrain)+matrix_fiturnover(p,igrain)) & + * cs13_veg%grainc_patch(p) + cs13_veg%matrix_cturnover_grainst_acc_patch(p) = cs13_veg%matrix_cturnover_grainst_acc_patch(p) & + + (matrix_phturnover(p,igrain_st)+matrix_gmturnover(p,igrain_st)+matrix_fiturnover(p,igrain_st)) & + * cs13_veg%grainc_storage_patch(p) + cs13_veg%matrix_cturnover_grainxf_acc_patch(p) = cs13_veg%matrix_cturnover_grainxf_acc_patch(p) & + + (matrix_phturnover(p,igrain_xf)+matrix_gmturnover(p,igrain_xf)+matrix_fiturnover(p,igrain_xf)) & + * cs13_veg%grainc_xfer_patch(p) + end if + if(use_c14)then + associate( & + matrix_c14fitransfer => c14_cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in (CNFireBaseMod or CNFireLi2014Mod) and CNC14decayMod + matrix_c14fiturnover => c14_cnveg_carbonflux_inst%matrix_fiturnover_patch & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods + ) + cs14_veg%matrix_cturnover_grain_acc_patch(p) = cs14_veg%matrix_cturnover_grain_acc_patch(p) & + + (matrix_phturnover(p,igrain)+matrix_gmturnover(p,igrain)+matrix_c14fiturnover(p,igrain)) & + * cs14_veg%grainc_patch(p) + cs14_veg%matrix_cturnover_grainst_acc_patch(p) = cs14_veg%matrix_cturnover_grainst_acc_patch(p) & + + (matrix_phturnover(p,igrain_st)+matrix_gmturnover(p,igrain_st)+matrix_c14fiturnover(p,igrain_st)) & + * cs14_veg%grainc_storage_patch(p) + cs14_veg%matrix_cturnover_grainxf_acc_patch(p) = cs14_veg%matrix_cturnover_grainxf_acc_patch(p) & + + (matrix_phturnover(p,igrain_xf)+matrix_gmturnover(p,igrain_xf)+matrix_c14fiturnover(p,igrain_xf)) & + * cs14_veg%grainc_xfer_patch(p) + end associate + end if + end if + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + matrix_nalloc_leaf_acc(p) = matrix_nalloc_leaf_acc(p) + vegmatrixn_input%V(p,ileaf) + matrix_nalloc_leafst_acc(p) = matrix_nalloc_leafst_acc(p) + vegmatrixn_input%V(p,ileaf_st) + matrix_nalloc_froot_acc(p) = matrix_nalloc_froot_acc(p) + vegmatrixn_input%V(p,ifroot) + matrix_nalloc_frootst_acc(p) = matrix_nalloc_frootst_acc(p) + vegmatrixn_input%V(p,ifroot_st) + matrix_nalloc_livestem_acc(p) = matrix_nalloc_livestem_acc(p) + vegmatrixn_input%V(p,ilivestem) + matrix_nalloc_livestemst_acc(p) = matrix_nalloc_livestemst_acc(p) + vegmatrixn_input%V(p,ilivestem_st) + matrix_nalloc_deadstem_acc(p) = matrix_nalloc_deadstem_acc(p) + vegmatrixn_input%V(p,ideadstem) + matrix_nalloc_deadstemst_acc(p) = matrix_nalloc_deadstemst_acc(p) + vegmatrixn_input%V(p,ideadstem_st) + matrix_nalloc_livecroot_acc(p) = matrix_nalloc_livecroot_acc(p) + vegmatrixn_input%V(p,ilivecroot) + matrix_nalloc_livecrootst_acc(p) = matrix_nalloc_livecrootst_acc(p) + vegmatrixn_input%V(p,ilivecroot_st) + matrix_nalloc_deadcroot_acc(p) = matrix_nalloc_deadcroot_acc(p) + vegmatrixn_input%V(p,ideadcroot) + matrix_nalloc_deadcrootst_acc(p) = matrix_nalloc_deadcrootst_acc(p) + vegmatrixn_input%V(p,ideadcroot_st) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + matrix_nalloc_grain_acc(p) = matrix_nalloc_grain_acc(p) + vegmatrixn_input%V(p,igrain) + matrix_nalloc_grainst_acc(p) = matrix_nalloc_grainst_acc(p) + vegmatrixn_input%V(p,igrain_st) + end if + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + matrix_ntransfer_leafst_to_leafxf_acc(p) = matrix_ntransfer_leafst_to_leafxf_acc(p) & + + matrix_nphtransfer(p,ileafst_to_ileafxf_phn) & + * dt * leafn_storage(p)!matrix_nphturnover(p,ileaf_st)*leafn_storage(p) + matrix_ntransfer_leafxf_to_leaf_acc(p) = matrix_ntransfer_leafxf_to_leaf_acc(p) & + + matrix_nphtransfer(p,ileafxf_to_ileaf_phn) & + * dt * leafn_xfer(p)!matrix_nphturnover(p,ileaf_xf)*leafn_xfer(p) + matrix_ntransfer_frootst_to_frootxf_acc(p) = matrix_ntransfer_frootst_to_frootxf_acc(p) & + + matrix_nphtransfer(p,ifrootst_to_ifrootxf_phn) & + * dt * frootn_storage(p)!matrix_nphturnover(p,ifroot_st)*frootn_storage(p) + matrix_ntransfer_frootxf_to_froot_acc(p) = matrix_ntransfer_frootxf_to_froot_acc(p) & + + matrix_nphtransfer(p,ifrootxf_to_ifroot_phn) & + * dt * frootn_xfer(p)!matrix_nphturnover(p,ifroot_xf)*frootn_xfer(p) + matrix_ntransfer_livestemst_to_livestemxf_acc(p) = matrix_ntransfer_livestemst_to_livestemxf_acc(p) & + + matrix_nphtransfer(p,ilivestemst_to_ilivestemxf_phn) & + * dt * livestemn_storage(p)!matrix_nphturnover(p,ilivestem_st)*livestemn_storage(p) + matrix_ntransfer_livestemxf_to_livestem_acc(p) = matrix_ntransfer_livestemxf_to_livestem_acc(p) & + + matrix_nphtransfer(p,ilivestemxf_to_ilivestem_phn) & + * dt * livestemn_xfer(p)!matrix_nphturnover(p,ilivestem_xf)*livestemn_xfer(p) + matrix_ntransfer_deadstemst_to_deadstemxf_acc(p) = matrix_ntransfer_deadstemst_to_deadstemxf_acc(p) & + + matrix_nphtransfer(p,ideadstemst_to_ideadstemxf_phn) & + * dt * deadstemn_storage(p)!matrix_nphturnover(p,ideadstem_st)*deadstemn_storage(p) + matrix_ntransfer_deadstemxf_to_deadstem_acc(p) = matrix_ntransfer_deadstemxf_to_deadstem_acc(p) & + + matrix_nphtransfer(p,ideadstemxf_to_ideadstem_phn) & + * dt * deadstemn_xfer(p)!matrix_nphturnover(p,ideadstem_xf)*deadstemn_storage(p) + matrix_ntransfer_livecrootst_to_livecrootxf_acc(p) = matrix_ntransfer_livecrootst_to_livecrootxf_acc(p) & + + matrix_nphtransfer(p,ilivecrootst_to_ilivecrootxf_phn) & + * dt * livecrootn_storage(p)!matrix_nphturnover(p,ilivecroot_st)*livecrootn_storage(p) + matrix_ntransfer_livecrootxf_to_livecroot_acc(p) = matrix_ntransfer_livecrootxf_to_livecroot_acc(p) & + + matrix_nphtransfer(p,ilivecrootxf_to_ilivecroot_phn) & + * dt * livecrootn_xfer(p)!matrix_nphturnover(p,ilivecroot_xf)*livecrootn_xfer(p) + matrix_ntransfer_deadcrootst_to_deadcrootxf_acc(p) = matrix_ntransfer_deadcrootst_to_deadcrootxf_acc(p) & + + matrix_nphtransfer(p,ideadcrootst_to_ideadcrootxf_phn) & + * dt * deadcrootn_storage(p)!matrix_nphturnover(p,ideadcroot_st)*deadcrootn_storage(p) + matrix_ntransfer_deadcrootxf_to_deadcroot_acc(p) = matrix_ntransfer_deadcrootxf_to_deadcroot_acc(p) & + + matrix_nphtransfer(p,ideadcrootxf_to_ideadcroot_phn) & + * dt * deadcrootn_xfer(p)!matrix_nphturnover(p,ideadcroot_st)*deadcrootn_xfer(p) + matrix_ntransfer_livestem_to_deadstem_acc(p) = matrix_ntransfer_livestem_to_deadstem_acc(p) & + +(matrix_nphtransfer(p,ilivestem_to_ideadstem_phn) &!*matrix_nphturnover(p,ilivestem) & + + matrix_nfitransfer(p,ilivestem_to_ideadstem_fin)) &!*matrix_nfiturnover(p,ilivestem)) & + * dt * livestemn(p) + matrix_ntransfer_livecroot_to_deadcroot_acc(p) = matrix_ntransfer_livecroot_to_deadcroot_acc(p) & + +(matrix_nphtransfer(p,ilivecroot_to_ideadcroot_phn) &!*matrix_nphturnover(p,ilivecroot) & + + matrix_nfitransfer(p,ilivecroot_to_ideadcroot_fin)) &!*matrix_nfiturnover(p,ilivecroot)) & + * dt * livecrootn(p) + + matrix_ntransfer_retransn_to_leaf_acc(p) = matrix_ntransfer_retransn_to_leaf_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ileaf_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_leafst_acc(p) = matrix_ntransfer_retransn_to_leafst_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ileafst_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_froot_acc(p) = matrix_ntransfer_retransn_to_froot_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ifroot_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_frootst_acc(p) = matrix_ntransfer_retransn_to_frootst_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ifrootst_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_livestem_acc(p) = matrix_ntransfer_retransn_to_livestem_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ilivestem_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_livestemst_acc(p) = matrix_ntransfer_retransn_to_livestemst_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ilivestemst_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_deadstem_acc(p) = matrix_ntransfer_retransn_to_deadstem_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ideadstem_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_deadstemst_acc(p) = matrix_ntransfer_retransn_to_deadstemst_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ideadstemst_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_livecroot_acc(p) = matrix_ntransfer_retransn_to_livecroot_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ilivecroot_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_livecrootst_acc(p) = matrix_ntransfer_retransn_to_livecrootst_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ilivecrootst_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_deadcroot_acc(p) = matrix_ntransfer_retransn_to_deadcroot_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ideadcroot_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_deadcrootst_acc(p) = matrix_ntransfer_retransn_to_deadcrootst_acc(p) & + + matrix_nphtransfer(p,iretransn_to_ideadcrootst_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_leaf_to_retransn_acc(p) = matrix_ntransfer_leaf_to_retransn_acc(p) & + + matrix_nphtransfer(p,ileaf_to_iretransn_phn) & + * dt * retransn(p)!matrix_nphturnover(p,ileaf)*leafn(p) + matrix_ntransfer_froot_to_retransn_acc(p) = matrix_ntransfer_froot_to_retransn_acc(p) & + + matrix_nphtransfer(p,ifroot_to_iretransn_phn) & + * dt * retransn(p)!matrix_nphturnover(p,ifroot)*frootn(p) + matrix_ntransfer_livestem_to_retransn_acc(p) = matrix_ntransfer_livestem_to_retransn_acc(p) & + + matrix_nphtransfer(p,ilivestem_to_iretransn_phn) & + * dt * retransn(p)!matrix_nphturnover(p,ilivestem)*livestemn(p) + matrix_ntransfer_livecroot_to_retransn_acc(p) = matrix_ntransfer_livecroot_to_retransn_acc(p) & + + matrix_nphtransfer(p,ilivecroot_to_iretransn_phn) & + * dt * retransn(p)!matrix_nphturnover(p,ilivecroot)*livecrootn(p) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + matrix_ntransfer_retransn_to_grain_acc(p) = matrix_ntransfer_retransn_to_grain_acc(p) & + + matrix_nphtransfer(p,iretransn_to_igrain_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + matrix_ntransfer_retransn_to_grainst_acc(p) = matrix_ntransfer_retransn_to_grainst_acc(p) & + + matrix_nphtransfer(p,iretransn_to_igrainst_phn) & + * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) + end if + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + matrix_nturnover_leaf_acc(p) = matrix_nturnover_leaf_acc(p) & + + (matrix_nphturnover(p,ileaf)+matrix_ngmturnover(p,ileaf)+matrix_nfiturnover(p,ileaf)) & + * leafn(p) + matrix_nturnover_leafst_acc(p) = matrix_nturnover_leafst_acc(p) & + + (matrix_nphturnover(p,ileaf_st)+matrix_ngmturnover(p,ileaf_st)+matrix_nfiturnover(p,ileaf_st)) & + * leafn_storage(p) + matrix_nturnover_leafxf_acc(p) = matrix_nturnover_leafxf_acc(p) & + + (matrix_nphturnover(p,ileaf_xf)+matrix_ngmturnover(p,ileaf_xf)+matrix_nfiturnover(p,ileaf_xf)) & + * leafn_xfer(p) + matrix_nturnover_froot_acc(p) = matrix_nturnover_froot_acc(p) & + + (matrix_nphturnover(p,ifroot)+matrix_ngmturnover(p,ifroot)+matrix_nfiturnover(p,ifroot)) & + * frootn(p) + matrix_nturnover_frootst_acc(p) = matrix_nturnover_frootst_acc(p) & + + (matrix_nphturnover(p,ifroot_st)+matrix_ngmturnover(p,ifroot_st)+matrix_nfiturnover(p,ifroot_st)) & + * frootn_storage(p) + matrix_nturnover_frootxf_acc(p) = matrix_nturnover_frootxf_acc(p) & + + (matrix_nphturnover(p,ifroot_xf)+matrix_ngmturnover(p,ifroot_xf)+matrix_nfiturnover(p,ifroot_xf)) & + * frootn_xfer(p) + matrix_nturnover_livestem_acc(p) = matrix_nturnover_livestem_acc(p) & + + (matrix_nphturnover(p,ilivestem)+matrix_ngmturnover(p,ilivestem)+matrix_nfiturnover(p,ilivestem)) & + * livestemn(p) + matrix_nturnover_livestemst_acc(p) = matrix_nturnover_livestemst_acc(p) & + + (matrix_nphturnover(p,ilivestem_st)+matrix_ngmturnover(p,ilivestem_st)+matrix_nfiturnover(p,ilivestem_st)) & + * livestemn_storage(p) + matrix_nturnover_livestemxf_acc(p) = matrix_nturnover_livestemxf_acc(p) & + + (matrix_nphturnover(p,ilivestem_xf)+matrix_ngmturnover(p,ilivestem_xf)+matrix_nfiturnover(p,ilivestem_xf)) & + * livestemn_xfer(p) + matrix_nturnover_deadstem_acc(p) = matrix_nturnover_deadstem_acc(p) & + + (matrix_nphturnover(p,ideadstem)+matrix_ngmturnover(p,ideadstem)+matrix_nfiturnover(p,ideadstem)) & + * deadstemn(p) + matrix_nturnover_deadstemst_acc(p) = matrix_nturnover_deadstemst_acc(p) & + + (matrix_nphturnover(p,ideadstem_st)+matrix_ngmturnover(p,ideadstem_st)+matrix_nfiturnover(p,ideadstem_st)) & + * deadstemn_storage(p) + matrix_nturnover_deadstemxf_acc(p) = matrix_nturnover_deadstemxf_acc(p) & + + (matrix_nphturnover(p,ideadstem_xf)+matrix_ngmturnover(p,ideadstem_xf)+matrix_nfiturnover(p,ideadstem_xf)) & + * deadstemn_xfer(p) + matrix_nturnover_livecroot_acc(p) = matrix_nturnover_livecroot_acc(p) & + + (matrix_nphturnover(p,ilivecroot)+matrix_ngmturnover(p,ilivecroot)+matrix_nfiturnover(p,ilivecroot)) & + * livecrootn(p) + matrix_nturnover_livecrootst_acc(p) = matrix_nturnover_livecrootst_acc(p) & + + (matrix_nphturnover(p,ilivecroot_st)+matrix_ngmturnover(p,ilivecroot_st)+matrix_nfiturnover(p,ilivecroot_st)) & + * livecrootn_storage(p) + matrix_nturnover_livecrootxf_acc(p) = matrix_nturnover_livecrootxf_acc(p) & + + (matrix_nphturnover(p,ilivecroot_xf)+matrix_ngmturnover(p,ilivecroot_xf)+matrix_nfiturnover(p,ilivecroot_xf)) & + * livecrootn_xfer(p) + matrix_nturnover_deadcroot_acc(p) = matrix_nturnover_deadcroot_acc(p) & + + (matrix_nphturnover(p,ideadcroot)+matrix_ngmturnover(p,ideadcroot)+matrix_nfiturnover(p,ideadcroot)) & + * deadcrootn(p) + matrix_nturnover_deadcrootst_acc(p) = matrix_nturnover_deadcrootst_acc(p) & + + (matrix_nphturnover(p,ideadcroot_st)+matrix_ngmturnover(p,ideadcroot_st)+matrix_nfiturnover(p,ideadcroot_st)) & + * deadcrootn_storage(p) + matrix_nturnover_deadcrootxf_acc(p) = matrix_nturnover_deadcrootxf_acc(p) & + + (matrix_nphturnover(p,ideadcroot_xf)+matrix_ngmturnover(p,ideadcroot_xf)+matrix_nfiturnover(p,ideadcroot_xf)) & + * deadcrootn_xfer(p) + matrix_nturnover_retransn_acc(p) = matrix_nturnover_retransn_acc(p) & + + (matrix_nphturnover(p,iretransn)+matrix_ngmturnover(p,iretransn)+matrix_nfiturnover(p,iretransn)) & + * retransn(p) + end do + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + matrix_nturnover_grain_acc(p) = matrix_nturnover_grain_acc(p) & + + (matrix_nphturnover(p,igrain)+matrix_ngmturnover(p,igrain)+matrix_nfiturnover(p,igrain)) & + * grainn(p) + matrix_nturnover_grainst_acc(p) = matrix_nturnover_grainst_acc(p) & + + (matrix_nphturnover(p,igrain_st)+matrix_ngmturnover(p,igrain_st)+matrix_nfiturnover(p,igrain_st)) & + * grainn_storage(p) + matrix_nturnover_grainxf_acc(p) = matrix_nturnover_grainxf_acc(p) & + + (matrix_nphturnover(p,igrain_xf)+matrix_ngmturnover(p,igrain_xf)+matrix_nfiturnover(p,igrain_xf)) & + * grainn_xfer(p) + end if + end do + end if + call t_stopf('CN veg matrix-accum. trans.') + + ! Update state variables + call t_startf('CN veg matrix-assign new value') + do fp = 1,num_soilp + p = filter_soilp(fp) + leafc(p) = Xvegc%V(p,ileaf) + leafc_storage(p) = Xvegc%V(p,ileaf_st) + leafc_xfer(p) = Xvegc%V(p,ileaf_xf) + frootc(p) = Xvegc%V(p,ifroot) + frootc_storage(p) = Xvegc%V(p,ifroot_st) + frootc_xfer(p) = Xvegc%V(p,ifroot_xf) + livestemc(p) = Xvegc%V(p,ilivestem) + livestemc_storage(p) = Xvegc%V(p,ilivestem_st) + livestemc_xfer(p) = Xvegc%V(p,ilivestem_xf) + deadstemc(p) = Xvegc%V(p,ideadstem) + deadstemc_storage(p) = Xvegc%V(p,ideadstem_st) + deadstemc_xfer(p) = Xvegc%V(p,ideadstem_xf) + livecrootc(p) = Xvegc%V(p,ilivecroot) + livecrootc_storage(p) = Xvegc%V(p,ilivecroot_st) + livecrootc_xfer(p) = Xvegc%V(p,ilivecroot_xf) + deadcrootc(p) = Xvegc%V(p,ideadcroot) + deadcrootc_storage(p) = Xvegc%V(p,ideadcroot_st) + deadcrootc_xfer(p) = Xvegc%V(p,ideadcroot_xf) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + grainc(p) = Xvegc%V(p,igrain) + grainc_storage(p) = Xvegc%V(p,igrain_st) + grainc_xfer(p) = Xvegc%V(p,igrain_xf) + end if + end do + + if ( use_c13 ) then + do fp = 1,num_soilp + p = filter_soilp(fp) + cs13_veg%leafc_patch(p) = Xveg13c%V(p,ileaf) + cs13_veg%leafc_storage_patch(p) = Xveg13c%V(p,ileaf_st) + cs13_veg%leafc_xfer_patch(p) = Xveg13c%V(p,ileaf_xf) + cs13_veg%frootc_patch(p) = Xveg13c%V(p,ifroot) + cs13_veg%frootc_storage_patch(p) = Xveg13c%V(p,ifroot_st) + cs13_veg%frootc_xfer_patch(p) = Xveg13c%V(p,ifroot_xf) + cs13_veg%livestemc_patch(p) = Xveg13c%V(p,ilivestem) + cs13_veg%livestemc_storage_patch(p) = Xveg13c%V(p,ilivestem_st) + cs13_veg%livestemc_xfer_patch(p) = Xveg13c%V(p,ilivestem_xf) + cs13_veg%deadstemc_patch(p) = Xveg13c%V(p,ideadstem) + cs13_veg%deadstemc_storage_patch(p) = Xveg13c%V(p,ideadstem_st) + cs13_veg%deadstemc_xfer_patch(p) = Xveg13c%V(p,ideadstem_xf) + cs13_veg%livecrootc_patch(p) = Xveg13c%V(p,ilivecroot) + cs13_veg%livecrootc_storage_patch(p) = Xveg13c%V(p,ilivecroot_st) + cs13_veg%livecrootc_xfer_patch(p) = Xveg13c%V(p,ilivecroot_xf) + cs13_veg%deadcrootc_patch(p) = Xveg13c%V(p,ideadcroot) + cs13_veg%deadcrootc_storage_patch(p) = Xveg13c%V(p,ideadcroot_st) + cs13_veg%deadcrootc_xfer_patch(p) = Xveg13c%V(p,ideadcroot_xf) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + cs13_veg%grainc_patch(p) = Xveg13c%V(p,igrain) + cs13_veg%grainc_storage_patch(p) = Xveg13c%V(p,igrain_st) + cs13_veg%grainc_xfer_patch(p) = Xveg13c%V(p,igrain_xf) + end if + end do + end if + + if ( use_c14 ) then + do fp = 1,num_soilp + p = filter_soilp(fp) + cs14_veg%leafc_patch(p) = Xveg14c%V(p,ileaf) + cs14_veg%leafc_storage_patch(p) = Xveg14c%V(p,ileaf_st) + cs14_veg%leafc_xfer_patch(p) = Xveg14c%V(p,ileaf_xf) + cs14_veg%frootc_patch(p) = Xveg14c%V(p,ifroot) + cs14_veg%frootc_storage_patch(p) = Xveg14c%V(p,ifroot_st) + cs14_veg%frootc_xfer_patch(p) = Xveg14c%V(p,ifroot_xf) + cs14_veg%livestemc_patch(p) = Xveg14c%V(p,ilivestem) + cs14_veg%livestemc_storage_patch(p) = Xveg14c%V(p,ilivestem_st) + cs14_veg%livestemc_xfer_patch(p) = Xveg14c%V(p,ilivestem_xf) + cs14_veg%deadstemc_patch(p) = Xveg14c%V(p,ideadstem) + cs14_veg%deadstemc_storage_patch(p) = Xveg14c%V(p,ideadstem_st) + cs14_veg%deadstemc_xfer_patch(p) = Xveg14c%V(p,ideadstem_xf) + cs14_veg%livecrootc_patch(p) = Xveg14c%V(p,ilivecroot) + cs14_veg%livecrootc_storage_patch(p) = Xveg14c%V(p,ilivecroot_st) + cs14_veg%livecrootc_xfer_patch(p) = Xveg14c%V(p,ilivecroot_xf) + cs14_veg%deadcrootc_patch(p) = Xveg14c%V(p,ideadcroot) + cs14_veg%deadcrootc_storage_patch(p) = Xveg14c%V(p,ideadcroot_st) + cs14_veg%deadcrootc_xfer_patch(p) = Xveg14c%V(p,ideadcroot_xf) + end do + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + cs14_veg%grainc_patch(p) = Xveg14c%V(p,igrain) + cs14_veg%grainc_storage_patch(p) = Xveg14c%V(p,igrain_st) + cs14_veg%grainc_xfer_patch(p) = Xveg14c%V(p,igrain_xf) + end if + end do + end if + + do fp = 1,num_soilp + p = filter_soilp(fp) + leafn(p) = Xvegn%V(p,ileaf) + leafn_storage(p) = Xvegn%V(p,ileaf_st) + leafn_xfer(p) = Xvegn%V(p,ileaf_xf) + frootn(p) = Xvegn%V(p,ifroot) + frootn_storage(p) = Xvegn%V(p,ifroot_st) + frootn_xfer(p) = Xvegn%V(p,ifroot_xf) + livestemn(p) = Xvegn%V(p,ilivestem) + livestemn_storage(p) = Xvegn%V(p,ilivestem_st) + livestemn_xfer(p) = Xvegn%V(p,ilivestem_xf) + deadstemn(p) = Xvegn%V(p,ideadstem) + deadstemn_storage(p) = Xvegn%V(p,ideadstem_st) + deadstemn_xfer(p) = Xvegn%V(p,ideadstem_xf) + livecrootn(p) = Xvegn%V(p,ilivecroot) + livecrootn_storage(p) = Xvegn%V(p,ilivecroot_st) + livecrootn_xfer(p) = Xvegn%V(p,ilivecroot_xf) + deadcrootn(p) = Xvegn%V(p,ideadcroot) + deadcrootn_storage(p) = Xvegn%V(p,ideadcroot_st) + deadcrootn_xfer(p) = Xvegn%V(p,ideadcroot_xf) + retransn(p) = Xvegn%V(p,iretransn) + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if(ivt(p) >= npcropmin)then + grainn(p) = Xvegn%V(p,igrain) + grainn_storage(p) = Xvegn%V(p,igrain_st) + grainn_xfer(p) = Xvegn%V(p,igrain_xf) + end if + end do + call t_stopf('CN veg matrix-assign new value') + + ! Calculate C storage capacity. 2D matrix instead of sparse matrix is still used when calculating the inverse + if(isspinup .or. is_outmatrix)then + if((.not. isspinup .and. is_end_curr_year()) .or. (isspinup .and. is_end_curr_year() .and. mod(iyr,nyr_SASU) .eq. 0))then + do fp = 1,num_soilp + call t_startf('CN veg matrix-prepare AK^-1') + p = filter_soilp(fp) + matrix_calloc_acc(ileaf) = matrix_calloc_leaf_acc(p) + matrix_calloc_acc(ileaf_st) = matrix_calloc_leafst_acc(p) + matrix_calloc_acc(ifroot) = matrix_calloc_froot_acc(p) + matrix_calloc_acc(ifroot_st) = matrix_calloc_frootst_acc(p) + matrix_calloc_acc(ilivestem) = matrix_calloc_livestem_acc(p) + matrix_calloc_acc(ilivestem_st) = matrix_calloc_livestemst_acc(p) + matrix_calloc_acc(ideadstem) = matrix_calloc_deadstem_acc(p) + matrix_calloc_acc(ideadstem_st) = matrix_calloc_deadstemst_acc(p) + matrix_calloc_acc(ilivecroot) = matrix_calloc_livecroot_acc(p) + matrix_calloc_acc(ilivecroot_st) = matrix_calloc_livecrootst_acc(p) + matrix_calloc_acc(ideadcroot) = matrix_calloc_deadcroot_acc(p) + matrix_calloc_acc(ideadcroot_st) = matrix_calloc_deadcrootst_acc(p) + if(ivt(p) >= npcropmin)then + matrix_calloc_acc(igrain) = matrix_calloc_grain_acc(p) + matrix_calloc_acc(igrain_st) = matrix_calloc_grainst_acc(p) + end if + + matrix_ctransfer_acc(ileaf_xf,ileaf_st) = matrix_ctransfer_leafst_to_leafxf_acc(p) + matrix_ctransfer_acc(ileaf,ileaf_xf) = matrix_ctransfer_leafxf_to_leaf_acc(p) + matrix_ctransfer_acc(ifroot_xf,ifroot_st) = matrix_ctransfer_frootst_to_frootxf_acc(p) + matrix_ctransfer_acc(ifroot,ifroot_xf) = matrix_ctransfer_frootxf_to_froot_acc(p) + matrix_ctransfer_acc(ilivestem_xf,ilivestem_st) = matrix_ctransfer_livestemst_to_livestemxf_acc(p) + matrix_ctransfer_acc(ilivestem,ilivestem_xf) = matrix_ctransfer_livestemxf_to_livestem_acc(p) + matrix_ctransfer_acc(ideadstem_xf,ideadstem_st) = matrix_ctransfer_deadstemst_to_deadstemxf_acc(p) + matrix_ctransfer_acc(ideadstem,ideadstem_xf) = matrix_ctransfer_deadstemxf_to_deadstem_acc(p) + matrix_ctransfer_acc(ilivecroot_xf,ilivecroot_st) = matrix_ctransfer_livecrootst_to_livecrootxf_acc(p) + matrix_ctransfer_acc(ilivecroot,ilivecroot_xf) = matrix_ctransfer_livecrootxf_to_livecroot_acc(p) + matrix_ctransfer_acc(ideadcroot_xf,ideadcroot_st) = matrix_ctransfer_deadcrootst_to_deadcrootxf_acc(p) + matrix_ctransfer_acc(ideadcroot,ideadcroot_xf) = matrix_ctransfer_deadcrootxf_to_deadcroot_acc(p) + if(ivt(p) >= npcropmin)then + matrix_ctransfer_acc(igrain_xf,igrain_st) = matrix_ctransfer_grainst_to_grainxf_acc(p) + matrix_ctransfer_acc(igrain,igrain_xf) = matrix_ctransfer_grainxf_to_grain_acc(p) + end if + matrix_ctransfer_acc(ideadstem,ilivestem) = matrix_ctransfer_livestem_to_deadstem_acc(p) + matrix_ctransfer_acc(ideadcroot,ilivecroot) = matrix_ctransfer_livecroot_to_deadcroot_acc(p) + + matrix_ctransfer_acc(ileaf,ileaf) = -matrix_cturnover_leaf_acc(p) + matrix_ctransfer_acc(ileaf_st,ileaf_st) = -matrix_cturnover_leafst_acc(p) + matrix_ctransfer_acc(ileaf_xf,ileaf_xf) = -matrix_cturnover_leafxf_acc(p) + matrix_ctransfer_acc(ifroot,ifroot) = -matrix_cturnover_froot_acc(p) + matrix_ctransfer_acc(ifroot_st,ifroot_st) = -matrix_cturnover_frootst_acc(p) + matrix_ctransfer_acc(ifroot_xf,ifroot_xf) = -matrix_cturnover_frootxf_acc(p) + matrix_ctransfer_acc(ilivestem,ilivestem) = -matrix_cturnover_livestem_acc(p) + matrix_ctransfer_acc(ilivestem_st,ilivestem_st) = -matrix_cturnover_livestemst_acc(p) + matrix_ctransfer_acc(ilivestem_xf,ilivestem_xf) = -matrix_cturnover_livestemxf_acc(p) + matrix_ctransfer_acc(ideadstem,ideadstem) = -matrix_cturnover_deadstem_acc(p) + matrix_ctransfer_acc(ideadstem_st,ideadstem_st) = -matrix_cturnover_deadstemst_acc(p) + matrix_ctransfer_acc(ideadstem_xf,ideadstem_xf) = -matrix_cturnover_deadstemxf_acc(p) + matrix_ctransfer_acc(ilivecroot,ilivecroot) = -matrix_cturnover_livecroot_acc(p) + matrix_ctransfer_acc(ilivecroot_st,ilivecroot_st) = -matrix_cturnover_livecrootst_acc(p) + matrix_ctransfer_acc(ilivecroot_xf,ilivecroot_xf) = -matrix_cturnover_livecrootxf_acc(p) + matrix_ctransfer_acc(ideadcroot,ideadcroot) = -matrix_cturnover_deadcroot_acc(p) + matrix_ctransfer_acc(ideadcroot_st,ideadcroot_st) = -matrix_cturnover_deadcrootst_acc(p) + matrix_ctransfer_acc(ideadcroot_xf,ideadcroot_xf) = -matrix_cturnover_deadcrootxf_acc(p) + if(ivt(p) >= npcropmin)then + matrix_ctransfer_acc(igrain,igrain) = -matrix_cturnover_grain_acc(p) + matrix_ctransfer_acc(igrain_st,igrain_st) = -matrix_cturnover_grainst_acc(p) + matrix_ctransfer_acc(igrain_xf,igrain_xf) = -matrix_cturnover_grainxf_acc(p) + end if + + if(use_c13)then + matrix_c13alloc_acc(ileaf) = cs13_veg%matrix_calloc_leaf_acc_patch(p) + matrix_c13alloc_acc(ileaf_st) = cs13_veg%matrix_calloc_leafst_acc_patch(p) + matrix_c13alloc_acc(ifroot) = cs13_veg%matrix_calloc_froot_acc_patch(p) + matrix_c13alloc_acc(ifroot_st) = cs13_veg%matrix_calloc_frootst_acc_patch(p) + matrix_c13alloc_acc(ilivestem) = cs13_veg%matrix_calloc_livestem_acc_patch(p) + matrix_c13alloc_acc(ilivestem_st) = cs13_veg%matrix_calloc_livestemst_acc_patch(p) + matrix_c13alloc_acc(ideadstem) = cs13_veg%matrix_calloc_deadstem_acc_patch(p) + matrix_c13alloc_acc(ideadstem_st) = cs13_veg%matrix_calloc_deadstemst_acc_patch(p) + matrix_c13alloc_acc(ilivecroot) = cs13_veg%matrix_calloc_livecroot_acc_patch(p) + matrix_c13alloc_acc(ilivecroot_st) = cs13_veg%matrix_calloc_livecrootst_acc_patch(p) + matrix_c13alloc_acc(ideadcroot) = cs13_veg%matrix_calloc_deadcroot_acc_patch(p) + matrix_c13alloc_acc(ideadcroot_st) = cs13_veg%matrix_calloc_deadcrootst_acc_patch(p) + if(ivt(p) >= npcropmin)then + matrix_c13alloc_acc(igrain) = cs13_veg%matrix_calloc_grain_acc_patch(p) + matrix_c13alloc_acc(igrain_st) = cs13_veg%matrix_calloc_grainst_acc_patch(p) + end if + + matrix_c13transfer_acc(ileaf_xf,ileaf_st) = cs13_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) + matrix_c13transfer_acc(ileaf,ileaf_xf) = cs13_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) + matrix_c13transfer_acc(ifroot_xf,ifroot_st) = cs13_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) + matrix_c13transfer_acc(ifroot,ifroot_xf) = cs13_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) + matrix_c13transfer_acc(ilivestem_xf,ilivestem_st) = cs13_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) + matrix_c13transfer_acc(ilivestem,ilivestem_xf) = cs13_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) + matrix_c13transfer_acc(ideadstem_xf,ideadstem_st) = cs13_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) + matrix_c13transfer_acc(ideadstem,ideadstem_xf) = cs13_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) + matrix_c13transfer_acc(ilivecroot_xf,ilivecroot_st) = cs13_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) + matrix_c13transfer_acc(ilivecroot,ilivecroot_xf) = cs13_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) + matrix_c13transfer_acc(ideadcroot_xf,ideadcroot_st) = cs13_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) + matrix_c13transfer_acc(ideadcroot,ideadcroot_xf) = cs13_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) + if(ivt(p) >= npcropmin)then + matrix_c13transfer_acc(igrain_xf,igrain_st) = cs13_veg%matrix_ctransfer_grainst_to_grainxf_acc_patch(p) + matrix_c13transfer_acc(igrain,igrain_xf) = cs13_veg%matrix_ctransfer_grainxf_to_grain_acc_patch(p) + end if + matrix_c13transfer_acc(ideadstem,ilivestem) = cs13_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) + matrix_c13transfer_acc(ideadcroot,ilivecroot) = cs13_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) + + matrix_c13transfer_acc(ileaf,ileaf) = -cs13_veg%matrix_cturnover_leaf_acc_patch(p) + matrix_c13transfer_acc(ileaf_st,ileaf_st) = -cs13_veg%matrix_cturnover_leafst_acc_patch(p) + matrix_c13transfer_acc(ileaf_xf,ileaf_xf) = -cs13_veg%matrix_cturnover_leafxf_acc_patch(p) + matrix_c13transfer_acc(ifroot,ifroot) = -cs13_veg%matrix_cturnover_froot_acc_patch(p) + matrix_c13transfer_acc(ifroot_st,ifroot_st) = -cs13_veg%matrix_cturnover_frootst_acc_patch(p) + matrix_c13transfer_acc(ifroot_xf,ifroot_xf) = -cs13_veg%matrix_cturnover_frootxf_acc_patch(p) + matrix_c13transfer_acc(ilivestem,ilivestem) = -cs13_veg%matrix_cturnover_livestem_acc_patch(p) + matrix_c13transfer_acc(ilivestem_st,ilivestem_st) = -cs13_veg%matrix_cturnover_livestemst_acc_patch(p) + matrix_c13transfer_acc(ilivestem_xf,ilivestem_xf) = -cs13_veg%matrix_cturnover_livestemxf_acc_patch(p) + matrix_c13transfer_acc(ideadstem,ideadstem) = -cs13_veg%matrix_cturnover_deadstem_acc_patch(p) + matrix_c13transfer_acc(ideadstem_st,ideadstem_st) = -cs13_veg%matrix_cturnover_deadstemst_acc_patch(p) + matrix_c13transfer_acc(ideadstem_xf,ideadstem_xf) = -cs13_veg%matrix_cturnover_deadstemxf_acc_patch(p) + matrix_c13transfer_acc(ilivecroot,ilivecroot) = -cs13_veg%matrix_cturnover_livecroot_acc_patch(p) + matrix_c13transfer_acc(ilivecroot_st,ilivecroot_st) = -cs13_veg%matrix_cturnover_livecrootst_acc_patch(p) + matrix_c13transfer_acc(ilivecroot_xf,ilivecroot_xf) = -cs13_veg%matrix_cturnover_livecrootxf_acc_patch(p) + matrix_c13transfer_acc(ideadcroot,ideadcroot) = -cs13_veg%matrix_cturnover_deadcroot_acc_patch(p) + matrix_c13transfer_acc(ideadcroot_st,ideadcroot_st) = -cs13_veg%matrix_cturnover_deadcrootst_acc_patch(p) + matrix_c13transfer_acc(ideadcroot_xf,ideadcroot_xf) = -cs13_veg%matrix_cturnover_deadcrootxf_acc_patch(p) + if(ivt(p) >= npcropmin)then + matrix_c13transfer_acc(igrain,igrain) = -cs13_veg%matrix_cturnover_grain_acc_patch(p) + matrix_c13transfer_acc(igrain_st,igrain_st) = -cs13_veg%matrix_cturnover_grainst_acc_patch(p) + matrix_c13transfer_acc(igrain_xf,igrain_xf) = -cs13_veg%matrix_cturnover_grainxf_acc_patch(p) + end if + end if + + if(use_c14)then + matrix_c14alloc_acc(ileaf) = cs14_veg%matrix_calloc_leaf_acc_patch(p) + matrix_c14alloc_acc(ileaf_st) = cs14_veg%matrix_calloc_leafst_acc_patch(p) + matrix_c14alloc_acc(ifroot) = cs14_veg%matrix_calloc_froot_acc_patch(p) + matrix_c14alloc_acc(ifroot_st) = cs14_veg%matrix_calloc_frootst_acc_patch(p) + matrix_c14alloc_acc(ilivestem) = cs14_veg%matrix_calloc_livestem_acc_patch(p) + matrix_c14alloc_acc(ilivestem_st) = cs14_veg%matrix_calloc_livestemst_acc_patch(p) + matrix_c14alloc_acc(ideadstem) = cs14_veg%matrix_calloc_deadstem_acc_patch(p) + matrix_c14alloc_acc(ideadstem_st) = cs14_veg%matrix_calloc_deadstemst_acc_patch(p) + matrix_c14alloc_acc(ilivecroot) = cs14_veg%matrix_calloc_livecroot_acc_patch(p) + matrix_c14alloc_acc(ilivecroot_st) = cs14_veg%matrix_calloc_livecrootst_acc_patch(p) + matrix_c14alloc_acc(ideadcroot) = cs14_veg%matrix_calloc_deadcroot_acc_patch(p) + matrix_c14alloc_acc(ideadcroot_st) = cs14_veg%matrix_calloc_deadcrootst_acc_patch(p) + if(ivt(p) >= npcropmin)then + matrix_c14alloc_acc(igrain) = cs14_veg%matrix_calloc_grain_acc_patch(p) + matrix_c14alloc_acc(igrain_st) = cs14_veg%matrix_calloc_grainst_acc_patch(p) + end if + + matrix_c14transfer_acc(ileaf_xf,ileaf_st) = cs14_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) + matrix_c14transfer_acc(ileaf,ileaf_xf) = cs14_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) + matrix_c14transfer_acc(ifroot_xf,ifroot_st) = cs14_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) + matrix_c14transfer_acc(ifroot,ifroot_xf) = cs14_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) + matrix_c14transfer_acc(ilivestem_xf,ilivestem_st) = cs14_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) + matrix_c14transfer_acc(ilivestem,ilivestem_xf) = cs14_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) + matrix_c14transfer_acc(ideadstem_xf,ideadstem_st) = cs14_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) + matrix_c14transfer_acc(ideadstem,ideadstem_xf) = cs14_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) + matrix_c14transfer_acc(ilivecroot_xf,ilivecroot_st) = cs14_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) + matrix_c14transfer_acc(ilivecroot,ilivecroot_xf) = cs14_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) + matrix_c14transfer_acc(ideadcroot_xf,ideadcroot_st) = cs14_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) + matrix_c14transfer_acc(ideadcroot,ideadcroot_xf) = cs14_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) + if(ivt(p) >= npcropmin)then + matrix_c14transfer_acc(igrain_xf,igrain_st) = cs14_veg%matrix_ctransfer_grainst_to_grainxf_acc_patch(p) + matrix_c14transfer_acc(igrain,igrain_xf) = cs14_veg%matrix_ctransfer_grainxf_to_grain_acc_patch(p) + end if + matrix_c14transfer_acc(ideadstem,ilivestem) = cs14_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) + matrix_c14transfer_acc(ideadcroot,ilivecroot) = cs14_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) + + matrix_c14transfer_acc(ileaf,ileaf) = -cs14_veg%matrix_cturnover_leaf_acc_patch(p) + matrix_c14transfer_acc(ileaf_st,ileaf_st) = -cs14_veg%matrix_cturnover_leafst_acc_patch(p) + matrix_c14transfer_acc(ileaf_xf,ileaf_xf) = -cs14_veg%matrix_cturnover_leafxf_acc_patch(p) + matrix_c14transfer_acc(ifroot,ifroot) = -cs14_veg%matrix_cturnover_froot_acc_patch(p) + matrix_c14transfer_acc(ifroot_st,ifroot_st) = -cs14_veg%matrix_cturnover_frootst_acc_patch(p) + matrix_c14transfer_acc(ifroot_xf,ifroot_xf) = -cs14_veg%matrix_cturnover_frootxf_acc_patch(p) + matrix_c14transfer_acc(ilivestem,ilivestem) = -cs14_veg%matrix_cturnover_livestem_acc_patch(p) + matrix_c14transfer_acc(ilivestem_st,ilivestem_st) = -cs14_veg%matrix_cturnover_livestemst_acc_patch(p) + matrix_c14transfer_acc(ilivestem_xf,ilivestem_xf) = -cs14_veg%matrix_cturnover_livestemxf_acc_patch(p) + matrix_c14transfer_acc(ideadstem,ideadstem) = -cs14_veg%matrix_cturnover_deadstem_acc_patch(p) + matrix_c14transfer_acc(ideadstem_st,ideadstem_st) = -cs14_veg%matrix_cturnover_deadstemst_acc_patch(p) + matrix_c14transfer_acc(ideadstem_xf,ideadstem_xf) = -cs14_veg%matrix_cturnover_deadstemxf_acc_patch(p) + matrix_c14transfer_acc(ilivecroot,ilivecroot) = -cs14_veg%matrix_cturnover_livecroot_acc_patch(p) + matrix_c14transfer_acc(ilivecroot_st,ilivecroot_st) = -cs14_veg%matrix_cturnover_livecrootst_acc_patch(p) + matrix_c14transfer_acc(ilivecroot_xf,ilivecroot_xf) = -cs14_veg%matrix_cturnover_livecrootxf_acc_patch(p) + matrix_c14transfer_acc(ideadcroot,ideadcroot) = -cs14_veg%matrix_cturnover_deadcroot_acc_patch(p) + matrix_c14transfer_acc(ideadcroot_st,ideadcroot_st) = -cs14_veg%matrix_cturnover_deadcrootst_acc_patch(p) + matrix_c14transfer_acc(ideadcroot_xf,ideadcroot_xf) = -cs14_veg%matrix_cturnover_deadcrootxf_acc_patch(p) + if(ivt(p) >= npcropmin)then + matrix_c14transfer_acc(igrain,igrain) = -cs14_veg%matrix_cturnover_grain_acc_patch(p) + matrix_c14transfer_acc(igrain_st,igrain_st) = -cs14_veg%matrix_cturnover_grainst_acc_patch(p) + matrix_c14transfer_acc(igrain_xf,igrain_xf) = -cs14_veg%matrix_cturnover_grainxf_acc_patch(p) + end if + end if + + matrix_nalloc_acc(ileaf) = matrix_nalloc_leaf_acc(p) + matrix_nalloc_acc(ileaf_st) = matrix_nalloc_leafst_acc(p) + matrix_nalloc_acc(ifroot) = matrix_nalloc_froot_acc(p) + matrix_nalloc_acc(ifroot_st) = matrix_nalloc_frootst_acc(p) + matrix_nalloc_acc(ilivestem) = matrix_nalloc_livestem_acc(p) + matrix_nalloc_acc(ilivestem_st) = matrix_nalloc_livestemst_acc(p) + matrix_nalloc_acc(ideadstem) = matrix_nalloc_deadstem_acc(p) + matrix_nalloc_acc(ideadstem_st) = matrix_nalloc_deadstemst_acc(p) + matrix_nalloc_acc(ilivecroot) = matrix_nalloc_livecroot_acc(p) + matrix_nalloc_acc(ilivecroot_st) = matrix_nalloc_livecrootst_acc(p) + matrix_nalloc_acc(ideadcroot) = matrix_nalloc_deadcroot_acc(p) + matrix_nalloc_acc(ideadcroot_st) = matrix_nalloc_deadcrootst_acc(p) + if(ivt(p) >= npcropmin)then + matrix_nalloc_acc(igrain) = matrix_nalloc_grain_acc(p) + matrix_nalloc_acc(igrain_st) = matrix_nalloc_grainst_acc(p) + end if + + matrix_ntransfer_acc(ileaf_xf,ileaf_st) = matrix_ntransfer_leafst_to_leafxf_acc(p) + matrix_ntransfer_acc(ileaf,ileaf_xf) = matrix_ntransfer_leafxf_to_leaf_acc(p) + matrix_ntransfer_acc(ifroot_xf,ifroot_st) = matrix_ntransfer_frootst_to_frootxf_acc(p) + matrix_ntransfer_acc(ifroot,ifroot_xf) = matrix_ntransfer_frootxf_to_froot_acc(p) + matrix_ntransfer_acc(ilivestem_xf,ilivestem_st) = matrix_ntransfer_livestemst_to_livestemxf_acc(p) + matrix_ntransfer_acc(ilivestem,ilivestem_xf) = matrix_ntransfer_livestemxf_to_livestem_acc(p) + matrix_ntransfer_acc(ideadstem_xf,ideadstem_st) = matrix_ntransfer_deadstemst_to_deadstemxf_acc(p) + matrix_ntransfer_acc(ideadstem,ideadstem_xf) = matrix_ntransfer_deadstemxf_to_deadstem_acc(p) + matrix_ntransfer_acc(ilivecroot_xf,ilivecroot_st) = matrix_ntransfer_livecrootst_to_livecrootxf_acc(p) + matrix_ntransfer_acc(ilivecroot,ilivecroot_xf) = matrix_ntransfer_livecrootxf_to_livecroot_acc(p) + matrix_ntransfer_acc(ideadcroot_xf,ideadcroot_st) = matrix_ntransfer_deadcrootst_to_deadcrootxf_acc(p) + matrix_ntransfer_acc(ideadcroot,ideadcroot_xf) = matrix_ntransfer_deadcrootxf_to_deadcroot_acc(p) + if(ivt(p) >= npcropmin)then + matrix_ntransfer_acc(igrain_xf,igrain_st) = matrix_ntransfer_grainst_to_grainxf_acc(p) + matrix_ntransfer_acc(igrain,igrain_xf) = matrix_ntransfer_grainxf_to_grain_acc(p) + end if + matrix_ntransfer_acc(ideadstem,ilivestem) = matrix_ntransfer_livestem_to_deadstem_acc(p) + matrix_ntransfer_acc(ideadcroot,ilivecroot) = matrix_ntransfer_livecroot_to_deadcroot_acc(p) + + matrix_ntransfer_acc(ileaf,iretransn) = matrix_ntransfer_retransn_to_leaf_acc(p) + matrix_ntransfer_acc(ileaf_st,iretransn) = matrix_ntransfer_retransn_to_leafst_acc(p) + matrix_ntransfer_acc(ifroot,iretransn) = matrix_ntransfer_retransn_to_froot_acc(p) + matrix_ntransfer_acc(ifroot_st,iretransn) = matrix_ntransfer_retransn_to_frootst_acc(p) + matrix_ntransfer_acc(ilivestem,iretransn) = matrix_ntransfer_retransn_to_livestem_acc(p) + matrix_ntransfer_acc(ilivestem_st,iretransn) = matrix_ntransfer_retransn_to_livestemst_acc(p) + matrix_ntransfer_acc(ideadstem,iretransn) = matrix_ntransfer_retransn_to_deadstem_acc(p) + matrix_ntransfer_acc(ideadstem_st,iretransn) = matrix_ntransfer_retransn_to_deadstemst_acc(p) + matrix_ntransfer_acc(ilivecroot,iretransn) = matrix_ntransfer_retransn_to_livecroot_acc(p) + matrix_ntransfer_acc(ilivecroot_st,iretransn) = matrix_ntransfer_retransn_to_livecrootst_acc(p) + matrix_ntransfer_acc(ideadcroot,iretransn) = matrix_ntransfer_retransn_to_deadcroot_acc(p) + matrix_ntransfer_acc(ideadcroot_st,iretransn) = matrix_ntransfer_retransn_to_deadcrootst_acc(p) + if(ivt(p) >= npcropmin)then + matrix_ntransfer_acc(igrain,iretransn) = matrix_ntransfer_retransn_to_grain_acc(p) + matrix_ntransfer_acc(igrain_st,iretransn) = matrix_ntransfer_retransn_to_grainst_acc(p) + end if + matrix_ntransfer_acc(iretransn,ileaf) = matrix_ntransfer_leaf_to_retransn_acc(p) + matrix_ntransfer_acc(iretransn,ifroot) = matrix_ntransfer_froot_to_retransn_acc(p) + matrix_ntransfer_acc(iretransn,ilivestem) = matrix_ntransfer_livestem_to_retransn_acc(p) + matrix_ntransfer_acc(iretransn,ilivecroot) = matrix_ntransfer_livecroot_to_retransn_acc(p) + + matrix_ntransfer_acc(ileaf,ileaf) = -matrix_nturnover_leaf_acc(p) + matrix_ntransfer_acc(ileaf_st,ileaf_st) = -matrix_nturnover_leafst_acc(p) + matrix_ntransfer_acc(ileaf_xf,ileaf_xf) = -matrix_nturnover_leafxf_acc(p) + matrix_ntransfer_acc(ifroot,ifroot) = -matrix_nturnover_froot_acc(p) + matrix_ntransfer_acc(ifroot_st,ifroot_st) = -matrix_nturnover_frootst_acc(p) + matrix_ntransfer_acc(ifroot_xf,ifroot_xf) = -matrix_nturnover_frootxf_acc(p) + matrix_ntransfer_acc(ilivestem,ilivestem) = -matrix_nturnover_livestem_acc(p) + matrix_ntransfer_acc(ilivestem_st,ilivestem_st) = -matrix_nturnover_livestemst_acc(p) + matrix_ntransfer_acc(ilivestem_xf,ilivestem_xf) = -matrix_nturnover_livestemxf_acc(p) + matrix_ntransfer_acc(ideadstem,ideadstem) = -matrix_nturnover_deadstem_acc(p) + matrix_ntransfer_acc(ideadstem_st,ideadstem_st) = -matrix_nturnover_deadstemst_acc(p) + matrix_ntransfer_acc(ideadstem_xf,ideadstem_xf) = -matrix_nturnover_deadstemxf_acc(p) + matrix_ntransfer_acc(ilivecroot,ilivecroot) = -matrix_nturnover_livecroot_acc(p) + matrix_ntransfer_acc(ilivecroot_st,ilivecroot_st) = -matrix_nturnover_livecrootst_acc(p) + matrix_ntransfer_acc(ilivecroot_xf,ilivecroot_xf) = -matrix_nturnover_livecrootxf_acc(p) + matrix_ntransfer_acc(ideadcroot,ideadcroot) = -matrix_nturnover_deadcroot_acc(p) + matrix_ntransfer_acc(ideadcroot_st,ideadcroot_st) = -matrix_nturnover_deadcrootst_acc(p) + matrix_ntransfer_acc(ideadcroot_xf,ideadcroot_xf) = -matrix_nturnover_deadcrootxf_acc(p) + if(ivt(p) >= npcropmin)then + matrix_ntransfer_acc(igrain,igrain) = -matrix_nturnover_grain_acc(p) + matrix_ntransfer_acc(igrain_st,igrain_st) = -matrix_nturnover_grainst_acc(p) + matrix_ntransfer_acc(igrain_xf,igrain_xf) = -matrix_nturnover_grainxf_acc(p) + end if + matrix_ntransfer_acc(iretransn,iretransn) = -matrix_nturnover_retransn_acc(p) + + do i=1,nvegcpool + if(matrix_ctransfer_acc(i,i) .eq. 0)then + matrix_ctransfer_acc(i,i) = 1.e+36 + end if + end do + if(use_c13)then + do i=1,nvegcpool + if(matrix_c13transfer_acc(i,i) .eq. 0)then + matrix_c13transfer_acc(i,i) = 1.e+36 + end if + end do + end if + if(use_c14)then + do i=1,nvegcpool + if(matrix_c14transfer_acc(i,i) .eq. 0)then + matrix_c14transfer_acc(i,i) = 1.e+36 + end if + end do + end if + do i=1,nvegnpool + if(matrix_ntransfer_acc(i,i) .eq. 0)then + matrix_ntransfer_acc(i,i) = 1.e+36 + end if + end do + + ! Calculate the transfer rate based on the initial value of the calendar year. + matrix_ctransfer_acc(1:nvegcpool,ileaf) = matrix_ctransfer_acc(1:nvegcpool,ileaf) / leafc0(p) + matrix_ctransfer_acc(1:nvegcpool,ileaf_st) = matrix_ctransfer_acc(1:nvegcpool,ileaf_st) / leafc0_storage(p) + matrix_ctransfer_acc(1:nvegcpool,ileaf_xf) = matrix_ctransfer_acc(1:nvegcpool,ileaf_xf) / leafc0_xfer(p) + matrix_ctransfer_acc(1:nvegcpool,ifroot) = matrix_ctransfer_acc(1:nvegcpool,ifroot) / frootc0(p) + matrix_ctransfer_acc(1:nvegcpool,ifroot_st) = matrix_ctransfer_acc(1:nvegcpool,ifroot_st) / frootc0_storage(p) + matrix_ctransfer_acc(1:nvegcpool,ifroot_xf) = matrix_ctransfer_acc(1:nvegcpool,ifroot_xf) / frootc0_xfer(p) + matrix_ctransfer_acc(1:nvegcpool,ilivestem) = matrix_ctransfer_acc(1:nvegcpool,ilivestem) / livestemc0(p) + matrix_ctransfer_acc(1:nvegcpool,ilivestem_st) = matrix_ctransfer_acc(1:nvegcpool,ilivestem_st) / livestemc0_storage(p) + matrix_ctransfer_acc(1:nvegcpool,ilivestem_xf) = matrix_ctransfer_acc(1:nvegcpool,ilivestem_xf) / livestemc0_xfer(p) + matrix_ctransfer_acc(1:nvegcpool,ideadstem) = matrix_ctransfer_acc(1:nvegcpool,ideadstem) / deadstemc0(p) + matrix_ctransfer_acc(1:nvegcpool,ideadstem_st) = matrix_ctransfer_acc(1:nvegcpool,ideadstem_st) / deadstemc0_storage(p) + matrix_ctransfer_acc(1:nvegcpool,ideadstem_xf) = matrix_ctransfer_acc(1:nvegcpool,ideadstem_xf) / deadstemc0_xfer(p) + matrix_ctransfer_acc(1:nvegcpool,ilivecroot) = matrix_ctransfer_acc(1:nvegcpool,ilivecroot) / livecrootc0(p) + matrix_ctransfer_acc(1:nvegcpool,ilivecroot_st) = matrix_ctransfer_acc(1:nvegcpool,ilivecroot_st) / livecrootc0_storage(p) + matrix_ctransfer_acc(1:nvegcpool,ilivecroot_xf) = matrix_ctransfer_acc(1:nvegcpool,ilivecroot_xf) / livecrootc0_xfer(p) + matrix_ctransfer_acc(1:nvegcpool,ideadcroot) = matrix_ctransfer_acc(1:nvegcpool,ideadcroot) / deadcrootc0(p) + matrix_ctransfer_acc(1:nvegcpool,ideadcroot_st) = matrix_ctransfer_acc(1:nvegcpool,ideadcroot_st) / deadcrootc0_storage(p) + matrix_ctransfer_acc(1:nvegcpool,ideadcroot_xf) = matrix_ctransfer_acc(1:nvegcpool,ideadcroot_xf) / deadcrootc0_xfer(p) + if(ivt(p) >= npcropmin)then + matrix_ctransfer_acc(1:nvegcpool,igrain) = matrix_ctransfer_acc(1:nvegcpool,igrain) / grainc0(p) + matrix_ctransfer_acc(1:nvegcpool,igrain_st) = matrix_ctransfer_acc(1:nvegcpool,igrain_st) / grainc0_storage(p) + matrix_ctransfer_acc(1:nvegcpool,igrain_xf) = matrix_ctransfer_acc(1:nvegcpool,igrain_xf) / grainc0_xfer(p) + end if + + if(use_c13)then + matrix_c13transfer_acc(1:nvegcpool,ileaf) = matrix_c13transfer_acc(1:nvegcpool,ileaf) / cs13_veg%leafc0_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ileaf_st) = matrix_c13transfer_acc(1:nvegcpool,ileaf_st) / cs13_veg%leafc0_storage_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ileaf_xf) = matrix_c13transfer_acc(1:nvegcpool,ileaf_xf) / cs13_veg%leafc0_xfer_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ifroot) = matrix_c13transfer_acc(1:nvegcpool,ifroot) / cs13_veg%frootc0_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ifroot_st) = matrix_c13transfer_acc(1:nvegcpool,ifroot_st) / cs13_veg%frootc0_storage_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ifroot_xf) = matrix_c13transfer_acc(1:nvegcpool,ifroot_xf) / cs13_veg%frootc0_xfer_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ilivestem) = matrix_c13transfer_acc(1:nvegcpool,ilivestem) / cs13_veg%livestemc0_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ilivestem_st) = matrix_c13transfer_acc(1:nvegcpool,ilivestem_st) / cs13_veg%livestemc0_storage_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ilivestem_xf) = matrix_c13transfer_acc(1:nvegcpool,ilivestem_xf) / cs13_veg%livestemc0_xfer_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ideadstem) = matrix_c13transfer_acc(1:nvegcpool,ideadstem) / cs13_veg%deadstemc0_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ideadstem_st) = matrix_c13transfer_acc(1:nvegcpool,ideadstem_st) / cs13_veg%deadstemc0_storage_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ideadstem_xf) = matrix_c13transfer_acc(1:nvegcpool,ideadstem_xf) / cs13_veg%deadstemc0_xfer_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ilivecroot) = matrix_c13transfer_acc(1:nvegcpool,ilivecroot) / cs13_veg%livecrootc0_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ilivecroot_st) = matrix_c13transfer_acc(1:nvegcpool,ilivecroot_st) / cs13_veg%livecrootc0_storage_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ilivecroot_xf) = matrix_c13transfer_acc(1:nvegcpool,ilivecroot_xf) / cs13_veg%livecrootc0_xfer_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ideadcroot) = matrix_c13transfer_acc(1:nvegcpool,ideadcroot) / cs13_veg%deadcrootc0_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ideadcroot_st) = matrix_c13transfer_acc(1:nvegcpool,ideadcroot_st) / cs13_veg%deadcrootc0_storage_patch(p) + matrix_c13transfer_acc(1:nvegcpool,ideadcroot_xf) = matrix_c13transfer_acc(1:nvegcpool,ideadcroot_xf) / cs13_veg%deadcrootc0_xfer_patch(p) + if(ivt(p) >= npcropmin)then + matrix_c13transfer_acc(1:nvegcpool,igrain) = matrix_c13transfer_acc(1:nvegcpool,igrain) / cs13_veg%grainc0_patch(p) + matrix_c13transfer_acc(1:nvegcpool,igrain_st) = matrix_c13transfer_acc(1:nvegcpool,igrain_st) / cs13_veg%grainc0_storage_patch(p) + matrix_c13transfer_acc(1:nvegcpool,igrain_xf) = matrix_c13transfer_acc(1:nvegcpool,igrain_xf) / cs13_veg%grainc0_xfer_patch(p) + end if + end if + + if(use_c14)then + matrix_c14transfer_acc(1:nvegcpool,ileaf) = matrix_c14transfer_acc(1:nvegcpool,ileaf) / cs14_veg%leafc0_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ileaf_st) = matrix_c14transfer_acc(1:nvegcpool,ileaf_st) / cs14_veg%leafc0_storage_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ileaf_xf) = matrix_c14transfer_acc(1:nvegcpool,ileaf_xf) / cs14_veg%leafc0_xfer_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ifroot) = matrix_c14transfer_acc(1:nvegcpool,ifroot) / cs14_veg%frootc0_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ifroot_st) = matrix_c14transfer_acc(1:nvegcpool,ifroot_st) / cs14_veg%frootc0_storage_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ifroot_xf) = matrix_c14transfer_acc(1:nvegcpool,ifroot_xf) / cs14_veg%frootc0_xfer_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ilivestem) = matrix_c14transfer_acc(1:nvegcpool,ilivestem) / cs14_veg%livestemc0_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ilivestem_st) = matrix_c14transfer_acc(1:nvegcpool,ilivestem_st) / cs14_veg%livestemc0_storage_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ilivestem_xf) = matrix_c14transfer_acc(1:nvegcpool,ilivestem_xf) / cs14_veg%livestemc0_xfer_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ideadstem) = matrix_c14transfer_acc(1:nvegcpool,ideadstem) / cs14_veg%deadstemc0_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ideadstem_st) = matrix_c14transfer_acc(1:nvegcpool,ideadstem_st) / cs14_veg%deadstemc0_storage_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ideadstem_xf) = matrix_c14transfer_acc(1:nvegcpool,ideadstem_xf) / cs14_veg%deadstemc0_xfer_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ilivecroot) = matrix_c14transfer_acc(1:nvegcpool,ilivecroot) / cs14_veg%livecrootc0_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ilivecroot_st) = matrix_c14transfer_acc(1:nvegcpool,ilivecroot_st) / cs14_veg%livecrootc0_storage_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ilivecroot_xf) = matrix_c14transfer_acc(1:nvegcpool,ilivecroot_xf) / cs14_veg%livecrootc0_xfer_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ideadcroot) = matrix_c14transfer_acc(1:nvegcpool,ideadcroot) / cs14_veg%deadcrootc0_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ideadcroot_st) = matrix_c14transfer_acc(1:nvegcpool,ideadcroot_st) / cs14_veg%deadcrootc0_storage_patch(p) + matrix_c14transfer_acc(1:nvegcpool,ideadcroot_xf) = matrix_c14transfer_acc(1:nvegcpool,ideadcroot_xf) / cs14_veg%deadcrootc0_xfer_patch(p) + if(ivt(p) >= npcropmin)then + matrix_c14transfer_acc(1:nvegcpool,igrain) = matrix_c14transfer_acc(1:nvegcpool,igrain) / cs14_veg%grainc0_patch(p) + matrix_c14transfer_acc(1:nvegcpool,igrain_st) = matrix_c14transfer_acc(1:nvegcpool,igrain_st) / cs14_veg%grainc0_storage_patch(p) + matrix_c14transfer_acc(1:nvegcpool,igrain_xf) = matrix_c14transfer_acc(1:nvegcpool,igrain_xf) / cs14_veg%grainc0_xfer_patch(p) + end if + end if + + matrix_ntransfer_acc(1:nvegnpool,ileaf) = matrix_ntransfer_acc(1:nvegnpool,ileaf) / leafn0(p) + matrix_ntransfer_acc(1:nvegnpool,ileaf_st) = matrix_ntransfer_acc(1:nvegnpool,ileaf_st) / leafn0_storage(p) + matrix_ntransfer_acc(1:nvegnpool,ileaf_xf) = matrix_ntransfer_acc(1:nvegnpool,ileaf_xf) / leafn0_xfer(p) + matrix_ntransfer_acc(1:nvegnpool,ifroot) = matrix_ntransfer_acc(1:nvegnpool,ifroot) / frootn0(p) + matrix_ntransfer_acc(1:nvegnpool,ifroot_st) = matrix_ntransfer_acc(1:nvegnpool,ifroot_st) / frootn0_storage(p) + matrix_ntransfer_acc(1:nvegnpool,ifroot_xf) = matrix_ntransfer_acc(1:nvegnpool,ifroot_xf) / frootn0_xfer(p) + matrix_ntransfer_acc(1:nvegnpool,ilivestem) = matrix_ntransfer_acc(1:nvegnpool,ilivestem) / livestemn0(p) + matrix_ntransfer_acc(1:nvegnpool,ilivestem_st) = matrix_ntransfer_acc(1:nvegnpool,ilivestem_st) / livestemn0_storage(p) + matrix_ntransfer_acc(1:nvegnpool,ilivestem_xf) = matrix_ntransfer_acc(1:nvegnpool,ilivestem_xf) / livestemn0_xfer(p) + matrix_ntransfer_acc(1:nvegnpool,ideadstem) = matrix_ntransfer_acc(1:nvegnpool,ideadstem) / deadstemn0(p) + matrix_ntransfer_acc(1:nvegnpool,ideadstem_st) = matrix_ntransfer_acc(1:nvegnpool,ideadstem_st) / deadstemn0_storage(p) + matrix_ntransfer_acc(1:nvegnpool,ideadstem_xf) = matrix_ntransfer_acc(1:nvegnpool,ideadstem_xf) / deadstemn0_xfer(p) + matrix_ntransfer_acc(1:nvegnpool,ilivecroot) = matrix_ntransfer_acc(1:nvegnpool,ilivecroot) / livecrootn0(p) + matrix_ntransfer_acc(1:nvegnpool,ilivecroot_st) = matrix_ntransfer_acc(1:nvegnpool,ilivecroot_st) / livecrootn0_storage(p) + matrix_ntransfer_acc(1:nvegnpool,ilivecroot_xf) = matrix_ntransfer_acc(1:nvegnpool,ilivecroot_xf) / livecrootn0_xfer(p) + matrix_ntransfer_acc(1:nvegnpool,ideadcroot) = matrix_ntransfer_acc(1:nvegnpool,ideadcroot) / deadcrootn0(p) + matrix_ntransfer_acc(1:nvegnpool,ideadcroot_st) = matrix_ntransfer_acc(1:nvegnpool,ideadcroot_st) / deadcrootn0_storage(p) + matrix_ntransfer_acc(1:nvegnpool,ideadcroot_xf) = matrix_ntransfer_acc(1:nvegnpool,ideadcroot_xf) / deadcrootn0_xfer(p) + if(ivt(p) >= npcropmin)then + matrix_ntransfer_acc(1:nvegnpool,igrain) = matrix_ntransfer_acc(1:nvegnpool,igrain) / grainn0(p) + matrix_ntransfer_acc(1:nvegnpool,igrain_st) = matrix_ntransfer_acc(1:nvegnpool,igrain_st) / grainn0_storage(p) + matrix_ntransfer_acc(1:nvegnpool,igrain_xf) = matrix_ntransfer_acc(1:nvegnpool,igrain_xf) / grainn0_xfer(p) + end if + matrix_ntransfer_acc(1:nvegnpool,iretransn) = matrix_ntransfer_acc(1:nvegnpool,iretransn) / retransn0(p) + + call t_stopf('CN veg matrix-prepare AK^-1') + call t_startf('CN veg matrix-inv matrix operation') + + ! Calculate the residence time and C storage capacity + call inverse(matrix_ctransfer_acc(1:nvegcpool,1:nvegcpool),AKinvc(1:nvegcpool,1:nvegcpool),nvegcpool) + vegmatrixc_rt(:) = -matmul(AKinvc(1:nvegcpool,1:nvegcpool),matrix_calloc_acc(1:nvegcpool)) + + ! Calculate the residence time and C13 storage capacity + if(use_c13)then + call inverse(matrix_c13transfer_acc(1:nvegcpool,1:nvegcpool),AKinvc(1:nvegcpool,1:nvegcpool),nvegcpool) + vegmatrixc13_rt(:) = -matmul(AKinvc(1:nvegcpool,1:nvegcpool),matrix_c13alloc_acc(1:nvegcpool)) + end if + + ! Calculate the residence time and C14 storage capacity + if(use_c14)then + call inverse(matrix_c14transfer_acc(1:nvegcpool,1:nvegcpool),AKinvc(1:nvegcpool,1:nvegcpool),nvegcpool) + vegmatrixc14_rt(:) = -matmul(AKinvc(1:nvegcpool,1:nvegcpool),matrix_c14alloc_acc(1:nvegcpool)) + end if + + ! Calculate the residence time and N storage capacity + call inverse(matrix_ntransfer_acc(1:nvegnpool,1:nvegnpool),AKinvn(1:nvegnpool,1:nvegnpool),nvegnpool) + vegmatrixn_rt(:) = -matmul(AKinvn(1:nvegnpool,1:nvegnpool),matrix_nalloc_acc(1:nvegnpool)) + + do i=1,nvegcpool + if(vegmatrixc_rt(i) .lt. 0)vegmatrixc_rt(i) = epsi + end do + if(use_c13)then + do i=1,nvegcpool + if(vegmatrixc13_rt(i) .lt. 0)vegmatrixc13_rt(i) = epsi + end do + end if + if(use_c14)then + do i=1,nvegcpool + if(vegmatrixc14_rt(i) .lt. 0)vegmatrixc14_rt(i) = epsi + end do + end if + do i=1,nvegnpool + if(vegmatrixn_rt(i) .lt. 0)vegmatrixn_rt(i) = epsi + end do + + call t_stopf('CN veg matrix-inv matrix operation') + + call t_startf('CN veg matrix-finalize spinup') + + if(isspinup .and. .not. is_first_step_of_this_run_segment())then + deadstemc(p) = vegmatrixc_rt(ideadstem) + deadstemc_storage(p) = vegmatrixc_rt(ideadstem_st) + deadcrootc(p) = vegmatrixc_rt(ideadcroot) + deadcrootc_storage(p) = vegmatrixc_rt(ideadcroot_st) + if(use_c13)then + cs13_veg%deadstemc_patch(p) = vegmatrixc13_rt(ideadstem) + cs13_veg%deadstemc_storage_patch(p) = vegmatrixc13_rt(ideadstem_st) + cs13_veg%deadcrootc_patch(p) = vegmatrixc13_rt(ideadcroot) + cs13_veg%deadcrootc_storage_patch(p) = vegmatrixc13_rt(ideadcroot_st) + end if + if(use_c14)then + cs14_veg%deadstemc_patch(p) = vegmatrixc14_rt(ideadstem) + cs14_veg%deadstemc_storage_patch(p) = vegmatrixc14_rt(ideadstem_st) + cs14_veg%deadcrootc_patch(p) = vegmatrixc14_rt(ideadcroot) + cs14_veg%deadcrootc_storage_patch(p) = vegmatrixc14_rt(ideadcroot_st) + end if + deadstemn(p) = vegmatrixn_rt(ideadstem) + deadstemn_storage(p) = vegmatrixn_rt(ideadstem_st) + deadcrootn(p) = vegmatrixn_rt(ideadcroot) + deadcrootn_storage(p) = vegmatrixn_rt(ideadcroot_st) + + if(iloop .eq. iloop_avg)then + leafc_SASUsave(p) = leafc_SASUsave(p) + leafc(p) + leafc_storage_SASUsave(p) = leafc_storage_SASUsave(p) + leafc_storage(p) + leafc_xfer_SASUsave(p) = leafc_xfer_SASUsave(p) + leafc_xfer(p) + frootc_SASUsave(p) = frootc_SASUsave(p) + frootc(p) + frootc_storage_SASUsave(p) = frootc_storage_SASUsave(p) + frootc_storage(p) + frootc_xfer_SASUsave(p) = frootc_xfer_SASUsave(p) + frootc_xfer(p) + livestemc_SASUsave(p) = livestemc_SASUsave(p) + livestemc(p) + livestemc_storage_SASUsave(p) = livestemc_storage_SASUsave(p) + livestemc_storage(p) + livestemc_xfer_SASUsave(p) = livestemc_xfer_SASUsave(p) + livestemc_xfer(p) + deadstemc_SASUsave(p) = deadstemc_SASUsave(p) + deadstemc(p) + deadstemc_storage_SASUsave(p) = deadstemc_storage_SASUsave(p) + deadstemc_storage(p) + deadstemc_xfer_SASUsave(p) = deadstemc_xfer_SASUsave(p) + deadstemc_xfer(p) + livecrootc_SASUsave(p) = livecrootc_SASUsave(p) + livecrootc(p) + livecrootc_storage_SASUsave(p) = livecrootc_storage_SASUsave(p) + livecrootc_storage(p) + livecrootc_xfer_SASUsave(p) = livecrootc_xfer_SASUsave(p) + livecrootc_xfer(p) + deadcrootc_SASUsave(p) = deadcrootc_SASUsave(p) + deadcrootc(p) + deadcrootc_storage_SASUsave(p) = deadcrootc_storage_SASUsave(p) + deadcrootc_storage(p) + deadcrootc_xfer_SASUsave(p) = deadcrootc_xfer_SASUsave(p) + deadcrootc_xfer(p) + if(ivt(p) >= npcropmin)then + grainc_SASUsave(p) = grainc_SASUsave(p) + grainc(p) + grainc_storage_SASUsave(p) = grainc_storage_SASUsave(p) + grainc_storage(p) + end if + if(use_c13)then + cs13_veg%leafc_SASUsave_patch(p) = cs13_veg%leafc_SASUsave_patch(p) + cs13_veg%leafc_patch(p) + cs13_veg%leafc_storage_SASUsave_patch(p) = cs13_veg%leafc_storage_SASUsave_patch(p) + cs13_veg%leafc_storage_patch(p) + cs13_veg%leafc_xfer_SASUsave_patch(p) = cs13_veg%leafc_xfer_SASUsave_patch(p) + cs13_veg%leafc_xfer_patch(p) + cs13_veg%frootc_SASUsave_patch(p) = cs13_veg%frootc_SASUsave_patch(p) + cs13_veg%frootc_patch(p) + cs13_veg%frootc_storage_SASUsave_patch(p) = cs13_veg%frootc_storage_SASUsave_patch(p) + cs13_veg%frootc_storage_patch(p) + cs13_veg%frootc_xfer_SASUsave_patch(p) = cs13_veg%frootc_xfer_SASUsave_patch(p) + cs13_veg%frootc_xfer_patch(p) + cs13_veg%livestemc_SASUsave_patch(p) = cs13_veg%livestemc_SASUsave_patch(p) + cs13_veg%livestemc_patch(p) + cs13_veg%livestemc_storage_SASUsave_patch(p) = cs13_veg%livestemc_storage_SASUsave_patch(p) + cs13_veg%livestemc_storage_patch(p) + cs13_veg%livestemc_xfer_SASUsave_patch(p) = cs13_veg%livestemc_xfer_SASUsave_patch(p) + cs13_veg%livestemc_xfer_patch(p) + cs13_veg%deadstemc_SASUsave_patch(p) = cs13_veg%deadstemc_SASUsave_patch(p) + cs13_veg%deadstemc_patch(p) + cs13_veg%deadstemc_storage_SASUsave_patch(p) = cs13_veg%deadstemc_storage_SASUsave_patch(p) + cs13_veg%deadstemc_storage_patch(p) + cs13_veg%deadstemc_xfer_SASUsave_patch(p) = cs13_veg%deadstemc_xfer_SASUsave_patch(p) + cs13_veg%deadstemc_xfer_patch(p) + cs13_veg%livecrootc_SASUsave_patch(p) = cs13_veg%livecrootc_SASUsave_patch(p) + cs13_veg%livecrootc_patch(p) + cs13_veg%livecrootc_storage_SASUsave_patch(p) = cs13_veg%livecrootc_storage_SASUsave_patch(p) + cs13_veg%livecrootc_storage_patch(p) + cs13_veg%livecrootc_xfer_SASUsave_patch(p) = cs13_veg%livecrootc_xfer_SASUsave_patch(p) + cs13_veg%livecrootc_xfer_patch(p) + cs13_veg%deadcrootc_SASUsave_patch(p) = cs13_veg%deadcrootc_SASUsave_patch(p) + cs13_veg%deadcrootc_patch(p) + cs13_veg%deadcrootc_storage_SASUsave_patch(p) = cs13_veg%deadcrootc_storage_SASUsave_patch(p) + cs13_veg%deadcrootc_storage_patch(p) + cs13_veg%deadcrootc_xfer_SASUsave_patch(p) = cs13_veg%deadcrootc_xfer_SASUsave_patch(p) + cs13_veg%deadcrootc_xfer_patch(p) + if(ivt(p) >= npcropmin)then + cs13_veg%grainc_SASUsave_patch(p) = cs13_veg%grainc_SASUsave_patch(p) + cs13_veg%grainc_patch(p) + cs13_veg%grainc_storage_SASUsave_patch(p) = cs13_veg%grainc_storage_SASUsave_patch(p) + cs13_veg%grainc_storage_patch(p) + end if + end if + if(use_c14)then + cs14_veg%leafc_SASUsave_patch(p) = cs14_veg%leafc_SASUsave_patch(p) + cs14_veg%leafc_patch(p) + cs14_veg%leafc_storage_SASUsave_patch(p) = cs14_veg%leafc_storage_SASUsave_patch(p) + cs14_veg%leafc_storage_patch(p) + cs14_veg%leafc_xfer_SASUsave_patch(p) = cs14_veg%leafc_xfer_SASUsave_patch(p) + cs14_veg%leafc_xfer_patch(p) + cs14_veg%frootc_SASUsave_patch(p) = cs14_veg%frootc_SASUsave_patch(p) + cs14_veg%frootc_patch(p) + cs14_veg%frootc_storage_SASUsave_patch(p) = cs14_veg%frootc_storage_SASUsave_patch(p) + cs14_veg%frootc_storage_patch(p) + cs14_veg%frootc_xfer_SASUsave_patch(p) = cs14_veg%frootc_xfer_SASUsave_patch(p) + cs14_veg%frootc_xfer_patch(p) + cs14_veg%livestemc_SASUsave_patch(p) = cs14_veg%livestemc_SASUsave_patch(p) + cs14_veg%livestemc_patch(p) + cs14_veg%livestemc_storage_SASUsave_patch(p) = cs14_veg%livestemc_storage_SASUsave_patch(p) + cs14_veg%livestemc_storage_patch(p) + cs14_veg%livestemc_xfer_SASUsave_patch(p) = cs14_veg%livestemc_xfer_SASUsave_patch(p) + cs14_veg%livestemc_xfer_patch(p) + cs14_veg%deadstemc_SASUsave_patch(p) = cs14_veg%deadstemc_SASUsave_patch(p) + cs14_veg%deadstemc_patch(p) + cs14_veg%deadstemc_storage_SASUsave_patch(p) = cs14_veg%deadstemc_storage_SASUsave_patch(p) + cs14_veg%deadstemc_storage_patch(p) + cs14_veg%deadstemc_xfer_SASUsave_patch(p) = cs14_veg%deadstemc_xfer_SASUsave_patch(p) + cs14_veg%deadstemc_xfer_patch(p) + cs14_veg%livecrootc_SASUsave_patch(p) = cs14_veg%livecrootc_SASUsave_patch(p) + cs14_veg%livecrootc_patch(p) + cs14_veg%livecrootc_storage_SASUsave_patch(p) = cs14_veg%livecrootc_storage_SASUsave_patch(p) + cs14_veg%livecrootc_storage_patch(p) + cs14_veg%livecrootc_xfer_SASUsave_patch(p) = cs14_veg%livecrootc_xfer_SASUsave_patch(p) + cs14_veg%livecrootc_xfer_patch(p) + cs14_veg%deadcrootc_SASUsave_patch(p) = cs14_veg%deadcrootc_SASUsave_patch(p) + cs14_veg%deadcrootc_patch(p) + cs14_veg%deadcrootc_storage_SASUsave_patch(p) = cs14_veg%deadcrootc_storage_SASUsave_patch(p) + cs14_veg%deadcrootc_storage_patch(p) + cs14_veg%deadcrootc_xfer_SASUsave_patch(p) = cs14_veg%deadcrootc_xfer_SASUsave_patch(p) + cs14_veg%deadcrootc_xfer_patch(p) + if(ivt(p) >= npcropmin)then + cs14_veg%grainc_SASUsave_patch(p) = cs14_veg%grainc_SASUsave_patch(p) + cs14_veg%grainc_patch(p) + cs14_veg%grainc_storage_SASUsave_patch(p) = cs14_veg%grainc_storage_SASUsave_patch(p) + cs14_veg%grainc_storage_patch(p) + end if + end if + leafn_SASUsave(p) = leafn_SASUsave(p) + leafn(p) + leafn_storage_SASUsave(p) = leafn_storage_SASUsave(p) + leafn_storage(p) + leafn_xfer_SASUsave(p) = leafn_xfer_SASUsave(p) + leafn_xfer(p) + frootn_SASUsave(p) = frootn_SASUsave(p) + frootn(p) + frootn_storage_SASUsave(p) = frootn_storage_SASUsave(p) + frootn_storage(p) + frootn_xfer_SASUsave(p) = frootn_xfer_SASUsave(p) + frootn_xfer(p) + livestemn_SASUsave(p) = livestemn_SASUsave(p) + livestemn(p) + livestemn_storage_SASUsave(p) = livestemn_storage_SASUsave(p) + livestemn_storage(p) + livestemn_xfer_SASUsave(p) = livestemn_xfer_SASUsave(p) + livestemn_xfer(p) + deadstemn_SASUsave(p) = deadstemn_SASUsave(p) + deadstemn(p) + deadstemn_storage_SASUsave(p) = deadstemn_storage_SASUsave(p) + deadstemn_storage(p) + deadstemn_xfer_SASUsave(p) = deadstemn_xfer_SASUsave(p) + deadstemn_xfer(p) + livecrootn_SASUsave(p) = livecrootn_SASUsave(p) + livecrootn(p) + livecrootn_storage_SASUsave(p) = livecrootn_storage_SASUsave(p) + livecrootn_storage(p) + livecrootn_xfer_SASUsave(p) = livecrootn_xfer_SASUsave(p) + livecrootn_xfer(p) + deadcrootn_SASUsave(p) = deadcrootn_SASUsave(p) + deadcrootn(p) + deadcrootn_storage_SASUsave(p) = deadcrootn_storage_SASUsave(p) + deadcrootn_storage(p) + deadcrootn_xfer_SASUsave(p) = deadcrootn_xfer_SASUsave(p) + deadcrootn_xfer(p) + if(ivt(p) >= npcropmin)then + grainn_SASUsave(p) = grainn_SASUsave(p) + grainn(p) + end if + if(iyr .eq. nyr_forcing)then + leafc(p) = leafc_SASUsave(p) / (nyr_forcing/nyr_SASU) + leafc_storage(p) = leafc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + leafc_xfer(p) = leafc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + frootc(p) = frootc_SASUsave(p) / (nyr_forcing/nyr_SASU) + frootc_storage(p) = frootc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + frootc_xfer(p) = frootc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + livestemc(p) = livestemc_SASUsave(p) / (nyr_forcing/nyr_SASU) + livestemc_storage(p) = livestemc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + livestemc_xfer(p) = livestemc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadstemc(p) = deadstemc_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadstemc_storage(p) = deadstemc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadstemc_xfer(p) = deadstemc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + livecrootc(p) = livecrootc_SASUsave(p) / (nyr_forcing/nyr_SASU) + livecrootc_storage(p) = livecrootc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + livecrootc_xfer(p) = livecrootc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadcrootc(p) = deadcrootc_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadcrootc_storage(p) = deadcrootc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadcrootc_xfer(p) = deadcrootc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + if(ivt(p) >= npcropmin)then + grainc(p) = grainc_SASUsave(p) / (nyr_forcing/nyr_SASU) + grainc_storage(p) = grainc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + end if + if(use_c13)then + cs13_veg%leafc_patch(p) = cs13_veg%leafc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%leafc_storage_patch(p) = cs13_veg%leafc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%leafc_xfer_patch(p) = cs13_veg%leafc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%frootc_patch(p) = cs13_veg%frootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%frootc_storage_patch(p) = cs13_veg%frootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%frootc_xfer_patch(p) = cs13_veg%frootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%livestemc_patch(p) = cs13_veg%livestemc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%livestemc_storage_patch(p) = cs13_veg%livestemc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%livestemc_xfer_patch(p) = cs13_veg%livestemc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%deadstemc_patch(p) = cs13_veg%deadstemc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%deadstemc_storage_patch(p) = cs13_veg%deadstemc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%deadstemc_xfer_patch(p) = cs13_veg%deadstemc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%livecrootc_patch(p) = cs13_veg%livecrootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%livecrootc_storage_patch(p) = cs13_veg%livecrootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%livecrootc_xfer_patch(p) = cs13_veg%livecrootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%deadcrootc_patch(p) = cs13_veg%deadcrootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%deadcrootc_storage_patch(p) = cs13_veg%deadcrootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%deadcrootc_xfer_patch(p) = cs13_veg%deadcrootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + if(ivt(p) >= npcropmin)then + cs13_veg%grainc_patch(p) = cs13_veg%grainc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs13_veg%grainc_storage_patch(p) = cs13_veg%grainc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + end if + end if + if(use_c14)then + cs14_veg%leafc_patch(p) = cs14_veg%leafc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%leafc_storage_patch(p) = cs14_veg%leafc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%leafc_xfer_patch(p) = cs14_veg%leafc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%frootc_patch(p) = cs14_veg%frootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%frootc_storage_patch(p) = cs14_veg%frootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%frootc_xfer_patch(p) = cs14_veg%frootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%livestemc_patch(p) = cs14_veg%livestemc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%livestemc_storage_patch(p) = cs14_veg%livestemc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%livestemc_xfer_patch(p) = cs14_veg%livestemc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%deadstemc_patch(p) = cs14_veg%deadstemc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%deadstemc_storage_patch(p) = cs14_veg%deadstemc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%deadstemc_xfer_patch(p) = cs14_veg%deadstemc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%livecrootc_patch(p) = cs14_veg%livecrootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%livecrootc_storage_patch(p) = cs14_veg%livecrootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%livecrootc_xfer_patch(p) = cs14_veg%livecrootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%deadcrootc_patch(p) = cs14_veg%deadcrootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%deadcrootc_storage_patch(p) = cs14_veg%deadcrootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%deadcrootc_xfer_patch(p) = cs14_veg%deadcrootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + if(ivt(p) >= npcropmin)then + cs14_veg%grainc_patch(p) = cs14_veg%grainc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + cs14_veg%grainc_storage_patch(p) = cs14_veg%grainc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) + end if + end if + leafn(p) = leafn_SASUsave(p) / (nyr_forcing/nyr_SASU) + leafn_storage(p) = leafn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + leafn_xfer(p) = leafn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + frootn(p) = frootn_SASUsave(p) / (nyr_forcing/nyr_SASU) + frootn_storage(p) = frootn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + frootn_xfer(p) = frootn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + livestemn(p) = livestemn_SASUsave(p) / (nyr_forcing/nyr_SASU) + livestemn_storage(p) = livestemn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + livestemn_xfer(p) = livestemn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadstemn(p) = deadstemn_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadstemn_storage(p) = deadstemn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadstemn_xfer(p) = deadstemn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + livecrootn(p) = livecrootn_SASUsave(p) / (nyr_forcing/nyr_SASU) + livecrootn_storage(p) = livecrootn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + livecrootn_xfer(p) = livecrootn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadcrootn(p) = deadcrootn_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadcrootn_storage(p) = deadcrootn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) + deadcrootn_xfer(p) = deadcrootn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) + if(ivt(p) >= npcropmin)then + grainn(p) = grainn_SASUsave(p) / (nyr_forcing/nyr_SASU) + end if + leafc_SASUsave(p) = 0 + leafc_storage_SASUsave(p) = 0 + leafc_xfer_SASUsave(p) = 0 + frootc_SASUsave(p) = 0 + frootc_storage_SASUsave(p) = 0 + frootc_xfer_SASUsave(p) = 0 + livestemc_SASUsave(p) = 0 + livestemc_storage_SASUsave(p) = 0 + livestemc_xfer_SASUsave(p) = 0 + deadstemc_SASUsave(p) = 0 + deadstemc_storage_SASUsave(p) = 0 + deadstemc_xfer_SASUsave(p) = 0 + livecrootc_SASUsave(p) = 0 + livecrootc_storage_SASUsave(p) = 0 + livecrootc_xfer_SASUsave(p) = 0 + deadcrootc_SASUsave(p) = 0 + deadcrootc_storage_SASUsave(p) = 0 + deadcrootc_xfer_SASUsave(p) = 0 + if(ivt(p) >= npcropmin)then + grainc_SASUsave(p) = 0 + grainc_storage_SASUsave(p) = 0 + end if + if(use_c13)then + cs13_veg%leafc_SASUsave_patch(p) = 0 + cs13_veg%leafc_storage_SASUsave_patch(p) = 0 + cs13_veg%leafc_xfer_SASUsave_patch(p) = 0 + cs13_veg%frootc_SASUsave_patch(p) = 0 + cs13_veg%frootc_storage_SASUsave_patch(p) = 0 + cs13_veg%frootc_xfer_SASUsave_patch(p) = 0 + cs13_veg%livestemc_SASUsave_patch(p) = 0 + cs13_veg%livestemc_storage_SASUsave_patch(p) = 0 + cs13_veg%livestemc_xfer_SASUsave_patch(p) = 0 + cs13_veg%deadstemc_SASUsave_patch(p) = 0 + cs13_veg%deadstemc_storage_SASUsave_patch(p) = 0 + cs13_veg%deadstemc_xfer_SASUsave_patch(p) = 0 + cs13_veg%livecrootc_SASUsave_patch(p) = 0 + cs13_veg%livecrootc_storage_SASUsave_patch(p) = 0 + cs13_veg%livecrootc_xfer_SASUsave_patch(p) = 0 + cs13_veg%deadcrootc_SASUsave_patch(p) = 0 + cs13_veg%deadcrootc_storage_SASUsave_patch(p) = 0 + cs13_veg%deadcrootc_xfer_SASUsave_patch(p) = 0 + if(ivt(p) >= npcropmin)then + cs13_veg%grainc_SASUsave_patch(p) = 0 + cs13_veg%grainc_storage_SASUsave_patch(p) = 0 + end if + end if + if(use_c14)then + cs14_veg%leafc_SASUsave_patch(p) = 0 + cs14_veg%leafc_storage_SASUsave_patch(p) = 0 + cs14_veg%leafc_xfer_SASUsave_patch(p) = 0 + cs14_veg%frootc_SASUsave_patch(p) = 0 + cs14_veg%frootc_storage_SASUsave_patch(p) = 0 + cs14_veg%frootc_xfer_SASUsave_patch(p) = 0 + cs14_veg%livestemc_SASUsave_patch(p) = 0 + cs14_veg%livestemc_storage_SASUsave_patch(p) = 0 + cs14_veg%livestemc_xfer_SASUsave_patch(p) = 0 + cs14_veg%deadstemc_SASUsave_patch(p) = 0 + cs14_veg%deadstemc_storage_SASUsave_patch(p) = 0 + cs14_veg%deadstemc_xfer_SASUsave_patch(p) = 0 + cs14_veg%livecrootc_SASUsave_patch(p) = 0 + cs14_veg%livecrootc_storage_SASUsave_patch(p) = 0 + cs14_veg%livecrootc_xfer_SASUsave_patch(p) = 0 + cs14_veg%deadcrootc_SASUsave_patch(p) = 0 + cs14_veg%deadcrootc_storage_SASUsave_patch(p) = 0 + cs14_veg%deadcrootc_xfer_SASUsave_patch(p) = 0 + if(ivt(p) >= npcropmin)then + cs14_veg%grainc_SASUsave_patch(p) = 0 + cs14_veg%grainc_storage_SASUsave_patch(p) = 0 + end if + end if + leafn_SASUsave(p) = 0 + leafn_storage_SASUsave(p) = 0 + leafn_xfer_SASUsave(p) = 0 + frootn_SASUsave(p) = 0 + frootn_storage_SASUsave(p) = 0 + frootn_xfer_SASUsave(p) = 0 + livestemn_SASUsave(p) = 0 + livestemn_storage_SASUsave(p) = 0 + livestemn_xfer_SASUsave(p) = 0 + deadstemn_SASUsave(p) = 0 + deadstemn_storage_SASUsave(p) = 0 + deadstemn_xfer_SASUsave(p) = 0 + livecrootn_SASUsave(p) = 0 + livecrootn_storage_SASUsave(p) = 0 + livecrootn_xfer_SASUsave(p) = 0 + deadcrootn_SASUsave(p) = 0 + deadcrootn_storage_SASUsave(p) = 0 + deadcrootn_xfer_SASUsave(p) = 0 + if(ivt(p) >= npcropmin)then + grainn_SASUsave(p) = 0 + end if + end if + end if + call update_DA_nstep() + end if + + ! Save C storage capacity from temporary variables to module variables + if(is_outmatrix)then + matrix_cap_leafc(p) = vegmatrixc_rt(ileaf) + matrix_cap_leafc_storage(p) = vegmatrixc_rt(ileaf_st) + matrix_cap_leafc_xfer(p) = vegmatrixc_rt(ileaf_xf) + matrix_cap_frootc(p) = vegmatrixc_rt(ifroot) + matrix_cap_frootc_storage(p) = vegmatrixc_rt(ifroot_st) + matrix_cap_frootc_xfer(p) = vegmatrixc_rt(ifroot_xf) + matrix_cap_livestemc(p) = vegmatrixc_rt(ilivestem) + matrix_cap_livestemc_storage(p) = vegmatrixc_rt(ilivestem_st) + matrix_cap_livestemc_xfer(p) = vegmatrixc_rt(ilivestem_xf) + matrix_cap_deadstemc(p) = vegmatrixc_rt(ideadstem) + matrix_cap_deadstemc_storage(p) = vegmatrixc_rt(ideadstem_st) + matrix_cap_deadstemc_xfer(p) = vegmatrixc_rt(ideadstem_xf) + matrix_cap_livecrootc(p) = vegmatrixc_rt(ilivecroot) + matrix_cap_livecrootc_storage(p) = vegmatrixc_rt(ilivecroot_st) + matrix_cap_livecrootc_xfer(p) = vegmatrixc_rt(ilivecroot_xf) + matrix_cap_deadcrootc(p) = vegmatrixc_rt(ideadcroot) + matrix_cap_deadcrootc_storage(p) = vegmatrixc_rt(ideadcroot_st) + matrix_cap_deadcrootc_xfer(p) = vegmatrixc_rt(ideadcroot_xf) + if(ivt(p) >= npcropmin)then + matrix_cap_grainc(p) = vegmatrixc_rt(igrain) + matrix_cap_grainc_storage(p) = vegmatrixc_rt(igrain_st) + matrix_cap_grainc_xfer(p) = vegmatrixc_rt(igrain_xf) + end if + if(use_c13)then + cs13_veg%matrix_cap_leafc_patch(p) = vegmatrixc13_rt(ileaf) + cs13_veg%matrix_cap_leafc_storage_patch(p) = vegmatrixc13_rt(ileaf_st) + cs13_veg%matrix_cap_leafc_xfer_patch(p) = vegmatrixc13_rt(ileaf_xf) + cs13_veg%matrix_cap_frootc_patch(p) = vegmatrixc13_rt(ifroot) + cs13_veg%matrix_cap_frootc_storage_patch(p) = vegmatrixc13_rt(ifroot_st) + cs13_veg%matrix_cap_frootc_xfer_patch(p) = vegmatrixc13_rt(ifroot_xf) + cs13_veg%matrix_cap_livestemc_patch(p) = vegmatrixc13_rt(ilivestem) + cs13_veg%matrix_cap_livestemc_storage_patch(p) = vegmatrixc13_rt(ilivestem_st) + cs13_veg%matrix_cap_livestemc_xfer_patch(p) = vegmatrixc13_rt(ilivestem_xf) + cs13_veg%matrix_cap_deadstemc_patch(p) = vegmatrixc13_rt(ideadstem) + cs13_veg%matrix_cap_deadstemc_storage_patch(p) = vegmatrixc13_rt(ideadstem_st) + cs13_veg%matrix_cap_deadstemc_xfer_patch(p) = vegmatrixc13_rt(ideadstem_xf) + cs13_veg%matrix_cap_livecrootc_patch(p) = vegmatrixc13_rt(ilivecroot) + cs13_veg%matrix_cap_livecrootc_storage_patch(p) = vegmatrixc13_rt(ilivecroot_st) + cs13_veg%matrix_cap_livecrootc_xfer_patch(p) = vegmatrixc13_rt(ilivecroot_xf) + cs13_veg%matrix_cap_deadcrootc_patch(p) = vegmatrixc13_rt(ideadcroot) + cs13_veg%matrix_cap_deadcrootc_storage_patch(p) = vegmatrixc13_rt(ideadcroot_st) + cs13_veg%matrix_cap_deadcrootc_xfer_patch(p) = vegmatrixc13_rt(ideadcroot_xf) + if(ivt(p) >= npcropmin)then + cs13_veg%matrix_cap_grainc_patch(p) = vegmatrixc13_rt(igrain) + cs13_veg%matrix_cap_grainc_storage_patch(p) = vegmatrixc13_rt(igrain_st) + cs13_veg%matrix_cap_grainc_xfer_patch(p) = vegmatrixc13_rt(igrain_xf) + end if + end if + if(use_c14)then + cs14_veg%matrix_cap_leafc_patch(p) = vegmatrixc14_rt(ileaf) + cs14_veg%matrix_cap_leafc_storage_patch(p) = vegmatrixc14_rt(ileaf_st) + cs14_veg%matrix_cap_leafc_xfer_patch(p) = vegmatrixc14_rt(ileaf_xf) + cs14_veg%matrix_cap_frootc_patch(p) = vegmatrixc14_rt(ifroot) + cs14_veg%matrix_cap_frootc_storage_patch(p) = vegmatrixc14_rt(ifroot_st) + cs14_veg%matrix_cap_frootc_xfer_patch(p) = vegmatrixc14_rt(ifroot_xf) + cs14_veg%matrix_cap_livestemc_patch(p) = vegmatrixc14_rt(ilivestem) + cs14_veg%matrix_cap_livestemc_storage_patch(p) = vegmatrixc14_rt(ilivestem_st) + cs14_veg%matrix_cap_livestemc_xfer_patch(p) = vegmatrixc14_rt(ilivestem_xf) + cs14_veg%matrix_cap_deadstemc_patch(p) = vegmatrixc14_rt(ideadstem) + cs14_veg%matrix_cap_deadstemc_storage_patch(p) = vegmatrixc14_rt(ideadstem_st) + cs14_veg%matrix_cap_deadstemc_xfer_patch(p) = vegmatrixc14_rt(ideadstem_xf) + cs14_veg%matrix_cap_livecrootc_patch(p) = vegmatrixc14_rt(ilivecroot) + cs14_veg%matrix_cap_livecrootc_storage_patch(p) = vegmatrixc14_rt(ilivecroot_st) + cs14_veg%matrix_cap_livecrootc_xfer_patch(p) = vegmatrixc14_rt(ilivecroot_xf) + cs14_veg%matrix_cap_deadcrootc_patch(p) = vegmatrixc14_rt(ideadcroot) + cs14_veg%matrix_cap_deadcrootc_storage_patch(p) = vegmatrixc14_rt(ideadcroot_st) + cs14_veg%matrix_cap_deadcrootc_xfer_patch(p) = vegmatrixc14_rt(ideadcroot_xf) + if(ivt(p) >= npcropmin)then + cs14_veg%matrix_cap_grainc_patch(p) = vegmatrixc14_rt(igrain) + cs14_veg%matrix_cap_grainc_storage_patch(p) = vegmatrixc14_rt(igrain_st) + cs14_veg%matrix_cap_grainc_xfer_patch(p) = vegmatrixc14_rt(igrain_xf) + end if + end if + matrix_cap_leafn(p) = vegmatrixn_rt(ileaf) + matrix_cap_leafn_storage(p) = vegmatrixn_rt(ileaf_st) + matrix_cap_leafn_xfer(p) = vegmatrixn_rt(ileaf_xf) + matrix_cap_frootn(p) = vegmatrixn_rt(ifroot) + matrix_cap_frootn_storage(p) = vegmatrixn_rt(ifroot_st) + matrix_cap_frootn_xfer(p) = vegmatrixn_rt(ifroot_xf) + matrix_cap_livestemn(p) = vegmatrixn_rt(ilivestem) + matrix_cap_livestemn_storage(p) = vegmatrixn_rt(ilivestem_st) + matrix_cap_livestemn_xfer(p) = vegmatrixn_rt(ilivestem_xf) + matrix_cap_deadstemn(p) = vegmatrixn_rt(ideadstem) + matrix_cap_deadstemn_storage(p) = vegmatrixn_rt(ideadstem_st) + matrix_cap_deadstemn_xfer(p) = vegmatrixn_rt(ideadstem_xf) + matrix_cap_livecrootn(p) = vegmatrixn_rt(ilivecroot) + matrix_cap_livecrootn_storage(p) = vegmatrixn_rt(ilivecroot_st) + matrix_cap_livecrootn_xfer(p) = vegmatrixn_rt(ilivecroot_xf) + matrix_cap_deadcrootn(p) = vegmatrixn_rt(ideadcroot) + matrix_cap_deadcrootn_storage(p) = vegmatrixn_rt(ideadcroot_st) + if(ivt(p) >= npcropmin)then + matrix_cap_grainn(p) = vegmatrixn_rt(igrain) + matrix_cap_grainn_storage(p) = vegmatrixn_rt(igrain_st) + matrix_cap_grainn_xfer(p) = vegmatrixn_rt(igrain_xf) + end if + end if + + ! Reset accumulated variables to 0 at end of each year after calculating capacity + matrix_calloc_leaf_acc(p) = 0._r8 + matrix_calloc_leafst_acc(p) = 0._r8 + matrix_calloc_froot_acc(p) = 0._r8 + matrix_calloc_frootst_acc(p) = 0._r8 + matrix_calloc_livestem_acc(p) = 0._r8 + matrix_calloc_livestemst_acc(p) = 0._r8 + matrix_calloc_deadstem_acc(p) = 0._r8 + matrix_calloc_deadstemst_acc(p) = 0._r8 + matrix_calloc_livecroot_acc(p) = 0._r8 + matrix_calloc_livecrootst_acc(p) = 0._r8 + matrix_calloc_deadcroot_acc(p) = 0._r8 + matrix_calloc_deadcrootst_acc(p) = 0._r8 + if(ivt(p) >= npcropmin)then + matrix_calloc_grain_acc(p) = 0._r8 + matrix_calloc_grainst_acc(p) = 0._r8 + end if + + matrix_ctransfer_leafst_to_leafxf_acc(p) = 0._r8 + matrix_ctransfer_leafxf_to_leaf_acc(p) = 0._r8 + matrix_ctransfer_frootst_to_frootxf_acc(p) = 0._r8 + matrix_ctransfer_frootxf_to_froot_acc(p) = 0._r8 + matrix_ctransfer_livestemst_to_livestemxf_acc(p) = 0._r8 + matrix_ctransfer_livestemxf_to_livestem_acc(p) = 0._r8 + matrix_ctransfer_deadstemst_to_deadstemxf_acc(p) = 0._r8 + matrix_ctransfer_deadstemxf_to_deadstem_acc(p) = 0._r8 + matrix_ctransfer_livecrootst_to_livecrootxf_acc(p) = 0._r8 + matrix_ctransfer_livecrootxf_to_livecroot_acc(p) = 0._r8 + matrix_ctransfer_deadcrootst_to_deadcrootxf_acc(p) = 0._r8 + matrix_ctransfer_deadcrootxf_to_deadcroot_acc(p) = 0._r8 + if(ivt(p) >= npcropmin)then + matrix_ctransfer_grainst_to_grainxf_acc(p) = 0._r8 + matrix_ctransfer_grainxf_to_grain_acc(p) = 0._r8 + end if + matrix_ctransfer_livestem_to_deadstem_acc(p) = 0._r8 + matrix_ctransfer_livecroot_to_deadcroot_acc(p) = 0._r8 + + matrix_cturnover_leaf_acc(p) = 0._r8 + matrix_cturnover_leafst_acc(p) = 0._r8 + matrix_cturnover_leafxf_acc(p) = 0._r8 + matrix_cturnover_froot_acc(p) = 0._r8 + matrix_cturnover_frootst_acc(p) = 0._r8 + matrix_cturnover_frootxf_acc(p) = 0._r8 + matrix_cturnover_livestem_acc(p) = 0._r8 + matrix_cturnover_livestemst_acc(p) = 0._r8 + matrix_cturnover_livestemxf_acc(p) = 0._r8 + matrix_cturnover_deadstem_acc(p) = 0._r8 + matrix_cturnover_deadstemst_acc(p) = 0._r8 + matrix_cturnover_deadstemxf_acc(p) = 0._r8 + matrix_cturnover_livecroot_acc(p) = 0._r8 + matrix_cturnover_livecrootst_acc(p) = 0._r8 + matrix_cturnover_livecrootxf_acc(p) = 0._r8 + matrix_cturnover_deadcroot_acc(p) = 0._r8 + matrix_cturnover_deadcrootst_acc(p) = 0._r8 + matrix_cturnover_deadcrootxf_acc(p) = 0._r8 + if(ivt(p) >= npcropmin)then + matrix_cturnover_grain_acc(p) = 0._r8 + matrix_cturnover_grainst_acc(p) = 0._r8 + matrix_cturnover_grainxf_acc(p) = 0._r8 + end if + + if(use_c13)then + cs13_veg%matrix_calloc_leaf_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_leafst_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_froot_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_frootst_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_livestem_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_livestemst_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_deadstem_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_deadstemst_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_livecroot_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_livecrootst_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_deadcroot_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_deadcrootst_acc_patch(p) = 0._r8 + if(ivt(p) >= npcropmin)then + cs13_veg%matrix_calloc_grain_acc_patch(p) = 0._r8 + cs13_veg%matrix_calloc_grainst_acc_patch(p) = 0._r8 + end if + + cs13_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) = 0._r8 + if(ivt(p) >= npcropmin)then + cs13_veg%matrix_ctransfer_grainst_to_grainxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_grainxf_to_grain_acc_patch(p) = 0._r8 + end if + cs13_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) = 0._r8 + cs13_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) = 0._r8 + + cs13_veg%matrix_cturnover_leaf_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_leafst_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_leafxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_froot_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_frootst_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_frootxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_livestem_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_livestemst_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_livestemxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_deadstem_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_deadstemst_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_deadstemxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_livecroot_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_livecrootst_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_livecrootxf_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_deadcroot_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_deadcrootst_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_deadcrootxf_acc_patch(p) = 0._r8 + if(ivt(p) >= npcropmin)then + cs13_veg%matrix_cturnover_grain_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_grainst_acc_patch(p) = 0._r8 + cs13_veg%matrix_cturnover_grainxf_acc_patch(p) = 0._r8 + end if + end if + + if(use_c14)then + cs14_veg%matrix_calloc_leaf_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_leafst_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_froot_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_frootst_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_livestem_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_livestemst_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_deadstem_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_deadstemst_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_livecroot_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_livecrootst_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_deadcroot_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_deadcrootst_acc_patch(p) = 0._r8 + if(ivt(p) >= npcropmin)then + cs14_veg%matrix_calloc_grain_acc_patch(p) = 0._r8 + cs14_veg%matrix_calloc_grainst_acc_patch(p) = 0._r8 + end if + + cs14_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) = 0._r8 + if(ivt(p) >= npcropmin)then + cs14_veg%matrix_ctransfer_grainst_to_grainxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_grainxf_to_grain_acc_patch(p) = 0._r8 + end if + cs14_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) = 0._r8 + cs14_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) = 0._r8 + + cs14_veg%matrix_cturnover_leaf_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_leafst_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_leafxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_froot_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_frootst_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_frootxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_livestem_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_livestemst_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_livestemxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_deadstem_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_deadstemst_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_deadstemxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_livecroot_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_livecrootst_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_livecrootxf_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_deadcroot_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_deadcrootst_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_deadcrootxf_acc_patch(p) = 0._r8 + if(ivt(p) >= npcropmin)then + cs14_veg%matrix_cturnover_grain_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_grainst_acc_patch(p) = 0._r8 + cs14_veg%matrix_cturnover_grainxf_acc_patch(p) = 0._r8 + end if + end if + + matrix_nalloc_leaf_acc(p) = 0._r8 + matrix_nalloc_leafst_acc(p) = 0._r8 + matrix_nalloc_froot_acc(p) = 0._r8 + matrix_nalloc_frootst_acc(p) = 0._r8 + matrix_nalloc_livestem_acc(p) = 0._r8 + matrix_nalloc_livestemst_acc(p) = 0._r8 + matrix_nalloc_deadstem_acc(p) = 0._r8 + matrix_nalloc_deadstemst_acc(p) = 0._r8 + matrix_nalloc_livecroot_acc(p) = 0._r8 + matrix_nalloc_livecrootst_acc(p) = 0._r8 + matrix_nalloc_deadcroot_acc(p) = 0._r8 + matrix_nalloc_deadcrootst_acc(p) = 0._r8 + if(ivt(p) >= npcropmin)then + matrix_nalloc_grain_acc(p) = 0._r8 + matrix_nalloc_grainst_acc(p) = 0._r8 + end if + + matrix_ntransfer_leafst_to_leafxf_acc(p) = 0._r8 + matrix_ntransfer_leafxf_to_leaf_acc(p) = 0._r8 + matrix_ntransfer_frootst_to_frootxf_acc(p) = 0._r8 + matrix_ntransfer_frootxf_to_froot_acc(p) = 0._r8 + matrix_ntransfer_livestemst_to_livestemxf_acc(p) = 0._r8 + matrix_ntransfer_livestemxf_to_livestem_acc(p) = 0._r8 + matrix_ntransfer_deadstemst_to_deadstemxf_acc(p) = 0._r8 + matrix_ntransfer_deadstemxf_to_deadstem_acc(p) = 0._r8 + matrix_ntransfer_livecrootst_to_livecrootxf_acc(p) = 0._r8 + matrix_ntransfer_livecrootxf_to_livecroot_acc(p) = 0._r8 + matrix_ntransfer_deadcrootst_to_deadcrootxf_acc(p) = 0._r8 + matrix_ntransfer_deadcrootxf_to_deadcroot_acc(p) = 0._r8 + if(ivt(p) >= npcropmin)then + matrix_ntransfer_grainst_to_grainxf_acc(p) = 0._r8 + matrix_ntransfer_grainxf_to_grain_acc(p) = 0._r8 + end if + matrix_ntransfer_livestem_to_deadstem_acc(p) = 0._r8 + matrix_ntransfer_livecroot_to_deadcroot_acc(p) = 0._r8 + + matrix_ntransfer_retransn_to_leaf_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_leafst_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_froot_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_frootst_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_livestem_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_livestemst_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_deadstem_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_deadstemst_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_livecroot_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_livecrootst_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_deadcroot_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_deadcrootst_acc(p) = 0._r8 + if(ivt(p) >= npcropmin)then + matrix_ntransfer_retransn_to_grain_acc(p) = 0._r8 + matrix_ntransfer_retransn_to_grainst_acc(p) = 0._r8 + end if + matrix_ntransfer_leaf_to_retransn_acc(p) = 0._r8 + matrix_ntransfer_froot_to_retransn_acc(p) = 0._r8 + matrix_ntransfer_livestem_to_retransn_acc(p) = 0._r8 + matrix_ntransfer_livecroot_to_retransn_acc(p) = 0._r8 + + matrix_nturnover_leaf_acc(p) = 0._r8 + matrix_nturnover_leafst_acc(p) = 0._r8 + matrix_nturnover_leafxf_acc(p) = 0._r8 + matrix_nturnover_froot_acc(p) = 0._r8 + matrix_nturnover_frootst_acc(p) = 0._r8 + matrix_nturnover_frootxf_acc(p) = 0._r8 + matrix_nturnover_livestem_acc(p) = 0._r8 + matrix_nturnover_livestemst_acc(p) = 0._r8 + matrix_nturnover_livestemxf_acc(p) = 0._r8 + matrix_nturnover_deadstem_acc(p) = 0._r8 + matrix_nturnover_deadstemst_acc(p) = 0._r8 + matrix_nturnover_deadstemxf_acc(p) = 0._r8 + matrix_nturnover_livecroot_acc(p) = 0._r8 + matrix_nturnover_livecrootst_acc(p) = 0._r8 + matrix_nturnover_livecrootxf_acc(p) = 0._r8 + matrix_nturnover_deadcroot_acc(p) = 0._r8 + matrix_nturnover_deadcrootst_acc(p) = 0._r8 + matrix_nturnover_deadcrootxf_acc(p) = 0._r8 + if(ivt(p) >= npcropmin)then + matrix_nturnover_grain_acc(p) = 0._r8 + matrix_nturnover_grainst_acc(p) = 0._r8 + matrix_nturnover_grainxf_acc(p) = 0._r8 + end if + matrix_nturnover_retransn_acc(p) = 0._r8 + matrix_calloc_acc(:) = 0._r8 + matrix_ctransfer_acc(:,:) = 0._r8 + matrix_nalloc_acc(:) = 0._r8 + matrix_ntransfer_acc(:,:) = 0._r8 + + call t_stopf('CN veg matrix-finalize spinup') + end do + if(iloop .eq. iloop_avg .and. iyr .eq. nyr_forcing)iloop = 0 + if(iyr .eq. nyr_forcing)iyr=0 + end if + end if + + call vegmatrixc_input%ReleaseV() + if ( use_c13 )then + call vegmatrixc13_input%ReleaseV() + end if + if ( use_c14 )then + call vegmatrixc14_input%ReleaseV() + end if + call vegmatrixn_input%ReleaseV() + + end associate td + end associate sd + end associate od + end associate fr + end subroutine CNVegMatrix + + function matrix_update_phc(p,itransfer,rate,dt,cnveg_carbonflux_inst,matrixcheck,acc) + + integer ,intent(in) :: p + integer ,intent(in) :: itransfer + real(r8),intent(in) :: rate + real(r8),intent(in) :: dt + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + logical ,intent(in),optional :: matrixcheck + logical ,intent(in),optional :: acc + real(r8) :: matrix_update_phc + + associate( & + matrix_phtransfer => cnveg_carbonflux_inst%matrix_phtransfer_patch , & + matrix_phturnover => cnveg_carbonflux_inst%matrix_phturnover_patch , & + doner_phc => cnveg_carbonflux_inst%matrix_phtransfer_doner_patch& + ) + if(.not. present(matrixcheck) .or. matrixcheck)then + if((.not. present(acc) .or. acc) .and. matrix_phturnover(p,doner_phc(itransfer)) + rate * dt .ge. 1)then + matrix_update_phc = max(0._r8,(1._r8 - matrix_phturnover(p,doner_phc(itransfer))) / dt) + else + matrix_update_phc = rate + end if + else + matrix_update_phc = rate + end if + if(.not. present(acc) .or. acc)then + matrix_phturnover(p,doner_phc(itransfer)) = matrix_phturnover(p,doner_phc(itransfer)) + matrix_update_phc * dt + matrix_phtransfer(p,itransfer) = matrix_phtransfer(p,itransfer) + matrix_update_phc + else + matrix_phturnover(p,doner_phc(itransfer)) = matrix_phturnover(p,doner_phc(itransfer)) - matrix_phtransfer(p,itransfer) * dt + matrix_update_phc * dt + matrix_phtransfer(p,itransfer) = matrix_update_phc + end if + + return + end associate + + end function matrix_update_phc + + function matrix_update_gmc(p,itransfer,rate,dt,cnveg_carbonflux_inst,matrixcheck,acc) + + integer,intent(in) :: p + integer,intent(in) :: itransfer + real(r8),intent(in) :: rate + real(r8),intent(in) :: dt + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + logical ,intent(in),optional :: matrixcheck + logical ,intent(in),optional :: acc + real(r8) :: matrix_update_gmc + + associate( & + matrix_phturnover => cnveg_carbonflux_inst%matrix_phturnover_patch , & + matrix_gmtransfer => cnveg_carbonflux_inst%matrix_gmtransfer_patch , & + matrix_gmturnover => cnveg_carbonflux_inst%matrix_gmturnover_patch , & + doner_gmc => cnveg_carbonflux_inst%matrix_gmtransfer_doner_patch & ! Input: [integer (:)] Doners of gap mortality related C transfer + ) + + if(.not. present(matrixcheck) .or. matrixcheck)then + if((.not. present(acc) .or. acc) .and. matrix_phturnover(p,doner_gmc(itransfer)) + matrix_gmturnover(p,doner_gmc(itransfer)) + rate * dt .ge. 1)then + matrix_update_gmc = max(0._r8,(1._r8 - matrix_phturnover(p,doner_gmc(itransfer)) - matrix_gmturnover(p,doner_gmc(itransfer))) / dt) + else + matrix_update_gmc = rate + end if + else + matrix_update_gmc = rate + end if + if(.not. present(acc) .or. acc)then + matrix_gmturnover(p,doner_gmc(itransfer)) = matrix_gmturnover(p,doner_gmc(itransfer)) + matrix_update_gmc * dt + matrix_gmtransfer(p,itransfer) = matrix_gmtransfer(p,itransfer) + matrix_update_gmc + else + matrix_gmturnover(p,doner_gmc(itransfer)) = matrix_gmturnover(p,doner_gmc(itransfer)) - matrix_gmtransfer(p,itransfer) * dt + matrix_update_gmc * dt + matrix_gmtransfer(p,itransfer) = matrix_update_gmc + end if + return + end associate + + end function matrix_update_gmc + + + function matrix_update_fic(p,itransfer,rate,dt,cnveg_carbonflux_inst,matrixcheck,acc) + + integer,intent(in) :: p + integer,intent(in) :: itransfer + real(r8),intent(in) :: rate + real(r8),intent(in) :: dt + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + logical ,intent(in),optional :: matrixcheck + logical ,intent(in),optional :: acc + real(r8) :: matrix_update_fic + + associate( & + matrix_phturnover => cnveg_carbonflux_inst%matrix_phturnover_patch , & + matrix_gmturnover => cnveg_carbonflux_inst%matrix_gmturnover_patch , & + matrix_fitransfer => cnveg_carbonflux_inst%matrix_fitransfer_patch , & + matrix_fiturnover => cnveg_carbonflux_inst%matrix_fiturnover_patch , & + doner_fic => cnveg_carbonflux_inst%matrix_fitransfer_doner_patch & + ) + + if(.not. present(matrixcheck) .or. matrixcheck)then + if((.not. present(acc) .or. acc) .and. matrix_phturnover(p,doner_fic(itransfer)) + matrix_gmturnover(p,doner_fic(itransfer)) & + + matrix_fiturnover(p,doner_fic(itransfer)) + rate * dt .ge. 1)then + matrix_update_fic = max(0._r8,(1._r8 - matrix_phturnover(p,doner_fic(itransfer)) & + - matrix_gmturnover(p,doner_fic(itransfer)) - matrix_fiturnover(p,doner_fic(itransfer))) / dt) + else + matrix_update_fic = rate + end if + else + matrix_update_fic = rate + end if + if(.not. present(acc) .or. acc)then + matrix_fiturnover(p,doner_fic(itransfer)) = matrix_fiturnover(p,doner_fic(itransfer)) + matrix_update_fic * dt + matrix_fitransfer(p,itransfer) = matrix_fitransfer(p,itransfer) + matrix_update_fic + else + matrix_fiturnover(p,doner_fic(itransfer)) = matrix_fiturnover(p,doner_fic(itransfer)) - matrix_fitransfer(p,itransfer) * dt + matrix_update_fic * dt + matrix_fitransfer(p,itransfer) = matrix_update_fic + end if + + return + end associate + +end function matrix_update_fic + + function matrix_update_phn(p,itransfer,rate,dt,cnveg_nitrogenflux_inst,matrixcheck,acc) + + integer,intent(in) :: p + integer,intent(in) :: itransfer + real(r8),intent(in) :: rate + real(r8),intent(in) :: dt + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + logical ,intent(in),optional :: matrixcheck + logical ,intent(in),optional :: acc + real(r8) :: matrix_update_phn + + associate( & + matrix_nphtransfer => cnveg_nitrogenflux_inst%matrix_nphtransfer_patch , & + matrix_nphturnover => cnveg_nitrogenflux_inst%matrix_nphturnover_patch , & + doner_phn => cnveg_nitrogenflux_inst%matrix_nphtransfer_doner_patch & ! Input: [integer (:)] Doners of phenology related N transfer + ) + + if(.not. present(matrixcheck) .or. matrixcheck)then + if((.not. present(acc) .or. acc) .and. matrix_nphturnover(p,doner_phn(itransfer)) + rate * dt .ge. 1)then + matrix_update_phn = max(0._r8,(1._r8 - matrix_nphturnover(p,doner_phn(itransfer))) / dt) + else + matrix_update_phn = rate + end if + else + matrix_update_phn = rate + end if + if(.not. present(acc) .or. acc)then + matrix_nphturnover(p,doner_phn(itransfer)) = matrix_nphturnover(p,doner_phn(itransfer)) + matrix_update_phn * dt + matrix_nphtransfer(p,itransfer) = matrix_nphtransfer(p,itransfer) + matrix_update_phn + else + matrix_nphturnover(p,doner_phn(itransfer)) = matrix_nphturnover(p,doner_phn(itransfer)) - matrix_nphtransfer(p,itransfer) * dt + matrix_update_phn * dt + matrix_nphtransfer(p,itransfer) = matrix_update_phn + end if + + return + end associate + + end function matrix_update_phn + + function matrix_update_gmn(p,itransfer,rate,dt,cnveg_nitrogenflux_inst,matrixcheck,acc) + + integer ,intent(in) :: p + integer ,intent(in) :: itransfer + real(r8),intent(in) :: rate + real(r8),intent(in) :: dt + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + logical ,intent(in),optional :: matrixcheck + logical ,intent(in),optional :: acc + real(r8) :: matrix_update_gmn + + associate( & + matrix_nphturnover => cnveg_nitrogenflux_inst%matrix_nphturnover_patch , & + matrix_ngmtransfer => cnveg_nitrogenflux_inst%matrix_ngmtransfer_patch , & + matrix_ngmturnover => cnveg_nitrogenflux_inst%matrix_ngmturnover_patch , & + doner_gmn => cnveg_nitrogenflux_inst%matrix_ngmtransfer_doner_patch & ! Input: [integer (:)] Doners of gap mortality related N transfer + ) + + if(.not. present(matrixcheck) .or. matrixcheck)then + if((.not. present(acc) .or. acc) .and. matrix_nphturnover(p,doner_gmn(itransfer)) + matrix_ngmturnover(p,doner_gmn(itransfer)) + rate * dt .ge. 1)then + matrix_update_gmn = max(0._r8,(1._r8 - matrix_nphturnover(p,doner_gmn(itransfer)) - matrix_ngmturnover(p,doner_gmn(itransfer))) / dt) + else + matrix_update_gmn = rate + end if + else + matrix_update_gmn = rate + end if + if(.not. present(acc) .or. acc)then + matrix_ngmturnover(p,doner_gmn(itransfer)) = matrix_ngmturnover(p,doner_gmn(itransfer)) + matrix_update_gmn * dt + matrix_ngmtransfer(p,itransfer) = matrix_ngmtransfer(p,itransfer) + matrix_update_gmn + else + matrix_ngmturnover(p,doner_gmn(itransfer)) = matrix_ngmturnover(p,doner_gmn(itransfer)) - matrix_ngmtransfer(p,itransfer) * dt + matrix_update_gmn * dt + matrix_ngmtransfer(p,itransfer) = matrix_update_gmn + end if + + return + end associate + + end function matrix_update_gmn + + + function matrix_update_fin(p,itransfer,rate,dt,cnveg_nitrogenflux_inst,matrixcheck,acc) + + integer ,intent(in) :: p + integer ,intent(in) :: itransfer + real(r8),intent(in) :: rate + real(r8),intent(in) :: dt + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + logical ,intent(in),optional :: matrixcheck + logical ,intent(in),optional :: acc + real(r8) :: matrix_update_fin + + associate( & + matrix_nphturnover => cnveg_nitrogenflux_inst%matrix_nphturnover_patch , & + matrix_ngmturnover => cnveg_nitrogenflux_inst%matrix_ngmturnover_patch , & + matrix_nfitransfer => cnveg_nitrogenflux_inst%matrix_nfitransfer_patch , & + matrix_nfiturnover => cnveg_nitrogenflux_inst%matrix_nfiturnover_patch , & + doner_fin => cnveg_nitrogenflux_inst%matrix_nfitransfer_doner_patch & + ) + + if(.not. present(matrixcheck) .or. matrixcheck)then + if((.not. present(acc) .or. acc) .and. matrix_nphturnover(p,doner_fin(itransfer)) + matrix_ngmturnover(p,doner_fin(itransfer)) & + + matrix_nfiturnover(p,doner_fin(itransfer)) + rate * dt .ge. 1)then + matrix_update_fin = max(0._r8,(1._r8 - matrix_nphturnover(p,doner_fin(itransfer)) & + - matrix_ngmturnover(p,doner_fin(itransfer)) - matrix_nfiturnover(p,doner_fin(itransfer))) / dt) + else + matrix_update_fin = rate + end if + else + matrix_update_fin = rate + end if + if(.not. present(acc) .or. acc)then + matrix_nfiturnover(p,doner_fin(itransfer)) = matrix_nfiturnover(p,doner_fin(itransfer)) + matrix_update_fin * dt + matrix_nfitransfer(p,itransfer) = matrix_nfitransfer(p,itransfer) + matrix_update_fin + else + matrix_nfiturnover(p,doner_fin(itransfer)) = matrix_nfiturnover(p,doner_fin(itransfer)) - matrix_nfitransfer(p,itransfer) * dt + matrix_update_fin * dt + matrix_nfitransfer(p,itransfer) = matrix_update_fin + end if + + return + end associate + + end function matrix_update_fin + + !----------------------------------------------------------------------- + subroutine CNVegMatrixRest( ncid, flag ) + ! !DESCRIPTION: + ! + ! Read/write restart data needed for the CN Matrix model solution + ! + ! !USES: + use restUtilMod , only: restartvar + use ncdio_pio , only: file_desc_t, ncd_int + ! + ! !ARGUMENTS: + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + ! + ! !LOCAL VARIABLES: + logical :: readvar ! determine if variable is on initial file + !------------------------------------------------------------------------ + call restartvar(ncid=ncid, flag=flag, varname='bgc_cycle_year', xtype=ncd_int, & + long_name='Year number in spinup cycle sequence', units='years', & + interpinic_flag='skip', readvar=readvar, data=iyr) + + call restartvar(ncid=ncid, flag=flag, varname='bgc_cycle_loop', xtype=ncd_int, & + long_name='Loop number in spinup cycle sequence', units='years', & + interpinic_flag='skip', readvar=readvar, data=iloop) + + !------------------------------------------------------------------------ + end subroutine CNVegMatrixRest + +end module CNVegMatrixMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/MatrixMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/MatrixMod.F90 new file mode 100755 index 000000000..bef00510f --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/MatrixMod.F90 @@ -0,0 +1,144 @@ +module MatrixMod +!============================================================ +! +! Module for linear alegebra matrix methods +! +!============================================================ + +#include "shr_assert.h" + + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + private + + ! + ! Public methods: + ! + public inverse ! Compute the inverse of a matrix + +!============================================================ +contains +!============================================================ + +subroutine inverse(a,c,n) +!============================================================ +! Inverse matrix +! Method: Based on Doolittle LU factorization for Ax=b +! Alex G. December 2009 +!----------------------------------------------------------- +! input ... +! a(n,n) - array of coefficients for matrix A +! n - dimension +! output ... +! c(n,n) - inverse matrix of A +! comments ... +! the original matrix a(n,n) will be destroyed +! during the calculation +!=========================================================== + implicit none + ! Arguments + integer,intent(in) :: n ! Size of matrix + real(r8),intent(in) :: a(:,:) ! Input matrix to fine the inverse of + real(r8),intent(out) :: c(:,:) ! Output inverse + ! Local variables + real(r8) :: L(n,n) ! matrix of the elimination coefficient + real(r8) :: U(n,n) ! Upper triangular part of input matrix A + real(r8) :: aa(n,n) ! Temporary equal to input matrix a + real(r8) :: b(n) ! Temporary vector + real(r8) :: d(n) ! Temporary vector (solution of L*d) + real(r8) :: x(n) ! Temporary vector (U*x = d) + real(r8) :: coeff ! coefficient + integer i, j, k ! Indices + character(len=*), parameter :: subname = 'inverse' + + ! + ! Verify input matrix sizes + ! + SHR_ASSERT((size(a,1) == n), errMsg(subname, __LINE__)) + SHR_ASSERT((size(a,2) == n), errMsg(subname, __LINE__)) + SHR_ASSERT((size(c,1) == n), errMsg(subname, __LINE__)) + SHR_ASSERT((size(c,2) == n), errMsg(subname, __LINE__)) + ! + ! Check that diagonals of input matrix aren't zero + ! + do k=1,n + if ( a(k,k) == 0.0_r8 )then + call endrun( subname//" ERROR: A diagonal element of the input matrix is zero" ) + return + end if + end do + ! + ! step 0: initialization for matrices L and U and b + ! Fortran 90/95 aloows such operations on matrices + ! + L=0.0 + U=0.0 + b=0.0 + + aa=a + ! + ! Step 1: forward elimination + ! + do k=1, n-1 + do i=k+1,n + ! Already verifieid that divisor isn't zero + coeff=aa(i,k)/aa(k,k) + L(i,k) = coeff + do j=k+1,n + aa(i,j) = aa(i,j)-coeff*aa(k,j) + end do + end do + end do + + ! + ! Step 2: prepare L and U matrices + ! L matrix is a matrix of the elimination coefficient + ! + the diagonal elements are 1.0 + ! + do i=1,n + L(i,i) = 1.0 + end do + ! + ! U matrix is the upper triangular part of A + ! + do j=1,n + do i=1,j + U(i,j) = aa(i,j) + end do + end do + ! + ! Step 3: compute columns of the inverse matrix C + ! + do k=1,n + b(k)=1.0 + d(1) = b(1) + ! Step 3a: Solve Ld=b using the forward substitution + do i=2,n + d(i)=b(i) + do j=1,i-1 + d(i) = d(i) - L(i,j)*d(j) + end do + end do + ! Step 3b: Solve Ux=d using the back substitution + x(n)=d(n)/U(n,n) + do i = n-1,1,-1 + x(i) = d(i) + do j=n,i+1,-1 + x(i)=x(i)-U(i,j)*x(j) + end do + ! Already verifieid that divisor isn't zero + x(i) = x(i)/u(i,i) + end do + ! Step 3c: fill the solutions x(n) into column k of C + do i=1,n + c(i,k) = x(i) + end do + b(k)=0.0 + end do +end subroutine inverse + +!============================================================ + +end module MatrixMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SPMMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SPMMod.F90 new file mode 100755 index 000000000..6fdb3ae57 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SPMMod.F90 @@ -0,0 +1,1234 @@ +module SPMMod + +#include "shr_assert.h" + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: SPMMod +! +! !DESCRIPTION: +! Sparse matrix multiplication add addition +! +! Author: Xingjie Lu +! +!EOP +!----------------------------------------------------------------------- + + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varctl , only : iulog + use abortutils , only : endrun + implicit none + private + + type, public :: sparse_matrix_type + + !sparse matrix is in COO format, Both row index and column index should be in ascending order. + !Row index should change faster than Column index to ensure SPMP_AB work properly. + + real(r8), pointer :: M(:,:) => null() ! non-zero entries in sparse matrix (unit,sparse matrix index) + integer , pointer :: RI(:) => null() ! Row index + integer , pointer :: CI(:) => null() ! Column index + integer NE ! Number of nonzero entries + integer SM ! Size of matrix, eg. for nxn matrix, SM=n + integer num_unit ! number of active unit, such as patch, col, or gridcell + integer begu ! begin index of unit in current process + integer endu ! end index of unit in current process + + contains + + procedure, public :: InitSM ! subroutine to initilize sparse matrix type + procedure, public :: ReleaseSM ! subroutine to deallocate the sparse matrix type data + procedure, public :: IsAllocSM ! return true if the sparse matrix type is allocated (InitSM was called) + procedure, public :: IsEquivIdxSM ! return true if the sparse matrix indices are the same for the two sparce matrices + procedure, public :: SetValueSM ! subroutine to set values in sparse matrix of any shape + procedure, public :: SetValueA ! subroutine to set off-diagonal values in sparse matrix of A + procedure, public :: SetValueA_diag ! subroutine to set diagonal values in sparse matrix of A + procedure, public :: SetValueCopySM ! subroutine to copy the input sparse matrix to the output + procedure, public :: CopyIdxSM ! subroutine to copy the input indices to the sparse matrix + procedure, public :: IsValuesSetSM ! return true if the values are set in the matrix + procedure, public :: SPMM_AK ! subroutine to calculate sparse matrix multiplication: A(sparse matrix) = A(sparse matrix) * K(diagonal matrix) + procedure, public :: SPMP_AB ! subroutine to calculate sparse matrix addition AB(sparse matrix) = A(sparse matrix) + B(sparse matrix) + procedure, public :: SPMP_B_ACC ! subroutine to calculate sparse matrix accumulation: B(sparse matrix) = B(sparse matrix) + A(sparse matrix) + procedure, public :: SPMP_ABC ! subroutine to calculate sparse matrix addition ABC(sparse matrix) = A(sparse matrix) + B(sparse matrix) + C(sparse matrix) + + end type sparse_matrix_type + + type, public :: diag_matrix_type + + !diagnoal matrix only store diagnoal entries + + real(r8), pointer :: DM(:,:) => null() ! entries in diagonal matrix (unit,diagonal matrix index) + integer SM ! Size of matrix, eg. for nxn matrix, SM=n + integer num_unit ! number of active unit, such as patch, col, or gridcell + integer begu ! begin index of unit in current process + integer endu ! end index of unit in current process + + contains + + procedure, public :: InitDM ! subroutine to initialize diagonal matrix type + procedure, public :: ReleaseDM ! subroutine to deallocate the diagonal matrix + procedure, public :: IsAllocDM ! return true if the diagonal matrix is allocated (InitDM was called) + procedure, public :: SetValueDM ! subroutine to set values in diagonal matrix + + end type diag_matrix_type + + type, public :: vector_type + + !vector + + real(r8), pointer :: V(:,:) => null() ! entries in vector (unit,vector index) + integer SV ! Size of vector + integer num_unit ! number of active unit, such as patch, col, or gridcell + integer begu ! begin index of unit in current process + integer endu ! end index of unit in current process + + contains + + procedure, public :: InitV ! subroutine to initialize vector type + procedure, public :: ReleaseV ! subroutine to deallocate veector type + procedure, public :: IsAllocV ! return true if the vector is allocated (InitV was called) + procedure, public :: SetValueV ! subroutine to set values in vector + procedure, public :: SetValueV_scaler ! subroutine to set a constant value to a vector + procedure, public :: SPMM_AX ! subroutine to calculate multiplication X(vector)=A(sparse matrix)*X(vector) + + end type vector_type + + integer, public, parameter :: empty_int = -9999 + real(r8), public, parameter :: empty_real = -9999._r8 + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + +subroutine InitSM(this,SM_in,begu,endu,maxsm) + +! Initialize the sparse matrix by giving the boundary of landunit/gridcell/column/patch, +! the size of matrix. Then allocate the matrix in a sparse matrix format + +class(sparse_matrix_type) :: this +integer,intent(in) :: SM_in +integer,intent(in) :: begu +integer,intent(in) :: endu +integer,optional,intent(in) :: maxsm +character(len=*),parameter :: subname = 'InitSM' + +if ( this%IsAllocSM() )then + call endrun( subname//" ERROR: Sparse Matrix was already allocated" ) + return +end if +this%SM = SM_in +this%begu = begu +this%endu = endu +if(present(maxsm))then + SHR_ASSERT_FL((maxsm >= 1), sourcefile, __LINE__) + SHR_ASSERT_FL((maxsm <= SM_in*SM_in), sourcefile, __LINE__) + allocate(this%M(begu:endu,1:maxsm)) +else + allocate(this%M(begu:endu,1:SM_in*SM_in)) +end if +allocate(this%RI(1:SM_in*SM_in)) +allocate(this%CI(1:SM_in*SM_in)) +this%M(:,:) = empty_real +this%RI(:) = empty_int +this%CI(:) = empty_int +this%NE = empty_int + +end subroutine InitSM + + ! ======================================================================== + + subroutine ReleaseSM(this) + + ! Release the Sparse Matrix data + + class(sparse_matrix_type) :: this + + this%SM = empty_int + this%begu = empty_int + this%endu = empty_int + if ( associated(this%M) )then + deallocate(this%M) + end if + if ( associated(this%RI) )then + deallocate(this%RI) + end if + if ( associated(this%CI) )then + deallocate(this%CI) + end if + this%M => null() + this%RI=> null() + this%CI=> null() + end subroutine ReleaseSM + + ! ======================================================================== + + logical function IsAllocSM(this) + + ! Check if the Sparse Matrix has been allocated (InitSM was called on it) + + class(sparse_matrix_type) :: this + + if ( associated(this%M) .or. associated(this%RI) .or. associated(this%CI) )then + IsAllocSM = .true. + else + IsAllocSM = .false. + end if + + end function IsAllocSM + + + ! ======================================================================== + + logical function IsEquivIdxSM(this, A) + + ! Check if the Sparse Matrix indices are eqiuivalent + + class(sparse_matrix_type) :: this + type(sparse_matrix_type), intent(in) :: A ! Sparse matrix indices to compare to + character(len=*),parameter :: subname = 'IsEquivIdxSM' + + ! Start checking easy critera and return if can determine status for sure, + ! keep checking harder things until everything has been checked for + if ( this%SM /= A%SM )then + IsEquivIdxSM = .false. + return + end if + if ( this%NE == A%NE )then + ! If NE is the same and the row and column indices are identical -- the + ! indices of the two arrays are identical + if ( all(this%RI(:this%NE) == A%RI(:this%NE)) .and. all(this%CI(:this%NE) == A%CI(:this%NE)) )then + IsEquivIdxSM = .true. + return + else + ! This needs more checking! The order could be different + IsEquivIdxSM = .false. + return + end if + else + ! This needs more checking! There could be some zerod entries in + ! non-zero positions + IsEquivIdxSM = .false. + return + end if + call endrun( subname//" ERROR: it should NOT be possible to reach this point" ) + return + + end function IsEquivIdxSM + + ! ======================================================================== + +subroutine SetValueSM(this,begu,endu,num_unit,filter_u,M,I,J,NE_in) + +! Set sparse matrix values by giving all non-zero values and the corresponding row and column indices. +! The information of active landunit/gridcell/column/patch is used to save computational cost. + +class(sparse_matrix_type) :: this +integer ,intent(in) :: begu +integer ,intent(in) :: endu +integer ,intent(in) :: NE_in +integer ,intent(in) :: num_unit +integer ,intent(in) :: filter_u(:) +real(r8),intent(in) :: M(begu:,1:) +integer ,intent(in) :: I(:) +integer ,intent(in) :: J(:) +character(len=*),parameter :: subname = 'SetValueSM' + +integer k,u,fu + +if ( .not. this%IsAllocSM() )then + call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) + return +end if +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M, 2) >= NE_in), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(I, 1) >= NE_in), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(J, 1) >= NE_in), sourcefile, __LINE__) +SHR_ASSERT_FL((lbound(M, 1) == begu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M, 1) == endu), sourcefile, __LINE__) +#ifndef _OPENMP +! Without OpenMP array sizes will be identical +SHR_ASSERT_FL((lbound(M, 1) == this%begu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M, 1) == this%endu), sourcefile, __LINE__) +#else +! With OpenMP the allocated array sizes might be larger than the input ones +SHR_ASSERT_FL((lbound(M, 1) >= this%begu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M, 1) <= this%endu), sourcefile, __LINE__) +#endif +SHR_ASSERT_FL((maxval(I(:this%NE)) <= this%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((minval(I(:this%NE)) >= 1), sourcefile, __LINE__) +SHR_ASSERT_FL((maxval(J(:this%NE)) <= this%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((minval(J(:this%NE)) >= 1), sourcefile, __LINE__) +do k = 1,NE_in + do fu = 1,num_unit + u = filter_u(fu) + this%M(u,k) = M(u,k) + end do +end do + +this%NE = NE_in +do k = 1,NE_in + this%RI(k) = I(k) + this%CI(k) = J(k) +end do + +end subroutine SetValueSM + + +subroutine SetValueA_diag(this,num_unit,filter_u,scaler) + +! Set diagonal sparse matrix values by giving a constant scaler. +! The information of active landunit/gridcell/column/patch is used to save computational cost. + +class(sparse_matrix_type) :: this +real(r8),intent(in) :: scaler +integer,intent(in) :: num_unit +integer,intent(in) :: filter_u(:) +integer i,u,fu +character(len=*),parameter :: subname = 'SetValueA_diag' + +if ( .not. this%IsAllocSM() )then + call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) + return +end if +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((lbound(this%M,1) == this%begu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(this%M,1) == this%endu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(this%M,2) >= this%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(this%RI,1) >= this%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(this%CI,1) >= this%SM), sourcefile, __LINE__) +do i=1,this%SM + do fu=1,num_unit + u = filter_u(fu) + this%M(u,i) = scaler + end do +end do + +do i=1,this%SM + this%RI(i) = i + this%CI(i) = i +end do +this%NE = this%SM + +end subroutine SetValueA_diag + + +subroutine SetValueA(this,begu,endu,num_unit,filter_u,M,AI,AJ,NE_NON,Init_ready,list,RI_A,CI_A) + +! Set sparse matrix values by giving values, rows, and columns of non-zero and non-diagonal entries. +! Then Set the diagonal entries to -1. The information of active landunit/gridcell/column/patch, +! The order and indices of non-diagonal entries in full sparse matrix are memorized to save computational cost, +! since these indices are usualy time-independent. + +class(sparse_matrix_type) :: this +integer ,intent(in) :: begu +integer ,intent(in) :: endu +integer ,intent(in) :: NE_NON +integer ,intent(in) :: num_unit +integer ,intent(in) :: filter_u(:) +real(r8),intent(in) :: M(begu:,1:) +integer ,intent(in) :: AI(:) +integer ,intent(in) :: AJ(:) +logical ,intent(inout) :: Init_ready !True: diagnoal of A has been set to -1,this%RI, this%CI, this%NE and list has been set up +integer ,intent(inout),optional :: list(:) +integer ,intent(inout),optional :: RI_A(:) +integer ,intent(inout),optional :: CI_A(:) + +integer i,j,k,fu,u +logical list_ready +type(sparse_matrix_type) :: A_diag, A_nondiag +character(len=*),parameter :: subname = 'SetValueA' + +list_ready = .false. + +if ( .not. this%IsAllocSM() )then + call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) + return +end if +if(init_ready .and. .not. (present(list) .and. present(RI_A) .and. present(CI_A)))then + write(iulog,*) "Error: initialization is ready, but at least one of list, RI_A or CI_A is not presented" + call endrun( subname//" ERROR: required optional arguments were NOT sent in" ) + return +end if +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((lbound(M,1) == begu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M,1) == endu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M,2) >= NE_NON), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(AI,1) >= NE_NON), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(AJ,1) >= NE_NON), sourcefile, __LINE__) +if ( present(list) )then + SHR_ASSERT_FL((ubound(list,1) >= NE_NON), sourcefile, __LINE__) +end if +if ( present(RI_A) )then + SHR_ASSERT_FL((ubound(RI_A,1) >= NE_NON+this%SM), sourcefile, __LINE__) +end if +if ( present(CI_A) )then + SHR_ASSERT_FL((ubound(CI_A,1) >= NE_NON+this%SM), sourcefile, __LINE__) +end if + +if(Init_ready)then + do i = 1,this%SM+NE_NON + do fu = 1,num_unit + u = filter_u(fu) + this%M(u,i) = -1._r8 + end do + end do + do i = 1,NE_NON + do fu = 1,num_unit + u = filter_u(fu) + this%M(u,list(i)) = M(u,i) + end do + end do + this%NE = this%SM+NE_NON + this%RI(1:this%NE) = RI_A(1:this%NE) + this%CI(1:this%NE) = CI_A(1:this%NE) +else + if ( A_diag%IsAllocSM() ) call A_diag%ReleaseSM() + if ( A_nondiag%IsAllocSM() ) call A_nondiag%ReleaseSM() + call A_diag%InitSM(this%SM,begu,endu) + call A_nondiag%InitSM(this%SM,begu,endu) + + call A_diag%SetValueA_diag(num_unit,filter_u,-1._r8) + call A_nondiag%SetValueSM(begu,endu,num_unit,filter_u,M,AI,AJ,NE_NON) + + if(present(list))then + call this%SPMP_AB(num_unit,filter_u,A_nondiag,A_diag,list_ready,list_A=list) + else + call this%SPMP_AB(num_unit,filter_u,A_nondiag,A_diag,list_ready) + end if + if(present(RI_A))RI_A(1:this%NE) = this%RI(1:this%NE) + if(present(CI_A))CI_A(1:this%NE) = this%CI(1:this%NE) + + Init_ready = .true. + call A_diag%ReleaseSM() + call A_nondiag%ReleaseSM() +end if + +end subroutine SetValueA + + + ! ======================================================================== + + subroutine SetValueCopySM(this, num_unit, filter_u, matrix) + + ! Set the sparse matrix by copying from another sparse matrix + + class(sparse_matrix_type) :: this + type(sparse_matrix_type), intent(in) :: matrix ! Sparse Matrix to copy + integer ,intent(in) :: num_unit + integer ,intent(in) :: filter_u(:) + character(len=*),parameter :: subname = 'SetValueCopySM' + + if ( .not. this%IsAllocSM() )then + call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) + return + end if + if ( .not. matrix%IsValuesSetSM() )then + call endrun( subname//" ERROR: Sparse Matrix data sent in was NOT already set" ) + return + end if + SHR_ASSERT_FL( (this%SM == matrix%SM), sourcefile, __LINE__) + SHR_ASSERT_FL( (this%begu == matrix%begu), sourcefile, __LINE__) + SHR_ASSERT_FL( (this%endu == matrix%endu), sourcefile, __LINE__) + SHR_ASSERT_FL((maxval(matrix%RI(:this%NE)) <= this%SM), sourcefile, __LINE__) + SHR_ASSERT_FL((minval(matrix%RI(:this%NE)) >= 1), sourcefile, __LINE__) + SHR_ASSERT_FL((maxval(matrix%CI(:this%NE)) <= this%SM), sourcefile, __LINE__) + SHR_ASSERT_FL((minval(matrix%CI(:this%NE)) >= 1), sourcefile, __LINE__) + call this%SetValueSM( matrix%begu, matrix%endu, num_unit, filter_u, matrix%M, & + matrix%RI, matrix%CI, matrix%NE) + + end subroutine SetValueCopySM + + ! ======================================================================== + + subroutine CopyIdxSM(this, matrix) + + ! Copy the indices from the input matrix to this sparse matrix + ! also make sure the sizes are consistent + + class(sparse_matrix_type) :: this + type(sparse_matrix_type), intent(in) :: matrix ! Sparse Matrix to copy + character(len=*),parameter :: subname = 'CopyIdxSM' + integer :: i + + if ( .not. this%IsAllocSM() )then + call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) + return + end if + if ( .not. matrix%IsValuesSetSM() )then + call endrun( subname//" ERROR: Sparse Matrix data sent in was NOT already set" ) + return + end if + SHR_ASSERT_FL( (this%SM == matrix%SM), sourcefile, __LINE__) + SHR_ASSERT_FL( (this%begu == matrix%begu), sourcefile, __LINE__) + SHR_ASSERT_FL( (this%endu == matrix%endu), sourcefile, __LINE__) + SHR_ASSERT_FL((maxval(matrix%RI(:matrix%NE)) <= this%SM), sourcefile, __LINE__) + SHR_ASSERT_FL((minval(matrix%RI(:matrix%NE)) >= 1), sourcefile, __LINE__) + SHR_ASSERT_FL((maxval(matrix%CI(:matrix%NE)) <= this%SM), sourcefile, __LINE__) + SHR_ASSERT_FL((minval(matrix%CI(:matrix%NE)) >= 1), sourcefile, __LINE__) + ! + ! Figure out the number of non-empty data values and make sure it's same as input + ! + this%NE = size(this%M,2) + do i = 1, this%NE + if ( all(this%M(:,i) == empty_int) )then + this%NE = i-1 + exit + end if + end do + if ( this%NE /= matrix%NE )then + call endrun( subname//" ERROR: Sparse Matrix empty data size is different from input one copying the indices from" ) + return + end if + ! + ! Copy indices + ! + this%RI(:this%NE) = matrix%RI(:matrix%NE) + this%CI(:this%NE) = matrix%CI(:matrix%NE) + end subroutine CopyIdxSM + + ! ======================================================================== + + logical function IsValuesSetSM(this) + + ! Check if the Sparse Matrix has it's data been set (One of the SetValue* subroutines was called on it) + + class(sparse_matrix_type) :: this + + if ( .not. this%IsAllocSM() )then + IsValuesSetSM = .false. + else if ( this%NE == empty_int )then + IsValuesSetSM = .false. + else + IsValuesSetSM = .true. + end if + + end function IsValuesSetSM + + ! ======================================================================== + +subroutine InitDM(this,SM_in,begu,endu) + +! Initialize the diagonal matrix by giving the boundary of landunit/gridcell/column/patch, +! the size of matrix. Then allocate the matrix in a diagonal matrix format + +class(diag_matrix_type) :: this +integer,intent(in) :: SM_in +integer,intent(in) :: begu +integer,intent(in) :: endu +character(len=*),parameter :: subname = 'InitDM' + +if ( this%IsAllocDM() )then + call endrun( subname//" ERROR: Diagonal Matrix was already allocated" ) + return +end if +this%SM = SM_in +allocate(this%DM(begu:endu,1:SM_in)) +this%DM(:,:) = empty_real +this%begu = begu +this%endu = endu + +end subroutine InitDM + + !----------------------------------------------------------------------- + subroutine ReleaseDM(this) + + ! Release the Diagonal Matrix data + + class(diag_matrix_type) :: this + + this%SM = empty_int + this%begu = empty_int + this%endu = empty_int + if ( associated(this%DM) )then + deallocate(this%DM) + end if + this%DM => null() + end subroutine ReleaseDM + + !----------------------------------------------------------------------- + logical function IsAllocDM(this) + + ! Check if the Diagonal Matrix is allocated (InitDM was called) + + class(diag_matrix_type) :: this + + if ( associated(this%DM) )then + IsAllocDM = .true. + else + IsAllocDM = .false. + end if + + end function IsAllocDM + + !----------------------------------------------------------------------- + +subroutine SetValueDM(this,begu,endu,num_unit,filter_u,M) + +! Set the diagonal matrix values by giving the values of diagonal entries in a right order. +! The information of active landunit/gridcell/column/patch is used to save computational cost. + +class(diag_matrix_type) :: this +integer ,intent(in) :: begu +integer ,intent(in) :: endu +real(r8),intent(in) :: M(begu:,1:) +integer ,intent(in) :: num_unit +integer ,intent(in) :: filter_u(:) +character(len=*),parameter :: subname = 'SetValueDM' + +integer i,fu,u + +if ( .not. this%IsAllocDM() )then + call endrun( subname//" ERROR: Diagonal matrix was NOT already allocated" ) + return +end if +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((lbound(M,1) == begu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M,1) == endu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M,2) >= this%SM), sourcefile, __LINE__) +do i = 1,this%SM + do fu = 1,num_unit + u = filter_u(fu) + this%DM(u,i) = M(u,i) + end do +end do + +end subroutine SetValueDM + + +subroutine InitV(this,SV_in,begu,endu) + +! Initialize the vector by giving the boundary of landunit/gridcell/column/patch, +! the size of vector. Then allocate the vector in a vector type + +class(vector_type) :: this +integer,intent(in) :: SV_in +integer,intent(in) :: begu +integer,intent(in) :: endu +character(len=*),parameter :: subname = 'InitV' + +if ( this%IsAllocV() )then + call endrun( subname//" ERROR: Vector was already allocated" ) + return +end if +this%SV = SV_in +allocate(this%V(begu:endu,1:SV_in)) +this%V(:,:) = empty_real +this%begu = begu +this%endu = endu + +end subroutine InitV + + +subroutine ReleaseV(this) + +! Deallocate vector type + +class(vector_type) :: this +if ( associated(this%V) )then + deallocate(this%V) +end if +this%V => null() +this%begu = empty_int +this%endu = empty_int +this%SV = empty_int + +end subroutine ReleaseV + + ! ======================================================================== + + logical function IsAllocV(this) + + ! Check if the Vector has been allocated (InitV was called on it) + + class(vector_type) :: this + + if ( associated(this%V) )then + IsAllocV = .true. + else + IsAllocV = .false. + end if + + end function IsAllocV + +subroutine SetValueV_scaler(this,num_unit,filter_u,scaler) + +! Set the vector values by giving a constant value +! The information of active landunit/gridcell/column/patch is used to save computational cost. + +class(vector_type) :: this +real(r8),intent(in) :: scaler +integer,intent(in) :: num_unit +integer,intent(in) :: filter_u(:) + +integer i,fu,u +character(len=*),parameter :: subname = 'SetValueV_scaler' + +if ( .not. this%IsAllocV() )then + call endrun( subname//" ERROR: Vector was NOT already allocated" ) + return +end if +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +do i=1,this%SV + do fu = 1,num_unit + u = filter_u(fu) + this%V(u,i) = scaler + end do +end do + +end subroutine SetValueV_scaler + + +subroutine SetValueV(this,begu,endu,num_unit,filter_u,M) + +! Set the vector values by giving the values in a right order. +! The information of active landunit/gridcell/column/patch is used to save computational cost. + +integer ,intent(in) :: begu +integer ,intent(in) :: endu +class(vector_type) :: this +real(r8),intent(in) :: M(begu:,1:) +integer ,intent(in) :: num_unit +integer ,intent(in) :: filter_u(:) + +integer i,fu,u +character(len=*),parameter :: subname = 'SetValueV' + +if ( .not. this%IsAllocV() )then + call endrun( subname//" ERROR: Vector was NOT already allocated" ) + return +end if +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((lbound(M,1) == begu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M,1) == endu), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(M,2) >= this%SV), sourcefile, __LINE__) +do i=1,this%SV + do fu = 1,num_unit + u = filter_u(fu) + this%V(u,i) = M(u,i) + end do +end do + +end subroutine SetValueV + + +subroutine SPMM_AK(this,num_unit,filter_u,K) + +! Calculate sparse matrix multiplication (SPMM) A(this) = A(this)*K +! The information of active landunit/gridcell/column/patch is used to save computational cost. +! A is a sparse matrix in Coordinate format (COO). +! K is a diagnoal matrix. + +class(sparse_matrix_type) :: this +type(diag_matrix_type) ,intent(in) :: K +integer,intent(in) :: num_unit +integer,intent(in) :: filter_u(:) + +integer i,fu,u + +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SM == K%SM), sourcefile, __LINE__) +do i=1,this%NE + do fu = 1,num_unit + u = filter_u(fu) + this%M(u,i) = this%M(u,i) * K%DM(u,this%CI(i)) + end do +end do + +end subroutine SPMM_AK + + +subroutine SPMM_AX(this,num_unit,filter_u,A) + +! Calculate sparse matrix multiplication (SPMM) X(this) = X(this) + A*X(this) +! The information of active landunit/gridcell/column/patch is used to save computational cost. +! A is a sparse matrix in Coordinate format (COO). +! X is a vector type. + +class(vector_type) :: this +type(sparse_matrix_type),intent(in) :: A +integer,intent(in) :: num_unit +integer,intent(in) :: filter_u(:) + +integer i,fu,u +real(r8) :: V(this%begu:this%endu,1:this%SV) + +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(this%V,2) == this%SV), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SV <= A%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(this%V,2) == this%SV), sourcefile, __LINE__) +SHR_ASSERT_FL((ubound(A%M,2) >= A%NE), sourcefile, __LINE__) +SHR_ASSERT_FL((maxval(A%RI) <= this%SV), sourcefile, __LINE__) +SHR_ASSERT_FL((maxval(A%CI) <= this%SV), sourcefile, __LINE__) +do i=1,this%SV + do fu = 1, num_unit + u = filter_u(fu) + V(u,i) = this%V(u,i) + end do +end do + +do i=1,A%NE + do fu = 1, num_unit + u = filter_u(fu) + this%V(u,A%RI(i)) = this%V(u,A%RI(i)) + A%M(u,i) * V(u,A%CI(i)) + end do +end do + +end subroutine SPMM_AX + + +subroutine SPMP_B_ACC(this,num_unit,filter_u,A) + +! Calculate sparse matrix addition (SPMP) B(this) = B(this) + A +! The information of active landunit/gridcell/column/patch is used to save computational cost. +! A and B are sparse matrix in Coordinate format (COO). +! Entry locations of A and B should be the same. + +class(sparse_matrix_type) :: this +type(sparse_matrix_type),intent(in) :: A +integer,intent(in) :: num_unit +integer,intent(in) :: filter_u(:) + +integer i,fu,u + +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SM == A%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((this%NE == A%NE), sourcefile, __LINE__) +SHR_ASSERT_ALL_FL((this%RI == A%RI), sourcefile, __LINE__) +SHR_ASSERT_ALL_FL((this%CI == A%CI), sourcefile, __LINE__) + +do i=1,A%NE + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i) = this%M(u,i) + A%M(u,i) + end do +end do + +end subroutine SPMP_B_ACC + + +subroutine SPMP_AB(this,num_unit,filter_u,A,B,list_ready,list_A,list_B,NE_AB,RI_AB,CI_AB) + +! Calculate sparse matrix addition (SPMP) AB(this) = A + B +! The map of each entry in A and B to AB have been memorized to save the computational cost, +! since they are usually time-independent. +! The information of active landunit/gridcell/column/patch is used to save computational cost. +! A is a sparse matrix in Coordinate format (COO) +! B is a sparse matrix in Coordinate format (COO) +! AB is a sparse matrix in Coordinate format (COO) + +class(sparse_matrix_type) :: this +type(sparse_matrix_type),intent(in) :: A +type(sparse_matrix_type),intent(in) :: B +logical,intent(inout) :: list_ready +integer,intent(in) :: num_unit +integer,intent(in) :: filter_u(:) + +integer,intent(inout),optional :: list_A(:) +integer,intent(inout),optional :: list_B(:) +integer,intent(inout),optional :: NE_AB +integer,intent(inout),optional :: RI_AB(:) +integer,intent(inout),optional :: CI_AB(:) + +integer,dimension(:) :: Aindex(A%NE+1),Bindex(B%NE+1) +integer,dimension(:) :: ABindex(this%SM*this%SM) + +integer i_a,i_b,i_ab +integer i,fu,u +character(len=*),parameter :: subname = 'SPMP_AB' + +! 'list_ready = .true.' means list_A, list_B, NE_AB, RI_AB, and CI_AB have been memorized before. +! In this case they all need to be presented. Otherwise, use 'list_ready = .false.' to get those information +! for the first time call this subroutine. + +if ( present(list_A) )then + SHR_ASSERT_FL((ubound(list_A,1) >= A%NE), sourcefile, __LINE__) +end if +if ( present(list_B) )then + SHR_ASSERT_FL((ubound(list_B,1) >= B%NE), sourcefile, __LINE__) +end if +if ( present(RI_AB) )then + SHR_ASSERT_FL((ubound(RI_AB,1) >= A%NE+B%NE), sourcefile, __LINE__) +end if +if ( present(CI_AB) )then + SHR_ASSERT_FL((ubound(CI_AB,1) >= A%NE+B%NE), sourcefile, __LINE__) +end if +if(list_ready .and. .not. (present(list_A) .and. present(list_B) .and. present(NE_AB) .and. present(RI_AB) .and. present(CI_AB)))then + write(iulog,*) "error in SPMP_AB: list_ready is True, but at least one of list_A, list_B, NE_AB, RI_AB and CI_AB are not presented" + call endrun( subname//" ERROR: missing required optional arguments" ) + return +end if +SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) +SHR_ASSERT_FL((A%NE > 0), sourcefile, __LINE__) +SHR_ASSERT_FL((B%NE > 0), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SM > 0), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SM == A%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SM == B%SM), sourcefile, __LINE__) + +if(.not. list_ready)then + i_a=1 + i_b=1 + i_ab=1 + Aindex(1:A%NE) = (A%CI(1:A%NE)-1)*A%SM + A%RI(1:A%NE) + Bindex(1:B%NE) = (B%CI(1:B%NE)-1)*B%SM + B%RI(1:B%NE) + Aindex(A%NE+1) = A%SM*A%SM + 1 + Bindex(B%NE+1) = B%SM*B%SM + 1 + + do while (i_a .le. A%NE .or. i_b .le. B%NE) + if(Aindex(i_a) .lt. Bindex(i_b))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_ab) = A%M(u,i_a) + end do + ABindex(i_ab) = Aindex(i_a) + if(present(list_A))list_A(i_a) = i_ab + i_a = i_a + 1 + i_ab = i_ab + 1 + else + if(Aindex(i_a) .gt. Bindex(i_b))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_ab) = B%M(u,i_b) + end do + ABindex(i_ab) = Bindex(i_b) + if(present(list_B))list_B(i_b) = i_ab + i_b = i_b + 1 + i_ab = i_ab + 1 + else + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_ab) = A%M(u,i_a) + B%M(u,i_b) + end do + ABindex(i_ab) = Aindex(i_a) + if(present(list_A))list_A(i_a) = i_ab + if(present(list_B))list_B(i_b) = i_ab + i_a = i_a + 1 + i_b = i_b + 1 + i_ab = i_ab + 1 + end if + end if + end do + + this%NE = i_ab - 1 + this%CI(1:this%NE) = (ABindex(1:this%NE) - 1) / this%SM + 1 + this%RI(1:this%NE) = ABindex(1:this%NE) - this%SM * (this%CI(1:this%NE) - 1) + if(present(NE_AB))NE_AB = this%NE + if(present(CI_AB))CI_AB(1:this%NE) = this%CI(1:this%NE) + if(present(RI_AB))RI_AB(1:this%NE) = this%RI(1:this%NE) + if(present(list_A) .and. present(list_B) .and. present(NE_AB) .and. present(RI_AB) .and. present(CI_AB))list_ready = .true. +else + do i = 1, NE_AB + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i) = 0._r8 + end do + end do + do i_a = 1, A%NE + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,list_A(i_a)) = A%M(u,i_a) + end do + end do + do i_b = 1, B%NE + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,list_B(i_b)) = this%M(u,list_B(i_b)) + B%M(u,i_b) + end do + end do + this%NE = NE_AB + this%CI(1:this%NE) = CI_AB(1:NE_AB) + this%RI(1:this%NE) = RI_AB(1:NE_AB) +end if + +end subroutine SPMP_AB + +subroutine SPMP_ABC(this,num_unit,filter_u,A,B,C,list_ready,list_A,list_B,list_C,NE_ABC,RI_ABC,CI_ABC,& + use_actunit_list_A,num_actunit_A,filter_actunit_A,use_actunit_list_B,num_actunit_B,filter_actunit_B,& + use_actunit_list_C,num_actunit_C,filter_actunit_C) + +! Calculate sparse matrix addition (SPMP) ABC(this) = A + B + C +! The map of each entry in A, B and C to ABC have been memorized to save the computational cost, +! since they are usually time-independent. +! The information of active landunit/gridcell/column/patch is used to save computational cost. +! A is a sparse matrix in Coordinate format (COO) +! B is a sparse matrix in Coordinate format (COO) +! C is a sparse matrix in Coordinate format (COO) +! ABC is a sparse matrix in Coordinate format (COO) + +class(sparse_matrix_type) :: this +type(sparse_matrix_type),intent(in) :: A +type(sparse_matrix_type),intent(in) :: B +type(sparse_matrix_type),intent(in) :: C +logical,intent(inout) :: list_ready +integer,intent(in) :: num_unit +integer,intent(in) :: filter_u(:) +logical,intent(in),optional :: use_actunit_list_A +logical,intent(in),optional :: use_actunit_list_B +logical,intent(in),optional :: use_actunit_list_C +integer,intent(in),optional :: num_actunit_A +integer,intent(in),optional :: num_actunit_B +integer,intent(in),optional :: num_actunit_C +integer,dimension(:),intent(in),optional :: filter_actunit_A +integer,dimension(:),intent(in),optional :: filter_actunit_B +integer,dimension(:),intent(in),optional :: filter_actunit_C + +integer,intent(inout),optional :: list_A(:) +integer,intent(inout),optional :: list_B(:) +integer,intent(inout),optional :: list_C(:) +integer,intent(inout),optional :: NE_ABC +integer,intent(inout),optional :: RI_ABC(:) +integer,intent(inout),optional :: CI_ABC(:) + +! Local data +integer,dimension(:) :: Aindex(A%NE+1),Bindex(B%NE+1),Cindex(C%NE+1) +integer,dimension(:) :: ABCindex(this%SM*this%SM) + +integer i_a,i_b,i_c,i_abc +integer i,fu,u +character(len=*),parameter :: subname = 'SPMP_ABC' + +! 'list_ready = .true.' means list_A, list_B, list_C, NE_ABC, RI_ABC, and CI_ABC have been memorized before. +! In this case they all need to be presented. Otherwise, use 'list_ready = .false.' to get those information +! for the first time call this subroutine. + +SHR_ASSERT_FL((this%SM > 0), sourcefile, __LINE__) +SHR_ASSERT_FL((A%NE > 0), sourcefile, __LINE__) +SHR_ASSERT_FL((B%NE > 0), sourcefile, __LINE__) +SHR_ASSERT_FL((C%NE > 0), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SM == A%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SM == B%SM), sourcefile, __LINE__) +SHR_ASSERT_FL((this%SM == C%SM), sourcefile, __LINE__) +if( present(list_A) )then + SHR_ASSERT_FL((size(list_A) >= A%NE), sourcefile, __LINE__) +end if +if( present(list_B) )then + SHR_ASSERT_FL((size(list_B) >= B%NE), sourcefile, __LINE__) +end if +if( present(list_C) )then + SHR_ASSERT_FL((size(list_C) >= C%NE), sourcefile, __LINE__) +end if +if( present(RI_ABC) )then + SHR_ASSERT_FL((size(RI_ABC) >= A%NE+B%NE+C%NE), sourcefile, __LINE__) +end if +if( present(CI_ABC) )then + SHR_ASSERT_FL((size(CI_ABC) >= A%NE+B%NE+C%NE), sourcefile, __LINE__) +end if +if(list_ready .and. .not. (present(list_A) .and. present(list_B) .and. present(list_C) .and. present(NE_ABC) .and. present(RI_ABC) .and. present(CI_ABC)))then + write(iulog,*) "error in SPMP_ABC: list_ready is True, but at least one of list_A, list_B, list_C, NE_ABC, RI_ABC and CI_ABC are not presented",& + present(list_A),present(list_B),present(list_C),present(NE_ABC),present(RI_ABC),present(CI_ABC) + call endrun( subname//" ERROR: missing required optional arguments" ) + return +end if +if(present(num_actunit_A))then + if(num_actunit_A < 0)then + write(iulog,*) "error: num_actunit_A cannot be less than 0" + call endrun( subname//" ERROR: bad value for num_actunit_A" ) + return + end if + if(.not. present(filter_actunit_A))then + write(iulog,*) "error: num_actunit_A is presented but filter_actunit_A is missing" + call endrun( subname//" ERROR: missing required optional arguments" ) + return + end if + SHR_ASSERT_FL((size(filter_actunit_A) > num_actunit_A), sourcefile, __LINE__) +end if +if(present(num_actunit_B))then + if(num_actunit_B < 0)then + write(iulog,*) "error: num_actunit_B cannot be less than 0" + call endrun( subname//" ERROR: bad value for num_actunit_B" ) + return + end if + if(.not. present(filter_actunit_B))then + write(iulog,*) "error: num_actunit_B is presented but filter_actunit_B is missing" + call endrun( subname//" ERROR: missing required optional arguments" ) + return + end if + SHR_ASSERT_FL((size(filter_actunit_B) > num_actunit_B), sourcefile, __LINE__) +end if +if(present(num_actunit_C))then + if(num_actunit_C < 0)then + write(iulog,*) "error: num_actunit_C cannot be less than 0" + call endrun( subname//" ERROR: bad value for num_actunit_C" ) + return + end if + if(.not. present(filter_actunit_C))then + write(iulog,*) "error: num_actunit_C is presented but filter_actunit_C is missing" + call endrun( subname//" ERROR: missing required optional arguments" ) + return + end if + SHR_ASSERT_FL((size(filter_actunit_C) > num_actunit_C), sourcefile, __LINE__) +end if + +if(.not. list_ready)then + i_a=1 + i_b=1 + i_c=1 + i_abc=1 + Aindex(1:A%NE) = (A%CI(1:A%NE)-1)*A%SM+A%RI(1:A%NE) + Bindex(1:B%NE) = (B%CI(1:B%NE)-1)*B%SM+B%RI(1:B%NE) + Cindex(1:C%NE) = (C%CI(1:C%NE)-1)*C%SM+C%RI(1:C%NE) + Aindex(A%NE+1) = A%SM*A%SM+1 + Bindex(B%NE+1) = B%SM*B%SM+1 + Cindex(C%NE+1) = C%SM*C%SM+1 + + do while (i_a .le. A%NE .or. i_b .le. B%NE .or. i_c .le. C%NE) + if(Aindex(i_a) .lt. Bindex(i_b) .and. Aindex(i_a) .lt. Cindex(i_c))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_abc) = A%M(u,i_a) + end do + ABCindex(i_abc) = Aindex(i_a) + if(present(list_A))list_A(i_a) = i_abc + i_a = i_a + 1 + i_abc = i_abc + 1 + else + if(Bindex(i_b) .lt. Aindex(i_a) .and. Bindex(i_b) .lt. Cindex(i_c))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_abc) = B%M(u,i_b) + end do + ABCindex(i_abc) = Bindex(i_b) + if(present(list_B))list_B(i_b) = i_abc + i_b = i_b + 1 + i_abc = i_abc + 1 + else + if(Cindex(i_c) .lt. Aindex(i_a) .and. Cindex(i_c) .lt. Bindex(i_b))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_abc) = C%M(u,i_c) + end do + ABCindex(i_abc) = Cindex(i_c) + if(present(list_C))list_C(i_c) = i_abc + i_c = i_c + 1 + i_abc = i_abc + 1 + else + if(Aindex(i_a) .eq. Bindex(i_b) .and. Aindex(i_a) .lt. Cindex(i_c))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_abc) = A%M(u,i_a) + B%M(u,i_b) + end do + ABCindex(i_abc) = Aindex(i_a) + if(present(list_A))list_A(i_a) = i_abc + if(present(list_B))list_B(i_b) = i_abc + i_a = i_a + 1 + i_b = i_b + 1 + i_abc = i_abc + 1 + else + if(Aindex(i_a) .eq. Cindex(i_c) .and. Aindex(i_a) .lt. Bindex(i_b))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_abc) = A%M(u,i_a) + C%M(u,i_c) + end do + ABCindex(i_abc) = Aindex(i_a) + if(present(list_A))list_A(i_a) = i_abc + if(present(list_C))list_C(i_c) = i_abc + i_a = i_a + 1 + i_c = i_c + 1 + i_abc = i_abc + 1 + else + if(Bindex(i_b) .eq. Cindex(i_c) .and. Bindex(i_b) .lt. Aindex(i_a))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_abc) = B%M(u,i_b) + C%M(u,i_c) + end do + ABCindex(i_abc) = Bindex(i_b) + if(present(list_B))list_B(i_b) = i_abc + if(present(list_C))list_C(i_c) = i_abc + i_b = i_b + 1 + i_c = i_c + 1 + i_abc = i_abc + 1 + else + if(Aindex(i_a) .eq. Bindex(i_b) .and. Aindex(i_a) .eq. Cindex(i_c))then + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i_abc) = A%M(u,i_a) + B%M(u,i_b) + C%M(u,i_c) + end do + ABCindex(i_abc) = Bindex(i_b) + if(present(list_A))list_A(i_a) = i_abc + if(present(list_B))list_B(i_b) = i_abc + if(present(list_C))list_C(i_c) = i_abc + i_a = i_a + 1 + i_b = i_b + 1 + i_c = i_c + 1 + i_abc = i_abc + 1 + else + write(iulog,*) 'Error in subroutine SPMP_ABC',Aindex(i_a),Bindex(i_b),Cindex(i_c) + end if + end if + end if + end if + end if + end if + end if + end do + + this%NE = i_abc - 1 + this%CI(1:this%NE) = (ABCindex(1:this%NE) - 1) / this%SM + 1 + this%RI(1:this%NE) = ABCindex(1:this%NE) - this%SM * (this%CI(1:this%NE) - 1) + if(present(NE_ABC))NE_ABC = this%NE + if(present(CI_ABC))CI_ABC(1:this%NE) = this%CI(1:this%NE) + if(present(RI_ABC))RI_ABC(1:this%NE) = this%RI(1:this%NE) + if(present(list_A) .and. present(list_B) .and. present(list_C) .and. present(NE_ABC) .and. present(RI_ABC) .and. present(CI_ABC))list_ready = .true. +else + do i = 1, NE_ABC + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,i) = 0._r8 + end do + end do + if(present(num_actunit_A))then + do i_a = 1, A%NE + do fu = 1, num_actunit_A + u = filter_actunit_A(fu) + this%M(u,list_A(i_a)) = A%M(u,i_a) + end do + end do + else + do i_a = 1, A%NE + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,list_A(i_a)) = A%M(u,i_a) + end do + end do + end if + if(present(num_actunit_B))then + do i_b = 1, B%NE + do fu = 1, num_actunit_B + u = filter_actunit_B(fu) + this%M(u,list_B(i_b)) = this%M(u,list_B(i_b)) + B%M(u,i_b) + end do + end do + else + do i_b = 1, B%NE + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,list_B(i_b)) = this%M(u,list_B(i_b)) + B%M(u,i_b) + end do + end do + end if + if(present(num_actunit_C))then + do i_c = 1, C%NE + do fu = 1, num_actunit_C + u = filter_actunit_C(fu) + this%M(u,list_C(i_c)) = this%M(u,list_C(i_c)) + C%M(u,i_c) + end do + end do + else + do i_c = 1, C%NE + do fu = 1, num_unit + u = filter_u(fu) + this%M(u,list_C(i_c)) = this%M(u,list_C(i_c)) + C%M(u,i_c) + end do + end do + end if + this%NE = NE_ABC + this%CI(1:this%NE) = CI_ABC(1:NE_ABC) + this%RI(1:this%NE) = RI_ABC(1:NE_ABC) +end if + +end subroutine SPMP_ABC + +end module SPMMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index dad5bcffe..63d9cd667 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -48,6 +48,10 @@ module clm_varcon real(r8), public, parameter :: secsphr = 3600._r8 ! Seconds in an hour real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data integer , public, parameter :: ispval = -9999 ! special value for int data + integer, public, parameter :: fun_period = 1 ! A FUN parameter, and probably needs to be changed for testing + real(r8),public, parameter :: smallValue = 1.e-12_r8 ! A small values used by FUN + + !------------------------------------------------------------------ ! Soil depths From 3d182a5d92213fb4b0f24790275d06aa3b08d854 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 13 Nov 2024 09:48:58 -0500 Subject: [PATCH 555/589] remove vegetation matrix functionality --- .../CLM51/CMakeLists.txt | 3 - .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 11 + .../CLM51/CNFUNMod.F90 | 12 +- .../CLM51/CNVegMatrixMod.F90 | 3839 ----------------- .../CLM51/MatrixMod.F90 | 144 - .../CLM51/SPMMod.F90 | 1234 ------ .../CLM51/clm_time_manager.F90 | 37 + .../CLM51/clm_varctl.F90 | 6 + 8 files changed, 60 insertions(+), 5226 deletions(-) delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegMatrixMod.F90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/MatrixMod.F90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SPMMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index cebfcc7bb..3b8036ec5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -94,7 +94,6 @@ set (srcs CNRootDynMod.F90 CNSharedParamsMod.F90 CNVegetationFacade.F90 - CNVegMatrixMod.F90 CNVegStructUpdateMod.F90 column_varcon.F90 fileutils.F90 @@ -102,7 +101,6 @@ set (srcs FireMethodType.F90 initSubgridMod.F90 landunit_varcon.F90 - MatrixMod.F90 ncdio_pio.F90 NutrientCompetitionCLM45defaultMod.F90 NutrientCompetitionFactoryMod.F90 @@ -135,7 +133,6 @@ set (srcs SoilBiogeochemVerticalProfileMod.F90 SoilWaterRetentionCurveMod.F90 spmdMod.F90 - SPMMod.F90 subgridAveMod.F90 SurfaceAlbedoMod.F90 SurfaceRadiationMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index 811eae567..f250df0ed 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -28,6 +28,8 @@ module CNVegCarbonFluxType use MAPL_ExceptionHandling use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg +! use SPMMod , only : sparse_matrix_type, diag_matrix_type, vector_type + ! !PUBLIC TYPES: implicit none @@ -468,6 +470,15 @@ module CNVegCarbonFluxType integer,pointer :: list_agmc (:) ! Indices of non-diagnoal entries in full sparse matrix Agm for C cycle integer,pointer :: list_afic (:) ! Indices of non-diagnoal entries in full sparse matrix Afi for C cycle +! type(sparse_matrix_type) :: AKphvegc ! Aph*Kph for C cycle in sparse matrix format +! type(sparse_matrix_type) :: AKgmvegc ! Agm*Kgm for C cycle in sparse matrix format +! type(sparse_matrix_type) :: AKfivegc ! Afi*Kfi for C cycle in sparse matrix format +! type(sparse_matrix_type) :: AKallvegc ! Aph*Kph + Agm*Kgm + Afi*Kfi for C cycle in sparse matrix format +! +! type(vector_type) :: Xvegc ! Vegetation C of each compartment in a vector format +! type(vector_type) :: Xveg13c ! Vegetation C13 of each compartment in a vector format +! type(vector_type) :: Xveg14c ! Vegetation C14 of each compartment in a vector format + ! Objects that help convert once-per-year dynamic land cover changes into fluxes ! that are dribbled throughout the year type(annual_flux_dribbler_type) :: dwt_conv_cflux_dribbler diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 index 12dbda862..d5ccc862f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 @@ -217,7 +217,7 @@ subroutine CNFUN(bounds,num_soilc, filter_soilc,num_soilp& use PatchType , only : patch use subgridAveMod , only : p2c use pftconMod , only : npcropmin - use CNVegMatrixMod , only : matrix_update_phn + !use CNVegMatrixMod , only : matrix_update_phn ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -1456,11 +1456,11 @@ subroutine CNFUN(bounds,num_soilc, filter_soilc,num_soilp& if(.not. use_matrixcn)then free_retransn_to_npool(p) = free_nretrans(p)/dt else - if(retransn(p) .gt. 0)then - free_retransn_to_npool(p) = retransn(p) * matrix_update_phn(p,iretransn_to_iout,free_nretrans(p)/dt/retransn(p),dt,cnveg_nitrogenflux_inst,.true.,.true.) - else - free_retransn_to_npool(p) = 0._r8 - end if +! if(retransn(p) .gt. 0)then +! free_retransn_to_npool(p) = retransn(p) * matrix_update_phn(p,iretransn_to_iout,free_nretrans(p)/dt/retransn(p),dt,cnveg_nitrogenflux_inst,.true.,.true.) +! else +! free_retransn_to_npool(p) = 0._r8 +! end if end if ! this is the N that comes off leaves. Nretrans(p) = retransn_to_npool(p) + free_retransn_to_npool(p) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegMatrixMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegMatrixMod.F90 deleted file mode 100755 index 3bb68a9dc..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegMatrixMod.F90 +++ /dev/null @@ -1,3839 +0,0 @@ -module CNVegMatrixMod - - !--------------------------------------------------------------------------------------- - ! The matrix model of CLM5.0 was developed by Yiqi Luo EcoLab members, - ! Drs. Xingjie Lu, Yuanyuan Huang and Zhengguang Du, at Northern Arizona University - !--------------------------------------------------------------------------------------- - ! - ! DESCRIPTION: - ! Matrix solution for vegetation C and N cycles - ! The matrix equation - ! Xn+1 = Xn + B*I*dt + (Aph*Kph + Agm*Kgm + Afi*Kfi) * Xn*dt - ! Xn is the state variable of last time step n, and Xn+1 is the state variable of - ! the next time step n+1, I is the input to the vegetation, i.e. NPP in this case. - ! B is allocation fraction vector. - ! Aph, Agm and Afi represent transfer coefficient matrix A from phenology, gap mortality - ! and fire related C and N transfers. - ! Kph, Kgm and Kfi represent turnover rate matrix K from phenology, gap mortality - ! and fire related C and N transfers. - !--------------------------------------------------------------------------------------- - - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_time_manager , only : get_step_size,is_end_curr_year,is_first_step_of_this_run_segment,& - get_days_per_year,is_beg_curr_year,update_DA_nstep - use decompMod , only : bounds_type - use clm_varpar , only : nlevdecomp, nvegcpool, nvegnpool - use clm_varpar , only : ileaf,ileaf_st,ileaf_xf,ifroot,ifroot_st,ifroot_xf,& - ilivestem,ilivestem_st,ilivestem_xf,& - ideadstem,ideadstem_st,ideadstem_xf,& - ilivecroot,ilivecroot_st,ilivecroot_xf,& - ideadcroot,ideadcroot_st,ideadcroot_xf,& - igrain,igrain_st,igrain_xf,iretransn,ioutc,ioutn,& - ncphtrans,nnphtrans,ncgmtrans,nngmtrans,ncfitrans,nnfitrans,& - ncphouttrans,nnphouttrans,ncgmouttrans,nngmouttrans,ncfiouttrans,nnfiouttrans - use perf_mod , only : t_startf, t_stopf - use PatchType , only : patch - use clm_varcon , only : secspday - use pftconMod , only : pftcon,npcropmin - use CNVegCarbonStateType , only : cnveg_carbonstate_type - use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type - use CNVegCarbonFluxType , only : cnveg_carbonflux_type !include: callocation,ctransfer, cturnover - use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type - use CNVegStateType , only : cnveg_state_type - use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type - use clm_varctl , only : isspinup, is_outmatrix, nyr_forcing, nyr_SASU, iloop_avg - use clm_varctl , only : use_c13, use_c14 - use SPMMod , only : sparse_matrix_type,diag_matrix_type,vector_type - use MatrixMod , only : inverse - ! - implicit none - private - ! - ! !PUBLIC MEMBER FUNCTIONS: - public:: CNVegMatrix - public:: matrix_update_phc,matrix_update_gmc,matrix_update_fic - public:: matrix_update_phn,matrix_update_gmn,matrix_update_fin - public:: CNVegMatrixRest - - ! ! PRIVATE MEMBER DATA: - integer,save, private :: iyr=0 ! Cycling year number into forcing sequence - integer,save, private :: iloop=0 ! The iloop^th forcing loop - !----------------------------------------------------------------------- - -contains - - !----------------------------------------------------------------------- - subroutine CNVegMatrix(bounds,num_soilp,filter_soilp,num_actfirep,filter_actfirep,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst,& - cnveg_carbonflux_inst, cnveg_nitrogenflux_inst,cnveg_state_inst,soilbiogeochem_nitrogenflux_inst, & - c13_cnveg_carbonstate_inst,c14_cnveg_carbonstate_inst,c13_cnveg_carbonflux_inst,& - c14_cnveg_carbonflux_inst) - ! !DESCRIPTION: - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - integer , intent(in) :: num_actfirep ! number of soil patches in filter - integer , intent(in) :: filter_actfirep(:) ! filter for soil patches - type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst - type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst - type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst - type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst - type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst - type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst - type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst - type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst - type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst - type(cnveg_state_type) , intent(in) :: cnveg_state_inst - -! LOCAL VARIABLES: - integer :: fc,fp,j,i,k ! indices - integer :: p,c ! - - ! Temporary variables matrix A for different processes - real(r8),dimension(:,:) :: Aphconed(bounds%begp:bounds%endp,ncphtrans-ncphouttrans) - real(r8),dimension(:,:) :: Aphnoned(bounds%begp:bounds%endp,nnphtrans-nnphouttrans) - real(r8),dimension(:,:) :: Agmconed(bounds%begp:bounds%endp,ncgmtrans-ncgmouttrans) - real(r8),dimension(:,:) :: Agmnoned(bounds%begp:bounds%endp,nngmtrans-nngmouttrans) - real(r8),dimension(:,:) :: Aficoned(bounds%begp:bounds%endp,ncfitrans-ncfiouttrans) - real(r8),dimension(:,:) :: Afic14oned(bounds%begp:bounds%endp,ncfitrans-ncfiouttrans) - real(r8),dimension(:,:) :: Afinoned(bounds%begp:bounds%endp,nnfitrans-nnfiouttrans) - - ! Temporary variables saving row indices of all transfers in different processes - integer,dimension(:) :: AI_phc(ncphtrans-ncphouttrans) - integer,dimension(:) :: AI_phn(nnphtrans-nnphouttrans) - integer,dimension(:) :: AI_gmc(ncgmtrans-ncgmouttrans) - integer,dimension(:) :: AI_gmn(nngmtrans-nngmouttrans) - integer,dimension(:) :: AI_fic(ncfitrans-ncfiouttrans) - integer,dimension(:) :: AI_fic14(ncfitrans-ncfiouttrans) - integer,dimension(:) :: AI_fin(nnfitrans-nnfiouttrans) - - ! Temporary variables saving column indices of all transfers in different processes - integer,dimension(:) :: AJ_phc(ncphtrans-ncphouttrans) - integer,dimension(:) :: AJ_phn(nnphtrans-nnphouttrans) - integer,dimension(:) :: AJ_gmc(ncgmtrans-ncgmouttrans) - integer,dimension(:) :: AJ_gmn(nngmtrans-nngmouttrans) - integer,dimension(:) :: AJ_fic(ncfitrans-ncfiouttrans) - integer,dimension(:) :: AJ_fic14(ncfitrans-ncfiouttrans) - integer,dimension(:) :: AJ_fin(nnfitrans-nnfiouttrans) - - ! Temporary variables for matrix operation, which save C and N inputs to different vegetation compartments as a vector type. - type(vector_type) :: vegmatrixc_input - type(vector_type) :: vegmatrixc13_input - type(vector_type) :: vegmatrixc14_input - type(vector_type) :: vegmatrixn_input - - ! "init" indicators indicate whether A matrices have been initialized. - logical, save :: init_ready_aphc = .false. - logical, save :: init_ready_agmc = .false. - logical, save :: init_ready_afic = .false. - logical, save :: init_ready_afic14 = .false. - logical, save :: init_ready_aphn = .false. - logical, save :: init_ready_agmn = .false. - logical, save :: init_ready_afin = .false. - - ! "list" indicators indicate whether operation of sparse matrix plus SPMP_AB or SPMP_ABC has already been saved. - logical, save :: list_ready_phgmfic = .false. - logical, save :: list_ready_phgmfic14 = .false. - logical, save :: list_ready_phgmc = .false. - logical, save :: list_ready_phgmfin = .false. - logical, save :: list_ready_phgmn = .false. - - ! Temporary variables are only used at end of the year to calculate C and N storage capacity - real(r8),dimension(:) :: matrix_calloc_acc (1:nvegcpool) - real(r8),dimension(:) :: matrix_nalloc_acc (1:nvegnpool) - real(r8),dimension(:,:) :: matrix_ctransfer_acc (1:nvegcpool,1:nvegcpool) - real(r8),dimension(:,:) :: matrix_ntransfer_acc (1:nvegnpool,1:nvegnpool) - real(r8),dimension(:) :: matrix_c13alloc_acc (1:nvegcpool) - real(r8),dimension(:,:) :: matrix_c13transfer_acc (1:nvegcpool,1:nvegcpool) - real(r8),dimension(:) :: matrix_c14alloc_acc (1:nvegcpool) - real(r8),dimension(:,:) :: matrix_c14transfer_acc (1:nvegcpool,1:nvegcpool) - - ! Local variables for capacity calculation and spin up - real(r8),dimension(:) :: vegmatrixc_rt(1:nvegcpool) ! C storage capacity - real(r8),dimension(:) :: vegmatrixc13_rt(1:nvegcpool) ! C13 storage capacity - real(r8),dimension(:) :: vegmatrixc14_rt(1:nvegcpool) ! C14 storage capacity - real(r8),dimension(:) :: vegmatrixn_rt(1:nvegnpool) ! N storage capacity - real(r8),dimension(:,:) :: AKinvc(1:nvegcpool,1:nvegcpool),AKinvn(1:nvegnpool,1:nvegnpool) - real(r8):: epsi - - - real(r8):: dt ! time step (seconds) - real(r8):: secspyear ! time step (seconds) -#ifdef _OPENMP - integer, external :: OMP_GET_MAX_THREADS - integer :: nthreads ! Number of threads -#else - integer, parameter :: nthreads = 0 ! Number of threads -#endif - -fr: associate( & - ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type - cf13_veg => c13_cnveg_carbonflux_inst , & ! In - cf14_veg => c14_cnveg_carbonflux_inst , & ! In - cs13_veg => c13_cnveg_carbonstate_inst , & ! In/Output - cs14_veg => c14_cnveg_carbonstate_inst , & ! In/Output - - fire_closs => cnveg_carbonflux_inst%fire_closs_patch , & - - ! Original vegetation variables are updated by matrix operation in this module - leafc => cnveg_carbonstate_inst%leafc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C - leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf storage C - leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf transfer C - frootc => cnveg_carbonstate_inst%frootc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root C - frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root storage C - frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root transfer C - livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem C - livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem storage C - livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem transfer C - deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem C - deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem storage C - deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem transfer C - livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root C - livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root storage C - livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root transfer C - deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root C - deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root storage C - deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root transfer C - grainc => cnveg_carbonstate_inst%grainc_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain C - grainc_storage => cnveg_carbonstate_inst%grainc_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain storage C - grainc_xfer => cnveg_carbonstate_inst%grainc_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain transfer C - - leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf N - leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf storage N - leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf transfer N - frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root N - frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root storage N - frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root transfer N - livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem N - livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem storage N - livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem transfer N - deadstemn => cnveg_nitrogenstate_inst%deadstemn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem N - deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem storage N - deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem transfer N - livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root N - livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root storage N - livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root transfer N - deadcrootn => cnveg_nitrogenstate_inst%deadcrootn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root N - deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root storage N - deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root transfer N - grainn => cnveg_nitrogenstate_inst%grainn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain N - grainn_storage => cnveg_nitrogenstate_inst%grainn_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain storage N - grainn_xfer => cnveg_nitrogenstate_inst%grainn_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain transfer N - retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) plant retranslocated N - - leafc_SASUsave => cnveg_carbonstate_inst%leafc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C for SASU - leafc_storage_SASUsave => cnveg_carbonstate_inst%leafc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C for SASU - leafc_xfer_SASUsave => cnveg_carbonstate_inst%leafc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C for SASU - frootc_SASUsave => cnveg_carbonstate_inst%frootc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot C for SASU - frootc_storage_SASUsave => cnveg_carbonstate_inst%frootc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot C for SASU - frootc_xfer_SASUsave => cnveg_carbonstate_inst%frootc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot C for SASU - livestemc_SASUsave => cnveg_carbonstate_inst%livestemc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem C for SASU - livestemc_storage_SASUsave => cnveg_carbonstate_inst%livestemc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem C for SASU - livestemc_xfer_SASUsave => cnveg_carbonstate_inst%livestemc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem C for SASU - deadstemc_SASUsave => cnveg_carbonstate_inst%deadstemc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem C for SASU - deadstemc_storage_SASUsave => cnveg_carbonstate_inst%deadstemc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem C for SASU - deadstemc_xfer_SASUsave => cnveg_carbonstate_inst%deadstemc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem C for SASU - livecrootc_SASUsave => cnveg_carbonstate_inst%livecrootc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot C for SASU - livecrootc_storage_SASUsave => cnveg_carbonstate_inst%livecrootc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot C for SASU - livecrootc_xfer_SASUsave => cnveg_carbonstate_inst%livecrootc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot C for SASU - deadcrootc_SASUsave => cnveg_carbonstate_inst%deadcrootc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot C for SASU - deadcrootc_storage_SASUsave => cnveg_carbonstate_inst%deadcrootc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot C for SASU - deadcrootc_xfer_SASUsave => cnveg_carbonstate_inst%deadcrootc_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot C for SASU - grainc_SASUsave => cnveg_carbonstate_inst%grainc_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain C for SASU - grainc_storage_SASUsave => cnveg_carbonstate_inst%grainc_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain storage C for SASU - - leafn_SASUsave => cnveg_nitrogenstate_inst%leafn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf N for SASU - leafn_storage_SASUsave => cnveg_nitrogenstate_inst%leafn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf N for SASU - leafn_xfer_SASUsave => cnveg_nitrogenstate_inst%leafn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf N for SASU - frootn_SASUsave => cnveg_nitrogenstate_inst%frootn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot N for SASU - frootn_storage_SASUsave => cnveg_nitrogenstate_inst%frootn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot N for SASU - frootn_xfer_SASUsave => cnveg_nitrogenstate_inst%frootn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) froot N for SASU - livestemn_SASUsave => cnveg_nitrogenstate_inst%livestemn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem N for SASU - livestemn_storage_SASUsave => cnveg_nitrogenstate_inst%livestemn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem N for SASU - livestemn_xfer_SASUsave => cnveg_nitrogenstate_inst%livestemn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livestem N for SASU - deadstemn_SASUsave => cnveg_nitrogenstate_inst%deadstemn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem N for SASU - deadstemn_storage_SASUsave => cnveg_nitrogenstate_inst%deadstemn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem N for SASU - deadstemn_xfer_SASUsave => cnveg_nitrogenstate_inst%deadstemn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadstem N for SASU - livecrootn_SASUsave => cnveg_nitrogenstate_inst%livecrootn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot N for SASU - livecrootn_storage_SASUsave => cnveg_nitrogenstate_inst%livecrootn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot N for SASU - livecrootn_xfer_SASUsave => cnveg_nitrogenstate_inst%livecrootn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) livecroot N for SASU - deadcrootn_SASUsave => cnveg_nitrogenstate_inst%deadcrootn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot N for SASU - deadcrootn_storage_SASUsave => cnveg_nitrogenstate_inst%deadcrootn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot N for SASU - deadcrootn_xfer_SASUsave => cnveg_nitrogenstate_inst%deadcrootn_xfer_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) deadcroot N for SASU - grainn_SASUsave => cnveg_nitrogenstate_inst%grainn_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain N for SASU - grainn_storage_SASUsave => cnveg_nitrogenstate_inst%grainn_storage_SASUsave_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain storage N for SASU - - ! Vegetation capacity variables "matrix_cap_*", save the capacity of each vegetation compartment. - matrix_cap_leafc => cnveg_carbonstate_inst%matrix_cap_leafc_patch ,&!Output:[real(r8)(:)] (gC/m2) leaf C capacity - matrix_cap_leafc_storage => cnveg_carbonstate_inst%matrix_cap_leafc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) leaf storage C capacity - matrix_cap_leafc_xfer => cnveg_carbonstate_inst%matrix_cap_leafc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) leaf transfer C capacity - matrix_cap_frootc => cnveg_carbonstate_inst%matrix_cap_frootc_patch ,&!Output:[real(r8)(:)] (gC/m2) fine root C capacity - matrix_cap_frootc_storage => cnveg_carbonstate_inst%matrix_cap_frootc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) fine root storage C capacity - matrix_cap_frootc_xfer => cnveg_carbonstate_inst%matrix_cap_frootc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) fine root transfer C capacity - matrix_cap_livestemc => cnveg_carbonstate_inst%matrix_cap_livestemc_patch ,&!Output:[real(r8)(:)] (gC/m2) live stem C capacity - matrix_cap_livestemc_storage => cnveg_carbonstate_inst%matrix_cap_livestemc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) live stem storage C capacity - matrix_cap_livestemc_xfer => cnveg_carbonstate_inst%matrix_cap_livestemc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) live stem transfer C capacity - matrix_cap_deadstemc => cnveg_carbonstate_inst%matrix_cap_deadstemc_patch ,&!Output:[real(r8)(:)] (gC/m2) dead stem C capacity - matrix_cap_deadstemc_storage => cnveg_carbonstate_inst%matrix_cap_deadstemc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) dead stem storage C capaicty - matrix_cap_deadstemc_xfer => cnveg_carbonstate_inst%matrix_cap_deadstemc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) dead stem transfer C capacity - matrix_cap_livecrootc => cnveg_carbonstate_inst%matrix_cap_livecrootc_patch ,&!Output:[real(r8)(:)] (gC/m2) live coarse root C capacity - matrix_cap_livecrootc_storage => cnveg_carbonstate_inst%matrix_cap_livecrootc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) live coarse root storage C capacity - matrix_cap_livecrootc_xfer => cnveg_carbonstate_inst%matrix_cap_livecrootc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) live coarse root transfer C capacity - matrix_cap_deadcrootc => cnveg_carbonstate_inst%matrix_cap_deadcrootc_patch ,&!Output:[real(r8)(:)] (gC/m2) dead coarse root C capacity - matrix_cap_deadcrootc_storage => cnveg_carbonstate_inst%matrix_cap_deadcrootc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) dead coarse root storage C capacity - matrix_cap_deadcrootc_xfer => cnveg_carbonstate_inst%matrix_cap_deadcrootc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) dead coarse root transfer C capacity - matrix_cap_grainc => cnveg_carbonstate_inst%matrix_cap_grainc_patch ,&!Output:[real(r8)(:)] (gC/m2) grain C capacity - matrix_cap_grainc_storage => cnveg_carbonstate_inst%matrix_cap_grainc_storage_patch ,&!Output:[real(r8)(:)] (gC/m2) grain storage C capacity - matrix_cap_grainc_xfer => cnveg_carbonstate_inst%matrix_cap_grainc_xfer_patch ,&!Output:[real(r8)(:)] (gC/m2) grain transfer C - - matrix_cap_leafn => cnveg_nitrogenstate_inst%matrix_cap_leafn_patch ,&!Output:[real(r8)(:)] (gN/m2) leaf N capacity - matrix_cap_leafn_storage => cnveg_nitrogenstate_inst%matrix_cap_leafn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) leaf storage N capacity - matrix_cap_leafn_xfer => cnveg_nitrogenstate_inst%matrix_cap_leafn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) leaf transfer N capacity - matrix_cap_frootn => cnveg_nitrogenstate_inst%matrix_cap_frootn_patch ,&!Output:[real(r8)(:)] (gN/m2) fine root N capacity - matrix_cap_frootn_storage => cnveg_nitrogenstate_inst%matrix_cap_frootn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) fine root storage N capacity - matrix_cap_frootn_xfer => cnveg_nitrogenstate_inst%matrix_cap_frootn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) fine root transfer N capacity - matrix_cap_livestemn => cnveg_nitrogenstate_inst%matrix_cap_livestemn_patch ,&!Output:[real(r8)(:)] (gN/m2) live stem N capacity - matrix_cap_livestemn_storage => cnveg_nitrogenstate_inst%matrix_cap_livestemn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) live stem storage N capacity - matrix_cap_livestemn_xfer => cnveg_nitrogenstate_inst%matrix_cap_livestemn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) live stem transfer N capacity - matrix_cap_deadstemn => cnveg_nitrogenstate_inst%matrix_cap_deadstemn_patch ,&!Output:[real(r8)(:)] (gN/m2) dead stem N capacity - matrix_cap_deadstemn_storage => cnveg_nitrogenstate_inst%matrix_cap_deadstemn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) dead stem storage N capacity - matrix_cap_deadstemn_xfer => cnveg_nitrogenstate_inst%matrix_cap_deadstemn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) dead stem transfer N capacity - matrix_cap_livecrootn => cnveg_nitrogenstate_inst%matrix_cap_livecrootn_patch ,&!Output:[real(r8)(:)] (gN/m2) live coarse root N capacity - matrix_cap_livecrootn_storage => cnveg_nitrogenstate_inst%matrix_cap_livecrootn_storage_patch,&!Output:[real(r8)(:)] (gN/m2) live coarse root storage N capacity - matrix_cap_livecrootn_xfer => cnveg_nitrogenstate_inst%matrix_cap_livecrootn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) live coarse root transfer N capacity - matrix_cap_deadcrootn => cnveg_nitrogenstate_inst%matrix_cap_deadcrootn_patch ,&!Output:[real(r8)(:)] (gN/m2) dead coarse root N capacity - matrix_cap_deadcrootn_storage => cnveg_nitrogenstate_inst%matrix_cap_deadcrootn_storage_patch,&!Output:[real(r8)(:)] (gN/m2) dead coarse root storage N capacity - matrix_cap_deadcrootn_xfer => cnveg_nitrogenstate_inst%matrix_cap_deadcrootn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) dead coarse root transfer N capacity - matrix_cap_grainn => cnveg_nitrogenstate_inst%matrix_cap_grainn_patch ,&!Output:[real(r8)(:)] (gN/m2) grain N capacity - matrix_cap_grainn_storage => cnveg_nitrogenstate_inst%matrix_cap_grainn_storage_patch ,&!Output:[real(r8)(:)] (gN/m2) grain storage N capacity - matrix_cap_grainn_xfer => cnveg_nitrogenstate_inst%matrix_cap_grainn_xfer_patch ,&!Output:[real(r8)(:)] (gN/m2) grain transfer N capacity - - ! Variables matrix_calloc_*_acc, matrix_ctransfer_*_acc, and matrix_cturnover_*_acc are used to calculate the C capacity as the C steady state estimates in spin up. - ! These variables are all state variables, saving accumulated N transfers during the calendar year. - matrix_calloc_leaf_acc => cnveg_carbonstate_inst%matrix_calloc_leaf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to leaf during this year - matrix_calloc_leafst_acc => cnveg_carbonstate_inst%matrix_calloc_leafst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to leaf storage during this year - matrix_calloc_froot_acc => cnveg_carbonstate_inst%matrix_calloc_froot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to fine root during this year - matrix_calloc_frootst_acc => cnveg_carbonstate_inst%matrix_calloc_frootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to fine root storage during this year - matrix_calloc_livestem_acc => cnveg_carbonstate_inst%matrix_calloc_livestem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to live stem during this year - matrix_calloc_livestemst_acc => cnveg_carbonstate_inst%matrix_calloc_livestemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to live stem storage during this year - matrix_calloc_deadstem_acc => cnveg_carbonstate_inst%matrix_calloc_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to dead stem during this year - matrix_calloc_deadstemst_acc => cnveg_carbonstate_inst%matrix_calloc_deadstemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to dead stem storage during this year - matrix_calloc_livecroot_acc => cnveg_carbonstate_inst%matrix_calloc_livecroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to live corase root during this year - matrix_calloc_livecrootst_acc => cnveg_carbonstate_inst%matrix_calloc_livecrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to live corase root storage during this year - matrix_calloc_deadcroot_acc => cnveg_carbonstate_inst%matrix_calloc_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to dead corase root during this year - matrix_calloc_deadcrootst_acc => cnveg_carbonstate_inst%matrix_calloc_deadcrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to dead corase root storage during this year - matrix_calloc_grain_acc => cnveg_carbonstate_inst%matrix_calloc_grain_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to grain during this year - matrix_calloc_grainst_acc => cnveg_carbonstate_inst%matrix_calloc_grainst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) Input C allocated to grain storage during this year - - matrix_ctransfer_leafst_to_leafxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_leafst_to_leafxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from leaf storage to leaf transfer pool during this year - matrix_ctransfer_leafxf_to_leaf_acc => cnveg_carbonstate_inst%matrix_ctransfer_leafxf_to_leaf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from leaf transfer to leaf pool during this year - matrix_ctransfer_frootst_to_frootxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_frootst_to_frootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from fine root storage to fine root transfer pool during this year - matrix_ctransfer_frootxf_to_froot_acc => cnveg_carbonstate_inst%matrix_ctransfer_frootxf_to_froot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from fine root transfer to fine root pool during this year - matrix_ctransfer_livestemst_to_livestemxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_livestemst_to_livestemxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live stem storage to live stem transfer pool during this year - matrix_ctransfer_livestemxf_to_livestem_acc => cnveg_carbonstate_inst%matrix_ctransfer_livestemxf_to_livestem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live stem transfer to live stem pool during this year - matrix_ctransfer_deadstemst_to_deadstemxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from dead stem storage to dead stem transfer pool during this year - matrix_ctransfer_deadstemxf_to_deadstem_acc => cnveg_carbonstate_inst%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from dead stem transfer to dead stem pool during this year - matrix_ctransfer_livecrootst_to_livecrootxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live coarse root storage to live coarse root transfer pool during this year - matrix_ctransfer_livecrootxf_to_livecroot_acc => cnveg_carbonstate_inst%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live coarse root transfer to live coarse root pool during this year - matrix_ctransfer_deadcrootst_to_deadcrootxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from dead coarse root storage to dead coarse root transfer pool during this year - matrix_ctransfer_deadcrootxf_to_deadcroot_acc => cnveg_carbonstate_inst%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from dead coarse root transfer to dead coarse root pool during this year - matrix_ctransfer_grainst_to_grainxf_acc => cnveg_carbonstate_inst%matrix_ctransfer_grainst_to_grainxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from grain storage to grain transfer pool during this year - matrix_ctransfer_grainxf_to_grain_acc => cnveg_carbonstate_inst%matrix_ctransfer_grainxf_to_grain_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from grain transfer to grain pool during this year - matrix_ctransfer_livestem_to_deadstem_acc => cnveg_carbonstate_inst%matrix_ctransfer_livestem_to_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live stem to dead stem pool during this year - matrix_ctransfer_livecroot_to_deadcroot_acc => cnveg_carbonstate_inst%matrix_ctransfer_livecroot_to_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C transfer from live coarse root to dead coarse root pool during this year - - matrix_cturnover_leaf_acc => cnveg_carbonstate_inst%matrix_cturnover_leaf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from leaf - matrix_cturnover_leafst_acc => cnveg_carbonstate_inst%matrix_cturnover_leafst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from leaf storage - matrix_cturnover_leafxf_acc => cnveg_carbonstate_inst%matrix_cturnover_leafxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from leaf transfer - matrix_cturnover_froot_acc => cnveg_carbonstate_inst%matrix_cturnover_froot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from fine root - matrix_cturnover_frootst_acc => cnveg_carbonstate_inst%matrix_cturnover_frootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from fine root storage - matrix_cturnover_frootxf_acc => cnveg_carbonstate_inst%matrix_cturnover_frootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from fine root transfer - matrix_cturnover_livestem_acc => cnveg_carbonstate_inst%matrix_cturnover_livestem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live stem - matrix_cturnover_livestemst_acc => cnveg_carbonstate_inst%matrix_cturnover_livestemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live stem storage - matrix_cturnover_livestemxf_acc => cnveg_carbonstate_inst%matrix_cturnover_livestemxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live stem transfer - matrix_cturnover_deadstem_acc => cnveg_carbonstate_inst%matrix_cturnover_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead stem - matrix_cturnover_deadstemst_acc => cnveg_carbonstate_inst%matrix_cturnover_deadstemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead stem storage - matrix_cturnover_deadstemxf_acc => cnveg_carbonstate_inst%matrix_cturnover_deadstemxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead stem transfer - matrix_cturnover_livecroot_acc => cnveg_carbonstate_inst%matrix_cturnover_livecroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live coarse root - matrix_cturnover_livecrootst_acc => cnveg_carbonstate_inst%matrix_cturnover_livecrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live coarse root storage - matrix_cturnover_livecrootxf_acc => cnveg_carbonstate_inst%matrix_cturnover_livecrootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from live coarse root transfer - matrix_cturnover_deadcroot_acc => cnveg_carbonstate_inst%matrix_cturnover_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead coarse root - matrix_cturnover_deadcrootst_acc => cnveg_carbonstate_inst%matrix_cturnover_deadcrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead coarse root storage - matrix_cturnover_deadcrootxf_acc => cnveg_carbonstate_inst%matrix_cturnover_deadcrootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from dead coarse root transfer - matrix_cturnover_grain_acc => cnveg_carbonstate_inst%matrix_cturnover_grain_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from grain - matrix_cturnover_grainst_acc => cnveg_carbonstate_inst%matrix_cturnover_grainst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from grain storage - matrix_cturnover_grainxf_acc => cnveg_carbonstate_inst%matrix_cturnover_grainxf_acc_patch & - ! In/Output: [real(r8) (:) ] (gC/m2/year) C turnover from grain transfer - ) -od: associate( & - - ! Variables matrix_nalloc_*_acc, matrix_ntransfer_*_acc, and matrix_nturnover_*_acc are used to calculate the N capacity as the N steady state estimates in spin up. - ! These variables are all state variables, saving accumulated N transfers during the calendar year. - matrix_nalloc_leaf_acc => cnveg_nitrogenstate_inst%matrix_nalloc_leaf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to leaf during this year - matrix_nalloc_leafst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_leafst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to leaf storage during this year - matrix_nalloc_froot_acc => cnveg_nitrogenstate_inst%matrix_nalloc_froot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to fine root during this year - matrix_nalloc_frootst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_frootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to fine root storage during this year - matrix_nalloc_livestem_acc => cnveg_nitrogenstate_inst%matrix_nalloc_livestem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to live stem during this year - matrix_nalloc_livestemst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_livestemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to live stem storage during this year - matrix_nalloc_deadstem_acc => cnveg_nitrogenstate_inst%matrix_nalloc_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to dead stem during this year - matrix_nalloc_deadstemst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_deadstemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to dead stem storage during this year - matrix_nalloc_livecroot_acc => cnveg_nitrogenstate_inst%matrix_nalloc_livecroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to live coarse root during this year - matrix_nalloc_livecrootst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_livecrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to live coarse root storage during this year - matrix_nalloc_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_nalloc_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to dead coarse root during this year - matrix_nalloc_deadcrootst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_deadcrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to dead coarse root storage during this year - matrix_nalloc_grain_acc => cnveg_nitrogenstate_inst%matrix_nalloc_grain_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to grain during this year - matrix_nalloc_grainst_acc => cnveg_nitrogenstate_inst%matrix_nalloc_grainst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) Input N allocated to grain storage during this year - - matrix_ntransfer_leafst_to_leafxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_leafst_to_leafxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from leaf storage to leaf transfer pool during this year - matrix_ntransfer_leafxf_to_leaf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_leafxf_to_leaf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from leaf transfer to leaf pool during this year - matrix_ntransfer_frootst_to_frootxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_frootst_to_frootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from fine root storage to fine root transfer pool during this year - matrix_ntransfer_frootxf_to_froot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_frootxf_to_froot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from fine root transfer to fine root pool during this year - matrix_ntransfer_livestemst_to_livestemxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livestemst_to_livestemxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live stem storage to live stem transfer pool during this year - matrix_ntransfer_livestemxf_to_livestem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livestemxf_to_livestem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live stem transfer to live stem pool during this year - matrix_ntransfer_deadstemst_to_deadstemxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_deadstemst_to_deadstemxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from dead stem storage to dead stem transfer pool during this year - matrix_ntransfer_deadstemxf_to_deadstem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_deadstemxf_to_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from dead stem transfer to dead stem pool during this year - matrix_ntransfer_livecrootst_to_livecrootxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livecrootst_to_livecrootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live coarese root storage to live coarese root transfer pool during this year - matrix_ntransfer_livecrootxf_to_livecroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livecrootxf_to_livecroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live coarese root transfer to live coarese root pool during this year - matrix_ntransfer_deadcrootst_to_deadcrootxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_deadcrootst_to_deadcrootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from dead coarse root storage to dead coarse root transfer pool during this year - matrix_ntransfer_deadcrootxf_to_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_deadcrootxf_to_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from dead coarse root transfer to dead coarse root pool during this year - matrix_ntransfer_grainst_to_grainxf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_grainst_to_grainxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from grain storage to grain transfer pool during this year - matrix_ntransfer_grainxf_to_grain_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_grainxf_to_grain_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from grain transfer to grain pool during this year - matrix_ntransfer_livestem_to_deadstem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livestem_to_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live stem storage to dead stem transfer pool during this year - matrix_ntransfer_livecroot_to_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livecroot_to_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live coarse root to dead coarse root pool during this year - - matrix_ntransfer_retransn_to_leaf_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_leaf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to leaf pool during this year - matrix_ntransfer_retransn_to_leafst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_leafst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to leaf storage pool during this year - matrix_ntransfer_retransn_to_froot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_froot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to fine root pool during this year - matrix_ntransfer_retransn_to_frootst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_frootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to fine root storage pool during this year - matrix_ntransfer_retransn_to_livestem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_livestem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to live stem pool during this year - matrix_ntransfer_retransn_to_livestemst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_livestemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to livestem storage pool during this year - matrix_ntransfer_retransn_to_deadstem_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to dead stem pool during this year - matrix_ntransfer_retransn_to_deadstemst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_deadstemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to dead stem storage pool during this year - matrix_ntransfer_retransn_to_livecroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_livecroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to live coarse root pool during this year - matrix_ntransfer_retransn_to_livecrootst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_livecrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to live coarse root storage pool during this year - matrix_ntransfer_retransn_to_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to dead coarse root pool during this year - matrix_ntransfer_retransn_to_deadcrootst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_deadcrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to dead coarse root storage pool during this year - matrix_ntransfer_retransn_to_grain_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_grain_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to grain pool during this year - matrix_ntransfer_retransn_to_grainst_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_retransn_to_grainst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from retranslocated N pool to grain storage pool during this year - - matrix_ntransfer_leaf_to_retransn_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_leaf_to_retransn_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from leaf pool to retranslocated N pool during this year - matrix_ntransfer_froot_to_retransn_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_froot_to_retransn_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from fine root pool to retranslocated N pool during this year - matrix_ntransfer_livestem_to_retransn_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livestem_to_retransn_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live stem pool to retranslocated N pool during this year - matrix_ntransfer_livecroot_to_retransn_acc => cnveg_nitrogenstate_inst%matrix_ntransfer_livecroot_to_retransn_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N transfer from live coarse root pool to retranslocated N pool during this year - - matrix_nturnover_leaf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_leaf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from leaf - matrix_nturnover_leafst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_leafst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from leaf storage - matrix_nturnover_leafxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_leafxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from leaf transfer - matrix_nturnover_froot_acc => cnveg_nitrogenstate_inst%matrix_nturnover_froot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from fine root - matrix_nturnover_frootst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_frootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from fine root storage - matrix_nturnover_frootxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_frootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from fine root transfer - matrix_nturnover_livestem_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livestem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live stem - matrix_nturnover_livestemst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livestemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live stem storage - matrix_nturnover_livestemxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livestemxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live stem transfer - matrix_nturnover_deadstem_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadstem_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead stem - matrix_nturnover_deadstemst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadstemst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead stem storage - matrix_nturnover_deadstemxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadstemxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead stem transfer - matrix_nturnover_livecroot_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livecroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live coarse root - matrix_nturnover_livecrootst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livecrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live coarse root storage - matrix_nturnover_livecrootxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_livecrootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from live coarse root transfer - matrix_nturnover_deadcroot_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadcroot_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead coarse root - matrix_nturnover_deadcrootst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadcrootst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead coarse root storage - matrix_nturnover_deadcrootxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_deadcrootxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from dead coarse root transfer - matrix_nturnover_grain_acc => cnveg_nitrogenstate_inst%matrix_nturnover_grain_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from grain - matrix_nturnover_grainst_acc => cnveg_nitrogenstate_inst%matrix_nturnover_grainst_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from grain storage - matrix_nturnover_grainxf_acc => cnveg_nitrogenstate_inst%matrix_nturnover_grainxf_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from grain transfer - matrix_nturnover_retransn_acc => cnveg_nitrogenstate_inst%matrix_nturnover_retransn_acc_patch , & - ! In/Output: [real(r8) (:) ] (gN/m2/year) N turnover from retranslocated N pool - - ! *c0* variables save vegetation pool size at beginning of each year as a base for capacity calculation. For examples, - ! C turnover rate of pool KC_leaf (yr-1) is calculated by C turnover during the calendar year: matrix_cturnover_leaf_acc (gC/m2/yr) / leafc0 (gC/m2) - leafc0 => cnveg_carbonstate_inst%leafc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf C at begin of this year - leafc0_storage => cnveg_carbonstate_inst%leafc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf storage C at begin of this year - leafc0_xfer => cnveg_carbonstate_inst%leafc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) leaf transfer C at begin of this year - frootc0 => cnveg_carbonstate_inst%frootc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root C at begin of this year - frootc0_storage => cnveg_carbonstate_inst%frootc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root storage C at begin of this year - frootc0_xfer => cnveg_carbonstate_inst%frootc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) fine root transfer C at begin of this year - livestemc0 => cnveg_carbonstate_inst%livestemc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem C at begin of this year - livestemc0_storage => cnveg_carbonstate_inst%livestemc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem storage C at begin of this year - livestemc0_xfer => cnveg_carbonstate_inst%livestemc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live stem transfer C at begin of this year - deadstemc0 => cnveg_carbonstate_inst%deadstemc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem C at begin of this year - deadstemc0_storage => cnveg_carbonstate_inst%deadstemc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem storage C at begin of this year - deadstemc0_xfer => cnveg_carbonstate_inst%deadstemc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead stem transfer C at begin of this year - livecrootc0 => cnveg_carbonstate_inst%livecrootc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root C at begin of this year - livecrootc0_storage => cnveg_carbonstate_inst%livecrootc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root storage C at begin of this year - livecrootc0_xfer => cnveg_carbonstate_inst%livecrootc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) live coarse root transfer C at begin of this year - deadcrootc0 => cnveg_carbonstate_inst%deadcrootc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root C at begin of this year - deadcrootc0_storage => cnveg_carbonstate_inst%deadcrootc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root storage C at begin of this year - deadcrootc0_xfer => cnveg_carbonstate_inst%deadcrootc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) dead coarse root transfer C at begin of this year - grainc0 => cnveg_carbonstate_inst%grainc0_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain C at begin of this year - grainc0_storage => cnveg_carbonstate_inst%grainc0_storage_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain storage C at begin of this year - grainc0_xfer => cnveg_carbonstate_inst%grainc0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gC/m2) grain transfer C at begin of this year - - ! *n0* variables save vegetation pool size at beginning of each year as a base for capacity calculation. For examples, - ! N turnover rate of pool KN_leaf (yr-1) is calculated by N turnover during the calendar year matrix_nturnover_leaf_acc (gN/m2/yr) / leafn0 (gN/m2) - leafn0 => cnveg_nitrogenstate_inst%leafn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf N at begin of this year - leafn0_storage => cnveg_nitrogenstate_inst%leafn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf storage N at begin of this year - leafn0_xfer => cnveg_nitrogenstate_inst%leafn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) leaf transfer N at begin of this year - frootn0 => cnveg_nitrogenstate_inst%frootn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root N at begin of this year - frootn0_storage => cnveg_nitrogenstate_inst%frootn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root storage N at begin of this year - frootn0_xfer => cnveg_nitrogenstate_inst%frootn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) fine root transfer N at begin of this year - livestemn0 => cnveg_nitrogenstate_inst%livestemn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem N at begin of this year - livestemn0_storage => cnveg_nitrogenstate_inst%livestemn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem storage N at begin of this year - livestemn0_xfer => cnveg_nitrogenstate_inst%livestemn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live stem transfer N at begin of this year - deadstemn0 => cnveg_nitrogenstate_inst%deadstemn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem N at begin of this year - deadstemn0_storage => cnveg_nitrogenstate_inst%deadstemn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem storage N at begin of this year - deadstemn0_xfer => cnveg_nitrogenstate_inst%deadstemn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead stem transfer N at begin of this year - livecrootn0 => cnveg_nitrogenstate_inst%livecrootn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root N at begin of this year - livecrootn0_storage => cnveg_nitrogenstate_inst%livecrootn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root storage N at begin of this year - livecrootn0_xfer => cnveg_nitrogenstate_inst%livecrootn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) live coarse root transfer N at begin of this year - deadcrootn0 => cnveg_nitrogenstate_inst%deadcrootn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root N at begin of this year - deadcrootn0_storage => cnveg_nitrogenstate_inst%deadcrootn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root storage N at begin of this year - deadcrootn0_xfer => cnveg_nitrogenstate_inst%deadcrootn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) dead coarse root transfer N at begin of this year - grainn0 => cnveg_nitrogenstate_inst%grainn0_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain N at begin of this year - grainn0_storage => cnveg_nitrogenstate_inst%grainn0_storage_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain storage N at begin of this year - grainn0_xfer => cnveg_nitrogenstate_inst%grainn0_xfer_patch , & ! In/Output: [real(r8) (:) ] (gN/m2) grain transfer N at begin of this year - retransn0 => cnveg_nitrogenstate_inst%retransn0_patch & ! In/Output: [real(r8) (:) ] (gN/m2) plant retranslocated N at begin of this year - ) -sd: associate( & - - ! Following variables save the C and N transfer rate of different processes at current time step. - ! Eg. ph: phenology, gm: gap mortality (including harvest), fi: fire. - matrix_alloc => cnveg_carbonflux_inst%matrix_alloc_patch , & ! Input: [real(r8) (:,:)] (gC/gC) input C allocation matrix, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod - matrix_nalloc => cnveg_nitrogenflux_inst%matrix_nalloc_patch , & ! Input: [real(r8) (:,:)] (gC/gC) input N allocation matrix, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod - matrix_phtransfer => cnveg_carbonflux_inst%matrix_phtransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from phenology processes, updated in CNPhenology - matrix_gmtransfer => cnveg_carbonflux_inst%matrix_gmtransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from gap mortality processes, updated in CNGapMortality - matrix_fitransfer => cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in CNFireBaseMod or CNFireLi2014Mod - matrix_phturnover => cnveg_carbonflux_inst%matrix_phturnover_patch , & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from phenology processes, updated in CNVegMatrixMod and dynHarvestMod - matrix_gmturnover => cnveg_carbonflux_inst%matrix_gmturnover_patch , & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from gap mortality processe, updated in CNVegMatrixMods - matrix_fiturnover => cnveg_carbonflux_inst%matrix_fiturnover_patch , & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods - - matrix_nphtransfer => cnveg_nitrogenflux_inst%matrix_nphtransfer_patch , & ! Input: [real(r8) (:,:)] (gN/m2/s) N transfer rate from phenology processes, updated in CNPhenology and (NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod) - matrix_ngmtransfer => cnveg_nitrogenflux_inst%matrix_ngmtransfer_patch , & ! Input: [real(r8) (:,:)] (gN/m2/s) N transfer rate from gap mortality processes, updated in CNGapMortality and dynHarvestMod - matrix_nfitransfer => cnveg_nitrogenflux_inst%matrix_nfitransfer_patch , & ! Input: [real(r8) (:,:)] (gN/m2/s) N transfer rate from fire processes, updated in CNFireBaseMod or CNFireLi2014Mod - matrix_nphturnover => cnveg_nitrogenflux_inst%matrix_nphturnover_patch , & ! Output: [real(r8) (:,:)] (gN/m2/step) N turnover rate from phenology processes, updated in CNVegMatrixMod - matrix_ngmturnover => cnveg_nitrogenflux_inst%matrix_ngmturnover_patch , & ! Output: [real(r8) (:,:)] (gN/m2/step) N turnover rate from gap mortality processes, updated in CNVegMatrixMod - matrix_nfiturnover => cnveg_nitrogenflux_inst%matrix_nfiturnover_patch , & ! Output: [real(r8) (:,:)] (gN/m2/step) N turnover rate from fire processes, updated in CNVegMatrixMod - - matrix_Cinput => cnveg_carbonflux_inst%matrix_Cinput_patch , & ! Input: [real(r8) (:)] (gC/m2/s) C input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod - matrix_C13input => cnveg_carbonflux_inst%matrix_C13input_patch , & ! Input: [real(r8) (:)] (gC/m2/s) C13 input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod - matrix_C14input => cnveg_carbonflux_inst%matrix_C14input_patch , & ! Input: [real(r8) (:)] (gC/m2/s) C14 input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod - matrix_Ninput => cnveg_nitrogenflux_inst%matrix_Ninput_patch , & ! Input: [real(r8) (:)] (gN/m2/s) N input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod - - ! Doners and receivers of all transfers from different processes have been prescribed in following variables: - doner_phc => cnveg_carbonflux_inst%matrix_phtransfer_doner_patch , & ! Input: [integer (:)] Doners of phenology related C transfer - receiver_phc => cnveg_carbonflux_inst%matrix_phtransfer_receiver_patch , & ! Input: [integer (:)] Receiver of phenology related C transfer - doner_gmc => cnveg_carbonflux_inst%matrix_gmtransfer_doner_patch , & ! Input: [integer (:)] Doners of gap mortality related C transfer - receiver_gmc => cnveg_carbonflux_inst%matrix_gmtransfer_receiver_patch , & ! Input: [integer (:)] Receiver of gap mortality related C transfer - doner_fic => cnveg_carbonflux_inst%matrix_fitransfer_doner_patch , & ! Input: [integer (:)] Doners of fire related C transfer - receiver_fic => cnveg_carbonflux_inst%matrix_fitransfer_receiver_patch , & ! Input: [integer (:)] Receiver of fire related C transfer - doner_phn => cnveg_nitrogenflux_inst%matrix_nphtransfer_doner_patch , & ! Input: [integer (:)] Doners of phenology related N transfer - receiver_phn => cnveg_nitrogenflux_inst%matrix_nphtransfer_receiver_patch , & ! Input: [integer (:)] Receiver of phenology related N transfer - doner_gmn => cnveg_nitrogenflux_inst%matrix_ngmtransfer_doner_patch , & ! Input: [integer (:)] Doners of gap mortality related N transfer - receiver_gmn => cnveg_nitrogenflux_inst%matrix_ngmtransfer_receiver_patch , & ! Input: [integer (:)] Receiver of gap mortality related N transfer - doner_fin => cnveg_nitrogenflux_inst%matrix_nfitransfer_doner_patch , & ! Input: [integer (:)] Doners of fire related N transfer - receiver_fin => cnveg_nitrogenflux_inst%matrix_nfitransfer_receiver_patch , & ! Input: [integer (:)] Receiver of fire related N transfer - - ! Index of each processes related C transfers. See subroutine InitTransfer in CNVegCarbonFluxType.F90 for details. - ileafst_to_ileafxf_phc => cnveg_carbonflux_inst%ileafst_to_ileafxf_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from leaf storage pool to leaf transfer pool - ileafxf_to_ileaf_phc => cnveg_carbonflux_inst%ileafxf_to_ileaf_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from leaf transfer pool to leaf pool - ifrootst_to_ifrootxf_phc => cnveg_carbonflux_inst%ifrootst_to_ifrootxf_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from fine root storage pool to fine root transfer pool - ifrootxf_to_ifroot_phc => cnveg_carbonflux_inst%ifrootxf_to_ifroot_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from fine root transfer pool to fine root pool - ilivestemst_to_ilivestemxf_phc => cnveg_carbonflux_inst%ilivestemst_to_ilivestemxf_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from live stem storage pool to live stem transfer pool - ilivestemxf_to_ilivestem_phc => cnveg_carbonflux_inst%ilivestemxf_to_ilivestem_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from live stem transfer pool to live stem pool - ideadstemst_to_ideadstemxf_phc => cnveg_carbonflux_inst%ideadstemst_to_ideadstemxf_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from dead stem storage pool to dead stem transfer pool - ideadstemxf_to_ideadstem_phc => cnveg_carbonflux_inst%ideadstemxf_to_ideadstem_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from dead stem transfer pool to dead stem pool - ilivecrootst_to_ilivecrootxf_phc => cnveg_carbonflux_inst%ilivecrootst_to_ilivecrootxf_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from live coarse root storage pool to live coarse root transfer pool - ilivecrootxf_to_ilivecroot_phc => cnveg_carbonflux_inst%ilivecrootxf_to_ilivecroot_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from live coarse root transfer pool to live coarse root pool - ideadcrootst_to_ideadcrootxf_phc => cnveg_carbonflux_inst%ideadcrootst_to_ideadcrootxf_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root storage pool to dead coarse root transfer pool - ideadcrootxf_to_ideadcroot_phc => cnveg_carbonflux_inst%ideadcrootxf_to_ideadcroot_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from dead coarse root transfer pool to dead coarse root pool - ilivestem_to_ideadstem_phc => cnveg_carbonflux_inst%ilivestem_to_ideadstem_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to dead stem pool - ilivecroot_to_ideadcroot_phc => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from live coarse root pool to dead coarse root pool - ileaf_to_iout_phc => cnveg_carbonflux_inst%ileaf_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from leaf pool to outside of vegetation pools - ifroot_to_iout_phc => cnveg_carbonflux_inst%ifroot_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from fine root pool to outside of vegetation pools - ilivestem_to_iout_phc => cnveg_carbonflux_inst%ilivestem_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from live stem pool to outside of vegetation pools - igrain_to_iout_phc => cnveg_carbonflux_inst%igrain_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related C transfer from grain pool to outside of vegetation pools - ileaf_to_iout_gmc => cnveg_carbonflux_inst%ileaf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from leaf pool to outside of vegetation pools - ileafst_to_iout_gmc => cnveg_carbonflux_inst%ileafst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from leaf storage pool to outside of vegetation pools - ileafxf_to_iout_gmc => cnveg_carbonflux_inst%ileafxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from leaf transfer pool to outside of vegetation pools - ifroot_to_iout_gmc => cnveg_carbonflux_inst%ifroot_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from fine root pool to outside of vegetation pools - ifrootst_to_iout_gmc => cnveg_carbonflux_inst%ifrootst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from fine root storage pool to outside of vegetation pools - ifrootxf_to_iout_gmc => cnveg_carbonflux_inst%ifrootxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from fine root transfer pool to outside of vegetation pools - ilivestem_to_iout_gmc => cnveg_carbonflux_inst%ilivestem_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from live stem pool to outside of vegetation pools - ilivestemst_to_iout_gmc => cnveg_carbonflux_inst%ilivestemst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from live stem storage pool to outside of vegetation pools - ilivestemxf_to_iout_gmc => cnveg_carbonflux_inst%ilivestemxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from live stem transfer pool to outside of vegetation pools - ideadstem_to_iout_gmc => cnveg_carbonflux_inst%ideadstem_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem pool to outside of vegetation pools - ideadstemst_to_iout_gmc => cnveg_carbonflux_inst%ideadstemst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem storage pool to outside of vegetation pools - ideadstemxf_to_iout_gmc => cnveg_carbonflux_inst%ideadstemxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from dead stem transfer pool to outside of vegetation pools - ilivecroot_to_iout_gmc => cnveg_carbonflux_inst%ilivecroot_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root pool to outside of vegetation pools - ilivecrootst_to_iout_gmc => cnveg_carbonflux_inst%ilivecrootst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root storage pool to outside of vegetation pools - ilivecrootxf_to_iout_gmc => cnveg_carbonflux_inst%ilivecrootxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from live coarse root transfer pool to outside of vegetation pools - ideadcroot_to_iout_gmc => cnveg_carbonflux_inst%ideadcroot_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root pool to outside of vegetation pools - ideadcrootst_to_iout_gmc => cnveg_carbonflux_inst%ideadcrootst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root storage pool to outside of vegetation pools - ideadcrootxf_to_iout_gmc => cnveg_carbonflux_inst%ideadcrootxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related C transfer from dead coarse root transfer pool to outside of vegetation pools - ileaf_to_iout_fic => cnveg_carbonflux_inst%ileaf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from leaf pool to outside of vegetation pools - ileafst_to_iout_fic => cnveg_carbonflux_inst%ileafst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from leaf storage pool to outside of vegetation pools - ileafxf_to_iout_fic => cnveg_carbonflux_inst%ileafxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from leaf transfer pool to outside of vegetation pools - ifroot_to_iout_fic => cnveg_carbonflux_inst%ifroot_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from fine root pool to outside of vegetation pools - ifrootst_to_iout_fic => cnveg_carbonflux_inst%ifrootst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from fine root storage pool to outside of vegetation pools - ifrootxf_to_iout_fic => cnveg_carbonflux_inst%ifrootxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from fine root transfer pool to outside of vegetation pools - ilivestem_to_iout_fic => cnveg_carbonflux_inst%ilivestem_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from live stem pool to outside of vegetation pools - ilivestemst_to_iout_fic => cnveg_carbonflux_inst%ilivestemst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from live stem storage pool to outside of vegetation pools - ilivestemxf_to_iout_fic => cnveg_carbonflux_inst%ilivestemxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from live stem transfer pool to outside of vegetation pools - ideadstem_to_iout_fic => cnveg_carbonflux_inst%ideadstem_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from dead stem pool to outside of vegetation pools - ideadstemst_to_iout_fic => cnveg_carbonflux_inst%ideadstemst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from dead stem storage pool to outside of vegetation pools - ideadstemxf_to_iout_fic => cnveg_carbonflux_inst%ideadstemxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from dead stem transfer pool to outside of vegetation pools - ilivecroot_to_iout_fic => cnveg_carbonflux_inst%ilivecroot_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to outside of vegetation pools - ilivecrootst_to_iout_fic => cnveg_carbonflux_inst%ilivecrootst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from live coarse root storage pool to outside of vegetation pools - ilivecrootxf_to_iout_fic => cnveg_carbonflux_inst%ilivecrootxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from live coarse root transfer pool to outside of vegetation pools - ideadcroot_to_iout_fic => cnveg_carbonflux_inst%ideadcroot_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from dead coarse root pool to outside of vegetation pools - ideadcrootst_to_iout_fic => cnveg_carbonflux_inst%ideadcrootst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from dead coarse root storage pool to outside of vegetation pools - ideadcrootxf_to_iout_fic => cnveg_carbonflux_inst%ideadcrootxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related C transfer from dead coarse root transfer pool to outside of vegetation pools - ilivestem_to_ideadstem_fic => cnveg_carbonflux_inst%ilivestem_to_ideadstem_fi , & - ! Input: [integer (:)] Index of fire related C transfer from live stem pool to dead stem pool - ilivecroot_to_ideadcroot_fic => cnveg_carbonflux_inst%ilivecroot_to_ideadcroot_fi , & - ! Input: [integer (:)] Index of fire related C transfer from live coarse root pool to dead coarse root pool - ! Index of each processes related N transfers. See subroutine InitTransfer in CNVegNitrogenFluxType.F90 for details. - ileafst_to_ileafxf_phn => cnveg_nitrogenflux_inst%ileafst_to_ileafxf_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from leaf storage pool to leaf transfer pool - ileafxf_to_ileaf_phn => cnveg_nitrogenflux_inst%ileafxf_to_ileaf_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from leaf transfer pool to leaf pool - ifrootst_to_ifrootxf_phn => cnveg_nitrogenflux_inst%ifrootst_to_ifrootxf_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from fine root storage pool to fine root transfer pool - ifrootxf_to_ifroot_phn => cnveg_nitrogenflux_inst%ifrootxf_to_ifroot_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from fine root transfer pool to fine root pool - ilivestemst_to_ilivestemxf_phn => cnveg_nitrogenflux_inst%ilivestemst_to_ilivestemxf_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from live stem storage pool to live stem transfer pool - ilivestemxf_to_ilivestem_phn => cnveg_nitrogenflux_inst%ilivestemxf_to_ilivestem_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from live stem transfer pool to live stem pool - ideadstemst_to_ideadstemxf_phn => cnveg_nitrogenflux_inst%ideadstemst_to_ideadstemxf_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from dead stem storage pool to dead stem transfer pool - ideadstemxf_to_ideadstem_phn => cnveg_nitrogenflux_inst%ideadstemxf_to_ideadstem_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from dead stem transfer pool to dead stem pool - ilivecrootst_to_ilivecrootxf_phn => cnveg_nitrogenflux_inst%ilivecrootst_to_ilivecrootxf_ph, & - ! Input: [integer (:)] Index of phenology related N transfer from live coarse root storage pool to live coarse root transfer pool - ilivecrootxf_to_ilivecroot_phn => cnveg_nitrogenflux_inst%ilivecrootxf_to_ilivecroot_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from live coarse root transfer pool to live coarse root pool - ideadcrootst_to_ideadcrootxf_phn => cnveg_nitrogenflux_inst%ideadcrootst_to_ideadcrootxf_ph, & - ! Input: [integer (:)] Index of phenology related N transfer from dead coarse root storage pool to dead coarse root transfer pool - ideadcrootxf_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ideadcrootxf_to_ideadcroot_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from dead coarse root transfer pool to dead coarse root pool - ilivestem_to_ideadstem_phn => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from live stem pool to dead stem pool - ilivecroot_to_ideadcroot_phn => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from live coarse root pool to dead coarse root pool - ileaf_to_iout_phn => cnveg_nitrogenflux_inst%ileaf_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from leaf pool to outside of vegetation pools - ifroot_to_iout_phn => cnveg_nitrogenflux_inst%ifroot_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from fine root pool to outside of vegetation pools - ilivestem_to_iout_phn => cnveg_nitrogenflux_inst%ilivestem_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from live stem pool to outside of vegetation pools - iretransn_to_iout_phn => cnveg_nitrogenflux_inst%iretransn_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to outside of vegetation pools - igrain_to_iout_phn => cnveg_nitrogenflux_inst%igrain_to_iout_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from grain pool to outside of vegetation pools - ileaf_to_iretransn_phn => cnveg_nitrogenflux_inst%ileaf_to_iretransn_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from leaf pool to retranslocated N pool - ifroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ifroot_to_iretransn_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from fine root pool to retranslocated N pool - ilivestem_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivestem_to_iretransn_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from live stem pool to retranslocated N pool - ilivecroot_to_iretransn_phn => cnveg_nitrogenflux_inst%ilivecroot_to_iretransn_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from live coarse root pool to retranslocated N pool - iretransn_to_ileaf_phn => cnveg_nitrogenflux_inst%iretransn_to_ileaf_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to leaf pool - iretransn_to_ileafst_phn => cnveg_nitrogenflux_inst%iretransn_to_ileafst_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to leaf storage pool - iretransn_to_ifroot_phn => cnveg_nitrogenflux_inst%iretransn_to_ifroot_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to fine root pool - iretransn_to_ifrootst_phn => cnveg_nitrogenflux_inst%iretransn_to_ifrootst_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to fine root storage pool - iretransn_to_ilivestem_phn => cnveg_nitrogenflux_inst%iretransn_to_ilivestem_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to live stem pool - iretransn_to_ilivestemst_phn => cnveg_nitrogenflux_inst%iretransn_to_ilivestemst_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to live stem storage pool - iretransn_to_ideadstem_phn => cnveg_nitrogenflux_inst%iretransn_to_ideadstem_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to dead stem pool - iretransn_to_ideadstemst_phn => cnveg_nitrogenflux_inst%iretransn_to_ideadstemst_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to dead stem storage pool - iretransn_to_ilivecroot_phn => cnveg_nitrogenflux_inst%iretransn_to_ilivecroot_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to live coarse root pool - iretransn_to_ilivecrootst_phn => cnveg_nitrogenflux_inst%iretransn_to_ilivecrootst_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to live coarse root storage pool - iretransn_to_ideadcroot_phn => cnveg_nitrogenflux_inst%iretransn_to_ideadcroot_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to dead coarse root pool - iretransn_to_ideadcrootst_phn => cnveg_nitrogenflux_inst%iretransn_to_ideadcrootst_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to dead coarse root storage pool - iretransn_to_igrain_phn => cnveg_nitrogenflux_inst%iretransn_to_igrain_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to grain pool - iretransn_to_igrainst_phn => cnveg_nitrogenflux_inst%iretransn_to_igrainst_ph , & - ! Input: [integer (:)] Index of phenology related N transfer from retranslocated N pool to grain storage pool - ileaf_to_iout_gmn => cnveg_nitrogenflux_inst%ileaf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from leaf pool to outside of vegetation pools - ileafst_to_iout_gmn => cnveg_nitrogenflux_inst%ileafst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from leaf storage pool to outside of vegetation pools - ileafxf_to_iout_gmn => cnveg_nitrogenflux_inst%ileafxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from leaf transfer pool to outside of vegetation pools - ifroot_to_iout_gmn => cnveg_nitrogenflux_inst%ifroot_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from fine root pool to outside of vegetation pools - ifrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ifrootst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from fine root storage pool to outside of vegetation pools - ifrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ifrootxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from fine root transfer pool to outside of vegetation pools - ilivestem_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestem_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from live stem pool to outside of vegetation pools - ilivestemst_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestemst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from live stem storage pool to outside of vegetation pools - ilivestemxf_to_iout_gmn => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from live stem transfer pool to outside of vegetation pools - ideadstem_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstem_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem pool to outside of vegetation pools - ideadstemst_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstemst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem storage pool to outside of vegetation pools - ideadstemxf_to_iout_gmn => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from dead stem transfer pool to outside of vegetation pools - ilivecroot_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecroot_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root pool to outside of vegetation pools - ilivecrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root storage pool to outside of vegetation pools - ilivecrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from live coarse root transfer pool to outside of vegetation pools - ideadcroot_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcroot_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root pool to outside of vegetation pools - ideadcrootst_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root storage pool to outside of vegetation pools - ideadcrootxf_to_iout_gmn => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from dead coarse root transfer pool to outside of vegetation pools - iretransn_to_iout_gmn => cnveg_nitrogenflux_inst%iretransn_to_iout_gm , & - ! Input: [integer (:)] Index of gap mortality related N transfer from retranslocated N pool to outside of vegetation pools - ileaf_to_iout_fin => cnveg_nitrogenflux_inst%ileaf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from leaf pool to outside of vegetation pools - ileafst_to_iout_fin => cnveg_nitrogenflux_inst%ileafst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from leaf storage pool to outside of vegetation pools - ileafxf_to_iout_fin => cnveg_nitrogenflux_inst%ileafxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from leaf transfer pool to outside of vegetation pools - ifroot_to_iout_fin => cnveg_nitrogenflux_inst%ifroot_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from fine root pool to outside of vegetation pools - ifrootst_to_iout_fin => cnveg_nitrogenflux_inst%ifrootst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from fine root storage pool to outside of vegetation pools - ifrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ifrootxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from fine transfer pool to outside of vegetation pools - ilivestem_to_iout_fin => cnveg_nitrogenflux_inst%ilivestem_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from live stem pool to outside of vegetation pools - ilivestemst_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from live stem storage pool to outside of vegetation pools - ilivestemxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivestemxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from live stem transfer pool to outside of vegetation pools - ideadstem_to_iout_fin => cnveg_nitrogenflux_inst%ideadstem_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from dead stem pool to outside of vegetation pools - ideadstemst_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from dead stem storage pool to outside of vegetation pools - ideadstemxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadstemxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from dead stem transfer pool to outside of vegetation pools - ilivecroot_to_iout_fin => cnveg_nitrogenflux_inst%ilivecroot_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to outside of vegetation pools - ilivecrootst_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from live coarse root storage pool to outside of vegetation pools - ilivecrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ilivecrootxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from live coarse root transfer pool to outside of vegetation pools - ideadcroot_to_iout_fin => cnveg_nitrogenflux_inst%ideadcroot_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from dead coarse root pool to outside of vegetation pools - ideadcrootst_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootst_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from dead coarse root storage pool to outside of vegetation pools - ideadcrootxf_to_iout_fin => cnveg_nitrogenflux_inst%ideadcrootxf_to_iout_fi , & - ! Input: [integer (:)] Index of fire related N transfer from dead coarse root transfer pool to outside of vegetation pools - ilivestem_to_ideadstem_fin => cnveg_nitrogenflux_inst%ilivestem_to_ideadstem_fi , & - ! Input: [integer (:)] Index of fire related N transfer from live stem to dead stem pool - ilivecroot_to_ideadcroot_fin => cnveg_nitrogenflux_inst%ilivecroot_to_ideadcroot_fi , & - ! Input: [integer (:)] Index of fire related N transfer from live coarse root pool to dead coarse root pool - iretransn_to_iout_fin => cnveg_nitrogenflux_inst%iretransn_to_iout_fi & - ! Input: [integer (:)] Index of fire related N transfer from retranslocated N pool to outside of vegetation pools - ) -td: associate( & - - ! Sparse matrix type of A*K - AKphvegc => cnveg_carbonflux_inst%AKphvegc , & ! Aph*Kph for C cycle in sparse matrix format - AKgmvegc => cnveg_carbonflux_inst%AKgmvegc , & ! Agm*Kgm for C cycle in sparse matrix format - AKfivegc => cnveg_carbonflux_inst%AKfivegc , & ! Afi*Kfi for C cycle in sparse matrix format - AKallvegc => cnveg_carbonflux_inst%AKallvegc , & ! Aph*Kph + Agm*Kgm + Afi*Kfi for C cycle in sparse matrix format - NE_AKallvegc => cnveg_carbonflux_inst%NE_AKallvegc , & ! Number of entries in AKallvegc - RI_AKallvegc => cnveg_carbonflux_inst%RI_AKallvegc , & ! Row indices in Akallvegc - CI_AKallvegc => cnveg_carbonflux_inst%CI_AKallvegc , & ! Column indices in AKallvegc - Kvegc => cnveg_carbonflux_inst%Kvegc , & ! Temporary variable of Kph, Kgm or Kfi for C cycle in diagonal matrix format - Xvegc => cnveg_carbonflux_inst%Xvegc , & ! Vegetation C of each compartment in a vector format - AKphvegn => cnveg_nitrogenflux_inst%AKphvegn , & ! Aph*Kph for N cycle in sparse matrix format - AKgmvegn => cnveg_nitrogenflux_inst%AKgmvegn , & ! Agm*Kgm for N cycle in sparse matrix format - AKfivegn => cnveg_nitrogenflux_inst%AKfivegn , & ! Afi*Kfi for N cycle in sparse matrix format - AKallvegn => cnveg_nitrogenflux_inst%AKallvegn , & ! Aph*Kph + Agm*Kgm + Afi*Kfi for N cycle in sparse matrix format - NE_AKallvegn => cnveg_nitrogenflux_inst%NE_AKallvegn , & ! Number of entries in AKallvegn - RI_AKallvegn => cnveg_nitrogenflux_inst%RI_AKallvegn , & ! Row indices in Akallvegn - CI_AKallvegn => cnveg_nitrogenflux_inst%CI_AKallvegn , & ! Column indices in AKallvegn - Kvegn => cnveg_nitrogenflux_inst%Kvegn , & ! Temporary variable of Kph, Kgm or Kfi for N cycle in diagonal matrix format - Xvegn => cnveg_nitrogenflux_inst%Xvegn , & ! Vegetation N of each compartment in a vector format - Xveg13c => cnveg_carbonflux_inst%Xveg13c , & ! Vegetation C13 of each compartment in a vector format - Xveg14c => cnveg_carbonflux_inst%Xveg14c , & ! Vegetation C14 of each compartment in a vector format - - ! Row and column indices of A matrices - RI_phc => cnveg_carbonflux_inst%RI_phc , & ! Row indices of non-diagonal entires in Aph for C cycle - CI_phc => cnveg_carbonflux_inst%CI_phc , & ! Column indices of non-diagonal entries in Aph for C cycle - RI_gmc => cnveg_carbonflux_inst%RI_gmc , & ! Row indices of non-diagonal entires in Agm for C cycle - CI_gmc => cnveg_carbonflux_inst%CI_gmc , & ! Column indices of non-diagonal entries in Agm for C cycle - RI_fic => cnveg_carbonflux_inst%RI_fic , & ! Row indices of non-diagonal entires in Afi for C cycle - CI_fic => cnveg_carbonflux_inst%CI_fic , & ! Column indices of non-diagonal entries in Afi for C cycle - RI_phn => cnveg_nitrogenflux_inst%RI_phn , & ! Row indices of non-diagonal entires in Aph for N cycle - CI_phn => cnveg_nitrogenflux_inst%CI_phn , & ! Column indices of non-diagonal entries in Aph for N cycle - RI_gmn => cnveg_nitrogenflux_inst%RI_gmn , & ! Row indices of non-diagonal entires in Agm for N cycle - CI_gmn => cnveg_nitrogenflux_inst%CI_gmn , & ! Column indices of non-diagonal entries in Agm for N cycle - RI_fin => cnveg_nitrogenflux_inst%RI_fin , & ! Row indices of non-diagonal entires in Afi for N cycle - CI_fin => cnveg_nitrogenflux_inst%CI_fin , & ! Column indices of non-diagonal entries in Afi for N cycle - - ! Following list contains indices of non-diagonal entries in full sparse matrix - list_aphc => cnveg_carbonflux_inst%list_aphc , & ! Indices of non-diagnoal entries in full sparse matrix Aph for C cycle - list_agmc => cnveg_carbonflux_inst%list_agmc , & ! Indices of non-diagnoal entries in full sparse matrix Agm for C cycle - list_afic => cnveg_carbonflux_inst%list_afic , & ! Indices of non-diagnoal entries in full sparse matrix Afi for C cycle - list_aphn => cnveg_nitrogenflux_inst%list_aphn , & ! Indices of non-diagnoal entries in full sparse matrix Aph for N cycle - list_agmn => cnveg_nitrogenflux_inst%list_agmn , & ! Indices of non-diagnoal entries in full sparse matrix Agm for N cycle - list_afin => cnveg_nitrogenflux_inst%list_afin , & ! Indices of non-diagnoal entries in full sparse matrix Afi for N cycle - - ! For sparse matrix A, B and A + B, following list contains locations of entries in A or B or C mapped into matrix (A+B) or (A+B+C) - list_phc_phgm => cnveg_carbonflux_inst%list_phc_phgmc , & ! The locations of entries in AKphvegc mapped into (AKphvegc+AKgmvegc) - list_gmc_phgm => cnveg_carbonflux_inst%list_gmc_phgmc , & ! The locations of entries in AKgmvegc mapped into (AKphvegc+AKgmvegc) - list_phc_phgmfi => cnveg_carbonflux_inst%list_phc_phgmfic , & ! The locations of entries in AKphvegc mapped into (AKphvegc+AKgmvegc+AKfivegc) - list_gmc_phgmfi => cnveg_carbonflux_inst%list_gmc_phgmfic , & ! The locations of entries in AKgmvegc mapped into (AKphvegc+AKgmvegc+AKfivegc) - list_fic_phgmfi => cnveg_carbonflux_inst%list_fic_phgmfic , & ! The locations of entries in AKfivegc mapped into (AKphvegc+AKgmvegc+AKfivegc) - list_phn_phgm => cnveg_nitrogenflux_inst%list_phn_phgmn , & ! The locations of entries in AKphvegn mapped into (AKphvegn+AKgmvegn) - list_gmn_phgm => cnveg_nitrogenflux_inst%list_gmn_phgmn , & ! The locations of entries in AKgmvegn mapped into (AKphvegn+AKgmvegn) - list_phn_phgmfi => cnveg_nitrogenflux_inst%list_phn_phgmfin , & ! The locations of entries in AKphvegn mapped into (AKphvegn+AKgmvegn+AKfivegn) - list_gmn_phgmfi => cnveg_nitrogenflux_inst%list_gmn_phgmfin , & ! The locations of entries in AKgmvegn mapped into (AKphvegn+AKgmvegn+AKfivegn) - list_fin_phgmfi => cnveg_nitrogenflux_inst%list_fin_phgmfin & ! The locations of entries in AKfivegn mapped into (AKphvegn+AKgmvegn+AKfivegn) - ) -#ifdef _OPENMP - nthreads = OMP_GET_MAX_THREADS() -#endif - !----------------------------------------------------------------------- - ! set time steps - call t_startf('CN veg matrix-init') - dt = real( get_step_size(), r8 ) - secspyear = get_days_per_year() * secspday - - ! Initialize local variables - call vegmatrixc_input%InitV(nvegcpool,bounds%begp,bounds%endp) - if(use_c13)then - call vegmatrixc13_input%InitV(nvegcpool,bounds%begp,bounds%endp) - end if - if(use_c14)then - call vegmatrixc14_input%InitV(nvegcpool,bounds%begp,bounds%endp) - end if - call vegmatrixn_input%InitV(nvegnpool,bounds%begp,bounds%endp) - - matrix_calloc_acc (:) = 0._r8 - matrix_nalloc_acc (:) = 0._r8 - matrix_ctransfer_acc (:,:) = 0._r8 - matrix_ntransfer_acc (:,:) = 0._r8 - if(use_c13)then - matrix_c13alloc_acc (:) = 0._r8 - matrix_c13transfer_acc (:,:) = 0._r8 - end if - if(use_c14)then - matrix_c14alloc_acc (:) = 0._r8 - matrix_c14transfer_acc (:,:) = 0._r8 - end if - - AKinvc (:,:) = 0._r8 - AKinvn (:,:) = 0._r8 - - epsi = 1.e-30_r8 ! small number - - call t_stopf('CN veg matrix-init') - - call t_startf('CN veg matrix-assigning matrix') - - ! Calculate A matrices from C transfers and C turnovers - if(ncphtrans .gt. ncphouttrans)then - do k=1,ncphtrans-ncphouttrans - do fp = 1,num_soilp - p = filter_soilp(fp) - if(matrix_phturnover(p,doner_phc(k)) .ne. 0)then - Aphconed(p,k) = matrix_phtransfer(p,k) * dt / matrix_phturnover(p,doner_phc(k)) - else - Aphconed(p,k) = 0._r8 - end if - end do - end do - end if - - if(ncgmtrans .gt. ncgmouttrans)then - do k=1,ncgmtrans-ncgmouttrans - do fp = 1,num_soilp - p = filter_soilp(fp) - if(matrix_gmturnover(p,doner_gmc(k)) .ne. 0)then - Agmconed(p,k) = matrix_gmtransfer(p,k) * dt / matrix_gmturnover(p,doner_gmc(k)) - else - Agmconed(p,k) = 0._r8 - end if - end do - end do - end if - - if(ncfitrans .gt. ncfiouttrans)then - do k=1,ncfitrans-ncfiouttrans - do fp = 1,num_soilp - p = filter_soilp(fp) - if(matrix_fiturnover(p,doner_fic(k)) .ne. 0)then - Aficoned(p,k) = matrix_fitransfer(p,k) * dt / matrix_fiturnover(p,doner_fic(k)) - else - Aficoned(p,k) = 0._r8 - end if - if(use_c14)then - associate( & - matrix_c14fitransfer => c14_cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in (CNFireBaseMod or CNFireLi2014Mod) and CNC14decayMod - matrix_c14fiturnover => c14_cnveg_carbonflux_inst%matrix_fiturnover_patch & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods - ) - if(matrix_c14fiturnover(p,doner_fic(k)) .ne. 0)then - Afic14oned(p,k) = matrix_c14fitransfer(p,k) * dt / matrix_c14fiturnover(p,doner_fic(k)) - else - Afic14oned(p,k) = 0._r8 - end if - end associate - end if - end do - end do - end if - - if(nnphtrans .gt. nnphouttrans)then - do k=1,nnphtrans-nnphouttrans - do fp = 1,num_soilp - p = filter_soilp(fp) - if(matrix_nphturnover(p,doner_phn(k)) .ne. 0)then - Aphnoned(p,k) = matrix_nphtransfer(p,k) * dt / matrix_nphturnover(p,doner_phn(k)) - else - Aphnoned(p,k) = 0._r8 - end if - end do - end do - end if - - if(nngmtrans .gt. nngmouttrans)then - do k=1,nngmtrans-nngmouttrans - do fp = 1,num_soilp - p = filter_soilp(fp) - if(matrix_ngmturnover(p,doner_phn(k)) .ne. 0)then - Agmnoned(p,k) = matrix_ngmtransfer(p,k) * dt / matrix_ngmturnover(p,doner_phn(k)) - else - Agmnoned(p,k) = 0._r8 - end if - end do - end do - end if - - if(nnfitrans .gt. nnfiouttrans)then - do k=1,nnfitrans-nnfiouttrans - do fp = 1,num_soilp - p = filter_soilp(fp) - if(matrix_nfiturnover(p,doner_fin(k)) .ne. 0)then - Afinoned(p,k) = matrix_nfitransfer(p,k) * dt / matrix_nfiturnover(p,doner_fin(k)) - else - Afinoned(p,k) = 0._r8 - end if - end do - end do - end if - - call t_stopf('CN veg matrix-assigning matrix') - - ! Assign old state variables to vector Xveg* - call t_startf('CN veg matrix-set old value') - - do fp = 1,num_soilp - p = filter_soilp(fp) - Xvegc%V(p,ileaf) = leafc(p) - Xvegc%V(p,ileaf_st) = leafc_storage(p) - Xvegc%V(p,ileaf_xf) = leafc_xfer(p) - Xvegc%V(p,ifroot) = frootc(p) - Xvegc%V(p,ifroot_st) = frootc_storage(p) - Xvegc%V(p,ifroot_xf) = frootc_xfer(p) - Xvegc%V(p,ilivestem) = livestemc(p) - Xvegc%V(p,ilivestem_st) = livestemc_storage(p) - Xvegc%V(p,ilivestem_xf) = livestemc_xfer(p) - Xvegc%V(p,ideadstem) = deadstemc(p) - Xvegc%V(p,ideadstem_st) = deadstemc_storage(p) - Xvegc%V(p,ideadstem_xf) = deadstemc_xfer(p) - Xvegc%V(p,ilivecroot) = livecrootc(p) - Xvegc%V(p,ilivecroot_st) = livecrootc_storage(p) - Xvegc%V(p,ilivecroot_xf) = livecrootc_xfer(p) - Xvegc%V(p,ideadcroot) = deadcrootc(p) - Xvegc%V(p,ideadcroot_st) = deadcrootc_storage(p) - Xvegc%V(p,ideadcroot_xf) = deadcrootc_xfer(p) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - Xvegc%V(p,igrain) = grainc(p) - Xvegc%V(p,igrain_st) = grainc_storage(p) - Xvegc%V(p,igrain_xf) = grainc_xfer(p) - end if - end do - - if ( use_c13 )then - do fp = 1,num_soilp - p = filter_soilp(fp) - Xveg13c%V(p,ileaf) = cs13_veg%leafc_patch(p) - Xveg13c%V(p,ileaf_st) = cs13_veg%leafc_storage_patch(p) - Xveg13c%V(p,ileaf_xf) = cs13_veg%leafc_xfer_patch(p) - Xveg13c%V(p,ifroot) = cs13_veg%frootc_patch(p) - Xveg13c%V(p,ifroot_st) = cs13_veg%frootc_storage_patch(p) - Xveg13c%V(p,ifroot_xf) = cs13_veg%frootc_xfer_patch(p) - Xveg13c%V(p,ilivestem) = cs13_veg%livestemc_patch(p) - Xveg13c%V(p,ilivestem_st) = cs13_veg%livestemc_storage_patch(p) - Xveg13c%V(p,ilivestem_xf) = cs13_veg%livestemc_xfer_patch(p) - Xveg13c%V(p,ideadstem) = cs13_veg%deadstemc_patch(p) - Xveg13c%V(p,ideadstem_st) = cs13_veg%deadstemc_storage_patch(p) - Xveg13c%V(p,ideadstem_xf) = cs13_veg%deadstemc_xfer_patch(p) - Xveg13c%V(p,ilivecroot) = cs13_veg%livecrootc_patch(p) - Xveg13c%V(p,ilivecroot_st) = cs13_veg%livecrootc_storage_patch(p) - Xveg13c%V(p,ilivecroot_xf) = cs13_veg%livecrootc_xfer_patch(p) - Xveg13c%V(p,ideadcroot) = cs13_veg%deadcrootc_patch(p) - Xveg13c%V(p,ideadcroot_st) = cs13_veg%deadcrootc_storage_patch(p) - Xveg13c%V(p,ideadcroot_xf) = cs13_veg%deadcrootc_xfer_patch(p) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - Xveg13c%V(p,igrain) = cs13_veg%grainc_patch(p) - Xveg13c%V(p,igrain_st) = cs13_veg%grainc_storage_patch(p) - Xveg13c%V(p,igrain_xf) = cs13_veg%grainc_xfer_patch(p) - end if - end do - end if - - if ( use_c14 )then - do fp = 1,num_soilp - p = filter_soilp(fp) - Xveg14c%V(p,ileaf) = cs14_veg%leafc_patch(p) - Xveg14c%V(p,ileaf_st) = cs14_veg%leafc_storage_patch(p) - Xveg14c%V(p,ileaf_xf) = cs14_veg%leafc_xfer_patch(p) - Xveg14c%V(p,ifroot) = cs14_veg%frootc_patch(p) - Xveg14c%V(p,ifroot_st) = cs14_veg%frootc_storage_patch(p) - Xveg14c%V(p,ifroot_xf) = cs14_veg%frootc_xfer_patch(p) - Xveg14c%V(p,ilivestem) = cs14_veg%livestemc_patch(p) - Xveg14c%V(p,ilivestem_st) = cs14_veg%livestemc_storage_patch(p) - Xveg14c%V(p,ilivestem_xf) = cs14_veg%livestemc_xfer_patch(p) - Xveg14c%V(p,ideadstem) = cs14_veg%deadstemc_patch(p) - Xveg14c%V(p,ideadstem_st) = cs14_veg%deadstemc_storage_patch(p) - Xveg14c%V(p,ideadstem_xf) = cs14_veg%deadstemc_xfer_patch(p) - Xveg14c%V(p,ilivecroot) = cs14_veg%livecrootc_patch(p) - Xveg14c%V(p,ilivecroot_st) = cs14_veg%livecrootc_storage_patch(p) - Xveg14c%V(p,ilivecroot_xf) = cs14_veg%livecrootc_xfer_patch(p) - Xveg14c%V(p,ideadcroot) = cs14_veg%deadcrootc_patch(p) - Xveg14c%V(p,ideadcroot_st) = cs14_veg%deadcrootc_storage_patch(p) - Xveg14c%V(p,ideadcroot_xf) = cs14_veg%deadcrootc_xfer_patch(p) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - Xveg14c%V(p,igrain) = cs14_veg%grainc_patch(p) - Xveg14c%V(p,igrain_st) = cs14_veg%grainc_storage_patch(p) - Xveg14c%V(p,igrain_xf) = cs14_veg%grainc_xfer_patch(p) - end if - end do - end if - - do fp = 1,num_soilp - p = filter_soilp(fp) - Xvegn%V(p,ileaf) = leafn(p) - Xvegn%V(p,ileaf_st) = leafn_storage(p) - Xvegn%V(p,ileaf_xf) = leafn_xfer(p) - Xvegn%V(p,ifroot) = frootn(p) - Xvegn%V(p,ifroot_st) = frootn_storage(p) - Xvegn%V(p,ifroot_xf) = frootn_xfer(p) - Xvegn%V(p,ilivestem) = livestemn(p) - Xvegn%V(p,ilivestem_st) = livestemn_storage(p) - Xvegn%V(p,ilivestem_xf) = livestemn_xfer(p) - Xvegn%V(p,ideadstem) = deadstemn(p) - Xvegn%V(p,ideadstem_st) = deadstemn_storage(p) - Xvegn%V(p,ideadstem_xf) = deadstemn_xfer(p) - Xvegn%V(p,ilivecroot) = livecrootn(p) - Xvegn%V(p,ilivecroot_st) = livecrootn_storage(p) - Xvegn%V(p,ilivecroot_xf) = livecrootn_xfer(p) - Xvegn%V(p,ideadcroot) = deadcrootn(p) - Xvegn%V(p,ideadcroot_st) = deadcrootn_storage(p) - Xvegn%V(p,ideadcroot_xf) = deadcrootn_xfer(p) - Xvegn%V(p,iretransn) = retransn(p) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - Xvegn%V(p,igrain) = grainn(p) - Xvegn%V(p,igrain_st) = grainn_storage(p) - Xvegn%V(p,igrain_xf) = grainn_xfer(p) - end if - end do - - ! Save *c0* and *n0* variables at begin of each year. - if (is_beg_curr_year())then - iyr = iyr + 1 - if(mod(iyr-1,nyr_forcing) .eq. 0)then - iloop = iloop + 1 - end if - if(.not. isspinup .or. isspinup .and. mod(iyr-1,nyr_SASU) .eq. 0)then - do fp = 1,num_soilp - p = filter_soilp(fp) - leafc0(p) = max(leafc(p), epsi) - leafc0_storage(p) = max(leafc_storage(p), epsi) - leafc0_xfer(p) = max(leafc_xfer(p), epsi) - frootc0(p) = max(frootc(p), epsi) - frootc0_storage(p) = max(frootc_storage(p), epsi) - frootc0_xfer(p) = max(frootc_xfer(p), epsi) - livestemc0(p) = max(livestemc(p), epsi) - livestemc0_storage(p) = max(livestemc_storage(p), epsi) - livestemc0_xfer(p) = max(livestemc_xfer(p), epsi) - deadstemc0(p) = max(deadstemc(p), epsi) - deadstemc0_storage(p) = max(deadstemc_storage(p), epsi) - deadstemc0_xfer(p) = max(deadstemc_xfer(p), epsi) - livecrootc0(p) = max(livecrootc(p), epsi) - livecrootc0_storage(p) = max(livecrootc_storage(p), epsi) - livecrootc0_xfer(p) = max(livecrootc_xfer(p), epsi) - deadcrootc0(p) = max(deadcrootc(p), epsi) - deadcrootc0_storage(p) = max(deadcrootc_storage(p), epsi) - deadcrootc0_xfer(p) = max(deadcrootc_xfer(p), epsi) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - grainc0(p) = max(grainc(p), epsi) - grainc0_storage(p) = max(grainc_storage(p), epsi) - grainc0_xfer(p) = max(grainc_xfer(p), epsi) - end if - end do - - if(use_c13)then - do fp = 1,num_soilp - p = filter_soilp(fp) - cs13_veg%leafc0_patch(p) = max(cs13_veg%leafc_patch(p), epsi) - cs13_veg%leafc0_storage_patch(p) = max(cs13_veg%leafc_storage_patch(p), epsi) - cs13_veg%leafc0_xfer_patch(p) = max(cs13_veg%leafc_xfer_patch(p), epsi) - cs13_veg%frootc0_patch(p) = max(cs13_veg%frootc_patch(p), epsi) - cs13_veg%frootc0_storage_patch(p) = max(cs13_veg%frootc_storage_patch(p), epsi) - cs13_veg%frootc0_xfer_patch(p) = max(cs13_veg%frootc_xfer_patch(p), epsi) - cs13_veg%livestemc0_patch(p) = max(cs13_veg%livestemc_patch(p), epsi) - cs13_veg%livestemc0_storage_patch(p) = max(cs13_veg%livestemc_storage_patch(p), epsi) - cs13_veg%livestemc0_xfer_patch(p) = max(cs13_veg%livestemc_xfer_patch(p), epsi) - cs13_veg%deadstemc0_patch(p) = max(cs13_veg%deadstemc_patch(p), epsi) - cs13_veg%deadstemc0_storage_patch(p) = max(cs13_veg%deadstemc_storage_patch(p), epsi) - cs13_veg%deadstemc0_xfer_patch(p) = max(cs13_veg%deadstemc_xfer_patch(p), epsi) - cs13_veg%livecrootc0_patch(p) = max(cs13_veg%livecrootc_patch(p), epsi) - cs13_veg%livecrootc0_storage_patch(p) = max(cs13_veg%livecrootc_storage_patch(p), epsi) - cs13_veg%livecrootc0_xfer_patch(p) = max(cs13_veg%livecrootc_xfer_patch(p), epsi) - cs13_veg%deadcrootc0_patch(p) = max(cs13_veg%deadcrootc_patch(p), epsi) - cs13_veg%deadcrootc0_storage_patch(p) = max(cs13_veg%deadcrootc_storage_patch(p), epsi) - cs13_veg%deadcrootc0_xfer_patch(p) = max(cs13_veg%deadcrootc_xfer_patch(p), epsi) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - cs13_veg%grainc0_patch(p) = max(cs13_veg%grainc_patch(p), epsi) - cs13_veg%grainc0_storage_patch(p) = max(cs13_veg%grainc_storage_patch(p), epsi) - cs13_veg%grainc0_xfer_patch(p) = max(cs13_veg%grainc_xfer_patch(p), epsi) - end if - end do - end if - - if(use_c14)then - do fp = 1,num_soilp - p = filter_soilp(fp) - cs14_veg%leafc0_patch(p) = max(cs14_veg%leafc_patch(p), epsi) - cs14_veg%leafc0_storage_patch(p) = max(cs14_veg%leafc_storage_patch(p), epsi) - cs14_veg%leafc0_xfer_patch(p) = max(cs14_veg%leafc_xfer_patch(p), epsi) - cs14_veg%frootc0_patch(p) = max(cs14_veg%frootc_patch(p), epsi) - cs14_veg%frootc0_storage_patch(p) = max(cs14_veg%frootc_storage_patch(p), epsi) - cs14_veg%frootc0_xfer_patch(p) = max(cs14_veg%frootc_xfer_patch(p), epsi) - cs14_veg%livestemc0_patch(p) = max(cs14_veg%livestemc_patch(p), epsi) - cs14_veg%livestemc0_storage_patch(p) = max(cs14_veg%livestemc_storage_patch(p), epsi) - cs14_veg%livestemc0_xfer_patch(p) = max(cs14_veg%livestemc_xfer_patch(p), epsi) - cs14_veg%deadstemc0_patch(p) = max(cs14_veg%deadstemc_patch(p), epsi) - cs14_veg%deadstemc0_storage_patch(p) = max(cs14_veg%deadstemc_storage_patch(p), epsi) - cs14_veg%deadstemc0_xfer_patch(p) = max(cs14_veg%deadstemc_xfer_patch(p), epsi) - cs14_veg%livecrootc0_patch(p) = max(cs14_veg%livecrootc_patch(p), epsi) - cs14_veg%livecrootc0_storage_patch(p) = max(cs14_veg%livecrootc_storage_patch(p), epsi) - cs14_veg%livecrootc0_xfer_patch(p) = max(cs14_veg%livecrootc_xfer_patch(p), epsi) - cs14_veg%deadcrootc0_patch(p) = max(cs14_veg%deadcrootc_patch(p), epsi) - cs14_veg%deadcrootc0_storage_patch(p) = max(cs14_veg%deadcrootc_storage_patch(p), epsi) - cs14_veg%deadcrootc0_xfer_patch(p) = max(cs14_veg%deadcrootc_xfer_patch(p), epsi) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - cs14_veg%grainc0_patch(p) = max(cs14_veg%grainc_patch(p), epsi) - cs14_veg%grainc0_storage_patch(p) = max(cs14_veg%grainc_storage_patch(p), epsi) - cs14_veg%grainc0_xfer_patch(p) = max(cs14_veg%grainc_xfer_patch(p), epsi) - end if - end do - end if - - do fp = 1,num_soilp - p = filter_soilp(fp) - leafn0(p) = max(leafn(p), epsi) - leafn0_storage(p) = max(leafn_storage(p), epsi) - leafn0_xfer(p) = max(leafn_xfer(p), epsi) - frootn0(p) = max(frootn(p), epsi) - frootn0_storage(p) = max(frootn_storage(p), epsi) - frootn0_xfer(p) = max(frootn_xfer(p), epsi) - livestemn0(p) = max(livestemn(p), epsi) - livestemn0_storage(p) = max(livestemn_storage(p), epsi) - livestemn0_xfer(p) = max(livestemn_xfer(p), epsi) - deadstemn0(p) = max(deadstemn(p), epsi) - deadstemn0_storage(p) = max(deadstemn_storage(p), epsi) - deadstemn0_xfer(p) = max(deadstemn_xfer(p), epsi) - livecrootn0(p) = max(livecrootn(p), epsi) - livecrootn0_storage(p) = max(livecrootn_storage(p), epsi) - livecrootn0_xfer(p) = max(livecrootn_xfer(p), epsi) - deadcrootn0(p) = max(deadcrootn(p), epsi) - deadcrootn0_storage(p) = max(deadcrootn_storage(p), epsi) - deadcrootn0_xfer(p) = max(deadcrootn_xfer(p), epsi) - retransn0(p) = max(retransn(p), epsi) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - grainn0(p) = max(grainn(p), epsi) - grainn0_storage(p) = max(grainn_storage(p), epsi) - grainn0_xfer(p) = max(grainn_xfer(p), epsi) - end if - end do - end if - end if - - call t_stopf('CN veg matrix-set old value') - - call t_startf('CN veg matrix-matrix multi.') - - ! Start matrix operation - ! Calculate B*I - - do i=1,nvegcpool - do fp = 1,num_soilp - p = filter_soilp(fp) - vegmatrixc_input%V(p,i) = matrix_alloc(p,i) * matrix_Cinput(p) * dt - end do - end do - - ! Set up sparse matrix Aph_c from non-diagonal entires Aphconed, diagonal entries are all set to -1. - ! Note that AKphvegc here only represent A matrix instead of A * K - - if(ncphtrans .gt. ncphouttrans)then - AI_phc = receiver_phc(1:ncphtrans-ncphouttrans) - AJ_phc = doner_phc (1:ncphtrans-ncphouttrans) - call AKphvegc%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Aphconed,& - AI_phc,AJ_phc,ncphtrans-ncphouttrans,init_ready_aphc,list_aphc,RI_phc,CI_phc) - else - call AKphvegc%SetValueA_diag(num_soilp,filter_soilp,-1._r8) - end if - - ! Set up diagonal matrix Kph_c from diagonal entries matrix_phturnover - call Kvegc%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_phturnover(bounds%begp:bounds%endp,1:nvegcpool)) - - ! Calculate Aph_c*Kph_c using SPMM_AK. - call AKphvegc%SPMM_AK(num_soilp,filter_soilp,Kvegc) - - - - ! Set up sparse matrix Agm_c from non-diagonal entires Agmconed, diagonal entries are all set to -1. - ! Note that AKgmvegc here only represent A matrix instead of A * K - - if(ncgmtrans .gt. ncgmouttrans)then - AI_gmc = receiver_gmc(1:ncgmtrans-ncgmouttrans) - AJ_gmc = doner_gmc (1:ncgmtrans-ncgmouttrans) - call AKgmvegc%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Agmconed,& - AI_gmc,AJ_gmc,ncgmtrans-ncgmouttrans,init_ready_agmc,list_agmc,RI_gmc,CI_gmc) - else - call AKgmvegc%SetValueA_diag(num_soilp,filter_soilp,-1._r8) - end if - - ! Set up diagonal matrix Kgm_c from diagonal entries matrix_gmturnover - call Kvegc%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_gmturnover(bounds%begp:bounds%endp,1:nvegcpool)) - - ! Calculate Agm_c*Kgm_c using SPMM_AK. - call AKgmvegc%SPMM_AK(num_soilp,filter_soilp,Kvegc) - - - - ! Set up sparse matrix Afi_c from non-diagonal entires Aficoned, diagonal entries are all set to -1. - ! Note that AKfivegc here only represent A matrix instead of A * K - - if(ncfitrans .gt. ncfiouttrans)then - AI_fic = receiver_fic(1:ncfitrans-ncfiouttrans) - AJ_fic = doner_fic (1:ncfitrans-ncfiouttrans) - call AKfivegc%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Aficoned,& - AI_fic,AJ_fic,ncfitrans-ncfiouttrans,init_ready_afic,list_afic,RI_fic,CI_fic) - if(use_c14)then - associate( & - AKfivegc14 => c14_cnveg_carbonflux_inst%AKfivegc , & ! Afi*Kfi for C14 cycle in sparse matrix format - RI_fic14 => c14_cnveg_carbonflux_inst%RI_fic , & ! Row indices of non-diagonal entires in Afi for C cycle - CI_fic14 => c14_cnveg_carbonflux_inst%CI_fic , & ! Column indices of non-diagonal entries in Afi for C cycle - list_afic14 => c14_cnveg_carbonflux_inst%list_afic & ! Indices of non-diagnoal entries in full sparse matrix Afi for C cycle - ) - AI_fic14 = receiver_fic(1:ncfitrans-ncfiouttrans) - AJ_fic14 = doner_fic (1:ncfitrans-ncfiouttrans) - call AKfivegc14%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Afic14oned,& - AI_fic14,AJ_fic14,ncfitrans-ncfiouttrans,init_ready_afic14,list_afic14,RI_fic14,CI_fic14) - end associate - end if - else - call AKfivegc%SetValueA_diag(num_soilp,filter_soilp,-1._r8) - if(use_c14)then - associate( & - AKfivegc14 => c14_cnveg_carbonflux_inst%AKfivegc & ! Afi*Kfi for C14 cycle in sparse matrix format - ) - call AKfivegc14%SetValueA_diag(num_soilp,filter_soilp,-1._r8) - end associate - end if - end if - - ! Set up diagonal matrix Kfi_c from diagonal entries matrix_fiturnover - call Kvegc%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_fiturnover(bounds%begp:bounds%endp,1:nvegcpool)) - - ! Calculate Afi_c*Kfi_c using SPMM_AK. - call AKfivegc%SPMM_AK(num_soilp,filter_soilp,Kvegc) - - if(use_c14)then - associate( & - AKfivegc14 => c14_cnveg_carbonflux_inst%AKfivegc , & ! Afi*Kfi for C14 cycle in sparse matrix format - matrix_c14fitransfer => c14_cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in (CNFireBaseMod or CNFireLi2014Mod) and CNC14decayMod - matrix_c14fiturnover => c14_cnveg_carbonflux_inst%matrix_fiturnover_patch & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods - ) - ! Set up diagonal matrix Kfi_c from diagonal entries matrix_fiturnover - call Kvegc%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_c14fiturnover(bounds%begp:bounds%endp,1:nvegcpool)) - - ! Calculate Afi_c*Kfi_c using SPMM_AK. - call AKfivegc14%SPMM_AK(num_soilp,filter_soilp,Kvegc) - end associate - end if - - ! Caclulate AKallvegc = Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c - ! When no fire, Afi_c*Kfi_c = 0, AKallvegc = Aph_c*Kph_c + Agm_c*Kgm_c - ! When fire is on, AKallvegc = Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c - - if(num_actfirep .eq. 0 .and. nthreads < 2)then - call AKallvegc%SPMP_AB(num_soilp,filter_soilp,AKphvegc,AKgmvegc,list_ready_phgmc,list_A=list_phc_phgm,list_B=list_gmc_phgm,& - NE_AB=NE_AKallvegc,RI_AB=RI_AKallvegc,CI_AB=CI_AKallvegc) - else - call AKallvegc%SPMP_ABC(num_soilp,filter_soilp,AKphvegc,AKgmvegc,AKfivegc,list_ready_phgmfic,list_A=list_phc_phgmfi,& - list_B=list_gmc_phgmfi,list_C=list_fic_phgmfi,NE_ABC=NE_AKallvegc,RI_ABC=RI_AKallvegc,CI_ABC=CI_AKallvegc,& - use_actunit_list_C=.True.,num_actunit_C=num_actfirep,filter_actunit_C=filter_actfirep) - end if - - if(use_c14)then - associate( & - AKfivegc14 => c14_cnveg_carbonflux_inst%AKfivegc , & ! Afi*Kfi for C14 cycle in sparse matrix format - AKallvegc14 => c14_cnveg_carbonflux_inst%AKallvegc , & ! Aph*Kph + Agm*Kgm + Afi*Kfi for C14 cycle in sparse matrix format - NE_AKallvegc14 => c14_cnveg_carbonflux_inst%NE_AKallvegc , & ! Number of entries in AKallvegc - RI_AKallvegc14 => c14_cnveg_carbonflux_inst%RI_AKallvegc , & ! Row indices in Akallvegc - CI_AKallvegc14 => c14_cnveg_carbonflux_inst%CI_AKallvegc , & ! Column indices in AKallvegc - list_phc14_phgmfi => c14_cnveg_carbonflux_inst%list_phc_phgmfic , & ! The locations of entries in AKphvegc mapped into (AKphvegc+AKgmvegc+AKfivegc) - list_gmc14_phgmfi => c14_cnveg_carbonflux_inst%list_gmc_phgmfic , & ! The locations of entries in AKgmvegc mapped into (AKphvegc+AKgmvegc+AKfivegc) - list_fic14_phgmfi => c14_cnveg_carbonflux_inst%list_fic_phgmfic & ! The locations of entries in AKfivegc mapped into (AKphvegc+AKgmvegc+AKfivegc) - ) - call AKallvegc14%SPMP_ABC(num_soilp,filter_soilp,AKphvegc,AKgmvegc,AKfivegc14,list_ready_phgmfic14,list_A=list_phc14_phgmfi,& - list_B=list_gmc14_phgmfi,list_C=list_fic14_phgmfi,NE_ABC=NE_AKallvegc14,RI_ABC=RI_AKallvegc14,CI_ABC=CI_AKallvegc14) - end associate - end if - - - ! Xvegc_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xvegc_n + Xvegc_n - call Xvegc%SPMM_AX(num_soilp,filter_soilp,AKallvegc) - - ! Xvegc_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xvegc_n + Xvegc_n + B*I - do i = 1,nvegcpool - do fp = 1,num_soilp - p = filter_soilp(fp) - Xvegc%V(p,i) = Xvegc%V(p,i) + vegmatrixc_input%V(p,i) - end do - end do - - - if ( use_c13 ) then - ! Calculate B*I_C13 - do i=1,nvegcpool - do fp = 1,num_soilp - p = filter_soilp(fp) - vegmatrixc13_input%V(p,i) = matrix_alloc(p,i) * matrix_C13input(p) * dt - end do - end do - - ! Xveg13c_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xveg13c_n + Xveg13c_n - call Xveg13c%SPMM_AX(num_soilp,filter_soilp,AKallvegc) - - ! Xveg13c_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xveg13c_n + Xveg13c_n + B*I_C13 - do i=1,nvegcpool - do fp = 1,num_soilp - p = filter_soilp(fp) - Xveg13c%V(p,i) = Xveg13c%V(p,i) + vegmatrixc13_input%V(p,i) - end do - end do - end if - - - if ( use_c14 ) then - associate( & - matrix_C14input => cnveg_carbonflux_inst%matrix_C14input_patch, & ! Input: [real(r8) (:)] (gC/m2/s) C14 input to vegetation, updated in NutrientCompetitionFlexibleCNMod or NutrientCompetitionCLM45defaultMod - AKallvegc14 => c14_cnveg_carbonflux_inst%AKallvegc & ! Aph*Kph + Agm*Kgm + Afi*Kfi for C14 cycle in sparse matrix format - ) - ! Calculate B*I_C14 - do i=1,nvegcpool - do fp = 1,num_soilp - p = filter_soilp(fp) - vegmatrixc14_input%V(p,i) = matrix_alloc(p,i) * matrix_C14input(p) * dt - end do - end do - - ! Xveg14c_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xveg14c_n + Xveg14c_n - call Xveg14c%SPMM_AX(num_soilp,filter_soilp,AKallvegc14) - - ! Xveg14c_n+1 = (Aph_c*Kph_c + Agm_c*Kgm_c + Afi_c*Kfi_c) * Xveg14c_n + Xveg14c_n + B*I_C14 - do i=1,nvegcpool - do fp = 1,num_soilp - p = filter_soilp(fp) - Xveg14c%V(p,i) = Xveg14c%V(p,i) + vegmatrixc14_input%V(p,i) - end do - end do - end associate - end if - - - - ! Calculate B_N*I_N - do i=1,nvegnpool - do fp = 1,num_soilp - p = filter_soilp(fp) - vegmatrixn_input%V(p,i) = matrix_nalloc(p,i) * matrix_Ninput(p) * dt - end do - end do - - - ! Set up sparse matrix Aph_n from non-diagonal entires Aficoned, diagonal entries are all set to -1. - ! Note that AKphvegn here only represent A matrix instead of A * K - - if(nnphtrans .gt. nnphouttrans)then - AI_phn = receiver_phn(1:nnphtrans-nnphouttrans) - AJ_phn = doner_phn (1:nnphtrans-nnphouttrans) - call AKphvegn%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Aphnoned,& - AI_phn,AJ_phn,nnphtrans-nnphouttrans,init_ready_aphn,list_aphn,RI_phn,CI_phn) - else - call AKphvegn%SetValueA_diag(num_soilp,filter_soilp,-1._r8) - end if - - ! Set up diagonal matrix Kph_n from diagonal entries matrix_nphturnover - call Kvegn%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_nphturnover(bounds%begp:bounds%endp,1:nvegnpool)) - - ! Calculate Aph_n*Kph_n using SPMM_AK. - call AKphvegn%SPMM_AK(num_soilp,filter_soilp,Kvegn) - - - ! Set up sparse matrix Agm_n from non-diagonal entires Aficoned, diagonal entries are all set to -1. - ! Note that AKgmvegn here only represent A matrix instead of A * K - - if(nngmtrans .gt. nngmouttrans)then - AI_gmn = receiver_gmn(1:nngmtrans-nngmouttrans) - AJ_gmn = doner_gmn (1:nngmtrans-nngmouttrans) - call AKgmvegn%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Agmnoned,& - AI_gmn,AJ_gmn,nngmtrans-nngmouttrans,init_ready_agmn,list_agmn,RI_gmn,CI_gmn) - else - call AKgmvegn%SetValueA_diag(num_soilp,filter_soilp,-1._r8) - end if - - ! Set up diagonal matrix Kgm_n from diagonal entries matrix_ngmturnover - call Kvegn%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_ngmturnover(bounds%begp:bounds%endp,1:nvegnpool)) - - ! Calculate Agm_n*Kgm_n using SPMM_AK. - call AKgmvegn%SPMM_AK(num_soilp,filter_soilp,Kvegn) - - - ! Set up sparse matrix Afi_n from non-diagonal entires Aficoned, diagonal entries are all set to -1. - ! Note that AKfivegn here only represent A matrix instead of A * K - - if(nnfitrans .gt. nnfiouttrans)then - AI_fin = receiver_fin(1:nnfitrans-nnfiouttrans) - AJ_fin = doner_fin (1:nnfitrans-nnfiouttrans) - call AKfivegn%SetValueA(bounds%begp,bounds%endp,num_soilp,filter_soilp,Afinoned,& - AI_fin,AJ_fin,nnfitrans-nnfiouttrans,init_ready_afin,list_afin,RI_fin,CI_fin) - else - call AKfivegn%SetValueA_diag(num_soilp,filter_soilp,-1._r8) - end if - - ! Set up diagonal matrix Kfi_n from diagonal entries matrix_nfiturnover - call Kvegn%SetValueDM(bounds%begp,bounds%endp,num_soilp,filter_soilp,matrix_nfiturnover(bounds%begp:bounds%endp,1:nvegnpool)) - - ! Calculate Afi_n*Kfi_n using SPMM_AK. - call AKfivegn%SPMM_AK(num_soilp,filter_soilp,Kvegn) - - - ! Caclulate AKallvegn = Aph_n*Kph_n + Agm_n*Kgm_n + Afi_n*Kfi_n - ! When no fire, Afi_n*Kfi_n = 0, AKallvegn = Aph_n*Kph_n + Agm_n*Kgm_n - ! When fire is on, AKallvegn = Aph_n*Kph_n + Agm_n*Kgm_n + Afi_n*Kfi_n - - if(num_actfirep .eq. 0 .and. nthreads < 2)then - call AKallvegn%SPMP_AB(num_soilp,filter_soilp,AKphvegn,AKgmvegn,list_ready_phgmn,list_A=list_phn_phgm,list_B=list_gmn_phgm,& - NE_AB=NE_AKallvegn,RI_AB=RI_AKallvegn,CI_AB=CI_AKallvegn) - else - call AKallvegn%SPMP_ABC(num_soilp,filter_soilp,AKphvegn,AKgmvegn,AKfivegn,list_ready_phgmfin,list_A=list_phn_phgmfi,& - list_B=list_gmn_phgmfi,list_C=list_fin_phgmfi,NE_ABC=NE_AKallvegn,RI_ABC=RI_AKallvegn,CI_ABC=CI_AKallvegn,& - use_actunit_list_C=.True.,num_actunit_C=num_actfirep,filter_actunit_C=filter_actfirep) - end if - - ! Xvegn_n+1 = (Aph_n*Kph_n + Agm_n*Kgm_n + Afi_n*Kfi_n) * Xvegc_n + Xvegc_n - call Xvegn%SPMM_AX(num_soilp,filter_soilp,AKallvegn) - - ! Xvegn_n+1 = (Aph_n*Kph_n + Agm_n*Kgm_n + Afi_n*Kfi_n) * Xvegc_n + Xvegc_n + B_N*I_N - do i=1,nvegnpool - do fp = 1,num_soilp - p = filter_soilp(fp) - Xvegn%V(p,i) = Xvegn%V(p,i) + vegmatrixn_input%V(p,i) - end do - end do - - call t_stopf('CN veg matrix-matrix multi.') - - - ! Accumulate transfers during the whole calendar year - - call t_startf('CN veg matrix-accum. trans.') - if(isspinup .or. is_outmatrix)then - do fp = 1,num_soilp - p = filter_soilp(fp) - matrix_calloc_leaf_acc(p) = matrix_calloc_leaf_acc(p) + vegmatrixc_input%V(p,ileaf) - matrix_calloc_leafst_acc(p) = matrix_calloc_leafst_acc(p) + vegmatrixc_input%V(p,ileaf_st) - matrix_calloc_froot_acc(p) = matrix_calloc_froot_acc(p) + vegmatrixc_input%V(p,ifroot) - matrix_calloc_frootst_acc(p) = matrix_calloc_frootst_acc(p) + vegmatrixc_input%V(p,ifroot_st) - matrix_calloc_livestem_acc(p) = matrix_calloc_livestem_acc(p) + vegmatrixc_input%V(p,ilivestem) - matrix_calloc_livestemst_acc(p) = matrix_calloc_livestemst_acc(p) + vegmatrixc_input%V(p,ilivestem_st) - matrix_calloc_deadstem_acc(p) = matrix_calloc_deadstem_acc(p) + vegmatrixc_input%V(p,ideadstem) - matrix_calloc_deadstemst_acc(p) = matrix_calloc_deadstemst_acc(p) + vegmatrixc_input%V(p,ideadstem_st) - matrix_calloc_livecroot_acc(p) = matrix_calloc_livecroot_acc(p) + vegmatrixc_input%V(p,ilivecroot) - matrix_calloc_livecrootst_acc(p) = matrix_calloc_livecrootst_acc(p) + vegmatrixc_input%V(p,ilivecroot_st) - matrix_calloc_deadcroot_acc(p) = matrix_calloc_deadcroot_acc(p) + vegmatrixc_input%V(p,ideadcroot) - matrix_calloc_deadcrootst_acc(p) = matrix_calloc_deadcrootst_acc(p) + vegmatrixc_input%V(p,ideadcroot_st) - if(use_c13)then - cs13_veg%matrix_calloc_leaf_acc_patch(p) = cs13_veg%matrix_calloc_leaf_acc_patch(p) + vegmatrixc13_input%V(p,ileaf) - cs13_veg%matrix_calloc_leafst_acc_patch(p) = cs13_veg%matrix_calloc_leafst_acc_patch(p) + vegmatrixc13_input%V(p,ileaf_st) - cs13_veg%matrix_calloc_froot_acc_patch(p) = cs13_veg%matrix_calloc_froot_acc_patch(p) + vegmatrixc13_input%V(p,ifroot) - cs13_veg%matrix_calloc_frootst_acc_patch(p) = cs13_veg%matrix_calloc_frootst_acc_patch(p) + vegmatrixc13_input%V(p,ifroot_st) - cs13_veg%matrix_calloc_livestem_acc_patch(p) = cs13_veg%matrix_calloc_livestem_acc_patch(p) + vegmatrixc13_input%V(p,ilivestem) - cs13_veg%matrix_calloc_livestemst_acc_patch(p) = cs13_veg%matrix_calloc_livestemst_acc_patch(p) + vegmatrixc13_input%V(p,ilivestem_st) - cs13_veg%matrix_calloc_deadstem_acc_patch(p) = cs13_veg%matrix_calloc_deadstem_acc_patch(p) + vegmatrixc13_input%V(p,ideadstem) - cs13_veg%matrix_calloc_deadstemst_acc_patch(p) = cs13_veg%matrix_calloc_deadstemst_acc_patch(p) + vegmatrixc13_input%V(p,ideadstem_st) - cs13_veg%matrix_calloc_livecroot_acc_patch(p) = cs13_veg%matrix_calloc_livecroot_acc_patch(p) + vegmatrixc13_input%V(p,ilivecroot) - cs13_veg%matrix_calloc_livecrootst_acc_patch(p) = cs13_veg%matrix_calloc_livecrootst_acc_patch(p) + vegmatrixc13_input%V(p,ilivecroot_st) - cs13_veg%matrix_calloc_deadcroot_acc_patch(p) = cs13_veg%matrix_calloc_deadcroot_acc_patch(p) + vegmatrixc13_input%V(p,ideadcroot) - cs13_veg%matrix_calloc_deadcrootst_acc_patch(p) = cs13_veg%matrix_calloc_deadcrootst_acc_patch(p) + vegmatrixc13_input%V(p,ideadcroot_st) - end if - if(use_c14)then - cs14_veg%matrix_calloc_leaf_acc_patch(p) = cs14_veg%matrix_calloc_leaf_acc_patch(p) + vegmatrixc14_input%V(p,ileaf) - cs14_veg%matrix_calloc_leafst_acc_patch(p) = cs14_veg%matrix_calloc_leafst_acc_patch(p) + vegmatrixc14_input%V(p,ileaf_st) - cs14_veg%matrix_calloc_froot_acc_patch(p) = cs14_veg%matrix_calloc_froot_acc_patch(p) + vegmatrixc14_input%V(p,ifroot) - cs14_veg%matrix_calloc_frootst_acc_patch(p) = cs14_veg%matrix_calloc_frootst_acc_patch(p) + vegmatrixc14_input%V(p,ifroot_st) - cs14_veg%matrix_calloc_livestem_acc_patch(p) = cs14_veg%matrix_calloc_livestem_acc_patch(p) + vegmatrixc14_input%V(p,ilivestem) - cs14_veg%matrix_calloc_livestemst_acc_patch(p) = cs14_veg%matrix_calloc_livestemst_acc_patch(p) + vegmatrixc14_input%V(p,ilivestem_st) - cs14_veg%matrix_calloc_deadstem_acc_patch(p) = cs14_veg%matrix_calloc_deadstem_acc_patch(p) + vegmatrixc14_input%V(p,ideadstem) - cs14_veg%matrix_calloc_deadstemst_acc_patch(p) = cs14_veg%matrix_calloc_deadstemst_acc_patch(p) + vegmatrixc14_input%V(p,ideadstem_st) - cs14_veg%matrix_calloc_livecroot_acc_patch(p) = cs14_veg%matrix_calloc_livecroot_acc_patch(p) + vegmatrixc14_input%V(p,ilivecroot) - cs14_veg%matrix_calloc_livecrootst_acc_patch(p) = cs14_veg%matrix_calloc_livecrootst_acc_patch(p) + vegmatrixc14_input%V(p,ilivecroot_st) - cs14_veg%matrix_calloc_deadcroot_acc_patch(p) = cs14_veg%matrix_calloc_deadcroot_acc_patch(p) + vegmatrixc14_input%V(p,ideadcroot) - cs14_veg%matrix_calloc_deadcrootst_acc_patch(p) = cs14_veg%matrix_calloc_deadcrootst_acc_patch(p) + vegmatrixc14_input%V(p,ideadcroot_st) - end if - end do - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - matrix_calloc_grain_acc(p) = matrix_calloc_grain_acc(p) + vegmatrixc_input%V(p,igrain) - matrix_calloc_grainst_acc(p) = matrix_calloc_grainst_acc(p) + vegmatrixc_input%V(p,igrain_st) - if(use_c13)then - cs13_veg%matrix_calloc_grain_acc_patch(p) = cs13_veg%matrix_calloc_grain_acc_patch(p) + vegmatrixc13_input%V(p,igrain) - cs13_veg%matrix_calloc_grainst_acc_patch(p) = cs13_veg%matrix_calloc_grainst_acc_patch(p) + vegmatrixc13_input%V(p,igrain_st) - end if - if(use_c14)then - cs14_veg%matrix_calloc_grain_acc_patch(p) = cs14_veg%matrix_calloc_grain_acc_patch(p) + vegmatrixc14_input%V(p,igrain) - cs14_veg%matrix_calloc_grainst_acc_patch(p) = cs14_veg%matrix_calloc_grainst_acc_patch(p) + vegmatrixc14_input%V(p,igrain_st) - end if - end if - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - matrix_ctransfer_leafst_to_leafxf_acc(p) = matrix_ctransfer_leafst_to_leafxf_acc(p) & - + matrix_phtransfer(p,ileafst_to_ileafxf_phc) & - * dt * leafc_storage(p) !matrix_phturnover(p,ileaf_st)*leafc_storage(p) - matrix_ctransfer_leafxf_to_leaf_acc(p) = matrix_ctransfer_leafxf_to_leaf_acc(p) & - + matrix_phtransfer(p,ileafxf_to_ileaf_phc) & - * dt * leafc_xfer(p)!matrix_phturnover(p,ileaf_xf)*leafc_xfer(p) - matrix_ctransfer_frootst_to_frootxf_acc(p) = matrix_ctransfer_frootst_to_frootxf_acc(p) & - + matrix_phtransfer(p,ifrootst_to_ifrootxf_phc) & - * dt * frootc_storage(p)!matrix_phturnover(p,ifroot_st)*frootc_storage(p) - matrix_ctransfer_frootxf_to_froot_acc(p) = matrix_ctransfer_frootxf_to_froot_acc(p) & - + matrix_phtransfer(p,ifrootxf_to_ifroot_phc) & - * dt * frootc_xfer(p)!matrix_phturnover(p,ifroot_xf)*frootc_xfer(p) - matrix_ctransfer_livestemst_to_livestemxf_acc(p) = matrix_ctransfer_livestemst_to_livestemxf_acc(p) & - + matrix_phtransfer(p,ilivestemst_to_ilivestemxf_phc) & - * dt * livestemc_storage(p)!matrix_phturnover(p,ilivestem_st)*livestemc_storage(p) - matrix_ctransfer_livestemxf_to_livestem_acc(p) = matrix_ctransfer_livestemxf_to_livestem_acc(p) & - + matrix_phtransfer(p,ilivestemxf_to_ilivestem_phc) & - * dt * livestemc_xfer(p)!matrix_phturnover(p,ilivestem_xf)*livestemc_xfer(p) - matrix_ctransfer_deadstemst_to_deadstemxf_acc(p) = matrix_ctransfer_deadstemst_to_deadstemxf_acc(p) & - + matrix_phtransfer(p,ideadstemst_to_ideadstemxf_phc) & - * dt * deadstemc_storage(p)!matrix_phturnover(p,ideadstem_st)*deadstemc_storage(p) - matrix_ctransfer_deadstemxf_to_deadstem_acc(p) = matrix_ctransfer_deadstemxf_to_deadstem_acc(p) & - + matrix_phtransfer(p,ideadstemxf_to_ideadstem_phc) & - * dt * deadstemc_xfer(p)!matrix_phturnover(p,ideadstem_xf)*deadstemc_xfer(p) - matrix_ctransfer_livecrootst_to_livecrootxf_acc(p) = matrix_ctransfer_livecrootst_to_livecrootxf_acc(p) & - + matrix_phtransfer(p,ilivecrootst_to_ilivecrootxf_phc) & - * dt * livecrootc_storage(p)!matrix_phturnover(p,ilivecroot_st)*livecrootc_storage(p) - matrix_ctransfer_livecrootxf_to_livecroot_acc(p) = matrix_ctransfer_livecrootxf_to_livecroot_acc(p) & - + matrix_phtransfer(p,ilivecrootxf_to_ilivecroot_phc) & - * dt * livecrootc_xfer(p)!matrix_phturnover(p,ilivecroot_xf)*livecrootc_xfer(p) - matrix_ctransfer_deadcrootst_to_deadcrootxf_acc(p) = matrix_ctransfer_deadcrootst_to_deadcrootxf_acc(p) & - + matrix_phtransfer(p,ideadcrootst_to_ideadcrootxf_phc) & - * dt * deadcrootc_storage(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_storage(p) - matrix_ctransfer_deadcrootxf_to_deadcroot_acc(p) = matrix_ctransfer_deadcrootxf_to_deadcroot_acc(p) & - + matrix_phtransfer(p,ideadcrootxf_to_ideadcroot_phc) & - * dt * deadcrootc_xfer(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_xfer(p) - matrix_ctransfer_livestem_to_deadstem_acc(p) = matrix_ctransfer_livestem_to_deadstem_acc(p) & - +(matrix_phtransfer(p,ilivestem_to_ideadstem_phc)&!matrix_phturnover(p,ilivestem) & - + matrix_fitransfer(p,ilivestem_to_ideadstem_fic))&!matrix_fiturnover(p,ilivestem))& - * dt * livestemc(p) - matrix_ctransfer_livecroot_to_deadcroot_acc(p) = matrix_ctransfer_livecroot_to_deadcroot_acc(p) & - +(matrix_phtransfer(p,ilivecroot_to_ideadcroot_phc)&!*matrix_phturnover(p,ilivecroot) & - + matrix_fitransfer(p,ilivecroot_to_ideadcroot_fic))&!*matrix_fiturnover(p,ilivecroot))& - * dt * livecrootc(p) - matrix_cturnover_leaf_acc(p) = matrix_cturnover_leaf_acc(p) & - + (matrix_phturnover(p,ileaf)+matrix_gmturnover(p,ileaf)+matrix_fiturnover(p,ileaf)) & - * leafc(p) - matrix_cturnover_leafst_acc(p) = matrix_cturnover_leafst_acc(p) & - + (matrix_phturnover(p,ileaf_st)+matrix_gmturnover(p,ileaf_st)+matrix_fiturnover(p,ileaf_st)) & - * leafc_storage(p) - matrix_cturnover_leafxf_acc(p) = matrix_cturnover_leafxf_acc(p) & - + (matrix_phturnover(p,ileaf_xf)+matrix_gmturnover(p,ileaf_xf)+matrix_fiturnover(p,ileaf_xf)) & - * leafc_xfer(p) - matrix_cturnover_froot_acc(p) = matrix_cturnover_froot_acc(p) & - + (matrix_phturnover(p,ifroot)+matrix_gmturnover(p,ifroot)+matrix_fiturnover(p,ifroot)) & - * frootc(p) - matrix_cturnover_frootst_acc(p) = matrix_cturnover_frootst_acc(p) & - + (matrix_phturnover(p,ifroot_st)+matrix_gmturnover(p,ifroot_st)+matrix_fiturnover(p,ifroot_st)) & - * frootc_storage(p) - matrix_cturnover_frootxf_acc(p) = matrix_cturnover_frootxf_acc(p) & - + (matrix_phturnover(p,ifroot_xf)+matrix_gmturnover(p,ifroot_xf)+matrix_fiturnover(p,ifroot_xf)) & - * frootc_xfer(p) - matrix_cturnover_livestem_acc(p) = matrix_cturnover_livestem_acc(p) & - + (matrix_phturnover(p,ilivestem)+matrix_gmturnover(p,ilivestem)+matrix_fiturnover(p,ilivestem)) & - * livestemc(p) - matrix_cturnover_livestemst_acc(p) = matrix_cturnover_livestemst_acc(p) & - + (matrix_phturnover(p,ilivestem_st)+matrix_gmturnover(p,ilivestem_st)+matrix_fiturnover(p,ilivestem_st)) & - * livestemc_storage(p) - matrix_cturnover_livestemxf_acc(p) = matrix_cturnover_livestemxf_acc(p) & - + (matrix_phturnover(p,ilivestem_xf)+matrix_gmturnover(p,ilivestem_xf)+matrix_fiturnover(p,ilivestem_xf)) & - * livestemc_xfer(p) - matrix_cturnover_deadstem_acc(p) = matrix_cturnover_deadstem_acc(p) & - + (matrix_phturnover(p,ideadstem)+matrix_gmturnover(p,ideadstem)+matrix_fiturnover(p,ideadstem)) & - * deadstemc(p) - matrix_cturnover_deadstemst_acc(p) = matrix_cturnover_deadstemst_acc(p) & - + (matrix_phturnover(p,ideadstem_st)+matrix_gmturnover(p,ideadstem_st)+matrix_fiturnover(p,ideadstem_st)) & - * deadstemc_storage(p) - matrix_cturnover_deadstemxf_acc(p) = matrix_cturnover_deadstemxf_acc(p) & - + (matrix_phturnover(p,ideadstem_xf)+matrix_gmturnover(p,ideadstem_xf)+matrix_fiturnover(p,ideadstem_xf)) & - * deadstemc_xfer(p) - matrix_cturnover_livecroot_acc(p) = matrix_cturnover_livecroot_acc(p) & - + (matrix_phturnover(p,ilivecroot)+matrix_gmturnover(p,ilivecroot)+matrix_fiturnover(p,ilivecroot)) & - * livecrootc(p) - matrix_cturnover_livecrootst_acc(p) = matrix_cturnover_livecrootst_acc(p) & - + (matrix_phturnover(p,ilivecroot_st)+matrix_gmturnover(p,ilivecroot_st)+matrix_fiturnover(p,ilivecroot_st)) & - * livecrootc_storage(p) - matrix_cturnover_livecrootxf_acc(p) = matrix_cturnover_livecrootxf_acc(p) & - + (matrix_phturnover(p,ilivecroot_xf)+matrix_gmturnover(p,ilivecroot_xf)+matrix_fiturnover(p,ilivecroot_xf)) & - * livecrootc_xfer(p) - matrix_cturnover_deadcroot_acc(p) = matrix_cturnover_deadcroot_acc(p) & - + (matrix_phturnover(p,ideadcroot)+matrix_gmturnover(p,ideadcroot)+matrix_fiturnover(p,ideadcroot)) & - * deadcrootc(p) - matrix_cturnover_deadcrootst_acc(p) = matrix_cturnover_deadcrootst_acc(p) & - + (matrix_phturnover(p,ideadcroot_st)+matrix_gmturnover(p,ideadcroot_st)+matrix_fiturnover(p,ideadcroot_st)) & - * deadcrootc_storage(p) - matrix_cturnover_deadcrootxf_acc(p) = matrix_cturnover_deadcrootxf_acc(p) & - + (matrix_phturnover(p,ideadcroot_xf)+matrix_gmturnover(p,ideadcroot_xf)+matrix_fiturnover(p,ideadcroot_xf)) & - * deadcrootc_xfer(p) - if(use_c13)then - cs13_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) = cs13_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) & - + matrix_phtransfer(p,ileafst_to_ileafxf_phc) & - * dt * cs13_veg%leafc_storage_patch(p) !matrix_phturnover(p,ileaf_st)*leafc_storage(p) - cs13_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) = cs13_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) & - + matrix_phtransfer(p,ileafxf_to_ileaf_phc) & - * dt * cs13_veg%leafc_xfer_patch(p)!matrix_phturnover(p,ileaf_xf)*leafc_xfer(p) - cs13_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) = cs13_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) & - + matrix_phtransfer(p,ifrootst_to_ifrootxf_phc) & - * dt * cs13_veg%frootc_storage_patch(p)!matrix_phturnover(p,ifroot_st)*frootc_storage(p) - cs13_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) = cs13_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) & - + matrix_phtransfer(p,ifrootxf_to_ifroot_phc) & - * dt * cs13_veg%frootc_xfer_patch(p)!matrix_phturnover(p,ifroot_xf)*frootc_xfer(p) - cs13_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) = cs13_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) & - + matrix_phtransfer(p,ilivestemst_to_ilivestemxf_phc) & - * dt * cs13_veg%livestemc_storage_patch(p)!matrix_phturnover(p,ilivestem_st)*livestemc_storage(p) - cs13_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) = cs13_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) & - + matrix_phtransfer(p,ilivestemxf_to_ilivestem_phc) & - * dt * cs13_veg%livestemc_xfer_patch(p)!matrix_phturnover(p,ilivestem_xf)*livestemc_xfer(p) - cs13_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) = cs13_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) & - + matrix_phtransfer(p,ideadstemst_to_ideadstemxf_phc) & - * dt * cs13_veg%deadstemc_storage_patch(p)!matrix_phturnover(p,ideadstem_st)*deadstemc_storage(p) - cs13_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) = cs13_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) & - + matrix_phtransfer(p,ideadstemxf_to_ideadstem_phc) & - * dt * cs13_veg%deadstemc_xfer_patch(p)!matrix_phturnover(p,ideadstem_xf)*deadstemc_xfer(p) - cs13_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) = cs13_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) & - + matrix_phtransfer(p,ilivecrootst_to_ilivecrootxf_phc) & - * dt * cs13_veg%livecrootc_storage_patch(p)!matrix_phturnover(p,ilivecroot_st)*livecrootc_storage(p) - cs13_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) = cs13_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) & - + matrix_phtransfer(p,ilivecrootxf_to_ilivecroot_phc) & - * dt * cs13_veg%livecrootc_xfer_patch(p)!matrix_phturnover(p,ilivecroot_xf)*livecrootc_xfer(p) - cs13_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) = cs13_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) & - + matrix_phtransfer(p,ideadcrootst_to_ideadcrootxf_phc) & - * dt * cs13_veg%deadcrootc_storage_patch(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_storage(p) - cs13_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) = cs13_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) & - + matrix_phtransfer(p,ideadcrootxf_to_ideadcroot_phc) & - * dt * cs13_veg%deadcrootc_xfer_patch(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_xfer(p) - cs13_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) = cs13_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) & - +(matrix_phtransfer(p,ilivestem_to_ideadstem_phc)&!matrix_phturnover(p,ilivestem) & - + matrix_fitransfer(p,ilivestem_to_ideadstem_fic))&!matrix_fiturnover(p,ilivestem))& - * dt * cs13_veg%livestemc_patch(p) - cs13_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) = cs13_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) & - +(matrix_phtransfer(p,ilivecroot_to_ideadcroot_phc)&!*matrix_phturnover(p,ilivecroot) & - + matrix_fitransfer(p,ilivecroot_to_ideadcroot_fic))&!*matrix_fiturnover(p,ilivecroot))& - * dt * cs13_veg%livecrootc_patch(p) - cs13_veg%matrix_cturnover_leaf_acc_patch(p) = cs13_veg%matrix_cturnover_leaf_acc_patch(p) & - + (matrix_phturnover(p,ileaf)+matrix_gmturnover(p,ileaf)+matrix_fiturnover(p,ileaf)) & - * cs13_veg%leafc_patch(p) - cs13_veg%matrix_cturnover_leafst_acc_patch(p) = cs13_veg%matrix_cturnover_leafst_acc_patch(p) & - + (matrix_phturnover(p,ileaf_st)+matrix_gmturnover(p,ileaf_st)+matrix_fiturnover(p,ileaf_st)) & - * cs13_veg%leafc_storage_patch(p) - cs13_veg%matrix_cturnover_leafxf_acc_patch(p) = cs13_veg%matrix_cturnover_leafxf_acc_patch(p) & - + (matrix_phturnover(p,ileaf_xf)+matrix_gmturnover(p,ileaf_xf)+matrix_fiturnover(p,ileaf_xf)) & - * cs13_veg%leafc_xfer_patch(p) - cs13_veg%matrix_cturnover_froot_acc_patch(p) = cs13_veg%matrix_cturnover_froot_acc_patch(p) & - + (matrix_phturnover(p,ifroot)+matrix_gmturnover(p,ifroot)+matrix_fiturnover(p,ifroot)) & - * cs13_veg%frootc_patch(p) - cs13_veg%matrix_cturnover_frootst_acc_patch(p) = cs13_veg%matrix_cturnover_frootst_acc_patch(p) & - + (matrix_phturnover(p,ifroot_st)+matrix_gmturnover(p,ifroot_st)+matrix_fiturnover(p,ifroot_st)) & - * cs13_veg%frootc_storage_patch(p) - cs13_veg%matrix_cturnover_frootxf_acc_patch(p) = cs13_veg%matrix_cturnover_frootxf_acc_patch(p) & - + (matrix_phturnover(p,ifroot_xf)+matrix_gmturnover(p,ifroot_xf)+matrix_fiturnover(p,ifroot_xf)) & - * cs13_veg%frootc_xfer_patch(p) - cs13_veg%matrix_cturnover_livestem_acc_patch(p) = cs13_veg%matrix_cturnover_livestem_acc_patch(p) & - + (matrix_phturnover(p,ilivestem)+matrix_gmturnover(p,ilivestem)+matrix_fiturnover(p,ilivestem)) & - * cs13_veg%livestemc_patch(p) - cs13_veg%matrix_cturnover_livestemst_acc_patch(p) = cs13_veg%matrix_cturnover_livestemst_acc_patch(p) & - + (matrix_phturnover(p,ilivestem_st)+matrix_gmturnover(p,ilivestem_st)+matrix_fiturnover(p,ilivestem_st)) & - * cs13_veg%livestemc_storage_patch(p) - cs13_veg%matrix_cturnover_livestemxf_acc_patch(p) = cs13_veg%matrix_cturnover_livestemxf_acc_patch(p) & - + (matrix_phturnover(p,ilivestem_xf)+matrix_gmturnover(p,ilivestem_xf)+matrix_fiturnover(p,ilivestem_xf)) & - * cs13_veg%livestemc_xfer_patch(p) - cs13_veg%matrix_cturnover_deadstem_acc_patch(p) = cs13_veg%matrix_cturnover_deadstem_acc_patch(p) & - + (matrix_phturnover(p,ideadstem)+matrix_gmturnover(p,ideadstem)+matrix_fiturnover(p,ideadstem)) & - * cs13_veg%deadstemc_patch(p) - cs13_veg%matrix_cturnover_deadstemst_acc_patch(p) = cs13_veg%matrix_cturnover_deadstemst_acc_patch(p) & - + (matrix_phturnover(p,ideadstem_st)+matrix_gmturnover(p,ideadstem_st)+matrix_fiturnover(p,ideadstem_st)) & - * cs13_veg%deadstemc_storage_patch(p) - cs13_veg%matrix_cturnover_deadstemxf_acc_patch(p) = cs13_veg%matrix_cturnover_deadstemxf_acc_patch(p) & - + (matrix_phturnover(p,ideadstem_xf)+matrix_gmturnover(p,ideadstem_xf)+matrix_fiturnover(p,ideadstem_xf)) & - * cs13_veg%deadstemc_xfer_patch(p) - cs13_veg%matrix_cturnover_livecroot_acc_patch(p) = cs13_veg%matrix_cturnover_livecroot_acc_patch(p) & - + (matrix_phturnover(p,ilivecroot)+matrix_gmturnover(p,ilivecroot)+matrix_fiturnover(p,ilivecroot)) & - * cs13_veg%livecrootc_patch(p) - cs13_veg%matrix_cturnover_livecrootst_acc_patch(p) = cs13_veg%matrix_cturnover_livecrootst_acc_patch(p) & - + (matrix_phturnover(p,ilivecroot_st)+matrix_gmturnover(p,ilivecroot_st)+matrix_fiturnover(p,ilivecroot_st)) & - * cs13_veg%livecrootc_storage_patch(p) - cs13_veg%matrix_cturnover_livecrootxf_acc_patch(p) = cs13_veg%matrix_cturnover_livecrootxf_acc_patch(p) & - + (matrix_phturnover(p,ilivecroot_xf)+matrix_gmturnover(p,ilivecroot_xf)+matrix_fiturnover(p,ilivecroot_xf)) & - * cs13_veg%livecrootc_xfer_patch(p) - cs13_veg%matrix_cturnover_deadcroot_acc_patch(p) = cs13_veg%matrix_cturnover_deadcroot_acc_patch(p) & - + (matrix_phturnover(p,ideadcroot)+matrix_gmturnover(p,ideadcroot)+matrix_fiturnover(p,ideadcroot)) & - * cs13_veg%deadcrootc_patch(p) - cs13_veg%matrix_cturnover_deadcrootst_acc_patch(p) = cs13_veg%matrix_cturnover_deadcrootst_acc_patch(p) & - + (matrix_phturnover(p,ideadcroot_st)+matrix_gmturnover(p,ideadcroot_st)+matrix_fiturnover(p,ideadcroot_st)) & - * cs13_veg%deadcrootc_storage_patch(p) - cs13_veg%matrix_cturnover_deadcrootxf_acc_patch(p) = cs13_veg%matrix_cturnover_deadcrootxf_acc_patch(p) & - + (matrix_phturnover(p,ideadcroot_xf)+matrix_gmturnover(p,ideadcroot_xf)+matrix_fiturnover(p,ideadcroot_xf)) & - * cs13_veg%deadcrootc_xfer_patch(p) - end if - if(use_c14)then - associate( & - matrix_c14fitransfer => c14_cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in (CNFireBaseMod or CNFireLi2014Mod) and CNC14decayMod - matrix_c14fiturnover => c14_cnveg_carbonflux_inst%matrix_fiturnover_patch & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods - ) - cs14_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) = cs14_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) & - + matrix_phtransfer(p,ileafst_to_ileafxf_phc) & - * dt * cs14_veg%leafc_storage_patch(p) !matrix_phturnover(p,ileaf_st)*leafc_storage(p) - cs14_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) = cs14_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) & - + matrix_phtransfer(p,ileafxf_to_ileaf_phc) & - * dt * cs14_veg%leafc_xfer_patch(p)!matrix_phturnover(p,ileaf_xf)*leafc_xfer(p) - cs14_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) = cs14_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) & - + matrix_phtransfer(p,ifrootst_to_ifrootxf_phc) & - * dt * cs14_veg%frootc_storage_patch(p)!matrix_phturnover(p,ifroot_st)*frootc_storage(p) - cs14_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) = cs14_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) & - + matrix_phtransfer(p,ifrootxf_to_ifroot_phc) & - * dt * cs14_veg%frootc_xfer_patch(p)!matrix_phturnover(p,ifroot_xf)*frootc_xfer(p) - cs14_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) = cs14_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) & - + matrix_phtransfer(p,ilivestemst_to_ilivestemxf_phc) & - * dt * cs14_veg%livestemc_storage_patch(p)!matrix_phturnover(p,ilivestem_st)*livestemc_storage(p) - cs14_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) = cs14_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) & - + matrix_phtransfer(p,ilivestemxf_to_ilivestem_phc) & - * dt * cs14_veg%livestemc_xfer_patch(p)!matrix_phturnover(p,ilivestem_xf)*livestemc_xfer(p) - cs14_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) = cs14_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) & - + matrix_phtransfer(p,ideadstemst_to_ideadstemxf_phc) & - * dt * cs14_veg%deadstemc_storage_patch(p)!matrix_phturnover(p,ideadstem_st)*deadstemc_storage(p) - cs14_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) = cs14_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) & - + matrix_phtransfer(p,ideadstemxf_to_ideadstem_phc) & - * dt * cs14_veg%deadstemc_xfer_patch(p)!matrix_phturnover(p,ideadstem_xf)*deadstemc_xfer(p) - cs14_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) = cs14_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) & - + matrix_phtransfer(p,ilivecrootst_to_ilivecrootxf_phc) & - * dt * cs14_veg%livecrootc_storage_patch(p)!matrix_phturnover(p,ilivecroot_st)*livecrootc_storage(p) - cs14_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) = cs14_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) & - + matrix_phtransfer(p,ilivecrootxf_to_ilivecroot_phc) & - * dt * cs14_veg%livecrootc_xfer_patch(p)!matrix_phturnover(p,ilivecroot_xf)*livecrootc_xfer(p) - cs14_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) = cs14_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) & - + matrix_phtransfer(p,ideadcrootst_to_ideadcrootxf_phc) & - * dt * cs14_veg%deadcrootc_storage_patch(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_storage(p) - cs14_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) = cs14_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) & - + matrix_phtransfer(p,ideadcrootxf_to_ideadcroot_phc) & - * dt * cs14_veg%deadcrootc_xfer_patch(p)!matrix_phturnover(p,ideadcroot_st)*deadcrootc_xfer(p) - cs14_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) = cs14_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) & - +(matrix_phtransfer(p,ilivestem_to_ideadstem_phc)&!matrix_phturnover(p,ilivestem) & - + matrix_c14fitransfer(p,ilivestem_to_ideadstem_fic))&!matrix_fiturnover(p,ilivestem))& - * dt * cs14_veg%livestemc_patch(p) - cs14_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) = cs14_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) & - +(matrix_phtransfer(p,ilivecroot_to_ideadcroot_phc)&!*matrix_phturnover(p,ilivecroot) & - + matrix_c14fitransfer(p,ilivecroot_to_ideadcroot_fic))&!*matrix_fiturnover(p,ilivecroot))& - * dt * cs14_veg%livecrootc_patch(p) - cs14_veg%matrix_cturnover_leaf_acc_patch(p) = cs14_veg%matrix_cturnover_leaf_acc_patch(p) & - + (matrix_phturnover(p,ileaf)+matrix_gmturnover(p,ileaf)+matrix_c14fiturnover(p,ileaf)) & - * cs14_veg%leafc_patch(p) - cs14_veg%matrix_cturnover_leafst_acc_patch(p) = cs14_veg%matrix_cturnover_leafst_acc_patch(p) & - + (matrix_phturnover(p,ileaf_st)+matrix_gmturnover(p,ileaf_st)+matrix_c14fiturnover(p,ileaf_st)) & - * cs14_veg%leafc_storage_patch(p) - cs14_veg%matrix_cturnover_leafxf_acc_patch(p) = cs14_veg%matrix_cturnover_leafxf_acc_patch(p) & - + (matrix_phturnover(p,ileaf_xf)+matrix_gmturnover(p,ileaf_xf)+matrix_c14fiturnover(p,ileaf_xf)) & - * cs14_veg%leafc_xfer_patch(p) - cs14_veg%matrix_cturnover_froot_acc_patch(p) = cs14_veg%matrix_cturnover_froot_acc_patch(p) & - + (matrix_phturnover(p,ifroot)+matrix_gmturnover(p,ifroot)+matrix_c14fiturnover(p,ifroot)) & - * cs14_veg%frootc_patch(p) - cs14_veg%matrix_cturnover_frootst_acc_patch(p) = cs14_veg%matrix_cturnover_frootst_acc_patch(p) & - + (matrix_phturnover(p,ifroot_st)+matrix_gmturnover(p,ifroot_st)+matrix_c14fiturnover(p,ifroot_st)) & - * cs14_veg%frootc_storage_patch(p) - cs14_veg%matrix_cturnover_frootxf_acc_patch(p) = cs14_veg%matrix_cturnover_frootxf_acc_patch(p) & - + (matrix_phturnover(p,ifroot_xf)+matrix_gmturnover(p,ifroot_xf)+matrix_c14fiturnover(p,ifroot_xf)) & - * cs14_veg%frootc_xfer_patch(p) - cs14_veg%matrix_cturnover_livestem_acc_patch(p) = cs14_veg%matrix_cturnover_livestem_acc_patch(p) & - + (matrix_phturnover(p,ilivestem)+matrix_gmturnover(p,ilivestem)+matrix_c14fiturnover(p,ilivestem)) & - * cs14_veg%livestemc_patch(p) - cs14_veg%matrix_cturnover_livestemst_acc_patch(p) = cs14_veg%matrix_cturnover_livestemst_acc_patch(p) & - + (matrix_phturnover(p,ilivestem_st)+matrix_gmturnover(p,ilivestem_st)+matrix_c14fiturnover(p,ilivestem_st)) & - * cs14_veg%livestemc_storage_patch(p) - cs14_veg%matrix_cturnover_livestemxf_acc_patch(p) = cs14_veg%matrix_cturnover_livestemxf_acc_patch(p) & - + (matrix_phturnover(p,ilivestem_xf)+matrix_gmturnover(p,ilivestem_xf)+matrix_c14fiturnover(p,ilivestem_xf)) & - * cs14_veg%livestemc_xfer_patch(p) - cs14_veg%matrix_cturnover_deadstem_acc_patch(p) = cs14_veg%matrix_cturnover_deadstem_acc_patch(p) & - + (matrix_phturnover(p,ideadstem)+matrix_gmturnover(p,ideadstem)+matrix_c14fiturnover(p,ideadstem)) & - * cs14_veg%deadstemc_patch(p) - cs14_veg%matrix_cturnover_deadstemst_acc_patch(p) = cs14_veg%matrix_cturnover_deadstemst_acc_patch(p) & - + (matrix_phturnover(p,ideadstem_st)+matrix_gmturnover(p,ideadstem_st)+matrix_c14fiturnover(p,ideadstem_st)) & - * cs14_veg%deadstemc_storage_patch(p) - cs14_veg%matrix_cturnover_deadstemxf_acc_patch(p) = cs14_veg%matrix_cturnover_deadstemxf_acc_patch(p) & - + (matrix_phturnover(p,ideadstem_xf)+matrix_gmturnover(p,ideadstem_xf)+matrix_c14fiturnover(p,ideadstem_xf)) & - * cs14_veg%deadstemc_xfer_patch(p) - cs14_veg%matrix_cturnover_livecroot_acc_patch(p) = cs14_veg%matrix_cturnover_livecroot_acc_patch(p) & - + (matrix_phturnover(p,ilivecroot)+matrix_gmturnover(p,ilivecroot)+matrix_c14fiturnover(p,ilivecroot)) & - * cs14_veg%livecrootc_patch(p) - cs14_veg%matrix_cturnover_livecrootst_acc_patch(p) = cs14_veg%matrix_cturnover_livecrootst_acc_patch(p) & - + (matrix_phturnover(p,ilivecroot_st)+matrix_gmturnover(p,ilivecroot_st)+matrix_c14fiturnover(p,ilivecroot_st)) & - * cs14_veg%livecrootc_storage_patch(p) - cs14_veg%matrix_cturnover_livecrootxf_acc_patch(p) = cs14_veg%matrix_cturnover_livecrootxf_acc_patch(p) & - + (matrix_phturnover(p,ilivecroot_xf)+matrix_gmturnover(p,ilivecroot_xf)+matrix_c14fiturnover(p,ilivecroot_xf)) & - * cs14_veg%livecrootc_xfer_patch(p) - cs14_veg%matrix_cturnover_deadcroot_acc_patch(p) = cs14_veg%matrix_cturnover_deadcroot_acc_patch(p) & - + (matrix_phturnover(p,ideadcroot)+matrix_gmturnover(p,ideadcroot)+matrix_c14fiturnover(p,ideadcroot)) & - * cs14_veg%deadcrootc_patch(p) - cs14_veg%matrix_cturnover_deadcrootst_acc_patch(p) = cs14_veg%matrix_cturnover_deadcrootst_acc_patch(p) & - + (matrix_phturnover(p,ideadcroot_st)+matrix_gmturnover(p,ideadcroot_st)+matrix_c14fiturnover(p,ideadcroot_st)) & - * cs14_veg%deadcrootc_storage_patch(p) - cs14_veg%matrix_cturnover_deadcrootxf_acc_patch(p) = cs14_veg%matrix_cturnover_deadcrootxf_acc_patch(p) & - + (matrix_phturnover(p,ideadcroot_xf)+matrix_gmturnover(p,ideadcroot_xf)+matrix_c14fiturnover(p,ideadcroot_xf)) & - * cs14_veg%deadcrootc_xfer_patch(p) - end associate - end if - end do - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - matrix_cturnover_grain_acc(p) = matrix_cturnover_grain_acc(p) & - + (matrix_phturnover(p,igrain)+matrix_gmturnover(p,igrain)+matrix_fiturnover(p,igrain)) & - * grainc(p) - matrix_cturnover_grainst_acc(p) = matrix_cturnover_grainst_acc(p) & - + (matrix_phturnover(p,igrain_st)+matrix_gmturnover(p,igrain_st)+matrix_fiturnover(p,igrain_st)) & - * grainc_storage(p) - matrix_cturnover_grainxf_acc(p) = matrix_cturnover_grainxf_acc(p) & - + (matrix_phturnover(p,igrain_xf)+matrix_gmturnover(p,igrain_xf)+matrix_fiturnover(p,igrain_xf)) & - * grainc_xfer(p) - if(use_c13)then - cs13_veg%matrix_cturnover_grain_acc_patch(p) = cs13_veg%matrix_cturnover_grain_acc_patch(p) & - + (matrix_phturnover(p,igrain)+matrix_gmturnover(p,igrain)+matrix_fiturnover(p,igrain)) & - * cs13_veg%grainc_patch(p) - cs13_veg%matrix_cturnover_grainst_acc_patch(p) = cs13_veg%matrix_cturnover_grainst_acc_patch(p) & - + (matrix_phturnover(p,igrain_st)+matrix_gmturnover(p,igrain_st)+matrix_fiturnover(p,igrain_st)) & - * cs13_veg%grainc_storage_patch(p) - cs13_veg%matrix_cturnover_grainxf_acc_patch(p) = cs13_veg%matrix_cturnover_grainxf_acc_patch(p) & - + (matrix_phturnover(p,igrain_xf)+matrix_gmturnover(p,igrain_xf)+matrix_fiturnover(p,igrain_xf)) & - * cs13_veg%grainc_xfer_patch(p) - end if - if(use_c14)then - associate( & - matrix_c14fitransfer => c14_cnveg_carbonflux_inst%matrix_fitransfer_patch , & ! Input: [real(r8) (:,:)] (gC/m2/s) C transfer rate from fire processes, updated in (CNFireBaseMod or CNFireLi2014Mod) and CNC14decayMod - matrix_c14fiturnover => c14_cnveg_carbonflux_inst%matrix_fiturnover_patch & ! Output: [real(r8) (:,:)] (gC/m2/step) C turnover rate from fire processe, updated in CNVegMatrixMods - ) - cs14_veg%matrix_cturnover_grain_acc_patch(p) = cs14_veg%matrix_cturnover_grain_acc_patch(p) & - + (matrix_phturnover(p,igrain)+matrix_gmturnover(p,igrain)+matrix_c14fiturnover(p,igrain)) & - * cs14_veg%grainc_patch(p) - cs14_veg%matrix_cturnover_grainst_acc_patch(p) = cs14_veg%matrix_cturnover_grainst_acc_patch(p) & - + (matrix_phturnover(p,igrain_st)+matrix_gmturnover(p,igrain_st)+matrix_c14fiturnover(p,igrain_st)) & - * cs14_veg%grainc_storage_patch(p) - cs14_veg%matrix_cturnover_grainxf_acc_patch(p) = cs14_veg%matrix_cturnover_grainxf_acc_patch(p) & - + (matrix_phturnover(p,igrain_xf)+matrix_gmturnover(p,igrain_xf)+matrix_c14fiturnover(p,igrain_xf)) & - * cs14_veg%grainc_xfer_patch(p) - end associate - end if - end if - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - matrix_nalloc_leaf_acc(p) = matrix_nalloc_leaf_acc(p) + vegmatrixn_input%V(p,ileaf) - matrix_nalloc_leafst_acc(p) = matrix_nalloc_leafst_acc(p) + vegmatrixn_input%V(p,ileaf_st) - matrix_nalloc_froot_acc(p) = matrix_nalloc_froot_acc(p) + vegmatrixn_input%V(p,ifroot) - matrix_nalloc_frootst_acc(p) = matrix_nalloc_frootst_acc(p) + vegmatrixn_input%V(p,ifroot_st) - matrix_nalloc_livestem_acc(p) = matrix_nalloc_livestem_acc(p) + vegmatrixn_input%V(p,ilivestem) - matrix_nalloc_livestemst_acc(p) = matrix_nalloc_livestemst_acc(p) + vegmatrixn_input%V(p,ilivestem_st) - matrix_nalloc_deadstem_acc(p) = matrix_nalloc_deadstem_acc(p) + vegmatrixn_input%V(p,ideadstem) - matrix_nalloc_deadstemst_acc(p) = matrix_nalloc_deadstemst_acc(p) + vegmatrixn_input%V(p,ideadstem_st) - matrix_nalloc_livecroot_acc(p) = matrix_nalloc_livecroot_acc(p) + vegmatrixn_input%V(p,ilivecroot) - matrix_nalloc_livecrootst_acc(p) = matrix_nalloc_livecrootst_acc(p) + vegmatrixn_input%V(p,ilivecroot_st) - matrix_nalloc_deadcroot_acc(p) = matrix_nalloc_deadcroot_acc(p) + vegmatrixn_input%V(p,ideadcroot) - matrix_nalloc_deadcrootst_acc(p) = matrix_nalloc_deadcrootst_acc(p) + vegmatrixn_input%V(p,ideadcroot_st) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - matrix_nalloc_grain_acc(p) = matrix_nalloc_grain_acc(p) + vegmatrixn_input%V(p,igrain) - matrix_nalloc_grainst_acc(p) = matrix_nalloc_grainst_acc(p) + vegmatrixn_input%V(p,igrain_st) - end if - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - matrix_ntransfer_leafst_to_leafxf_acc(p) = matrix_ntransfer_leafst_to_leafxf_acc(p) & - + matrix_nphtransfer(p,ileafst_to_ileafxf_phn) & - * dt * leafn_storage(p)!matrix_nphturnover(p,ileaf_st)*leafn_storage(p) - matrix_ntransfer_leafxf_to_leaf_acc(p) = matrix_ntransfer_leafxf_to_leaf_acc(p) & - + matrix_nphtransfer(p,ileafxf_to_ileaf_phn) & - * dt * leafn_xfer(p)!matrix_nphturnover(p,ileaf_xf)*leafn_xfer(p) - matrix_ntransfer_frootst_to_frootxf_acc(p) = matrix_ntransfer_frootst_to_frootxf_acc(p) & - + matrix_nphtransfer(p,ifrootst_to_ifrootxf_phn) & - * dt * frootn_storage(p)!matrix_nphturnover(p,ifroot_st)*frootn_storage(p) - matrix_ntransfer_frootxf_to_froot_acc(p) = matrix_ntransfer_frootxf_to_froot_acc(p) & - + matrix_nphtransfer(p,ifrootxf_to_ifroot_phn) & - * dt * frootn_xfer(p)!matrix_nphturnover(p,ifroot_xf)*frootn_xfer(p) - matrix_ntransfer_livestemst_to_livestemxf_acc(p) = matrix_ntransfer_livestemst_to_livestemxf_acc(p) & - + matrix_nphtransfer(p,ilivestemst_to_ilivestemxf_phn) & - * dt * livestemn_storage(p)!matrix_nphturnover(p,ilivestem_st)*livestemn_storage(p) - matrix_ntransfer_livestemxf_to_livestem_acc(p) = matrix_ntransfer_livestemxf_to_livestem_acc(p) & - + matrix_nphtransfer(p,ilivestemxf_to_ilivestem_phn) & - * dt * livestemn_xfer(p)!matrix_nphturnover(p,ilivestem_xf)*livestemn_xfer(p) - matrix_ntransfer_deadstemst_to_deadstemxf_acc(p) = matrix_ntransfer_deadstemst_to_deadstemxf_acc(p) & - + matrix_nphtransfer(p,ideadstemst_to_ideadstemxf_phn) & - * dt * deadstemn_storage(p)!matrix_nphturnover(p,ideadstem_st)*deadstemn_storage(p) - matrix_ntransfer_deadstemxf_to_deadstem_acc(p) = matrix_ntransfer_deadstemxf_to_deadstem_acc(p) & - + matrix_nphtransfer(p,ideadstemxf_to_ideadstem_phn) & - * dt * deadstemn_xfer(p)!matrix_nphturnover(p,ideadstem_xf)*deadstemn_storage(p) - matrix_ntransfer_livecrootst_to_livecrootxf_acc(p) = matrix_ntransfer_livecrootst_to_livecrootxf_acc(p) & - + matrix_nphtransfer(p,ilivecrootst_to_ilivecrootxf_phn) & - * dt * livecrootn_storage(p)!matrix_nphturnover(p,ilivecroot_st)*livecrootn_storage(p) - matrix_ntransfer_livecrootxf_to_livecroot_acc(p) = matrix_ntransfer_livecrootxf_to_livecroot_acc(p) & - + matrix_nphtransfer(p,ilivecrootxf_to_ilivecroot_phn) & - * dt * livecrootn_xfer(p)!matrix_nphturnover(p,ilivecroot_xf)*livecrootn_xfer(p) - matrix_ntransfer_deadcrootst_to_deadcrootxf_acc(p) = matrix_ntransfer_deadcrootst_to_deadcrootxf_acc(p) & - + matrix_nphtransfer(p,ideadcrootst_to_ideadcrootxf_phn) & - * dt * deadcrootn_storage(p)!matrix_nphturnover(p,ideadcroot_st)*deadcrootn_storage(p) - matrix_ntransfer_deadcrootxf_to_deadcroot_acc(p) = matrix_ntransfer_deadcrootxf_to_deadcroot_acc(p) & - + matrix_nphtransfer(p,ideadcrootxf_to_ideadcroot_phn) & - * dt * deadcrootn_xfer(p)!matrix_nphturnover(p,ideadcroot_st)*deadcrootn_xfer(p) - matrix_ntransfer_livestem_to_deadstem_acc(p) = matrix_ntransfer_livestem_to_deadstem_acc(p) & - +(matrix_nphtransfer(p,ilivestem_to_ideadstem_phn) &!*matrix_nphturnover(p,ilivestem) & - + matrix_nfitransfer(p,ilivestem_to_ideadstem_fin)) &!*matrix_nfiturnover(p,ilivestem)) & - * dt * livestemn(p) - matrix_ntransfer_livecroot_to_deadcroot_acc(p) = matrix_ntransfer_livecroot_to_deadcroot_acc(p) & - +(matrix_nphtransfer(p,ilivecroot_to_ideadcroot_phn) &!*matrix_nphturnover(p,ilivecroot) & - + matrix_nfitransfer(p,ilivecroot_to_ideadcroot_fin)) &!*matrix_nfiturnover(p,ilivecroot)) & - * dt * livecrootn(p) - - matrix_ntransfer_retransn_to_leaf_acc(p) = matrix_ntransfer_retransn_to_leaf_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ileaf_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_leafst_acc(p) = matrix_ntransfer_retransn_to_leafst_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ileafst_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_froot_acc(p) = matrix_ntransfer_retransn_to_froot_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ifroot_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_frootst_acc(p) = matrix_ntransfer_retransn_to_frootst_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ifrootst_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_livestem_acc(p) = matrix_ntransfer_retransn_to_livestem_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ilivestem_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_livestemst_acc(p) = matrix_ntransfer_retransn_to_livestemst_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ilivestemst_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_deadstem_acc(p) = matrix_ntransfer_retransn_to_deadstem_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ideadstem_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_deadstemst_acc(p) = matrix_ntransfer_retransn_to_deadstemst_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ideadstemst_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_livecroot_acc(p) = matrix_ntransfer_retransn_to_livecroot_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ilivecroot_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_livecrootst_acc(p) = matrix_ntransfer_retransn_to_livecrootst_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ilivecrootst_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_deadcroot_acc(p) = matrix_ntransfer_retransn_to_deadcroot_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ideadcroot_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_deadcrootst_acc(p) = matrix_ntransfer_retransn_to_deadcrootst_acc(p) & - + matrix_nphtransfer(p,iretransn_to_ideadcrootst_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_leaf_to_retransn_acc(p) = matrix_ntransfer_leaf_to_retransn_acc(p) & - + matrix_nphtransfer(p,ileaf_to_iretransn_phn) & - * dt * retransn(p)!matrix_nphturnover(p,ileaf)*leafn(p) - matrix_ntransfer_froot_to_retransn_acc(p) = matrix_ntransfer_froot_to_retransn_acc(p) & - + matrix_nphtransfer(p,ifroot_to_iretransn_phn) & - * dt * retransn(p)!matrix_nphturnover(p,ifroot)*frootn(p) - matrix_ntransfer_livestem_to_retransn_acc(p) = matrix_ntransfer_livestem_to_retransn_acc(p) & - + matrix_nphtransfer(p,ilivestem_to_iretransn_phn) & - * dt * retransn(p)!matrix_nphturnover(p,ilivestem)*livestemn(p) - matrix_ntransfer_livecroot_to_retransn_acc(p) = matrix_ntransfer_livecroot_to_retransn_acc(p) & - + matrix_nphtransfer(p,ilivecroot_to_iretransn_phn) & - * dt * retransn(p)!matrix_nphturnover(p,ilivecroot)*livecrootn(p) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - matrix_ntransfer_retransn_to_grain_acc(p) = matrix_ntransfer_retransn_to_grain_acc(p) & - + matrix_nphtransfer(p,iretransn_to_igrain_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - matrix_ntransfer_retransn_to_grainst_acc(p) = matrix_ntransfer_retransn_to_grainst_acc(p) & - + matrix_nphtransfer(p,iretransn_to_igrainst_phn) & - * dt * retransn(p)!matrix_nphturnover(p,iretransn)*retransn(p) - end if - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - matrix_nturnover_leaf_acc(p) = matrix_nturnover_leaf_acc(p) & - + (matrix_nphturnover(p,ileaf)+matrix_ngmturnover(p,ileaf)+matrix_nfiturnover(p,ileaf)) & - * leafn(p) - matrix_nturnover_leafst_acc(p) = matrix_nturnover_leafst_acc(p) & - + (matrix_nphturnover(p,ileaf_st)+matrix_ngmturnover(p,ileaf_st)+matrix_nfiturnover(p,ileaf_st)) & - * leafn_storage(p) - matrix_nturnover_leafxf_acc(p) = matrix_nturnover_leafxf_acc(p) & - + (matrix_nphturnover(p,ileaf_xf)+matrix_ngmturnover(p,ileaf_xf)+matrix_nfiturnover(p,ileaf_xf)) & - * leafn_xfer(p) - matrix_nturnover_froot_acc(p) = matrix_nturnover_froot_acc(p) & - + (matrix_nphturnover(p,ifroot)+matrix_ngmturnover(p,ifroot)+matrix_nfiturnover(p,ifroot)) & - * frootn(p) - matrix_nturnover_frootst_acc(p) = matrix_nturnover_frootst_acc(p) & - + (matrix_nphturnover(p,ifroot_st)+matrix_ngmturnover(p,ifroot_st)+matrix_nfiturnover(p,ifroot_st)) & - * frootn_storage(p) - matrix_nturnover_frootxf_acc(p) = matrix_nturnover_frootxf_acc(p) & - + (matrix_nphturnover(p,ifroot_xf)+matrix_ngmturnover(p,ifroot_xf)+matrix_nfiturnover(p,ifroot_xf)) & - * frootn_xfer(p) - matrix_nturnover_livestem_acc(p) = matrix_nturnover_livestem_acc(p) & - + (matrix_nphturnover(p,ilivestem)+matrix_ngmturnover(p,ilivestem)+matrix_nfiturnover(p,ilivestem)) & - * livestemn(p) - matrix_nturnover_livestemst_acc(p) = matrix_nturnover_livestemst_acc(p) & - + (matrix_nphturnover(p,ilivestem_st)+matrix_ngmturnover(p,ilivestem_st)+matrix_nfiturnover(p,ilivestem_st)) & - * livestemn_storage(p) - matrix_nturnover_livestemxf_acc(p) = matrix_nturnover_livestemxf_acc(p) & - + (matrix_nphturnover(p,ilivestem_xf)+matrix_ngmturnover(p,ilivestem_xf)+matrix_nfiturnover(p,ilivestem_xf)) & - * livestemn_xfer(p) - matrix_nturnover_deadstem_acc(p) = matrix_nturnover_deadstem_acc(p) & - + (matrix_nphturnover(p,ideadstem)+matrix_ngmturnover(p,ideadstem)+matrix_nfiturnover(p,ideadstem)) & - * deadstemn(p) - matrix_nturnover_deadstemst_acc(p) = matrix_nturnover_deadstemst_acc(p) & - + (matrix_nphturnover(p,ideadstem_st)+matrix_ngmturnover(p,ideadstem_st)+matrix_nfiturnover(p,ideadstem_st)) & - * deadstemn_storage(p) - matrix_nturnover_deadstemxf_acc(p) = matrix_nturnover_deadstemxf_acc(p) & - + (matrix_nphturnover(p,ideadstem_xf)+matrix_ngmturnover(p,ideadstem_xf)+matrix_nfiturnover(p,ideadstem_xf)) & - * deadstemn_xfer(p) - matrix_nturnover_livecroot_acc(p) = matrix_nturnover_livecroot_acc(p) & - + (matrix_nphturnover(p,ilivecroot)+matrix_ngmturnover(p,ilivecroot)+matrix_nfiturnover(p,ilivecroot)) & - * livecrootn(p) - matrix_nturnover_livecrootst_acc(p) = matrix_nturnover_livecrootst_acc(p) & - + (matrix_nphturnover(p,ilivecroot_st)+matrix_ngmturnover(p,ilivecroot_st)+matrix_nfiturnover(p,ilivecroot_st)) & - * livecrootn_storage(p) - matrix_nturnover_livecrootxf_acc(p) = matrix_nturnover_livecrootxf_acc(p) & - + (matrix_nphturnover(p,ilivecroot_xf)+matrix_ngmturnover(p,ilivecroot_xf)+matrix_nfiturnover(p,ilivecroot_xf)) & - * livecrootn_xfer(p) - matrix_nturnover_deadcroot_acc(p) = matrix_nturnover_deadcroot_acc(p) & - + (matrix_nphturnover(p,ideadcroot)+matrix_ngmturnover(p,ideadcroot)+matrix_nfiturnover(p,ideadcroot)) & - * deadcrootn(p) - matrix_nturnover_deadcrootst_acc(p) = matrix_nturnover_deadcrootst_acc(p) & - + (matrix_nphturnover(p,ideadcroot_st)+matrix_ngmturnover(p,ideadcroot_st)+matrix_nfiturnover(p,ideadcroot_st)) & - * deadcrootn_storage(p) - matrix_nturnover_deadcrootxf_acc(p) = matrix_nturnover_deadcrootxf_acc(p) & - + (matrix_nphturnover(p,ideadcroot_xf)+matrix_ngmturnover(p,ideadcroot_xf)+matrix_nfiturnover(p,ideadcroot_xf)) & - * deadcrootn_xfer(p) - matrix_nturnover_retransn_acc(p) = matrix_nturnover_retransn_acc(p) & - + (matrix_nphturnover(p,iretransn)+matrix_ngmturnover(p,iretransn)+matrix_nfiturnover(p,iretransn)) & - * retransn(p) - end do - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - matrix_nturnover_grain_acc(p) = matrix_nturnover_grain_acc(p) & - + (matrix_nphturnover(p,igrain)+matrix_ngmturnover(p,igrain)+matrix_nfiturnover(p,igrain)) & - * grainn(p) - matrix_nturnover_grainst_acc(p) = matrix_nturnover_grainst_acc(p) & - + (matrix_nphturnover(p,igrain_st)+matrix_ngmturnover(p,igrain_st)+matrix_nfiturnover(p,igrain_st)) & - * grainn_storage(p) - matrix_nturnover_grainxf_acc(p) = matrix_nturnover_grainxf_acc(p) & - + (matrix_nphturnover(p,igrain_xf)+matrix_ngmturnover(p,igrain_xf)+matrix_nfiturnover(p,igrain_xf)) & - * grainn_xfer(p) - end if - end do - end if - call t_stopf('CN veg matrix-accum. trans.') - - ! Update state variables - call t_startf('CN veg matrix-assign new value') - do fp = 1,num_soilp - p = filter_soilp(fp) - leafc(p) = Xvegc%V(p,ileaf) - leafc_storage(p) = Xvegc%V(p,ileaf_st) - leafc_xfer(p) = Xvegc%V(p,ileaf_xf) - frootc(p) = Xvegc%V(p,ifroot) - frootc_storage(p) = Xvegc%V(p,ifroot_st) - frootc_xfer(p) = Xvegc%V(p,ifroot_xf) - livestemc(p) = Xvegc%V(p,ilivestem) - livestemc_storage(p) = Xvegc%V(p,ilivestem_st) - livestemc_xfer(p) = Xvegc%V(p,ilivestem_xf) - deadstemc(p) = Xvegc%V(p,ideadstem) - deadstemc_storage(p) = Xvegc%V(p,ideadstem_st) - deadstemc_xfer(p) = Xvegc%V(p,ideadstem_xf) - livecrootc(p) = Xvegc%V(p,ilivecroot) - livecrootc_storage(p) = Xvegc%V(p,ilivecroot_st) - livecrootc_xfer(p) = Xvegc%V(p,ilivecroot_xf) - deadcrootc(p) = Xvegc%V(p,ideadcroot) - deadcrootc_storage(p) = Xvegc%V(p,ideadcroot_st) - deadcrootc_xfer(p) = Xvegc%V(p,ideadcroot_xf) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - grainc(p) = Xvegc%V(p,igrain) - grainc_storage(p) = Xvegc%V(p,igrain_st) - grainc_xfer(p) = Xvegc%V(p,igrain_xf) - end if - end do - - if ( use_c13 ) then - do fp = 1,num_soilp - p = filter_soilp(fp) - cs13_veg%leafc_patch(p) = Xveg13c%V(p,ileaf) - cs13_veg%leafc_storage_patch(p) = Xveg13c%V(p,ileaf_st) - cs13_veg%leafc_xfer_patch(p) = Xveg13c%V(p,ileaf_xf) - cs13_veg%frootc_patch(p) = Xveg13c%V(p,ifroot) - cs13_veg%frootc_storage_patch(p) = Xveg13c%V(p,ifroot_st) - cs13_veg%frootc_xfer_patch(p) = Xveg13c%V(p,ifroot_xf) - cs13_veg%livestemc_patch(p) = Xveg13c%V(p,ilivestem) - cs13_veg%livestemc_storage_patch(p) = Xveg13c%V(p,ilivestem_st) - cs13_veg%livestemc_xfer_patch(p) = Xveg13c%V(p,ilivestem_xf) - cs13_veg%deadstemc_patch(p) = Xveg13c%V(p,ideadstem) - cs13_veg%deadstemc_storage_patch(p) = Xveg13c%V(p,ideadstem_st) - cs13_veg%deadstemc_xfer_patch(p) = Xveg13c%V(p,ideadstem_xf) - cs13_veg%livecrootc_patch(p) = Xveg13c%V(p,ilivecroot) - cs13_veg%livecrootc_storage_patch(p) = Xveg13c%V(p,ilivecroot_st) - cs13_veg%livecrootc_xfer_patch(p) = Xveg13c%V(p,ilivecroot_xf) - cs13_veg%deadcrootc_patch(p) = Xveg13c%V(p,ideadcroot) - cs13_veg%deadcrootc_storage_patch(p) = Xveg13c%V(p,ideadcroot_st) - cs13_veg%deadcrootc_xfer_patch(p) = Xveg13c%V(p,ideadcroot_xf) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - cs13_veg%grainc_patch(p) = Xveg13c%V(p,igrain) - cs13_veg%grainc_storage_patch(p) = Xveg13c%V(p,igrain_st) - cs13_veg%grainc_xfer_patch(p) = Xveg13c%V(p,igrain_xf) - end if - end do - end if - - if ( use_c14 ) then - do fp = 1,num_soilp - p = filter_soilp(fp) - cs14_veg%leafc_patch(p) = Xveg14c%V(p,ileaf) - cs14_veg%leafc_storage_patch(p) = Xveg14c%V(p,ileaf_st) - cs14_veg%leafc_xfer_patch(p) = Xveg14c%V(p,ileaf_xf) - cs14_veg%frootc_patch(p) = Xveg14c%V(p,ifroot) - cs14_veg%frootc_storage_patch(p) = Xveg14c%V(p,ifroot_st) - cs14_veg%frootc_xfer_patch(p) = Xveg14c%V(p,ifroot_xf) - cs14_veg%livestemc_patch(p) = Xveg14c%V(p,ilivestem) - cs14_veg%livestemc_storage_patch(p) = Xveg14c%V(p,ilivestem_st) - cs14_veg%livestemc_xfer_patch(p) = Xveg14c%V(p,ilivestem_xf) - cs14_veg%deadstemc_patch(p) = Xveg14c%V(p,ideadstem) - cs14_veg%deadstemc_storage_patch(p) = Xveg14c%V(p,ideadstem_st) - cs14_veg%deadstemc_xfer_patch(p) = Xveg14c%V(p,ideadstem_xf) - cs14_veg%livecrootc_patch(p) = Xveg14c%V(p,ilivecroot) - cs14_veg%livecrootc_storage_patch(p) = Xveg14c%V(p,ilivecroot_st) - cs14_veg%livecrootc_xfer_patch(p) = Xveg14c%V(p,ilivecroot_xf) - cs14_veg%deadcrootc_patch(p) = Xveg14c%V(p,ideadcroot) - cs14_veg%deadcrootc_storage_patch(p) = Xveg14c%V(p,ideadcroot_st) - cs14_veg%deadcrootc_xfer_patch(p) = Xveg14c%V(p,ideadcroot_xf) - end do - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - cs14_veg%grainc_patch(p) = Xveg14c%V(p,igrain) - cs14_veg%grainc_storage_patch(p) = Xveg14c%V(p,igrain_st) - cs14_veg%grainc_xfer_patch(p) = Xveg14c%V(p,igrain_xf) - end if - end do - end if - - do fp = 1,num_soilp - p = filter_soilp(fp) - leafn(p) = Xvegn%V(p,ileaf) - leafn_storage(p) = Xvegn%V(p,ileaf_st) - leafn_xfer(p) = Xvegn%V(p,ileaf_xf) - frootn(p) = Xvegn%V(p,ifroot) - frootn_storage(p) = Xvegn%V(p,ifroot_st) - frootn_xfer(p) = Xvegn%V(p,ifroot_xf) - livestemn(p) = Xvegn%V(p,ilivestem) - livestemn_storage(p) = Xvegn%V(p,ilivestem_st) - livestemn_xfer(p) = Xvegn%V(p,ilivestem_xf) - deadstemn(p) = Xvegn%V(p,ideadstem) - deadstemn_storage(p) = Xvegn%V(p,ideadstem_st) - deadstemn_xfer(p) = Xvegn%V(p,ideadstem_xf) - livecrootn(p) = Xvegn%V(p,ilivecroot) - livecrootn_storage(p) = Xvegn%V(p,ilivecroot_st) - livecrootn_xfer(p) = Xvegn%V(p,ilivecroot_xf) - deadcrootn(p) = Xvegn%V(p,ideadcroot) - deadcrootn_storage(p) = Xvegn%V(p,ideadcroot_st) - deadcrootn_xfer(p) = Xvegn%V(p,ideadcroot_xf) - retransn(p) = Xvegn%V(p,iretransn) - end do - - do fp = 1,num_soilp - p = filter_soilp(fp) - if(ivt(p) >= npcropmin)then - grainn(p) = Xvegn%V(p,igrain) - grainn_storage(p) = Xvegn%V(p,igrain_st) - grainn_xfer(p) = Xvegn%V(p,igrain_xf) - end if - end do - call t_stopf('CN veg matrix-assign new value') - - ! Calculate C storage capacity. 2D matrix instead of sparse matrix is still used when calculating the inverse - if(isspinup .or. is_outmatrix)then - if((.not. isspinup .and. is_end_curr_year()) .or. (isspinup .and. is_end_curr_year() .and. mod(iyr,nyr_SASU) .eq. 0))then - do fp = 1,num_soilp - call t_startf('CN veg matrix-prepare AK^-1') - p = filter_soilp(fp) - matrix_calloc_acc(ileaf) = matrix_calloc_leaf_acc(p) - matrix_calloc_acc(ileaf_st) = matrix_calloc_leafst_acc(p) - matrix_calloc_acc(ifroot) = matrix_calloc_froot_acc(p) - matrix_calloc_acc(ifroot_st) = matrix_calloc_frootst_acc(p) - matrix_calloc_acc(ilivestem) = matrix_calloc_livestem_acc(p) - matrix_calloc_acc(ilivestem_st) = matrix_calloc_livestemst_acc(p) - matrix_calloc_acc(ideadstem) = matrix_calloc_deadstem_acc(p) - matrix_calloc_acc(ideadstem_st) = matrix_calloc_deadstemst_acc(p) - matrix_calloc_acc(ilivecroot) = matrix_calloc_livecroot_acc(p) - matrix_calloc_acc(ilivecroot_st) = matrix_calloc_livecrootst_acc(p) - matrix_calloc_acc(ideadcroot) = matrix_calloc_deadcroot_acc(p) - matrix_calloc_acc(ideadcroot_st) = matrix_calloc_deadcrootst_acc(p) - if(ivt(p) >= npcropmin)then - matrix_calloc_acc(igrain) = matrix_calloc_grain_acc(p) - matrix_calloc_acc(igrain_st) = matrix_calloc_grainst_acc(p) - end if - - matrix_ctransfer_acc(ileaf_xf,ileaf_st) = matrix_ctransfer_leafst_to_leafxf_acc(p) - matrix_ctransfer_acc(ileaf,ileaf_xf) = matrix_ctransfer_leafxf_to_leaf_acc(p) - matrix_ctransfer_acc(ifroot_xf,ifroot_st) = matrix_ctransfer_frootst_to_frootxf_acc(p) - matrix_ctransfer_acc(ifroot,ifroot_xf) = matrix_ctransfer_frootxf_to_froot_acc(p) - matrix_ctransfer_acc(ilivestem_xf,ilivestem_st) = matrix_ctransfer_livestemst_to_livestemxf_acc(p) - matrix_ctransfer_acc(ilivestem,ilivestem_xf) = matrix_ctransfer_livestemxf_to_livestem_acc(p) - matrix_ctransfer_acc(ideadstem_xf,ideadstem_st) = matrix_ctransfer_deadstemst_to_deadstemxf_acc(p) - matrix_ctransfer_acc(ideadstem,ideadstem_xf) = matrix_ctransfer_deadstemxf_to_deadstem_acc(p) - matrix_ctransfer_acc(ilivecroot_xf,ilivecroot_st) = matrix_ctransfer_livecrootst_to_livecrootxf_acc(p) - matrix_ctransfer_acc(ilivecroot,ilivecroot_xf) = matrix_ctransfer_livecrootxf_to_livecroot_acc(p) - matrix_ctransfer_acc(ideadcroot_xf,ideadcroot_st) = matrix_ctransfer_deadcrootst_to_deadcrootxf_acc(p) - matrix_ctransfer_acc(ideadcroot,ideadcroot_xf) = matrix_ctransfer_deadcrootxf_to_deadcroot_acc(p) - if(ivt(p) >= npcropmin)then - matrix_ctransfer_acc(igrain_xf,igrain_st) = matrix_ctransfer_grainst_to_grainxf_acc(p) - matrix_ctransfer_acc(igrain,igrain_xf) = matrix_ctransfer_grainxf_to_grain_acc(p) - end if - matrix_ctransfer_acc(ideadstem,ilivestem) = matrix_ctransfer_livestem_to_deadstem_acc(p) - matrix_ctransfer_acc(ideadcroot,ilivecroot) = matrix_ctransfer_livecroot_to_deadcroot_acc(p) - - matrix_ctransfer_acc(ileaf,ileaf) = -matrix_cturnover_leaf_acc(p) - matrix_ctransfer_acc(ileaf_st,ileaf_st) = -matrix_cturnover_leafst_acc(p) - matrix_ctransfer_acc(ileaf_xf,ileaf_xf) = -matrix_cturnover_leafxf_acc(p) - matrix_ctransfer_acc(ifroot,ifroot) = -matrix_cturnover_froot_acc(p) - matrix_ctransfer_acc(ifroot_st,ifroot_st) = -matrix_cturnover_frootst_acc(p) - matrix_ctransfer_acc(ifroot_xf,ifroot_xf) = -matrix_cturnover_frootxf_acc(p) - matrix_ctransfer_acc(ilivestem,ilivestem) = -matrix_cturnover_livestem_acc(p) - matrix_ctransfer_acc(ilivestem_st,ilivestem_st) = -matrix_cturnover_livestemst_acc(p) - matrix_ctransfer_acc(ilivestem_xf,ilivestem_xf) = -matrix_cturnover_livestemxf_acc(p) - matrix_ctransfer_acc(ideadstem,ideadstem) = -matrix_cturnover_deadstem_acc(p) - matrix_ctransfer_acc(ideadstem_st,ideadstem_st) = -matrix_cturnover_deadstemst_acc(p) - matrix_ctransfer_acc(ideadstem_xf,ideadstem_xf) = -matrix_cturnover_deadstemxf_acc(p) - matrix_ctransfer_acc(ilivecroot,ilivecroot) = -matrix_cturnover_livecroot_acc(p) - matrix_ctransfer_acc(ilivecroot_st,ilivecroot_st) = -matrix_cturnover_livecrootst_acc(p) - matrix_ctransfer_acc(ilivecroot_xf,ilivecroot_xf) = -matrix_cturnover_livecrootxf_acc(p) - matrix_ctransfer_acc(ideadcroot,ideadcroot) = -matrix_cturnover_deadcroot_acc(p) - matrix_ctransfer_acc(ideadcroot_st,ideadcroot_st) = -matrix_cturnover_deadcrootst_acc(p) - matrix_ctransfer_acc(ideadcroot_xf,ideadcroot_xf) = -matrix_cturnover_deadcrootxf_acc(p) - if(ivt(p) >= npcropmin)then - matrix_ctransfer_acc(igrain,igrain) = -matrix_cturnover_grain_acc(p) - matrix_ctransfer_acc(igrain_st,igrain_st) = -matrix_cturnover_grainst_acc(p) - matrix_ctransfer_acc(igrain_xf,igrain_xf) = -matrix_cturnover_grainxf_acc(p) - end if - - if(use_c13)then - matrix_c13alloc_acc(ileaf) = cs13_veg%matrix_calloc_leaf_acc_patch(p) - matrix_c13alloc_acc(ileaf_st) = cs13_veg%matrix_calloc_leafst_acc_patch(p) - matrix_c13alloc_acc(ifroot) = cs13_veg%matrix_calloc_froot_acc_patch(p) - matrix_c13alloc_acc(ifroot_st) = cs13_veg%matrix_calloc_frootst_acc_patch(p) - matrix_c13alloc_acc(ilivestem) = cs13_veg%matrix_calloc_livestem_acc_patch(p) - matrix_c13alloc_acc(ilivestem_st) = cs13_veg%matrix_calloc_livestemst_acc_patch(p) - matrix_c13alloc_acc(ideadstem) = cs13_veg%matrix_calloc_deadstem_acc_patch(p) - matrix_c13alloc_acc(ideadstem_st) = cs13_veg%matrix_calloc_deadstemst_acc_patch(p) - matrix_c13alloc_acc(ilivecroot) = cs13_veg%matrix_calloc_livecroot_acc_patch(p) - matrix_c13alloc_acc(ilivecroot_st) = cs13_veg%matrix_calloc_livecrootst_acc_patch(p) - matrix_c13alloc_acc(ideadcroot) = cs13_veg%matrix_calloc_deadcroot_acc_patch(p) - matrix_c13alloc_acc(ideadcroot_st) = cs13_veg%matrix_calloc_deadcrootst_acc_patch(p) - if(ivt(p) >= npcropmin)then - matrix_c13alloc_acc(igrain) = cs13_veg%matrix_calloc_grain_acc_patch(p) - matrix_c13alloc_acc(igrain_st) = cs13_veg%matrix_calloc_grainst_acc_patch(p) - end if - - matrix_c13transfer_acc(ileaf_xf,ileaf_st) = cs13_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) - matrix_c13transfer_acc(ileaf,ileaf_xf) = cs13_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) - matrix_c13transfer_acc(ifroot_xf,ifroot_st) = cs13_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) - matrix_c13transfer_acc(ifroot,ifroot_xf) = cs13_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) - matrix_c13transfer_acc(ilivestem_xf,ilivestem_st) = cs13_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) - matrix_c13transfer_acc(ilivestem,ilivestem_xf) = cs13_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) - matrix_c13transfer_acc(ideadstem_xf,ideadstem_st) = cs13_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) - matrix_c13transfer_acc(ideadstem,ideadstem_xf) = cs13_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) - matrix_c13transfer_acc(ilivecroot_xf,ilivecroot_st) = cs13_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) - matrix_c13transfer_acc(ilivecroot,ilivecroot_xf) = cs13_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) - matrix_c13transfer_acc(ideadcroot_xf,ideadcroot_st) = cs13_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) - matrix_c13transfer_acc(ideadcroot,ideadcroot_xf) = cs13_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) - if(ivt(p) >= npcropmin)then - matrix_c13transfer_acc(igrain_xf,igrain_st) = cs13_veg%matrix_ctransfer_grainst_to_grainxf_acc_patch(p) - matrix_c13transfer_acc(igrain,igrain_xf) = cs13_veg%matrix_ctransfer_grainxf_to_grain_acc_patch(p) - end if - matrix_c13transfer_acc(ideadstem,ilivestem) = cs13_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) - matrix_c13transfer_acc(ideadcroot,ilivecroot) = cs13_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) - - matrix_c13transfer_acc(ileaf,ileaf) = -cs13_veg%matrix_cturnover_leaf_acc_patch(p) - matrix_c13transfer_acc(ileaf_st,ileaf_st) = -cs13_veg%matrix_cturnover_leafst_acc_patch(p) - matrix_c13transfer_acc(ileaf_xf,ileaf_xf) = -cs13_veg%matrix_cturnover_leafxf_acc_patch(p) - matrix_c13transfer_acc(ifroot,ifroot) = -cs13_veg%matrix_cturnover_froot_acc_patch(p) - matrix_c13transfer_acc(ifroot_st,ifroot_st) = -cs13_veg%matrix_cturnover_frootst_acc_patch(p) - matrix_c13transfer_acc(ifroot_xf,ifroot_xf) = -cs13_veg%matrix_cturnover_frootxf_acc_patch(p) - matrix_c13transfer_acc(ilivestem,ilivestem) = -cs13_veg%matrix_cturnover_livestem_acc_patch(p) - matrix_c13transfer_acc(ilivestem_st,ilivestem_st) = -cs13_veg%matrix_cturnover_livestemst_acc_patch(p) - matrix_c13transfer_acc(ilivestem_xf,ilivestem_xf) = -cs13_veg%matrix_cturnover_livestemxf_acc_patch(p) - matrix_c13transfer_acc(ideadstem,ideadstem) = -cs13_veg%matrix_cturnover_deadstem_acc_patch(p) - matrix_c13transfer_acc(ideadstem_st,ideadstem_st) = -cs13_veg%matrix_cturnover_deadstemst_acc_patch(p) - matrix_c13transfer_acc(ideadstem_xf,ideadstem_xf) = -cs13_veg%matrix_cturnover_deadstemxf_acc_patch(p) - matrix_c13transfer_acc(ilivecroot,ilivecroot) = -cs13_veg%matrix_cturnover_livecroot_acc_patch(p) - matrix_c13transfer_acc(ilivecroot_st,ilivecroot_st) = -cs13_veg%matrix_cturnover_livecrootst_acc_patch(p) - matrix_c13transfer_acc(ilivecroot_xf,ilivecroot_xf) = -cs13_veg%matrix_cturnover_livecrootxf_acc_patch(p) - matrix_c13transfer_acc(ideadcroot,ideadcroot) = -cs13_veg%matrix_cturnover_deadcroot_acc_patch(p) - matrix_c13transfer_acc(ideadcroot_st,ideadcroot_st) = -cs13_veg%matrix_cturnover_deadcrootst_acc_patch(p) - matrix_c13transfer_acc(ideadcroot_xf,ideadcroot_xf) = -cs13_veg%matrix_cturnover_deadcrootxf_acc_patch(p) - if(ivt(p) >= npcropmin)then - matrix_c13transfer_acc(igrain,igrain) = -cs13_veg%matrix_cturnover_grain_acc_patch(p) - matrix_c13transfer_acc(igrain_st,igrain_st) = -cs13_veg%matrix_cturnover_grainst_acc_patch(p) - matrix_c13transfer_acc(igrain_xf,igrain_xf) = -cs13_veg%matrix_cturnover_grainxf_acc_patch(p) - end if - end if - - if(use_c14)then - matrix_c14alloc_acc(ileaf) = cs14_veg%matrix_calloc_leaf_acc_patch(p) - matrix_c14alloc_acc(ileaf_st) = cs14_veg%matrix_calloc_leafst_acc_patch(p) - matrix_c14alloc_acc(ifroot) = cs14_veg%matrix_calloc_froot_acc_patch(p) - matrix_c14alloc_acc(ifroot_st) = cs14_veg%matrix_calloc_frootst_acc_patch(p) - matrix_c14alloc_acc(ilivestem) = cs14_veg%matrix_calloc_livestem_acc_patch(p) - matrix_c14alloc_acc(ilivestem_st) = cs14_veg%matrix_calloc_livestemst_acc_patch(p) - matrix_c14alloc_acc(ideadstem) = cs14_veg%matrix_calloc_deadstem_acc_patch(p) - matrix_c14alloc_acc(ideadstem_st) = cs14_veg%matrix_calloc_deadstemst_acc_patch(p) - matrix_c14alloc_acc(ilivecroot) = cs14_veg%matrix_calloc_livecroot_acc_patch(p) - matrix_c14alloc_acc(ilivecroot_st) = cs14_veg%matrix_calloc_livecrootst_acc_patch(p) - matrix_c14alloc_acc(ideadcroot) = cs14_veg%matrix_calloc_deadcroot_acc_patch(p) - matrix_c14alloc_acc(ideadcroot_st) = cs14_veg%matrix_calloc_deadcrootst_acc_patch(p) - if(ivt(p) >= npcropmin)then - matrix_c14alloc_acc(igrain) = cs14_veg%matrix_calloc_grain_acc_patch(p) - matrix_c14alloc_acc(igrain_st) = cs14_veg%matrix_calloc_grainst_acc_patch(p) - end if - - matrix_c14transfer_acc(ileaf_xf,ileaf_st) = cs14_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) - matrix_c14transfer_acc(ileaf,ileaf_xf) = cs14_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) - matrix_c14transfer_acc(ifroot_xf,ifroot_st) = cs14_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) - matrix_c14transfer_acc(ifroot,ifroot_xf) = cs14_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) - matrix_c14transfer_acc(ilivestem_xf,ilivestem_st) = cs14_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) - matrix_c14transfer_acc(ilivestem,ilivestem_xf) = cs14_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) - matrix_c14transfer_acc(ideadstem_xf,ideadstem_st) = cs14_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) - matrix_c14transfer_acc(ideadstem,ideadstem_xf) = cs14_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) - matrix_c14transfer_acc(ilivecroot_xf,ilivecroot_st) = cs14_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) - matrix_c14transfer_acc(ilivecroot,ilivecroot_xf) = cs14_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) - matrix_c14transfer_acc(ideadcroot_xf,ideadcroot_st) = cs14_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) - matrix_c14transfer_acc(ideadcroot,ideadcroot_xf) = cs14_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) - if(ivt(p) >= npcropmin)then - matrix_c14transfer_acc(igrain_xf,igrain_st) = cs14_veg%matrix_ctransfer_grainst_to_grainxf_acc_patch(p) - matrix_c14transfer_acc(igrain,igrain_xf) = cs14_veg%matrix_ctransfer_grainxf_to_grain_acc_patch(p) - end if - matrix_c14transfer_acc(ideadstem,ilivestem) = cs14_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) - matrix_c14transfer_acc(ideadcroot,ilivecroot) = cs14_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) - - matrix_c14transfer_acc(ileaf,ileaf) = -cs14_veg%matrix_cturnover_leaf_acc_patch(p) - matrix_c14transfer_acc(ileaf_st,ileaf_st) = -cs14_veg%matrix_cturnover_leafst_acc_patch(p) - matrix_c14transfer_acc(ileaf_xf,ileaf_xf) = -cs14_veg%matrix_cturnover_leafxf_acc_patch(p) - matrix_c14transfer_acc(ifroot,ifroot) = -cs14_veg%matrix_cturnover_froot_acc_patch(p) - matrix_c14transfer_acc(ifroot_st,ifroot_st) = -cs14_veg%matrix_cturnover_frootst_acc_patch(p) - matrix_c14transfer_acc(ifroot_xf,ifroot_xf) = -cs14_veg%matrix_cturnover_frootxf_acc_patch(p) - matrix_c14transfer_acc(ilivestem,ilivestem) = -cs14_veg%matrix_cturnover_livestem_acc_patch(p) - matrix_c14transfer_acc(ilivestem_st,ilivestem_st) = -cs14_veg%matrix_cturnover_livestemst_acc_patch(p) - matrix_c14transfer_acc(ilivestem_xf,ilivestem_xf) = -cs14_veg%matrix_cturnover_livestemxf_acc_patch(p) - matrix_c14transfer_acc(ideadstem,ideadstem) = -cs14_veg%matrix_cturnover_deadstem_acc_patch(p) - matrix_c14transfer_acc(ideadstem_st,ideadstem_st) = -cs14_veg%matrix_cturnover_deadstemst_acc_patch(p) - matrix_c14transfer_acc(ideadstem_xf,ideadstem_xf) = -cs14_veg%matrix_cturnover_deadstemxf_acc_patch(p) - matrix_c14transfer_acc(ilivecroot,ilivecroot) = -cs14_veg%matrix_cturnover_livecroot_acc_patch(p) - matrix_c14transfer_acc(ilivecroot_st,ilivecroot_st) = -cs14_veg%matrix_cturnover_livecrootst_acc_patch(p) - matrix_c14transfer_acc(ilivecroot_xf,ilivecroot_xf) = -cs14_veg%matrix_cturnover_livecrootxf_acc_patch(p) - matrix_c14transfer_acc(ideadcroot,ideadcroot) = -cs14_veg%matrix_cturnover_deadcroot_acc_patch(p) - matrix_c14transfer_acc(ideadcroot_st,ideadcroot_st) = -cs14_veg%matrix_cturnover_deadcrootst_acc_patch(p) - matrix_c14transfer_acc(ideadcroot_xf,ideadcroot_xf) = -cs14_veg%matrix_cturnover_deadcrootxf_acc_patch(p) - if(ivt(p) >= npcropmin)then - matrix_c14transfer_acc(igrain,igrain) = -cs14_veg%matrix_cturnover_grain_acc_patch(p) - matrix_c14transfer_acc(igrain_st,igrain_st) = -cs14_veg%matrix_cturnover_grainst_acc_patch(p) - matrix_c14transfer_acc(igrain_xf,igrain_xf) = -cs14_veg%matrix_cturnover_grainxf_acc_patch(p) - end if - end if - - matrix_nalloc_acc(ileaf) = matrix_nalloc_leaf_acc(p) - matrix_nalloc_acc(ileaf_st) = matrix_nalloc_leafst_acc(p) - matrix_nalloc_acc(ifroot) = matrix_nalloc_froot_acc(p) - matrix_nalloc_acc(ifroot_st) = matrix_nalloc_frootst_acc(p) - matrix_nalloc_acc(ilivestem) = matrix_nalloc_livestem_acc(p) - matrix_nalloc_acc(ilivestem_st) = matrix_nalloc_livestemst_acc(p) - matrix_nalloc_acc(ideadstem) = matrix_nalloc_deadstem_acc(p) - matrix_nalloc_acc(ideadstem_st) = matrix_nalloc_deadstemst_acc(p) - matrix_nalloc_acc(ilivecroot) = matrix_nalloc_livecroot_acc(p) - matrix_nalloc_acc(ilivecroot_st) = matrix_nalloc_livecrootst_acc(p) - matrix_nalloc_acc(ideadcroot) = matrix_nalloc_deadcroot_acc(p) - matrix_nalloc_acc(ideadcroot_st) = matrix_nalloc_deadcrootst_acc(p) - if(ivt(p) >= npcropmin)then - matrix_nalloc_acc(igrain) = matrix_nalloc_grain_acc(p) - matrix_nalloc_acc(igrain_st) = matrix_nalloc_grainst_acc(p) - end if - - matrix_ntransfer_acc(ileaf_xf,ileaf_st) = matrix_ntransfer_leafst_to_leafxf_acc(p) - matrix_ntransfer_acc(ileaf,ileaf_xf) = matrix_ntransfer_leafxf_to_leaf_acc(p) - matrix_ntransfer_acc(ifroot_xf,ifroot_st) = matrix_ntransfer_frootst_to_frootxf_acc(p) - matrix_ntransfer_acc(ifroot,ifroot_xf) = matrix_ntransfer_frootxf_to_froot_acc(p) - matrix_ntransfer_acc(ilivestem_xf,ilivestem_st) = matrix_ntransfer_livestemst_to_livestemxf_acc(p) - matrix_ntransfer_acc(ilivestem,ilivestem_xf) = matrix_ntransfer_livestemxf_to_livestem_acc(p) - matrix_ntransfer_acc(ideadstem_xf,ideadstem_st) = matrix_ntransfer_deadstemst_to_deadstemxf_acc(p) - matrix_ntransfer_acc(ideadstem,ideadstem_xf) = matrix_ntransfer_deadstemxf_to_deadstem_acc(p) - matrix_ntransfer_acc(ilivecroot_xf,ilivecroot_st) = matrix_ntransfer_livecrootst_to_livecrootxf_acc(p) - matrix_ntransfer_acc(ilivecroot,ilivecroot_xf) = matrix_ntransfer_livecrootxf_to_livecroot_acc(p) - matrix_ntransfer_acc(ideadcroot_xf,ideadcroot_st) = matrix_ntransfer_deadcrootst_to_deadcrootxf_acc(p) - matrix_ntransfer_acc(ideadcroot,ideadcroot_xf) = matrix_ntransfer_deadcrootxf_to_deadcroot_acc(p) - if(ivt(p) >= npcropmin)then - matrix_ntransfer_acc(igrain_xf,igrain_st) = matrix_ntransfer_grainst_to_grainxf_acc(p) - matrix_ntransfer_acc(igrain,igrain_xf) = matrix_ntransfer_grainxf_to_grain_acc(p) - end if - matrix_ntransfer_acc(ideadstem,ilivestem) = matrix_ntransfer_livestem_to_deadstem_acc(p) - matrix_ntransfer_acc(ideadcroot,ilivecroot) = matrix_ntransfer_livecroot_to_deadcroot_acc(p) - - matrix_ntransfer_acc(ileaf,iretransn) = matrix_ntransfer_retransn_to_leaf_acc(p) - matrix_ntransfer_acc(ileaf_st,iretransn) = matrix_ntransfer_retransn_to_leafst_acc(p) - matrix_ntransfer_acc(ifroot,iretransn) = matrix_ntransfer_retransn_to_froot_acc(p) - matrix_ntransfer_acc(ifroot_st,iretransn) = matrix_ntransfer_retransn_to_frootst_acc(p) - matrix_ntransfer_acc(ilivestem,iretransn) = matrix_ntransfer_retransn_to_livestem_acc(p) - matrix_ntransfer_acc(ilivestem_st,iretransn) = matrix_ntransfer_retransn_to_livestemst_acc(p) - matrix_ntransfer_acc(ideadstem,iretransn) = matrix_ntransfer_retransn_to_deadstem_acc(p) - matrix_ntransfer_acc(ideadstem_st,iretransn) = matrix_ntransfer_retransn_to_deadstemst_acc(p) - matrix_ntransfer_acc(ilivecroot,iretransn) = matrix_ntransfer_retransn_to_livecroot_acc(p) - matrix_ntransfer_acc(ilivecroot_st,iretransn) = matrix_ntransfer_retransn_to_livecrootst_acc(p) - matrix_ntransfer_acc(ideadcroot,iretransn) = matrix_ntransfer_retransn_to_deadcroot_acc(p) - matrix_ntransfer_acc(ideadcroot_st,iretransn) = matrix_ntransfer_retransn_to_deadcrootst_acc(p) - if(ivt(p) >= npcropmin)then - matrix_ntransfer_acc(igrain,iretransn) = matrix_ntransfer_retransn_to_grain_acc(p) - matrix_ntransfer_acc(igrain_st,iretransn) = matrix_ntransfer_retransn_to_grainst_acc(p) - end if - matrix_ntransfer_acc(iretransn,ileaf) = matrix_ntransfer_leaf_to_retransn_acc(p) - matrix_ntransfer_acc(iretransn,ifroot) = matrix_ntransfer_froot_to_retransn_acc(p) - matrix_ntransfer_acc(iretransn,ilivestem) = matrix_ntransfer_livestem_to_retransn_acc(p) - matrix_ntransfer_acc(iretransn,ilivecroot) = matrix_ntransfer_livecroot_to_retransn_acc(p) - - matrix_ntransfer_acc(ileaf,ileaf) = -matrix_nturnover_leaf_acc(p) - matrix_ntransfer_acc(ileaf_st,ileaf_st) = -matrix_nturnover_leafst_acc(p) - matrix_ntransfer_acc(ileaf_xf,ileaf_xf) = -matrix_nturnover_leafxf_acc(p) - matrix_ntransfer_acc(ifroot,ifroot) = -matrix_nturnover_froot_acc(p) - matrix_ntransfer_acc(ifroot_st,ifroot_st) = -matrix_nturnover_frootst_acc(p) - matrix_ntransfer_acc(ifroot_xf,ifroot_xf) = -matrix_nturnover_frootxf_acc(p) - matrix_ntransfer_acc(ilivestem,ilivestem) = -matrix_nturnover_livestem_acc(p) - matrix_ntransfer_acc(ilivestem_st,ilivestem_st) = -matrix_nturnover_livestemst_acc(p) - matrix_ntransfer_acc(ilivestem_xf,ilivestem_xf) = -matrix_nturnover_livestemxf_acc(p) - matrix_ntransfer_acc(ideadstem,ideadstem) = -matrix_nturnover_deadstem_acc(p) - matrix_ntransfer_acc(ideadstem_st,ideadstem_st) = -matrix_nturnover_deadstemst_acc(p) - matrix_ntransfer_acc(ideadstem_xf,ideadstem_xf) = -matrix_nturnover_deadstemxf_acc(p) - matrix_ntransfer_acc(ilivecroot,ilivecroot) = -matrix_nturnover_livecroot_acc(p) - matrix_ntransfer_acc(ilivecroot_st,ilivecroot_st) = -matrix_nturnover_livecrootst_acc(p) - matrix_ntransfer_acc(ilivecroot_xf,ilivecroot_xf) = -matrix_nturnover_livecrootxf_acc(p) - matrix_ntransfer_acc(ideadcroot,ideadcroot) = -matrix_nturnover_deadcroot_acc(p) - matrix_ntransfer_acc(ideadcroot_st,ideadcroot_st) = -matrix_nturnover_deadcrootst_acc(p) - matrix_ntransfer_acc(ideadcroot_xf,ideadcroot_xf) = -matrix_nturnover_deadcrootxf_acc(p) - if(ivt(p) >= npcropmin)then - matrix_ntransfer_acc(igrain,igrain) = -matrix_nturnover_grain_acc(p) - matrix_ntransfer_acc(igrain_st,igrain_st) = -matrix_nturnover_grainst_acc(p) - matrix_ntransfer_acc(igrain_xf,igrain_xf) = -matrix_nturnover_grainxf_acc(p) - end if - matrix_ntransfer_acc(iretransn,iretransn) = -matrix_nturnover_retransn_acc(p) - - do i=1,nvegcpool - if(matrix_ctransfer_acc(i,i) .eq. 0)then - matrix_ctransfer_acc(i,i) = 1.e+36 - end if - end do - if(use_c13)then - do i=1,nvegcpool - if(matrix_c13transfer_acc(i,i) .eq. 0)then - matrix_c13transfer_acc(i,i) = 1.e+36 - end if - end do - end if - if(use_c14)then - do i=1,nvegcpool - if(matrix_c14transfer_acc(i,i) .eq. 0)then - matrix_c14transfer_acc(i,i) = 1.e+36 - end if - end do - end if - do i=1,nvegnpool - if(matrix_ntransfer_acc(i,i) .eq. 0)then - matrix_ntransfer_acc(i,i) = 1.e+36 - end if - end do - - ! Calculate the transfer rate based on the initial value of the calendar year. - matrix_ctransfer_acc(1:nvegcpool,ileaf) = matrix_ctransfer_acc(1:nvegcpool,ileaf) / leafc0(p) - matrix_ctransfer_acc(1:nvegcpool,ileaf_st) = matrix_ctransfer_acc(1:nvegcpool,ileaf_st) / leafc0_storage(p) - matrix_ctransfer_acc(1:nvegcpool,ileaf_xf) = matrix_ctransfer_acc(1:nvegcpool,ileaf_xf) / leafc0_xfer(p) - matrix_ctransfer_acc(1:nvegcpool,ifroot) = matrix_ctransfer_acc(1:nvegcpool,ifroot) / frootc0(p) - matrix_ctransfer_acc(1:nvegcpool,ifroot_st) = matrix_ctransfer_acc(1:nvegcpool,ifroot_st) / frootc0_storage(p) - matrix_ctransfer_acc(1:nvegcpool,ifroot_xf) = matrix_ctransfer_acc(1:nvegcpool,ifroot_xf) / frootc0_xfer(p) - matrix_ctransfer_acc(1:nvegcpool,ilivestem) = matrix_ctransfer_acc(1:nvegcpool,ilivestem) / livestemc0(p) - matrix_ctransfer_acc(1:nvegcpool,ilivestem_st) = matrix_ctransfer_acc(1:nvegcpool,ilivestem_st) / livestemc0_storage(p) - matrix_ctransfer_acc(1:nvegcpool,ilivestem_xf) = matrix_ctransfer_acc(1:nvegcpool,ilivestem_xf) / livestemc0_xfer(p) - matrix_ctransfer_acc(1:nvegcpool,ideadstem) = matrix_ctransfer_acc(1:nvegcpool,ideadstem) / deadstemc0(p) - matrix_ctransfer_acc(1:nvegcpool,ideadstem_st) = matrix_ctransfer_acc(1:nvegcpool,ideadstem_st) / deadstemc0_storage(p) - matrix_ctransfer_acc(1:nvegcpool,ideadstem_xf) = matrix_ctransfer_acc(1:nvegcpool,ideadstem_xf) / deadstemc0_xfer(p) - matrix_ctransfer_acc(1:nvegcpool,ilivecroot) = matrix_ctransfer_acc(1:nvegcpool,ilivecroot) / livecrootc0(p) - matrix_ctransfer_acc(1:nvegcpool,ilivecroot_st) = matrix_ctransfer_acc(1:nvegcpool,ilivecroot_st) / livecrootc0_storage(p) - matrix_ctransfer_acc(1:nvegcpool,ilivecroot_xf) = matrix_ctransfer_acc(1:nvegcpool,ilivecroot_xf) / livecrootc0_xfer(p) - matrix_ctransfer_acc(1:nvegcpool,ideadcroot) = matrix_ctransfer_acc(1:nvegcpool,ideadcroot) / deadcrootc0(p) - matrix_ctransfer_acc(1:nvegcpool,ideadcroot_st) = matrix_ctransfer_acc(1:nvegcpool,ideadcroot_st) / deadcrootc0_storage(p) - matrix_ctransfer_acc(1:nvegcpool,ideadcroot_xf) = matrix_ctransfer_acc(1:nvegcpool,ideadcroot_xf) / deadcrootc0_xfer(p) - if(ivt(p) >= npcropmin)then - matrix_ctransfer_acc(1:nvegcpool,igrain) = matrix_ctransfer_acc(1:nvegcpool,igrain) / grainc0(p) - matrix_ctransfer_acc(1:nvegcpool,igrain_st) = matrix_ctransfer_acc(1:nvegcpool,igrain_st) / grainc0_storage(p) - matrix_ctransfer_acc(1:nvegcpool,igrain_xf) = matrix_ctransfer_acc(1:nvegcpool,igrain_xf) / grainc0_xfer(p) - end if - - if(use_c13)then - matrix_c13transfer_acc(1:nvegcpool,ileaf) = matrix_c13transfer_acc(1:nvegcpool,ileaf) / cs13_veg%leafc0_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ileaf_st) = matrix_c13transfer_acc(1:nvegcpool,ileaf_st) / cs13_veg%leafc0_storage_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ileaf_xf) = matrix_c13transfer_acc(1:nvegcpool,ileaf_xf) / cs13_veg%leafc0_xfer_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ifroot) = matrix_c13transfer_acc(1:nvegcpool,ifroot) / cs13_veg%frootc0_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ifroot_st) = matrix_c13transfer_acc(1:nvegcpool,ifroot_st) / cs13_veg%frootc0_storage_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ifroot_xf) = matrix_c13transfer_acc(1:nvegcpool,ifroot_xf) / cs13_veg%frootc0_xfer_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ilivestem) = matrix_c13transfer_acc(1:nvegcpool,ilivestem) / cs13_veg%livestemc0_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ilivestem_st) = matrix_c13transfer_acc(1:nvegcpool,ilivestem_st) / cs13_veg%livestemc0_storage_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ilivestem_xf) = matrix_c13transfer_acc(1:nvegcpool,ilivestem_xf) / cs13_veg%livestemc0_xfer_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ideadstem) = matrix_c13transfer_acc(1:nvegcpool,ideadstem) / cs13_veg%deadstemc0_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ideadstem_st) = matrix_c13transfer_acc(1:nvegcpool,ideadstem_st) / cs13_veg%deadstemc0_storage_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ideadstem_xf) = matrix_c13transfer_acc(1:nvegcpool,ideadstem_xf) / cs13_veg%deadstemc0_xfer_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ilivecroot) = matrix_c13transfer_acc(1:nvegcpool,ilivecroot) / cs13_veg%livecrootc0_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ilivecroot_st) = matrix_c13transfer_acc(1:nvegcpool,ilivecroot_st) / cs13_veg%livecrootc0_storage_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ilivecroot_xf) = matrix_c13transfer_acc(1:nvegcpool,ilivecroot_xf) / cs13_veg%livecrootc0_xfer_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ideadcroot) = matrix_c13transfer_acc(1:nvegcpool,ideadcroot) / cs13_veg%deadcrootc0_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ideadcroot_st) = matrix_c13transfer_acc(1:nvegcpool,ideadcroot_st) / cs13_veg%deadcrootc0_storage_patch(p) - matrix_c13transfer_acc(1:nvegcpool,ideadcroot_xf) = matrix_c13transfer_acc(1:nvegcpool,ideadcroot_xf) / cs13_veg%deadcrootc0_xfer_patch(p) - if(ivt(p) >= npcropmin)then - matrix_c13transfer_acc(1:nvegcpool,igrain) = matrix_c13transfer_acc(1:nvegcpool,igrain) / cs13_veg%grainc0_patch(p) - matrix_c13transfer_acc(1:nvegcpool,igrain_st) = matrix_c13transfer_acc(1:nvegcpool,igrain_st) / cs13_veg%grainc0_storage_patch(p) - matrix_c13transfer_acc(1:nvegcpool,igrain_xf) = matrix_c13transfer_acc(1:nvegcpool,igrain_xf) / cs13_veg%grainc0_xfer_patch(p) - end if - end if - - if(use_c14)then - matrix_c14transfer_acc(1:nvegcpool,ileaf) = matrix_c14transfer_acc(1:nvegcpool,ileaf) / cs14_veg%leafc0_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ileaf_st) = matrix_c14transfer_acc(1:nvegcpool,ileaf_st) / cs14_veg%leafc0_storage_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ileaf_xf) = matrix_c14transfer_acc(1:nvegcpool,ileaf_xf) / cs14_veg%leafc0_xfer_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ifroot) = matrix_c14transfer_acc(1:nvegcpool,ifroot) / cs14_veg%frootc0_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ifroot_st) = matrix_c14transfer_acc(1:nvegcpool,ifroot_st) / cs14_veg%frootc0_storage_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ifroot_xf) = matrix_c14transfer_acc(1:nvegcpool,ifroot_xf) / cs14_veg%frootc0_xfer_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ilivestem) = matrix_c14transfer_acc(1:nvegcpool,ilivestem) / cs14_veg%livestemc0_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ilivestem_st) = matrix_c14transfer_acc(1:nvegcpool,ilivestem_st) / cs14_veg%livestemc0_storage_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ilivestem_xf) = matrix_c14transfer_acc(1:nvegcpool,ilivestem_xf) / cs14_veg%livestemc0_xfer_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ideadstem) = matrix_c14transfer_acc(1:nvegcpool,ideadstem) / cs14_veg%deadstemc0_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ideadstem_st) = matrix_c14transfer_acc(1:nvegcpool,ideadstem_st) / cs14_veg%deadstemc0_storage_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ideadstem_xf) = matrix_c14transfer_acc(1:nvegcpool,ideadstem_xf) / cs14_veg%deadstemc0_xfer_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ilivecroot) = matrix_c14transfer_acc(1:nvegcpool,ilivecroot) / cs14_veg%livecrootc0_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ilivecroot_st) = matrix_c14transfer_acc(1:nvegcpool,ilivecroot_st) / cs14_veg%livecrootc0_storage_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ilivecroot_xf) = matrix_c14transfer_acc(1:nvegcpool,ilivecroot_xf) / cs14_veg%livecrootc0_xfer_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ideadcroot) = matrix_c14transfer_acc(1:nvegcpool,ideadcroot) / cs14_veg%deadcrootc0_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ideadcroot_st) = matrix_c14transfer_acc(1:nvegcpool,ideadcroot_st) / cs14_veg%deadcrootc0_storage_patch(p) - matrix_c14transfer_acc(1:nvegcpool,ideadcroot_xf) = matrix_c14transfer_acc(1:nvegcpool,ideadcroot_xf) / cs14_veg%deadcrootc0_xfer_patch(p) - if(ivt(p) >= npcropmin)then - matrix_c14transfer_acc(1:nvegcpool,igrain) = matrix_c14transfer_acc(1:nvegcpool,igrain) / cs14_veg%grainc0_patch(p) - matrix_c14transfer_acc(1:nvegcpool,igrain_st) = matrix_c14transfer_acc(1:nvegcpool,igrain_st) / cs14_veg%grainc0_storage_patch(p) - matrix_c14transfer_acc(1:nvegcpool,igrain_xf) = matrix_c14transfer_acc(1:nvegcpool,igrain_xf) / cs14_veg%grainc0_xfer_patch(p) - end if - end if - - matrix_ntransfer_acc(1:nvegnpool,ileaf) = matrix_ntransfer_acc(1:nvegnpool,ileaf) / leafn0(p) - matrix_ntransfer_acc(1:nvegnpool,ileaf_st) = matrix_ntransfer_acc(1:nvegnpool,ileaf_st) / leafn0_storage(p) - matrix_ntransfer_acc(1:nvegnpool,ileaf_xf) = matrix_ntransfer_acc(1:nvegnpool,ileaf_xf) / leafn0_xfer(p) - matrix_ntransfer_acc(1:nvegnpool,ifroot) = matrix_ntransfer_acc(1:nvegnpool,ifroot) / frootn0(p) - matrix_ntransfer_acc(1:nvegnpool,ifroot_st) = matrix_ntransfer_acc(1:nvegnpool,ifroot_st) / frootn0_storage(p) - matrix_ntransfer_acc(1:nvegnpool,ifroot_xf) = matrix_ntransfer_acc(1:nvegnpool,ifroot_xf) / frootn0_xfer(p) - matrix_ntransfer_acc(1:nvegnpool,ilivestem) = matrix_ntransfer_acc(1:nvegnpool,ilivestem) / livestemn0(p) - matrix_ntransfer_acc(1:nvegnpool,ilivestem_st) = matrix_ntransfer_acc(1:nvegnpool,ilivestem_st) / livestemn0_storage(p) - matrix_ntransfer_acc(1:nvegnpool,ilivestem_xf) = matrix_ntransfer_acc(1:nvegnpool,ilivestem_xf) / livestemn0_xfer(p) - matrix_ntransfer_acc(1:nvegnpool,ideadstem) = matrix_ntransfer_acc(1:nvegnpool,ideadstem) / deadstemn0(p) - matrix_ntransfer_acc(1:nvegnpool,ideadstem_st) = matrix_ntransfer_acc(1:nvegnpool,ideadstem_st) / deadstemn0_storage(p) - matrix_ntransfer_acc(1:nvegnpool,ideadstem_xf) = matrix_ntransfer_acc(1:nvegnpool,ideadstem_xf) / deadstemn0_xfer(p) - matrix_ntransfer_acc(1:nvegnpool,ilivecroot) = matrix_ntransfer_acc(1:nvegnpool,ilivecroot) / livecrootn0(p) - matrix_ntransfer_acc(1:nvegnpool,ilivecroot_st) = matrix_ntransfer_acc(1:nvegnpool,ilivecroot_st) / livecrootn0_storage(p) - matrix_ntransfer_acc(1:nvegnpool,ilivecroot_xf) = matrix_ntransfer_acc(1:nvegnpool,ilivecroot_xf) / livecrootn0_xfer(p) - matrix_ntransfer_acc(1:nvegnpool,ideadcroot) = matrix_ntransfer_acc(1:nvegnpool,ideadcroot) / deadcrootn0(p) - matrix_ntransfer_acc(1:nvegnpool,ideadcroot_st) = matrix_ntransfer_acc(1:nvegnpool,ideadcroot_st) / deadcrootn0_storage(p) - matrix_ntransfer_acc(1:nvegnpool,ideadcroot_xf) = matrix_ntransfer_acc(1:nvegnpool,ideadcroot_xf) / deadcrootn0_xfer(p) - if(ivt(p) >= npcropmin)then - matrix_ntransfer_acc(1:nvegnpool,igrain) = matrix_ntransfer_acc(1:nvegnpool,igrain) / grainn0(p) - matrix_ntransfer_acc(1:nvegnpool,igrain_st) = matrix_ntransfer_acc(1:nvegnpool,igrain_st) / grainn0_storage(p) - matrix_ntransfer_acc(1:nvegnpool,igrain_xf) = matrix_ntransfer_acc(1:nvegnpool,igrain_xf) / grainn0_xfer(p) - end if - matrix_ntransfer_acc(1:nvegnpool,iretransn) = matrix_ntransfer_acc(1:nvegnpool,iretransn) / retransn0(p) - - call t_stopf('CN veg matrix-prepare AK^-1') - call t_startf('CN veg matrix-inv matrix operation') - - ! Calculate the residence time and C storage capacity - call inverse(matrix_ctransfer_acc(1:nvegcpool,1:nvegcpool),AKinvc(1:nvegcpool,1:nvegcpool),nvegcpool) - vegmatrixc_rt(:) = -matmul(AKinvc(1:nvegcpool,1:nvegcpool),matrix_calloc_acc(1:nvegcpool)) - - ! Calculate the residence time and C13 storage capacity - if(use_c13)then - call inverse(matrix_c13transfer_acc(1:nvegcpool,1:nvegcpool),AKinvc(1:nvegcpool,1:nvegcpool),nvegcpool) - vegmatrixc13_rt(:) = -matmul(AKinvc(1:nvegcpool,1:nvegcpool),matrix_c13alloc_acc(1:nvegcpool)) - end if - - ! Calculate the residence time and C14 storage capacity - if(use_c14)then - call inverse(matrix_c14transfer_acc(1:nvegcpool,1:nvegcpool),AKinvc(1:nvegcpool,1:nvegcpool),nvegcpool) - vegmatrixc14_rt(:) = -matmul(AKinvc(1:nvegcpool,1:nvegcpool),matrix_c14alloc_acc(1:nvegcpool)) - end if - - ! Calculate the residence time and N storage capacity - call inverse(matrix_ntransfer_acc(1:nvegnpool,1:nvegnpool),AKinvn(1:nvegnpool,1:nvegnpool),nvegnpool) - vegmatrixn_rt(:) = -matmul(AKinvn(1:nvegnpool,1:nvegnpool),matrix_nalloc_acc(1:nvegnpool)) - - do i=1,nvegcpool - if(vegmatrixc_rt(i) .lt. 0)vegmatrixc_rt(i) = epsi - end do - if(use_c13)then - do i=1,nvegcpool - if(vegmatrixc13_rt(i) .lt. 0)vegmatrixc13_rt(i) = epsi - end do - end if - if(use_c14)then - do i=1,nvegcpool - if(vegmatrixc14_rt(i) .lt. 0)vegmatrixc14_rt(i) = epsi - end do - end if - do i=1,nvegnpool - if(vegmatrixn_rt(i) .lt. 0)vegmatrixn_rt(i) = epsi - end do - - call t_stopf('CN veg matrix-inv matrix operation') - - call t_startf('CN veg matrix-finalize spinup') - - if(isspinup .and. .not. is_first_step_of_this_run_segment())then - deadstemc(p) = vegmatrixc_rt(ideadstem) - deadstemc_storage(p) = vegmatrixc_rt(ideadstem_st) - deadcrootc(p) = vegmatrixc_rt(ideadcroot) - deadcrootc_storage(p) = vegmatrixc_rt(ideadcroot_st) - if(use_c13)then - cs13_veg%deadstemc_patch(p) = vegmatrixc13_rt(ideadstem) - cs13_veg%deadstemc_storage_patch(p) = vegmatrixc13_rt(ideadstem_st) - cs13_veg%deadcrootc_patch(p) = vegmatrixc13_rt(ideadcroot) - cs13_veg%deadcrootc_storage_patch(p) = vegmatrixc13_rt(ideadcroot_st) - end if - if(use_c14)then - cs14_veg%deadstemc_patch(p) = vegmatrixc14_rt(ideadstem) - cs14_veg%deadstemc_storage_patch(p) = vegmatrixc14_rt(ideadstem_st) - cs14_veg%deadcrootc_patch(p) = vegmatrixc14_rt(ideadcroot) - cs14_veg%deadcrootc_storage_patch(p) = vegmatrixc14_rt(ideadcroot_st) - end if - deadstemn(p) = vegmatrixn_rt(ideadstem) - deadstemn_storage(p) = vegmatrixn_rt(ideadstem_st) - deadcrootn(p) = vegmatrixn_rt(ideadcroot) - deadcrootn_storage(p) = vegmatrixn_rt(ideadcroot_st) - - if(iloop .eq. iloop_avg)then - leafc_SASUsave(p) = leafc_SASUsave(p) + leafc(p) - leafc_storage_SASUsave(p) = leafc_storage_SASUsave(p) + leafc_storage(p) - leafc_xfer_SASUsave(p) = leafc_xfer_SASUsave(p) + leafc_xfer(p) - frootc_SASUsave(p) = frootc_SASUsave(p) + frootc(p) - frootc_storage_SASUsave(p) = frootc_storage_SASUsave(p) + frootc_storage(p) - frootc_xfer_SASUsave(p) = frootc_xfer_SASUsave(p) + frootc_xfer(p) - livestemc_SASUsave(p) = livestemc_SASUsave(p) + livestemc(p) - livestemc_storage_SASUsave(p) = livestemc_storage_SASUsave(p) + livestemc_storage(p) - livestemc_xfer_SASUsave(p) = livestemc_xfer_SASUsave(p) + livestemc_xfer(p) - deadstemc_SASUsave(p) = deadstemc_SASUsave(p) + deadstemc(p) - deadstemc_storage_SASUsave(p) = deadstemc_storage_SASUsave(p) + deadstemc_storage(p) - deadstemc_xfer_SASUsave(p) = deadstemc_xfer_SASUsave(p) + deadstemc_xfer(p) - livecrootc_SASUsave(p) = livecrootc_SASUsave(p) + livecrootc(p) - livecrootc_storage_SASUsave(p) = livecrootc_storage_SASUsave(p) + livecrootc_storage(p) - livecrootc_xfer_SASUsave(p) = livecrootc_xfer_SASUsave(p) + livecrootc_xfer(p) - deadcrootc_SASUsave(p) = deadcrootc_SASUsave(p) + deadcrootc(p) - deadcrootc_storage_SASUsave(p) = deadcrootc_storage_SASUsave(p) + deadcrootc_storage(p) - deadcrootc_xfer_SASUsave(p) = deadcrootc_xfer_SASUsave(p) + deadcrootc_xfer(p) - if(ivt(p) >= npcropmin)then - grainc_SASUsave(p) = grainc_SASUsave(p) + grainc(p) - grainc_storage_SASUsave(p) = grainc_storage_SASUsave(p) + grainc_storage(p) - end if - if(use_c13)then - cs13_veg%leafc_SASUsave_patch(p) = cs13_veg%leafc_SASUsave_patch(p) + cs13_veg%leafc_patch(p) - cs13_veg%leafc_storage_SASUsave_patch(p) = cs13_veg%leafc_storage_SASUsave_patch(p) + cs13_veg%leafc_storage_patch(p) - cs13_veg%leafc_xfer_SASUsave_patch(p) = cs13_veg%leafc_xfer_SASUsave_patch(p) + cs13_veg%leafc_xfer_patch(p) - cs13_veg%frootc_SASUsave_patch(p) = cs13_veg%frootc_SASUsave_patch(p) + cs13_veg%frootc_patch(p) - cs13_veg%frootc_storage_SASUsave_patch(p) = cs13_veg%frootc_storage_SASUsave_patch(p) + cs13_veg%frootc_storage_patch(p) - cs13_veg%frootc_xfer_SASUsave_patch(p) = cs13_veg%frootc_xfer_SASUsave_patch(p) + cs13_veg%frootc_xfer_patch(p) - cs13_veg%livestemc_SASUsave_patch(p) = cs13_veg%livestemc_SASUsave_patch(p) + cs13_veg%livestemc_patch(p) - cs13_veg%livestemc_storage_SASUsave_patch(p) = cs13_veg%livestemc_storage_SASUsave_patch(p) + cs13_veg%livestemc_storage_patch(p) - cs13_veg%livestemc_xfer_SASUsave_patch(p) = cs13_veg%livestemc_xfer_SASUsave_patch(p) + cs13_veg%livestemc_xfer_patch(p) - cs13_veg%deadstemc_SASUsave_patch(p) = cs13_veg%deadstemc_SASUsave_patch(p) + cs13_veg%deadstemc_patch(p) - cs13_veg%deadstemc_storage_SASUsave_patch(p) = cs13_veg%deadstemc_storage_SASUsave_patch(p) + cs13_veg%deadstemc_storage_patch(p) - cs13_veg%deadstemc_xfer_SASUsave_patch(p) = cs13_veg%deadstemc_xfer_SASUsave_patch(p) + cs13_veg%deadstemc_xfer_patch(p) - cs13_veg%livecrootc_SASUsave_patch(p) = cs13_veg%livecrootc_SASUsave_patch(p) + cs13_veg%livecrootc_patch(p) - cs13_veg%livecrootc_storage_SASUsave_patch(p) = cs13_veg%livecrootc_storage_SASUsave_patch(p) + cs13_veg%livecrootc_storage_patch(p) - cs13_veg%livecrootc_xfer_SASUsave_patch(p) = cs13_veg%livecrootc_xfer_SASUsave_patch(p) + cs13_veg%livecrootc_xfer_patch(p) - cs13_veg%deadcrootc_SASUsave_patch(p) = cs13_veg%deadcrootc_SASUsave_patch(p) + cs13_veg%deadcrootc_patch(p) - cs13_veg%deadcrootc_storage_SASUsave_patch(p) = cs13_veg%deadcrootc_storage_SASUsave_patch(p) + cs13_veg%deadcrootc_storage_patch(p) - cs13_veg%deadcrootc_xfer_SASUsave_patch(p) = cs13_veg%deadcrootc_xfer_SASUsave_patch(p) + cs13_veg%deadcrootc_xfer_patch(p) - if(ivt(p) >= npcropmin)then - cs13_veg%grainc_SASUsave_patch(p) = cs13_veg%grainc_SASUsave_patch(p) + cs13_veg%grainc_patch(p) - cs13_veg%grainc_storage_SASUsave_patch(p) = cs13_veg%grainc_storage_SASUsave_patch(p) + cs13_veg%grainc_storage_patch(p) - end if - end if - if(use_c14)then - cs14_veg%leafc_SASUsave_patch(p) = cs14_veg%leafc_SASUsave_patch(p) + cs14_veg%leafc_patch(p) - cs14_veg%leafc_storage_SASUsave_patch(p) = cs14_veg%leafc_storage_SASUsave_patch(p) + cs14_veg%leafc_storage_patch(p) - cs14_veg%leafc_xfer_SASUsave_patch(p) = cs14_veg%leafc_xfer_SASUsave_patch(p) + cs14_veg%leafc_xfer_patch(p) - cs14_veg%frootc_SASUsave_patch(p) = cs14_veg%frootc_SASUsave_patch(p) + cs14_veg%frootc_patch(p) - cs14_veg%frootc_storage_SASUsave_patch(p) = cs14_veg%frootc_storage_SASUsave_patch(p) + cs14_veg%frootc_storage_patch(p) - cs14_veg%frootc_xfer_SASUsave_patch(p) = cs14_veg%frootc_xfer_SASUsave_patch(p) + cs14_veg%frootc_xfer_patch(p) - cs14_veg%livestemc_SASUsave_patch(p) = cs14_veg%livestemc_SASUsave_patch(p) + cs14_veg%livestemc_patch(p) - cs14_veg%livestemc_storage_SASUsave_patch(p) = cs14_veg%livestemc_storage_SASUsave_patch(p) + cs14_veg%livestemc_storage_patch(p) - cs14_veg%livestemc_xfer_SASUsave_patch(p) = cs14_veg%livestemc_xfer_SASUsave_patch(p) + cs14_veg%livestemc_xfer_patch(p) - cs14_veg%deadstemc_SASUsave_patch(p) = cs14_veg%deadstemc_SASUsave_patch(p) + cs14_veg%deadstemc_patch(p) - cs14_veg%deadstemc_storage_SASUsave_patch(p) = cs14_veg%deadstemc_storage_SASUsave_patch(p) + cs14_veg%deadstemc_storage_patch(p) - cs14_veg%deadstemc_xfer_SASUsave_patch(p) = cs14_veg%deadstemc_xfer_SASUsave_patch(p) + cs14_veg%deadstemc_xfer_patch(p) - cs14_veg%livecrootc_SASUsave_patch(p) = cs14_veg%livecrootc_SASUsave_patch(p) + cs14_veg%livecrootc_patch(p) - cs14_veg%livecrootc_storage_SASUsave_patch(p) = cs14_veg%livecrootc_storage_SASUsave_patch(p) + cs14_veg%livecrootc_storage_patch(p) - cs14_veg%livecrootc_xfer_SASUsave_patch(p) = cs14_veg%livecrootc_xfer_SASUsave_patch(p) + cs14_veg%livecrootc_xfer_patch(p) - cs14_veg%deadcrootc_SASUsave_patch(p) = cs14_veg%deadcrootc_SASUsave_patch(p) + cs14_veg%deadcrootc_patch(p) - cs14_veg%deadcrootc_storage_SASUsave_patch(p) = cs14_veg%deadcrootc_storage_SASUsave_patch(p) + cs14_veg%deadcrootc_storage_patch(p) - cs14_veg%deadcrootc_xfer_SASUsave_patch(p) = cs14_veg%deadcrootc_xfer_SASUsave_patch(p) + cs14_veg%deadcrootc_xfer_patch(p) - if(ivt(p) >= npcropmin)then - cs14_veg%grainc_SASUsave_patch(p) = cs14_veg%grainc_SASUsave_patch(p) + cs14_veg%grainc_patch(p) - cs14_veg%grainc_storage_SASUsave_patch(p) = cs14_veg%grainc_storage_SASUsave_patch(p) + cs14_veg%grainc_storage_patch(p) - end if - end if - leafn_SASUsave(p) = leafn_SASUsave(p) + leafn(p) - leafn_storage_SASUsave(p) = leafn_storage_SASUsave(p) + leafn_storage(p) - leafn_xfer_SASUsave(p) = leafn_xfer_SASUsave(p) + leafn_xfer(p) - frootn_SASUsave(p) = frootn_SASUsave(p) + frootn(p) - frootn_storage_SASUsave(p) = frootn_storage_SASUsave(p) + frootn_storage(p) - frootn_xfer_SASUsave(p) = frootn_xfer_SASUsave(p) + frootn_xfer(p) - livestemn_SASUsave(p) = livestemn_SASUsave(p) + livestemn(p) - livestemn_storage_SASUsave(p) = livestemn_storage_SASUsave(p) + livestemn_storage(p) - livestemn_xfer_SASUsave(p) = livestemn_xfer_SASUsave(p) + livestemn_xfer(p) - deadstemn_SASUsave(p) = deadstemn_SASUsave(p) + deadstemn(p) - deadstemn_storage_SASUsave(p) = deadstemn_storage_SASUsave(p) + deadstemn_storage(p) - deadstemn_xfer_SASUsave(p) = deadstemn_xfer_SASUsave(p) + deadstemn_xfer(p) - livecrootn_SASUsave(p) = livecrootn_SASUsave(p) + livecrootn(p) - livecrootn_storage_SASUsave(p) = livecrootn_storage_SASUsave(p) + livecrootn_storage(p) - livecrootn_xfer_SASUsave(p) = livecrootn_xfer_SASUsave(p) + livecrootn_xfer(p) - deadcrootn_SASUsave(p) = deadcrootn_SASUsave(p) + deadcrootn(p) - deadcrootn_storage_SASUsave(p) = deadcrootn_storage_SASUsave(p) + deadcrootn_storage(p) - deadcrootn_xfer_SASUsave(p) = deadcrootn_xfer_SASUsave(p) + deadcrootn_xfer(p) - if(ivt(p) >= npcropmin)then - grainn_SASUsave(p) = grainn_SASUsave(p) + grainn(p) - end if - if(iyr .eq. nyr_forcing)then - leafc(p) = leafc_SASUsave(p) / (nyr_forcing/nyr_SASU) - leafc_storage(p) = leafc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - leafc_xfer(p) = leafc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - frootc(p) = frootc_SASUsave(p) / (nyr_forcing/nyr_SASU) - frootc_storage(p) = frootc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - frootc_xfer(p) = frootc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - livestemc(p) = livestemc_SASUsave(p) / (nyr_forcing/nyr_SASU) - livestemc_storage(p) = livestemc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - livestemc_xfer(p) = livestemc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadstemc(p) = deadstemc_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadstemc_storage(p) = deadstemc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadstemc_xfer(p) = deadstemc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - livecrootc(p) = livecrootc_SASUsave(p) / (nyr_forcing/nyr_SASU) - livecrootc_storage(p) = livecrootc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - livecrootc_xfer(p) = livecrootc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadcrootc(p) = deadcrootc_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadcrootc_storage(p) = deadcrootc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadcrootc_xfer(p) = deadcrootc_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - if(ivt(p) >= npcropmin)then - grainc(p) = grainc_SASUsave(p) / (nyr_forcing/nyr_SASU) - grainc_storage(p) = grainc_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - end if - if(use_c13)then - cs13_veg%leafc_patch(p) = cs13_veg%leafc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%leafc_storage_patch(p) = cs13_veg%leafc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%leafc_xfer_patch(p) = cs13_veg%leafc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%frootc_patch(p) = cs13_veg%frootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%frootc_storage_patch(p) = cs13_veg%frootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%frootc_xfer_patch(p) = cs13_veg%frootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%livestemc_patch(p) = cs13_veg%livestemc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%livestemc_storage_patch(p) = cs13_veg%livestemc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%livestemc_xfer_patch(p) = cs13_veg%livestemc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%deadstemc_patch(p) = cs13_veg%deadstemc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%deadstemc_storage_patch(p) = cs13_veg%deadstemc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%deadstemc_xfer_patch(p) = cs13_veg%deadstemc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%livecrootc_patch(p) = cs13_veg%livecrootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%livecrootc_storage_patch(p) = cs13_veg%livecrootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%livecrootc_xfer_patch(p) = cs13_veg%livecrootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%deadcrootc_patch(p) = cs13_veg%deadcrootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%deadcrootc_storage_patch(p) = cs13_veg%deadcrootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%deadcrootc_xfer_patch(p) = cs13_veg%deadcrootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - if(ivt(p) >= npcropmin)then - cs13_veg%grainc_patch(p) = cs13_veg%grainc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs13_veg%grainc_storage_patch(p) = cs13_veg%grainc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - end if - end if - if(use_c14)then - cs14_veg%leafc_patch(p) = cs14_veg%leafc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%leafc_storage_patch(p) = cs14_veg%leafc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%leafc_xfer_patch(p) = cs14_veg%leafc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%frootc_patch(p) = cs14_veg%frootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%frootc_storage_patch(p) = cs14_veg%frootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%frootc_xfer_patch(p) = cs14_veg%frootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%livestemc_patch(p) = cs14_veg%livestemc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%livestemc_storage_patch(p) = cs14_veg%livestemc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%livestemc_xfer_patch(p) = cs14_veg%livestemc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%deadstemc_patch(p) = cs14_veg%deadstemc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%deadstemc_storage_patch(p) = cs14_veg%deadstemc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%deadstemc_xfer_patch(p) = cs14_veg%deadstemc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%livecrootc_patch(p) = cs14_veg%livecrootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%livecrootc_storage_patch(p) = cs14_veg%livecrootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%livecrootc_xfer_patch(p) = cs14_veg%livecrootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%deadcrootc_patch(p) = cs14_veg%deadcrootc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%deadcrootc_storage_patch(p) = cs14_veg%deadcrootc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%deadcrootc_xfer_patch(p) = cs14_veg%deadcrootc_xfer_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - if(ivt(p) >= npcropmin)then - cs14_veg%grainc_patch(p) = cs14_veg%grainc_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - cs14_veg%grainc_storage_patch(p) = cs14_veg%grainc_storage_SASUsave_patch(p) / (nyr_forcing/nyr_SASU) - end if - end if - leafn(p) = leafn_SASUsave(p) / (nyr_forcing/nyr_SASU) - leafn_storage(p) = leafn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - leafn_xfer(p) = leafn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - frootn(p) = frootn_SASUsave(p) / (nyr_forcing/nyr_SASU) - frootn_storage(p) = frootn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - frootn_xfer(p) = frootn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - livestemn(p) = livestemn_SASUsave(p) / (nyr_forcing/nyr_SASU) - livestemn_storage(p) = livestemn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - livestemn_xfer(p) = livestemn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadstemn(p) = deadstemn_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadstemn_storage(p) = deadstemn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadstemn_xfer(p) = deadstemn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - livecrootn(p) = livecrootn_SASUsave(p) / (nyr_forcing/nyr_SASU) - livecrootn_storage(p) = livecrootn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - livecrootn_xfer(p) = livecrootn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadcrootn(p) = deadcrootn_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadcrootn_storage(p) = deadcrootn_storage_SASUsave(p) / (nyr_forcing/nyr_SASU) - deadcrootn_xfer(p) = deadcrootn_xfer_SASUsave(p) / (nyr_forcing/nyr_SASU) - if(ivt(p) >= npcropmin)then - grainn(p) = grainn_SASUsave(p) / (nyr_forcing/nyr_SASU) - end if - leafc_SASUsave(p) = 0 - leafc_storage_SASUsave(p) = 0 - leafc_xfer_SASUsave(p) = 0 - frootc_SASUsave(p) = 0 - frootc_storage_SASUsave(p) = 0 - frootc_xfer_SASUsave(p) = 0 - livestemc_SASUsave(p) = 0 - livestemc_storage_SASUsave(p) = 0 - livestemc_xfer_SASUsave(p) = 0 - deadstemc_SASUsave(p) = 0 - deadstemc_storage_SASUsave(p) = 0 - deadstemc_xfer_SASUsave(p) = 0 - livecrootc_SASUsave(p) = 0 - livecrootc_storage_SASUsave(p) = 0 - livecrootc_xfer_SASUsave(p) = 0 - deadcrootc_SASUsave(p) = 0 - deadcrootc_storage_SASUsave(p) = 0 - deadcrootc_xfer_SASUsave(p) = 0 - if(ivt(p) >= npcropmin)then - grainc_SASUsave(p) = 0 - grainc_storage_SASUsave(p) = 0 - end if - if(use_c13)then - cs13_veg%leafc_SASUsave_patch(p) = 0 - cs13_veg%leafc_storage_SASUsave_patch(p) = 0 - cs13_veg%leafc_xfer_SASUsave_patch(p) = 0 - cs13_veg%frootc_SASUsave_patch(p) = 0 - cs13_veg%frootc_storage_SASUsave_patch(p) = 0 - cs13_veg%frootc_xfer_SASUsave_patch(p) = 0 - cs13_veg%livestemc_SASUsave_patch(p) = 0 - cs13_veg%livestemc_storage_SASUsave_patch(p) = 0 - cs13_veg%livestemc_xfer_SASUsave_patch(p) = 0 - cs13_veg%deadstemc_SASUsave_patch(p) = 0 - cs13_veg%deadstemc_storage_SASUsave_patch(p) = 0 - cs13_veg%deadstemc_xfer_SASUsave_patch(p) = 0 - cs13_veg%livecrootc_SASUsave_patch(p) = 0 - cs13_veg%livecrootc_storage_SASUsave_patch(p) = 0 - cs13_veg%livecrootc_xfer_SASUsave_patch(p) = 0 - cs13_veg%deadcrootc_SASUsave_patch(p) = 0 - cs13_veg%deadcrootc_storage_SASUsave_patch(p) = 0 - cs13_veg%deadcrootc_xfer_SASUsave_patch(p) = 0 - if(ivt(p) >= npcropmin)then - cs13_veg%grainc_SASUsave_patch(p) = 0 - cs13_veg%grainc_storage_SASUsave_patch(p) = 0 - end if - end if - if(use_c14)then - cs14_veg%leafc_SASUsave_patch(p) = 0 - cs14_veg%leafc_storage_SASUsave_patch(p) = 0 - cs14_veg%leafc_xfer_SASUsave_patch(p) = 0 - cs14_veg%frootc_SASUsave_patch(p) = 0 - cs14_veg%frootc_storage_SASUsave_patch(p) = 0 - cs14_veg%frootc_xfer_SASUsave_patch(p) = 0 - cs14_veg%livestemc_SASUsave_patch(p) = 0 - cs14_veg%livestemc_storage_SASUsave_patch(p) = 0 - cs14_veg%livestemc_xfer_SASUsave_patch(p) = 0 - cs14_veg%deadstemc_SASUsave_patch(p) = 0 - cs14_veg%deadstemc_storage_SASUsave_patch(p) = 0 - cs14_veg%deadstemc_xfer_SASUsave_patch(p) = 0 - cs14_veg%livecrootc_SASUsave_patch(p) = 0 - cs14_veg%livecrootc_storage_SASUsave_patch(p) = 0 - cs14_veg%livecrootc_xfer_SASUsave_patch(p) = 0 - cs14_veg%deadcrootc_SASUsave_patch(p) = 0 - cs14_veg%deadcrootc_storage_SASUsave_patch(p) = 0 - cs14_veg%deadcrootc_xfer_SASUsave_patch(p) = 0 - if(ivt(p) >= npcropmin)then - cs14_veg%grainc_SASUsave_patch(p) = 0 - cs14_veg%grainc_storage_SASUsave_patch(p) = 0 - end if - end if - leafn_SASUsave(p) = 0 - leafn_storage_SASUsave(p) = 0 - leafn_xfer_SASUsave(p) = 0 - frootn_SASUsave(p) = 0 - frootn_storage_SASUsave(p) = 0 - frootn_xfer_SASUsave(p) = 0 - livestemn_SASUsave(p) = 0 - livestemn_storage_SASUsave(p) = 0 - livestemn_xfer_SASUsave(p) = 0 - deadstemn_SASUsave(p) = 0 - deadstemn_storage_SASUsave(p) = 0 - deadstemn_xfer_SASUsave(p) = 0 - livecrootn_SASUsave(p) = 0 - livecrootn_storage_SASUsave(p) = 0 - livecrootn_xfer_SASUsave(p) = 0 - deadcrootn_SASUsave(p) = 0 - deadcrootn_storage_SASUsave(p) = 0 - deadcrootn_xfer_SASUsave(p) = 0 - if(ivt(p) >= npcropmin)then - grainn_SASUsave(p) = 0 - end if - end if - end if - call update_DA_nstep() - end if - - ! Save C storage capacity from temporary variables to module variables - if(is_outmatrix)then - matrix_cap_leafc(p) = vegmatrixc_rt(ileaf) - matrix_cap_leafc_storage(p) = vegmatrixc_rt(ileaf_st) - matrix_cap_leafc_xfer(p) = vegmatrixc_rt(ileaf_xf) - matrix_cap_frootc(p) = vegmatrixc_rt(ifroot) - matrix_cap_frootc_storage(p) = vegmatrixc_rt(ifroot_st) - matrix_cap_frootc_xfer(p) = vegmatrixc_rt(ifroot_xf) - matrix_cap_livestemc(p) = vegmatrixc_rt(ilivestem) - matrix_cap_livestemc_storage(p) = vegmatrixc_rt(ilivestem_st) - matrix_cap_livestemc_xfer(p) = vegmatrixc_rt(ilivestem_xf) - matrix_cap_deadstemc(p) = vegmatrixc_rt(ideadstem) - matrix_cap_deadstemc_storage(p) = vegmatrixc_rt(ideadstem_st) - matrix_cap_deadstemc_xfer(p) = vegmatrixc_rt(ideadstem_xf) - matrix_cap_livecrootc(p) = vegmatrixc_rt(ilivecroot) - matrix_cap_livecrootc_storage(p) = vegmatrixc_rt(ilivecroot_st) - matrix_cap_livecrootc_xfer(p) = vegmatrixc_rt(ilivecroot_xf) - matrix_cap_deadcrootc(p) = vegmatrixc_rt(ideadcroot) - matrix_cap_deadcrootc_storage(p) = vegmatrixc_rt(ideadcroot_st) - matrix_cap_deadcrootc_xfer(p) = vegmatrixc_rt(ideadcroot_xf) - if(ivt(p) >= npcropmin)then - matrix_cap_grainc(p) = vegmatrixc_rt(igrain) - matrix_cap_grainc_storage(p) = vegmatrixc_rt(igrain_st) - matrix_cap_grainc_xfer(p) = vegmatrixc_rt(igrain_xf) - end if - if(use_c13)then - cs13_veg%matrix_cap_leafc_patch(p) = vegmatrixc13_rt(ileaf) - cs13_veg%matrix_cap_leafc_storage_patch(p) = vegmatrixc13_rt(ileaf_st) - cs13_veg%matrix_cap_leafc_xfer_patch(p) = vegmatrixc13_rt(ileaf_xf) - cs13_veg%matrix_cap_frootc_patch(p) = vegmatrixc13_rt(ifroot) - cs13_veg%matrix_cap_frootc_storage_patch(p) = vegmatrixc13_rt(ifroot_st) - cs13_veg%matrix_cap_frootc_xfer_patch(p) = vegmatrixc13_rt(ifroot_xf) - cs13_veg%matrix_cap_livestemc_patch(p) = vegmatrixc13_rt(ilivestem) - cs13_veg%matrix_cap_livestemc_storage_patch(p) = vegmatrixc13_rt(ilivestem_st) - cs13_veg%matrix_cap_livestemc_xfer_patch(p) = vegmatrixc13_rt(ilivestem_xf) - cs13_veg%matrix_cap_deadstemc_patch(p) = vegmatrixc13_rt(ideadstem) - cs13_veg%matrix_cap_deadstemc_storage_patch(p) = vegmatrixc13_rt(ideadstem_st) - cs13_veg%matrix_cap_deadstemc_xfer_patch(p) = vegmatrixc13_rt(ideadstem_xf) - cs13_veg%matrix_cap_livecrootc_patch(p) = vegmatrixc13_rt(ilivecroot) - cs13_veg%matrix_cap_livecrootc_storage_patch(p) = vegmatrixc13_rt(ilivecroot_st) - cs13_veg%matrix_cap_livecrootc_xfer_patch(p) = vegmatrixc13_rt(ilivecroot_xf) - cs13_veg%matrix_cap_deadcrootc_patch(p) = vegmatrixc13_rt(ideadcroot) - cs13_veg%matrix_cap_deadcrootc_storage_patch(p) = vegmatrixc13_rt(ideadcroot_st) - cs13_veg%matrix_cap_deadcrootc_xfer_patch(p) = vegmatrixc13_rt(ideadcroot_xf) - if(ivt(p) >= npcropmin)then - cs13_veg%matrix_cap_grainc_patch(p) = vegmatrixc13_rt(igrain) - cs13_veg%matrix_cap_grainc_storage_patch(p) = vegmatrixc13_rt(igrain_st) - cs13_veg%matrix_cap_grainc_xfer_patch(p) = vegmatrixc13_rt(igrain_xf) - end if - end if - if(use_c14)then - cs14_veg%matrix_cap_leafc_patch(p) = vegmatrixc14_rt(ileaf) - cs14_veg%matrix_cap_leafc_storage_patch(p) = vegmatrixc14_rt(ileaf_st) - cs14_veg%matrix_cap_leafc_xfer_patch(p) = vegmatrixc14_rt(ileaf_xf) - cs14_veg%matrix_cap_frootc_patch(p) = vegmatrixc14_rt(ifroot) - cs14_veg%matrix_cap_frootc_storage_patch(p) = vegmatrixc14_rt(ifroot_st) - cs14_veg%matrix_cap_frootc_xfer_patch(p) = vegmatrixc14_rt(ifroot_xf) - cs14_veg%matrix_cap_livestemc_patch(p) = vegmatrixc14_rt(ilivestem) - cs14_veg%matrix_cap_livestemc_storage_patch(p) = vegmatrixc14_rt(ilivestem_st) - cs14_veg%matrix_cap_livestemc_xfer_patch(p) = vegmatrixc14_rt(ilivestem_xf) - cs14_veg%matrix_cap_deadstemc_patch(p) = vegmatrixc14_rt(ideadstem) - cs14_veg%matrix_cap_deadstemc_storage_patch(p) = vegmatrixc14_rt(ideadstem_st) - cs14_veg%matrix_cap_deadstemc_xfer_patch(p) = vegmatrixc14_rt(ideadstem_xf) - cs14_veg%matrix_cap_livecrootc_patch(p) = vegmatrixc14_rt(ilivecroot) - cs14_veg%matrix_cap_livecrootc_storage_patch(p) = vegmatrixc14_rt(ilivecroot_st) - cs14_veg%matrix_cap_livecrootc_xfer_patch(p) = vegmatrixc14_rt(ilivecroot_xf) - cs14_veg%matrix_cap_deadcrootc_patch(p) = vegmatrixc14_rt(ideadcroot) - cs14_veg%matrix_cap_deadcrootc_storage_patch(p) = vegmatrixc14_rt(ideadcroot_st) - cs14_veg%matrix_cap_deadcrootc_xfer_patch(p) = vegmatrixc14_rt(ideadcroot_xf) - if(ivt(p) >= npcropmin)then - cs14_veg%matrix_cap_grainc_patch(p) = vegmatrixc14_rt(igrain) - cs14_veg%matrix_cap_grainc_storage_patch(p) = vegmatrixc14_rt(igrain_st) - cs14_veg%matrix_cap_grainc_xfer_patch(p) = vegmatrixc14_rt(igrain_xf) - end if - end if - matrix_cap_leafn(p) = vegmatrixn_rt(ileaf) - matrix_cap_leafn_storage(p) = vegmatrixn_rt(ileaf_st) - matrix_cap_leafn_xfer(p) = vegmatrixn_rt(ileaf_xf) - matrix_cap_frootn(p) = vegmatrixn_rt(ifroot) - matrix_cap_frootn_storage(p) = vegmatrixn_rt(ifroot_st) - matrix_cap_frootn_xfer(p) = vegmatrixn_rt(ifroot_xf) - matrix_cap_livestemn(p) = vegmatrixn_rt(ilivestem) - matrix_cap_livestemn_storage(p) = vegmatrixn_rt(ilivestem_st) - matrix_cap_livestemn_xfer(p) = vegmatrixn_rt(ilivestem_xf) - matrix_cap_deadstemn(p) = vegmatrixn_rt(ideadstem) - matrix_cap_deadstemn_storage(p) = vegmatrixn_rt(ideadstem_st) - matrix_cap_deadstemn_xfer(p) = vegmatrixn_rt(ideadstem_xf) - matrix_cap_livecrootn(p) = vegmatrixn_rt(ilivecroot) - matrix_cap_livecrootn_storage(p) = vegmatrixn_rt(ilivecroot_st) - matrix_cap_livecrootn_xfer(p) = vegmatrixn_rt(ilivecroot_xf) - matrix_cap_deadcrootn(p) = vegmatrixn_rt(ideadcroot) - matrix_cap_deadcrootn_storage(p) = vegmatrixn_rt(ideadcroot_st) - if(ivt(p) >= npcropmin)then - matrix_cap_grainn(p) = vegmatrixn_rt(igrain) - matrix_cap_grainn_storage(p) = vegmatrixn_rt(igrain_st) - matrix_cap_grainn_xfer(p) = vegmatrixn_rt(igrain_xf) - end if - end if - - ! Reset accumulated variables to 0 at end of each year after calculating capacity - matrix_calloc_leaf_acc(p) = 0._r8 - matrix_calloc_leafst_acc(p) = 0._r8 - matrix_calloc_froot_acc(p) = 0._r8 - matrix_calloc_frootst_acc(p) = 0._r8 - matrix_calloc_livestem_acc(p) = 0._r8 - matrix_calloc_livestemst_acc(p) = 0._r8 - matrix_calloc_deadstem_acc(p) = 0._r8 - matrix_calloc_deadstemst_acc(p) = 0._r8 - matrix_calloc_livecroot_acc(p) = 0._r8 - matrix_calloc_livecrootst_acc(p) = 0._r8 - matrix_calloc_deadcroot_acc(p) = 0._r8 - matrix_calloc_deadcrootst_acc(p) = 0._r8 - if(ivt(p) >= npcropmin)then - matrix_calloc_grain_acc(p) = 0._r8 - matrix_calloc_grainst_acc(p) = 0._r8 - end if - - matrix_ctransfer_leafst_to_leafxf_acc(p) = 0._r8 - matrix_ctransfer_leafxf_to_leaf_acc(p) = 0._r8 - matrix_ctransfer_frootst_to_frootxf_acc(p) = 0._r8 - matrix_ctransfer_frootxf_to_froot_acc(p) = 0._r8 - matrix_ctransfer_livestemst_to_livestemxf_acc(p) = 0._r8 - matrix_ctransfer_livestemxf_to_livestem_acc(p) = 0._r8 - matrix_ctransfer_deadstemst_to_deadstemxf_acc(p) = 0._r8 - matrix_ctransfer_deadstemxf_to_deadstem_acc(p) = 0._r8 - matrix_ctransfer_livecrootst_to_livecrootxf_acc(p) = 0._r8 - matrix_ctransfer_livecrootxf_to_livecroot_acc(p) = 0._r8 - matrix_ctransfer_deadcrootst_to_deadcrootxf_acc(p) = 0._r8 - matrix_ctransfer_deadcrootxf_to_deadcroot_acc(p) = 0._r8 - if(ivt(p) >= npcropmin)then - matrix_ctransfer_grainst_to_grainxf_acc(p) = 0._r8 - matrix_ctransfer_grainxf_to_grain_acc(p) = 0._r8 - end if - matrix_ctransfer_livestem_to_deadstem_acc(p) = 0._r8 - matrix_ctransfer_livecroot_to_deadcroot_acc(p) = 0._r8 - - matrix_cturnover_leaf_acc(p) = 0._r8 - matrix_cturnover_leafst_acc(p) = 0._r8 - matrix_cturnover_leafxf_acc(p) = 0._r8 - matrix_cturnover_froot_acc(p) = 0._r8 - matrix_cturnover_frootst_acc(p) = 0._r8 - matrix_cturnover_frootxf_acc(p) = 0._r8 - matrix_cturnover_livestem_acc(p) = 0._r8 - matrix_cturnover_livestemst_acc(p) = 0._r8 - matrix_cturnover_livestemxf_acc(p) = 0._r8 - matrix_cturnover_deadstem_acc(p) = 0._r8 - matrix_cturnover_deadstemst_acc(p) = 0._r8 - matrix_cturnover_deadstemxf_acc(p) = 0._r8 - matrix_cturnover_livecroot_acc(p) = 0._r8 - matrix_cturnover_livecrootst_acc(p) = 0._r8 - matrix_cturnover_livecrootxf_acc(p) = 0._r8 - matrix_cturnover_deadcroot_acc(p) = 0._r8 - matrix_cturnover_deadcrootst_acc(p) = 0._r8 - matrix_cturnover_deadcrootxf_acc(p) = 0._r8 - if(ivt(p) >= npcropmin)then - matrix_cturnover_grain_acc(p) = 0._r8 - matrix_cturnover_grainst_acc(p) = 0._r8 - matrix_cturnover_grainxf_acc(p) = 0._r8 - end if - - if(use_c13)then - cs13_veg%matrix_calloc_leaf_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_leafst_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_froot_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_frootst_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_livestem_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_livestemst_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_deadstem_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_deadstemst_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_livecroot_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_livecrootst_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_deadcroot_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_deadcrootst_acc_patch(p) = 0._r8 - if(ivt(p) >= npcropmin)then - cs13_veg%matrix_calloc_grain_acc_patch(p) = 0._r8 - cs13_veg%matrix_calloc_grainst_acc_patch(p) = 0._r8 - end if - - cs13_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) = 0._r8 - if(ivt(p) >= npcropmin)then - cs13_veg%matrix_ctransfer_grainst_to_grainxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_grainxf_to_grain_acc_patch(p) = 0._r8 - end if - cs13_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) = 0._r8 - cs13_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) = 0._r8 - - cs13_veg%matrix_cturnover_leaf_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_leafst_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_leafxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_froot_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_frootst_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_frootxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_livestem_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_livestemst_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_livestemxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_deadstem_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_deadstemst_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_deadstemxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_livecroot_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_livecrootst_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_livecrootxf_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_deadcroot_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_deadcrootst_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_deadcrootxf_acc_patch(p) = 0._r8 - if(ivt(p) >= npcropmin)then - cs13_veg%matrix_cturnover_grain_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_grainst_acc_patch(p) = 0._r8 - cs13_veg%matrix_cturnover_grainxf_acc_patch(p) = 0._r8 - end if - end if - - if(use_c14)then - cs14_veg%matrix_calloc_leaf_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_leafst_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_froot_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_frootst_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_livestem_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_livestemst_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_deadstem_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_deadstemst_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_livecroot_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_livecrootst_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_deadcroot_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_deadcrootst_acc_patch(p) = 0._r8 - if(ivt(p) >= npcropmin)then - cs14_veg%matrix_calloc_grain_acc_patch(p) = 0._r8 - cs14_veg%matrix_calloc_grainst_acc_patch(p) = 0._r8 - end if - - cs14_veg%matrix_ctransfer_leafst_to_leafxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_leafxf_to_leaf_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_frootst_to_frootxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_frootxf_to_froot_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_livestemst_to_livestemxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_livestemxf_to_livestem_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_deadstemst_to_deadstemxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_deadstemxf_to_deadstem_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_livecrootst_to_livecrootxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_livecrootxf_to_livecroot_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_deadcrootst_to_deadcrootxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_deadcrootxf_to_deadcroot_acc_patch(p) = 0._r8 - if(ivt(p) >= npcropmin)then - cs14_veg%matrix_ctransfer_grainst_to_grainxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_grainxf_to_grain_acc_patch(p) = 0._r8 - end if - cs14_veg%matrix_ctransfer_livestem_to_deadstem_acc_patch(p) = 0._r8 - cs14_veg%matrix_ctransfer_livecroot_to_deadcroot_acc_patch(p) = 0._r8 - - cs14_veg%matrix_cturnover_leaf_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_leafst_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_leafxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_froot_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_frootst_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_frootxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_livestem_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_livestemst_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_livestemxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_deadstem_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_deadstemst_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_deadstemxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_livecroot_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_livecrootst_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_livecrootxf_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_deadcroot_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_deadcrootst_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_deadcrootxf_acc_patch(p) = 0._r8 - if(ivt(p) >= npcropmin)then - cs14_veg%matrix_cturnover_grain_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_grainst_acc_patch(p) = 0._r8 - cs14_veg%matrix_cturnover_grainxf_acc_patch(p) = 0._r8 - end if - end if - - matrix_nalloc_leaf_acc(p) = 0._r8 - matrix_nalloc_leafst_acc(p) = 0._r8 - matrix_nalloc_froot_acc(p) = 0._r8 - matrix_nalloc_frootst_acc(p) = 0._r8 - matrix_nalloc_livestem_acc(p) = 0._r8 - matrix_nalloc_livestemst_acc(p) = 0._r8 - matrix_nalloc_deadstem_acc(p) = 0._r8 - matrix_nalloc_deadstemst_acc(p) = 0._r8 - matrix_nalloc_livecroot_acc(p) = 0._r8 - matrix_nalloc_livecrootst_acc(p) = 0._r8 - matrix_nalloc_deadcroot_acc(p) = 0._r8 - matrix_nalloc_deadcrootst_acc(p) = 0._r8 - if(ivt(p) >= npcropmin)then - matrix_nalloc_grain_acc(p) = 0._r8 - matrix_nalloc_grainst_acc(p) = 0._r8 - end if - - matrix_ntransfer_leafst_to_leafxf_acc(p) = 0._r8 - matrix_ntransfer_leafxf_to_leaf_acc(p) = 0._r8 - matrix_ntransfer_frootst_to_frootxf_acc(p) = 0._r8 - matrix_ntransfer_frootxf_to_froot_acc(p) = 0._r8 - matrix_ntransfer_livestemst_to_livestemxf_acc(p) = 0._r8 - matrix_ntransfer_livestemxf_to_livestem_acc(p) = 0._r8 - matrix_ntransfer_deadstemst_to_deadstemxf_acc(p) = 0._r8 - matrix_ntransfer_deadstemxf_to_deadstem_acc(p) = 0._r8 - matrix_ntransfer_livecrootst_to_livecrootxf_acc(p) = 0._r8 - matrix_ntransfer_livecrootxf_to_livecroot_acc(p) = 0._r8 - matrix_ntransfer_deadcrootst_to_deadcrootxf_acc(p) = 0._r8 - matrix_ntransfer_deadcrootxf_to_deadcroot_acc(p) = 0._r8 - if(ivt(p) >= npcropmin)then - matrix_ntransfer_grainst_to_grainxf_acc(p) = 0._r8 - matrix_ntransfer_grainxf_to_grain_acc(p) = 0._r8 - end if - matrix_ntransfer_livestem_to_deadstem_acc(p) = 0._r8 - matrix_ntransfer_livecroot_to_deadcroot_acc(p) = 0._r8 - - matrix_ntransfer_retransn_to_leaf_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_leafst_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_froot_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_frootst_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_livestem_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_livestemst_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_deadstem_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_deadstemst_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_livecroot_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_livecrootst_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_deadcroot_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_deadcrootst_acc(p) = 0._r8 - if(ivt(p) >= npcropmin)then - matrix_ntransfer_retransn_to_grain_acc(p) = 0._r8 - matrix_ntransfer_retransn_to_grainst_acc(p) = 0._r8 - end if - matrix_ntransfer_leaf_to_retransn_acc(p) = 0._r8 - matrix_ntransfer_froot_to_retransn_acc(p) = 0._r8 - matrix_ntransfer_livestem_to_retransn_acc(p) = 0._r8 - matrix_ntransfer_livecroot_to_retransn_acc(p) = 0._r8 - - matrix_nturnover_leaf_acc(p) = 0._r8 - matrix_nturnover_leafst_acc(p) = 0._r8 - matrix_nturnover_leafxf_acc(p) = 0._r8 - matrix_nturnover_froot_acc(p) = 0._r8 - matrix_nturnover_frootst_acc(p) = 0._r8 - matrix_nturnover_frootxf_acc(p) = 0._r8 - matrix_nturnover_livestem_acc(p) = 0._r8 - matrix_nturnover_livestemst_acc(p) = 0._r8 - matrix_nturnover_livestemxf_acc(p) = 0._r8 - matrix_nturnover_deadstem_acc(p) = 0._r8 - matrix_nturnover_deadstemst_acc(p) = 0._r8 - matrix_nturnover_deadstemxf_acc(p) = 0._r8 - matrix_nturnover_livecroot_acc(p) = 0._r8 - matrix_nturnover_livecrootst_acc(p) = 0._r8 - matrix_nturnover_livecrootxf_acc(p) = 0._r8 - matrix_nturnover_deadcroot_acc(p) = 0._r8 - matrix_nturnover_deadcrootst_acc(p) = 0._r8 - matrix_nturnover_deadcrootxf_acc(p) = 0._r8 - if(ivt(p) >= npcropmin)then - matrix_nturnover_grain_acc(p) = 0._r8 - matrix_nturnover_grainst_acc(p) = 0._r8 - matrix_nturnover_grainxf_acc(p) = 0._r8 - end if - matrix_nturnover_retransn_acc(p) = 0._r8 - matrix_calloc_acc(:) = 0._r8 - matrix_ctransfer_acc(:,:) = 0._r8 - matrix_nalloc_acc(:) = 0._r8 - matrix_ntransfer_acc(:,:) = 0._r8 - - call t_stopf('CN veg matrix-finalize spinup') - end do - if(iloop .eq. iloop_avg .and. iyr .eq. nyr_forcing)iloop = 0 - if(iyr .eq. nyr_forcing)iyr=0 - end if - end if - - call vegmatrixc_input%ReleaseV() - if ( use_c13 )then - call vegmatrixc13_input%ReleaseV() - end if - if ( use_c14 )then - call vegmatrixc14_input%ReleaseV() - end if - call vegmatrixn_input%ReleaseV() - - end associate td - end associate sd - end associate od - end associate fr - end subroutine CNVegMatrix - - function matrix_update_phc(p,itransfer,rate,dt,cnveg_carbonflux_inst,matrixcheck,acc) - - integer ,intent(in) :: p - integer ,intent(in) :: itransfer - real(r8),intent(in) :: rate - real(r8),intent(in) :: dt - type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst - logical ,intent(in),optional :: matrixcheck - logical ,intent(in),optional :: acc - real(r8) :: matrix_update_phc - - associate( & - matrix_phtransfer => cnveg_carbonflux_inst%matrix_phtransfer_patch , & - matrix_phturnover => cnveg_carbonflux_inst%matrix_phturnover_patch , & - doner_phc => cnveg_carbonflux_inst%matrix_phtransfer_doner_patch& - ) - if(.not. present(matrixcheck) .or. matrixcheck)then - if((.not. present(acc) .or. acc) .and. matrix_phturnover(p,doner_phc(itransfer)) + rate * dt .ge. 1)then - matrix_update_phc = max(0._r8,(1._r8 - matrix_phturnover(p,doner_phc(itransfer))) / dt) - else - matrix_update_phc = rate - end if - else - matrix_update_phc = rate - end if - if(.not. present(acc) .or. acc)then - matrix_phturnover(p,doner_phc(itransfer)) = matrix_phturnover(p,doner_phc(itransfer)) + matrix_update_phc * dt - matrix_phtransfer(p,itransfer) = matrix_phtransfer(p,itransfer) + matrix_update_phc - else - matrix_phturnover(p,doner_phc(itransfer)) = matrix_phturnover(p,doner_phc(itransfer)) - matrix_phtransfer(p,itransfer) * dt + matrix_update_phc * dt - matrix_phtransfer(p,itransfer) = matrix_update_phc - end if - - return - end associate - - end function matrix_update_phc - - function matrix_update_gmc(p,itransfer,rate,dt,cnveg_carbonflux_inst,matrixcheck,acc) - - integer,intent(in) :: p - integer,intent(in) :: itransfer - real(r8),intent(in) :: rate - real(r8),intent(in) :: dt - type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst - logical ,intent(in),optional :: matrixcheck - logical ,intent(in),optional :: acc - real(r8) :: matrix_update_gmc - - associate( & - matrix_phturnover => cnveg_carbonflux_inst%matrix_phturnover_patch , & - matrix_gmtransfer => cnveg_carbonflux_inst%matrix_gmtransfer_patch , & - matrix_gmturnover => cnveg_carbonflux_inst%matrix_gmturnover_patch , & - doner_gmc => cnveg_carbonflux_inst%matrix_gmtransfer_doner_patch & ! Input: [integer (:)] Doners of gap mortality related C transfer - ) - - if(.not. present(matrixcheck) .or. matrixcheck)then - if((.not. present(acc) .or. acc) .and. matrix_phturnover(p,doner_gmc(itransfer)) + matrix_gmturnover(p,doner_gmc(itransfer)) + rate * dt .ge. 1)then - matrix_update_gmc = max(0._r8,(1._r8 - matrix_phturnover(p,doner_gmc(itransfer)) - matrix_gmturnover(p,doner_gmc(itransfer))) / dt) - else - matrix_update_gmc = rate - end if - else - matrix_update_gmc = rate - end if - if(.not. present(acc) .or. acc)then - matrix_gmturnover(p,doner_gmc(itransfer)) = matrix_gmturnover(p,doner_gmc(itransfer)) + matrix_update_gmc * dt - matrix_gmtransfer(p,itransfer) = matrix_gmtransfer(p,itransfer) + matrix_update_gmc - else - matrix_gmturnover(p,doner_gmc(itransfer)) = matrix_gmturnover(p,doner_gmc(itransfer)) - matrix_gmtransfer(p,itransfer) * dt + matrix_update_gmc * dt - matrix_gmtransfer(p,itransfer) = matrix_update_gmc - end if - return - end associate - - end function matrix_update_gmc - - - function matrix_update_fic(p,itransfer,rate,dt,cnveg_carbonflux_inst,matrixcheck,acc) - - integer,intent(in) :: p - integer,intent(in) :: itransfer - real(r8),intent(in) :: rate - real(r8),intent(in) :: dt - type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst - logical ,intent(in),optional :: matrixcheck - logical ,intent(in),optional :: acc - real(r8) :: matrix_update_fic - - associate( & - matrix_phturnover => cnveg_carbonflux_inst%matrix_phturnover_patch , & - matrix_gmturnover => cnveg_carbonflux_inst%matrix_gmturnover_patch , & - matrix_fitransfer => cnveg_carbonflux_inst%matrix_fitransfer_patch , & - matrix_fiturnover => cnveg_carbonflux_inst%matrix_fiturnover_patch , & - doner_fic => cnveg_carbonflux_inst%matrix_fitransfer_doner_patch & - ) - - if(.not. present(matrixcheck) .or. matrixcheck)then - if((.not. present(acc) .or. acc) .and. matrix_phturnover(p,doner_fic(itransfer)) + matrix_gmturnover(p,doner_fic(itransfer)) & - + matrix_fiturnover(p,doner_fic(itransfer)) + rate * dt .ge. 1)then - matrix_update_fic = max(0._r8,(1._r8 - matrix_phturnover(p,doner_fic(itransfer)) & - - matrix_gmturnover(p,doner_fic(itransfer)) - matrix_fiturnover(p,doner_fic(itransfer))) / dt) - else - matrix_update_fic = rate - end if - else - matrix_update_fic = rate - end if - if(.not. present(acc) .or. acc)then - matrix_fiturnover(p,doner_fic(itransfer)) = matrix_fiturnover(p,doner_fic(itransfer)) + matrix_update_fic * dt - matrix_fitransfer(p,itransfer) = matrix_fitransfer(p,itransfer) + matrix_update_fic - else - matrix_fiturnover(p,doner_fic(itransfer)) = matrix_fiturnover(p,doner_fic(itransfer)) - matrix_fitransfer(p,itransfer) * dt + matrix_update_fic * dt - matrix_fitransfer(p,itransfer) = matrix_update_fic - end if - - return - end associate - -end function matrix_update_fic - - function matrix_update_phn(p,itransfer,rate,dt,cnveg_nitrogenflux_inst,matrixcheck,acc) - - integer,intent(in) :: p - integer,intent(in) :: itransfer - real(r8),intent(in) :: rate - real(r8),intent(in) :: dt - type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst - logical ,intent(in),optional :: matrixcheck - logical ,intent(in),optional :: acc - real(r8) :: matrix_update_phn - - associate( & - matrix_nphtransfer => cnveg_nitrogenflux_inst%matrix_nphtransfer_patch , & - matrix_nphturnover => cnveg_nitrogenflux_inst%matrix_nphturnover_patch , & - doner_phn => cnveg_nitrogenflux_inst%matrix_nphtransfer_doner_patch & ! Input: [integer (:)] Doners of phenology related N transfer - ) - - if(.not. present(matrixcheck) .or. matrixcheck)then - if((.not. present(acc) .or. acc) .and. matrix_nphturnover(p,doner_phn(itransfer)) + rate * dt .ge. 1)then - matrix_update_phn = max(0._r8,(1._r8 - matrix_nphturnover(p,doner_phn(itransfer))) / dt) - else - matrix_update_phn = rate - end if - else - matrix_update_phn = rate - end if - if(.not. present(acc) .or. acc)then - matrix_nphturnover(p,doner_phn(itransfer)) = matrix_nphturnover(p,doner_phn(itransfer)) + matrix_update_phn * dt - matrix_nphtransfer(p,itransfer) = matrix_nphtransfer(p,itransfer) + matrix_update_phn - else - matrix_nphturnover(p,doner_phn(itransfer)) = matrix_nphturnover(p,doner_phn(itransfer)) - matrix_nphtransfer(p,itransfer) * dt + matrix_update_phn * dt - matrix_nphtransfer(p,itransfer) = matrix_update_phn - end if - - return - end associate - - end function matrix_update_phn - - function matrix_update_gmn(p,itransfer,rate,dt,cnveg_nitrogenflux_inst,matrixcheck,acc) - - integer ,intent(in) :: p - integer ,intent(in) :: itransfer - real(r8),intent(in) :: rate - real(r8),intent(in) :: dt - type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst - logical ,intent(in),optional :: matrixcheck - logical ,intent(in),optional :: acc - real(r8) :: matrix_update_gmn - - associate( & - matrix_nphturnover => cnveg_nitrogenflux_inst%matrix_nphturnover_patch , & - matrix_ngmtransfer => cnveg_nitrogenflux_inst%matrix_ngmtransfer_patch , & - matrix_ngmturnover => cnveg_nitrogenflux_inst%matrix_ngmturnover_patch , & - doner_gmn => cnveg_nitrogenflux_inst%matrix_ngmtransfer_doner_patch & ! Input: [integer (:)] Doners of gap mortality related N transfer - ) - - if(.not. present(matrixcheck) .or. matrixcheck)then - if((.not. present(acc) .or. acc) .and. matrix_nphturnover(p,doner_gmn(itransfer)) + matrix_ngmturnover(p,doner_gmn(itransfer)) + rate * dt .ge. 1)then - matrix_update_gmn = max(0._r8,(1._r8 - matrix_nphturnover(p,doner_gmn(itransfer)) - matrix_ngmturnover(p,doner_gmn(itransfer))) / dt) - else - matrix_update_gmn = rate - end if - else - matrix_update_gmn = rate - end if - if(.not. present(acc) .or. acc)then - matrix_ngmturnover(p,doner_gmn(itransfer)) = matrix_ngmturnover(p,doner_gmn(itransfer)) + matrix_update_gmn * dt - matrix_ngmtransfer(p,itransfer) = matrix_ngmtransfer(p,itransfer) + matrix_update_gmn - else - matrix_ngmturnover(p,doner_gmn(itransfer)) = matrix_ngmturnover(p,doner_gmn(itransfer)) - matrix_ngmtransfer(p,itransfer) * dt + matrix_update_gmn * dt - matrix_ngmtransfer(p,itransfer) = matrix_update_gmn - end if - - return - end associate - - end function matrix_update_gmn - - - function matrix_update_fin(p,itransfer,rate,dt,cnveg_nitrogenflux_inst,matrixcheck,acc) - - integer ,intent(in) :: p - integer ,intent(in) :: itransfer - real(r8),intent(in) :: rate - real(r8),intent(in) :: dt - type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst - logical ,intent(in),optional :: matrixcheck - logical ,intent(in),optional :: acc - real(r8) :: matrix_update_fin - - associate( & - matrix_nphturnover => cnveg_nitrogenflux_inst%matrix_nphturnover_patch , & - matrix_ngmturnover => cnveg_nitrogenflux_inst%matrix_ngmturnover_patch , & - matrix_nfitransfer => cnveg_nitrogenflux_inst%matrix_nfitransfer_patch , & - matrix_nfiturnover => cnveg_nitrogenflux_inst%matrix_nfiturnover_patch , & - doner_fin => cnveg_nitrogenflux_inst%matrix_nfitransfer_doner_patch & - ) - - if(.not. present(matrixcheck) .or. matrixcheck)then - if((.not. present(acc) .or. acc) .and. matrix_nphturnover(p,doner_fin(itransfer)) + matrix_ngmturnover(p,doner_fin(itransfer)) & - + matrix_nfiturnover(p,doner_fin(itransfer)) + rate * dt .ge. 1)then - matrix_update_fin = max(0._r8,(1._r8 - matrix_nphturnover(p,doner_fin(itransfer)) & - - matrix_ngmturnover(p,doner_fin(itransfer)) - matrix_nfiturnover(p,doner_fin(itransfer))) / dt) - else - matrix_update_fin = rate - end if - else - matrix_update_fin = rate - end if - if(.not. present(acc) .or. acc)then - matrix_nfiturnover(p,doner_fin(itransfer)) = matrix_nfiturnover(p,doner_fin(itransfer)) + matrix_update_fin * dt - matrix_nfitransfer(p,itransfer) = matrix_nfitransfer(p,itransfer) + matrix_update_fin - else - matrix_nfiturnover(p,doner_fin(itransfer)) = matrix_nfiturnover(p,doner_fin(itransfer)) - matrix_nfitransfer(p,itransfer) * dt + matrix_update_fin * dt - matrix_nfitransfer(p,itransfer) = matrix_update_fin - end if - - return - end associate - - end function matrix_update_fin - - !----------------------------------------------------------------------- - subroutine CNVegMatrixRest( ncid, flag ) - ! !DESCRIPTION: - ! - ! Read/write restart data needed for the CN Matrix model solution - ! - ! !USES: - use restUtilMod , only: restartvar - use ncdio_pio , only: file_desc_t, ncd_int - ! - ! !ARGUMENTS: - type(file_desc_t) , intent(inout) :: ncid ! netcdf id - character(len=*) , intent(in) :: flag !'read' or 'write' - ! - ! !LOCAL VARIABLES: - logical :: readvar ! determine if variable is on initial file - !------------------------------------------------------------------------ - call restartvar(ncid=ncid, flag=flag, varname='bgc_cycle_year', xtype=ncd_int, & - long_name='Year number in spinup cycle sequence', units='years', & - interpinic_flag='skip', readvar=readvar, data=iyr) - - call restartvar(ncid=ncid, flag=flag, varname='bgc_cycle_loop', xtype=ncd_int, & - long_name='Loop number in spinup cycle sequence', units='years', & - interpinic_flag='skip', readvar=readvar, data=iloop) - - !------------------------------------------------------------------------ - end subroutine CNVegMatrixRest - -end module CNVegMatrixMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/MatrixMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/MatrixMod.F90 deleted file mode 100755 index bef00510f..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/MatrixMod.F90 +++ /dev/null @@ -1,144 +0,0 @@ -module MatrixMod -!============================================================ -! -! Module for linear alegebra matrix methods -! -!============================================================ - -#include "shr_assert.h" - - use shr_kind_mod, only: r8 => shr_kind_r8 - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - implicit none - private - - ! - ! Public methods: - ! - public inverse ! Compute the inverse of a matrix - -!============================================================ -contains -!============================================================ - -subroutine inverse(a,c,n) -!============================================================ -! Inverse matrix -! Method: Based on Doolittle LU factorization for Ax=b -! Alex G. December 2009 -!----------------------------------------------------------- -! input ... -! a(n,n) - array of coefficients for matrix A -! n - dimension -! output ... -! c(n,n) - inverse matrix of A -! comments ... -! the original matrix a(n,n) will be destroyed -! during the calculation -!=========================================================== - implicit none - ! Arguments - integer,intent(in) :: n ! Size of matrix - real(r8),intent(in) :: a(:,:) ! Input matrix to fine the inverse of - real(r8),intent(out) :: c(:,:) ! Output inverse - ! Local variables - real(r8) :: L(n,n) ! matrix of the elimination coefficient - real(r8) :: U(n,n) ! Upper triangular part of input matrix A - real(r8) :: aa(n,n) ! Temporary equal to input matrix a - real(r8) :: b(n) ! Temporary vector - real(r8) :: d(n) ! Temporary vector (solution of L*d) - real(r8) :: x(n) ! Temporary vector (U*x = d) - real(r8) :: coeff ! coefficient - integer i, j, k ! Indices - character(len=*), parameter :: subname = 'inverse' - - ! - ! Verify input matrix sizes - ! - SHR_ASSERT((size(a,1) == n), errMsg(subname, __LINE__)) - SHR_ASSERT((size(a,2) == n), errMsg(subname, __LINE__)) - SHR_ASSERT((size(c,1) == n), errMsg(subname, __LINE__)) - SHR_ASSERT((size(c,2) == n), errMsg(subname, __LINE__)) - ! - ! Check that diagonals of input matrix aren't zero - ! - do k=1,n - if ( a(k,k) == 0.0_r8 )then - call endrun( subname//" ERROR: A diagonal element of the input matrix is zero" ) - return - end if - end do - ! - ! step 0: initialization for matrices L and U and b - ! Fortran 90/95 aloows such operations on matrices - ! - L=0.0 - U=0.0 - b=0.0 - - aa=a - ! - ! Step 1: forward elimination - ! - do k=1, n-1 - do i=k+1,n - ! Already verifieid that divisor isn't zero - coeff=aa(i,k)/aa(k,k) - L(i,k) = coeff - do j=k+1,n - aa(i,j) = aa(i,j)-coeff*aa(k,j) - end do - end do - end do - - ! - ! Step 2: prepare L and U matrices - ! L matrix is a matrix of the elimination coefficient - ! + the diagonal elements are 1.0 - ! - do i=1,n - L(i,i) = 1.0 - end do - ! - ! U matrix is the upper triangular part of A - ! - do j=1,n - do i=1,j - U(i,j) = aa(i,j) - end do - end do - ! - ! Step 3: compute columns of the inverse matrix C - ! - do k=1,n - b(k)=1.0 - d(1) = b(1) - ! Step 3a: Solve Ld=b using the forward substitution - do i=2,n - d(i)=b(i) - do j=1,i-1 - d(i) = d(i) - L(i,j)*d(j) - end do - end do - ! Step 3b: Solve Ux=d using the back substitution - x(n)=d(n)/U(n,n) - do i = n-1,1,-1 - x(i) = d(i) - do j=n,i+1,-1 - x(i)=x(i)-U(i,j)*x(j) - end do - ! Already verifieid that divisor isn't zero - x(i) = x(i)/u(i,i) - end do - ! Step 3c: fill the solutions x(n) into column k of C - do i=1,n - c(i,k) = x(i) - end do - b(k)=0.0 - end do -end subroutine inverse - -!============================================================ - -end module MatrixMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SPMMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SPMMod.F90 deleted file mode 100755 index 6fdb3ae57..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SPMMod.F90 +++ /dev/null @@ -1,1234 +0,0 @@ -module SPMMod - -#include "shr_assert.h" - -!----------------------------------------------------------------------- -!BOP -! -! !MODULE: SPMMod -! -! !DESCRIPTION: -! Sparse matrix multiplication add addition -! -! Author: Xingjie Lu -! -!EOP -!----------------------------------------------------------------------- - - use shr_kind_mod , only : r8 => shr_kind_r8 - use decompMod , only : bounds_type - use clm_varctl , only : iulog - use abortutils , only : endrun - implicit none - private - - type, public :: sparse_matrix_type - - !sparse matrix is in COO format, Both row index and column index should be in ascending order. - !Row index should change faster than Column index to ensure SPMP_AB work properly. - - real(r8), pointer :: M(:,:) => null() ! non-zero entries in sparse matrix (unit,sparse matrix index) - integer , pointer :: RI(:) => null() ! Row index - integer , pointer :: CI(:) => null() ! Column index - integer NE ! Number of nonzero entries - integer SM ! Size of matrix, eg. for nxn matrix, SM=n - integer num_unit ! number of active unit, such as patch, col, or gridcell - integer begu ! begin index of unit in current process - integer endu ! end index of unit in current process - - contains - - procedure, public :: InitSM ! subroutine to initilize sparse matrix type - procedure, public :: ReleaseSM ! subroutine to deallocate the sparse matrix type data - procedure, public :: IsAllocSM ! return true if the sparse matrix type is allocated (InitSM was called) - procedure, public :: IsEquivIdxSM ! return true if the sparse matrix indices are the same for the two sparce matrices - procedure, public :: SetValueSM ! subroutine to set values in sparse matrix of any shape - procedure, public :: SetValueA ! subroutine to set off-diagonal values in sparse matrix of A - procedure, public :: SetValueA_diag ! subroutine to set diagonal values in sparse matrix of A - procedure, public :: SetValueCopySM ! subroutine to copy the input sparse matrix to the output - procedure, public :: CopyIdxSM ! subroutine to copy the input indices to the sparse matrix - procedure, public :: IsValuesSetSM ! return true if the values are set in the matrix - procedure, public :: SPMM_AK ! subroutine to calculate sparse matrix multiplication: A(sparse matrix) = A(sparse matrix) * K(diagonal matrix) - procedure, public :: SPMP_AB ! subroutine to calculate sparse matrix addition AB(sparse matrix) = A(sparse matrix) + B(sparse matrix) - procedure, public :: SPMP_B_ACC ! subroutine to calculate sparse matrix accumulation: B(sparse matrix) = B(sparse matrix) + A(sparse matrix) - procedure, public :: SPMP_ABC ! subroutine to calculate sparse matrix addition ABC(sparse matrix) = A(sparse matrix) + B(sparse matrix) + C(sparse matrix) - - end type sparse_matrix_type - - type, public :: diag_matrix_type - - !diagnoal matrix only store diagnoal entries - - real(r8), pointer :: DM(:,:) => null() ! entries in diagonal matrix (unit,diagonal matrix index) - integer SM ! Size of matrix, eg. for nxn matrix, SM=n - integer num_unit ! number of active unit, such as patch, col, or gridcell - integer begu ! begin index of unit in current process - integer endu ! end index of unit in current process - - contains - - procedure, public :: InitDM ! subroutine to initialize diagonal matrix type - procedure, public :: ReleaseDM ! subroutine to deallocate the diagonal matrix - procedure, public :: IsAllocDM ! return true if the diagonal matrix is allocated (InitDM was called) - procedure, public :: SetValueDM ! subroutine to set values in diagonal matrix - - end type diag_matrix_type - - type, public :: vector_type - - !vector - - real(r8), pointer :: V(:,:) => null() ! entries in vector (unit,vector index) - integer SV ! Size of vector - integer num_unit ! number of active unit, such as patch, col, or gridcell - integer begu ! begin index of unit in current process - integer endu ! end index of unit in current process - - contains - - procedure, public :: InitV ! subroutine to initialize vector type - procedure, public :: ReleaseV ! subroutine to deallocate veector type - procedure, public :: IsAllocV ! return true if the vector is allocated (InitV was called) - procedure, public :: SetValueV ! subroutine to set values in vector - procedure, public :: SetValueV_scaler ! subroutine to set a constant value to a vector - procedure, public :: SPMM_AX ! subroutine to calculate multiplication X(vector)=A(sparse matrix)*X(vector) - - end type vector_type - - integer, public, parameter :: empty_int = -9999 - real(r8), public, parameter :: empty_real = -9999._r8 - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - -contains - - -subroutine InitSM(this,SM_in,begu,endu,maxsm) - -! Initialize the sparse matrix by giving the boundary of landunit/gridcell/column/patch, -! the size of matrix. Then allocate the matrix in a sparse matrix format - -class(sparse_matrix_type) :: this -integer,intent(in) :: SM_in -integer,intent(in) :: begu -integer,intent(in) :: endu -integer,optional,intent(in) :: maxsm -character(len=*),parameter :: subname = 'InitSM' - -if ( this%IsAllocSM() )then - call endrun( subname//" ERROR: Sparse Matrix was already allocated" ) - return -end if -this%SM = SM_in -this%begu = begu -this%endu = endu -if(present(maxsm))then - SHR_ASSERT_FL((maxsm >= 1), sourcefile, __LINE__) - SHR_ASSERT_FL((maxsm <= SM_in*SM_in), sourcefile, __LINE__) - allocate(this%M(begu:endu,1:maxsm)) -else - allocate(this%M(begu:endu,1:SM_in*SM_in)) -end if -allocate(this%RI(1:SM_in*SM_in)) -allocate(this%CI(1:SM_in*SM_in)) -this%M(:,:) = empty_real -this%RI(:) = empty_int -this%CI(:) = empty_int -this%NE = empty_int - -end subroutine InitSM - - ! ======================================================================== - - subroutine ReleaseSM(this) - - ! Release the Sparse Matrix data - - class(sparse_matrix_type) :: this - - this%SM = empty_int - this%begu = empty_int - this%endu = empty_int - if ( associated(this%M) )then - deallocate(this%M) - end if - if ( associated(this%RI) )then - deallocate(this%RI) - end if - if ( associated(this%CI) )then - deallocate(this%CI) - end if - this%M => null() - this%RI=> null() - this%CI=> null() - end subroutine ReleaseSM - - ! ======================================================================== - - logical function IsAllocSM(this) - - ! Check if the Sparse Matrix has been allocated (InitSM was called on it) - - class(sparse_matrix_type) :: this - - if ( associated(this%M) .or. associated(this%RI) .or. associated(this%CI) )then - IsAllocSM = .true. - else - IsAllocSM = .false. - end if - - end function IsAllocSM - - - ! ======================================================================== - - logical function IsEquivIdxSM(this, A) - - ! Check if the Sparse Matrix indices are eqiuivalent - - class(sparse_matrix_type) :: this - type(sparse_matrix_type), intent(in) :: A ! Sparse matrix indices to compare to - character(len=*),parameter :: subname = 'IsEquivIdxSM' - - ! Start checking easy critera and return if can determine status for sure, - ! keep checking harder things until everything has been checked for - if ( this%SM /= A%SM )then - IsEquivIdxSM = .false. - return - end if - if ( this%NE == A%NE )then - ! If NE is the same and the row and column indices are identical -- the - ! indices of the two arrays are identical - if ( all(this%RI(:this%NE) == A%RI(:this%NE)) .and. all(this%CI(:this%NE) == A%CI(:this%NE)) )then - IsEquivIdxSM = .true. - return - else - ! This needs more checking! The order could be different - IsEquivIdxSM = .false. - return - end if - else - ! This needs more checking! There could be some zerod entries in - ! non-zero positions - IsEquivIdxSM = .false. - return - end if - call endrun( subname//" ERROR: it should NOT be possible to reach this point" ) - return - - end function IsEquivIdxSM - - ! ======================================================================== - -subroutine SetValueSM(this,begu,endu,num_unit,filter_u,M,I,J,NE_in) - -! Set sparse matrix values by giving all non-zero values and the corresponding row and column indices. -! The information of active landunit/gridcell/column/patch is used to save computational cost. - -class(sparse_matrix_type) :: this -integer ,intent(in) :: begu -integer ,intent(in) :: endu -integer ,intent(in) :: NE_in -integer ,intent(in) :: num_unit -integer ,intent(in) :: filter_u(:) -real(r8),intent(in) :: M(begu:,1:) -integer ,intent(in) :: I(:) -integer ,intent(in) :: J(:) -character(len=*),parameter :: subname = 'SetValueSM' - -integer k,u,fu - -if ( .not. this%IsAllocSM() )then - call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) - return -end if -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M, 2) >= NE_in), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(I, 1) >= NE_in), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(J, 1) >= NE_in), sourcefile, __LINE__) -SHR_ASSERT_FL((lbound(M, 1) == begu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M, 1) == endu), sourcefile, __LINE__) -#ifndef _OPENMP -! Without OpenMP array sizes will be identical -SHR_ASSERT_FL((lbound(M, 1) == this%begu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M, 1) == this%endu), sourcefile, __LINE__) -#else -! With OpenMP the allocated array sizes might be larger than the input ones -SHR_ASSERT_FL((lbound(M, 1) >= this%begu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M, 1) <= this%endu), sourcefile, __LINE__) -#endif -SHR_ASSERT_FL((maxval(I(:this%NE)) <= this%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((minval(I(:this%NE)) >= 1), sourcefile, __LINE__) -SHR_ASSERT_FL((maxval(J(:this%NE)) <= this%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((minval(J(:this%NE)) >= 1), sourcefile, __LINE__) -do k = 1,NE_in - do fu = 1,num_unit - u = filter_u(fu) - this%M(u,k) = M(u,k) - end do -end do - -this%NE = NE_in -do k = 1,NE_in - this%RI(k) = I(k) - this%CI(k) = J(k) -end do - -end subroutine SetValueSM - - -subroutine SetValueA_diag(this,num_unit,filter_u,scaler) - -! Set diagonal sparse matrix values by giving a constant scaler. -! The information of active landunit/gridcell/column/patch is used to save computational cost. - -class(sparse_matrix_type) :: this -real(r8),intent(in) :: scaler -integer,intent(in) :: num_unit -integer,intent(in) :: filter_u(:) -integer i,u,fu -character(len=*),parameter :: subname = 'SetValueA_diag' - -if ( .not. this%IsAllocSM() )then - call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) - return -end if -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((lbound(this%M,1) == this%begu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(this%M,1) == this%endu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(this%M,2) >= this%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(this%RI,1) >= this%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(this%CI,1) >= this%SM), sourcefile, __LINE__) -do i=1,this%SM - do fu=1,num_unit - u = filter_u(fu) - this%M(u,i) = scaler - end do -end do - -do i=1,this%SM - this%RI(i) = i - this%CI(i) = i -end do -this%NE = this%SM - -end subroutine SetValueA_diag - - -subroutine SetValueA(this,begu,endu,num_unit,filter_u,M,AI,AJ,NE_NON,Init_ready,list,RI_A,CI_A) - -! Set sparse matrix values by giving values, rows, and columns of non-zero and non-diagonal entries. -! Then Set the diagonal entries to -1. The information of active landunit/gridcell/column/patch, -! The order and indices of non-diagonal entries in full sparse matrix are memorized to save computational cost, -! since these indices are usualy time-independent. - -class(sparse_matrix_type) :: this -integer ,intent(in) :: begu -integer ,intent(in) :: endu -integer ,intent(in) :: NE_NON -integer ,intent(in) :: num_unit -integer ,intent(in) :: filter_u(:) -real(r8),intent(in) :: M(begu:,1:) -integer ,intent(in) :: AI(:) -integer ,intent(in) :: AJ(:) -logical ,intent(inout) :: Init_ready !True: diagnoal of A has been set to -1,this%RI, this%CI, this%NE and list has been set up -integer ,intent(inout),optional :: list(:) -integer ,intent(inout),optional :: RI_A(:) -integer ,intent(inout),optional :: CI_A(:) - -integer i,j,k,fu,u -logical list_ready -type(sparse_matrix_type) :: A_diag, A_nondiag -character(len=*),parameter :: subname = 'SetValueA' - -list_ready = .false. - -if ( .not. this%IsAllocSM() )then - call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) - return -end if -if(init_ready .and. .not. (present(list) .and. present(RI_A) .and. present(CI_A)))then - write(iulog,*) "Error: initialization is ready, but at least one of list, RI_A or CI_A is not presented" - call endrun( subname//" ERROR: required optional arguments were NOT sent in" ) - return -end if -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((lbound(M,1) == begu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M,1) == endu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M,2) >= NE_NON), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(AI,1) >= NE_NON), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(AJ,1) >= NE_NON), sourcefile, __LINE__) -if ( present(list) )then - SHR_ASSERT_FL((ubound(list,1) >= NE_NON), sourcefile, __LINE__) -end if -if ( present(RI_A) )then - SHR_ASSERT_FL((ubound(RI_A,1) >= NE_NON+this%SM), sourcefile, __LINE__) -end if -if ( present(CI_A) )then - SHR_ASSERT_FL((ubound(CI_A,1) >= NE_NON+this%SM), sourcefile, __LINE__) -end if - -if(Init_ready)then - do i = 1,this%SM+NE_NON - do fu = 1,num_unit - u = filter_u(fu) - this%M(u,i) = -1._r8 - end do - end do - do i = 1,NE_NON - do fu = 1,num_unit - u = filter_u(fu) - this%M(u,list(i)) = M(u,i) - end do - end do - this%NE = this%SM+NE_NON - this%RI(1:this%NE) = RI_A(1:this%NE) - this%CI(1:this%NE) = CI_A(1:this%NE) -else - if ( A_diag%IsAllocSM() ) call A_diag%ReleaseSM() - if ( A_nondiag%IsAllocSM() ) call A_nondiag%ReleaseSM() - call A_diag%InitSM(this%SM,begu,endu) - call A_nondiag%InitSM(this%SM,begu,endu) - - call A_diag%SetValueA_diag(num_unit,filter_u,-1._r8) - call A_nondiag%SetValueSM(begu,endu,num_unit,filter_u,M,AI,AJ,NE_NON) - - if(present(list))then - call this%SPMP_AB(num_unit,filter_u,A_nondiag,A_diag,list_ready,list_A=list) - else - call this%SPMP_AB(num_unit,filter_u,A_nondiag,A_diag,list_ready) - end if - if(present(RI_A))RI_A(1:this%NE) = this%RI(1:this%NE) - if(present(CI_A))CI_A(1:this%NE) = this%CI(1:this%NE) - - Init_ready = .true. - call A_diag%ReleaseSM() - call A_nondiag%ReleaseSM() -end if - -end subroutine SetValueA - - - ! ======================================================================== - - subroutine SetValueCopySM(this, num_unit, filter_u, matrix) - - ! Set the sparse matrix by copying from another sparse matrix - - class(sparse_matrix_type) :: this - type(sparse_matrix_type), intent(in) :: matrix ! Sparse Matrix to copy - integer ,intent(in) :: num_unit - integer ,intent(in) :: filter_u(:) - character(len=*),parameter :: subname = 'SetValueCopySM' - - if ( .not. this%IsAllocSM() )then - call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) - return - end if - if ( .not. matrix%IsValuesSetSM() )then - call endrun( subname//" ERROR: Sparse Matrix data sent in was NOT already set" ) - return - end if - SHR_ASSERT_FL( (this%SM == matrix%SM), sourcefile, __LINE__) - SHR_ASSERT_FL( (this%begu == matrix%begu), sourcefile, __LINE__) - SHR_ASSERT_FL( (this%endu == matrix%endu), sourcefile, __LINE__) - SHR_ASSERT_FL((maxval(matrix%RI(:this%NE)) <= this%SM), sourcefile, __LINE__) - SHR_ASSERT_FL((minval(matrix%RI(:this%NE)) >= 1), sourcefile, __LINE__) - SHR_ASSERT_FL((maxval(matrix%CI(:this%NE)) <= this%SM), sourcefile, __LINE__) - SHR_ASSERT_FL((minval(matrix%CI(:this%NE)) >= 1), sourcefile, __LINE__) - call this%SetValueSM( matrix%begu, matrix%endu, num_unit, filter_u, matrix%M, & - matrix%RI, matrix%CI, matrix%NE) - - end subroutine SetValueCopySM - - ! ======================================================================== - - subroutine CopyIdxSM(this, matrix) - - ! Copy the indices from the input matrix to this sparse matrix - ! also make sure the sizes are consistent - - class(sparse_matrix_type) :: this - type(sparse_matrix_type), intent(in) :: matrix ! Sparse Matrix to copy - character(len=*),parameter :: subname = 'CopyIdxSM' - integer :: i - - if ( .not. this%IsAllocSM() )then - call endrun( subname//" ERROR: Sparse Matrix was NOT already allocated" ) - return - end if - if ( .not. matrix%IsValuesSetSM() )then - call endrun( subname//" ERROR: Sparse Matrix data sent in was NOT already set" ) - return - end if - SHR_ASSERT_FL( (this%SM == matrix%SM), sourcefile, __LINE__) - SHR_ASSERT_FL( (this%begu == matrix%begu), sourcefile, __LINE__) - SHR_ASSERT_FL( (this%endu == matrix%endu), sourcefile, __LINE__) - SHR_ASSERT_FL((maxval(matrix%RI(:matrix%NE)) <= this%SM), sourcefile, __LINE__) - SHR_ASSERT_FL((minval(matrix%RI(:matrix%NE)) >= 1), sourcefile, __LINE__) - SHR_ASSERT_FL((maxval(matrix%CI(:matrix%NE)) <= this%SM), sourcefile, __LINE__) - SHR_ASSERT_FL((minval(matrix%CI(:matrix%NE)) >= 1), sourcefile, __LINE__) - ! - ! Figure out the number of non-empty data values and make sure it's same as input - ! - this%NE = size(this%M,2) - do i = 1, this%NE - if ( all(this%M(:,i) == empty_int) )then - this%NE = i-1 - exit - end if - end do - if ( this%NE /= matrix%NE )then - call endrun( subname//" ERROR: Sparse Matrix empty data size is different from input one copying the indices from" ) - return - end if - ! - ! Copy indices - ! - this%RI(:this%NE) = matrix%RI(:matrix%NE) - this%CI(:this%NE) = matrix%CI(:matrix%NE) - end subroutine CopyIdxSM - - ! ======================================================================== - - logical function IsValuesSetSM(this) - - ! Check if the Sparse Matrix has it's data been set (One of the SetValue* subroutines was called on it) - - class(sparse_matrix_type) :: this - - if ( .not. this%IsAllocSM() )then - IsValuesSetSM = .false. - else if ( this%NE == empty_int )then - IsValuesSetSM = .false. - else - IsValuesSetSM = .true. - end if - - end function IsValuesSetSM - - ! ======================================================================== - -subroutine InitDM(this,SM_in,begu,endu) - -! Initialize the diagonal matrix by giving the boundary of landunit/gridcell/column/patch, -! the size of matrix. Then allocate the matrix in a diagonal matrix format - -class(diag_matrix_type) :: this -integer,intent(in) :: SM_in -integer,intent(in) :: begu -integer,intent(in) :: endu -character(len=*),parameter :: subname = 'InitDM' - -if ( this%IsAllocDM() )then - call endrun( subname//" ERROR: Diagonal Matrix was already allocated" ) - return -end if -this%SM = SM_in -allocate(this%DM(begu:endu,1:SM_in)) -this%DM(:,:) = empty_real -this%begu = begu -this%endu = endu - -end subroutine InitDM - - !----------------------------------------------------------------------- - subroutine ReleaseDM(this) - - ! Release the Diagonal Matrix data - - class(diag_matrix_type) :: this - - this%SM = empty_int - this%begu = empty_int - this%endu = empty_int - if ( associated(this%DM) )then - deallocate(this%DM) - end if - this%DM => null() - end subroutine ReleaseDM - - !----------------------------------------------------------------------- - logical function IsAllocDM(this) - - ! Check if the Diagonal Matrix is allocated (InitDM was called) - - class(diag_matrix_type) :: this - - if ( associated(this%DM) )then - IsAllocDM = .true. - else - IsAllocDM = .false. - end if - - end function IsAllocDM - - !----------------------------------------------------------------------- - -subroutine SetValueDM(this,begu,endu,num_unit,filter_u,M) - -! Set the diagonal matrix values by giving the values of diagonal entries in a right order. -! The information of active landunit/gridcell/column/patch is used to save computational cost. - -class(diag_matrix_type) :: this -integer ,intent(in) :: begu -integer ,intent(in) :: endu -real(r8),intent(in) :: M(begu:,1:) -integer ,intent(in) :: num_unit -integer ,intent(in) :: filter_u(:) -character(len=*),parameter :: subname = 'SetValueDM' - -integer i,fu,u - -if ( .not. this%IsAllocDM() )then - call endrun( subname//" ERROR: Diagonal matrix was NOT already allocated" ) - return -end if -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((lbound(M,1) == begu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M,1) == endu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M,2) >= this%SM), sourcefile, __LINE__) -do i = 1,this%SM - do fu = 1,num_unit - u = filter_u(fu) - this%DM(u,i) = M(u,i) - end do -end do - -end subroutine SetValueDM - - -subroutine InitV(this,SV_in,begu,endu) - -! Initialize the vector by giving the boundary of landunit/gridcell/column/patch, -! the size of vector. Then allocate the vector in a vector type - -class(vector_type) :: this -integer,intent(in) :: SV_in -integer,intent(in) :: begu -integer,intent(in) :: endu -character(len=*),parameter :: subname = 'InitV' - -if ( this%IsAllocV() )then - call endrun( subname//" ERROR: Vector was already allocated" ) - return -end if -this%SV = SV_in -allocate(this%V(begu:endu,1:SV_in)) -this%V(:,:) = empty_real -this%begu = begu -this%endu = endu - -end subroutine InitV - - -subroutine ReleaseV(this) - -! Deallocate vector type - -class(vector_type) :: this -if ( associated(this%V) )then - deallocate(this%V) -end if -this%V => null() -this%begu = empty_int -this%endu = empty_int -this%SV = empty_int - -end subroutine ReleaseV - - ! ======================================================================== - - logical function IsAllocV(this) - - ! Check if the Vector has been allocated (InitV was called on it) - - class(vector_type) :: this - - if ( associated(this%V) )then - IsAllocV = .true. - else - IsAllocV = .false. - end if - - end function IsAllocV - -subroutine SetValueV_scaler(this,num_unit,filter_u,scaler) - -! Set the vector values by giving a constant value -! The information of active landunit/gridcell/column/patch is used to save computational cost. - -class(vector_type) :: this -real(r8),intent(in) :: scaler -integer,intent(in) :: num_unit -integer,intent(in) :: filter_u(:) - -integer i,fu,u -character(len=*),parameter :: subname = 'SetValueV_scaler' - -if ( .not. this%IsAllocV() )then - call endrun( subname//" ERROR: Vector was NOT already allocated" ) - return -end if -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -do i=1,this%SV - do fu = 1,num_unit - u = filter_u(fu) - this%V(u,i) = scaler - end do -end do - -end subroutine SetValueV_scaler - - -subroutine SetValueV(this,begu,endu,num_unit,filter_u,M) - -! Set the vector values by giving the values in a right order. -! The information of active landunit/gridcell/column/patch is used to save computational cost. - -integer ,intent(in) :: begu -integer ,intent(in) :: endu -class(vector_type) :: this -real(r8),intent(in) :: M(begu:,1:) -integer ,intent(in) :: num_unit -integer ,intent(in) :: filter_u(:) - -integer i,fu,u -character(len=*),parameter :: subname = 'SetValueV' - -if ( .not. this%IsAllocV() )then - call endrun( subname//" ERROR: Vector was NOT already allocated" ) - return -end if -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((lbound(M,1) == begu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M,1) == endu), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(M,2) >= this%SV), sourcefile, __LINE__) -do i=1,this%SV - do fu = 1,num_unit - u = filter_u(fu) - this%V(u,i) = M(u,i) - end do -end do - -end subroutine SetValueV - - -subroutine SPMM_AK(this,num_unit,filter_u,K) - -! Calculate sparse matrix multiplication (SPMM) A(this) = A(this)*K -! The information of active landunit/gridcell/column/patch is used to save computational cost. -! A is a sparse matrix in Coordinate format (COO). -! K is a diagnoal matrix. - -class(sparse_matrix_type) :: this -type(diag_matrix_type) ,intent(in) :: K -integer,intent(in) :: num_unit -integer,intent(in) :: filter_u(:) - -integer i,fu,u - -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SM == K%SM), sourcefile, __LINE__) -do i=1,this%NE - do fu = 1,num_unit - u = filter_u(fu) - this%M(u,i) = this%M(u,i) * K%DM(u,this%CI(i)) - end do -end do - -end subroutine SPMM_AK - - -subroutine SPMM_AX(this,num_unit,filter_u,A) - -! Calculate sparse matrix multiplication (SPMM) X(this) = X(this) + A*X(this) -! The information of active landunit/gridcell/column/patch is used to save computational cost. -! A is a sparse matrix in Coordinate format (COO). -! X is a vector type. - -class(vector_type) :: this -type(sparse_matrix_type),intent(in) :: A -integer,intent(in) :: num_unit -integer,intent(in) :: filter_u(:) - -integer i,fu,u -real(r8) :: V(this%begu:this%endu,1:this%SV) - -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(this%V,2) == this%SV), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SV <= A%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(this%V,2) == this%SV), sourcefile, __LINE__) -SHR_ASSERT_FL((ubound(A%M,2) >= A%NE), sourcefile, __LINE__) -SHR_ASSERT_FL((maxval(A%RI) <= this%SV), sourcefile, __LINE__) -SHR_ASSERT_FL((maxval(A%CI) <= this%SV), sourcefile, __LINE__) -do i=1,this%SV - do fu = 1, num_unit - u = filter_u(fu) - V(u,i) = this%V(u,i) - end do -end do - -do i=1,A%NE - do fu = 1, num_unit - u = filter_u(fu) - this%V(u,A%RI(i)) = this%V(u,A%RI(i)) + A%M(u,i) * V(u,A%CI(i)) - end do -end do - -end subroutine SPMM_AX - - -subroutine SPMP_B_ACC(this,num_unit,filter_u,A) - -! Calculate sparse matrix addition (SPMP) B(this) = B(this) + A -! The information of active landunit/gridcell/column/patch is used to save computational cost. -! A and B are sparse matrix in Coordinate format (COO). -! Entry locations of A and B should be the same. - -class(sparse_matrix_type) :: this -type(sparse_matrix_type),intent(in) :: A -integer,intent(in) :: num_unit -integer,intent(in) :: filter_u(:) - -integer i,fu,u - -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SM == A%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((this%NE == A%NE), sourcefile, __LINE__) -SHR_ASSERT_ALL_FL((this%RI == A%RI), sourcefile, __LINE__) -SHR_ASSERT_ALL_FL((this%CI == A%CI), sourcefile, __LINE__) - -do i=1,A%NE - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i) = this%M(u,i) + A%M(u,i) - end do -end do - -end subroutine SPMP_B_ACC - - -subroutine SPMP_AB(this,num_unit,filter_u,A,B,list_ready,list_A,list_B,NE_AB,RI_AB,CI_AB) - -! Calculate sparse matrix addition (SPMP) AB(this) = A + B -! The map of each entry in A and B to AB have been memorized to save the computational cost, -! since they are usually time-independent. -! The information of active landunit/gridcell/column/patch is used to save computational cost. -! A is a sparse matrix in Coordinate format (COO) -! B is a sparse matrix in Coordinate format (COO) -! AB is a sparse matrix in Coordinate format (COO) - -class(sparse_matrix_type) :: this -type(sparse_matrix_type),intent(in) :: A -type(sparse_matrix_type),intent(in) :: B -logical,intent(inout) :: list_ready -integer,intent(in) :: num_unit -integer,intent(in) :: filter_u(:) - -integer,intent(inout),optional :: list_A(:) -integer,intent(inout),optional :: list_B(:) -integer,intent(inout),optional :: NE_AB -integer,intent(inout),optional :: RI_AB(:) -integer,intent(inout),optional :: CI_AB(:) - -integer,dimension(:) :: Aindex(A%NE+1),Bindex(B%NE+1) -integer,dimension(:) :: ABindex(this%SM*this%SM) - -integer i_a,i_b,i_ab -integer i,fu,u -character(len=*),parameter :: subname = 'SPMP_AB' - -! 'list_ready = .true.' means list_A, list_B, NE_AB, RI_AB, and CI_AB have been memorized before. -! In this case they all need to be presented. Otherwise, use 'list_ready = .false.' to get those information -! for the first time call this subroutine. - -if ( present(list_A) )then - SHR_ASSERT_FL((ubound(list_A,1) >= A%NE), sourcefile, __LINE__) -end if -if ( present(list_B) )then - SHR_ASSERT_FL((ubound(list_B,1) >= B%NE), sourcefile, __LINE__) -end if -if ( present(RI_AB) )then - SHR_ASSERT_FL((ubound(RI_AB,1) >= A%NE+B%NE), sourcefile, __LINE__) -end if -if ( present(CI_AB) )then - SHR_ASSERT_FL((ubound(CI_AB,1) >= A%NE+B%NE), sourcefile, __LINE__) -end if -if(list_ready .and. .not. (present(list_A) .and. present(list_B) .and. present(NE_AB) .and. present(RI_AB) .and. present(CI_AB)))then - write(iulog,*) "error in SPMP_AB: list_ready is True, but at least one of list_A, list_B, NE_AB, RI_AB and CI_AB are not presented" - call endrun( subname//" ERROR: missing required optional arguments" ) - return -end if -SHR_ASSERT_FL((ubound(filter_u,1) >= num_unit), sourcefile, __LINE__) -SHR_ASSERT_FL((A%NE > 0), sourcefile, __LINE__) -SHR_ASSERT_FL((B%NE > 0), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SM > 0), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SM == A%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SM == B%SM), sourcefile, __LINE__) - -if(.not. list_ready)then - i_a=1 - i_b=1 - i_ab=1 - Aindex(1:A%NE) = (A%CI(1:A%NE)-1)*A%SM + A%RI(1:A%NE) - Bindex(1:B%NE) = (B%CI(1:B%NE)-1)*B%SM + B%RI(1:B%NE) - Aindex(A%NE+1) = A%SM*A%SM + 1 - Bindex(B%NE+1) = B%SM*B%SM + 1 - - do while (i_a .le. A%NE .or. i_b .le. B%NE) - if(Aindex(i_a) .lt. Bindex(i_b))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_ab) = A%M(u,i_a) - end do - ABindex(i_ab) = Aindex(i_a) - if(present(list_A))list_A(i_a) = i_ab - i_a = i_a + 1 - i_ab = i_ab + 1 - else - if(Aindex(i_a) .gt. Bindex(i_b))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_ab) = B%M(u,i_b) - end do - ABindex(i_ab) = Bindex(i_b) - if(present(list_B))list_B(i_b) = i_ab - i_b = i_b + 1 - i_ab = i_ab + 1 - else - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_ab) = A%M(u,i_a) + B%M(u,i_b) - end do - ABindex(i_ab) = Aindex(i_a) - if(present(list_A))list_A(i_a) = i_ab - if(present(list_B))list_B(i_b) = i_ab - i_a = i_a + 1 - i_b = i_b + 1 - i_ab = i_ab + 1 - end if - end if - end do - - this%NE = i_ab - 1 - this%CI(1:this%NE) = (ABindex(1:this%NE) - 1) / this%SM + 1 - this%RI(1:this%NE) = ABindex(1:this%NE) - this%SM * (this%CI(1:this%NE) - 1) - if(present(NE_AB))NE_AB = this%NE - if(present(CI_AB))CI_AB(1:this%NE) = this%CI(1:this%NE) - if(present(RI_AB))RI_AB(1:this%NE) = this%RI(1:this%NE) - if(present(list_A) .and. present(list_B) .and. present(NE_AB) .and. present(RI_AB) .and. present(CI_AB))list_ready = .true. -else - do i = 1, NE_AB - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i) = 0._r8 - end do - end do - do i_a = 1, A%NE - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,list_A(i_a)) = A%M(u,i_a) - end do - end do - do i_b = 1, B%NE - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,list_B(i_b)) = this%M(u,list_B(i_b)) + B%M(u,i_b) - end do - end do - this%NE = NE_AB - this%CI(1:this%NE) = CI_AB(1:NE_AB) - this%RI(1:this%NE) = RI_AB(1:NE_AB) -end if - -end subroutine SPMP_AB - -subroutine SPMP_ABC(this,num_unit,filter_u,A,B,C,list_ready,list_A,list_B,list_C,NE_ABC,RI_ABC,CI_ABC,& - use_actunit_list_A,num_actunit_A,filter_actunit_A,use_actunit_list_B,num_actunit_B,filter_actunit_B,& - use_actunit_list_C,num_actunit_C,filter_actunit_C) - -! Calculate sparse matrix addition (SPMP) ABC(this) = A + B + C -! The map of each entry in A, B and C to ABC have been memorized to save the computational cost, -! since they are usually time-independent. -! The information of active landunit/gridcell/column/patch is used to save computational cost. -! A is a sparse matrix in Coordinate format (COO) -! B is a sparse matrix in Coordinate format (COO) -! C is a sparse matrix in Coordinate format (COO) -! ABC is a sparse matrix in Coordinate format (COO) - -class(sparse_matrix_type) :: this -type(sparse_matrix_type),intent(in) :: A -type(sparse_matrix_type),intent(in) :: B -type(sparse_matrix_type),intent(in) :: C -logical,intent(inout) :: list_ready -integer,intent(in) :: num_unit -integer,intent(in) :: filter_u(:) -logical,intent(in),optional :: use_actunit_list_A -logical,intent(in),optional :: use_actunit_list_B -logical,intent(in),optional :: use_actunit_list_C -integer,intent(in),optional :: num_actunit_A -integer,intent(in),optional :: num_actunit_B -integer,intent(in),optional :: num_actunit_C -integer,dimension(:),intent(in),optional :: filter_actunit_A -integer,dimension(:),intent(in),optional :: filter_actunit_B -integer,dimension(:),intent(in),optional :: filter_actunit_C - -integer,intent(inout),optional :: list_A(:) -integer,intent(inout),optional :: list_B(:) -integer,intent(inout),optional :: list_C(:) -integer,intent(inout),optional :: NE_ABC -integer,intent(inout),optional :: RI_ABC(:) -integer,intent(inout),optional :: CI_ABC(:) - -! Local data -integer,dimension(:) :: Aindex(A%NE+1),Bindex(B%NE+1),Cindex(C%NE+1) -integer,dimension(:) :: ABCindex(this%SM*this%SM) - -integer i_a,i_b,i_c,i_abc -integer i,fu,u -character(len=*),parameter :: subname = 'SPMP_ABC' - -! 'list_ready = .true.' means list_A, list_B, list_C, NE_ABC, RI_ABC, and CI_ABC have been memorized before. -! In this case they all need to be presented. Otherwise, use 'list_ready = .false.' to get those information -! for the first time call this subroutine. - -SHR_ASSERT_FL((this%SM > 0), sourcefile, __LINE__) -SHR_ASSERT_FL((A%NE > 0), sourcefile, __LINE__) -SHR_ASSERT_FL((B%NE > 0), sourcefile, __LINE__) -SHR_ASSERT_FL((C%NE > 0), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SM == A%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SM == B%SM), sourcefile, __LINE__) -SHR_ASSERT_FL((this%SM == C%SM), sourcefile, __LINE__) -if( present(list_A) )then - SHR_ASSERT_FL((size(list_A) >= A%NE), sourcefile, __LINE__) -end if -if( present(list_B) )then - SHR_ASSERT_FL((size(list_B) >= B%NE), sourcefile, __LINE__) -end if -if( present(list_C) )then - SHR_ASSERT_FL((size(list_C) >= C%NE), sourcefile, __LINE__) -end if -if( present(RI_ABC) )then - SHR_ASSERT_FL((size(RI_ABC) >= A%NE+B%NE+C%NE), sourcefile, __LINE__) -end if -if( present(CI_ABC) )then - SHR_ASSERT_FL((size(CI_ABC) >= A%NE+B%NE+C%NE), sourcefile, __LINE__) -end if -if(list_ready .and. .not. (present(list_A) .and. present(list_B) .and. present(list_C) .and. present(NE_ABC) .and. present(RI_ABC) .and. present(CI_ABC)))then - write(iulog,*) "error in SPMP_ABC: list_ready is True, but at least one of list_A, list_B, list_C, NE_ABC, RI_ABC and CI_ABC are not presented",& - present(list_A),present(list_B),present(list_C),present(NE_ABC),present(RI_ABC),present(CI_ABC) - call endrun( subname//" ERROR: missing required optional arguments" ) - return -end if -if(present(num_actunit_A))then - if(num_actunit_A < 0)then - write(iulog,*) "error: num_actunit_A cannot be less than 0" - call endrun( subname//" ERROR: bad value for num_actunit_A" ) - return - end if - if(.not. present(filter_actunit_A))then - write(iulog,*) "error: num_actunit_A is presented but filter_actunit_A is missing" - call endrun( subname//" ERROR: missing required optional arguments" ) - return - end if - SHR_ASSERT_FL((size(filter_actunit_A) > num_actunit_A), sourcefile, __LINE__) -end if -if(present(num_actunit_B))then - if(num_actunit_B < 0)then - write(iulog,*) "error: num_actunit_B cannot be less than 0" - call endrun( subname//" ERROR: bad value for num_actunit_B" ) - return - end if - if(.not. present(filter_actunit_B))then - write(iulog,*) "error: num_actunit_B is presented but filter_actunit_B is missing" - call endrun( subname//" ERROR: missing required optional arguments" ) - return - end if - SHR_ASSERT_FL((size(filter_actunit_B) > num_actunit_B), sourcefile, __LINE__) -end if -if(present(num_actunit_C))then - if(num_actunit_C < 0)then - write(iulog,*) "error: num_actunit_C cannot be less than 0" - call endrun( subname//" ERROR: bad value for num_actunit_C" ) - return - end if - if(.not. present(filter_actunit_C))then - write(iulog,*) "error: num_actunit_C is presented but filter_actunit_C is missing" - call endrun( subname//" ERROR: missing required optional arguments" ) - return - end if - SHR_ASSERT_FL((size(filter_actunit_C) > num_actunit_C), sourcefile, __LINE__) -end if - -if(.not. list_ready)then - i_a=1 - i_b=1 - i_c=1 - i_abc=1 - Aindex(1:A%NE) = (A%CI(1:A%NE)-1)*A%SM+A%RI(1:A%NE) - Bindex(1:B%NE) = (B%CI(1:B%NE)-1)*B%SM+B%RI(1:B%NE) - Cindex(1:C%NE) = (C%CI(1:C%NE)-1)*C%SM+C%RI(1:C%NE) - Aindex(A%NE+1) = A%SM*A%SM+1 - Bindex(B%NE+1) = B%SM*B%SM+1 - Cindex(C%NE+1) = C%SM*C%SM+1 - - do while (i_a .le. A%NE .or. i_b .le. B%NE .or. i_c .le. C%NE) - if(Aindex(i_a) .lt. Bindex(i_b) .and. Aindex(i_a) .lt. Cindex(i_c))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_abc) = A%M(u,i_a) - end do - ABCindex(i_abc) = Aindex(i_a) - if(present(list_A))list_A(i_a) = i_abc - i_a = i_a + 1 - i_abc = i_abc + 1 - else - if(Bindex(i_b) .lt. Aindex(i_a) .and. Bindex(i_b) .lt. Cindex(i_c))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_abc) = B%M(u,i_b) - end do - ABCindex(i_abc) = Bindex(i_b) - if(present(list_B))list_B(i_b) = i_abc - i_b = i_b + 1 - i_abc = i_abc + 1 - else - if(Cindex(i_c) .lt. Aindex(i_a) .and. Cindex(i_c) .lt. Bindex(i_b))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_abc) = C%M(u,i_c) - end do - ABCindex(i_abc) = Cindex(i_c) - if(present(list_C))list_C(i_c) = i_abc - i_c = i_c + 1 - i_abc = i_abc + 1 - else - if(Aindex(i_a) .eq. Bindex(i_b) .and. Aindex(i_a) .lt. Cindex(i_c))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_abc) = A%M(u,i_a) + B%M(u,i_b) - end do - ABCindex(i_abc) = Aindex(i_a) - if(present(list_A))list_A(i_a) = i_abc - if(present(list_B))list_B(i_b) = i_abc - i_a = i_a + 1 - i_b = i_b + 1 - i_abc = i_abc + 1 - else - if(Aindex(i_a) .eq. Cindex(i_c) .and. Aindex(i_a) .lt. Bindex(i_b))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_abc) = A%M(u,i_a) + C%M(u,i_c) - end do - ABCindex(i_abc) = Aindex(i_a) - if(present(list_A))list_A(i_a) = i_abc - if(present(list_C))list_C(i_c) = i_abc - i_a = i_a + 1 - i_c = i_c + 1 - i_abc = i_abc + 1 - else - if(Bindex(i_b) .eq. Cindex(i_c) .and. Bindex(i_b) .lt. Aindex(i_a))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_abc) = B%M(u,i_b) + C%M(u,i_c) - end do - ABCindex(i_abc) = Bindex(i_b) - if(present(list_B))list_B(i_b) = i_abc - if(present(list_C))list_C(i_c) = i_abc - i_b = i_b + 1 - i_c = i_c + 1 - i_abc = i_abc + 1 - else - if(Aindex(i_a) .eq. Bindex(i_b) .and. Aindex(i_a) .eq. Cindex(i_c))then - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i_abc) = A%M(u,i_a) + B%M(u,i_b) + C%M(u,i_c) - end do - ABCindex(i_abc) = Bindex(i_b) - if(present(list_A))list_A(i_a) = i_abc - if(present(list_B))list_B(i_b) = i_abc - if(present(list_C))list_C(i_c) = i_abc - i_a = i_a + 1 - i_b = i_b + 1 - i_c = i_c + 1 - i_abc = i_abc + 1 - else - write(iulog,*) 'Error in subroutine SPMP_ABC',Aindex(i_a),Bindex(i_b),Cindex(i_c) - end if - end if - end if - end if - end if - end if - end if - end do - - this%NE = i_abc - 1 - this%CI(1:this%NE) = (ABCindex(1:this%NE) - 1) / this%SM + 1 - this%RI(1:this%NE) = ABCindex(1:this%NE) - this%SM * (this%CI(1:this%NE) - 1) - if(present(NE_ABC))NE_ABC = this%NE - if(present(CI_ABC))CI_ABC(1:this%NE) = this%CI(1:this%NE) - if(present(RI_ABC))RI_ABC(1:this%NE) = this%RI(1:this%NE) - if(present(list_A) .and. present(list_B) .and. present(list_C) .and. present(NE_ABC) .and. present(RI_ABC) .and. present(CI_ABC))list_ready = .true. -else - do i = 1, NE_ABC - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,i) = 0._r8 - end do - end do - if(present(num_actunit_A))then - do i_a = 1, A%NE - do fu = 1, num_actunit_A - u = filter_actunit_A(fu) - this%M(u,list_A(i_a)) = A%M(u,i_a) - end do - end do - else - do i_a = 1, A%NE - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,list_A(i_a)) = A%M(u,i_a) - end do - end do - end if - if(present(num_actunit_B))then - do i_b = 1, B%NE - do fu = 1, num_actunit_B - u = filter_actunit_B(fu) - this%M(u,list_B(i_b)) = this%M(u,list_B(i_b)) + B%M(u,i_b) - end do - end do - else - do i_b = 1, B%NE - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,list_B(i_b)) = this%M(u,list_B(i_b)) + B%M(u,i_b) - end do - end do - end if - if(present(num_actunit_C))then - do i_c = 1, C%NE - do fu = 1, num_actunit_C - u = filter_actunit_C(fu) - this%M(u,list_C(i_c)) = this%M(u,list_C(i_c)) + C%M(u,i_c) - end do - end do - else - do i_c = 1, C%NE - do fu = 1, num_unit - u = filter_u(fu) - this%M(u,list_C(i_c)) = this%M(u,list_C(i_c)) + C%M(u,i_c) - end do - end do - end if - this%NE = NE_ABC - this%CI(1:this%NE) = CI_ABC(1:NE_ABC) - this%RI(1:this%NE) = RI_ABC(1:NE_ABC) -end if - -end subroutine SPMP_ABC - -end module SPMMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 9de9ebc78..77ed14851 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -41,8 +41,10 @@ module clm_time_manager is_end_curr_day, &! return true on last timestep in current day is_beg_curr_year, &! return true on first timestep in current year + is_end_curr_year, &! return true on last timestep in current year is_restart, &! return true if this is a restart run is_first_step, &! dummy function here, because it is loaded, but not used + is_first_step_of_this_run_segment, &! return true on first step of any run segment (initial, restart or branch run) is_near_local_noon, &! return true if near local noon update_rad_dtime ! track radiation interval via nstep @@ -522,6 +524,41 @@ function get_prev_yearfrac() end function get_prev_yearfrac + !----------------------------------------------------------------------- + logical function is_end_curr_year() + ! + ! !DESCRIPTION: + ! Return true if current timestep is last timestep in current year. + ! + ! !LOCAL VARIABLES: + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + character(len=*), parameter :: subname = 'is_end_curr_year' + !----------------------------------------------------------------------- + + call get_curr_date(yr, mon, day, tod) + is_end_curr_year = (mon == 1 .and. day == 1 .and. tod == 0) + + end function is_end_curr_year + + !========================================================================================= + + logical function is_first_step_of_this_run_segment() + + ! Return true if this is the first step of this run segment. This will be true for + ! the first step of a startup, restart or branch run. + character(len=*), parameter :: sub = 'clm::is_first_step_of_this_run_segment' + + !if ( .not. check_timemgr_initialized(sub) ) return + + is_first_step_of_this_run_segment = (is_first_step()) + + end function is_first_step_of_this_run_segment + !========================================================================================= ! function get_curr_calday(offset) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index 44ebc2ef0..abf4443ac 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -69,6 +69,12 @@ module clm_varctl !---------------------------------------------------------- logical, public :: use_matrixcn = .false. !.false. ! true => use cn matrix logical, public :: use_soil_matrixcn = .false.! true => use cn matrix + logical, public :: isspinup = .false. !.false. ! true => use acc spinup + logical, public :: is_outmatrix = .false.!.false. ! true => use acc spinup + integer, public :: nyr_forcing = 10 ! length of forcing years for the spin up. eg. if DATM_CLMNCEP_YR_START=1901;DATM_CLMNCEP_YR_END=1920, then nyr_forcing = 20 + integer, public :: nyr_SASU = 1 ! length of each semi-analytic solution. eg. nyr_SASU=5, analytic solutions will be calculated every five years. + ! nyr_SASU=1: the fastest SASU, but inaccurate; nyr_SASU=nyr_forcing(eg. 20): the lowest SASU but accurate + integer, public :: iloop_avg = -999 ! The restart file will be based on the average of all analytic solutions within the iloop_avg^th loop. real(r8), public :: nfix_timeconst = -1.2345_r8 From 2ef74c5a35f68e983a35977d6aa33680f9fe7915 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 13 Nov 2024 13:53:59 -0500 Subject: [PATCH 556/589] add parameter read and initialization for FUN --- .../GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 | 8 ++++---- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 ++ 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 index 0cbe3fa43..276c7fc3e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -115,7 +115,7 @@ subroutine CNDriverNoLeaching(bounds, use CropType , only: crop_type use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix,CNFreeLivingFixation use CNMRespMod , only: CNMResp - ! use CNFUNMod , only: CNFUNInit !, CNFUN + use CNFUNMod , only: CNFUNInit !, CNFUN use CNPhenologyMod , only: CNPhenology use CNGRespMod , only: CNGResp use FireMethodType , only: fire_method_type @@ -386,9 +386,9 @@ subroutine CNDriverNoLeaching(bounds, phase=1) call t_stopf('CNPhenology_phase1') -! call t_startf('CNFUNInit') -! call CNFUNInit(bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst) -! call t_stopf('CNFUNInit') + call t_startf('CNFUNInit') + call CNFUNInit(bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst) + call t_stopf('CNFUNInit') end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index b55462bd9..b92d06746 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -77,6 +77,7 @@ module CN_initMod use SoilBiogeochemCompetitionMod , only : SoilBiogeochemCompetitionInit use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams use CNGapMortalityMod , only : readCNGapMortalityParams => readParams + use CNFUNMod , only : readCNFUNParams => readParams use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControlInit @@ -339,6 +340,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call readSoilBiogeochemCompetitionParams(ncid) call readSoilBiogeochemPotentialParams(ncid) call readCNGapMortalityParams(ncid) + call readCNFUNParams(ncid) call ncid%close(rc=status) From 9157b6f8c14be37f09ee8477ca98ac051a60b77a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 15 Nov 2024 08:58:47 -0500 Subject: [PATCH 557/589] add 365-day running mean of ET as input to CLM routines --- .../CLM51/CNCLM_DriverMod.F90 | 4 +- .../GEOS_CatchCNCLM51GridComp.F90 | 37 ++++++++++++++++++- 2 files changed, 39 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 728b7062b..076e9013e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -62,7 +62,7 @@ module CNCLM_DriverMod !--------------------------------- subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& - rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,gdp,& + rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,et365d,gdp,& abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& fsnow,tg10d,t2m5d,sndzn5d,water_inst,first, & psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, wpwet, & @@ -97,6 +97,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real, dimension(nch), intent(in) :: snowfm ! snowfall (kg/m2/s) real, dimension(nch), intent(in) :: prec10d ! 10-day running mean of total precipitation (mm H2O/s) real, dimension(nch), intent(in) :: prec60d ! 60-day running mean of total precipitation (mm H2O/s) + real, dimension(nch), intent(in) :: et365d ! 365-day running mean of total ET (EVPSOI + EVPINT + EVPVEG) (W m-2) real, dimension(nch), intent(in) :: gdp ! Real GDP (K 1995US$/capita) real, dimension(nch), intent(in) :: abm ! Peak month for agricultural fire, unitless real, dimension(nch), intent(in) :: peatf ! Fraction of peatland, unitless (0-1) @@ -264,6 +265,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m water_inst%waterstatebulk_inst%h2osoi_liq_col(n,-nlevsno+1:nlevgrnd) = totwat(nc) water_inst%waterfluxbulk_inst%qflx_drain_col(n) = bflow(nc) water_inst%waterfluxbulk_inst%qflx_surf_col(n) = runsrf(nc) + water_inst%waterfluxbulk_inst%AnnET(n) = et365d(nc)*(0.0864*0.408/3600) ! convert from W m-2 to mm/s ! compute column-level saturated area fraction (water table at surface) if(nz==1) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index ca4ac4756..7704232c4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -1916,6 +1916,17 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddInternalSpec(GC ,& + LONG_NAME = '365-day running mean of total ET',& + UNITS = 'W m-2' ,& + SHORT_NAME = 'ET365D' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RESTART = MAPL_RestartOptional ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddInternalSpec(GC, & LONG_NAME = 'overland_runoff_including_throughflow' ,& UNITS = 'kg m-2 s-1' ,& @@ -4793,6 +4804,7 @@ subroutine Driver ( RC ) real, dimension(:), pointer :: RH30D real, dimension(:), pointer :: TPREC10D real, dimension(:), pointer :: TPREC60D + real, dimension(:), pointer :: ET365D ! ----------------------------------------------------- ! EXPORT Pointers @@ -5227,13 +5239,16 @@ subroutine Driver ( RC ) integer, save :: n10d ! number of land model steps in a 10-day period integer, save :: n30d ! number of land model steps in a 30-day period integer, save :: n60d ! number of land model steps in a 60-day period + integer, save :: n365d ! number of land model steps in a 365-day period ! For accumulated fields ! NOTE: In CNPhenologyMod.F90, init_gdd20 is always set to .false. as well. For GEOS-5 runs, need to discard at least the first 2 years. ! This is not a problem for offline runs because we always spin up the model whenever we change meterology. fzeng, July 2017 ! -------------------------------------------------------------------------------------------------------------------------------------- logical, parameter :: init_accum = .true.! jkolassa May 2023: needs to be set to true if no CNCLM51 restart is available + logical, parameter :: init_accum_365 = .true.! jkolassa May 2023: needs to be set to true if no CNCLM51 restart is available integer, save :: istep ! model time step index + integer, save :: istep_365 ! model time step index integer :: accper ! number of time steps accumulated in a period of XX days, increases from 1 to nXXd in the first XX days, ! and remains as nXXd thereafter integer, allocatable, dimension(:) :: ta_count @@ -5484,6 +5499,7 @@ subroutine Driver ( RC ) call MAPL_GetPointer(INTERNAL,RH30D ,'RH30D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC10D ,'TPREC10D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,TPREC60D ,'TPREC60D' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ET365D ,'ET365D' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,RUNSURF ,'RUNSURF' ,RC=STATUS); VERIFY_(STATUS) if (catchcn_internal%N_CONST_LAND4SNWALB /= 0) then @@ -5689,6 +5705,7 @@ subroutine Driver ( RC ) n10d = 10*86400/dt n30d = 30*86400/dt n60d = 60*86400/dt + n365d = 365*86400/dt ! fzeng: this is done in such way to exclude istep in the restart file if(init_accum) then istep = 0 ! set model time step index to 0 when begin to accumulate the cumulative variables, fzeng, 21 Apr 2017 @@ -5696,6 +5713,14 @@ subroutine Driver ( RC ) istep = maxval((/n10d,n30d,n60d/)) ! otherwise, set model time step index to the maximum of these nXX end if + ! jkolassa: implement this separately for 365-day running mean of ET + if(init_accum_365) then + istep_365 = 0 ! set model time step index to 0 when begin to accumulate the cumulative variables, fzeng, 21 Apr 2017 + else + istep_365 = maxval((/n10d,n30d,n60d,n365d/)) ! otherwise, set model time step index to the maximum of these nXX + end if + + ! variables used for summing CN inputs over multiple land model calls; not saved on restart ! fzeng: run must end on a CN call step ! ----------------------------------------------------------------------------------------- @@ -6671,6 +6696,7 @@ subroutine Driver ( RC ) ! -------------------------------------------------------------------- istep = istep + 1 + istep_365 = istep_365 + 1 TA_MIN(:) = 1000. ! running mean - reset accumulation period until greater than nstep @@ -7080,7 +7106,7 @@ subroutine Driver ( RC ) asnowm = asnowm / cnsum call CN_Driver(ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& - rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,gdp,& + rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,ET365D,gdp,& abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, first_cn, & psnsunm, psnsham, lmrsunm, lmrsham, laisunm, laisham, wpwet, & @@ -7669,6 +7695,15 @@ subroutine Driver ( RC ) end if + ! compute 365-day running mean of total ET (excluding sublimation from snow) + if(init_accum_365) then + ! 365-day running mean of total ET (W m-2) + accper = min(istep_365,n365d) + ET365D = ((accper-1)*ET365D + EVPSOI + EVPINT + EVPVEG) / accper + else + ET365D = ((n365d-1)*ET365D + EVPSOI + EVPINT + EVPVEG) / n365d + endif + if (OFFLINE_MODE /=0) then TC(:,FSAT) = TC1_0 TC(:,FTRN) = TC2_0 From 2fbc19a7a9fc040a17d491d044de8ed0eab902ad Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 15 Nov 2024 09:17:16 -0500 Subject: [PATCH 558/589] add nitrogen parameter namelist read --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index b92d06746..b30d539d5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -78,6 +78,7 @@ module CN_initMod use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams use CNGapMortalityMod , only : readCNGapMortalityParams => readParams use CNFUNMod , only : readCNFUNParams => readParams + use CNNDynamicsMod , only : CNNDynamicsReadNML use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControlInit @@ -251,6 +252,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call CNPhenologyReadNML ( NLFilename ) call dynSubgridControl_init ( ) call CNFireReadNML ( NLFilename ) + call CNNDynamicsReadNML ( NLFilename ) ! initialize states and fluxes From 1906b2324ee5f4d9231ded6e45a1e2f85ba610ac Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 15 Nov 2024 11:18:02 -0500 Subject: [PATCH 559/589] read photosynthesis and canopy state parameters from namelist --- .../CLM51/CNCLM_CanopyStateType.F90 | 61 ++++++++++++++++++- .../CLM51/CN_init_mod.F90 | 2 + .../CLM51/PhotosynthesisMod.F90 | 18 +++--- 3 files changed, 70 insertions(+), 11 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index 1ed191a0f..b17bbe7e5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -56,7 +56,8 @@ module CanopyStateType contains procedure, public :: Init - + procedure, public :: ReadNML + end type canopystate_type type(canopystate_type), public, target, save :: canopystate_inst @@ -138,7 +139,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) ! set parameters to default values or read from parameter file - this%leaf_mr_vcm = 0.032 !0.015 ! jkolassa Mar 2022: 0.015 is default value in CTSM5.1, but accoring to ChangeLog 0.032 should be used for Atkin leaf respiration method, which we are using +! this%leaf_mr_vcm = 0.032 !0.015 ! jkolassa Mar 2022: 0.015 is default value in CTSM5.1, but accoring to ChangeLog 0.032 should be used for Atkin leaf respiration method, which we are using ! initialize variables from restart file or set to cold start value @@ -187,4 +188,60 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start, rc) end subroutine Init + !----------------------------------------------------------------------- + subroutine ReadNML( this, NLFilename ) + ! + ! Read in canopy parameter namelist + ! + ! USES: + use shr_mpi_mod , only : shr_mpi_bcast + use abortutils , only : endrun + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! ARGUMENTS: + implicit none + class(canopystate_type) :: this + character(len=*), intent(IN) :: NLFilename ! Namelist filename + ! LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + real(r8) :: leaf_mr_vcm ! Scalar of leaf respiration to vcmax + character(len=32) :: subname = 'CanopyStateType::ReadNML' ! subroutine name + !----------------------------------------------------------------------- + namelist / clm_canopy_inparm / leaf_mr_vcm + + ! ---------------------------------------------------------------------- + ! Read namelist from input namelist filename + ! ---------------------------------------------------------------------- + + if ( masterproc )then + + unitn = getavu() + write(iulog,*) 'Read in clm_canopy_inparm namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, 'clm_canopy_inparm', status=ierr) + if (ierr == 0) then + read(unitn, clm_canopy_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading clm_canopy_inparm namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR finding clm_canopy_inparm namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + + end if + + ! Broadcast namelist variables read in + call shr_mpi_bcast(leaf_mr_vcm, mpicom) + this%leaf_mr_vcm = leaf_mr_vcm + + end subroutine ReadNML + + end module CanopyStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index b30d539d5..e12a94281 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -253,6 +253,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call dynSubgridControl_init ( ) call CNFireReadNML ( NLFilename ) call CNNDynamicsReadNML ( NLFilename ) + call photosyns_inst%ReadNML ( NLFilename ) + call canopystate_inst%ReadNML ( NLFilename ) ! initialize states and fluxes diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 9cd2d346a..755d9943f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -359,15 +359,15 @@ subroutine Init(this,bounds,nch,ityp,fveg,cncol,cnpft,cn5_cold_start,rc) allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 endif - this%rootstem_acc = .false. ! jkolassa, Jun 2022: Default for CTSM5.1 - - this%light_inhibit = .true. ! jkolassa, Feb 2022: This is the default value for CTSM5.1; we could in the future control this through resource files - - this%leafresp_method = 2 ! jkolassa, Feb 2022: Default for CTSM5.1 if use_cn is true (2 corresponds to Atkin et al., 2015) - - this%stomatalcond_mtd = 2 ! jkolassa, Feb 2022: Default for CTSM5.1, corresponds to Medlyn et al., 2011 - - this%modifyphoto_and_lmr_forcrop = .true. ! jkolassa, Feb 2022: Default for CLM50 and up +! this%rootstem_acc = .false. ! jkolassa, Jun 2022: Default for CTSM5.1 +! +! this%light_inhibit = .true. ! jkolassa, Feb 2022: This is the default value for CTSM5.1; we could in the future control this through resource files +! +! this%leafresp_method = 2 ! jkolassa, Feb 2022: Default for CTSM5.1 if use_cn is true (2 corresponds to Atkin et al., 2015) +! +! this%stomatalcond_mtd = 2 ! jkolassa, Feb 2022: Default for CTSM5.1, corresponds to Medlyn et al., 2011 +! +! this%modifyphoto_and_lmr_forcrop = .true. ! jkolassa, Feb 2022: Default for CLM50 and up ! initialize types from restart file or through cold start values From 3d54d68ad4fcab36e01b149671d7300d2a81f5be Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 15 Nov 2024 11:40:05 -0500 Subject: [PATCH 560/589] add missing source file --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 index b17bbe7e5..1f54142cb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CanopyStateType.F90 @@ -61,6 +61,10 @@ module CanopyStateType end type canopystate_type type(canopystate_type), public, target, save :: canopystate_inst + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + contains !-------------------------------------------------------------- From 3392cc456a52b53ebabce34eb5d7ff3c94ecab4e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 15 Nov 2024 12:47:56 -0500 Subject: [PATCH 561/589] add missing procedure declaration --- .../GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 index 755d9943f..fbcfae073 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/PhotosynthesisMod.F90 @@ -220,6 +220,7 @@ module PhotosynthesisMod ! Public procedures procedure, public :: Init procedure, public :: ReadParams + procedure, public :: ReadNML procedure, public :: TimeStepInit end type photosyns_type From 608c321236479018a22463f5877934904b92cb75 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 15 Nov 2024 15:12:16 -0500 Subject: [PATCH 562/589] set fire parameters in namelist file --- .../CLM51/CNCLM_CNFireBaseMod.F90 | 100 ++++++++---------- .../CLM51/CNCLM_FireDataBaseType.F90 | 4 +- .../CLM51/CNFireFactoryMod.F90 | 3 +- .../CLM51/CNVegetationFacade.F90 | 5 +- .../CLM51/CN_init_mod.F90 | 6 +- .../CLM51/FireMethodType.F90 | 6 +- 6 files changed, 57 insertions(+), 67 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 index 168671f1f..05c4cbbf0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -297,7 +297,7 @@ end subroutine CNFire_calc_fire_root_wetness_Li2021 !---------------------------------------------------------------------- !---------------------------------------------------------------------- - subroutine FireReadNML( this, fire_method ) + subroutine FireReadNML( this, NLFilename ) ! ! !DESCRIPTION: ! Read the namelist for CNFire @@ -308,7 +308,7 @@ subroutine FireReadNML( this, fire_method ) ! ! !ARGUMENTS: class(cnfire_base_type) :: this - character(len=*), intent(in) :: fire_method ! Namelist filename + character(len=*), intent(in) :: NLFilename ! Namelist filename ! ! !LOCAL VARIABLES: integer :: ierr ! error code @@ -322,6 +322,10 @@ subroutine FireReadNML( this, fire_method ) real(r8) :: rh_low, rh_hgh, bt_min, bt_max, occur_hi_gdp_tree real(r8) :: lfuel, ufuel, cmb_cmplt_fact_litter, cmb_cmplt_fact_cwd + namelist /lifire_inparm/ cli_scale, boreal_peatfire_c, pot_hmn_ign_counts_alpha, & + non_boreal_peatfire_c, cropfire_a1, & + rh_low, rh_hgh, bt_min, bt_max, occur_hi_gdp_tree, & + lfuel, ufuel, cmb_cmplt_fact_litter, cmb_cmplt_fact_cwd if ( this%need_lightning_and_popdens() ) then cli_scale = cnfire_const%cli_scale @@ -341,61 +345,36 @@ subroutine FireReadNML( this, fire_method ) ! Initialize options to default values, in case they are not specified in ! the namelist - select case (trim(fire_method)) - - case ("nofire") - - case ("li2014qianfrc") - lfuel = 75._r8 - ufuel = 1050._r8 - rh_low = 30.0_r8 - rh_hgh = 80.0_r8 - bt_min = 0.3_r8 - bt_max = 0.7_r8 - cli_scale = 0.035_r8 - boreal_peatfire_c = 4.2e-5_r8 - pot_hmn_ign_counts_alpha = 0.0035_r8 - non_boreal_peatfire_c = 0.001_r8 - cropfire_a1 = 0.3_r8 - occur_hi_gdp_tree = 0.39_r8 - cmb_cmplt_fact_litter = 0.5_r8 - cmb_cmplt_fact_cwd = 0.25_r8 - case ("li2016crufrc") - lfuel = 105._r8 - ufuel = 1050._r8 - rh_low = 30.0_r8 - rh_hgh = 80.0_r8 - bt_min = 0.85_r8 - bt_max = 0.98_r8 - cli_scale = 0.033_r8 - boreal_peatfire_c = 0.09e-4_r8 - pot_hmn_ign_counts_alpha = 0.01_r8 - non_boreal_peatfire_c = 0.17e-3_r8 - cropfire_a1 = 1.6e-4_r8 - occur_hi_gdp_tree = 0.33_r8 - cmb_cmplt_fact_litter = 0.5_r8 - cmb_cmplt_fact_cwd = 0.28_r8 - case ("li2021gswpfrc") - lfuel = 75._r8 - ufuel = 1050._r8 - rh_low = 30.0_r8 - rh_hgh = 80.0_r8 - bt_min = 0.85_r8 - bt_max = 0.98_r8 - cli_scale = 0.025_r8 - boreal_peatfire_c = 0.09e-4_r8 - pot_hmn_ign_counts_alpha = 0.01_r8 - non_boreal_peatfire_c = 0.17e-3_r8 - cropfire_a1 = 1.6e-4_r8 - occur_hi_gdp_tree = 0.33_r8 - cmb_cmplt_fact_litter = 0.5_r8 - cmb_cmplt_fact_cwd = 0.28_r8 - - case default - write(iulog,*) subname//' ERROR: unknown method: ', fire_method - call endrun(msg=errMsg(sourcefile, __LINE__)) - - end select + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=lifire_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (cli_scale , mpicom) + call shr_mpi_bcast (boreal_peatfire_c , mpicom) + call shr_mpi_bcast (pot_hmn_ign_counts_alpha, mpicom) + call shr_mpi_bcast (non_boreal_peatfire_c , mpicom) + call shr_mpi_bcast (cropfire_a1 , mpicom) + call shr_mpi_bcast (rh_low , mpicom) + call shr_mpi_bcast (rh_hgh , mpicom) + call shr_mpi_bcast (lfuel , mpicom) + call shr_mpi_bcast (ufuel , mpicom) + call shr_mpi_bcast (bt_min , mpicom) + call shr_mpi_bcast (bt_max , mpicom) + call shr_mpi_bcast (occur_hi_gdp_tree , mpicom) + call shr_mpi_bcast (cmb_cmplt_fact_litter , mpicom) + call shr_mpi_bcast (cmb_cmplt_fact_cwd , mpicom) cnfire_const%cli_scale = cli_scale cnfire_const%boreal_peatfire_c = boreal_peatfire_c @@ -412,8 +391,15 @@ subroutine FireReadNML( this, fire_method ) cnfire_const%cmb_cmplt_fact_litter = cmb_cmplt_fact_litter cnfire_const%cmb_cmplt_fact_cwd = cmb_cmplt_fact_cwd + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=lifire_inparm) + write(iulog,*) ' ' + end if end if + end subroutine FireReadNML !----------------------------------------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 index 5804be555..286c3e078 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 @@ -65,7 +65,7 @@ end function need_lightning_and_popdens_interface contains !----------------------------------------------------------------------- - subroutine FireReadNML_interface( this, fire_method ) + subroutine FireReadNML_interface( this, NLFilename ) ! ! !DESCRIPTION: ! Read the namelist for Fire @@ -74,7 +74,7 @@ subroutine FireReadNML_interface( this, fire_method ) ! ! !ARGUMENTS: class(fire_base_type) :: this - character(len=*), intent(in) :: fire_method + character(len=*), intent(in) :: NLFilename ! Namelist filename end subroutine FireReadNML_interface !----------------------------------------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 index 8eedce3fc..06d18e098 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 @@ -98,6 +98,7 @@ subroutine create_cnfire_method( cnfire_method ) use decompMod , only : bounds_type ! ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename class(fire_method_type), allocatable, intent(inout) :: cnfire_method ! ! !LOCAL VARIABLES: @@ -120,7 +121,7 @@ subroutine create_cnfire_method( cnfire_method ) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - call cnfire_method%FireReadNML( fire_method ) + call cnfire_method%FireReadNML( NLFilename ) end subroutine create_cnfire_method !----------------------------------------------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 1856cb42a..a0703a5d2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -195,7 +195,7 @@ module CNVegetationFacade contains !----------------------------------------------------------------------- - subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold_start) + subroutine Init(this, bounds, NLFilename, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold_start) ! ! !DESCRIPTION: @@ -214,6 +214,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold ! !ARGUMENTS: class(cn_vegetation_type), intent(inout) :: this type(bounds_type), intent(in) :: bounds + character(len=*) , intent(in) :: NLFilename ! namelist filename integer, intent(in) :: nch ! number of tiles integer, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: ityp ! PFT index real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction @@ -277,7 +278,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold call this%dgvs_inst%Init(bounds) end if - call create_cnfire_method(this%cnfire_method) + call create_cnfire_method(NLFilename, this%cnfire_method) call this%cnfire_method%FireInit(bounds) call ncid%open(trim(paramfile),pFIO_READ, RC=status) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index e12a94281..19b60b838 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -60,7 +60,7 @@ module CN_initMod use WaterType , only : water_type use CNBalanceCheckMod - use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc + use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc, DecompCascadeBGCreadNML use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn use SoilBiogeochemDecompCascadeCNMod , only : readSoilBiogeochemDecompCnParams => readParams use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method @@ -255,12 +255,14 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call CNNDynamicsReadNML ( NLFilename ) call photosyns_inst%ReadNML ( NLFilename ) call canopystate_inst%ReadNML ( NLFilename ) + call DecompCascadeBGCreadNML ( NLFilename ) + ! initialize states and fluxes call pftcon%init_pftcon_type () - call bgc_vegetation_inst%Init(bounds, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold_start) + call bgc_vegetation_inst%Init(bounds, NLFilename, nch, ityp, fveg, cncol, cnpft, paramfile, cn5_cold_start) call atm2lnd_inst%Init (bounds) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 index 25f715d63..356e7ad04 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 @@ -52,7 +52,7 @@ module FireMethodType ! consistent between different implementations. ! !--------------------------------------------------------------------------- - subroutine FireInit_interface(this, bounds) + subroutine FireInit_interface(this, bounds, NLFilename) ! ! !DESCRIPTION: ! Initialize Fire datasets @@ -68,7 +68,7 @@ subroutine FireInit_interface(this, bounds) end subroutine FireInit_interface - subroutine FireReadNML_interface(this, fire_method ) + subroutine FireReadNML_interface(this, NLFilename ) ! ! !DESCRIPTION: ! Read general fire namelist @@ -77,7 +77,7 @@ subroutine FireReadNML_interface(this, fire_method ) import :: fire_method_type ! !ARGUMENTS: class(fire_method_type) :: this - character(len=*), intent(in) :: fire_method + character(len=*), intent(in) :: NLFilename !----------------------------------------------------------------------- end subroutine FireReadNML_interface From bafb7ce23a3afa493015059844897fcf3e97ee2f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 15 Nov 2024 16:12:01 -0500 Subject: [PATCH 563/589] overwrite default parameters with parameters from namelist file --- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 64 ++++++++++- .../CLM51/CNCLM_FireDataBaseType.F90 | 3 +- .../CLM51/CNVegetationFacade.F90 | 2 +- .../CLM51/CN_init_mod.F90 | 15 +-- .../CLM51/FireMethodType.F90 | 2 +- .../CLM51/SurfaceAlbedoMod.F90 | 104 +++++++++--------- 6 files changed, 125 insertions(+), 65 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 3305328e5..2f21fcb2b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -223,7 +223,7 @@ module CNVegCarbonStateType contains !---------------------------------------------- - subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) + subroutine Init(this, bounds, NLFilename, nch, ityp, fveg, cncol, cnpft) ! !DESCRIPTION: ! Initialize CTSM carbon states @@ -235,6 +235,7 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) ! INPUT type(bounds_type), intent(in) :: bounds + character(len=*) , intent(in) :: NLFilename ! Namelist filename integer, intent(in) :: nch ! number of tiles integer, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: ityp ! PFT index real, dimension(nch,NUM_VEG,NUM_ZON), intent(in) :: fveg ! PFT fraction @@ -527,8 +528,69 @@ subroutine Init(this, bounds, nch, ityp, fveg, cncol, cnpft) end do ! nz end do ! nc + call this%InitReadNML ( NLFilename ) + end subroutine Init + !------------------------------------------------------------------------ + subroutine InitReadNML(this, NLFilename) + ! + ! !DESCRIPTION: + ! Read the namelist for CNVegCarbonState + ! + !USES: + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + class(cnveg_carbonstate_type) :: this + character(len=*) , intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + character(len=*), parameter :: subname = 'InitReadNML' + character(len=*), parameter :: nmlname = 'cnvegcarbonstate' ! MUST match what is in namelist below + !----------------------------------------------------------------------- + real(r8) :: initial_vegC + namelist /cnvegcarbonstate/ initial_vegC + + initial_vegC = cnvegcstate_const%initial_vegC + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=cnvegcarbonstate, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast (initial_vegC , mpicom) + + cnvegcstate_const%initial_vegC = initial_vegC + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) nmlname//' settings:' + write(iulog,nml=cnvegcarbonstate) ! Name here MUST be the same as in nmlname above! + write(iulog,*) ' ' + end if + + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & num_soilc, filter_soilc, num_soilp, filter_soilp, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 index 286c3e078..1a4ad1fb9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_FireDataBaseType.F90 @@ -78,7 +78,7 @@ subroutine FireReadNML_interface( this, NLFilename ) end subroutine FireReadNML_interface !----------------------------------------------------------------------- - subroutine BaseFireInit( this, bounds ) + subroutine BaseFireInit( this, bounds) ! ! !DESCRIPTION: ! Initialize CN Fire module @@ -88,6 +88,7 @@ subroutine BaseFireInit( this, bounds ) ! !ARGUMENTS: class(fire_base_type) :: this type(bounds_type), intent(in) :: bounds + !character(len=*), intent(in) :: NLFilename !----------------------------------------------------------------------- if ( this%need_lightning_and_popdens() ) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index a0703a5d2..28a81f0f7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -243,7 +243,7 @@ subroutine Init(this, bounds, NLFilename, nch, ityp, fveg, cncol, cnpft, paramfi ! Read in the general CN namelist ! call this%CNReadNML( NLFilename ) ! MUST be called first as passes down control information to others - call this%cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + call this%cnveg_carbonstate_inst%Init (bounds, NLFilename, nch, ityp, fveg, cncol, cnpft) if (use_c13) then call this%c13_cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 19b60b838..0890d3b64 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -42,7 +42,7 @@ module CN_initMod use CNDVType use LandunitType , only : lun use RootBiophysMod - use CNMRespMod , only : readCNMRespParams => readParams + use CNMRespMod , only : readCNMRespParams => readParams, CNMRespReadNML use CNSharedParamsMod , only : CNParamsReadShared use spmdMod use Wateratm2lndBulkType @@ -79,7 +79,7 @@ module CN_initMod use CNGapMortalityMod , only : readCNGapMortalityParams => readParams use CNFUNMod , only : readCNFUNParams => readParams use CNNDynamicsMod , only : CNNDynamicsReadNML - + use SurfaceAlbedoMod , only: SurfaceAlbedo_readnl use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControlInit use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & @@ -206,7 +206,6 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget type(Netcdf4_fileformatter) :: ncid integer :: rc, status, ndt - integer, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function !----------------------------------------- paramfile = '/discover/nobackup/jkolassa/CLM/parameter_files/ctsm51_params.c210923.nc' @@ -256,7 +255,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call photosyns_inst%ReadNML ( NLFilename ) call canopystate_inst%ReadNML ( NLFilename ) call DecompCascadeBGCreadNML ( NLFilename ) - + call CNMRespReadNML ( NLFilename ) + call SurfaceAlbedo_readnl ( NLFilename ) ! initialize states and fluxes @@ -312,12 +312,9 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget ! calls to original CTSM initialization routines - ! initialize rooting profile with default values - rooting_profile_method_water = zeng_2001_root - rooting_profile_method_carbon = zeng_2001_root - rooting_profile_varindex_water = 1 - rooting_profile_varindex_carbon = 2 + ! initialize rooting profile parameters from namelist + call init_rootprof(NLFilename) ! initialize root fractions call init_vegrootfr(bounds, nlevsoi, nlevgrnd, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 index 356e7ad04..4c714a751 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/FireMethodType.F90 @@ -52,7 +52,7 @@ module FireMethodType ! consistent between different implementations. ! !--------------------------------------------------------------------------- - subroutine FireInit_interface(this, bounds, NLFilename) + subroutine FireInit_interface(this, bounds) ! ! !DESCRIPTION: ! Initialize Fire datasets diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 index 039e86cbf..53854cb71 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SurfaceAlbedoMod.F90 @@ -32,7 +32,7 @@ module SurfaceAlbedoMod implicit none ! ! !PUBLIC MEMBER FUNCTIONS: - ! public :: SurfaceAlbedo_readnl + public :: SurfaceAlbedo_readnl ! public :: SurfaceAlbedoInitTimeConst ! public :: SurfaceAlbedo ! Surface albedo and two-stream fluxes ! @@ -82,57 +82,57 @@ module SurfaceAlbedoMod contains !----------------------------------------------------------------------- -! subroutine SurfaceAlbedo_readnl( NLFilename ) -! ! -! ! !DESCRIPTION: -! ! Read the namelist for SurfaceAlbedo -! ! -! ! !USES: -! use spmdMod , only : masterproc, mpicom -! use fileutils , only : getavu, relavu, opnfil -! use shr_nl_mod , only : shr_nl_find_group_name -! use shr_mpi_mod , only : shr_mpi_bcast -! ! -! ! !ARGUMENTS: -! character(len=*), intent(in) :: NLFilename ! Namelist filename -! ! -! ! !LOCAL VARIABLES: -! integer :: ierr ! error code -! integer :: unitn ! unit for namelist file -! character(len=*), parameter :: nmlname = "surfacealbedo_inparm" -! -! character(len=*), parameter :: subname = 'SurfaceAlbedo_readnl' -! !----------------------------------------------------------------------- -! -! namelist /surfacealbedo_inparm/ snowveg_affects_radiation -! -! if (masterproc) then -! unitn = getavu() -! write(iulog,*) 'Read in '//nmlname//' namelist' -! call opnfil (NLFilename, unitn, 'F') -! call shr_nl_find_group_name(unitn, nmlname, status=ierr) -! if (ierr == 0) then -! read(unitn, nml=surfacealbedo_inparm, iostat=ierr) -! if (ierr /= 0) then -! call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) -! end if -! else -! call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) -! end if -! call relavu( unitn ) -! end if -! -! call shr_mpi_bcast(snowveg_affects_radiation, mpicom) -! -! if (masterproc) then -! write(iulog,*) -! write(iulog,*) nmlname, ' settings' -! write(iulog,nml=surfacealbedo_inparm) -! write(iulog,*) -! end if -! -! end subroutine SurfaceAlbedo_readnl -! + subroutine SurfaceAlbedo_readnl( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for SurfaceAlbedo + ! + ! !USES: + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=*), parameter :: nmlname = "surfacealbedo_inparm" + + character(len=*), parameter :: subname = 'SurfaceAlbedo_readnl' + !----------------------------------------------------------------------- + + namelist /surfacealbedo_inparm/ snowveg_affects_radiation + + if (masterproc) then + unitn = getavu() + write(iulog,*) 'Read in '//nmlname//' namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=surfacealbedo_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + end if + + call shr_mpi_bcast(snowveg_affects_radiation, mpicom) + + if (masterproc) then + write(iulog,*) + write(iulog,*) nmlname, ' settings' + write(iulog,nml=surfacealbedo_inparm) + write(iulog,*) + end if + + end subroutine SurfaceAlbedo_readnl + ! ! !----------------------------------------------------------------------- ! subroutine SurfaceAlbedoInitTimeConst(bounds) From fa2a1ad6bbab89793457518e89d155a9df059653 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 18 Nov 2024 10:14:39 -0500 Subject: [PATCH 564/589] add missing subroutine end statement --- .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 2f21fcb2b..86072aabd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -589,7 +589,7 @@ subroutine InitReadNML(this, NLFilename) end if !----------------------------------------------------------------------- - + end subroutine InitReadNML !----------------------------------------------------------------------- subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & From 01892d206f5c874befa478542941b7c67f3903e1 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Nov 2024 10:21:22 -0500 Subject: [PATCH 565/589] bug fixes --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 | 4 ++++ .../CLM51/CNCLM_CNVegCarbonStateType.F90 | 3 +++ .../GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 | 4 ++-- 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 index 05c4cbbf0..0b70acadc 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNFireBaseMod.F90 @@ -303,8 +303,12 @@ subroutine FireReadNML( this, NLFilename ) ! Read the namelist for CNFire ! ! !USES: + use fileutils , only : getavu, relavu, opnfil use shr_nl_mod , only : shr_nl_find_group_name + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast use clm_varctl , only : iulog + ! ! !ARGUMENTS: class(cnfire_base_type) :: this diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 index 86072aabd..329b6f21f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonStateType.F90 @@ -11,6 +11,8 @@ module CNVegCarbonStateType use decompMod , only : bounds_type use pftconMod , only : noveg, npcropmin, pftcon use PatchType , only : patch + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg ! !PUBLIC TYPES: implicit none @@ -201,6 +203,7 @@ module CNVegCarbonStateType procedure , public :: Summary => Summary_carbonstate procedure , public :: ZeroDWT procedure , public :: Init + procedure , private :: InitReadNML ! Read in namelist end type cnveg_carbonstate_type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 index 06d18e098..dbd9b70d1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFireFactoryMod.F90 @@ -82,7 +82,7 @@ end subroutine CNFireReadNML !----------------------------------------------------------------------- !----------------------------------------------------------------------- - subroutine create_cnfire_method( cnfire_method ) + subroutine create_cnfire_method( NLFilename, cnfire_method ) ! ! !DESCRIPTION: ! Create and return an object of fire_method_type. The particular type diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 index 28a81f0f7..a792cf7cf 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNVegetationFacade.F90 @@ -246,10 +246,10 @@ subroutine Init(this, bounds, NLFilename, nch, ityp, fveg, cncol, cnpft, paramfi call this%cnveg_carbonstate_inst%Init (bounds, NLFilename, nch, ityp, fveg, cncol, cnpft) if (use_c13) then - call this%c13_cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + call this%c13_cnveg_carbonstate_inst%Init (bounds, NLFilename, nch, ityp, fveg, cncol, cnpft) end if if (use_c14) then - call this%c14_cnveg_carbonstate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft) + call this%c14_cnveg_carbonstate_inst%Init (bounds, NLFilename, nch, ityp, fveg, cncol, cnpft) end if call this%cnveg_carbonflux_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, 'c12', cn5_cold_start) if (use_c13) then From 651b3cdccc23e189849f495710e12b6b1a32679c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Nov 2024 13:33:32 -0500 Subject: [PATCH 566/589] add root profile initialization --- .../CLM51/RootBiophysMod.F90 | 150 +++++++++--------- 1 file changed, 75 insertions(+), 75 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 index 1a6f68f3f..6e94ddef4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 @@ -12,7 +12,7 @@ module RootBiophysMod private ! public :: init_vegrootfr -! public :: init_rootprof + public :: init_rootprof integer, private, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function integer, private, parameter :: jackson_1996_root = 1 !the jackson 1996 root profile function @@ -31,80 +31,80 @@ module RootBiophysMod contains !-------------------------------------------------------------------------------------- -! subroutine init_rootprof(NLFilename) -! ! -! !DESCRIPTION -! ! initialize methods for root profile calculation -! -! ! !USES: -! use abortutils , only : endrun -! use fileutils , only : getavu, relavu -! use spmdMod , only : mpicom, masterproc -! use shr_mpi_mod , only : shr_mpi_bcast -! use clm_varctl , only : iulog -! use clm_nlUtilsMod , only : find_nlgroup_name -! -! ! !ARGUMENTS: -! !------------------------------------------------------------------------------ -! implicit none -! character(len=*), intent(in) :: NLFilename -! -! integer :: nu_nml ! unit for namelist file -! integer :: nml_error ! namelist i/o error flag -! character(*), parameter :: subName = "('init_rootprof')" -! -! !----------------------------------------------------------------------- -! -!! MUST agree with name in namelist and read statement -! namelist /rooting_profile_inparm/ rooting_profile_method_water, rooting_profile_method_carbon, & -! rooting_profile_varindex_water, rooting_profile_varindex_carbon -! -! ! Default values for namelist -! -! rooting_profile_method_water = zeng_2001_root -! rooting_profile_method_carbon = zeng_2001_root -! rooting_profile_varindex_water = 1 -! rooting_profile_varindex_carbon = 2 -! -! ! Read rooting_profile namelist -! if (masterproc) then -! nu_nml = getavu() -! open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) -! call find_nlgroup_name(nu_nml, 'rooting_profile_inparm', status=nml_error) -! if (nml_error == 0) then -! read(nu_nml, nml=rooting_profile_inparm,iostat=nml_error) -! if (nml_error /= 0) then -! call endrun(subname // ':: ERROR reading rooting_profile namelist') -! end if -! else -! call endrun(subname // ':: ERROR finding rooting_profile namelist') -! end if -! close(nu_nml) -! call relavu( nu_nml ) -! -! endif -! -! call shr_mpi_bcast(rooting_profile_method_water, mpicom) -! call shr_mpi_bcast(rooting_profile_method_carbon, mpicom) -! call shr_mpi_bcast(rooting_profile_varindex_water, mpicom) -! call shr_mpi_bcast(rooting_profile_varindex_carbon, mpicom) -! -! if (masterproc) then -! -! write(iulog,*) ' ' -! write(iulog,*) 'rooting_profile settings:' -! write(iulog,*) ' rooting_profile_method_water = ',rooting_profile_method_water -! if ( rooting_profile_method_water == jackson_1996_root )then -! write(iulog,*) ' (rooting_profile_varindex_water = ',rooting_profile_varindex_water, ')' -! end if -! write(iulog,*) ' rooting_profile_method_carbon = ',rooting_profile_method_carbon -! if ( rooting_profile_method_carbon == jackson_1996_root )then -! write(iulog,*) ' (rooting_profile_varindex_carbon = ',rooting_profile_varindex_carbon, ')' -! end if -! -! endif -! -! end subroutine init_rootprof + subroutine init_rootprof(NLFilename) + ! + !DESCRIPTION + ! initialize methods for root profile calculation + + ! !USES: + use abortutils , only : endrun + use fileutils , only : getavu, relavu + use spmdMod , only : mpicom, masterproc + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + use clm_nlUtilsMod , only : find_nlgroup_name + + ! !ARGUMENTS: + !------------------------------------------------------------------------------ + implicit none + character(len=*), intent(in) :: NLFilename + + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + character(*), parameter :: subName = "('init_rootprof')" + + !----------------------------------------------------------------------- + +! MUST agree with name in namelist and read statement + namelist /rooting_profile_inparm/ rooting_profile_method_water, rooting_profile_method_carbon, & + rooting_profile_varindex_water, rooting_profile_varindex_carbon + + ! Default values for namelist + + rooting_profile_method_water = zeng_2001_root + rooting_profile_method_carbon = zeng_2001_root + rooting_profile_varindex_water = 1 + rooting_profile_varindex_carbon = 2 + + ! Read rooting_profile namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'rooting_profile_inparm', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=rooting_profile_inparm,iostat=nml_error) + if (nml_error /= 0) then + call endrun(subname // ':: ERROR reading rooting_profile namelist') + end if + else + call endrun(subname // ':: ERROR finding rooting_profile namelist') + end if + close(nu_nml) + call relavu( nu_nml ) + + endif + + call shr_mpi_bcast(rooting_profile_method_water, mpicom) + call shr_mpi_bcast(rooting_profile_method_carbon, mpicom) + call shr_mpi_bcast(rooting_profile_varindex_water, mpicom) + call shr_mpi_bcast(rooting_profile_varindex_carbon, mpicom) + + if (masterproc) then + + write(iulog,*) ' ' + write(iulog,*) 'rooting_profile settings:' + write(iulog,*) ' rooting_profile_method_water = ',rooting_profile_method_water + if ( rooting_profile_method_water == jackson_1996_root )then + write(iulog,*) ' (rooting_profile_varindex_water = ',rooting_profile_varindex_water, ')' + end if + write(iulog,*) ' rooting_profile_method_carbon = ',rooting_profile_method_carbon + if ( rooting_profile_method_carbon == jackson_1996_root )then + write(iulog,*) ' (rooting_profile_varindex_carbon = ',rooting_profile_varindex_carbon, ')' + end if + + endif + + end subroutine init_rootprof !-------------------------------------------------------------------------------------- subroutine init_vegrootfr(bounds, nlevsoi, nlevgrnd, rootfr, water_carbon) From 5c9658e58f2684e7609c358d5c8ef1fe523edc6e Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Nov 2024 14:08:58 -0500 Subject: [PATCH 567/589] fix root profile namelist read --- .../CLM51/RootBiophysMod.F90 | 23 +++++++++---------- 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 index 6e94ddef4..8c910b694 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/RootBiophysMod.F90 @@ -38,19 +38,19 @@ subroutine init_rootprof(NLFilename) ! !USES: use abortutils , only : endrun - use fileutils , only : getavu, relavu + use fileutils , only : getavu, relavu, opnfil use spmdMod , only : mpicom, masterproc use shr_mpi_mod , only : shr_mpi_bcast use clm_varctl , only : iulog - use clm_nlUtilsMod , only : find_nlgroup_name + use shr_nl_mod , only : shr_nl_find_group_name ! !ARGUMENTS: !------------------------------------------------------------------------------ implicit none character(len=*), intent(in) :: NLFilename - integer :: nu_nml ! unit for namelist file - integer :: nml_error ! namelist i/o error flag + integer :: unitn ! unit for namelist file + integer :: ierr ! namelist i/o error flag character(*), parameter :: subName = "('init_rootprof')" !----------------------------------------------------------------------- @@ -68,19 +68,18 @@ subroutine init_rootprof(NLFilename) ! Read rooting_profile namelist if (masterproc) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call find_nlgroup_name(nu_nml, 'rooting_profile_inparm', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=rooting_profile_inparm,iostat=nml_error) - if (nml_error /= 0) then + unitn = getavu() + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, 'rooting_profile_inparm', status=ierr) + if (ierr == 0) then + read(unitn, rooting_profile_inparm,iostat=ierr) + if (ierr /= 0) then call endrun(subname // ':: ERROR reading rooting_profile namelist') end if else call endrun(subname // ':: ERROR finding rooting_profile namelist') end if - close(nu_nml) - call relavu( nu_nml ) + call relavu( unitn ) endif From 3a5e6d3f455fab9ca4a8d506f58ce0b9b676118c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 19 Nov 2024 20:27:11 -0500 Subject: [PATCH 568/589] enable CNFUN --- .../CNCLM_SoilBiogeochemCompetitionMod.F90 | 60 +++++++++---------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCompetitionMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCompetitionMod.F90 index ab4b10cd3..76c1da3ac 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCompetitionMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCompetitionMod.F90 @@ -178,7 +178,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions use clm_varcon , only: nitrif_n2o_loss_frac use CNSharedParamsMod, only: use_fun - ! use CNFUNMod , only: CNFUN + use CNFUNMod , only: CNFUN use subgridAveMod , only: p2c use perf_mod , only : t_startf, t_stopf ! @@ -365,17 +365,17 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end do if ( local_use_fun ) then -! call t_startf( 'CNFUN' ) -! call CNFUN(bounds,num_soilc,filter_soilc,num_soilp,filter_soilp,waterstatebulk_inst, & -! waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst,cnveg_carbonstate_inst,& -! cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst ,& -! soilbiogeochem_nitrogenflux_inst,soilbiogeochem_carbonflux_inst,canopystate_inst, & -! soilbiogeochem_nitrogenstate_inst) -! call p2c(bounds, nlevdecomp, & -! cnveg_nitrogenflux_inst%sminn_to_plant_fun_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& -! soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_vr_col(bounds%begc:bounds%endc,1:nlevdecomp), & -! 'unity') -! call t_stopf( 'CNFUN' ) + call t_startf( 'CNFUN' ) + call CNFUN(bounds,num_soilc,filter_soilc,num_soilp,filter_soilp,waterstatebulk_inst, & + waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst,cnveg_carbonstate_inst,& + cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst ,& + soilbiogeochem_nitrogenflux_inst,soilbiogeochem_carbonflux_inst,canopystate_inst, & + soilbiogeochem_nitrogenstate_inst) + call p2c(bounds, nlevdecomp, & + cnveg_nitrogenflux_inst%sminn_to_plant_fun_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& + soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_vr_col(bounds%begc:bounds%endc,1:nlevdecomp), & + 'unity') + call t_stopf( 'CNFUN' ) end if ! sum up N fluxes to plant @@ -733,24 +733,24 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end do if ( local_use_fun ) then -! call t_startf( 'CNFUN' ) -! call CNFUN(bounds,num_soilc,filter_soilc,num_soilp,filter_soilp,waterstatebulk_inst,& -! waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst,cnveg_carbonstate_inst,& -! cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst ,& -! soilbiogeochem_nitrogenflux_inst,soilbiogeochem_carbonflux_inst,canopystate_inst, & -! soilbiogeochem_nitrogenstate_inst) -! -! ! sminn_to_plant_fun is output of actual N uptake from FUN -! call p2c(bounds,nlevdecomp, & -! cnveg_nitrogenflux_inst%sminn_to_plant_fun_no3_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& -! soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_no3_vr_col(bounds%begc:bounds%endc,1:nlevdecomp),& -! 'unity') -! -! call p2c(bounds,nlevdecomp, & -! cnveg_nitrogenflux_inst%sminn_to_plant_fun_nh4_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& -! soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_nh4_vr_col(bounds%begc:bounds%endc,1:nlevdecomp),& -! 'unity') -! call t_stopf( 'CNFUN' ) + call t_startf( 'CNFUN' ) + call CNFUN(bounds,num_soilc,filter_soilc,num_soilp,filter_soilp,waterstatebulk_inst,& + waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst,cnveg_carbonstate_inst,& + cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst ,& + soilbiogeochem_nitrogenflux_inst,soilbiogeochem_carbonflux_inst,canopystate_inst, & + soilbiogeochem_nitrogenstate_inst) + + ! sminn_to_plant_fun is output of actual N uptake from FUN + call p2c(bounds,nlevdecomp, & + cnveg_nitrogenflux_inst%sminn_to_plant_fun_no3_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& + soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_no3_vr_col(bounds%begc:bounds%endc,1:nlevdecomp),& + 'unity') + + call p2c(bounds,nlevdecomp, & + cnveg_nitrogenflux_inst%sminn_to_plant_fun_nh4_vr_patch(bounds%begp:bounds%endp,1:nlevdecomp),& + soilbiogeochem_nitrogenflux_inst%sminn_to_plant_fun_nh4_vr_col(bounds%begc:bounds%endc,1:nlevdecomp),& + 'unity') + call t_stopf( 'CNFUN' ) end if From bc3b559383da85c2b6802d4415519472c809bbdd Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 20 Nov 2024 09:08:01 -0500 Subject: [PATCH 569/589] add initialization for several nitrogen states --- .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 31 ++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index c8cfb9ab1..38257e093 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -11,6 +11,10 @@ module SoilBiogeochemNitrogenStateType use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp, use_soil_matrixcn use decompMod , only : bounds_type use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use LandunitType , only : lun + use ColumnType , only : col + use landunit_varcon , only : istcrop, istsoil + ! !PUBLIC TYPES: implicit none @@ -94,7 +98,7 @@ subroutine Init(this, bounds, nch, cncol) ! ! !LOCAL VARIABLES: integer :: begc,endc - integer :: n, nc, nz, np + integer :: n, nc, nz, np, l, c integer, dimension(8) :: decomp_npool_cncol_index = (/ 18, 19, 20, 17,25, 26, 27, 28 /) !----------------------------------- @@ -165,6 +169,14 @@ subroutine Init(this, bounds, nch, cncol) this%sminn_vr_col (n,1:nlevdecomp_full) = cncol(nc,nz,24) this%sminn_col (n) = this%sminn_vr_col(n,1) + ! jkolassa Nov 2024: temporary initialization for NO3 and NH4; need to be + ! added as restart variables + this%smin_no3_col(n) = (1.25/2.25)*this%sminn_col(n) + this%smin_nh4_col(n) = this%sminn_col(n)/2.25 + this%smin_no3_vr_col(n,1:nlevdecomp_full) = this%smin_no3_col(n) + this%smin_nh4_vr_col(n,1:nlevdecomp_full) = this%smin_nh4_col(n) + + do np = 1,ndecomp_pools ! jkolassa May 2022: accounting for fact that pool order in CNCOL is different from CTSM this%decomp_npools_col (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) @@ -175,6 +187,23 @@ subroutine Init(this, bounds, nch, cncol) end do !nz end do + do c = begc, endc + l = col%landunit(c) + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + this%totlitn_col(c) = 0._r8 + this%totsomn_col(c) = 0._r8 + this%totlitn_1m_col(c) = 0._r8 + this%totsomn_1m_col(c) = 0._r8 + this%cwdn_col(c) = 0._r8 + + end if + end do + + + + end subroutine Init !----------------------------------------------------------------------- From 2eb8137b3b7cc67d3c473a93b8a2fdb061cdceef Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 20 Nov 2024 13:00:48 -0500 Subject: [PATCH 570/589] add soil nitrification/denitrification calculations --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/CNDriverMod.F90 | 8 +- .../CLM51/CN_init_mod.F90 | 4 +- .../CLM51/SoilBiogeochemNitrifDenitrifMod.F90 | 396 ++++++++++++++++++ .../CLM51/clm_varcon.F90 | 20 +- 5 files changed, 423 insertions(+), 6 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNitrifDenitrifMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index 3b8036ec5..ae43f2dee 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -126,6 +126,7 @@ set (srcs SoilBiogeochemDecompCascadeCNMod.F90 SoilBiogeochemDecompMod.F90 SoilBiogeochemLittVertTranspMod.F90 + SoilBiogeochemNitrifDenitrifMod.F90 SoilBiogeochemNLeachingMod.F90 SoilBiogeochemNStateUpdate1Mod.F90 SoilBiogeochemPotentialMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 index 276c7fc3e..8b7f2c43d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNDriverMod.F90 @@ -136,7 +136,7 @@ subroutine CNDriverNoLeaching(bounds, use SoilBiogeochemLittVertTranspMod , only: SoilBiogeochemLittVertTransp use SoilBiogeochemPotentialMod , only: SoilBiogeochemPotential use SoilBiogeochemVerticalProfileMod , only: SoilBiogeochemVerticalProfile - ! use SoilBiogeochemNitrifDenitrifMod , only: SoilBiogeochemNitrifDenitrif + use SoilBiogeochemNitrifDenitrifMod , only: SoilBiogeochemNitrifDenitrif use SoilBiogeochemNStateUpdate1Mod , only: SoilBiogeochemNStateUpdate1 use NutrientCompetitionMethodMod , only: nutrient_competition_method_type use CNRootDynMod , only: CNRootDyn @@ -349,9 +349,9 @@ subroutine CNDriverNoLeaching(bounds, ! calculate nitrification and denitrification rates (previously subroutine nitrif_denitrif called from CNDecompAlloc) if (use_nitrif_denitrif) then -! call SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & -! soilstate_inst, waterstatebulk_inst, temperature_inst, ch4_inst, & -! soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + call SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & + soilstate_inst, waterstatebulk_inst, temperature_inst, ch4_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) end if call t_stopf('SoilBiogeochem') diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 0890d3b64..69c9df3aa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -81,7 +81,8 @@ module CN_initMod use CNNDynamicsMod , only : CNNDynamicsReadNML use SurfaceAlbedoMod , only: SurfaceAlbedo_readnl use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControlInit - + use SoilBiogeochemNitrifDenitrifMod , only : readSoilBiogeochemNitrifDenitrifParams => readParams + use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -344,6 +345,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call readSoilBiogeochemPotentialParams(ncid) call readCNGapMortalityParams(ncid) call readCNFUNParams(ncid) + call readSoilBiogeochemNitrifDenitrifParams(ncid) call ncid%close(rc=status) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNitrifDenitrifMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNitrifDenitrifMod.F90 new file mode 100755 index 000000000..784b90719 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemNitrifDenitrifMod.F90 @@ -0,0 +1,396 @@ +module SoilBiogeochemNitrifDenitrifMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate nitrification and denitrification rates + ! + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : nlevdecomp + use clm_varcon , only : rpi, grav + use clm_varcon , only : d_con_g, d_con_w, secspday + use clm_varctl , only : use_lch4 + use abortutils , only : endrun + use decompMod , only : bounds_type + use SoilStatetype , only : soilstate_type + use WaterStateBulkType , only : waterstatebulk_type + use TemperatureType , only : temperature_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use ch4Mod , only : ch4_type + use ColumnType , only : col + ! + implicit none + private + ! + public :: readParams ! Read in parameters from params file + public :: SoilBiogeochemNitrifDenitrif ! Calculate nitrification and + ! + type, private :: params_type + real(r8) :: k_nitr_max_perday ! maximum nitrification rate constant (1/day) + real(r8) :: surface_tension_water ! surface tension of water(J/m^2), Arah an and Vinten 1995 + real(r8) :: rij_kro_a ! Arah and Vinten 1995) + real(r8) :: rij_kro_alpha ! parameter to calculate anoxic fraction of soil (Arah and Vinten 1995) + real(r8) :: rij_kro_beta ! (Arah and Vinten 1995) + real(r8) :: rij_kro_gamma ! (Arah and Vinten 1995) + real(r8) :: rij_kro_delta ! (Arah and Vinten 1995) + real(r8) :: denitrif_respiration_coefficient ! Multiplier for heterotrophic respiration for max denitrif rates + real(r8) :: denitrif_respiration_exponent ! Exponents for heterotrophic respiration for max denitrif rates + real(r8) :: denitrif_nitrateconc_coefficient ! Multiplier for nitrate concentration for max denitrif rates + real(r8) :: denitrif_nitrateconc_exponent ! Exponent for nitrate concentration for max denitrif rates + end type params_type + + type(params_type), private :: params_inst + + logical, public :: no_frozen_nitrif_denitrif = .false. ! stop nitrification and denitrification in frozen soils + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + use ncdio_pio, only: file_desc_t,ncd_io + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNNitrifDenitrifParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + ! + ! read in constants + ! + tString='surface_tension_water' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%surface_tension_water=tempr + + tString='rij_kro_a' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rij_kro_a=tempr + + tString='rij_kro_alpha' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rij_kro_alpha=tempr + + tString='rij_kro_beta' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rij_kro_beta=tempr + + tString='rij_kro_gamma' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rij_kro_gamma=tempr + + tString='rij_kro_delta' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rij_kro_delta=tempr + + tString='k_nitr_max_perday' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%k_nitr_max_perday=tempr + + tString='denitrif_nitrateconc_coefficient' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%denitrif_nitrateconc_coefficient=tempr + + tString='denitrif_nitrateconc_exponent' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%denitrif_nitrateconc_exponent=tempr + + tString='denitrif_respiration_coefficient' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%denitrif_respiration_coefficient=tempr + + tString='denitrif_respiration_exponent' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%denitrif_respiration_exponent=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & + soilstate_inst, waterstatebulk_inst, temperature_inst, ch4_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! calculate nitrification and denitrification rates + ! + ! !USES: + use clm_time_manager , only : get_curr_date + use CNSharedParamsMod , only : CNParamsShareInst + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(temperature_type) , intent(in) :: temperature_inst + type(ch4_type) , intent(in) :: ch4_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c, fc, reflev, j + real(r8) :: soil_hr_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! total soil respiration rate (g C / m3 / s) + real(r8) :: g_per_m3__to__ug_per_gsoil + real(r8) :: g_per_m3_sec__to__ug_per_gsoil_day + real(r8) :: mu, sigma + real(r8) :: t + real(r8) :: pH(bounds%begc:bounds%endc) + !debug-- put these type structure for outing to hist files + real(r8) :: co2diff_con(2) ! diffusion constants for CO2 + real(r8) :: eps + real(r8) :: f_a + real(r8) :: surface_tension_water ! (J/m^2), Arah and Vinten 1995 + real(r8) :: rij_kro_a ! Arah and Vinten 1995 + real(r8) :: rij_kro_alpha ! Arah and Vinten 1995 + real(r8) :: rij_kro_beta ! Arah and Vinten 1995 + real(r8) :: rij_kro_gamma ! Arah and Vinten 1995 + real(r8) :: rij_kro_delta ! Arah and Vinten 1995 + real(r8) :: rho_w = 1.e3_r8 ! (kg/m3) + real(r8) :: r_max + real(r8) :: r_min(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: ratio_diffusivity_water_gas(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: om_frac + real(r8) :: anaerobic_frac_sat, r_psi_sat, r_min_sat ! scalar values in sat portion for averaging + real(r8) :: organic_max ! organic matter content (kg/m3) where + ! soil is assumed to act like peat + character(len=32) :: subname='nitrif_denitrif' ! subroutine name + !----------------------------------------------------------------------- + + associate( & + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) (nlevgrnd) + watfc => soilstate_inst%watfc_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at field capacity (nlevsoi) + bd => soilstate_inst%bd_col , & ! Input: [real(r8) (:,:) ] bulk density of dry soil material [kg/m3] + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" (nlevgrnd) + cellorg => soilstate_inst%cellorg_col , & ! Input: [real(r8) (:,:) ] column 3D org (kg/m3 organic matter) (nlevgrnd) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) + h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + o2_decomp_depth_unsat => ch4_inst%o2_decomp_depth_unsat_col , & ! Input: [real(r8) (:,:) ] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + conc_o2_unsat => ch4_inst%conc_o2_unsat_col , & ! Input: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) + o2_decomp_depth_sat => ch4_inst%o2_decomp_depth_sat_col , & ! Input: [real(r8) (:,:) ] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + conc_o2_sat => ch4_inst%conc_o2_sat_col , & ! Input: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) + finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area in soil column (excluding dedicated wetland columns) + + smin_nh4_vr => soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NH4 pool + smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 pool + + phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Input: [real(r8) (:,:) ] potential hr (not N-limited) + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] soil water scalar for decomp + t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Input: [real(r8) (:,:) ] temperature scalar for decomp + denit_resp_coef => params_inst%denitrif_respiration_coefficient , & ! Input: [real(r8) ] coefficient for max denitrification rate based on respiration + denit_resp_exp => params_inst%denitrif_respiration_exponent , & ! Input: [real(r8) ] exponent for max denitrification rate based on respiration + denit_nitrate_coef => params_inst%denitrif_nitrateconc_coefficient , & ! Input: [real(r8) ] coefficient for max denitrification rate based on nitrate concentration + denit_nitrate_exp => params_inst%denitrif_nitrateconc_exponent , & ! Input: [real(r8) ] exponent for max denitrification rate based on nitrate concentration + k_nitr_max_perday => params_inst%k_nitr_max_perday , & ! Input: [real(r8) ] maximum nitrification rate constant (1/day) + r_psi => soilbiogeochem_nitrogenflux_inst%r_psi_col , & ! Output: [real(r8) (:,:) ] + anaerobic_frac => soilbiogeochem_nitrogenflux_inst%anaerobic_frac_col , & ! Output: [real(r8) (:,:) ] + ! ! subsets of the n flux calcs (for diagnostic/debugging purposes) + smin_no3_massdens_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_massdens_vr_col , & ! Output: [real(r8) (:,:) ] (ugN / g soil) soil nitrate concentration + k_nitr_t_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_t_vr_col , & ! Output: [real(r8) (:,:) ] + k_nitr_ph_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_ph_vr_col , & ! Output: [real(r8) (:,:) ] + k_nitr_h2o_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_h2o_vr_col , & ! Output: [real(r8) (:,:) ] + k_nitr_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_vr_col , & ! Output: [real(r8) (:,:) ] + wfps_vr => soilbiogeochem_nitrogenflux_inst%wfps_vr_col , & ! Output: [real(r8) (:,:) ] + fmax_denit_carbonsubstrate_vr => soilbiogeochem_nitrogenflux_inst%fmax_denit_carbonsubstrate_vr_col , & ! Output: [real(r8) (:,:) ] + fmax_denit_nitrate_vr => soilbiogeochem_nitrogenflux_inst%fmax_denit_nitrate_vr_col , & ! Output: [real(r8) (:,:) ] + f_denit_base_vr => soilbiogeochem_nitrogenflux_inst%f_denit_base_vr_col , & ! Output: [real(r8) (:,:) ] + diffus => soilbiogeochem_nitrogenflux_inst%diffus_col , & ! Output: [real(r8) (:,:) ] diffusivity (unitless fraction of total diffusivity) + ratio_k1 => soilbiogeochem_nitrogenflux_inst%ratio_k1_col , & ! Output: [real(r8) (:,:) ] + ratio_no3_co2 => soilbiogeochem_nitrogenflux_inst%ratio_no3_co2_col , & ! Output: [real(r8) (:,:) ] + soil_co2_prod => soilbiogeochem_nitrogenflux_inst%soil_co2_prod_col , & ! Output: [real(r8) (:,:) ] (ug C / g soil / day) + fr_WFPS => soilbiogeochem_nitrogenflux_inst%fr_WFPS_col , & ! Output: [real(r8) (:,:) ] + soil_bulkdensity => soilbiogeochem_nitrogenflux_inst%soil_bulkdensity_col , & ! Output: [real(r8) (:,:) ] (kg soil / m3) bulk density of soil (including water) + pot_f_nit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_nit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) potential soil nitrification flux + + pot_f_denit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_denit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) potential soil denitrification flux + n2_n2o_ratio_denit_vr => soilbiogeochem_nitrogenflux_inst%n2_n2o_ratio_denit_vr_col & ! Output: [real(r8) (:,:) ] ratio of N2 to N2O production by denitrification [gN/gN] + ) + + surface_tension_water = params_inst%surface_tension_water + + ! Set parameters from simple-structure model to calculate anoxic fratction (Arah and Vinten 1995) + rij_kro_a = params_inst%rij_kro_a + rij_kro_alpha = params_inst%rij_kro_alpha + rij_kro_beta = params_inst%rij_kro_beta + rij_kro_gamma = params_inst%rij_kro_gamma + rij_kro_delta = params_inst%rij_kro_delta + + organic_max = CNParamsShareInst%organic_max + + pH(bounds%begc:bounds%endc) = 6.5 !!! set all soils with the same pH as placeholder here + co2diff_con(1) = 0.1325_r8 + co2diff_con(2) = 0.0009_r8 + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + !---------------- calculate soil anoxia state + ! calculate gas diffusivity of soil at field capacity here + ! use expression from methane code, but neglect OM for now + f_a = 1._r8 - watfc(c,j) / watsat(c,j) + eps = watsat(c,j)-watfc(c,j) ! Air-filled fraction of total soil volume + + ! use diffusivity calculation including peat + if (use_lch4) then + + if (organic_max > 0._r8) then + om_frac = min(cellorg(c,j)/organic_max, 1._r8) + ! Use first power, not square as in iniTimeConst + else + om_frac = 1._r8 + end if + diffus (c,j) = (d_con_g(2,1) + d_con_g(2,2)*t_soisno(c,j)) * 1.e-4_r8 * & + (om_frac * f_a**(10._r8/3._r8) / watsat(c,j)**2 + & + (1._r8-om_frac) * eps**2 * f_a**(3._r8 / bsw(c,j)) ) + + ! calculate anoxic fraction of soils + ! use rijtema and kroess model after Riley et al., 2000 + ! caclulated r_psi as a function of psi + r_min(c,j) = 2 * surface_tension_water / (rho_w * grav * abs(soilpsi(c,j))) + r_max = 2 * surface_tension_water / (rho_w * grav * 0.1_r8) + r_psi(c,j) = sqrt(r_min(c,j) * r_max) + ratio_diffusivity_water_gas(c,j) = (d_con_g(2,1) + d_con_g(2,2)*t_soisno(c,j) ) * 1.e-4_r8 / & + ((d_con_w(2,1) + d_con_w(2,2)*t_soisno(c,j) + d_con_w(2,3)*t_soisno(c,j)**2) * 1.e-9_r8) + + if (o2_decomp_depth_unsat(c,j) > 0._r8) then + anaerobic_frac(c,j) = exp(-rij_kro_a * r_psi(c,j)**(-rij_kro_alpha) * & + o2_decomp_depth_unsat(c,j)**(-rij_kro_beta) * & + conc_o2_unsat(c,j)**rij_kro_gamma * (h2osoi_vol(c,j) + ratio_diffusivity_water_gas(c,j) * & + watsat(c,j))**rij_kro_delta) + else + anaerobic_frac(c,j) = 0._r8 + endif + + else + ! NITRIF_DENITRIF requires Methane model to be active, + ! otherwise diffusivity will be zeroed out here. EBK CDK 10/18/2011 + anaerobic_frac(c,j) = 0._r8 + diffus (c,j) = 0._r8 + !call endrun(msg=' ERROR: NITRIF_DENITRIF requires Methane model to be active'//errMsg(sourcefile, __LINE__) ) + end if + + + !---------------- nitrification + ! follows CENTURY nitrification scheme (Parton et al., (2001, 1996)) + + ! assume nitrification temp function equal to the HR scalar + k_nitr_t_vr(c,j) = min(t_scalar(c,j), 1._r8) + + ! ph function from Parton et al., (2001, 1996) + k_nitr_ph_vr(c,j) = 0.56 + atan(rpi * 0.45 * (-5.+ pH(c)))/rpi + + ! moisture function-- assume the same moisture function as limits heterotrophic respiration + ! Parton et al. base their nitrification- soil moisture rate constants based on heterotrophic rates-- can we do the same? + k_nitr_h2o_vr(c,j) = w_scalar(c,j) + + ! nitrification constant is a set scalar * temp, moisture, and ph scalars + ! note that k_nitr_max_perday is converted from 1/day to 1/s + k_nitr_vr(c,j) = k_nitr_max_perday/secspday * k_nitr_t_vr(c,j) * k_nitr_h2o_vr(c,j) * k_nitr_ph_vr(c,j) + + ! first-order decay of ammonium pool with scalar defined above + pot_f_nit_vr(c,j) = max(smin_nh4_vr(c,j) * k_nitr_vr(c,j), 0._r8) + + ! limit to oxic fraction of soils + pot_f_nit_vr(c,j) = pot_f_nit_vr(c,j) * (1._r8 - anaerobic_frac(c,j)) + + ! limit to non-frozen soil layers + if ( t_soisno(c,j) <= SHR_CONST_TKFRZ .and. no_frozen_nitrif_denitrif) then + pot_f_nit_vr(c,j) = 0._r8 + endif + + + !---------------- denitrification + ! first some input variables an unit conversions + soil_hr_vr(c,j) = phr_vr(c,j) + + ! CENTURY papers give denitrification in units of per gram soil; need to convert from volumetric to mass-based units here + soil_bulkdensity(c,j) = bd(c,j) + h2osoi_liq(c,j)/col%dz(c,j) + + g_per_m3__to__ug_per_gsoil = 1.e3_r8 / soil_bulkdensity(c,j) + + g_per_m3_sec__to__ug_per_gsoil_day = g_per_m3__to__ug_per_gsoil * secspday + + smin_no3_massdens_vr(c,j) = max(smin_no3_vr(c,j), 0._r8) * g_per_m3__to__ug_per_gsoil + + soil_co2_prod(c,j) = (soil_hr_vr(c,j) * (g_per_m3_sec__to__ug_per_gsoil_day)) + + !! maximum potential denitrification rates based on heterotrophic respiration rates or nitrate concentrations, + !! from (del Grosso et al., 2000) + fmax_denit_carbonsubstrate_vr(c,j) = (denit_resp_coef * (soil_co2_prod(c,j)**denit_resp_exp)) & + / g_per_m3_sec__to__ug_per_gsoil_day + ! + fmax_denit_nitrate_vr(c,j) = (denit_nitrate_coef * smin_no3_massdens_vr(c,j)**denit_nitrate_exp) & + / g_per_m3_sec__to__ug_per_gsoil_day + + ! find limiting denitrification rate + f_denit_base_vr(c,j) = max(min(fmax_denit_carbonsubstrate_vr(c,j), fmax_denit_nitrate_vr(c,j)),0._r8) + + ! limit to non-frozen soil layers + if ( t_soisno(c,j) <= SHR_CONST_TKFRZ .and. no_frozen_nitrif_denitrif ) then + f_denit_base_vr(c,j) = 0._r8 + endif + + ! limit to anoxic fraction of soils + pot_f_denit_vr(c,j) = f_denit_base_vr(c,j) * anaerobic_frac(c,j) + + ! now calculate the ratio of N2O to N2 from denitrifictaion, following Del Grosso et al., 2000 + ! diffusivity constant (figure 6b) + ratio_k1(c,j) = max(1.7_r8, 38.4_r8 - 350._r8 * diffus(c,j)) + + ! ratio function (figure 7c) + if ( soil_co2_prod(c,j) > 1.0e-9_r8 ) then + ratio_no3_co2(c,j) = smin_no3_massdens_vr(c,j) / soil_co2_prod(c,j) + else + ! fucntion saturates at large no3/co2 ratios, so set as some nominally large number + ratio_no3_co2(c,j) = 100._r8 + endif + + ! total water limitation function (Del Grosso et al., 2000, figure 7a) + wfps_vr(c,j) = max(min(h2osoi_vol(c,j)/watsat(c, j), 1._r8), 0._r8) * 100._r8 + fr_WFPS(c,j) = max(0.1_r8, 0.015_r8 * wfps_vr(c,j) - 0.32_r8) + + ! final ratio expression + n2_n2o_ratio_denit_vr(c,j) = max(0.16*ratio_k1(c,j), ratio_k1(c,j)*exp(-0.8 * ratio_no3_co2(c,j))) * fr_WFPS(c,j) + + end do + + end do + + end associate + + end subroutine SoilBiogeochemNitrifDenitrif + +end module SoilBiogeochemNitrifDenitrifMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 index 63d9cd667..3e195d16d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varcon.F90 @@ -17,7 +17,7 @@ module clm_varcon SHR_CONST_RGAS, & SHR_CONST_PI, & SHR_CONST_PDB - use clm_varpar , only: nlevgrnd, nlevdecomp_full, numrad + use clm_varpar , only: nlevgrnd, nlevdecomp_full, numrad, ngases ! !PUBLIC TYPES: implicit none @@ -108,6 +108,24 @@ module clm_varcon real(r8), public, parameter :: c_to_b = 2.0_r8 ! conversion between mass carbon and total biomass (g biomass /g C) + !------------------------------------------------------------------ + ! (Non-tunable) Constants for the CH4 submodel (Tuneable constants in ch4varcon) + !------------------------------------------------------------------ + ! Note some of these constants are also used in CNNitrifDenitrifMod + + integer, private :: i ! loop index + + real(r8), public :: d_con_w(ngases,3) ! water diffusivity constants (spp, #) (mult. by 10^-4) + data (d_con_w(1,i),i=1,3) /0.9798_r8, 0.02986_r8, 0.0004381_r8/ ! CH4 + data (d_con_w(2,i),i=1,3) /1.172_r8, 0.03443_r8, 0.0005048_r8/ ! O2 + data (d_con_w(3,i),i=1,3) /0.939_r8, 0.02671_r8, 0.0004095_r8/ ! CO2 + + real(r8), public :: d_con_g(ngases,2) ! gas diffusivity constants (spp, #) (cm^2/s) (mult. by 10^-9) + data (d_con_g(1,i),i=1,2) /0.1875_r8, 0.0013_r8/ ! CH4 + data (d_con_g(2,i),i=1,2) /0.1759_r8, 0.00117_r8/ ! O2 + data (d_con_g(3,i),i=1,2) /0.1325_r8, 0.0009_r8/ ! CO2 + + ! !PUBLIC MEMBER FUNCTIONS: public clm_varcon_init ! Initialze constants that need to be initialized From e414eddd172fe9336444fe9af41eebac8947f071 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 22 Nov 2024 11:51:05 -0500 Subject: [PATCH 571/589] add soil NH4 and NO3 as restart variables --- .../CLM51/CNCLM_DriverMod.F90 | 3 +++ .../CNCLM_SoilBiogeochemNitrogenStateType.F90 | 14 +++++++++----- .../Shared/clm_varpar_shared.F90 | 2 +- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 076e9013e..d8802bdf4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -578,6 +578,9 @@ subroutine CN_exit(nch,ityp,fveg,cncol,cnpft) cncol(nc,nz,33) = bgc_vegetation_inst%cnveg_carbonflux_inst%annsum_npp_col (n) cncol(nc,nz,34) = bgc_vegetation_inst%cnveg_state_inst%farea_burned_col (n) cncol(nc,nz,35) = soilbiogeochem_state_inst%fpi_col (n) + cncol(nc,nz,36) = soilbiogeochem_nitrogenstate_inst%smin_no3_col (n) + cncol(nc,nz,37) = soilbiogeochem_nitrogenstate_inst%smin_nh4_col (n) + do p = 0,numpft ! PFT index loop np = np + 1 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 index 38257e093..cdc196e21 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemNitrogenStateType.F90 @@ -100,6 +100,7 @@ subroutine Init(this, bounds, nch, cncol) integer :: begc,endc integer :: n, nc, nz, np, l, c integer, dimension(8) :: decomp_npool_cncol_index = (/ 18, 19, 20, 17,25, 26, 27, 28 /) + logical :: no_cn51_rst = .false. !----------------------------------- begc = bounds%begc ; endc = bounds%endc @@ -169,14 +170,17 @@ subroutine Init(this, bounds, nch, cncol) this%sminn_vr_col (n,1:nlevdecomp_full) = cncol(nc,nz,24) this%sminn_col (n) = this%sminn_vr_col(n,1) - ! jkolassa Nov 2024: temporary initialization for NO3 and NH4; need to be - ! added as restart variables - this%smin_no3_col(n) = (1.25/2.25)*this%sminn_col(n) - this%smin_nh4_col(n) = this%sminn_col(n)/2.25 + if (no_cn51_rst) then ! jkolassa Nov 2024: when no CN51 restart file is available compute NO3 and NH4 from N + this%smin_no3_col(n) = (1.25/2.25)*this%sminn_col(n) + this%smin_nh4_col(n) = this%sminn_col(n)/2.25 + else + this%smin_no3_col(n) = cncol(nc,nz,36); + this%smin_nh4_col(n) = cncol(nc,nz,37); + end if + this%smin_no3_vr_col(n,1:nlevdecomp_full) = this%smin_no3_col(n) this%smin_nh4_vr_col(n,1:nlevdecomp_full) = this%smin_nh4_col(n) - do np = 1,ndecomp_pools ! jkolassa May 2022: accounting for fact that pool order in CNCOL is different from CTSM this%decomp_npools_col (n,np) = cncol(nc,nz,decomp_npool_cncol_index(np)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 index c9e4e82b2..c543cfab5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 @@ -26,7 +26,7 @@ module clm_varpar_shared integer, parameter, PUBLIC :: VAR_PFT_40=74 ! number of CN PFT variables per column integer, parameter, PUBLIC :: VAR_COL_45=35 ! number of CN column restart variables integer, parameter, PUBLIC :: VAR_PFT_45=75 ! number of CN PFT variables per column - integer, parameter, PUBLIC :: VAR_COL_51=35 ! number of CN column restart variables + integer, parameter, PUBLIC :: VAR_COL_51=37 ! number of CN column restart variables integer, parameter, PUBLIC :: VAR_PFT_51=83 ! number of CN PFT restart variables From 2bd3e66c71fc1e8d57594a46ffeec8a061d98916 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 25 Nov 2024 11:09:33 -0500 Subject: [PATCH 572/589] bug fixes --- .../CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 | 11 ++++++++--- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 ++ 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 index 99f1ec109..17a6add25 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonStateType.F90 @@ -8,7 +8,7 @@ module SoilBiogeochemCarbonStateType use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi, & NUM_ZON, VAR_COL use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi, zsoi, c3_r2 - use clm_varctl , only : iulog, use_vertsoilc, use_fates, use_soil_matrixcn + use clm_varctl , only : iulog, use_vertsoilc, use_fates, use_soil_matrixcn, use_century_decomp use decompMod , only : bounds_type use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con @@ -160,8 +160,13 @@ subroutine Init(this, bounds, nch, cncol) end do !np ! sum soil carbon pools - this%totsomc_col (n) = this%decomp_cpools_col(n,5) + this%decomp_cpools_col(n,6) & - + this%decomp_cpools_col(n,7) + this%decomp_cpools_col(n,8) + if (use_century_decomp) then + this%totsomc_col (n) = this%decomp_cpools_col(n,5) + this%decomp_cpools_col(n,6) & + + this%decomp_cpools_col(n,7) + else + this%totsomc_col (n) = this%decomp_cpools_col(n,5) + this%decomp_cpools_col(n,6) & + + this%decomp_cpools_col(n,7) + this%decomp_cpools_col(n,8) + end if end do !nz end do ! nc diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 69c9df3aa..ebd0445ca 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -61,6 +61,7 @@ module CN_initMod use CNBalanceCheckMod use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc, DecompCascadeBGCreadNML + use SoilBiogeochemDecompCascadeBGCMod , only : readSoilBiogeochemDecompBgcParams => readParams use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn use SoilBiogeochemDecompCascadeCNMod , only : readSoilBiogeochemDecompCnParams => readParams use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method @@ -335,6 +336,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call readCNMRespParams(ncid) call CNParamsReadShared(ncid) ! this is called CN params but really is for the soil biogeochem parameters call readSoilBiogeochemDecompCnParams(ncid) + call readSoilBiogeochemDecompBgcParams(ncid) call nutrient_competition_method%readParams(ncid) call readSoilBiogeochemDecompParams(ncid) call readCNPhenolParams(ncid) From cb12469fb46f5c5f66745d6a3e20c793839b3f7c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 25 Nov 2024 14:01:15 -0500 Subject: [PATCH 573/589] read shared parameters from namelist; comment resetting of soil_decomp levels --- .../CLM51/CNSharedParamsMod.F90 | 168 +++++++++--------- .../CLM51/CN_init_mod.F90 | 2 +- .../SoilBiogeochemDecompCascadeBGCMod.F90 | 2 +- 3 files changed, 86 insertions(+), 86 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 index e448900bf..cf60816b8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNSharedParamsMod.F90 @@ -46,7 +46,7 @@ subroutine CNParamsReadShared(ncid, namelist_file) character(len=*), optional, intent(in) :: namelist_file call CNParamsReadShared_netcdf(ncid) - ! call CNParamsReadShared_namelist(namelist_file) + call CNParamsReadShared_namelist(namelist_file) end subroutine CNParamsReadShared @@ -108,88 +108,88 @@ subroutine CNParamsReadShared_netcdf(ncid) end subroutine CNParamsReadShared_netcdf !----------------------------------------------------------------------- -! subroutine CNParamsReadShared_namelist(namelist_file) -! ! -! ! !DESCRIPTION: -! ! Read and initialize CN Shared parameteres from the namelist. -! ! -! ! !USES: -! use fileutils , only : relavu, getavu -! use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_LOGICAL -! use shr_nl_mod , only : shr_nl_find_group_name -! use shr_log_mod , only : errMsg => shr_log_errMsg -! use clm_varctl , only : iulog -! use abortutils , only : endrun -! use shr_mpi_mod , only : shr_mpi_bcast -! -! ! -! implicit none -! ! -! -! character(len=*), intent(in) :: namelist_file -! -! integer :: i,j,n ! loop indices -! integer :: ierr ! error code -! integer :: unitn ! unit for namelist file -! -! real(r8) :: decomp_depth_efolding = 0.0_r8 -! logical :: constrain_stress_deciduous_onset = .false. -! -! character(len=32) :: subroutine_name = 'CNParamsReadNamelist' -! character(len=10) :: namelist_group = 'bgc_shared' -! -! !----------------------------------------------------------------------- -! -! ! ---------------------------------------------------------------------- -! ! Namelist Variables -! ! ---------------------------------------------------------------------- -! -! namelist /bgc_shared/ & -! decomp_depth_efolding, & -! constrain_stress_deciduous_onset -! -! -! ! Read namelist from standard input. -! if (masterproc) then -! -! write(iulog,*) 'Attempting to read CN/BGC shared namelist parameters .....' -! unitn = getavu() -! write(iulog,*) 'Read in ' // namelist_group // ' namelist from: ', trim(namelist_file) -! open( unitn, file=trim(namelist_file), status='old' ) -! call shr_nl_find_group_name(unitn, namelist_group, status=ierr) -! if (ierr == 0) then -! read(unitn, bgc_shared, iostat=ierr) -! if (ierr /= 0) then -! call endrun(msg='error in reading in ' // namelist_group // ' namelist' // & -! errMsg(sourcefile, __LINE__)) -! end if -! else -! call endrun(msg='error in finding ' // namelist_group // ' namelist' // & -! errMsg(sourcefile, __LINE__)) -! end if -! call relavu( unitn ) -! -! end if ! masterproc -! -! ! Broadcast the parameters from master -! call shr_mpi_bcast ( decomp_depth_efolding, mpicom ) -! call shr_mpi_bcast ( constrain_stress_deciduous_onset, mpicom ) -! -! ! Save the parameter to the instance -! CNParamsShareInst%decomp_depth_efolding = decomp_depth_efolding -! CNParamsShareInst%constrain_stress_deciduous_onset = constrain_stress_deciduous_onset -! -! ! Output read parameters to the lnd.log -! if (masterproc) then -! write(iulog,*) 'CN/BGC shared namelist parameters:' -! write(iulog,*)' ' -! write(iulog,*)' decomp_depth_efolding = ', decomp_depth_efolding -! write(iulog,*)' constrain_stress_deciduous_onset = ',constrain_stress_deciduous_onset -! -! write(iulog,*) -! -! end if -! -! end subroutine CNParamsReadShared_namelist + subroutine CNParamsReadShared_namelist(namelist_file) + ! + ! !DESCRIPTION: + ! Read and initialize CN Shared parameteres from the namelist. + ! + ! !USES: + use fileutils , only : relavu, getavu + use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_LOGICAL + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_mpi_mod , only : shr_mpi_bcast + + ! + implicit none + ! + + character(len=*), intent(in) :: namelist_file + + integer :: i,j,n ! loop indices + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + + real(r8) :: decomp_depth_efolding = 0.0_r8 + logical :: constrain_stress_deciduous_onset = .false. + + character(len=32) :: subroutine_name = 'CNParamsReadNamelist' + character(len=10) :: namelist_group = 'bgc_shared' + + !----------------------------------------------------------------------- + + ! ---------------------------------------------------------------------- + ! Namelist Variables + ! ---------------------------------------------------------------------- + + namelist /bgc_shared/ & + decomp_depth_efolding, & + constrain_stress_deciduous_onset + + + ! Read namelist from standard input. + if (masterproc) then + + write(iulog,*) 'Attempting to read CN/BGC shared namelist parameters .....' + unitn = getavu() + write(iulog,*) 'Read in ' // namelist_group // ' namelist from: ', trim(namelist_file) + open( unitn, file=trim(namelist_file), status='old' ) + call shr_nl_find_group_name(unitn, namelist_group, status=ierr) + if (ierr == 0) then + read(unitn, bgc_shared, iostat=ierr) + if (ierr /= 0) then + call endrun(msg='error in reading in ' // namelist_group // ' namelist' // & + errMsg(sourcefile, __LINE__)) + end if + else + call endrun(msg='error in finding ' // namelist_group // ' namelist' // & + errMsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + + end if ! masterproc + + ! Broadcast the parameters from master + call shr_mpi_bcast ( decomp_depth_efolding, mpicom ) + call shr_mpi_bcast ( constrain_stress_deciduous_onset, mpicom ) + + ! Save the parameter to the instance + CNParamsShareInst%decomp_depth_efolding = decomp_depth_efolding + CNParamsShareInst%constrain_stress_deciduous_onset = constrain_stress_deciduous_onset + + ! Output read parameters to the lnd.log + if (masterproc) then + write(iulog,*) 'CN/BGC shared namelist parameters:' + write(iulog,*)' ' + write(iulog,*)' decomp_depth_efolding = ', decomp_depth_efolding + write(iulog,*)' constrain_stress_deciduous_onset = ',constrain_stress_deciduous_onset + + write(iulog,*) + + end if + + end subroutine CNParamsReadShared_namelist end module CNSharedParamsMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index ebd0445ca..f72e84b7e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -334,7 +334,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call ncid%open(trim(paramfile),pFIO_READ, RC=status) call readCNMRespParams(ncid) - call CNParamsReadShared(ncid) ! this is called CN params but really is for the soil biogeochem parameters + call CNParamsReadShared(ncid, NLFilename) ! this is called CN params but really is for the soil biogeochem parameters call readSoilBiogeochemDecompCnParams(ncid) call readSoilBiogeochemDecompBgcParams(ncid) call nutrient_competition_method%readParams(ncid) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 index 3ca6871c9..e1dfb5831 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilBiogeochemDecompCascadeBGCMod.F90 @@ -855,7 +855,7 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! the following normalizes values in fr so that they ! sum to 1.0 across top nlevdecomp levels on a column frw(bounds%begc:bounds%endc) = 0._r8 - nlev_soildecomp_standard=5 + !nlev_soildecomp_standard=5 allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard)) do j=1,nlev_soildecomp_standard do fc = 1,num_soilc From 084716ad6c658aaea5b111bec9124f2dfdcb061f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 26 Nov 2024 11:01:59 -0500 Subject: [PATCH 574/589] read additional soil parameters --- .../CLM51/CMakeLists.txt | 1 + .../CLM51/CNCLM_DriverMod.F90 | 2 + .../CLM51/CNCLM_SoilStateType.F90 | 11 +- .../CLM51/CN_init_mod.F90 | 6 +- .../CLM51/SoilStateInitTimeConstMod.F90 | 711 ++++++++++++++++++ 5 files changed, 726 insertions(+), 5 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt index ae43f2dee..c3d07faae 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CMakeLists.txt @@ -132,6 +132,7 @@ set (srcs SoilBiogeochemPotentialMod.F90 SoilBiogeochemPrecisionControlMod.F90 SoilBiogeochemVerticalProfileMod.F90 + SoilStateInitTimeConstMod.F90 SoilWaterRetentionCurveMod.F90 spmdMod.F90 subgridAveMod.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index d8802bdf4..2f8ce2b18 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -220,6 +220,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions integer :: n, p, nc, nz, np, nv + real(r8) :: pd = 2700. ! Particle density of soil (kg/m3 !------------------------------- @@ -251,6 +252,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m soilstate_inst%soilpsi_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point soilstate_inst%psiwilt_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*wpwet(nc)**(-bee(nc)) ! jkolassa: soil water potential at wilting point (not a CLM variable, but added to use instead of constant threshold to determine water stress) soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd) = poros(nc) + soilstate_inst%bd_col(n,1:nlevmaxurbgrnd) = (1._r8 - soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd))*pd atm2lnd_inst%forc_t_downscaled_col(n) = tairm(nc) water_inst%wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) water_inst%wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index 4c6cff281..3bc4b3817 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -105,11 +105,14 @@ subroutine Init(this, bounds) begc = bounds%begc ; endc = bounds%endc allocate(this%mss_frc_cly_vld_col (begc:endc)) ; this%mss_frc_cly_vld_col (:) = nan - allocate(this%sandfrac_patch (begp:endp)) ; this%sandfrac_patch (:) = nan - allocate(this%clayfrac_patch (begp:endp)) ; this%clayfrac_patch (:) = nan + allocate(this%sandfrac_patch (begp:endp)) ; this%sandfrac_patch (:) = 0.5 ! jkolassa: temporary; replace with Catchment soil texture + allocate(this%clayfrac_patch (begp:endp)) ; this%clayfrac_patch (:) = 0.5 ! jkolassa: + temporary; replace with Catchment soil texture allocate(this%cellorg_col (begc:endc,nlevsoi)) ; this%cellorg_col (:,:) = nan - allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = nan - allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = nan + allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = 0.5 ! jkolassa: + temporary; replace with Catchment soil texture + allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = 0.5 ! jkolassa: + temporary; replace with Catchment soil texture allocate(this%bd_col (begc:endc,nlevgrnd)) ; this%bd_col (:,:) = nan allocate(this%hksat_col (begc:endc,nlevgrnd)) ; this%hksat_col (:,:) = spval diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index f72e84b7e..c55c95cd9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -83,7 +83,8 @@ module CN_initMod use SurfaceAlbedoMod , only: SurfaceAlbedo_readnl use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControlInit use SoilBiogeochemNitrifDenitrifMod , only : readSoilBiogeochemNitrifDenitrifParams => readParams - + use SoilStateInitTimeConstMod , only : readParams_SoilStateInitTimeConst => readParams, & + SoilStateInitTimeConst use clm_varpar , only : numpft, num_zon, num_veg, var_pft, var_col, & nlevgrnd, nlevsoi @@ -272,6 +273,8 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call soilstate_inst%Init (bounds) + call SoilStateInitTimeConst (bounds, soilstate_inst, NLFilename) ! sets hydraulic and thermal soil properties + call water_inst%Init (bounds) call canopystate_inst%Init (bounds, nch, ityp, fveg, cncol, cnpft, cn5_cold_start) @@ -348,6 +351,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call readCNGapMortalityParams(ncid) call readCNFUNParams(ncid) call readSoilBiogeochemNitrifDenitrifParams(ncid) + call readParams_SoilStateInitTimeConst(ncid) call ncid%close(rc=status) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 new file mode 100755 index 000000000..74b6fa804 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 @@ -0,0 +1,711 @@ +module SoilStateInitTimeConstMod + + !------------------------------------------------------------------------------ + ! DESCRIPTION: + ! Set hydraulic and thermal properties + ! + ! !USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use SoilStateType , only : soilstate_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SoilStateInitTimeConst + public :: readParams + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: ReadNL + ! + ! !PUBLIC DATA: + real(r8), public :: organic_max ! organic matter (kg/m3) where soil is assumed to act like peat + + ! !PRIVATE DATA: + type, private :: params_type + real(r8) :: tkd_sand ! Thermal conductivity of sand (W/m/K) + real(r8) :: tkd_clay ! Thermal conductivity of clay (W/m/K) + real(r8) :: tkd_om ! Thermal conductivity of dry organic matter (Farouki, 1981) (W/m/K) + real(r8) :: tkm_om ! Thermal conductivity of organic matter (Farouki, 1986) (W/m/K) + real(r8) :: pd ! Particle density of soil (kg/m3) + real(r8) :: csol_clay ! Heat capacity of clay *10^6 (J/K/m3) + real(r8) :: csol_om ! Heat capacity of peat soil *10^6 (Farouki, 1986) (J/K/m3) + real(r8) :: csol_sand ! Heat capacity of sand *10^6 (J/K/m3) + real(r8) :: bsw_sf ! Scale factor for bsw (unitless) + real(r8) :: hksat_sf ! Scale factor for hksat (unitless) + real(r8) :: sucsat_sf ! Scale factor for sucsat (unitless) + real(r8) :: watsat_sf ! Scale factor for watsat (unitless) + real(r8) :: sand_pf ! Perturbation factor (via addition) for percent sand (percent) + real(r8) :: clay_pf ! Perturbation factor (via addition) for percent clay of clay+silt (percent) + end type params_type + type(params_type), private :: params_inst + + ! Control variables (from namelist) + logical, private :: organic_frac_squared ! If organic fraction should be squared (as in CLM4.5) + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !----------------------------------------------------------------------- + ! +contains + + !----------------------------------------------------------------------- + subroutine ReadNL( nlfilename ) + ! + ! !DESCRIPTION: + ! Read namelist for SoilStateType + ! + ! !USES: + use shr_mpi_mod , only : shr_mpi_bcast + use shr_log_mod , only : errMsg => shr_log_errMsg + use fileutils , only : getavu, relavu, opnfil + use clm_nlUtilsMod , only : find_nlgroup_name + use clm_varctl , only : iulog + use spmdMod , only : mpicom, masterproc + use abortUtils , only : endrun + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: nlfilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=32) :: subname = 'SoilState_readnl' ! subroutine name + !----------------------------------------------------------------------- + + character(len=*), parameter :: nl_name = 'clm_soilstate_inparm' ! Namelist name + ! MUST agree with name in namelist and read + namelist / clm_soilstate_inparm / organic_frac_squared + + ! preset values + + organic_frac_squared = .false. + + if ( masterproc )then + + unitn = getavu() + write(iulog,*) 'Read in '//nl_name//' namelist' + call opnfil (nlfilename, unitn, 'F') + call find_nlgroup_name(unitn, nl_name, status=ierr) + if (ierr == 0) then + read(unit=unitn, nml=clm_soilstate_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading '//nl_name//' namelist"//errmsg(sourcefile, __LINE__)) + end if + else + call endrun(msg="ERROR finding '//nl_name//' namelist"//errmsg(sourcefile, __LINE__)) + end if + call relavu( unitn ) + + end if + + call shr_mpi_bcast(organic_frac_squared, mpicom) + + end subroutine ReadNL + + !----------------------------------------------------------------------- + subroutine readParams( ncid ) + ! + ! !USES: + use ncdio_pio, only: file_desc_t + use paramUtilMod, only: readNcdioScalar + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'readParams_SoilStateInitTimeConst' + !-------------------------------------------------------------------- + + ! Thermal conductivity of sand (W/m/K) + call readNcdioScalar(ncid, 'tkd_sand', subname, params_inst%tkd_sand) + ! Thermal conductivity of clay (W/m/K) + call readNcdioScalar(ncid, 'tkd_clay', subname, params_inst%tkd_clay) + ! Thermal conductivity of dry organic matter (Farouki, 1981) (W/m/K) + call readNcdioScalar(ncid, 'tkd_om', subname, params_inst%tkd_om) + ! Thermal conductivity of organic matter (Farouki, 1986) (W/m/K) + call readNcdioScalar(ncid, 'tkm_om', subname, params_inst%tkm_om) + ! Particle density of soil (kg/m3) + call readNcdioScalar(ncid, 'pd', subname, params_inst%pd) + ! Heat capacity of clay *10^6 (J/K/m3) + call readNcdioScalar(ncid, 'csol_clay', subname, params_inst%csol_clay) + ! Heat capacity of peat soil *10^6 (Farouki, 1986) (J/K/m3) + call readNcdioScalar(ncid, 'csol_om', subname, params_inst%csol_om) + ! Heat capacity of sand *10^6 (J/K/m3) + call readNcdioScalar(ncid, 'csol_sand', subname, params_inst%csol_sand) + ! Scale factor for bsw (unitless) + call readNcdioScalar(ncid, 'bsw_sf', subname, params_inst%bsw_sf) + ! Scale factor for hksat (unitless) + call readNcdioScalar(ncid, 'hksat_sf', subname, params_inst%hksat_sf) + ! Scale factor for sucsat (unitless) + call readNcdioScalar(ncid, 'sucsat_sf', subname, params_inst%sucsat_sf) + ! Scale factor for watsat (unitless) + call readNcdioScalar(ncid, 'watsat_sf', subname, params_inst%watsat_sf) + ! Perturbation factor (via addition) for percent sand (percent) + call readNcdioScalar(ncid, 'sand_pf', subname, params_inst%sand_pf) + ! Perturbation factor (via addition) for percent clay of clay+silt (percent) + call readNcdioScalar(ncid, 'clay_pf', subname, params_inst%clay_pf) + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilStateInitTimeConst(bounds, soilstate_inst, nlfilename) + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use abortutils , only : endrun + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use ncdio_pio , only : ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use clm_varpar , only : numrad + use clm_varpar , only : nlevsoi, nlevgrnd, nlevlak, nlevsoifl, nlayer, nlayert, nlevmaxurbgrnd, nlevsno + use clm_varcon , only : zsoi, dzsoi, zisoi, spval + use clm_varcon , only : secspday, pc, mu, denh2o, denice, grlnd + use clm_varctl , only : use_cn, use_lch4, use_fates + use clm_varctl , only : iulog, fsurdat, paramfile, soil_layerstruct_predefined + use landunit_varcon , only : istdlak, istwet, istsoil, istcrop, istice_mec + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv + use fileutils , only : getfil + use organicFileMod , only : organicrd + use FuncPedotransferMod , only : pedotransf, get_ipedof + use RootBiophysMod , only : init_vegrootfr + use GridcellType , only : grc + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(soilstate_type) , intent(inout) :: soilstate_inst + character(len=*) , intent(in) :: nlfilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: p, lev, c, l, g, j ! indices + real(r8) :: om_frac ! organic matter fraction + real(r8) :: om_watsat_lake = 0.9_r8 ! porosity of organic soil + real(r8) :: om_hksat_lake = 0.1_r8 ! saturated hydraulic conductivity of organic soil [mm/s] + real(r8) :: om_sucsat_lake = 10.3_r8 ! saturated suction for organic matter (Letts, 2000) + real(r8) :: om_b_lake = 2.7_r8 ! Clapp Hornberger paramater for oragnic soil (Letts, 2000) (lake) + real(r8) :: om_watsat ! porosity of organic soil + real(r8) :: om_hksat ! saturated hydraulic conductivity of organic soil [mm/s] + real(r8) :: om_sucsat ! saturated suction for organic matter (mm)(Letts, 2000) + real(r8) :: om_b ! Clapp Hornberger paramater for oragnic soil (Letts, 2000) + real(r8) :: zsapric = 0.5_r8 ! depth (m) that organic matter takes on characteristics of sapric peat + real(r8) :: pcalpha = 0.5_r8 ! percolation threshold + real(r8) :: pcbeta = 0.139_r8 ! percolation exponent + real(r8) :: pc_lake = 0.5_r8 ! percolation threshold + real(r8) :: perc_frac ! "percolating" fraction of organic soil + real(r8) :: perc_norm ! normalize to 1 when 100% organic soil + real(r8) :: uncon_hksat ! series conductivity of mineral/organic soil + real(r8) :: uncon_frac ! fraction of "unconnected" soil + real(r8) :: bd ! bulk density of dry soil material [kg/m^3] + real(r8) :: tkm ! mineral conductivity + real(r8) :: xksat ! maximum hydraulic conductivity of soil [mm/s] + real(r8) :: clay,sand ! temporaries + real(r8) :: perturbed_sand ! temporary for paramfile implementation of +/- sand percentage + real(r8) :: residual_clay_frac ! temporary for paramfile implementation of +/- residual clay percentage + real(r8) :: perturbed_residual_clay_frac ! temporary for paramfile implementation of +/- residual clay percentage + integer :: dimid ! dimension id + logical :: readvar + type(file_desc_t) :: ncid ! netcdf id + real(r8) ,pointer :: zsoifl (:) ! Output: [real(r8) (:)] original soil midpoint + real(r8) ,pointer :: zisoifl (:) ! Output: [real(r8) (:)] original soil interface depth + real(r8) ,pointer :: gti (:) ! read in - fmax + real(r8) ,pointer :: sand3d (:,:) ! read in - soil texture: percent sand (needs to be a pointer for use in ncdio) + real(r8) ,pointer :: clay3d (:,:) ! read in - soil texture: percent clay (needs to be a pointer for use in ncdio) + real(r8) ,pointer :: organic3d (:,:) ! read in - organic matter: kg/m3 (needs to be a pointer for use in ncdio) + character(len=256) :: locfn ! local filename + integer :: ipedof + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + integer :: found ! flag that equals 0 if not found and 1 if found + !----------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + do c = begc,endc + soilstate_inst%smpmin_col(c) = -1.e8_r8 + end do + + ! -------------------------------------------------------------------- + ! Read namelist + ! -------------------------------------------------------------------- + + call ReadNL( nlfilename ) + + ! -------------------------------------------------------------------- + ! Initialize root fraction (computing from surface, d is depth in meter): + ! -------------------------------------------------------------------- + +! ! Currently pervious road has same properties as soil +! do c = begc,endc +! l = col%landunit(c) +! +! if (lun%urbpoi(l) .and. col%itype(c) == icol_road_perv) then +! do lev = 1, nlevgrnd +! soilstate_inst%rootfr_road_perv_col(c,lev) = 0._r8 +! enddo +! do lev = 1,nlevsoi +! soilstate_inst%rootfr_road_perv_col(c,lev) = 1.0_r8/real(nlevsoi,r8) +! end do +!! remove roots below bedrock layer +! soilstate_inst%rootfr_road_perv_col(c,1:col%nbedrock(c)) = & +! soilstate_inst%rootfr_road_perv_col(c,1:col%nbedrock(c)) & +! + sum(soilstate_inst%rootfr_road_perv_col(c,col%nbedrock(c)+1:nlevsoi)) & +! /real(col%nbedrock(c)) +! soilstate_inst%rootfr_road_perv_col(c,col%nbedrock(c)+1:nlevsoi) = 0._r8 +! end if +! end do + +! do c = bounds%begc,bounds%endc +! l = col%landunit(c) +! if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then +! soilstate_inst%rootfr_col (c,nlevsoi+1:nlevgrnd) = 0._r8 +! else +! ! Inactive CH4 columns +! ! (Also includes (lun%itype(l)==istdlak .and. allowlakeprod), which used to be +! ! in a separate branch of the conditional) +! soilstate_inst%rootfr_col (c,:) = spval +! end if +! end do + +! ! Initialize root fraction +! ! Note that fates has its own root fraction root fraction routine and should not +! ! use the following since it depends on patch%itype - which fates should not use +! +! if (.not. use_fates) then +! call init_vegrootfr(bounds, nlevsoi, nlevgrnd, & +! soilstate_inst%rootfr_patch(begp:endp,1:nlevgrnd),'water') +! call init_vegrootfr(bounds, nlevsoi, nlevgrnd, & +! soilstate_inst%crootfr_patch(begp:endp,1:nlevgrnd),'carbon') +! end if + +! ! -------------------------------------------------------------------- +! ! dynamic memory allocation +! ! -------------------------------------------------------------------- +! +! allocate(sand3d(begg:endg,nlevsoifl)) +! allocate(clay3d(begg:endg,nlevsoifl)) +! +! ! Determine organic_max from parameter file +! +! call getfil (paramfile, locfn, 0) +! call ncd_pio_openfile (ncid, trim(locfn), 0) +! call ncd_io(ncid=ncid, varname='organic_max', flag='read', data=organic_max, readvar=readvar) +! if ( .not. readvar ) call endrun(msg=' ERROR: organic_max not on param file'//errMsg(sourcefile, __LINE__)) +! call ncd_pio_closefile(ncid) +! +! ! -------------------------------------------------------------------- +! ! Read surface dataset +! ! -------------------------------------------------------------------- +! +! if (masterproc) then +! write(iulog,*) 'Attempting to read soil color, sand and clay boundary data .....' +! end if +! +! call getfil (fsurdat, locfn, 0) +! call ncd_pio_openfile (ncid, locfn, 0) +! +! ! Read in organic matter dataset +! +! allocate(organic3d(begg:endg,nlevsoifl)) +! call organicrd(organic3d) +! +! ! Read in sand and clay data +! +! call ncd_io(ncid=ncid, varname='PCT_SAND', flag='read', data=sand3d, dim1name=grlnd, readvar=readvar) +! if (.not. readvar) then +! call endrun(msg=' ERROR: PCT_SAND NOT on surfdata file'//errMsg(sourcefile, __LINE__)) +! end if +! +! call ncd_io(ncid=ncid, varname='PCT_CLAY', flag='read', data=clay3d, dim1name=grlnd, readvar=readvar) +! if (.not. readvar) then +! call endrun(msg=' ERROR: PCT_CLAY NOT on surfdata file'//errMsg(sourcefile, __LINE__)) +! end if +! +! do p = begp,endp +! g = patch%gridcell(p) +! if ( sand3d(g,1)+clay3d(g,1) == 0.0_r8 )then +! if ( any( sand3d(g,:)+clay3d(g,:) /= 0.0_r8 ) )then +! call endrun(msg='found depth points that do NOT sum to zero when surface does'//& +! errMsg(sourcefile, __LINE__)) +! end if +! sand3d(g,:) = 1.0_r8 +! clay3d(g,:) = 1.0_r8 +! end if +! if ( any( sand3d(g,:)+clay3d(g,:) == 0.0_r8 ) )then +! call endrun(msg='after setting, found points sum to zero'//errMsg(sourcefile, __LINE__)) +! end if +! +! soilstate_inst%sandfrac_patch(p) = sand3d(g,1)/100.0_r8 +! soilstate_inst%clayfrac_patch(p) = clay3d(g,1)/100.0_r8 +! end do + +! ! Read fmax +! +! allocate(gti(begg:endg)) +! call ncd_io(ncid=ncid, varname='FMAX', flag='read', data=gti, dim1name=grlnd, readvar=readvar) +! if (.not. readvar) then +! call endrun(msg=' ERROR: FMAX NOT on surfdata file'//errMsg(sourcefile, __LINE__)) +! end if +! do c = begc, endc +! g = col%gridcell(c) +! soilstate_inst%wtfact_col(c) = gti(g) +! end do +! deallocate(gti) +! +! ! Close file +! +! call ncd_pio_closefile(ncid) +! +! ! -------------------------------------------------------------------- +! ! get original soil depths to be used in interpolation of sand and clay +! ! -------------------------------------------------------------------- +! +! ! Note that the depths on the file are assumed to be the same as the depths in the +! ! model when running with 10SL_3.5m. Ideally zsoifl and zisoifl would be read from +! ! the surface dataset rather than assumed here. +! ! +! ! We need to specify zsoifl down to nlevsoifl+1 (rather than just nlevsoifl) so that +! ! we can get the appropriate zisoifl at level nlevsoifl (i.e., the bottom interface +! ! depth). +! allocate(zsoifl(1:nlevsoifl+1), zisoifl(0:nlevsoifl)) +! do j = 1, nlevsoifl+1 +! zsoifl(j) = 0.025_r8*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths +! enddo +! +! zisoifl(0) = 0._r8 +! do j = 1, nlevsoifl +! zisoifl(j) = 0.5_r8*(zsoifl(j)+zsoifl(j+1)) !interface depths +! enddo +! +! ! -------------------------------------------------------------------- +! ! Set soil hydraulic and thermal properties: non-lake +! ! -------------------------------------------------------------------- +! +! ! urban roof, sunwall and shadewall thermal properties used to +! ! derive thermal conductivity and heat capacity are set to special +! ! value because thermal conductivity and heat capacity for urban +! ! roof, sunwall and shadewall are prescribed in SoilThermProp.F90 +! ! in SoilPhysicsMod.F90 +! +! do c = begc, endc +! g = col%gridcell(c) +! l = col%landunit(c) +! +! ! istwet and istice_mec and +! ! urban roof, sunwall, shadewall properties set to special value +! if (lun%itype(l)==istwet .or. lun%itype(l)==istice_mec .or. & +! (lun%urbpoi(l) .and. col%itype(c) /= icol_road_perv .and. & +! col%itype(c) /= icol_road_imperv)) then +! +! do lev = 1,nlevmaxurbgrnd +! soilstate_inst%watsat_col(c,lev) = spval +! end do +! +! do lev = 1,nlevgrnd +! soilstate_inst%bsw_col(c,lev) = spval +! soilstate_inst%watfc_col(c,lev) = spval +! soilstate_inst%hksat_col(c,lev) = spval +! soilstate_inst%sucsat_col(c,lev) = spval +! soilstate_inst%watdry_col(c,lev) = spval +! soilstate_inst%watopt_col(c,lev) = spval +! soilstate_inst%bd_col(c,lev) = spval +! if (lev <= nlevsoi) then +! soilstate_inst%cellsand_col(c,lev) = spval +! soilstate_inst%cellclay_col(c,lev) = spval +! soilstate_inst%cellorg_col(c,lev) = spval +! end if +! end do +! +! do lev = 1,nlevgrnd +! soilstate_inst%tkmg_col(c,lev) = spval +! soilstate_inst%tksatu_col(c,lev) = spval +! soilstate_inst%tkdry_col(c,lev) = spval +! soilstate_inst%csol_col(c,lev)= spval +! end do +! +! else +! +! do lev = 1,nlevgrnd +! ! Top-most model soil level corresponds to dataset's top-most soil +! ! level regardless of corresponding depths +! if (lev .eq. 1) then +! clay = clay3d(g,1) +! sand = sand3d(g,1) +! om_frac = organic3d(g,1)/organic_max +! else if (lev <= nlevsoi) then +! found = 0 ! reset value +! if (zsoi(lev) <= zisoifl(1)) then +! ! Search above the dataset's range of zisoifl depths +! clay = clay3d(g,1) +! sand = sand3d(g,1) +! om_frac = organic3d(g,1)/organic_max +! found = 1 +! else if (zsoi(lev) > zisoifl(nlevsoifl)) then +! ! Search below the dataset's range of zisoifl depths +! clay = clay3d(g,nlevsoifl) +! sand = sand3d(g,nlevsoifl) +! om_frac = organic3d(g,nlevsoifl)/organic_max +! found = 1 +! else +! ! For remaining model soil levels, search within dataset's +! ! range of zisoifl values. Look for model node depths +! ! that are between the dataset's interface depths. +! do j = 1,nlevsoifl-1 +! if (zsoi(lev) > zisoifl(j) .AND. zsoi(lev) <= zisoifl(j+1)) then +! clay = clay3d(g,j+1) +! sand = sand3d(g,j+1) +! om_frac = organic3d(g,j+1)/organic_max +! found = 1 +! endif +! if (found == 1) exit ! no need to stay in the loop +! end do +! end if +! ! If not found, then something's wrong +! if (found == 0) then +! write(iulog,*) 'For model soil level =', lev +! call endrun(msg="ERROR finding a soil dataset depth to interpolate the model depth to"//errmsg(sourcefile, __LINE__)) +! end if +! else ! if lev > nlevsoi +! clay = clay3d(g,nlevsoifl) +! sand = sand3d(g,nlevsoifl) +! om_frac = 0._r8 +! endif +! +! if (organic_frac_squared) then +! om_frac = om_frac**2._r8 +! end if +! +! if (lun%urbpoi(l)) then +! om_frac = 0._r8 ! No organic matter for urban +! end if +! +! if (lev <= nlevsoi) then +! ! This is separated into sections for non-perturbation and perturbation of sand/clay +! ! because the perturbation code is not bfb when sand_pf=clay_pf=0. This occurs because +! ! of a divide and then a multiply in the code. +! if (params_inst%sand_pf == 0._r8 .and. params_inst%clay_pf == 0._r8) then +! soilstate_inst%cellsand_col(c,lev) = sand +! soilstate_inst%cellclay_col(c,lev) = clay +! else +! ! by default, will read sand and clay from the surface dataset +! ! - sand_pf can be used to perturb the absolute percent sand +! ! - clay_pf can be used to perturb what percent of (clay+silt) is clay +! if (sand<100._r8) then +! residual_clay_frac = clay/(100._r8-sand) +! else +! residual_clay_frac = 0.5_r8 +! end if +! perturbed_sand = min(100._r8,max(0._r8,sand+params_inst%sand_pf)) +! perturbed_residual_clay_frac = min(1._r8,max(0._r8,residual_clay_frac + & +! params_inst%clay_pf/100._r8)) +! soilstate_inst%cellsand_col(c,lev) = perturbed_sand +! soilstate_inst%cellclay_col(c,lev) = (100._r8-perturbed_sand)*perturbed_residual_clay_frac +! end if +! soilstate_inst%cellorg_col(c,lev) = om_frac*organic_max +! end if +! +! if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types +! +! ! Note that the following properties are overwritten for urban impervious road +! ! layers that are not soil in SoilThermProp.F90 within SoilTemperatureMod.F90 +! +! !determine the type of pedotransfer function to be used based on soil order +! !I will use the following implementation to further explore the ET problem, now +! !I set soil order to 0 for all soils. Jinyun Tang, Mar 20, 2014 +! +! ipedof=get_ipedof(0) +! call pedotransf(ipedof, sand, clay, & +! soilstate_inst%watsat_col(c,lev), soilstate_inst%bsw_col(c,lev), soilstate_inst%sucsat_col(c,lev), xksat) +! +! om_watsat = max(0.93_r8 - 0.1_r8 *(zsoi(lev)/zsapric), 0.83_r8) +! om_b = min(2.7_r8 + 9.3_r8 *(zsoi(lev)/zsapric), 12.0_r8) +! om_sucsat = min(10.3_r8 - 0.2_r8 *(zsoi(lev)/zsapric), 10.1_r8) +! om_hksat = max(0.28_r8 - 0.2799_r8*(zsoi(lev)/zsapric), xksat) +! +! soilstate_inst%bd_col(c,lev) = (1._r8 - soilstate_inst%watsat_col(c,lev))*params_inst%pd +! soilstate_inst%watsat_col(c,lev) = params_inst%watsat_sf * ( (1._r8 - om_frac) * & +! soilstate_inst%watsat_col(c,lev) + om_watsat*om_frac ) +! tkm = (1._r8-om_frac) * (params_inst%tkd_sand*sand+params_inst%tkd_clay*clay)/ & +! (sand+clay)+params_inst%tkm_om*om_frac ! W/(m K) +! soilstate_inst%bsw_col(c,lev) = params_inst%bsw_sf * ( (1._r8-om_frac) * & +! (2.91_r8 + 0.159_r8*clay) + om_frac*om_b ) +! soilstate_inst%sucsat_col(c,lev) = params_inst%sucsat_sf * ( (1._r8-om_frac) * & +! soilstate_inst%sucsat_col(c,lev) + om_sucsat*om_frac ) +! soilstate_inst%hksat_min_col(c,lev) = xksat +! +! ! perc_frac is zero unless perf_frac greater than percolation threshold +! if (om_frac > pcalpha) then +! perc_norm=(1._r8 - pcalpha)**(-pcbeta) +! perc_frac=perc_norm*(om_frac - pcalpha)**pcbeta +! else +! perc_frac=0._r8 +! endif +! +! ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil +! uncon_frac=(1._r8-om_frac)+(1._r8-perc_frac)*om_frac +! +! ! uncon_hksat is series addition of mineral/organic conductivites +! if (om_frac < 1._r8) then +! uncon_hksat=uncon_frac/((1._r8-om_frac)/xksat & +! +((1._r8-perc_frac)*om_frac)/om_hksat) +! else +! uncon_hksat = 0._r8 +! end if +! soilstate_inst%hksat_col(c,lev) = params_inst%hksat_sf * ( uncon_frac*uncon_hksat + & +! (perc_frac*om_frac)*om_hksat ) +! +! soilstate_inst%tkmg_col(c,lev) = tkm ** (1._r8- soilstate_inst%watsat_col(c,lev)) +! +! soilstate_inst%tksatu_col(c,lev) = soilstate_inst%tkmg_col(c,lev)*0.57_r8**soilstate_inst%watsat_col(c,lev) +! +! soilstate_inst%tkdry_col(c,lev) = ((0.135_r8*soilstate_inst%bd_col(c,lev) + 64.7_r8) / & +! (params_inst%pd - 0.947_r8*soilstate_inst%bd_col(c,lev)))*(1._r8-om_frac) + params_inst%tkd_om*om_frac +! +! soilstate_inst%csol_col(c,lev) = ((1._r8-om_frac)*(params_inst%csol_sand*sand+ & +! params_inst%csol_clay*clay) / (sand+clay) + params_inst%csol_om*om_frac)*1.e6_r8 ! J/(m3 K) +! +! soilstate_inst%watdry_col(c,lev) = soilstate_inst%watsat_col(c,lev) * & +! (316230._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev)) +! soilstate_inst%watopt_col(c,lev) = soilstate_inst%watsat_col(c,lev) * & +! (158490._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev)) +! +! !! added by K.Sakaguchi for beta from Lee and Pielke, 1992 +! ! water content at field capacity, defined as hk = 0.1 mm/day +! ! used eqn (7.70) in CLM3 technote with k = 0.1 (mm/day) / secspday (day/sec) +! soilstate_inst%watfc_col(c,lev) = soilstate_inst%watsat_col(c,lev) * & +! (0.1_r8 / (soilstate_inst%hksat_col(c,lev)*secspday))**(1._r8/(2._r8*soilstate_inst%bsw_col(c,lev)+3._r8)) +! end if +! end do +! +! ! Urban pervious and impervious road +! if (col%itype(c) == icol_road_imperv) then +! ! Impervious road layers -- same as above except set watdry and watopt as missing +! do lev = 1,nlevgrnd +! soilstate_inst%watdry_col(c,lev) = spval +! soilstate_inst%watopt_col(c,lev) = spval +! end do +! else if (col%itype(c) == icol_road_perv) then +! ! pervious road layers - set in UrbanInitTimeConst +! end if +! +! end if +! end do +! +! ! -------------------------------------------------------------------- +! ! Set soil hydraulic and thermal properties: lake +! ! -------------------------------------------------------------------- +! +! do c = begc, endc +! g = col%gridcell(c) +! l = col%landunit(c) +! +! if (lun%itype(l)==istdlak) then +! +! do lev = 1,nlevgrnd +! if ( lev <= nlevsoi )then +! clay = soilstate_inst%cellclay_col(c,lev) +! sand = soilstate_inst%cellsand_col(c,lev) +! if ( organic_frac_squared )then +! om_frac = (soilstate_inst%cellorg_col(c,lev)/organic_max)**2._r8 +! else +! om_frac = soilstate_inst%cellorg_col(c,lev)/organic_max +! end if +! else +! clay = soilstate_inst%cellclay_col(c,nlevsoi) +! sand = soilstate_inst%cellsand_col(c,nlevsoi) +! om_frac = 0.0_r8 +! end if +! +! soilstate_inst%watsat_col(c,lev) = 0.489_r8 - 0.00126_r8*sand +! +! soilstate_inst%bsw_col(c,lev) = 2.91 + 0.159*clay +! +! soilstate_inst%sucsat_col(c,lev) = 10._r8 * ( 10._r8**(1.88_r8-0.0131_r8*sand) ) +! +! bd = (1._r8-soilstate_inst%watsat_col(c,lev))*params_inst%pd +! +! soilstate_inst%watsat_col(c,lev) = params_inst%watsat_sf * ( (1._r8 - om_frac) * & +! soilstate_inst%watsat_col(c,lev) + om_watsat_lake * om_frac ) +! +! tkm = (1._r8-om_frac)*(params_inst%tkd_sand*sand+params_inst%tkd_clay*clay)/(sand+clay) + & +! params_inst%tkm_om * om_frac ! W/(m K) +! +! soilstate_inst%bsw_col(c,lev) = params_inst%bsw_sf * ( (1._r8-om_frac) * & +! (2.91_r8 + 0.159_r8*clay) + om_frac * om_b_lake ) +! +! soilstate_inst%sucsat_col(c,lev) = params_inst%sucsat_sf * ( (1._r8-om_frac) * & +! soilstate_inst%sucsat_col(c,lev) + om_sucsat_lake * om_frac ) +! +! xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s +! +! ! perc_frac is zero unless perf_frac greater than percolation threshold +! if (om_frac > pc_lake) then +! perc_norm = (1._r8 - pc_lake)**(-pcbeta) +! perc_frac = perc_norm*(om_frac - pc_lake)**pcbeta +! else +! perc_frac = 0._r8 +! endif +! +! ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil +! uncon_frac = (1._r8-om_frac) + (1._r8-perc_frac)*om_frac +! +! ! uncon_hksat is series addition of mineral/organic conductivites +! if (om_frac < 1._r8) then +! xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s +! uncon_hksat = uncon_frac/((1._r8-om_frac)/xksat + ((1._r8-perc_frac)*om_frac)/om_hksat_lake) +! else +! uncon_hksat = 0._r8 +! end if +! +! soilstate_inst%hksat_col(c,lev) = params_inst%hksat_sf * ( uncon_frac*uncon_hksat + & +! (perc_frac*om_frac)*om_hksat_lake ) +! soilstate_inst%tkmg_col(c,lev) = tkm ** (1._r8- soilstate_inst%watsat_col(c,lev)) +! soilstate_inst%tksatu_col(c,lev) = soilstate_inst%tkmg_col(c,lev)*0.57_r8**soilstate_inst%watsat_col(c,lev) +! soilstate_inst%tkdry_col(c,lev) = ((0.135_r8*bd + 64.7_r8) / (params_inst%pd - 0.947_r8*bd))*(1._r8-om_frac) + & +! params_inst%tkd_om * om_frac +! soilstate_inst%csol_col(c,lev) = ((1._r8-om_frac)*(params_inst%csol_sand*sand+ & +! params_inst%csol_clay*clay) / (sand+clay) + params_inst%csol_om * om_frac)*1.e6_r8 ! J/(m3 K) +! soilstate_inst%watdry_col(c,lev) = soilstate_inst%watsat_col(c,lev) & +! * (316230._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev)) +! soilstate_inst%watopt_col(c,lev) = soilstate_inst%watsat_col(c,lev) & +! * (158490._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev)) +! +! !! added by K.Sakaguchi for beta from Lee and Pielke, 1992 +! ! water content at field capacity, defined as hk = 0.1 mm/day +! ! used eqn (7.70) in CLM3 technote with k = 0.1 (mm/day) / (# seconds/day) +! soilstate_inst%watfc_col(c,lev) = soilstate_inst%watsat_col(c,lev) * (0.1_r8 / & +! (soilstate_inst%hksat_col(c,lev)*secspday))**(1._r8/(2._r8*soilstate_inst%bsw_col(c,lev)+3._r8)) +! end do +! endif +! +! end do +! +! ! -------------------------------------------------------------------- +! ! Initialize threshold soil moisture and mass fracion of clay limited to 0.20 +! ! -------------------------------------------------------------------- +! +! do c = begc,endc +! g = col%gridcell(c) +! +! soilstate_inst%gwc_thr_col(c) = 0.17_r8 + 0.14_r8 * clay3d(g,1) * 0.01_r8 +! soilstate_inst%mss_frc_cly_vld_col(c) = min(clay3d(g,1) * 0.01_r8, 0.20_r8) +! end do +! +! ! -------------------------------------------------------------------- +! ! Deallocate memory +! ! -------------------------------------------------------------------- +! +! deallocate(sand3d, clay3d, organic3d) +! deallocate(zisoifl, zsoifl) + + end subroutine SoilStateInitTimeConst + +end module SoilStateInitTimeConstMod From 104fa46058295c4dba8dc57261e9ffef8b8b7a25 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 26 Nov 2024 11:08:13 -0500 Subject: [PATCH 575/589] temporary sand/clay initialization --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index 3bc4b3817..3377fa67b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -109,9 +109,9 @@ subroutine Init(this, bounds) allocate(this%clayfrac_patch (begp:endp)) ; this%clayfrac_patch (:) = 0.5 ! jkolassa: temporary; replace with Catchment soil texture allocate(this%cellorg_col (begc:endc,nlevsoi)) ; this%cellorg_col (:,:) = nan - allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = 0.5 ! jkolassa: + allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = 0.5*100. ! jkolassa: temporary; replace with Catchment soil texture - allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = 0.5 ! jkolassa: + allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = 0.5*100. ! jkolassa: temporary; replace with Catchment soil texture allocate(this%bd_col (begc:endc,nlevgrnd)) ; this%bd_col (:,:) = nan From 44a5d6af1d4a24ba3f6128be8d9c2bb8a34e9656 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 26 Nov 2024 17:04:30 -0500 Subject: [PATCH 576/589] typo fix --- .../CLM51/CNCLM_SoilStateType.F90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 index 3377fa67b..40e8089c9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilStateType.F90 @@ -106,13 +106,10 @@ subroutine Init(this, bounds) allocate(this%mss_frc_cly_vld_col (begc:endc)) ; this%mss_frc_cly_vld_col (:) = nan allocate(this%sandfrac_patch (begp:endp)) ; this%sandfrac_patch (:) = 0.5 ! jkolassa: temporary; replace with Catchment soil texture - allocate(this%clayfrac_patch (begp:endp)) ; this%clayfrac_patch (:) = 0.5 ! jkolassa: - temporary; replace with Catchment soil texture + allocate(this%clayfrac_patch (begp:endp)) ; this%clayfrac_patch (:) = 0.5 ! jkolassa: temporary; replace with Catchment soil texture allocate(this%cellorg_col (begc:endc,nlevsoi)) ; this%cellorg_col (:,:) = nan - allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = 0.5*100. ! jkolassa: - temporary; replace with Catchment soil texture - allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = 0.5*100. ! jkolassa: - temporary; replace with Catchment soil texture + allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = 0.5*100. ! jkolassa: temporary; replace with Catchment soil texture + allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = 0.5*100. ! jkolassa: temporary; replace with Catchment soil texture allocate(this%bd_col (begc:endc,nlevgrnd)) ; this%bd_col (:,:) = nan allocate(this%hksat_col (begc:endc,nlevgrnd)) ; this%hksat_col (:,:) = spval From 7a8e91dac57d16815d12fb2d069ac817b2b4bf04 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 26 Nov 2024 17:13:49 -0500 Subject: [PATCH 577/589] change to standard function for reading namelist group in SoilStateInitTimeConstMod.F90 --- .../CLM51/SoilStateInitTimeConstMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 index 74b6fa804..00ec43bd6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 @@ -62,7 +62,7 @@ subroutine ReadNL( nlfilename ) use shr_mpi_mod , only : shr_mpi_bcast use shr_log_mod , only : errMsg => shr_log_errMsg use fileutils , only : getavu, relavu, opnfil - use clm_nlUtilsMod , only : find_nlgroup_name + use shr_nl_mod , only : shr_nl_find_group_name use clm_varctl , only : iulog use spmdMod , only : mpicom, masterproc use abortUtils , only : endrun @@ -89,7 +89,7 @@ subroutine ReadNL( nlfilename ) unitn = getavu() write(iulog,*) 'Read in '//nl_name//' namelist' call opnfil (nlfilename, unitn, 'F') - call find_nlgroup_name(unitn, nl_name, status=ierr) + call shr_nl_find_group_name(unitn, nl_name, status=ierr) if (ierr == 0) then read(unit=unitn, nml=clm_soilstate_inparm, iostat=ierr) if (ierr /= 0) then From a2b4df702e7f8e6d3de79a1fb9396628dafdee4c Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 26 Nov 2024 17:40:14 -0500 Subject: [PATCH 578/589] remove unnecessary variables --- .../CLM51/SoilStateInitTimeConstMod.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 index 00ec43bd6..e6e213aed 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/SoilStateInitTimeConstMod.F90 @@ -161,19 +161,19 @@ subroutine SoilStateInitTimeConst(bounds, soilstate_inst, nlfilename) use decompMod , only : bounds_type use abortutils , only : endrun use spmdMod , only : masterproc - use ncdio_pio , only : file_desc_t, ncd_io, ncd_double, ncd_int, ncd_inqvdlen - use ncdio_pio , only : ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use ncdio_pio , only : file_desc_t, ncd_io + use ncdio_pio , only : ncd_pio_openfile, ncd_pio_closefile use clm_varpar , only : numrad - use clm_varpar , only : nlevsoi, nlevgrnd, nlevlak, nlevsoifl, nlayer, nlayert, nlevmaxurbgrnd, nlevsno + use clm_varpar , only : nlevsoi, nlevgrnd, nlevlak, nlayer, nlevmaxurbgrnd, nlevsno use clm_varcon , only : zsoi, dzsoi, zisoi, spval - use clm_varcon , only : secspday, pc, mu, denh2o, denice, grlnd + use clm_varcon , only : secspday, denh2o, grlnd use clm_varctl , only : use_cn, use_lch4, use_fates - use clm_varctl , only : iulog, fsurdat, paramfile, soil_layerstruct_predefined + use clm_varctl , only : iulog use landunit_varcon , only : istdlak, istwet, istsoil, istcrop, istice_mec use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv use fileutils , only : getfil - use organicFileMod , only : organicrd - use FuncPedotransferMod , only : pedotransf, get_ipedof + !use organicFileMod , only : organicrd + !use FuncPedotransferMod , only : pedotransf, get_ipedof use RootBiophysMod , only : init_vegrootfr use GridcellType , only : grc ! From 221b1da6dedca80354cd4729f41e365c4d3a5662 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 27 Nov 2024 09:17:23 -0500 Subject: [PATCH 579/589] bug fixes --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 3 +-- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 4 +++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 2f8ce2b18..1eb42a7f2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -220,7 +220,6 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions integer :: n, p, nc, nz, np, nv - real(r8) :: pd = 2700. ! Particle density of soil (kg/m3 !------------------------------- @@ -252,7 +251,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m soilstate_inst%soilpsi_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*rzm(nc,nz)**(-bee(nc)) ! jkolassa: only one soil layer at this point soilstate_inst%psiwilt_col(n,1:nlevgrnd) = 1.e-6*psis(nc)*grav*denh2o*wpwet(nc)**(-bee(nc)) ! jkolassa: soil water potential at wilting point (not a CLM variable, but added to use instead of constant threshold to determine water stress) soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd) = poros(nc) - soilstate_inst%bd_col(n,1:nlevmaxurbgrnd) = (1._r8 - soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd))*pd + soilstate_inst%bd_col(n,1:nlevmaxurbgrnd) = (1. - soilstate_inst%watsat_col(n,1:nlevmaxurbgrnd))*2700. atm2lnd_inst%forc_t_downscaled_col(n) = tairm(nc) water_inst%wateratm2lndbulk_inst%forc_rain_downscaled_col(n) = rainfm(nc) water_inst%wateratm2lndbulk_inst%forc_snow_downscaled_col(n) = snowfm(nc) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index cc977f185..91aa9f606 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -142,7 +142,9 @@ subroutine clm_varpar_init() ! currently it works on either a single level or on nlevsoi and nlevgrnd levels if (use_vertsoilc) then nlevdecomp = nlevsoi - nlevdecomp_full = nlevgrnd + ! nlevdecomp_full = nlevgrnd + nlevdecomp_full = nlevdecomp + 1 !jkolassa Nov 2024: nlevdecomp_full needs to be larger than nlevdecomp + ! when use_vertsoilc is true else nlevdecomp = 1 nlevdecomp_full = 1 From a17c802c1ffe25dcc15f92e01b15920087c3fafb Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 28 Feb 2025 15:47:58 -0500 Subject: [PATCH 580/589] update time step counter --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 7 ++++++- .../GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 | 1 - .../GEOS_CatchCNCLM51GridComp.F90 | 4 ++-- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 1eb42a7f2..328546162 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -61,7 +61,7 @@ module CNCLM_DriverMod contains !--------------------------------- - subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& + subroutine CN_Driver(istep,nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m,& rzm,sfm,rhm,windm,rainfm,snowfm,prec10d,prec60d,et365d,gdp,& abm,peatf,hdm,lnfm,poros,rh30,totwat,bflow,runsrf,sndzn,& fsnow,tg10d,t2m5d,sndzn5d,water_inst,first, & @@ -78,6 +78,7 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m implicit none !INPUT + integer, intent(in) :: istep ! number of CN time steps run integer, intent(in) :: nch ! number of tiles integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction @@ -220,9 +221,13 @@ subroutine CN_Driver(nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire,car1m real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions integer :: n, p, nc, nz, np, nv + integer :: nstep_cn ! number of CN model steps run !------------------------------- + ! update time step + nstep_cn = get_nstep(istep) + ! update CLM types with current states n = 0 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index 77ed14851..d005daf74 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -102,7 +102,6 @@ integer function get_nstep(istep) if(istep_default < 0) stop 'CN: istep_default < 0' get_nstep = istep_default ! for FireMod - get_nstep = get_nstep - 1 end function get_nstep !========================================================================================= diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 7704232c4..8b73f7c4a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -3964,7 +3964,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: nv, nz, ib real :: bare logical, save :: first = .true. - integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline + integer*8, save :: istep_cn = 0 ! gkw: legacy variable from offline real :: ndt integer :: nstep_cn @@ -7105,7 +7105,7 @@ subroutine Driver ( RC ) sndzm = sndzm / cnsum asnowm = asnowm / cnsum - call CN_Driver(ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& + call CN_Driver(istep_cn,ntiles,ityp,fveg,ndep,tpm,tairm,psis,bee,dayl,btran_fire,ar1m,& rzmm,sfmm,rhm,windm,rainfm,snowfm,TPREC10D,TPREC60D,ET365D,gdp,& abm,peatf,hdm,lnfm,poros,RH30D,totwatm,bflowm,runsrfm,sndzm,& asnowm,TG10D,T2MMIN5D,SNDZM5D,water_inst, first_cn, & From df09e61b721a8e499112629f9b71ce3baaba75ce Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 3 Mar 2025 12:33:26 -0500 Subject: [PATCH 581/589] adding inclusion of get_nstep in CN_Driver --- .../GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index 328546162..af6939add 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -5,7 +5,7 @@ module CNCLM_DriverMod use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& var_col, var_pft, nlevgrnd, numpft, ndecomp_pools use clm_varcon , only : grav, denh2o - use clm_time_manager , only : is_first_step + use clm_time_manager , only : is_first_step, get_nstep use decompMod use filterMod use SoilBiogeochemCarbonFluxType From 25eef52029a8f5f262d330a824d08575a523bc64 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 May 2025 07:50:15 -0400 Subject: [PATCH 582/589] bug fix in root respiration calculation --- .../CLM51/CNCLM_CNVegCarbonFluxType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 index f250df0ed..00ab7d811 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_CNVegCarbonFluxType.F90 @@ -1742,6 +1742,7 @@ subroutine Summary_carbonflux(this, & ! root respiration (RR) this%rr_patch(p) = & this%froot_mr_patch(p) + & + this%livecroot_mr_patch(p) + & this%cpool_froot_gr_patch(p) + & this%cpool_livecroot_gr_patch(p) + & this%cpool_deadcroot_gr_patch(p) + & From b4c3853e801ca5652e54ba967a3448dabb0784a9 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 May 2025 07:51:12 -0400 Subject: [PATCH 583/589] add heterotrophic respiration from coarse woody debris as on of the heterotrophic respiration components --- .../CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 index 1e52ec427..e03bf4ea0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_SoilBiogeochemCarbonFluxType.F90 @@ -44,6 +44,7 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: hr_col (:) ! (gC/m2/s) total heterotrophic respiration real(r8), pointer :: lithr_col (:) ! (gC/m2/s) litter heterotrophic respiration real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res + real(r8), pointer :: cwdhr_col (:) ! (gC/m2/s) coarse woody debris heterotrophic res real(r8), pointer :: soilc_change_col (:) ! (gC/m2/s) FUN used soil C @@ -134,6 +135,7 @@ subroutine Init(this, bounds) allocate(this%hr_col (begc:endc)) ; this%hr_col (:) = nan allocate(this%lithr_col (begc:endc)) ; this%lithr_col (:) = nan allocate(this%somhr_col (begc:endc)) ; this%somhr_col (:) = nan + allocate(this%cwdhr_col (begc:endc)) ; this%cwdhr_col (:) = nan allocate(this%soilc_change_col (begc:endc)) ; this%soilc_change_col (:) = nan ! if(use_soil_matrixcn)then @@ -257,6 +259,7 @@ subroutine SetValues ( this, num_column, filter_column, value_column) this%somc_fire_col(i) = value_column this%som_c_leached_col(i) = value_column this%somhr_col(i) = value_column + this%cwdhr_col(i) = value_column this%lithr_col(i) = value_column this%soilc_change_col(i) = value_column end do @@ -366,12 +369,25 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) end do end associate + ! coarse woody debris heterotrophic respiration (CWDHR) + associate(is_cwd => decomp_cascade_con%is_cwd) ! TRUE => pool is a cwd pool + do k = 1, ndecomp_cascade_transitions + if ( is_cwd(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdhr_col(c) = this%cwdhr_col(c) + this%decomp_cascade_hr_col(c,k) + end do + end if + end do + end associate + ! total heterotrophic respiration (HR) do fc = 1,num_soilc c = filter_soilc(fc) this%hr_col(c) = & this%lithr_col(c) + & + this%cwdhr_col(c) + & this%somhr_col(c) end do From 4a8d46316e09c6c70a885e1bdff9804897f8e902 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 May 2025 09:03:56 -0400 Subject: [PATCH 584/589] bug fixes in configuration --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 2 +- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index c55c95cd9..6706a7813 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -351,7 +351,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call readCNGapMortalityParams(ncid) call readCNFUNParams(ncid) call readSoilBiogeochemNitrifDenitrifParams(ncid) - call readParams_SoilStateInitTimeConst(ncid) + !call readParams_SoilStateInitTimeConst(ncid) call ncid%close(rc=status) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 index abf4443ac..1a88cf7aa 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varctl.F90 @@ -30,7 +30,7 @@ module clm_varctl logical, public :: use_lch4 = .false. logical, public :: use_nitrif_denitrif = .true. - logical, public :: use_vertsoilc = .true. + logical, public :: use_vertsoilc = .false. logical, public :: use_century_decomp = .true. logical, public :: use_cn = .true. logical, public :: use_cndv = .false. From 647d0bd7723d3bb7856c66c354a4f72b52f2d0c3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 27 May 2025 15:00:43 -0400 Subject: [PATCH 585/589] fix nlevdecomp_full definition --- .../GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 index 91aa9f606..22eecb28e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_varpar.F90 @@ -142,8 +142,8 @@ subroutine clm_varpar_init() ! currently it works on either a single level or on nlevsoi and nlevgrnd levels if (use_vertsoilc) then nlevdecomp = nlevsoi - ! nlevdecomp_full = nlevgrnd - nlevdecomp_full = nlevdecomp + 1 !jkolassa Nov 2024: nlevdecomp_full needs to be larger than nlevdecomp + nlevdecomp_full = nlevgrnd + ! nlevdecomp_full = nlevdecomp + 1 !jkolassa Nov 2024: nlevdecomp_full needs to be larger than nlevdecomp ! when use_vertsoilc is true else nlevdecomp = 1 From 3a5d4cf4f9659f8882a175751759159696bde181 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 27 May 2025 17:37:43 -0400 Subject: [PATCH 586/589] increase istep_cn --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 8b73f7c4a..e641bfa07 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -7117,6 +7117,8 @@ subroutine Driver ( RC ) sminn_to_npool,ndep_to_sminn,totvegn,totlitn,totsomn,& retransn,retransn_to_npool,fuelc,totlitc,cwdc,rootc) + istep_cn = istep_cn + 1 + ! jkolassa: padd is a correction term that we may no longer need; ! I am setting it to zero here in order to avoid having to change ! the restart file for now From d9b3d78b00d90febae19b57819ed0d98ceaa8cd6 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 20 Jun 2025 14:32:00 -0400 Subject: [PATCH 587/589] fix N_CONSTIT and get_nstep kind --- .../CLM51/CNCLM_DriverMod.F90 | 5 +- .../CLM51/CNFUNMod.F90 | 5 +- .../CLM51/CN_init_mod.F90 | 2 +- .../CLM51/clm_time_manager.F90 | 10 ++- .../GEOS_CatchCNCLM51GridComp.F90 | 82 ++++++++++--------- 5 files changed, 57 insertions(+), 47 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 index af6939add..ba5340f53 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNCLM_DriverMod.F90 @@ -1,5 +1,6 @@ module CNCLM_DriverMod + use, intrinsic :: iso_fortran_env, only: INT64 use nanMod , only : nan use CNVegetationFacade use clm_varpar , only : nlevsno, nlevmaxurbgrnd, num_veg, num_zon, CN_zone_weight,& @@ -78,7 +79,7 @@ subroutine CN_Driver(istep,nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire implicit none !INPUT - integer, intent(in) :: istep ! number of CN time steps run + integer(INT64), intent(in) :: istep ! number of CN time steps run integer, intent(in) :: nch ! number of tiles integer, dimension(nch,num_veg,num_zon), intent(in) :: ityp ! PFT index real, dimension(nch,num_veg,num_zon), intent(in) :: fveg ! PFT fraction @@ -221,7 +222,7 @@ subroutine CN_Driver(istep,nch,ityp,fveg,ndep,tp1,tairm,psis,bee,dayl,btran_fire real :: pwtgcell logical, save :: doalb = .true. ! assume surface albedo calculation time step; jkolassa: following setting from previous CNCLM versions integer :: n, p, nc, nz, np, nv - integer :: nstep_cn ! number of CN model steps run + integer(INT64) :: nstep_cn ! number of CN model steps run !------------------------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 index d5ccc862f..9c4cce20b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNFUNMod.F90 @@ -17,7 +17,8 @@ module CNFUNMod ! ! available to the plant for grwoth, and the C spent on obtaining ! it. -! !USES: +! !USES: + use, intrinsic :: iso_fortran_env, only: INT64 use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varctl , only : iulog @@ -138,7 +139,7 @@ subroutine CNFUNInit (bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitro ! FUN (s) real(r8) :: numofyear ! number of days per ! year - integer :: nstep ! time step number + integer(INT64) :: nstep ! time step number integer :: nstep_fun ! Number of ! atmospheric timesteps between calls to FUN character(len=32) :: subname = 'CNFUNInit' diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index 6706a7813..e20469f4b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -8,7 +8,7 @@ module CN_initMod use clm_varpar , only : VAR_COL, VAR_PFT, clm_varpar_init use clm_varctl , only : use_century_decomp, init_clm_varctl use clm_time_manager , only : get_step_size, update_rad_dtime - use decompMod + use decompMod , only : bounds use filterMod use CNVegNitrogenStateType use CNVegCarbonStateType diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 index d005daf74..8b5753dca 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/clm_time_manager.F90 @@ -3,6 +3,7 @@ module clm_time_manager #include "MAPL_Generic.h" #include "shr_assert.h" + use, intrinsic :: iso_fortran_env, only: INT64 use MAPL_ConstantsMod, ONLY: r8 => MAPL_R8 use update_model_para4cn, only: curr_year,curr_month,curr_day,curr_dofyr,curr_hour,curr_min,curr_sec, & prev_year,prev_month,prev_day,prev_dofyr,prev_hour,prev_min,prev_sec @@ -87,13 +88,13 @@ end function get_step_size_real !========================================================================================= -integer function get_nstep(istep) +integer(INT64) function get_nstep(istep) ! Return the timestep number. - integer*8, optional, intent(in) :: istep + integer(INT64), optional, intent(in) :: istep - integer, save :: istep_default = -999 + integer(INT64), save :: istep_default = -999 if ( present(istep) ) then istep_default = istep @@ -111,7 +112,8 @@ subroutine update_rad_dtime(doalb) ! ! Local Arguments logical,intent(in) :: doalb - integer :: dtime,nstep + integer :: dtime + integer(INT64) :: nstep if (doalb) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index e641bfa07..010dbd5ef 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -28,6 +28,7 @@ module GEOS_CatchCNCLM51GridCompMod ! ! !USES: + use, intrinsic :: iso_fortran_env, only: INT64 use sfclayer ! using module that contains sfc layer code use ESMF use GEOS_Mod @@ -3964,9 +3965,9 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: nv, nz, ib real :: bare logical, save :: first = .true. - integer*8, save :: istep_cn = 0 ! gkw: legacy variable from offline + integer(INT64), save :: istep_cn = 0 ! gkw: legacy variable from offline real :: ndt - integer :: nstep_cn + integer(INT64) :: nstep_cn ! Offline mode @@ -5256,7 +5257,7 @@ subroutine Driver ( RC ) integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_MI, AGCM_S, AGCM_HH, dofyr, AGCM_S_ofday logical, save :: first = .true. - integer*8, save :: istep_cn = 1 ! gkw: legacy variable from offline + integer(INT64), save :: istep_cn = 1 ! gkw: legacy variable from offline ! solar declination related real :: ob, declin, zs, zc, max_decl, max_dayl @@ -6155,10 +6156,12 @@ subroutine Driver ( RC ) / log((max(DZ-D0,10.)+Z0)/Z0)) !--------------- GOSWIM IMPORTS FROM GOCART --------------- - ! Initialization - RCONSTIT(:,:,:) = 0.0 - TOTDEPOS(:,:) = 0.0 - RMELT(:,:) = 0.0 + ! Initialization + if (N_CONSTIT > 0) then + RCONSTIT(:,:,:) = 0.0 + TOTDEPOS(:,:) = 0.0 + RMELT(:,:) = 0.0 + endif !------------------------------------------------------------------ ! Zero the light-absorbing aerosol (LAA) deposition rates from GOCART: @@ -6216,16 +6219,17 @@ subroutine Driver ( RC ) ! TOTDEPOS(:,13): Combined sea salt deposition from size bin 3 (dry, conv-scav, ls-scav, sed) ! TOTDEPOS(:,14): Combined sea salt deposition from size bin 4 (dry, conv-scav, ls-scav, sed) ! TOTDEPOS(:,15): Combined sea salt deposition from size bin 5 (dry, conv-scav, ls-scav, sed) - - TOTDEPOS(:,1) = DUDP(:,1) + DUSV(:,1) + DUWT(:,1) + DUSD(:,1) - TOTDEPOS(:,2) = DUDP(:,2) + DUSV(:,2) + DUWT(:,2) + DUSD(:,2) - TOTDEPOS(:,3) = DUDP(:,3) + DUSV(:,3) + DUWT(:,3) + DUSD(:,3) - TOTDEPOS(:,4) = DUDP(:,4) + DUSV(:,4) + DUWT(:,4) + DUSD(:,4) - TOTDEPOS(:,5) = DUDP(:,5) + DUSV(:,5) + DUWT(:,5) + DUSD(:,5) - TOTDEPOS(:,6) = BCDP(:,1) + BCSV(:,1) + BCWT(:,1) + BCSD(:,1) - TOTDEPOS(:,7) = BCDP(:,2) + BCSV(:,2) + BCWT(:,2) + BCSD(:,2) - TOTDEPOS(:,8) = OCDP(:,1) + OCSV(:,1) + OCWT(:,1) + OCSD(:,1) - TOTDEPOS(:,9) = OCDP(:,2) + OCSV(:,2) + OCWT(:,2) + OCSD(:,2) + if (N_CONSTIT > 0) then + TOTDEPOS(:,1) = DUDP(:,1) + DUSV(:,1) + DUWT(:,1) + DUSD(:,1) + TOTDEPOS(:,2) = DUDP(:,2) + DUSV(:,2) + DUWT(:,2) + DUSD(:,2) + TOTDEPOS(:,3) = DUDP(:,3) + DUSV(:,3) + DUWT(:,3) + DUSD(:,3) + TOTDEPOS(:,4) = DUDP(:,4) + DUSV(:,4) + DUWT(:,4) + DUSD(:,4) + TOTDEPOS(:,5) = DUDP(:,5) + DUSV(:,5) + DUWT(:,5) + DUSD(:,5) + TOTDEPOS(:,6) = BCDP(:,1) + BCSV(:,1) + BCWT(:,1) + BCSD(:,1) + TOTDEPOS(:,7) = BCDP(:,2) + BCSV(:,2) + BCWT(:,2) + BCSD(:,2) + TOTDEPOS(:,8) = OCDP(:,1) + OCSV(:,1) + OCWT(:,1) + OCSD(:,1) + TOTDEPOS(:,9) = OCDP(:,2) + OCSV(:,2) + OCWT(:,2) + OCSD(:,2) + endif !============================= Possible future applications ==================================== ! TOTDEPOS(:,10) = SUDP(:,1) + SUSV(:,1) + SUWT(:,1) + SUSD(:,1) ! TOTDEPOS(:,11) = SSDP(:,1) + SSSV(:,1) + SSWT(:,1) + SSSD(:,1) @@ -6257,17 +6261,17 @@ subroutine Driver ( RC ) ! RCONSTIT(NTILES,N,13): Sea salt mass from size bin 3 in layer N ! RCONSTIT(NTILES,N,14): Sea salt mass from size bin 4 in layer N ! RCONSTIT(NTILES,N,15): Sea salt mass from size bin 5 in layer N - - RCONSTIT(:,:,1) = RDU001(:,:) - RCONSTIT(:,:,2) = RDU002(:,:) - RCONSTIT(:,:,3) = RDU003(:,:) - RCONSTIT(:,:,4) = RDU004(:,:) - RCONSTIT(:,:,5) = RDU005(:,:) - RCONSTIT(:,:,6) = RBC001(:,:) - RCONSTIT(:,:,7) = RBC002(:,:) - RCONSTIT(:,:,8) = ROC001(:,:) - RCONSTIT(:,:,9) = ROC002(:,:) - + if (N_CONSTIT > 0) then + RCONSTIT(:,:,1) = RDU001(:,:) + RCONSTIT(:,:,2) = RDU002(:,:) + RCONSTIT(:,:,3) = RDU003(:,:) + RCONSTIT(:,:,4) = RDU004(:,:) + RCONSTIT(:,:,5) = RDU005(:,:) + RCONSTIT(:,:,6) = RBC001(:,:) + RCONSTIT(:,:,7) = RBC002(:,:) + RCONSTIT(:,:,8) = ROC001(:,:) + RCONSTIT(:,:,9) = ROC002(:,:) + endif !============================= Possible future applications ==================================== ! RCONSTIT(:,:,10) = RSU003(:,:) ! RCONSTIT(:,:,11) = RSS001(:,:) @@ -7902,15 +7906,17 @@ subroutine Driver ( RC ) if(associated(FICE2 )) FICE2 = max( min( FICESOUT(2,:),1.0 ), 0.0 ) if(associated(FICE3 )) FICE3 = max( min( FICESOUT(3,:),1.0 ), 0.0 ) - if(associated(RMELTDU001)) RMELTDU001 = RMELT(:,1) - if(associated(RMELTDU002)) RMELTDU002 = RMELT(:,2) - if(associated(RMELTDU003)) RMELTDU003 = RMELT(:,3) - if(associated(RMELTDU004)) RMELTDU004 = RMELT(:,4) - if(associated(RMELTDU005)) RMELTDU005 = RMELT(:,5) - if(associated(RMELTBC001)) RMELTBC001 = RMELT(:,6) - if(associated(RMELTBC002)) RMELTBC002 = RMELT(:,7) - if(associated(RMELTOC001)) RMELTOC001 = RMELT(:,8) - if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) + if (N_CONSTIT > 0) then + if(associated(RMELTDU001)) RMELTDU001 = RMELT(:,1) + if(associated(RMELTDU002)) RMELTDU002 = RMELT(:,2) + if(associated(RMELTDU003)) RMELTDU003 = RMELT(:,3) + if(associated(RMELTDU004)) RMELTDU004 = RMELT(:,4) + if(associated(RMELTDU005)) RMELTDU005 = RMELT(:,5) + if(associated(RMELTBC001)) RMELTBC001 = RMELT(:,6) + if(associated(RMELTBC002)) RMELTBC002 = RMELT(:,7) + if(associated(RMELTOC001)) RMELTOC001 = RMELT(:,8) + if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) + endif if(associated(PEATCLSM_FSWCHANGE )) then where (POROS >= PEATCLSM_POROS_THRESHOLD) PEATCLSM_FSWCHANGE = FSW_CHANGE @@ -7987,7 +7993,7 @@ subroutine Driver ( RC ) SNDZN2 = SNDZN (2,:) SNDZN3 = SNDZN (3,:) - if (catchcn_internal%N_CONST_LAND4SNWALB /= 0) then + if (catchcn_internal%N_CONST_LAND4SNWALB /= 0 .and. N_CONSTIT > 0 ) then RDU001(:,:) = RCONSTIT(:,:,1) RDU002(:,:) = RCONSTIT(:,:,2) RDU003(:,:) = RCONSTIT(:,:,3) From 3dc717ca874ffdf26b0150b95e4191f1c8745952 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 24 Jun 2025 12:07:47 -0400 Subject: [PATCH 588/589] manual update to align with latest develop branch --- .../GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 index 010dbd5ef..eb7a5d959 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/GEOS_CatchCNCLM51GridComp.F90 @@ -8586,7 +8586,7 @@ subroutine RUN0(gc, import, export, clock, rc) wesnn(1,:) = wesnn1 wesnn(2,:) = wesnn2 wesnn(3,:) = wesnn3 - call StieglitzSnow_calc_asnow(3, ntiles, wesnn, asnow) + call StieglitzSnow_calc_asnow(N_snow, ntiles, wesnn, asnow) EMIS = fveg1*(EMSVEG(NINT(VEG1)) + (EMSBARESOIL - EMSVEG(NINT(VEG1)))*exp(-LAI1)) + & fveg2*(EMSVEG(NINT(VEG2)) + (EMSBARESOIL - EMSVEG(NINT(VEG2)))*exp(-LAI2)) From 4438c627f3861514de8e2d6f03c2b5a375893844 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 24 Jun 2025 12:08:41 -0400 Subject: [PATCH 589/589] move initialization of CNFUN variables to before CNDriver call --- .../GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 index e20469f4b..d3b046724 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CN_init_mod.F90 @@ -78,7 +78,8 @@ module CN_initMod use SoilBiogeochemCompetitionMod , only : SoilBiogeochemCompetitionInit use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams use CNGapMortalityMod , only : readCNGapMortalityParams => readParams - use CNFUNMod , only : readCNFUNParams => readParams + use CNFUNMod , only : readCNFUNParams => readParams, & + CNFUNInit use CNNDynamicsMod , only : CNNDynamicsReadNML use SurfaceAlbedoMod , only: SurfaceAlbedo_readnl use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControlInit @@ -359,6 +360,7 @@ subroutine CN_init(nch,ityp,fveg,cncol,cnpft,lats,lons,dtcn,water_inst,bgc_veget call CNPhenologyInit (bounds) call SoilBiogeochemCompetitionInit (bounds) + call CNFUNInit(bounds,bgc_vegetation_inst%cnveg_state_inst,bgc_vegetation_inst%cnveg_carbonstate_inst,bgc_vegetation_inst%cnveg_nitrogenstate_inst) ! Initialize precision control for soil biogeochemistry (use soilbiogeochem_carbonstate three times, since we do not currently use isotopes) call SoilBiogeochemPrecisionControlInit( soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonstate_inst, &