Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add wood harvest/products pool parameters to namelist file #549

Draft
wants to merge 1 commit into
base: main
Choose a base branch
from
Draft

Add wood harvest/products pool parameters to namelist file #549

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
255 changes: 255 additions & 0 deletions src/coupled/esm16/cable_um_tech.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,255 @@
!==============================================================================
! This source code is part of the
! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model.
! This work is licensed under the CABLE Academic User Licence Agreement
! (the "Licence").
! You may not use this file except in compliance with the Licence.
! A copy of the Licence and registration form can be obtained from
! http://www.cawcr.gov.au/projects/access/cable
! You need to register and read the Licence agreement before use.
! Please contact cable_help@nf.nci.org.au for any questions on
! registration and the Licence.
!
! Unless required by applicable law or agreed to in writing,
! software distributed under the Licence is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the Licence for the specific language governing permissions and
! limitations under the Licence.
! ==============================================================================
!
! Purpose: Routines to read CABLE namelist, check variables, allocate and
! deallocate CABLE arrays
!
! Contact: Jhan.Srbinovsky@csiro.au
!
! History: Rewrite of code from v1.8 (ACCESS1.3)
! soil_snow_type now ssnow (instead of ssoil)
!
!
! ==============================================================================

MODULE cable_um_tech_mod

USE cable_def_types_mod, ONLY : air_type, bgc_pool_type, met_type, &
balances_type, radiation_type, roughness_type, sum_flux_type, &
soil_snow_type, canopy_type, veg_parameter_type, &
soil_parameter_type, climate_type

IMPLICIT NONE

TYPE(air_type), SAVE :: air
TYPE(bgc_pool_type), SAVE :: bgc
TYPE(met_type), SAVE :: met
TYPE(balances_type), SAVE :: bal
TYPE(radiation_type), SAVE :: rad
TYPE(roughness_type), SAVE :: rough
TYPE(soil_parameter_type), SAVE :: soil ! soil parameters
TYPE(soil_snow_type), SAVE :: ssnow
TYPE(sum_flux_type), SAVE :: sum_flux
TYPE(veg_parameter_type), SAVE :: veg ! vegetation parameters
TYPE(canopy_type), SAVE :: canopy
TYPE(climate_type), SAVE :: climate

TYPE derived_rad_bands
REAL, ALLOCATABLE :: &
SW_DOWN_DIR (:,:), & ! Surface downward SW direct radiation (W/m2).
SW_DOWN_DIF(:,:), & ! Surface downward SW diffuse radiation (W/m2).
SW_DOWN_VIS(:,:), & ! Surface downward VIS radiation (W/m2).
SW_DOWN_NIR(:,:), & ! Surface downward NIR radiation (W/m2).
FBEAM(:,:,:) ! Surface downward SW radiation (W/m2).
END TYPE derived_rad_bands

TYPE um_dimensions
INTEGER :: row_length, rows, land_pts, ntiles, npft, &
sm_levels, timestep
INTEGER, ALLOCATABLE, DIMENSION(:) :: tile_pts, land_index
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: tile_index
REAL :: rho_water
REAL,ALLOCATABLE, DIMENSION(:,:) :: tile_frac
REAL,ALLOCATABLE, DIMENSION(:,:) :: latitude, longitude
LOGICAL,ALLOCATABLE, DIMENSION(:,:) :: l_tile_pts
ENDTYPE um_dimensions

TYPE derived_veg_pars
INTEGER, DIMENSION(:,:), POINTER :: &
ivegt(:,:), & ! vegetation types
isoilm(:,:) ! soil types
REAL, DIMENSION(:,:), POINTER :: &
htveg(:,:), &
laift(:,:) ! hruffmax(:.:)
END TYPE derived_veg_pars

INTERFACE check_nmlvar
MODULE PROCEDURE check_chvar, check_intvar, check_lgvar
END INTERFACE check_nmlvar

TYPE(derived_rad_bands), SAVE :: kblum_rad
TYPE(derived_veg_pars), SAVE :: kblum_veg
TYPE(um_dimensions), SAVE :: um1

REAL,ALLOCATABLE, DIMENSION(:) :: conv_rain_prevstep, conv_snow_prevstep

CONTAINS

!========================================================================
!========================================================================
!========================================================================

SUBROUTINE cable_um_runtime_vars(runtime_vars_file)
USE cable_common_module, ONLY : cable_runtime, cable_user, filename, &
cable_user, knode_gl, redistrb, wiltParam, &
satuParam, l_casacnp, l_laiFeedbk, &
l_vcmaxFeedbk, l_luc, l_thinforest, &
pool_frac, pool_time

USE casavariable, ONLY : casafile
USE casadimension, ONLY : icycle


