! radiation_cloud.F90 - Derived type to store cloud/precip properties ! (C) Copyright 2014- ECMWF. ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int ! Modifications ! 2019-01-14 R. Hogan Added inv_inhom_effective_size variable ! 2019-01-14 R. Hogan Added out_of_physical_bounds routine ! 2019-06-14 R. Hogan Added capability to store any number of cloud/precip types module radiation_cloud use parkind1, only : jprb implicit none public !--------------------------------------------------------------------- ! The intention is that all variables describing clouds and ! radiatively-active precipitation are contained in this derived ! type, and if cloud variables are to be added in future, they can ! be added to this type without requiring extra variables to be ! passed between subroutines elsewhere in the program. type cloud_type ! For maximum flexibility, an arbitrary number "ntype" of ! hydrometeor types can be stored, dimensioned (ncol,nlev,ntype) integer :: ntype = 0 real(jprb), allocatable, dimension(:,:,:) :: & & mixing_ratio, & ! mass mixing ratio (kg/kg) & effective_radius ! (m) ! For backwards compatibility, we also allow for the two ! traditional cloud types, liquid cloud droplets and ice cloud ! particles, dimensioned (ncol,nlev) real(jprb), pointer, dimension(:,:) :: & & q_liq, q_ice, & ! mass mixing ratio (kg/kg) & re_liq, re_ice ! effective radius (m) ! For the moment, the different types of hydrometeor are assumed ! to be mixed with each other, so there is just one cloud fraction ! variable varying from 0 to 1 real(jprb), allocatable, dimension(:,:) :: fraction ! The fractional standard deviation of cloud optical depth in the ! cloudy part of the gridbox. In the Tripleclouds representation ! of cloud inhomogeneity, this is implemented by splitting the ! cloudy part of the gridbox into two equal-area regions, one ! with the cloud optical depth scaled by 1+fractional_std and the ! other scaled by 1-fractional_std. This variable is dimensioned ! (ncol,nlev) real(jprb), allocatable, dimension(:,:) :: fractional_std ! The inverse of the effective horizontal size of the clouds in ! the gridbox, used to compute the cloud edge length per unit ! gridbox area for use in representing 3D effects. This variable ! is dimensioned (ncol,nlev). real(jprb), allocatable, dimension(:,:) :: inv_cloud_effective_size ! m-1 ! Similarly for the in-cloud heterogeneities, used to compute the ! edge length between the optically thin and thick cloudy regions ! of the gridbox. real(jprb), allocatable, dimension(:,:) :: inv_inhom_effective_size ! m-1 ! The following variable describes the overlap of cloud boundaries ! in adjacent layers, with dimensions (ncol,nlev-1): 1 corresponds ! to maximum overlap and 0 to random overlap. Depending on the ! ecRad configuration, it may be the "alpha" overlap parameter of ! Hogan and Illingworth (2000) or the "beta" overlap parameter of ! Shonk et al. (2010). real(jprb), allocatable, dimension(:,:) :: overlap_param contains procedure :: allocate => allocate_cloud_arrays procedure :: deallocate => deallocate_cloud_arrays procedure :: set_overlap_param_fix procedure :: set_overlap_param_var generic :: set_overlap_param => set_overlap_param_fix, set_overlap_param_var procedure :: set_overlap_param_var2D procedure :: set_overlap_param_approx procedure :: create_fractional_std procedure :: create_inv_cloud_effective_size procedure :: create_inv_cloud_effective_size_eta procedure :: param_cloud_effective_separation_eta procedure :: crop_cloud_fraction procedure :: out_of_physical_bounds end type cloud_type contains !--------------------------------------------------------------------- ! Allocate arrays for describing clouds and precipitation, although ! in the offline code these are allocated when they are read from ! the NetCDF file subroutine allocate_cloud_arrays(this, ncol, nlev, ntype, use_inhom_effective_size) use yomhook, only : lhook, dr_hook, jphook class(cloud_type), intent(inout), target :: this integer, intent(in) :: ncol ! Number of columns integer, intent(in) :: nlev ! Number of levels ! Number of cloud/precip particle types. If not present then the ! older cloud behaviour is assumed: two types are present, (1) ! liquid and (2) ice, and they can be accessed via q_liq, q_ice, ! re_liq and re_ice. integer, intent(in), optional :: ntype logical, intent(in), optional :: use_inhom_effective_size real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:allocate',0,hook_handle) if (present(ntype)) then this%ntype = ntype else this%ntype = 2 end if allocate(this%mixing_ratio(ncol,nlev,this%ntype)) allocate(this%effective_radius(ncol,nlev,this%ntype)) nullify(this%q_liq) nullify(this%q_ice) nullify(this%re_liq) nullify(this%re_ice) if (.not. present(ntype)) then ! Older interface in which only liquid and ice are supported this%q_liq => this%mixing_ratio(:,:,1) this%q_ice => this%mixing_ratio(:,:,2) this%re_liq => this%effective_radius(:,:,1) this%re_ice => this%effective_radius(:,:,2) end if allocate(this%fraction(ncol,nlev)) allocate(this%overlap_param(ncol,nlev-1)) allocate(this%fractional_std(ncol,nlev)) allocate(this%inv_cloud_effective_size(ncol,nlev)) if (present(use_inhom_effective_size)) then if (use_inhom_effective_size) then allocate(this%inv_inhom_effective_size(ncol,nlev)) end if end if if (lhook) call dr_hook('radiation_cloud:allocate',1,hook_handle) end subroutine allocate_cloud_arrays !--------------------------------------------------------------------- ! Deallocate arrays subroutine deallocate_cloud_arrays(this) use yomhook, only : lhook, dr_hook, jphook class(cloud_type), intent(inout) :: this real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:deallocate',0,hook_handle) nullify(this%q_liq) nullify(this%q_ice) nullify(this%re_liq) nullify(this%re_ice) if (allocated(this%mixing_ratio)) deallocate(this%mixing_ratio) if (allocated(this%effective_radius)) deallocate(this%effective_radius) if (allocated(this%fraction)) deallocate(this%fraction) if (allocated(this%overlap_param)) deallocate(this%overlap_param) if (allocated(this%fractional_std)) deallocate(this%fractional_std) if (allocated(this%inv_cloud_effective_size)) & & deallocate(this%inv_cloud_effective_size) if (allocated(this%inv_inhom_effective_size)) & & deallocate(this%inv_inhom_effective_size) if (lhook) call dr_hook('radiation_cloud:deallocate',1,hook_handle) end subroutine deallocate_cloud_arrays !--------------------------------------------------------------------- ! Compute and store the overlap parameter from the provided overlap ! decorrelation length (in metres). If istartcol and/or iendcol are ! provided then only columns in this range are computed. If the ! overlap_param array has not been allocated then it will be ! allocated to be of the correct size relative to the pressure ! field. This version assumes a fixed decorrelation_length for all ! columns. subroutine set_overlap_param_fix(this, thermodynamics, decorrelation_length, & & istartcol, iendcol) use yomhook, only : lhook, dr_hook, jphook use radiation_thermodynamics, only : thermodynamics_type use radiation_constants, only : GasConstantDryAir, AccelDueToGravity class(cloud_type), intent(inout) :: this type(thermodynamics_type), intent(in) :: thermodynamics real(jprb), intent(in) :: decorrelation_length ! m integer, optional, intent(in) :: istartcol, iendcol ! Ratio of gas constant for dry air to acceleration due to gravity real(jprb), parameter :: R_over_g = GasConstantDryAir / AccelDueToGravity ! Process only columns i1 to i2, which will be istartcol to ! iendcol if they were provided integer :: i1, i2 integer :: ncol, nlev integer :: jcol, jlev real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:set_overlap_param_fix',0,hook_handle) ! Pressure at half-levels, pressure_hl, is defined at nlev+1 ! points ncol = size(thermodynamics%pressure_hl,dim=1) nlev = size(thermodynamics%pressure_hl,dim=2)-1 if (present(istartcol)) then i1 = istartcol else i1 = 1 end if if (present(iendcol)) then i2 = iendcol else i2 = ncol end if if (.not. allocated(this%overlap_param)) then ! If pressure is of size (ncol,nlev+1) then overlap_param is of ! size (ncol,nlev-1), since overlap parameter is only defined here ! for interfaces between model layers, not for the interface to ! space or the surface allocate(this%overlap_param(ncol, nlev-1)) end if if (thermodynamics%pressure_hl(i1,2) > thermodynamics%pressure_hl(i1,1)) then ! Pressure is increasing with index (order of layers is ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we ! don't take the logarithm of the first pressure in each column. DO jcol = i1,i2 this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length) & & * thermodynamics%temperature_hl(jcol,2) & & *log(thermodynamics%pressure_hl(jcol,3) & & /thermodynamics%pressure_hl(jcol,2))) end do DO jlev = 2,nlev-1 DO jcol = i1,i2 this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) & & * thermodynamics%temperature_hl(jcol,jlev+1) & & *log(thermodynamics%pressure_hl(jcol,jlev+2) & & /thermodynamics%pressure_hl(jcol,jlev))) end do end do else ! Pressure is decreasing with index (order of layers is surface ! to top-of-atmosphere). In case pressure_hl(:,nlev+1)=0, we ! don't take the logarithm of the last pressure in each column. DO jlev = 1,nlev-2 DO jcol = i1,i2 this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) & & * thermodynamics%temperature_hl(jcol,jlev+1) & & *log(thermodynamics%pressure_hl(jcol,jlev) & & /thermodynamics%pressure_hl(jcol,jlev+2))) end do end do DO jcol = i1,i2 this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length) & & * thermodynamics%temperature_hl(jcol,nlev) & & *log(thermodynamics%pressure_hl(jcol,nlev-1) & & /thermodynamics%pressure_hl(jcol,nlev))) end do end if if (lhook) call dr_hook('radiation_cloud:set_overlap_param_fix',1,hook_handle) end subroutine set_overlap_param_fix !--------------------------------------------------------------------- ! Compute and store the overlap parameter from the provided overlap ! decorrelation length (in metres), which may vary with column. Only ! columns from istartcol to iendcol are computed. If the ! overlap_param array has not been allocated then it will be ! allocated to be of the correct size relative to the pressure ! field. subroutine set_overlap_param_var(this, thermodynamics, decorrelation_length, & & istartcol, iendcol) use yomhook, only : lhook, dr_hook, jphook use radiation_thermodynamics, only : thermodynamics_type use radiation_constants, only : GasConstantDryAir, AccelDueToGravity class(cloud_type), intent(inout) :: this type(thermodynamics_type), intent(in) :: thermodynamics integer, intent(in) :: istartcol, iendcol real(jprb), intent(in) :: decorrelation_length(istartcol:iendcol) ! m ! Ratio of gas constant for dry air to acceleration due to gravity real(jprb), parameter :: R_over_g = GasConstantDryAir / AccelDueToGravity integer :: ncol, nlev integer :: jcol, jlev real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:set_overlap_param_var',0,hook_handle) ! Pressure at half-levels, pressure_hl, is defined at nlev+1 ! points ncol = size(thermodynamics%pressure_hl,dim=1) nlev = size(thermodynamics%pressure_hl,dim=2)-1 if (.not. allocated(this%overlap_param)) then ! If pressure is of size (ncol,nlev+1) then overlap_param is of ! size (ncol,nlev-1), since overlap parameter is only defined here ! for interfaces between model layers, not for the interface to ! space or the surface allocate(this%overlap_param(ncol, nlev-1)) end if if (thermodynamics%pressure_hl(istartcol,2) > thermodynamics%pressure_hl(istartcol,1)) then ! Pressure is increasing with index (order of layers is ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we ! don't take the logarithm of the first pressure in each column. DO jcol = istartcol,iendcol this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length(jcol)) & & * thermodynamics%temperature_hl(jcol,2) & & *log(thermodynamics%pressure_hl(jcol,3) & & /thermodynamics%pressure_hl(jcol,2))) end do DO jlev = 2,nlev-1 DO jcol = istartcol,iendcol this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol)) & & * thermodynamics%temperature_hl(jcol,jlev+1) & & *log(thermodynamics%pressure_hl(jcol,jlev+2) & & /thermodynamics%pressure_hl(jcol,jlev))) end do end do else ! Pressure is decreasing with index (order of layers is surface ! to top-of-atmosphere). In case pressure_hl(:,nlev+1)=0, we ! don't take the logarithm of the last pressure in each column. DO jlev = 1,nlev-2 DO jcol = istartcol,iendcol this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol)) & & * thermodynamics%temperature_hl(jcol,jlev+1) & & *log(thermodynamics%pressure_hl(jcol,jlev) & & /thermodynamics%pressure_hl(jcol,jlev+2))) end do end do DO jcol = istartcol,iendcol this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length(jcol)) & & * thermodynamics%temperature_hl(jcol,nlev) & & *log(thermodynamics%pressure_hl(jcol,nlev-1) & & /thermodynamics%pressure_hl(jcol,nlev))) end do end if if (lhook) call dr_hook('radiation_cloud:set_overlap_param_var',1,hook_handle) end subroutine set_overlap_param_var ! AI 04 2024 variation de la longueur Ld en fonction de la verticale subroutine set_overlap_param_var2D(this, thermodynamics, decorrelation_length, & & klev, istartcol, iendcol) use yomhook, only : lhook, dr_hook, jphook use radiation_thermodynamics, only : thermodynamics_type use radiation_constants, only : GasConstantDryAir, AccelDueToGravity integer, intent(in) :: klev class(cloud_type), intent(inout) :: this type(thermodynamics_type), intent(in) :: thermodynamics integer, intent(in) :: istartcol, iendcol real(jprb), intent(in) :: decorrelation_length(istartcol:iendcol,klev) ! m ! Ratio of gas constant for dry air to acceleration due to gravity real(jprb), parameter :: R_over_g = GasConstantDryAir / AccelDueToGravity integer :: ncol, nlev integer :: jcol, jlev real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:set_overlap_param_var',0,hook_handle) ! Pressure at half-levels, pressure_hl, is defined at nlev+1 ! points ncol = size(thermodynamics%pressure_hl,dim=1) nlev = size(thermodynamics%pressure_hl,dim=2)-1 if (.not. allocated(this%overlap_param)) then ! If pressure is of size (ncol,nlev+1) then overlap_param is of ! size (ncol,nlev-1), since overlap parameter is only defined here ! for interfaces between model layers, not for the interface to ! space or the surface allocate(this%overlap_param(ncol, nlev-1)) end if if (thermodynamics%pressure_hl(istartcol,2) > thermodynamics%pressure_hl(istartcol,1)) then ! Pressure is increasing with index (order of layers is ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we ! don't take the logarithm of the first pressure in each column. DO jcol = istartcol,iendcol this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length(jcol,1)) & & * thermodynamics%temperature_hl(jcol,2) & & *log(thermodynamics%pressure_hl(jcol,3) & & /thermodynamics%pressure_hl(jcol,2))) end do DO jlev = 2,nlev-1 DO jcol = istartcol,iendcol this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol,jlev)) & & * thermodynamics%temperature_hl(jcol,jlev+1) & & *log(thermodynamics%pressure_hl(jcol,jlev+2) & & /thermodynamics%pressure_hl(jcol,jlev))) end do end do else ! Pressure is decreasing with index (order of layers is surface ! to top-of-atmosphere). In case pressure_hl(:,nlev+1)=0, we ! don't take the logarithm of the last pressure in each column. DO jlev = 1,nlev-2 DO jcol = istartcol,iendcol this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol,jlev)) & & * thermodynamics%temperature_hl(jcol,jlev+1) & & *log(thermodynamics%pressure_hl(jcol,jlev) & & /thermodynamics%pressure_hl(jcol,jlev+2))) end do end do DO jcol = istartcol,iendcol ! AI ATTENTION a verifier decorrelation_length(jcol,nlev-1) ou nlev this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length(jcol,nlev-1)) & & * thermodynamics%temperature_hl(jcol,nlev) & & *log(thermodynamics%pressure_hl(jcol,nlev-1) & & /thermodynamics%pressure_hl(jcol,nlev))) end do end if if (lhook) call dr_hook('radiation_cloud:set_overlap_param_var',1,hook_handle) end subroutine set_overlap_param_var2D !--------------------------------------------------------------------- ! Compute and store the overlap parameter from the provided overlap ! decorrelation length (in metres). If istartcol and/or iendcol are ! provided then only columns in this range are computed. If the ! overlap_param array has not been allocated then it will be ! allocated to be of the correct size relative to the pressure ! field. This is the APPROXIMATE method as it assumes a fixed ! atmospheric scale height, which leads to differences particularly ! in low cloud. subroutine set_overlap_param_approx(this, thermodynamics, decorrelation_length, & & istartcol, iendcol) use yomhook, only : lhook, dr_hook, jphook use radiation_thermodynamics, only : thermodynamics_type class(cloud_type), intent(inout) :: this type(thermodynamics_type), intent(in) :: thermodynamics real(jprb), intent(in) :: decorrelation_length ! m integer, optional, intent(in) :: istartcol, iendcol ! To convert decorrelation length (m) to overlap parameter between ! layers, we need an estimate for the thickness of the layer. This ! is found using the pressure difference between the edges of the ! layer, along with the approximate scale height of the atmosphere ! (m) given here: real(jprb), parameter :: scale_height = 8000.0_jprb ! Process only columns i1 to i2, which will be istartcol to ! iendcol if they were provided integer :: i1, i2 integer :: ncol, nlev real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:set_overlap_param_approx',0,hook_handle) ! Pressure at half-levels, pressure_hl, is defined at nlev+1 ! points ncol = size(thermodynamics%pressure_hl,dim=1) nlev = size(thermodynamics%pressure_hl,dim=2)-1 if (present(istartcol)) then i1 = istartcol else i1 = 1 end if if (present(iendcol)) then i2 = iendcol else i2 = ncol end if if (.not. allocated(this%overlap_param)) then ! If pressure is of size (ncol,nlev+1) then overlap_param is of ! size (ncol,nlev-1), since overlap parameter is only defined here ! for interfaces between model layers, not for the interface to ! space or the surface allocate(this%overlap_param(ncol, nlev-1)) end if if (thermodynamics%pressure_hl(i1,2) > thermodynamics%pressure_hl(i1,1)) then ! Pressure is increasing with index (order of layers is ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we ! don't take the logarithm of the first pressure in each ! column. this%overlap_param(i1:i2,:) = exp(-(scale_height/decorrelation_length) & & * ( log(thermodynamics%pressure_hl(i1:i2,3:nlev+1) & & /thermodynamics%pressure_hl(i1:i2,2:nlev )) ) ) else ! Pressure is decreasing with index (order of layers is surface ! to top-of-atmosphere). In case pressure_hl(:,nlev+1)=0, we ! don't take the logarithm of the last pressure in each column. this%overlap_param(i1:i2,:) = exp(-(scale_height/decorrelation_length) & & * ( log(thermodynamics%pressure_hl(i1:i2,1:nlev-1) & & /thermodynamics%pressure_hl(i1:i2,2:nlev )) ) ) end if if (lhook) call dr_hook('radiation_cloud:set_overlap_param_approx',1,hook_handle) end subroutine set_overlap_param_approx !--------------------------------------------------------------------- ! Create a matrix of constant fractional standard deviations ! (dimensionless) subroutine create_fractional_std(this, ncol, nlev, frac_std) use yomhook, only : lhook, dr_hook, jphook class(cloud_type), intent(inout) :: this integer, intent(in) :: ncol, nlev real(jprb), intent(in) :: frac_std real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:create_fractional_std',0,hook_handle) if (allocated(this%fractional_std)) then deallocate(this%fractional_std) end if allocate(this%fractional_std(ncol, nlev)) this%fractional_std = frac_std if (lhook) call dr_hook('radiation_cloud:create_fractional_std',1,hook_handle) end subroutine create_fractional_std !--------------------------------------------------------------------- ! Create a matrix of constant inverse cloud effective size (m-1) subroutine create_inv_cloud_effective_size(this, ncol, nlev, inv_eff_size) use yomhook, only : lhook, dr_hook, jphook class(cloud_type), intent(inout) :: this integer, intent(in) :: ncol, nlev real(jprb), intent(in) :: inv_eff_size real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:create_inv_cloud_effective_size',0,hook_handle) if (allocated(this%inv_cloud_effective_size)) then deallocate(this%inv_cloud_effective_size) end if allocate(this%inv_cloud_effective_size(ncol, nlev)) this%inv_cloud_effective_size = inv_eff_size if (lhook) call dr_hook('radiation_cloud:create_inv_cloud_effective_size',1,hook_handle) end subroutine create_inv_cloud_effective_size !--------------------------------------------------------------------- ! Create a matrix of inverse cloud effective size (m-1) according to ! the value of eta (=pressure divided by surface pressure) subroutine create_inv_cloud_effective_size_eta(this, ncol, nlev, & & pressure_hl, inv_eff_size_low, inv_eff_size_mid, inv_eff_size_high, & & eta_low_mid, eta_mid_high, istartcol, iendcol) use yomhook, only : lhook, dr_hook, jphook class(cloud_type), intent(inout) :: this integer, intent(in) :: ncol, nlev ! Pressure on half levels (Pa) real(jprb), intent(in) :: pressure_hl(:,:) ! Inverse effective size for low, mid and high cloud (m-1) real(jprb), intent(in) :: inv_eff_size_low real(jprb), intent(in) :: inv_eff_size_mid real(jprb), intent(in) :: inv_eff_size_high ! Eta values at low-mid and mid-high interfaces real(jprb), intent(in) :: eta_low_mid, eta_mid_high integer, optional, intent(in) :: istartcol, iendcol ! Ratio of layer midpoint pressure to surface pressure real(jprb) :: eta(nlev) ! Indices of column, level and surface half-level integer :: jcol, isurf ! Local values of istartcol, iendcol integer :: i1, i2 real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:create_inv_cloud_effective_size_eta',0,hook_handle) if (allocated(this%inv_cloud_effective_size)) then deallocate(this%inv_cloud_effective_size) end if allocate(this%inv_cloud_effective_size(ncol, nlev)) if (present(istartcol)) then i1 = istartcol else i1 = 1 end if if (present(iendcol)) then i2 = iendcol else i2 = ncol end if ! Locate the surface half-level if (pressure_hl(1,1) > pressure_hl(1,2)) then isurf = 1 else isurf = nlev+1 end if DO jcol = i1,i2 eta = (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)) & & * (0.5_jprb / pressure_hl(jcol,isurf)) where (eta > eta_low_mid) this%inv_cloud_effective_size(jcol,:) = inv_eff_size_low elsewhere (eta > eta_mid_high) this%inv_cloud_effective_size(jcol,:) = inv_eff_size_mid elsewhere this%inv_cloud_effective_size(jcol,:) = inv_eff_size_high end where end do if (lhook) call dr_hook('radiation_cloud:create_inv_cloud_effective_size_eta',1,hook_handle) end subroutine create_inv_cloud_effective_size_eta !--------------------------------------------------------------------- ! Create a matrix of inverse cloud and inhomogeneity effective size ! (m-1) parameterized according to the value of eta (=pressure ! divided by surface pressure): effective_separation = ! coeff_a + coeff_b*exp(-(eta**power)). subroutine param_cloud_effective_separation_eta(this, ncol, nlev, & & pressure_hl, separation_surf, separation_toa, power, & & inhom_separation_factor, istartcol, iendcol) use yomhook, only : lhook, dr_hook, jphook class(cloud_type), intent(inout) :: this integer, intent(in) :: ncol, nlev ! Pressure on half levels (Pa) real(jprb), intent(in) :: pressure_hl(:,:) ! Separation distances at surface and top-of-atmosphere, and power ! on eta real(jprb), intent(in) :: separation_surf ! m real(jprb), intent(in) :: separation_toa ! m real(jprb), intent(in) :: power real(jprb), optional, intent(in) :: inhom_separation_factor integer, optional, intent(in) :: istartcol, iendcol ! Ratio of layer midpoint pressure to surface pressure real(jprb) :: eta(nlev) ! Effective cloud separation (m) real(jprb) :: eff_separation(nlev) ! Coefficients used to compute effective separation distance real(jprb) :: coeff_e, coeff_a, coeff_b, inhom_sep_factor ! Indices of column, level and surface half-level integer :: jcol, isurf ! Local values of istartcol, iendcol integer :: i1, i2 real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:param_cloud_effective_separation_eta',0,hook_handle) if (present(inhom_separation_factor)) then inhom_sep_factor = inhom_separation_factor else inhom_sep_factor = 1.0_jprb end if coeff_e = 1.0_jprb - exp(-1.0_jprb) coeff_b = (separation_toa - separation_surf) / coeff_e coeff_a = separation_toa - coeff_b if (allocated(this%inv_cloud_effective_size)) then deallocate(this%inv_cloud_effective_size) end if if (allocated(this%inv_inhom_effective_size)) then deallocate(this%inv_inhom_effective_size) end if allocate(this%inv_cloud_effective_size(ncol, nlev)) allocate(this%inv_inhom_effective_size(ncol, nlev)) if (present(istartcol)) then i1 = istartcol else i1 = 1 end if if (present(iendcol)) then i2 = iendcol else i2 = ncol end if ! Locate the surface half-level if (pressure_hl(1,1) > pressure_hl(1,2)) then isurf = 1 else isurf = nlev+1 end if DO jcol = i1,i2 eta = (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)) & & * (0.5_jprb / pressure_hl(jcol,isurf)) eff_separation = coeff_a + coeff_b * exp(-eta**power) this%inv_cloud_effective_size(jcol,:) = 1.0_jprb / (eff_separation & & * sqrt(max(1.0e-5_jprb,this%fraction(jcol,:)*(1.0_jprb-this%fraction(jcol,:))))) this%inv_inhom_effective_size(jcol,:) = 1.0_jprb / (eff_separation * inhom_sep_factor & & * sqrt(max(1.0e-5_jprb,0.5_jprb*this%fraction(jcol,:)*(1.0_jprb-0.5_jprb*this%fraction(jcol,:))))) end do if (lhook) call dr_hook('radiation_cloud:param_cloud_effective_separation_eta',1,hook_handle) end subroutine param_cloud_effective_separation_eta !--------------------------------------------------------------------- ! Remove "ghost" clouds: those with a cloud fraction that is too ! small to treat sensibly (e.g. because it implies that the ! "in-cloud" water content is too high), or with a cloud water ! content that is too small. We do this in one place to ensure that ! all subsequent subroutines can assume that if cloud_fraction > 0.0 ! then cloud is really present and should be treated. subroutine crop_cloud_fraction(this, istartcol, iendcol, & & cloud_fraction_threshold, cloud_mixing_ratio_threshold) use yomhook, only : lhook, dr_hook, jphook class(cloud_type), intent(inout) :: this integer, intent(in) :: istartcol, iendcol integer :: nlev, ntype integer :: jcol, jlev, jh real(jprb) :: cloud_fraction_threshold, cloud_mixing_ratio_threshold real(jprb) :: sum_mixing_ratio(istartcol:iendcol) real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:crop_cloud_fraction',0,hook_handle) nlev = size(this%fraction,2) ntype = size(this%mixing_ratio,3) DO jlev = 1,nlev DO jcol = istartcol,iendcol sum_mixing_ratio(jcol) = 0.0_jprb end do DO jh = 1, ntype DO jcol = istartcol,iendcol sum_mixing_ratio(jcol) = sum_mixing_ratio(jcol) + this%mixing_ratio(jcol,jlev,jh) end do end do DO jcol = istartcol,iendcol if (this%fraction(jcol,jlev) < cloud_fraction_threshold & & .or. sum_mixing_ratio(jcol) < cloud_mixing_ratio_threshold) then this%fraction(jcol,jlev) = 0.0_jprb end if end do end do if (lhook) call dr_hook('radiation_cloud:crop_cloud_fraction',1,hook_handle) end subroutine crop_cloud_fraction !--------------------------------------------------------------------- ! Return .true. if variables are out of a physically sensible range, ! optionally only considering columns between istartcol and iendcol function out_of_physical_bounds(this, istartcol, iendcol, do_fix) result(is_bad) use yomhook, only : lhook, dr_hook, jphook use radiation_check, only : out_of_bounds_2d, out_of_bounds_3d class(cloud_type), intent(inout) :: this integer, optional,intent(in) :: istartcol, iendcol logical, optional,intent(in) :: do_fix logical :: is_bad logical :: do_fix_local real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud:out_of_physical_bounds',0,hook_handle) if (present(do_fix)) then do_fix_local = do_fix else do_fix_local = .false. end if is_bad = out_of_bounds_3d(this%mixing_ratio, 'cloud%mixing_ratio', 0.0_jprb, 1.0_jprb, & & do_fix_local, i1=istartcol, i2=iendcol) & & .or. out_of_bounds_3d(this%effective_radius, 'cloud%effective_radius', 0.0_jprb, 0.1_jprb, & & do_fix_local, i1=istartcol, i2=iendcol) & & .or. out_of_bounds_2d(this%fraction, 'cloud%fraction', 0.0_jprb, 1.0_jprb, & & do_fix_local, i1=istartcol, i2=iendcol) & & .or. out_of_bounds_2d(this%fractional_std, 'fractional_std', 0.0_jprb, 10.0_jprb, & & do_fix_local, i1=istartcol, i2=iendcol) & & .or. out_of_bounds_2d(this%inv_cloud_effective_size, 'inv_cloud_effective_size', & & 0.0_jprb, 1.0_jprb, do_fix_local, i1=istartcol, i2=iendcol) & & .or. out_of_bounds_2d(this%inv_inhom_effective_size, 'inv_inhom_effective_size', & & 0.0_jprb, 1.0_jprb, do_fix_local, i1=istartcol, i2=iendcol) & & .or. out_of_bounds_2d(this%overlap_param, 'overlap_param', -0.5_jprb, 1.0_jprb, & & do_fix_local, i1=istartcol, i2=iendcol) if (lhook) call dr_hook('radiation_cloud:out_of_physical_bounds',1,hook_handle) end function out_of_physical_bounds end module radiation_cloud