diff --git a/src/coupled/AM3/control/casa/shared/progs_cnp_vars_mod.F90 b/src/coupled/AM3/control/casa/shared/progs_cnp_vars_mod.F90 index 419990e3d..2575901fb 100644 --- a/src/coupled/AM3/control/casa/shared/progs_cnp_vars_mod.F90 +++ b/src/coupled/AM3/control/casa/shared/progs_cnp_vars_mod.F90 @@ -6,8 +6,15 @@ MODULE progs_cnp_vars_mod PUBLIC :: progs_cnp_vars_assoc PUBLIC :: progs_cnp_vars_data_type PUBLIC :: progs_cnp_vars_type +PUBLIC :: nCpool_casa +PUBLIC :: nNpool_casa +PUBLIC :: nPPool_casa PRIVATE +INTEGER, PARAMETER :: nCpool_casa = 10 +INTEGER, PARAMETER :: nNpool_casa = 10 +INTEGER, PARAMETER :: nPPool_casa = 12 + CHARACTER(LEN=*), PARAMETER, PRIVATE :: ModuleName='PROGS_CNP_VARS_MOD' ! Prognostic Fields for CASA-CNP to be initialized from IO TYPE :: progs_cnp_vars_data_type @@ -54,7 +61,6 @@ MODULE progs_cnp_vars_mod SUBROUTINE progs_cnp_vars_alloc(land_pts, nsurft, progs_cnp_vars_data ) -USE grid_constants_mod_cbl, ONLY : nCpool_casa, nNpool_casa, nPpool_casa USE casadimension, ONLY: mwood IMPLICIT NONE diff --git a/src/offline/cable_parameters.F90 b/src/offline/cable_parameters.F90 index b6133f64f..0a1451d3b 100644 --- a/src/offline/cable_parameters.F90 +++ b/src/offline/cable_parameters.F90 @@ -2474,7 +2474,7 @@ SUBROUTINE consistency_ice_veg_soil(soil, veg) ! Ensure that when an active patch has a veg type of ice then its soil type is also ice and vice versa ! Any change effected to enforce this consistency includes correcting the appropriate paramter values - USE grid_constants_mod_cbl, ONLY : ICE_SoilType, ICE_VegType + USE grid_constants_mod_cbl, ONLY : ICE_SoilType, ICE_VegType => ice_cable USE cable_phys_constants_mod, ONLY : csice, density_ice TYPE (soil_parameter_type), INTENT(INOUT) :: soil ! soil parameter data diff --git a/src/params/cable_other_constants_mod.F90 b/src/params/cable_other_constants_mod.F90 index 77d0efb15..b91797355 100644 --- a/src/params/cable_other_constants_mod.F90 +++ b/src/params/cable_other_constants_mod.F90 @@ -18,6 +18,10 @@ MODULE cable_other_constants_mod !----------------------------------------------------------------------------- !CABLE science not yet in JAC uses msn to describe number of snow layers USE grid_constants_mod_cbl, ONLY: nrb, nsl, nsCs, nvCs, msn => nsnl +USE grid_constants_mod_cbl, ONLY: n_soiltypes => nsoil_max ! # of soil types [9] +USE grid_constants_mod_cbl, ONLY: niter ! # iterations za/L +USE grid_constants_mod_cbl, ONLY: mf !sunlit/shaded leaves +USE grid_constants_mod_cbl, ONLY: swb ! 2 shortwave bands (VIS,NIR) IMPLICIT NONE @@ -28,17 +32,7 @@ MODULE cable_other_constants_mod REAL, PARAMETER :: rad_thresh = 0.001 ! min. zenithal angle for downward SW REAL, PARAMETER :: lai_thresh = 0.001 ! min. LAI to be considered as vegetated -INTEGER, PARAMETER :: & - swb = 2, & ! 2 shortwave bands (initial division - visible / - ! near infrared) - n_sw_bands = 4, & ! total number of shortwave radiation bands - ! (above divided into direct / diffuse) - mf = 2, & ! types of leaves (sunlit / shaded) - r_2 = SELECTED_REAL_KIND(12, 50), &!this will be removed - ! double precision real dimension - niter = 4, & ! number of iterations for za/L - n_assim_rates = 3, & ! Rubisco, RuBP and Sink-limited rates of photosynthesis - n_soiltypes = 9 ! number of soil types +INTEGER, PARAMETER :: r_2 = KIND(1.d0) ! SELECTED_REAL_KIND(12, 50) REAL, PARAMETER :: & max_snow_depth = 50000.0, & ! maximum depth of lying snow on tiles (kg/m2) diff --git a/src/params/grid_constants_cbl.F90 b/src/params/grid_constants_cbl.F90 index 8d2ec313a..53d7b8346 100644 --- a/src/params/grid_constants_cbl.F90 +++ b/src/params/grid_constants_cbl.F90 @@ -1,3 +1,4 @@ +!#define UM_CBL YES !****************************************************************************** ! This source code is part of the Community Atmosphere Biosphere Land Exchange ! (CABLE) model. This work is licensed under the CSIRO Open Source Software @@ -45,12 +46,14 @@ MODULE grid_constants_mod_cbl INTEGER, PARAMETER :: nsCs = 2 ! # soil carbon stores INTEGER, PARAMETER :: nvCs = 3 ! # vegetation carbon stores INTEGER, PARAMETER :: ICE_SoilType = 9 ! SoilType Index (soilparm_cable.nml JAC) -INTEGER, PARAMETER :: lakes_cable = 16! SoilType Index (soilparm_cable.nml JAC) - -INTEGER, PARAMETER :: ICE_VegType = 17 ! permanent ice index for veg - -INTEGER, PARAMETER :: mf = 2 ! # leaves (sunlit, shaded) -INTEGER, PARAMETER :: niter = 4 ! number of iterations for za/L +#ifndef UM_CBL +! UM_CBL gets from cable_surface_types namelist +INTEGER, PARAMETER :: lakes_cable = 16 ! cable_surface_type (nml) Index +INTEGER, PARAMETER :: ice_cable = 17 ! cable_surface_type (nml) Index +#endif +INTEGER, PARAMETER :: mf = 2 ! # leaves (sunlit, shaded) +INTEGER, PARAMETER :: niter = 4 ! number of iterations for za/L +INTEGER, PARAMETER :: swb = 2 ! # SW bands (VIS+NIR) - CM3 alloc TYPEs ! Strictly NOT a constant. # of active tiles, length of CABLE working vectors INTEGER :: mp diff --git a/src/science/albedo/cbl_snow_albedo.F90 b/src/science/albedo/cbl_snow_albedo.F90 index efed51a6a..ed81b3cf3 100644 --- a/src/science/albedo/cbl_snow_albedo.F90 +++ b/src/science/albedo/cbl_snow_albedo.F90 @@ -76,6 +76,9 @@ SUBROUTINE surface_albedosn( AlbSnow, AlbSoil, mp, nrb, ICE_SoilType, & alvo = 0.95, & ! albedo for vis. on a new snow aliro = 0.70 ! albedo for near-infr. on a new snow +REAL, PARAMETER :: sfact_default = 0.68 +REAL, PARAMETER :: sfact_dark = 0.62 +REAL, PARAMETER :: sfact_darker = 0.5 INTEGER :: i !looping variable !initialise to the no-snow value for albedo for all land points @@ -89,11 +92,12 @@ SUBROUTINE surface_albedosn( AlbSnow, AlbSoil, mp, nrb, ICE_SoilType, & SoilAlbsoilF = 0.85 END WHERE -sfact(:) = 0.68 +!initialize all land points +sfact(:) = sfact_default WHERE (SoilAlbsoilF <= 0.14) - sfact = 0.5 + sfact = sfact_darker ! NB: .14 corresponds to snow albedo < liq lakes ELSE WHERE (SoilAlbsoilF > 0.14 .AND. SoilAlbsoilF <= 0.20) - sfact = 0.62 + sfact = sfact_dark ! captures liq lakes & similar snow albedo cells END WHERE !first estimate of snow-affected surface albedos diff --git a/src/science/misc/cable_carbon.F90 b/src/science/misc/cable_carbon.F90 index 9d044ff7c..3148a01c2 100644 --- a/src/science/misc/cable_carbon.F90 +++ b/src/science/misc/cable_carbon.F90 @@ -68,6 +68,11 @@ SUBROUTINE carbon_pl(dels, soil, ssnow, veg, canopy, bgc) coef_drght, & ! coeff. for drought stress (eq. 8) wbav ! water stress index + REAL :: CampbellExp(mp) + REAL :: EffStressIndexWater(mp) + REAL :: EffStressIndexWilting(mp) + REAL :: RelativeStress(mp) + REAL, DIMENSION(:), ALLOCATABLE :: & rw, & ! tfcl, & ! @@ -150,8 +155,16 @@ SUBROUTINE carbon_pl(dels, soil, ssnow, veg, canopy, bgc) wbav = MAX( 0.01, wbav ) ! EAK Jan2011 ! drought stress - coef_drght = EXP( 5.*( MIN( 1., MAX( 1., wbav**( 2 - soil%ibp2 ) - 1.) / & - ( soil%swilt**( 2 - soil%ibp2 ) - 1. ) ) - 1. ) ) + CampbellExp = 2.0 - soil%ibp2 + EffStressIndexWater = wbav**( CampbellExp ) - 1.0 + EffStressIndexWater = MAX( 1.0, EffStressIndexWater ) + + EffStressIndexWilting = soil%swilt**( CampbellExp ) - 1.0 + + RelativeStress = EffStressIndexWater / EffStressIndexWilting - 1.0 + RelativeStress = MIN( 1.0, RelativeStress ) + + coef_drght = EXP( 5.0 * RelativeStress ) coef_cd = ( coef_cold + coef_drght ) * 2.0e-7 @@ -212,13 +225,13 @@ SUBROUTINE soilcarb( soil, ssnow, veg, bgc, met, canopy) USE cable_common_module - TYPE (soil_snow_type), INTENT(IN) :: ssnow - TYPE (bgc_pool_type), INTENT(IN) :: bgc - TYPE (met_type), INTENT(IN) :: met - TYPE (canopy_type), INTENT(INOUT) :: canopy + TYPE (soil_snow_type), INTENT(IN) :: ssnow + TYPE (bgc_pool_type), INTENT(IN) :: bgc + TYPE (met_type), INTENT(IN) :: met + TYPE (canopy_type), INTENT(INOUT) :: canopy - TYPE (soil_parameter_type), INTENT(IN) :: soil - TYPE (veg_parameter_type), INTENT(IN) :: veg + TYPE (soil_parameter_type), INTENT(IN) :: soil + TYPE (veg_parameter_type), INTENT(IN) :: veg REAL, DIMENSION(mp) :: & den, & ! sib3 diff --git a/src/science/roughness/cable_roughness.F90 b/src/science/roughness/cable_roughness.F90 index 9f8896356..689f35674 100644 --- a/src/science/roughness/cable_roughness.F90 +++ b/src/science/roughness/cable_roughness.F90 @@ -1,3 +1,4 @@ +!#define UM_CBL YES !============================================================================== ! This source code is part of the ! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model. @@ -22,17 +23,22 @@ MODULE cable_roughness_module -USE cable_phys_constants_mod, ONLY : CCSD => CSD -USE cable_phys_constants_mod, ONLY : CCRD => CRD -USE cable_phys_constants_mod, ONLY : CCCD => CCD -USE cable_phys_constants_mod, ONLY : CCCW_C => CCW_C -USE cable_phys_constants_mod, ONLY : CUSUHM => USUHM -USE cable_phys_constants_mod, ONLY : CVONK => VONK -USE cable_phys_constants_mod, ONLY : CA33 => A33 -USE cable_phys_constants_mod, ONLY : CCTL => CTL -USE cable_phys_constants_mod, ONLY : CZDLIN => ZDLIN -USE cable_phys_constants_mod, ONLY : CCSW => CSW -USE cable_phys_constants_mod, ONLY : CGRAV => GRAV +#ifdef UM_CBL +USE cable_surface_types_mod, ONLY: ICE_SurfaceType => ICE_cable +#else +USE grid_constants_mod_cbl, ONLY: ICE_SurfaceType => ICE_cable +#endif +USE cable_phys_constants_mod, ONLY: CCSD => CSD +USE cable_phys_constants_mod, ONLY: CCRD => CRD +USE cable_phys_constants_mod, ONLY: CCCD => CCD +USE cable_phys_constants_mod, ONLY: CCCW_C => CCW_C +USE cable_phys_constants_mod, ONLY: CUSUHM => USUHM +USE cable_phys_constants_mod, ONLY: CVONK => VONK +USE cable_phys_constants_mod, ONLY: CA33 => A33 +USE cable_phys_constants_mod, ONLY: CCTL => CTL +USE cable_phys_constants_mod, ONLY: CZDLIN => ZDLIN +USE cable_phys_constants_mod, ONLY: CCSW => CSW +USE cable_phys_constants_mod, ONLY: CGRAV => GRAV USE cable_other_constants_mod, ONLY : CLAI_THRESH => LAI_THRESH !*# Overview @@ -133,7 +139,7 @@ SUBROUTINE ruff_resist(veg, rough, ssnow, canopy, LAI_pft, HGT_pft, reducedLAIdu -USE cable_common_module, ONLY : cable_user +USE cable_common_module, ONLY : cable_user, cable_runtime USE cable_def_types_mod, ONLY : veg_parameter_type, roughness_type, & soil_snow_type, canopy_type, mp !subrs @@ -171,12 +177,14 @@ SUBROUTINE ruff_resist(veg, rough, ssnow, canopy, LAI_pft, HGT_pft, reducedLAIdu !* * evaluates the canopy height and leaf area given the presence of snow ! (or not) using [[HgtAboveSnow]] and [[LAI_eff]] rough%hruff = HeightAboveSnow - +!why are we using veg% for LAI and height-although this is synced now +IF(cable_runtime%um_radiation .OR. cable_runtime%offline ) THEN ! LAI decreases due to snow: formerly canopy%vlaiw call LAI_eff( mp, veg%vlai, veg%hc, HeightAboveSnow, & reducedLAIdue2snow ) canopy%vlaiw = reducedLAIdue2snow +ENDIF canopy%rghlai = canopy%vlaiw !* * sets the value of soil and snow roughness lengths @@ -195,7 +203,7 @@ SUBROUTINE ruff_resist(veg, rough, ssnow, canopy, LAI_pft, HGT_pft, reducedLAIdu WHERE( ssnow%snowd .GT. 0.01 ) & rough%z0soilsn = MAX(z0soilsn_min, & rough%z0soil - rough%z0soil*MIN(ssnow%snowd,10.)/10.) - WHERE( ssnow%snowd .GT. 0.01 .AND. veg%iveg == 17 ) & + WHERE( ssnow%snowd .GT. 0.01 .AND. veg%iveg == ICE_SurfaceType ) & rough%z0soilsn = MAX(rough%z0soilsn, z0soilsn_min_PF ) ELSEIF (cable_user%soil_struc=='sli') THEN diff --git a/src/science/soilsnow/cbl_surfbv.F90 b/src/science/soilsnow/cbl_surfbv.F90 index 6c62b3891..3a4e0db14 100644 --- a/src/science/soilsnow/cbl_surfbv.F90 +++ b/src/science/soilsnow/cbl_surfbv.F90 @@ -1,3 +1,4 @@ +!#define UM_CBL YES MODULE surfbv_mod USE cbl_ssnow_data_mod @@ -10,8 +11,13 @@ SUBROUTINE surfbv (dels, met, ssnow, soil, veg, canopy ) USE smoisturev_mod, ONLY: smoisturev USE cable_common_module - USE grid_constants_mod_cbl, ONLY : lakes_cable - +! data +#ifdef UM_CBL +USE cable_surface_types_mod, ONLY: lakes_cable +#else +USE grid_constants_mod_cbl, ONLY: lakes_cable +#endif + IMPLICIT NONE REAL, INTENT(IN) :: dels ! integration time step (s) @@ -29,7 +35,6 @@ SUBROUTINE surfbv (dels, met, ssnow, soil, veg, canopy ) REAL, DIMENSION(mp) :: & rnof5, & ! - sfact, & ! sgamm, & ! smasstot, & ! talb, & ! snow albedo diff --git a/src/util/cable_runtime_opts_mod.F90 b/src/util/cable_runtime_opts_mod.F90 index 628f97a48..0c3b01273 100644 --- a/src/util/cable_runtime_opts_mod.F90 +++ b/src/util/cable_runtime_opts_mod.F90 @@ -12,7 +12,7 @@ MODULE cable_runtime_opts_mod !jhan:make this logical CHARACTER(LEN=3) :: diag_soil_resp='' - CHARACTER(LEN=20) :: fwsoil_switch='' + CHARACTER(LEN=20) :: fwsoil_switch='standard' ! Ticket #56 !jhan:options?