CHARACTER(LEN=*), INTENT(IN) :: runtime_vars_file
INTEGER :: funit=88

!--- namelist for CABLE runtime vars, files, switches
NAMELIST/CABLE/filename, l_thinforest, l_luc, l_casacnp, l_laiFeedbk, &
l_vcmaxFeedbk, icycle, &
casafile, cable_user, redistrb, wiltParam, satuParam, &
pool_frac, pool_time


!--- assume namelist exists. no iostatus check
OPEN(unit=funit,FILE= runtime_vars_file)
READ(funit,NML=CABLE)
IF( knode_gl==0) THEN
PRINT *, ' '; PRINT *, 'CABLE_log:'
PRINT *, ' Opened file - '
PRINT *, ' ', trim(runtime_vars_file)
PRINT *, ' for reading runtime vars.'
PRINT *, 'End CABLE_log:'; PRINT *, ' '
ENDIF
CLOSE(funit)

if (knode_gl==0) then
print *, ' '; print *, 'CASA_log:'
print *, ' icycle =',icycle
print *, ' l_casacnp =',l_casacnp
print *, ' l_laiFeedbk =',l_laiFeedbk
print *, ' l_vcmaxFeedbk =',l_vcmaxFeedbk
print *, 'End CASA_log:'; print *, ' '
endif
IF (l_casacnp .AND. (icycle == 0 .OR. icycle > 3)) &
STOP 'CASA_log: icycle must be 1 to 3 when using casaCNP'
IF ((.NOT. l_casacnp) .AND. (icycle >= 1)) &
STOP 'CASA_log: icycle must be <=0 when not using casaCNP'
IF ((l_laiFeedbk .OR. l_vcmaxFeedbk) .AND. (.NOT. l_casacnp)) &
STOP 'CASA_log: casaCNP required to get prognostic LAI or Vcmax'
IF (l_vcmaxFeedbk .AND. icycle < 2) &
STOP 'CASA_log: icycle must be 2 to 3 to get prognostic Vcmax'

!--- check value of variable
CALL check_nmlvar('filename%veg', filename%veg)
CALL check_nmlvar('filename%soil', filename%soil)
CALL check_nmlvar('cable_user%DIAG_SOIL_RESP', cable_user%DIAG_SOIL_RESP)
CALL check_nmlvar('cable_user%LEAF_RESPIRATION', &
cable_user%LEAF_RESPIRATION)
CALL check_nmlvar('cable_user%FWSOIL_SWITCH', cable_user%FWSOIL_SWITCH)
CALL check_nmlvar('cable_user%RUN_DIAG_LEVEL', cable_user%RUN_DIAG_LEVEL)
CALL check_nmlvar('cable_user%l_new_roughness_soil', &
cable_user%l_new_roughness_soil)
CALL check_nmlvar('cable_user%l_new_roughness_soil', &
cable_user%l_new_roughness_soil)
CALL check_nmlvar('cable_user%l_new_roughness_soil', &
cable_user%l_new_roughness_soil)

END SUBROUTINE cable_um_runtime_vars

!jhan: also add real, logical, int interfaces
SUBROUTINE check_chvar(this_var, val_var)
USE cable_common_module, ONLY : knode_gl

CHARACTER(LEN=*), INTENT(IN) :: this_var, val_var

IF (knode_gl==0) THEN
PRINT *, ' '; PRINT *, 'CABLE_log:'
PRINT *, ' run time variable - '
PRINT *, ' ', trim(this_var)
PRINT *, ' defined as - '
PRINT *, ' ', trim(val_var)
PRINT *, 'End CABLE_log:'; PRINT *, ' '
ENDIf

END SUBROUTINE check_chvar

SUBROUTINE check_intvar(this_var, val_var)
USE cable_common_module, ONLY : knode_gl

CHARACTER(LEN=*), INTENT(IN) :: this_var
INTEGER, INTENT(IN) :: val_var

IF (knode_gl==0) THEN
PRINT *, ' '; PRINT *, 'CABLE_log:'
PRINT *, ' run time variable - '
PRINT *, ' ', trim(this_var)
PRINT *, ' defined as - '
PRINT *, ' ', val_var
PRINT *, 'End CABLE_log:'; PRINT *, ' '
ENDIF

END SUBROUTINE check_intvar

SUBROUTINE check_lgvar(this_var, val_var)
USE cable_common_module, ONLY : knode_gl

CHARACTER(LEN=*), INTENT(IN) :: this_var
LOGICAL, INTENT(IN) :: val_var

