MODULE MP2M_MICROPHYSICS !============================================================================ ! ! Purpose ! ------- ! Interface to main microphysics subroutine. ! The interface computes all aerosols microphysics processes in a single call. ! ! The module contains two methods: ! - mm_muphys ! - mm_diagnostics ! ! Authors ! ------- ! B. de Batz de Trenquelléon, J. Burgalat (11/2024) ! !============================================================================ USE MP2M_MPREC USE MP2M_GLOBALS USE MP2M_HAZE USE MP2M_CLOUDS USE MP2M_METHODS USE MP2M_CLOUDS_METHODS IMPLICIT NONE PUBLIC :: mm_muphys, mm_diagnostics !! Interface to main microphysics subroutine: !! Computes either all the microphysics processes [[muphys_all]] !! or only aerosols microphysics [[muphys_nocld]] in a single call. INTERFACE mm_muphys MODULE PROCEDURE muphys_all,muphys_nocld END INTERFACE mm_muphys CONTAINS FUNCTION muphys_all(m3as_prod,dm0as,dm3as,dm0af,dm3af,dm0ccn,dm3ccn,dm3ices,dmugases,dtlc) RESULT(ret) !! Compute the evolution of moments tracers through haze microphysics processes. !! !! This method computes the evolution of all the microphysics tracers, given under the form !! of moments during a time step. !! !! The method requires that global variables of the model (i.e. variables declared in mm_globals !! module) are initialized/updated correctly (see mm_global_init, mm_column_init, and mm_aerosols_init). !! !! The tendencies returned by the method are defined on the vertical __layers__ of the model from the __GROUND__ to !! the __TOP__ of the atmosphere. They should be added to the input variables used in the initialization methods !! before the latter are called to initialize a new step. !! ! Production of the 3rd order moment of the spherical mode distribution (m3.m-2). REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: m3as_prod ! Tendency of the 0th order moment of the spherical mode distribution (m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm0as ! Tendency of the 3rd order moment of the spherical mode distribution (m3.m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm3as ! Tendency of the 0th order moment of the fractal mode distribution (m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm0af ! Tendency of the 3rd order moment of the fractal mode distribution (m3.m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm3af ! Tendency of the 0th order moment of the CCN distribution (m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm0ccn ! Tendency of the 3rd order moment of the CCN distribution (m3.m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm3ccn ! Tendency of the 3rd order moment of each ice components (m3.m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:,:) :: dm3ices ! Tendencies of each condensible gaz species (mol.mol-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:,:) :: dmugases ! Latent heat of condensation (J.kg-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dtlc ! .true. on succes (i.e. model has been initialized at least once previously), .false. otherwise. LOGICAL :: ret ! Local variables: !~~~~~~~~~~~~~~~~~ INTEGER :: i ! Production of the spherical aerosols (m3.m-3). REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: m3a_s_prod ! Tendencies related to haze model (X/m3). REAL(kind=mm_wp), DIMENSION(SIZE(dm0as)) :: Hdm0as,Hdm3as,Hdm0af,Hdm3af ! Tendencies related to cloud model (X/m3). REAL(kind=mm_wp), DIMENSION(SIZE(dm0as)) :: Cdm0as,Cdm3as,Cdm0af,Cdm3af ALLOCATE(m3a_s_prod(mm_nla)) ! Sanity check for initialization: !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ret = (mm_ini_col.AND.mm_ini_aer) if (.NOT.ret) then return endif if (mm_call_clouds.AND.mm_debug) then write(*,'(a)') "[MM_DEBUG - muphys_nocld] Clouds microphysics enabled but will not be computed... (wrong interface)" endif ! Reverse vectors so they go from top to ground ! @note: mm_dzlev is already from top to ground m3a_s_prod = m3as_prod(mm_nla:1:-1) / mm_dzlev(:) ! Initialize latent heat dtlc(:) = 0._mm_wp ! Calls haze microphysics (/!\ tendencies in X/m-3): !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ call mm_haze_microphysics(m3a_s_prod,Hdm0as,Hdm3as,Hdm0af,Hdm3af) ! Calls cloud microphysics (/!\ tendencies in X/m-3): !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ if (mm_call_clouds) then call mm_cloud_microphysics(Hdm0as,Hdm3as,Hdm0af,Hdm3af,& Cdm0as,Cdm3as,Cdm0af,Cdm3af,& dm0ccn,dm3ccn,dm3ices,dmugases) ! Multiply by altitude thickness and reverse vectors so they go from ground to top (--> m-2) dm0ccn = dm0ccn(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1) dm3ccn = dm3ccn(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1) do i = 1, mm_nesp dm3ices(:,i) = dm3ices(mm_nla:1:-1,i) * mm_dzlev(mm_nla:1:-1) dmugases(:,i) = dmugases(mm_nla:1:-1,i) ! Compute condensation heating rate (/!\ dmugases = - dm3ices) dtlc(:) = dtlc(:) - (dmugases(:,i) * mm_xESPS(i)%fmol2fmas * mm_LheatX(mm_temp,mm_xESPS(i))) enddo else Cdm0as(:) = 0._mm_wp ; Cdm3as(:) = 0._mm_wp ; Cdm0af(:) = 0._mm_wp ; Cdm3af(:) = 0._mm_wp dm0ccn(:) = 0._mm_wp ; dm3ccn(:) = 0._mm_wp ; dm3ices(:,:) = 0._mm_wp ; dmugases(:,:) = 0._mm_wp dtlc(:) = 0._mm_wp endif ! end of mm_call_clouds ! Multiply by altitude thickness and reverse vectors so they go from ground to top (--> m-2) dm0as = (Hdm0as(mm_nla:1:-1) + Cdm0as(mm_nla:1:-1)) * mm_dzlev(mm_nla:1:-1) dm3as = (Hdm3as(mm_nla:1:-1) + Cdm3as(mm_nla:1:-1)) * mm_dzlev(mm_nla:1:-1) dm0af = (Hdm0af(mm_nla:1:-1) + Cdm0af(mm_nla:1:-1)) * mm_dzlev(mm_nla:1:-1) dm3af = (Hdm3af(mm_nla:1:-1) + Cdm3af(mm_nla:1:-1)) * mm_dzlev(mm_nla:1:-1) RETURN END FUNCTION muphys_all FUNCTION muphys_nocld(m3as_prod,dm0as,dm3as,dm0af,dm3af) RESULT(ret) !! Compute the evolution of moments tracers through haze microphysics processes. !! !! This method computes the evolution of all the microphysics tracers, given under the form !! of moments during a time step. !! !! The method requires that global variables of the model (i.e. variables declared in mm_globals !! module) are initialized/updated correctly (see mm_global_init, mm_column_init, and mm_aerosols_init). !! !! The tendencies returned by the method are defined on the vertical __layers__ of the model from the __GROUND__ to !! the __TOP__ of the atmosphere. They should be added to the input variables used in the initialization methods !! before the latter are called to initialize a new step. !! ! Production of the 3rd order moment of the spherical mode distribution (m3.m-2). REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: m3as_prod ! Tendency of the 0th order moment of the spherical mode distribution (m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm0as ! Tendency of the 3rd order moment of the spherical mode distribution (m3.m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm3as ! Tendency of the 0th order moment of the fractal mode distribution (m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm0af ! Tendency of the 3rd order moment of the fractal mode distribution (m3.m-2). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:) :: dm3af ! .true. on succes (i.e. model has been initialized at least once previously), .false. otherwise. LOGICAL :: ret ! Local variables: !~~~~~~~~~~~~~~~~~ ! Production of the spherical aerosols (m3.m-3). REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: m3a_s_prod ALLOCATE(m3a_s_prod(mm_nla)) ! Sanity check for initialization: !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ret = (mm_ini_col.AND.mm_ini_aer) if (.NOT.ret) then return endif if (mm_call_clouds.AND.mm_debug) then write(*,'(a)') "[MM_DEBUG - muphys_nocld] Clouds microphysics enabled but will not be computed... (wrong interface)" endif ! Reverse vectors so they go from top to ground ! @note: mm_dzlev is already from top to ground m3a_s_prod = m3as_prod(mm_nla:1:-1) / mm_dzlev(:) ! Calls haze microphysics (/!\ tendencies in X/m-3): !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ call mm_haze_microphysics(m3a_s_prod,dm0as,dm3as,dm0af,dm3af) ! Multiply by altitude thickness and reverse vectors so they go from ground to top (--> m-2) dm0as = dm0as(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1) dm3as = dm3as(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1) dm0af = dm0af(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1) dm3af = dm3af(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1) RETURN END FUNCTION muphys_nocld SUBROUTINE mm_diagnostics(dt,aer_s_prec,aer_f_prec,aer_s_w,aer_f_w,aer_s_flux,aer_f_flux,rc_sph,rc_fra,& ccn_prec,ice_prec,cld_w,ccn_flux,ice_fluxes,rcld,gas_sat,n_rate,g_rate) !! Get various diagnostic fields of the microphysics. !! !! @note !! Fluxes values are always negative as they account for sedimentation fluxes. They are set as !! vector and are ordered from __GROUND__ to __TOP__. !! !! @note !! Precipitation are always positive and defined in kg.m-2.s-1. !! ! Physics timestep (s). REAL(kind=8), INTENT(IN) :: dt ! Haze related: !~~~~~~~~~~~~~~ ! Aerosol precipitation (kg.m-2.s-1). REAL(kind=mm_wp), INTENT(inout), OPTIONAL :: aer_s_prec REAL(kind=mm_wp), INTENT(inout), OPTIONAL :: aer_f_prec ! Aerosol settling velocity (m.s-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: aer_s_w REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: aer_f_w ! Aerosol mass flux (kg.m-2.s-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: aer_s_flux REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: aer_f_flux ! Aerosol characteristic radius (m). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: rc_sph REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: rc_fra ! Clouds related: !~~~~~~~~~~~~~~~~ ! Cloud condensation nuclei precipitation (kg.m-2.s-1). REAL(kind=mm_wp), INTENT(inout), OPTIONAL :: ccn_prec ! Ice precipitation (kg.m-2.s-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: ice_prec ! Cloud drop (CCN + ices) settling velocity (m.s-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: cld_w ! Cloud condensation nuclei mass flux (kg.m-2.s-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: ccn_flux ! Ice mass fluxes (kg.m-2.s-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:,:), OPTIONAL :: ice_fluxes ! Cloud drop (CCN + ices) radius (m). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:), OPTIONAL :: rcld ! Cloud related diagnostics. REAL(kind=mm_wp), INTENT(inout), DIMENSION(:,:), OPTIONAL :: gas_sat ! Condensible gaz saturation ratios. REAL(kind=mm_wp), INTENT(inout), DIMENSION(:,:), OPTIONAL :: n_rate ! Condensible gaz nucleation rates (m-2.s-1). REAL(kind=mm_wp), INTENT(inout), DIMENSION(:,:), OPTIONAL :: g_rate ! Ice growth rates (m2.s-1). ! Haze related: !~~~~~~~~~~~~~~ IF (PRESENT(aer_s_prec)) aer_s_prec = ABS(mm_aers_prec) / dt IF (PRESENT(aer_f_prec)) aer_f_prec = ABS(mm_aerf_prec) / dt IF (PRESENT(aer_s_w)) aer_s_w = -mm_m3as_vsed(mm_nla:1:-1) IF (PRESENT(aer_f_w)) aer_f_w = -mm_m3af_vsed(mm_nla:1:-1) IF (PRESENT(aer_s_flux)) aer_s_flux = -mm_aer_s_flux(mm_nla:1:-1) IF (PRESENT(aer_f_flux)) aer_f_flux = -mm_aer_f_flux(mm_nla:1:-1) IF (mm_ini_aer) THEN IF (PRESENT(rc_sph)) rc_sph = mm_rcs(mm_nla:1:-1) IF (PRESENT(rc_fra)) rc_fra = mm_rcf(mm_nla:1:-1) ELSE IF (PRESENT(rc_sph)) rc_sph = 0._mm_wp IF (PRESENT(rc_fra)) rc_fra = 0._mm_wp ENDIF ! Clouds related: !~~~~~~~~~~~~~~~~ IF (mm_call_clouds) THEN IF (PRESENT(ccn_prec)) ccn_prec = ABS(mm_ccn_prec) / dt IF (PRESENT(ice_prec)) ice_prec = ABS(mm_ice_prec) / dt IF (PRESENT(cld_w)) cld_w = mm_cld_vsed(mm_nla:1:-1) IF (PRESENT(ccn_flux)) ccn_flux = mm_ccn_flux(mm_nla:1:-1) IF (PRESENT(ice_fluxes)) ice_fluxes = mm_ice_fluxes(mm_nla:1:-1,:) IF (PRESENT(rcld)) rcld = mm_drad(mm_nla:1:-1) IF (PRESENT(gas_sat)) gas_sat = mm_gas_sat(mm_nla:1:-1,:) IF (PRESENT(n_rate)) n_rate = mm_nrate(mm_nla:1:-1,:) IF (PRESENT(g_rate)) g_rate = mm_grate(mm_nla:1:-1,:) ELSE IF (PRESENT(ccn_prec)) ccn_prec = 0._mm_wp IF (PRESENT(ice_prec)) ice_prec = 0._mm_wp IF (PRESENT(cld_w)) cld_w = 0._mm_wp IF (PRESENT(ccn_flux)) ccn_flux = 0._mm_wp IF (PRESENT(ice_fluxes)) ice_fluxes = 0._mm_wp IF (PRESENT(rcld)) rcld = 0._mm_wp IF (PRESENT(gas_sat)) gas_sat = 0._mm_wp IF (PRESENT(n_rate)) n_rate = 0._mm_wp IF (PRESENT(g_rate)) g_rate = 0._mm_wp ENDIF ! end of mm_call_clouds END SUBROUTINE mm_diagnostics END MODULE MP2M_MICROPHYSICS