| 1 | MODULE mp2m_diagnostics |
|---|
| 2 | |
|---|
| 3 | !======================================================================= |
|---|
| 4 | ! Purpose |
|---|
| 5 | ! ------- |
|---|
| 6 | ! Microphysics diagnostics variables module. |
|---|
| 7 | ! |
|---|
| 8 | ! The module contains all the variables related to output diagnostics of the microphysics two moments. |
|---|
| 9 | ! Such variables are not (and should not be) used as input in the GCM except for output data writing. |
|---|
| 10 | ! |
|---|
| 11 | ! The module also contains three methods: |
|---|
| 12 | ! - inimuphy_diag(ngrid,nlayer,nq,pq,int2ext) | Initialize the variables associated to microphysics diagnostics. |
|---|
| 13 | ! - alpha_s(k) | Inter-moment relation for spherical aerosols size distribution law. |
|---|
| 14 | ! - alpha_f(k) | Inter-moment relation for fractal aerosols size distribution law. |
|---|
| 15 | ! |
|---|
| 16 | ! @warning |
|---|
| 17 | ! We suppose a given order of microphysical tracers in micro_indx and micro_ice_indx: |
|---|
| 18 | ! 1. mu_m0as, 2. mu_m3as, 3. mu_m0af, 4. mu_m3af. |
|---|
| 19 | ! If clouds are activated: |
|---|
| 20 | ! 5. mu_m0ccn, 6. mu_m3ccn, 7(+). mu_m3ices. |
|---|
| 21 | ! |
|---|
| 22 | ! Authors |
|---|
| 23 | ! ------- |
|---|
| 24 | ! Bruno de Batz de Trenquelléon (11/2024) |
|---|
| 25 | !======================================================================= |
|---|
| 26 | |
|---|
| 27 | USE tracer_h |
|---|
| 28 | USE callkeys_mod, only : haze_rc_prod, haze_rm, callmuclouds |
|---|
| 29 | |
|---|
| 30 | IMPLICIT NONE |
|---|
| 31 | |
|---|
| 32 | ! Haze model diagnostics |
|---|
| 33 | REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_aer_s_prec ! Spherical aerosols precipitation (kg.m-2.s-1). |
|---|
| 34 | REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_aer_f_prec ! Fractal aerosols precipitation (kg.m-2.s-1). |
|---|
| 35 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_aer_s_w ! Spherical aerosol settling velocity (m.s-1). |
|---|
| 36 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_aer_f_w ! Fractal aerosol settling velocity (m.s-1). |
|---|
| 37 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_aer_s_flux ! Spherical aerosol mass flux (kg.m-2.s-1). |
|---|
| 38 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_aer_f_flux ! Fractal aerosol mass flux (kg.m-2.s-1). |
|---|
| 39 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_sph ! Spherical mode characteristic radius, i.e. bulk radius (m). |
|---|
| 40 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_fra ! Fractal mode characteristic radius, i.e. bulk radius (m). |
|---|
| 41 | !$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) |
|---|
| 42 | !$OMP THREADPRIVATE(mp2m_rc_sph,mp2m_rc_fra) |
|---|
| 43 | |
|---|
| 44 | ! Cloud model diagnostics |
|---|
| 45 | REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_ccn_prec ! CCN precipitation (kg.m-2.s-1). |
|---|
| 46 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_ice_prec ! Ice precipitation (kg.m-2.s-1). |
|---|
| 47 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_cld_w ! Cloud drop settling velocity (m.s-1). |
|---|
| 48 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_ccn_flux ! CCN mass flux (kg.m-2.s-1). |
|---|
| 49 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_ice_fluxes ! Ice mass fluxes (kg.m-2.s-1). |
|---|
| 50 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_cld ! Cloud drop radius (m). |
|---|
| 51 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_gas_sat ! Condensible gaz saturation ratios. |
|---|
| 52 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_nrate ! Condensible species nucleation rate (m-2.s-1). |
|---|
| 53 | REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_grate ! Condensible species growth rate (m2.s-1). |
|---|
| 54 | !$OMP THREADPRIVATE(mp2m_ccn_prec,mp2m_ice_prec,mp2m_cld_w,mp2m_ccn_flux,mp2m_ice_fluxes) |
|---|
| 55 | !$OMP THREADPRIVATE(mp2m_rc_cld,mp2m_gas_sat,mp2m_nrate,mp2m_grate) |
|---|
| 56 | |
|---|
| 57 | CONTAINS |
|---|
| 58 | |
|---|
| 59 | SUBROUTINE inimufi_diag(ngrid,nlayer,nq,pq,int2ext) |
|---|
| 60 | !! Initialize the variables associated to microphysics diagnostics. |
|---|
| 61 | !! |
|---|
| 62 | INTEGER, INTENT(in) :: ngrid ! Number of points of the horizontal grid. |
|---|
| 63 | INTEGER, INTENT(in) :: nlayer ! Number of points of the vertical grid (layers). |
|---|
| 64 | INTEGER, INTENT(in) :: nq ! Number of advected fields. |
|---|
| 65 | |
|---|
| 66 | REAL,INTENT(in) :: pq(ngrid,nlayer,nq) ! Tracers (X/kg_of_air). |
|---|
| 67 | REAL,INTENT(in) :: int2ext(ngrid,nlayer) ! Intensive to extensive factor (kg_air/m3). |
|---|
| 68 | |
|---|
| 69 | ! Local variables: |
|---|
| 70 | !~~~~~~~~~~~~~~~~~ |
|---|
| 71 | INTEGER :: i |
|---|
| 72 | REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0as ! 0th order moment of the spherical mode (m-3). |
|---|
| 73 | REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3as ! 3rd order moment of the spherical mode (m3.m-3). |
|---|
| 74 | REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0af ! 0th order moment of the fractal mode (m-3). |
|---|
| 75 | REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3af ! 3rd order moment of the fractal mode (m3.m-3). |
|---|
| 76 | REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0ccn ! 0th order moment of the cloud condensation nuclei (m-3). |
|---|
| 77 | REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3ccn ! 3rd order moment of the cloud condensation nuclei (m3.m-3). |
|---|
| 78 | REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3itot ! 3rd order moment of the total ices (m3.m-3). |
|---|
| 79 | |
|---|
| 80 | IF (.NOT.ALLOCATED(mp2m_aer_s_prec)) ALLOCATE(mp2m_aer_s_prec(ngrid)) |
|---|
| 81 | IF (.NOT.ALLOCATED(mp2m_aer_f_prec)) ALLOCATE(mp2m_aer_f_prec(ngrid)) |
|---|
| 82 | IF (.NOT.ALLOCATED(mp2m_aer_s_w)) ALLOCATE(mp2m_aer_s_w(ngrid,nlayer)) |
|---|
| 83 | IF (.NOT.ALLOCATED(mp2m_aer_f_w)) ALLOCATE(mp2m_aer_f_w(ngrid,nlayer)) |
|---|
| 84 | IF (.NOT.ALLOCATED(mp2m_aer_s_flux)) ALLOCATE(mp2m_aer_s_flux(ngrid,nlayer)) |
|---|
| 85 | IF (.NOT.ALLOCATED(mp2m_aer_f_flux)) ALLOCATE(mp2m_aer_f_flux(ngrid,nlayer)) |
|---|
| 86 | IF (.NOT.ALLOCATED(mp2m_rc_sph)) ALLOCATE(mp2m_rc_sph(ngrid,nlayer)) |
|---|
| 87 | IF (.NOT.ALLOCATED(mp2m_rc_fra)) ALLOCATE(mp2m_rc_fra(ngrid,nlayer)) |
|---|
| 88 | |
|---|
| 89 | IF (.NOT.ALLOCATED(mp2m_ccn_prec)) ALLOCATE(mp2m_ccn_prec(ngrid)) |
|---|
| 90 | IF (.NOT.ALLOCATED(mp2m_ice_prec)) ALLOCATE(mp2m_ice_prec(ngrid,nmicro_ices)) |
|---|
| 91 | IF (.NOT.ALLOCATED(mp2m_cld_w)) ALLOCATE(mp2m_cld_w(ngrid,nlayer)) |
|---|
| 92 | IF (.NOT.ALLOCATED(mp2m_ccn_flux)) ALLOCATE(mp2m_ccn_flux(ngrid,nlayer)) |
|---|
| 93 | IF (.NOT.ALLOCATED(mp2m_ice_fluxes)) ALLOCATE(mp2m_ice_fluxes(ngrid,nlayer,nmicro_ices)) |
|---|
| 94 | IF (.NOT.ALLOCATED(mp2m_rc_cld)) ALLOCATE(mp2m_rc_cld(ngrid,nlayer)) |
|---|
| 95 | IF (.NOT.ALLOCATED(mp2m_gas_sat)) ALLOCATE(mp2m_gas_sat(ngrid,nlayer,nmicro_ices)) |
|---|
| 96 | IF (.NOT.ALLOCATED(mp2m_nrate)) ALLOCATE(mp2m_nrate(ngrid,nlayer,nmicro_ices)) |
|---|
| 97 | IF (.NOT.ALLOCATED(mp2m_grate)) ALLOCATE(mp2m_grate(ngrid,nlayer,nmicro_ices)) |
|---|
| 98 | |
|---|
| 99 | ALLOCATE(m0as(ngrid,nlayer)) |
|---|
| 100 | ALLOCATE(m3as(ngrid,nlayer)) |
|---|
| 101 | ALLOCATE(m0af(ngrid,nlayer)) |
|---|
| 102 | ALLOCATE(m3af(ngrid,nlayer)) |
|---|
| 103 | ALLOCATE(m0ccn(ngrid,nlayer)) |
|---|
| 104 | ALLOCATE(m3ccn(ngrid,nlayer)) |
|---|
| 105 | ALLOCATE(m3itot(ngrid,nlayer)) |
|---|
| 106 | |
|---|
| 107 | ! Set to 0: |
|---|
| 108 | !~~~~~~~~~~ |
|---|
| 109 | mp2m_aer_s_prec(:) = 0d0 |
|---|
| 110 | mp2m_aer_f_prec(:) = 0d0 |
|---|
| 111 | mp2m_aer_s_w(:,:) = 0d0 |
|---|
| 112 | mp2m_aer_f_w(:,:) = 0d0 |
|---|
| 113 | mp2m_aer_s_flux(:,:) = 0d0 |
|---|
| 114 | mp2m_aer_f_flux(:,:) = 0d0 |
|---|
| 115 | mp2m_rc_sph(:,:) = 0d0 |
|---|
| 116 | mp2m_rc_fra(:,:) = 0d0 |
|---|
| 117 | |
|---|
| 118 | mp2m_ccn_prec(:) = 0d0 |
|---|
| 119 | mp2m_ice_prec(:,:) = 0d0 |
|---|
| 120 | mp2m_cld_w(:,:) = 0d0 |
|---|
| 121 | mp2m_ccn_flux(:,:) = 0d0 |
|---|
| 122 | mp2m_ice_fluxes(:,:,:) = 0d0 |
|---|
| 123 | mp2m_rc_cld(:,:) = 0d0 |
|---|
| 124 | mp2m_gas_sat(:,:,:) = 0d0 |
|---|
| 125 | mp2m_nrate(:,:,:) = 0d0 |
|---|
| 126 | mp2m_grate(:,:,:) = 0d0 |
|---|
| 127 | |
|---|
| 128 | m0as(:,:) = 0d0 |
|---|
| 129 | m3as(:,:) = 0d0 |
|---|
| 130 | m0af(:,:) = 0d0 |
|---|
| 131 | m3af(:,:) = 0d0 |
|---|
| 132 | m0ccn(:,:) = 0d0 |
|---|
| 133 | m3ccn(:,:) = 0d0 |
|---|
| 134 | m3itot(:,:) = 0d0 |
|---|
| 135 | |
|---|
| 136 | ! Initializes the radius to their first value (useful for radiative transfer): |
|---|
| 137 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 138 | ! Spherical aerosols |
|---|
| 139 | m0as(:,:) = pq(:,:,micro_indx(1)) * int2ext |
|---|
| 140 | m3as(:,:) = pq(:,:,micro_indx(2)) * int2ext |
|---|
| 141 | |
|---|
| 142 | WHERE(m0as > 1e-8 .AND. m3as > (1e-8*alpha_s(3.)*haze_rc_prod**3)) |
|---|
| 143 | mp2m_rc_sph = (m3as / (m0as*alpha_s(3.)))**(1./3.) |
|---|
| 144 | ELSEWHERE |
|---|
| 145 | mp2m_rc_sph = 0d0 |
|---|
| 146 | ENDWHERE |
|---|
| 147 | |
|---|
| 148 | ! Fractal aerosols |
|---|
| 149 | m0af(:,:) = pq(:,:,micro_indx(3)) * int2ext |
|---|
| 150 | m3af(:,:) = pq(:,:,micro_indx(4)) * int2ext |
|---|
| 151 | |
|---|
| 152 | WHERE(m0af > 1e-8 .AND. m3af > (1e-8*alpha_f(3.)*haze_rm**3)) |
|---|
| 153 | mp2m_rc_fra = (m3af / (m0af*alpha_f(3.)))**(1./3.) |
|---|
| 154 | ELSEWHERE |
|---|
| 155 | mp2m_rc_fra = 0d0 |
|---|
| 156 | ENDWHERE |
|---|
| 157 | |
|---|
| 158 | ! Cloud drops |
|---|
| 159 | IF (callmuclouds) THEN |
|---|
| 160 | m0ccn(:,:) = pq(:,:,micro_indx(5)) * int2ext |
|---|
| 161 | m3ccn(:,:) = pq(:,:,micro_indx(6)) * int2ext |
|---|
| 162 | DO i=1, size(micro_ice_indx) |
|---|
| 163 | m3itot(:,:) = m3itot(:,:) + (pq(:,:,micro_ice_indx(i)) * int2ext) |
|---|
| 164 | ENDDO |
|---|
| 165 | |
|---|
| 166 | WHERE(m0ccn > 1e-8 .AND. (m3ccn+m3itot) > (1e-8*alpha_f(3.)*haze_rm**3)) |
|---|
| 167 | mp2m_rc_cld = ((m3ccn+m3itot) / (m0ccn))**(1./3.) |
|---|
| 168 | ELSEWHERE |
|---|
| 169 | mp2m_rc_cld = 0d0 |
|---|
| 170 | ENDWHERE |
|---|
| 171 | ENDIF ! end of callmuclouds |
|---|
| 172 | |
|---|
| 173 | CONTAINS |
|---|
| 174 | |
|---|
| 175 | FUNCTION alpha_s(k) RESULT (res) |
|---|
| 176 | !! Inter-moment relation for spherical aerosols size distribution law. |
|---|
| 177 | !! Mk / M0 = rc^k . alpha(k) |
|---|
| 178 | !! |
|---|
| 179 | use mp2m_intgcm |
|---|
| 180 | REAL, INTENT(in) :: k ! k order of the moment. |
|---|
| 181 | REAL :: sigma ! Standard deviation. |
|---|
| 182 | REAL :: res ! Alpha value. |
|---|
| 183 | |
|---|
| 184 | ! Titan's case |
|---|
| 185 | !~~~~~~~~~~~~~ |
|---|
| 186 | ! res = SUM(dexp(mm_asp%a*k**2 + mm_asp%b*k + mm_asp%c)) |
|---|
| 187 | |
|---|
| 188 | ! Pluto's case |
|---|
| 189 | !~~~~~~~~~~~~~ |
|---|
| 190 | sigma = 0.2 |
|---|
| 191 | res = exp(k**2 * sigma**2 / 2.) |
|---|
| 192 | END FUNCTION alpha_s |
|---|
| 193 | |
|---|
| 194 | FUNCTION alpha_f(k) RESULT (res) |
|---|
| 195 | !! Inter-moment relation for fractal aerosols size distribution law. |
|---|
| 196 | !! Mk / M0 = rc^k . alpha(k) |
|---|
| 197 | !! |
|---|
| 198 | use mp2m_intgcm |
|---|
| 199 | REAL, INTENT(in) :: k ! k order of the moment. |
|---|
| 200 | REAL :: sigma ! Standard deviation. |
|---|
| 201 | REAL :: res ! Alpha value. |
|---|
| 202 | |
|---|
| 203 | ! Titan's case |
|---|
| 204 | !~~~~~~~~~~~~~ |
|---|
| 205 | ! res = SUM(dexp(mm_asp%a*k**2 + mm_asp%b*k + mm_asp%c)) |
|---|
| 206 | |
|---|
| 207 | ! Pluto's case |
|---|
| 208 | !~~~~~~~~~~~~~ |
|---|
| 209 | sigma = 0.35 |
|---|
| 210 | res = exp(k**2 * sigma**2 / 2.) |
|---|
| 211 | END FUNCTION alpha_f |
|---|
| 212 | END SUBROUTINE inimufi_diag |
|---|
| 213 | |
|---|
| 214 | END MODULE mp2m_diagnostics |
|---|