IF (knode_gl==0) THEN
PRINT *, ' '; PRINT *, 'CABLE_log:'
PRINT *, ' run time variable - '
PRINT *, ' ', trim(this_var)
PRINT *, ' defined as - '
PRINT *, ' ', (val_var)
PRINT *, 'End CABLE_log:'; PRINT *, ' '
ENDIf

END SUBROUTINE check_lgvar

!=========================================================================
!=========================================================================
!=========================================================================

SUBROUTINE alloc_um_interface_types( row_length, rows, land_pts, ntiles, &
sm_levels )
USE cable_common_module, ONLY : cable_runtime, cable_user

INTEGER,INTENT(IN) :: row_length, rows, land_pts, ntiles, sm_levels

ALLOCATE( um1%land_index(land_pts) )
ALLOCATE( um1%tile_pts(ntiles) )
ALLOCATE( um1%tile_frac(land_pts, ntiles) )
ALLOCATE( um1%tile_index(land_pts, ntiles) )
ALLOCATE( um1%latitude(row_length, rows) )
ALLOCATE( um1%longitude(row_length, rows) )
ALLOCATE( um1%l_tile_pts(land_pts, ntiles) )
!-------------------------------------------------------
ALLOCATE( kblum_rad%sw_down_dir(row_length,rows) )
ALLOCATE( kblum_rad%sw_down_dif(row_length,rows) )
ALLOCATE( kblum_rad%sw_down_vis(row_length,rows) )
ALLOCATE( kblum_rad%sw_down_nir(row_length,rows) )
ALLOCATE( kblum_rad%fbeam(row_length,rows,3) )
ALLOCATE( kblum_veg%htveg(land_pts,ntiles) )
ALLOCATE( kblum_veg%laift(land_pts,ntiles) )
ALLOCATE( kblum_veg%ivegt(land_pts,ntiles) )
ALLOCATE( kblum_veg%isoilm(land_pts,ntiles) )

END SUBROUTINE alloc_um_interface_types

!========================================================================
!========================================================================
!========================================================================

END MODULE cable_um_tech_mod





6 changes: 2 additions & 4 deletions src/coupled/esm16/casa_um_inout.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -373,7 +373,8 @@ SUBROUTINE casa_reinit_pk(casabiome,casamet,casapool,casabal,veg,phen, &
USE casaparm
USE casavariable
USE phenvariable
USE cable_common_module, ONLY : ktau_gl, l_thinforest
USE cable_common_module, ONLY : ktau_gl, l_thinforest, pool_frac, pool_time


USE cable_um_tech_mod, ONLY : um1

Expand Down Expand Up @@ -431,9 +432,6 @@ SUBROUTINE casa_reinit_pk(casabiome,casamet,casapool,casabal,veg,phen, &
REAL(r_2) :: woodhvest_c(um1%land_pts,um1%ntiles,3),woodhvest_n(um1%land_pts,um1%ntiles,3),woodhvest_p(um1%land_pts,um1%ntiles,3)
REAL(r_2) :: wresp_c(um1%land_pts,um1%ntiles,3),wresp_n(um1%land_pts,um1%ntiles,3),wresp_p(um1%land_pts,um1%ntiles,3)
REAL(r_2) :: thinning(um1%land_pts,um1%ntiles)
!REAL(r_2), DIMENSION(3) :: pool_frac, pool_time
REAL,PARAMETER:: POOL_FRAC(3) =(/0.33, 0.33, 0.34/)
REAL,PARAMETER:: POOL_TIME(3) =(/1.00, 0.10, 0.01/)
REAL(r_2) :: cplant_z(um1%land_pts,um1%ntiles,mplant) ! Plant carbon pools after thinning.
REAL(r_2) :: nplant_z(um1%land_pts,um1%ntiles,mplant) ! Plant nitrogen pools after thinning.
REAL(r_2) :: pplant_z(um1%land_pts,um1%ntiles,mplant) ! Plant phosphorus pools after thinning.
Expand Down
9 changes: 7 additions & 2 deletions src/util/cable_common.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,8 +46,13 @@ MODULE cable_common_module
!---Lestevens Sept2012
!---CASACNP switches and cycle index
LOGICAL, SAVE :: l_casacnp,l_laiFeedbk,l_vcmaxFeedbk
LOGICAL :: l_luc = .FALSE.
LOGICAL :: l_thinforest = .FALSE.
LOGICAL :: l_luc = .FALSE.
LOGICAL :: l_thinforest = .FALSE.
!! Fraction of harvested biomass allocated to the wood products pools
REAL :: pool_frac(3) = (/0.33,0.33,0.34/)
!! Timescale of wood product pool decay to the atmosphere (year^-1)
REAL :: pool_time(3) = (/1.00,0.10,0.01/)

LOGICAL :: l_landuse = .FALSE.

!---CABLE runtime switches def in this type
Expand Down