MODULE mp2m_diagnostics !======================================================================= ! Purpose ! ------- ! Microphysics diagnostics variables module. ! ! The module contains all the variables related to output diagnostics of the microphysics two moments. ! Such variables are not (and should not be) used as input in the GCM except for output data writing. ! ! The module also contains three methods: ! - inimuphy_diag(ngrid,nlayer,nq,pq,int2ext) | Initialize the variables associated to microphysics diagnostics. ! - alpha_s(k) | Inter-moment relation for spherical aerosols size distribution law. ! - alpha_f(k) | Inter-moment relation for fractal aerosols size distribution law. ! ! @warning ! We suppose a given order of microphysical tracers in micro_indx and micro_ice_indx: ! 1. mu_m0as, 2. mu_m3as, 3. mu_m0af, 4. mu_m3af. ! If clouds are activated: ! 5. mu_m0ccn, 6. mu_m3ccn, 7(+). mu_m3ices. ! ! Authors ! ------- ! Bruno de Batz de Trenquelléon (11/2024) !======================================================================= USE tracer_h USE callkeys_mod, only : haze_rc_prod, haze_rm, callmuclouds IMPLICIT NONE ! Haze model diagnostics REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_aer_s_prec ! Spherical aerosols precipitation (kg.m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_aer_f_prec ! Fractal aerosols precipitation (kg.m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_aer_s_w ! Spherical aerosol settling velocity (m.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_aer_f_w ! Fractal aerosol settling velocity (m.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_aer_s_flux ! Spherical aerosol mass flux (kg.m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_aer_f_flux ! Fractal aerosol mass flux (kg.m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_sph ! Spherical mode characteristic radius, i.e. bulk radius (m). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_fra ! Fractal mode characteristic radius, i.e. bulk radius (m). !$OMP THREADPRIVATE(mp2m_aer_s_prec,mp2m_aer_f_prec,mp2m_aer_s_w,mp2m_aer_f_w,mp2m_aer_s_flux,mp2m_aer_f_flux) !$OMP THREADPRIVATE(mp2m_rc_sph,mp2m_rc_fra) ! Cloud model diagnostics REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_ccn_prec ! CCN precipitation (kg.m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_ice_prec ! Ice precipitation (kg.m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_cld_w ! Cloud drop settling velocity (m.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_ccn_flux ! CCN mass flux (kg.m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_ice_fluxes ! Ice mass fluxes (kg.m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_cld ! Cloud drop radius (m). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_gas_sat ! Condensible gaz saturation ratios. REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_nrate ! Condensible species nucleation rate (m-2.s-1). REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_grate ! Condensible species growth rate (m2.s-1). !$OMP THREADPRIVATE(mp2m_ccn_prec,mp2m_ice_prec,mp2m_cld_w,mp2m_ccn_flux,mp2m_ice_fluxes) !$OMP THREADPRIVATE(mp2m_rc_cld,mp2m_gas_sat,mp2m_nrate,mp2m_grate) CONTAINS SUBROUTINE inimufi_diag(ngrid,nlayer,nq,pq,int2ext) !! Initialize the variables associated to microphysics diagnostics. !! INTEGER, INTENT(in) :: ngrid ! Number of points of the horizontal grid. INTEGER, INTENT(in) :: nlayer ! Number of points of the vertical grid (layers). INTEGER, INTENT(in) :: nq ! Number of advected fields. REAL,INTENT(in) :: pq(ngrid,nlayer,nq) ! Tracers (X/kg_of_air). REAL,INTENT(in) :: int2ext(ngrid,nlayer) ! Intensive to extensive factor (kg_air/m3). ! Local variables: !~~~~~~~~~~~~~~~~~ INTEGER :: i REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0as ! 0th order moment of the spherical mode (m-3). REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3as ! 3rd order moment of the spherical mode (m3.m-3). REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0af ! 0th order moment of the fractal mode (m-3). REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3af ! 3rd order moment of the fractal mode (m3.m-3). REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0ccn ! 0th order moment of the cloud condensation nuclei (m-3). REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3ccn ! 3rd order moment of the cloud condensation nuclei (m3.m-3). REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3itot ! 3rd order moment of the total ices (m3.m-3). IF (.NOT.ALLOCATED(mp2m_aer_s_prec)) ALLOCATE(mp2m_aer_s_prec(ngrid)) IF (.NOT.ALLOCATED(mp2m_aer_f_prec)) ALLOCATE(mp2m_aer_f_prec(ngrid)) IF (.NOT.ALLOCATED(mp2m_aer_s_w)) ALLOCATE(mp2m_aer_s_w(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_aer_f_w)) ALLOCATE(mp2m_aer_f_w(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_aer_s_flux)) ALLOCATE(mp2m_aer_s_flux(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_aer_f_flux)) ALLOCATE(mp2m_aer_f_flux(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_rc_sph)) ALLOCATE(mp2m_rc_sph(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_rc_fra)) ALLOCATE(mp2m_rc_fra(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_ccn_prec)) ALLOCATE(mp2m_ccn_prec(ngrid)) IF (.NOT.ALLOCATED(mp2m_ice_prec)) ALLOCATE(mp2m_ice_prec(ngrid,nmicro_ices)) IF (.NOT.ALLOCATED(mp2m_cld_w)) ALLOCATE(mp2m_cld_w(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_ccn_flux)) ALLOCATE(mp2m_ccn_flux(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_ice_fluxes)) ALLOCATE(mp2m_ice_fluxes(ngrid,nlayer,nmicro_ices)) IF (.NOT.ALLOCATED(mp2m_rc_cld)) ALLOCATE(mp2m_rc_cld(ngrid,nlayer)) IF (.NOT.ALLOCATED(mp2m_gas_sat)) ALLOCATE(mp2m_gas_sat(ngrid,nlayer,nmicro_ices)) IF (.NOT.ALLOCATED(mp2m_nrate)) ALLOCATE(mp2m_nrate(ngrid,nlayer,nmicro_ices)) IF (.NOT.ALLOCATED(mp2m_grate)) ALLOCATE(mp2m_grate(ngrid,nlayer,nmicro_ices)) ALLOCATE(m0as(ngrid,nlayer)) ALLOCATE(m3as(ngrid,nlayer)) ALLOCATE(m0af(ngrid,nlayer)) ALLOCATE(m3af(ngrid,nlayer)) ALLOCATE(m0ccn(ngrid,nlayer)) ALLOCATE(m3ccn(ngrid,nlayer)) ALLOCATE(m3itot(ngrid,nlayer)) ! Set to 0: !~~~~~~~~~~ mp2m_aer_s_prec(:) = 0d0 mp2m_aer_f_prec(:) = 0d0 mp2m_aer_s_w(:,:) = 0d0 mp2m_aer_f_w(:,:) = 0d0 mp2m_aer_s_flux(:,:) = 0d0 mp2m_aer_f_flux(:,:) = 0d0 mp2m_rc_sph(:,:) = 0d0 mp2m_rc_fra(:,:) = 0d0 mp2m_ccn_prec(:) = 0d0 mp2m_ice_prec(:,:) = 0d0 mp2m_cld_w(:,:) = 0d0 mp2m_ccn_flux(:,:) = 0d0 mp2m_ice_fluxes(:,:,:) = 0d0 mp2m_rc_cld(:,:) = 0d0 mp2m_gas_sat(:,:,:) = 0d0 mp2m_nrate(:,:,:) = 0d0 mp2m_grate(:,:,:) = 0d0 m0as(:,:) = 0d0 m3as(:,:) = 0d0 m0af(:,:) = 0d0 m3af(:,:) = 0d0 m0ccn(:,:) = 0d0 m3ccn(:,:) = 0d0 m3itot(:,:) = 0d0 ! Initializes the radius to their first value (useful for radiative transfer): !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! Spherical aerosols m0as(:,:) = pq(:,:,micro_indx(1)) * int2ext m3as(:,:) = pq(:,:,micro_indx(2)) * int2ext WHERE(m0as > 1e-8 .AND. m3as > (1e-8*alpha_s(3.)*haze_rc_prod**3)) mp2m_rc_sph = (m3as / (m0as*alpha_s(3.)))**(1./3.) ELSEWHERE mp2m_rc_sph = 0d0 ENDWHERE ! Fractal aerosols m0af(:,:) = pq(:,:,micro_indx(3)) * int2ext m3af(:,:) = pq(:,:,micro_indx(4)) * int2ext WHERE(m0af > 1e-8 .AND. m3af > (1e-8*alpha_f(3.)*haze_rm**3)) mp2m_rc_fra = (m3af / (m0af*alpha_f(3.)))**(1./3.) ELSEWHERE mp2m_rc_fra = 0d0 ENDWHERE ! Cloud drops IF (callmuclouds) THEN m0ccn(:,:) = pq(:,:,micro_indx(5)) * int2ext m3ccn(:,:) = pq(:,:,micro_indx(6)) * int2ext DO i=1, size(micro_ice_indx) m3itot(:,:) = m3itot(:,:) + (pq(:,:,micro_ice_indx(i)) * int2ext) ENDDO WHERE(m0ccn > 1e-8 .AND. (m3ccn+m3itot) > (1e-8*alpha_f(3.)*haze_rm**3)) mp2m_rc_cld = ((m3ccn+m3itot) / (m0ccn))**(1./3.) ELSEWHERE mp2m_rc_cld = 0d0 ENDWHERE ENDIF ! end of callmuclouds CONTAINS FUNCTION alpha_s(k) RESULT (res) !! Inter-moment relation for spherical aerosols size distribution law. !! Mk / M0 = rc^k . alpha(k) !! use mp2m_intgcm REAL, INTENT(in) :: k ! k order of the moment. REAL :: sigma ! Standard deviation. REAL :: res ! Alpha value. ! Titan's case !~~~~~~~~~~~~~ ! res = SUM(dexp(mm_asp%a*k**2 + mm_asp%b*k + mm_asp%c)) ! Pluto's case !~~~~~~~~~~~~~ sigma = 0.2 res = exp(k**2 * sigma**2 / 2.) END FUNCTION alpha_s FUNCTION alpha_f(k) RESULT (res) !! Inter-moment relation for fractal aerosols size distribution law. !! Mk / M0 = rc^k . alpha(k) !! use mp2m_intgcm REAL, INTENT(in) :: k ! k order of the moment. REAL :: sigma ! Standard deviation. REAL :: res ! Alpha value. ! Titan's case !~~~~~~~~~~~~~ ! res = SUM(dexp(mm_asp%a*k**2 + mm_asp%b*k + mm_asp%c)) ! Pluto's case !~~~~~~~~~~~~~ sigma = 0.35 res = exp(k**2 * sigma**2 / 2.) END FUNCTION alpha_f END SUBROUTINE inimufi_diag END MODULE mp2m_diagnostics