diff --git a/src/coupled/esm16/cable_um_tech.F90 b/src/coupled/esm16/cable_um_tech.F90 new file mode 100644 index 000000000..ebe559bb2 --- /dev/null +++ b/src/coupled/esm16/cable_um_tech.F90 @@ -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 + + + + + diff --git a/src/coupled/esm16/casa_um_inout.F90 b/src/coupled/esm16/casa_um_inout.F90 index dbafa021b..9839db2a3 100644 --- a/src/coupled/esm16/casa_um_inout.F90 +++ b/src/coupled/esm16/casa_um_inout.F90 @@ -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 @@ -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. diff --git a/src/util/cable_common.F90 b/src/util/cable_common.F90 index 33e4af2c3..60a120bcc 100644 --- a/src/util/cable_common.F90 +++ b/src/util/cable_common.F90 @@ -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