[3090] | 1 | ! Copyright (2013-2015,2017,2022-2023) Université de Reims Champagne-Ardenne |
---|
| 2 | ! Contributors : J. Burgalat (GSMA, URCA), B. de Batz de Trenquelléon (GSMA, URCA) |
---|
[1793] | 3 | ! email of the author : jeremie.burgalat@univ-reims.fr |
---|
[3083] | 4 | ! |
---|
[1793] | 5 | ! This software is a computer program whose purpose is to compute |
---|
| 6 | ! microphysics processes using a two-moments scheme. |
---|
[3083] | 7 | ! |
---|
[1793] | 8 | ! This library is governed by the CeCILL-B license under French law and |
---|
[3083] | 9 | ! abiding by the rules of distribution of free software. You can use, |
---|
[1793] | 10 | ! modify and/ or redistribute the software under the terms of the CeCILL-B |
---|
| 11 | ! license as circulated by CEA, CNRS and INRIA at the following URL |
---|
[3083] | 12 | ! "http://www.cecill.info". |
---|
| 13 | ! |
---|
[1793] | 14 | ! As a counterpart to the access to the source code and rights to copy, |
---|
| 15 | ! modify and redistribute granted by the license, users are provided only |
---|
| 16 | ! with a limited warranty and the software's author, the holder of the |
---|
| 17 | ! economic rights, and the successive licensors have only limited |
---|
[3083] | 18 | ! liability. |
---|
| 19 | ! |
---|
[1793] | 20 | ! In this respect, the user's attention is drawn to the risks associated |
---|
| 21 | ! with loading, using, modifying and/or developing or reproducing the |
---|
| 22 | ! software by the user in light of its specific status of free software, |
---|
| 23 | ! that may mean that it is complicated to manipulate, and that also |
---|
| 24 | ! therefore means that it is reserved for developers and experienced |
---|
| 25 | ! professionals having in-depth computer knowledge. Users are therefore |
---|
| 26 | ! encouraged to load and test the software's suitability as regards their |
---|
[3083] | 27 | ! requirements in conditions enabling the security of their systems and/or |
---|
| 28 | ! data to be ensured and, more generally, to use and operate it in the |
---|
| 29 | ! same conditions as regards security. |
---|
| 30 | ! |
---|
[1793] | 31 | ! The fact that you are presently reading this means that you have had |
---|
| 32 | ! knowledge of the CeCILL-B license and that you accept its terms. |
---|
| 33 | |
---|
| 34 | !! file: mm_methods.f90 |
---|
| 35 | !! summary: Model miscellaneous methods module. |
---|
| 36 | !! author: J. Burgalat |
---|
[3090] | 37 | !! date: 2013-2015,2017,2022-2023 |
---|
| 38 | !! modifications: B. de Batz de Trenquelléon |
---|
[1793] | 39 | |
---|
| 40 | MODULE MM_METHODS |
---|
| 41 | !! Model miscellaneous methods module. |
---|
| 42 | !! |
---|
| 43 | !! The module contains miscellaneous methods used either in the haze and clouds parts of the model. |
---|
| 44 | !! |
---|
| 45 | !! All thermodynamic functions related to cloud microphysics (i.e. [[mm_methods(module):mm_lHeatX(interface)]], |
---|
[3083] | 46 | !! [[mm_methods(module):mm_sigX(interface)]] and [[mm_methods(module):mm_psatX(interface)]]) compute related equations |
---|
[1793] | 47 | !! from \cite{reid1986}. A version of the book is freely available [here](http://f3.tiera.ru/3/Chemistry/References/Poling%20B.E.,%20Prausnitz%20J.M.,%20O'Connell%20J.P.%20The%20Properties%20of%20Gases%20and%20Liquids%20(5ed.,%20MGH,%202000)(ISBN%200070116822)(803s).pdf). |
---|
| 48 | !! |
---|
| 49 | !! The module defines the following functions/subroutines/interfaces: |
---|
| 50 | !! |
---|
[3083] | 51 | !! | name | description |
---|
[1793] | 52 | !! | :---------: | :------------------------------------------------------------------------------------- |
---|
| 53 | !! | mm_lheatx | Compute latent heat released |
---|
| 54 | !! | mm_sigx | Compute surface tension |
---|
| 55 | !! | mm_psatx | Compute saturation vapor pressure |
---|
| 56 | !! | mm_qsatx | Compute saturation mass mixing ratio |
---|
| 57 | !! | mm_fshape | Compute shape factor |
---|
| 58 | !! | mm_lambda_g | Compute air mean free path |
---|
| 59 | !! | mm_eta_g | Compute air viscosity |
---|
| 60 | !! | mm_get_kfm | Compute the thermodynamic pre-factor of coagulation kernel in free-molecular regime |
---|
| 61 | !! | mm_get_kco | Compute the thermodynamic pre-factor of coagulation kernel in continuous regime |
---|
| 62 | USE MM_MPREC |
---|
| 63 | USE MM_GLOBALS |
---|
| 64 | USE MM_INTERFACES |
---|
| 65 | IMPLICIT NONE |
---|
| 66 | |
---|
[3083] | 67 | PRIVATE |
---|
[1793] | 68 | |
---|
[3083] | 69 | PUBLIC :: mm_sigX, mm_LheatX, mm_psatX, mm_qsatx, mm_ysatX, mm_fshape, & |
---|
| 70 | mm_get_kco, mm_get_kfm, mm_eta_g, mm_lambda_g |
---|
[1793] | 71 | |
---|
| 72 | ! ---- INTERFACES |
---|
| 73 | |
---|
| 74 | !> Interface to surface tension computation functions. |
---|
| 75 | !! |
---|
| 76 | !! The method computes the surface tension of a given specie at given temperature(s). |
---|
| 77 | !! |
---|
| 78 | !! ```fortran |
---|
| 79 | !! FUNCTION mm_sigX(temp,xESP) |
---|
| 80 | !! ``` |
---|
[3083] | 81 | !! |
---|
| 82 | !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method |
---|
[1793] | 83 | !! computes the result for all the temperatures and returns a vector of same size than __temp__. |
---|
| 84 | INTERFACE mm_sigX |
---|
| 85 | MODULE PROCEDURE sigx_sc,sigx_ve |
---|
[3083] | 86 | END INTERFACE mm_sigX |
---|
[1793] | 87 | |
---|
| 88 | !> Interface to Latent heat computation functions. |
---|
[3083] | 89 | !! |
---|
[1793] | 90 | !! The method computes the latent heat released of a given specie at given temperature(s). |
---|
| 91 | !! |
---|
| 92 | !! ```fortran |
---|
| 93 | !! FUNCTION mm_lheatX(temp,xESP) |
---|
| 94 | !! ``` |
---|
| 95 | !! |
---|
[3083] | 96 | !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method |
---|
[1793] | 97 | !! computes the result for all the temperatures and returns a vector of same size than __temp__. |
---|
| 98 | INTERFACE mm_LheatX |
---|
| 99 | MODULE PROCEDURE lheatx_sc,lheatx_ve |
---|
[3083] | 100 | END INTERFACE mm_LheatX |
---|
[1793] | 101 | |
---|
| 102 | !> Interface to saturation vapor pressure computation functions. |
---|
| 103 | !! |
---|
| 104 | !! ```fortran |
---|
| 105 | !! FUNCTION mm_psatX(temp,xESP) |
---|
| 106 | !! ``` |
---|
[3083] | 107 | !! |
---|
[1793] | 108 | !! The method computes the saturation vapor pressure of a given specie at given temperature(s). |
---|
| 109 | !! |
---|
[3083] | 110 | !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method |
---|
[1793] | 111 | !! computes the result for all the temperatures and returns a vector of same size than __temp__. |
---|
| 112 | INTERFACE mm_psatX |
---|
| 113 | MODULE PROCEDURE psatx_sc,psatx_ve |
---|
[3083] | 114 | END INTERFACE mm_psatX |
---|
[1793] | 115 | |
---|
[3083] | 116 | !> Interface to saturation mass mixing ratio computation functions. |
---|
[1793] | 117 | !! |
---|
[3083] | 118 | !! The method computes the mass mixing ratio at saturation of a given specie at given temperature(s) |
---|
[1793] | 119 | !! and pressure level(s). |
---|
| 120 | !! |
---|
| 121 | !! ```fortran |
---|
[3083] | 122 | !! FUNCTION mm_qsatX(temp,pres,xESP) |
---|
[1793] | 123 | !! ``` |
---|
| 124 | !! |
---|
[3083] | 125 | !! __xESP__ must always be given as a scalar. If __temp__ and __pres__ are given as a vector (of same |
---|
[1793] | 126 | !! size !), then the method computes the result for each couple of (temperature, pressure) and returns |
---|
| 127 | !! a vector of same size than __temp__. |
---|
| 128 | INTERFACE mm_qsatx |
---|
| 129 | MODULE PROCEDURE qsatx_sc,qsatx_ve |
---|
[3083] | 130 | END INTERFACE mm_qsatx |
---|
[1793] | 131 | |
---|
[3083] | 132 | !> Interface to saturation molar mixing ratio computation functions. |
---|
| 133 | !! |
---|
| 134 | !! The method computes the molar mixing ratio at saturation of a given specie at given temperature(s) |
---|
[3090] | 135 | !! and pressure level(s). |
---|
[3083] | 136 | !! |
---|
| 137 | !! ```fortran |
---|
| 138 | !! FUNCTION mm_ysatX(temp,pres,xESP) |
---|
| 139 | !! ``` |
---|
| 140 | !! |
---|
| 141 | !! __xESP__ must always be given as a scalar. If __temp__ and __pres__ are given as a vector (of same |
---|
| 142 | !! size !), then the method computes the result for each couple of (temperature, pressure) and returns |
---|
| 143 | !! a vector of same size than __temp__. |
---|
| 144 | INTERFACE mm_ysatX |
---|
| 145 | MODULE PROCEDURE ysatX_sc,ysatX_ve |
---|
| 146 | END INTERFACE mm_ysatX |
---|
| 147 | |
---|
[1793] | 148 | !> Interface to shape factor computation functions. |
---|
| 149 | !! |
---|
| 150 | !! The method computes the shape factor for the heterogeneous nucleation. |
---|
| 151 | !! |
---|
| 152 | !! ```fortran |
---|
| 153 | !! FUNCTION mm_fshape(m,x) |
---|
| 154 | !! ``` |
---|
| 155 | !! |
---|
[3083] | 156 | !! Where __m__ is cosine of the contact angle and __x__ the curvature radius. __m__ must always be |
---|
| 157 | !! given as a scalar. If __x__ is given as a vector, then the method compute the result for each |
---|
[1793] | 158 | !! value of __x__ and and returns a vector of same size than __x__. |
---|
| 159 | INTERFACE mm_fshape |
---|
| 160 | MODULE PROCEDURE fshape_sc,fshape_ve |
---|
[3083] | 161 | END INTERFACE mm_fshape |
---|
[1793] | 162 | |
---|
[3083] | 163 | CONTAINS |
---|
[1793] | 164 | |
---|
| 165 | FUNCTION fshape_sc(cost,rap) RESULT(res) |
---|
| 166 | !! Get the shape factor of a ccn (scalar). |
---|
| 167 | !! |
---|
[3083] | 168 | !! The method computes the shape factor for the heterogeneous nucleation on a fractal particle. |
---|
[1793] | 169 | !! Details about the shape factor can be found in \cite{prup1978}. |
---|
| 170 | REAL(kind=mm_wp), INTENT(in) :: cost !! Cosine of the contact angle. |
---|
| 171 | REAL(kind=mm_wp), INTENT(in) :: rap !! Curvature radius (\(r_{particle}/r^{*}\)). |
---|
| 172 | REAL(kind=mm_wp) :: res !! Shape factor value. |
---|
| 173 | REAL(kind=mm_wp) :: phi,a,b,c |
---|
| 174 | IF (rap > 3000._mm_wp) THEN |
---|
| 175 | res = ((2._mm_wp+cost)*(1._mm_wp-cost)**2)/4._mm_wp |
---|
| 176 | ELSE |
---|
| 177 | phi = dsqrt(1._mm_wp-2._mm_wp*cost*rap+rap**2) |
---|
| 178 | a = 1._mm_wp + ( (1._mm_wp-cost*rap)/phi )**3 |
---|
[3083] | 179 | b = (rap**3) * (2._mm_wp - 3._mm_wp*(rap-cost)/phi + ((rap-cost)/phi)**3) |
---|
[1793] | 180 | c = 3._mm_wp * cost * (rap**2) * ((rap-cost)/phi-1._mm_wp) |
---|
| 181 | res = 0.5_mm_wp*(a+b+c) |
---|
| 182 | ENDIF |
---|
| 183 | RETURN |
---|
| 184 | END FUNCTION fshape_sc |
---|
| 185 | |
---|
| 186 | FUNCTION fshape_ve(cost,rap) RESULT(res) |
---|
| 187 | !! Get the shape factor of a ccn (vector). |
---|
| 188 | !! |
---|
| 189 | !! See [[mm_methods(module):fshape_sc(function)]]. |
---|
| 190 | REAL(kind=mm_wp), INTENT(in) :: cost !! Cosine of the contact angle. |
---|
| 191 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: rap !! Curvature radii (\(r_{particle}/r^{*}\)). |
---|
| 192 | REAL(kind=mm_wp), DIMENSION(SIZE(rap)) :: res !! Shape factor value. |
---|
| 193 | REAL(kind=mm_wp), DIMENSION(SIZE(rap)) :: phi,a,b,c |
---|
| 194 | WHERE(rap > 3000._mm_wp) |
---|
| 195 | res = ((2._mm_wp+cost)*(1._mm_wp-cost)**2)/4._mm_wp |
---|
[3083] | 196 | ELSEWHERE |
---|
[1793] | 197 | phi = dsqrt(1._mm_wp-2._mm_wp*cost*rap+rap**2) |
---|
| 198 | a = 1._mm_wp + ((1._mm_wp-cost*rap)/phi )**3 |
---|
| 199 | b = (rap**3)*(2._mm_wp-3._mm_wp*(rap-cost)/phi+((rap-cost)/phi)**3) |
---|
| 200 | c = 3._mm_wp*cost*(rap**2)*((rap-cost)/phi-1._mm_wp) |
---|
| 201 | res = 0.5_mm_wp*(a+b+c) |
---|
| 202 | ENDWHERE |
---|
| 203 | RETURN |
---|
| 204 | END FUNCTION fshape_ve |
---|
| 205 | |
---|
| 206 | FUNCTION LHeatX_sc(temp,xESP) RESULT(res) |
---|
| 207 | !! Compute latent heat of a given specie at given temperature (scalar). |
---|
| 208 | !! |
---|
| 209 | !! The method computes the latent heat equation as given in \cite{reid1986} p. 220 (eq. 7-9.4). |
---|
| 210 | IMPLICIT NONE |
---|
[3083] | 211 | ! - DUMMY |
---|
[1793] | 212 | REAL(kind=mm_wp), INTENT(in) :: temp !! temperature (K). |
---|
| 213 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 214 | REAL(kind=mm_wp) :: res !! Latent heat of given specie at given temperature (\(J.kg^{-1}\)). |
---|
| 215 | REAL(kind=mm_wp) :: ftm |
---|
[3083] | 216 | ftm=MAX(1._mm_wp-temp/xESP%tc,1.e-3_mm_wp) |
---|
[1793] | 217 | res = mm_rgas*xESP%tc*(7.08_mm_wp*ftm**0.354_mm_wp+10.95_mm_wp*xESP%w*ftm**0.456_mm_wp)/xESP%masmol |
---|
| 218 | END FUNCTION LHeatX_sc |
---|
[3083] | 219 | |
---|
[1793] | 220 | FUNCTION LHeatX_ve(temp,xESP) RESULT(res) |
---|
| 221 | !! Compute latent heat of a given specie at given temperature (vector). |
---|
| 222 | !! |
---|
| 223 | !! See [[mm_methods(module):lheatx_sc(function)]]. |
---|
| 224 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! temperatures (K). |
---|
| 225 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 226 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: res !! Latent heat of given specie at given temperatures (\(J.kg^{-1}\)). |
---|
[3083] | 227 | REAL(kind=mm_wp) :: ftm |
---|
[1793] | 228 | INTEGER :: i |
---|
| 229 | DO i=1,SIZE(temp) |
---|
[3083] | 230 | ftm=MAX(1._mm_wp-temp(i)/xESP%tc,1.e-3_mm_wp) |
---|
[1793] | 231 | res(i) = mm_rgas*xESP%tc*(7.08_mm_wp*ftm**0.354_mm_wp+10.95_mm_wp*xESP%w*ftm**0.456_mm_wp) / & |
---|
[3083] | 232 | xESP%masmol |
---|
[1793] | 233 | ENDDO |
---|
| 234 | END FUNCTION LHeatX_ve |
---|
| 235 | |
---|
| 236 | FUNCTION sigX_sc(temp,xESP) RESULT(res) |
---|
| 237 | !! Get the surface tension between a given specie and the air (scalar). |
---|
[3083] | 238 | !! |
---|
[1793] | 239 | !! The method computes the surface tension equation as given in \cite{reid1986} p. 637 (eq. 12-3.6). |
---|
| 240 | REAL(kind=mm_wp), INTENT(in) :: temp !! temperature (K). |
---|
| 241 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 242 | REAL(kind=mm_wp) :: res !! Surface tension (\(N.m^{-1}\)). |
---|
| 243 | REAL(kind=mm_wp) :: tr,tbr,sig |
---|
| 244 | tr=MIN(temp/xESP%tc,0.99_mm_wp) |
---|
| 245 | tbr=xESP%tb/xESP%tc |
---|
| 246 | sig = 0.1196_mm_wp*(1._mm_wp+(tbr*dlog(xESP%pc/1.01325_mm_wp))/(1._mm_wp-tbr))-0.279_mm_wp |
---|
| 247 | sig = xESP%pc**(2._mm_wp/3._mm_wp)*xESP%tc**(1._mm_wp/3._mm_wp)*sig*(1._mm_wp-tr)**(11._mm_wp/9._mm_wp) |
---|
[3083] | 248 | res = sig*1e-3_mm_wp ! dyn/cm -> N/m |
---|
[1793] | 249 | END FUNCTION sigX_sc |
---|
[3083] | 250 | |
---|
[1793] | 251 | FUNCTION sigX_ve(temp,xESP) RESULT(res) |
---|
| 252 | !! Get the surface tension between a given specie and the air (vector). |
---|
| 253 | !! |
---|
| 254 | !! See [[mm_methods(module):sigx_sc(function)]]. |
---|
| 255 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! temperatures (K). |
---|
| 256 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 257 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: res !! Surface tensions (\(N.m^{-1}\)). |
---|
| 258 | INTEGER :: i |
---|
[3083] | 259 | REAL(kind=mm_wp) :: tr,tbr,sig0,sig |
---|
[1793] | 260 | tbr = xESP%tb/xESP%tc |
---|
[3083] | 261 | sig0 = 0.1196_mm_wp*(1._mm_wp+(tbr*dlog(xESP%pc/1.01325_mm_wp))/(1._mm_wp-tbr))-0.279_mm_wp |
---|
[1793] | 262 | DO i=1,SIZE(temp) |
---|
| 263 | tr = MIN(temp(i)/xESP%tc,0.99_mm_wp) |
---|
[3083] | 264 | sig = xESP%pc**(2._mm_wp/3._mm_wp)*xESP%tc**(1._mm_wp/3._mm_wp)*sig0*(1._mm_wp-tr)**(11._mm_wp/9._mm_wp) |
---|
| 265 | res(i) = sig*1e-3_mm_wp ! dyn/cm -> N/m |
---|
[1793] | 266 | ENDDO |
---|
| 267 | END FUNCTION sigX_ve |
---|
| 268 | |
---|
| 269 | FUNCTION psatX_sc(temp,xESP) RESULT(res) |
---|
| 270 | !! Get saturation vapor pressure for a given specie at given temperature (scalar). |
---|
[3083] | 271 | !! |
---|
[1793] | 272 | !! The method computes the saturation vapor pressure equation given in \cite{reid1986} p. 657 (eq. 1). |
---|
| 273 | REAL(kind=mm_wp), INTENT(in) :: temp !! Temperature (K). |
---|
| 274 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 275 | REAL(kind=mm_wp) :: res !! Saturation vapor pressure (Pa). |
---|
| 276 | REAL(kind=mm_wp) :: x,qsat |
---|
| 277 | x = 1._mm_wp-temp/xESP%tc |
---|
| 278 | IF (x > 0._mm_wp) THEN |
---|
| 279 | qsat = (1._mm_wp-x)**(-1) * & |
---|
[3083] | 280 | (xESP%a_sat*x + xESP%b_sat*x**1.5_mm_wp + xESP%c_sat*x**2.5_mm_wp + xESP%d_sat*x**5_mm_wp) |
---|
[1793] | 281 | ELSE |
---|
[3083] | 282 | qsat = XESP%a_sat*x/abs(1._mm_wp-x) ! approx for t > tc |
---|
[1793] | 283 | ENDIF |
---|
[3083] | 284 | res = xESP%pc*exp(qsat) |
---|
[1793] | 285 | ! now convert bar to Pa |
---|
| 286 | res = res * 1e5_mm_wp |
---|
| 287 | END FUNCTION psatX_sc |
---|
| 288 | |
---|
| 289 | FUNCTION psatX_ve(temp,xESP) RESULT(res) |
---|
| 290 | !! Get saturation vapor pressure for a given specie at given temperature (vector). |
---|
[3083] | 291 | !! |
---|
[1793] | 292 | !! See [[mm_methods(module):psatX_sc(function)]]. |
---|
| 293 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! Temperatures (K). |
---|
| 294 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 295 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: res !! Saturation vapor pressures (Pa). |
---|
| 296 | INTEGER :: i |
---|
| 297 | REAL(kind=mm_wp) :: x,qsat |
---|
| 298 | DO i=1, SIZE(temp) |
---|
| 299 | x = 1._mm_wp-temp(i)/xESP%tc |
---|
| 300 | IF (x > 0._mm_wp) THEN |
---|
[3083] | 301 | qsat = (1._mm_wp-x)**(-1) * & |
---|
| 302 | (xESP%a_sat*x + xESP%b_sat*x**1.5_mm_wp + xESP%c_sat*x**2.5_mm_wp + xESP%d_sat*x**5_mm_wp) |
---|
[1793] | 303 | ELSE |
---|
[3083] | 304 | qsat = XESP%a_sat*x/abs(1._mm_wp-x) ! approx for t > tc |
---|
[1793] | 305 | ENDIF |
---|
[3083] | 306 | res(i) = xESP%pc*exp(qsat) |
---|
[1793] | 307 | ENDDO |
---|
[3083] | 308 | ! now convert bar to Pa |
---|
| 309 | res = res * 1e5_mm_wp |
---|
[1793] | 310 | END FUNCTION psatX_ve |
---|
| 311 | |
---|
| 312 | FUNCTION qsatX_sc(temp,pres,xESP) RESULT(res) |
---|
| 313 | !! Get the mass mixing ratio of a given specie at saturation (scalar). |
---|
[3083] | 314 | !! |
---|
| 315 | !! @warning |
---|
[3090] | 316 | !! The method applies a multiplicative factor of 0.80 if the specie is CH4 : |
---|
[3083] | 317 | !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere. |
---|
[1793] | 318 | REAL(kind=mm_wp), INTENT(in) :: temp !! Temperature (K). |
---|
| 319 | REAL(kind=mm_wp), INTENT(in) :: pres !! Pressure level (Pa). |
---|
[3090] | 320 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 321 | REAL(kind=mm_wp) :: res !! Mass mixing ratio of the specie. |
---|
| 322 | REAL(kind=mm_wp) :: psat |
---|
[1793] | 323 | psat = mm_psatX(temp,xESP) |
---|
| 324 | res = (psat / pres) * xESP%fmol2fmas |
---|
[3090] | 325 | ! Peculiar case of CH4 : x0.80 (dissolution in N2) |
---|
[3083] | 326 | IF (xESP%name == "CH4") THEN |
---|
[3090] | 327 | res = res * 0.80_mm_wp |
---|
[3083] | 328 | IF (mm_debug) WRITE(*,'(a)') "[DEBUG] mm_qsat: applying .85 factor to qsat for CH4 specie (N2 dissolution)" |
---|
| 329 | ENDIF |
---|
[1793] | 330 | END FUNCTION qsatX_sc |
---|
| 331 | |
---|
| 332 | FUNCTION qsatX_ve(temp,pres,xESP) RESULT(res) |
---|
| 333 | !! Get the mass mixing ratio of a given specie at saturation (vector). |
---|
[3083] | 334 | !! |
---|
| 335 | !! @warning |
---|
| 336 | !! The method applies a multiplicative factor of 0.85 if the specie is CH4 : |
---|
| 337 | !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere. |
---|
[1793] | 338 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! Temperatures (K). |
---|
| 339 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: pres !! Pressure levels (Pa). |
---|
| 340 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
[3090] | 341 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: res !! Mass mixing ratios of the specie. |
---|
| 342 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: psat |
---|
[1793] | 343 | psat = mm_psatX(temp,xESP) |
---|
| 344 | res = (psat / pres) * xESP%fmol2fmas |
---|
[3090] | 345 | ! Peculiar case of CH4 : x0.80 (dissolution in N2) |
---|
[3083] | 346 | IF (xESP%name == "CH4") THEN |
---|
[3090] | 347 | res = res * 0.80_mm_wp |
---|
[3083] | 348 | IF (mm_debug) WRITE(*,'(a)') "[DEBUG] mm_qsat: applying .85 factor to qsat for CH4 specie (N2 dissolution)" |
---|
| 349 | ENDIF |
---|
[1793] | 350 | END FUNCTION qsatX_ve |
---|
| 351 | |
---|
[3083] | 352 | FUNCTION ysatX_sc(temp,pres,xESP) RESULT(res) |
---|
| 353 | !! Get the molar mixing ratio of a given specie at saturation (scalar). |
---|
[3090] | 354 | !! Compute saturation profiles (mol/mol) for condensable tracers |
---|
[3083] | 355 | !! |
---|
| 356 | !! @warning |
---|
[3090] | 357 | !! The method applies a multiplicative factor of 0.80 if the specie is CH4 : |
---|
[3083] | 358 | !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere. |
---|
| 359 | REAL(kind=mm_wp), INTENT(in) :: temp !! Temperature (K). |
---|
| 360 | REAL(kind=mm_wp), INTENT(in) :: pres !! Pressure level (Pa). |
---|
| 361 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 362 | REAL(kind=mm_wp) :: res !! Molar mixing ratio of the specie. |
---|
| 363 | |
---|
| 364 | IF(xESP%name == "C2H2") THEN |
---|
[3090] | 365 | ! Fray and Schmidt (2009) |
---|
[3083] | 366 | res = (1.0e5 / pres) * exp(1.340e1 - 2.536e3/temp) |
---|
| 367 | |
---|
| 368 | ELSE IF(xESP%name == "C2H6") THEN |
---|
[3090] | 369 | ! Fray and Schmidt (2009) |
---|
[3083] | 370 | res = (1.0e5 / pres) * exp(1.511e1 - 2.207e3/temp - 2.411e4/temp**2 + 7.744e5/temp**3 - 1.161e7/temp**4 + 6.763e7/temp**5) |
---|
| 371 | |
---|
| 372 | ELSE IF(xESP%name == "HCN") THEN |
---|
[3090] | 373 | ! Fray and Schmidt (2009) |
---|
[3083] | 374 | res = (1.0e5 / pres) * exp(1.393e1 - 3.624e3/temp - 1.325e5/temp**2 + 6.314e6/temp**3 - 1.128e8/temp**4) |
---|
| 375 | |
---|
| 376 | ELSE IF (xESP%name == "CH4") THEN |
---|
[3090] | 377 | ! Fray and Schmidt (2009) |
---|
[3083] | 378 | res = (1.0e5 / pres) * exp(1.051e1 - 1.110e3/temp - 4.341e3/temp**2 + 1.035e5/temp**3 - 7.910e5/temp**4) |
---|
[3090] | 379 | ! Peculiar case of CH4 : x0.80 (dissolution in N2) |
---|
| 380 | res = res * 0.80_mm_wp |
---|
| 381 | ! Forcing CH4 to 1.4% minimum |
---|
| 382 | IF (res < 0.014) THEN |
---|
| 383 | res = 0.014 |
---|
| 384 | ENDIF |
---|
[3083] | 385 | ENDIF |
---|
| 386 | END FUNCTION ysatX_sc |
---|
| 387 | |
---|
| 388 | FUNCTION ysatX_ve(temp,pres,xESP) RESULT(res) |
---|
| 389 | !! Get the molar mixing ratio of a given specie at saturation (vector). |
---|
[3090] | 390 | !! Compute saturation profiles (mol/mol) for condensable tracers |
---|
[3083] | 391 | !! |
---|
| 392 | !! @warning |
---|
[3090] | 393 | !! The method applies a multiplicative factor of 0.80 if the specie is CH4 : |
---|
[3083] | 394 | !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere. |
---|
| 395 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! Temperatures (K). |
---|
| 396 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: pres !! Pressure levels (Pa). |
---|
| 397 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
---|
| 398 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: res !! Molar mixing ratios of the specie. |
---|
| 399 | |
---|
| 400 | IF(xESP%name == "C2H2") THEN |
---|
[3090] | 401 | ! Fray and Schmidt (2009) |
---|
[3083] | 402 | res = (1.0e5 / pres) * exp(1.340e1 - 2.536e3/temp) |
---|
| 403 | |
---|
| 404 | ELSE IF(xESP%name == "C2H6") THEN |
---|
[3090] | 405 | ! Fray and Schmidt (2009) |
---|
[3083] | 406 | res = (1.0e5 / pres) * exp(1.511e1 - 2.207e3/temp - 2.411e4/temp**2 + 7.744e5/temp**3 - 1.161e7/temp**4 + 6.763e7/temp**5) |
---|
| 407 | |
---|
| 408 | ELSE IF(xESP%name == "HCN") THEN |
---|
[3090] | 409 | ! Fray and Schmidt (2009) |
---|
[3083] | 410 | res = (1.0e5 / pres) * exp(1.393e1 - 3.624e3/temp - 1.325e5/temp**2 + 6.314e6/temp**3 - 1.128e8/temp**4) |
---|
| 411 | |
---|
| 412 | ! Peculiar case : CH4 : x0.85 (dissolution in N2) |
---|
| 413 | ELSE IF (xESP%name == "CH4") THEN |
---|
| 414 | res = (1.0e5 / pres) * exp(1.051e1 - 1.110e3/temp - 4.341e3/temp**2 + 1.035e5/temp**3 - 7.910e5/temp**4) |
---|
[3090] | 415 | ! Peculiar case of CH4 : x0.80 (dissolution in N2) |
---|
| 416 | res = res * 0.80_mm_wp |
---|
| 417 | ! Forcing CH4 to 1.4% minimum |
---|
| 418 | WHERE (res(:) < 0.014) res(:) = 0.014 |
---|
[3083] | 419 | ENDIF |
---|
| 420 | END FUNCTION ysatX_ve |
---|
| 421 | |
---|
[1793] | 422 | ELEMENTAL FUNCTION mm_get_kco(t) RESULT(res) |
---|
| 423 | !! Get the Continuous regime thermodynamics pre-factor of the coagulation kernel. |
---|
| 424 | REAL(kind=mm_wp), INTENT(in) :: t !! Temperature (K). |
---|
| 425 | REAL(kind=mm_wp) :: res !! Continuous regime thermodynamics pre-factor (\(m^{3}.s^{-1}\)). |
---|
| 426 | res = 2._mm_wp*mm_kboltz*t / (3._mm_wp*mm_eta_g(t)) |
---|
| 427 | RETURN |
---|
| 428 | END FUNCTION mm_get_kco |
---|
| 429 | |
---|
| 430 | ELEMENTAL FUNCTION mm_get_kfm(t) RESULT(res) |
---|
| 431 | !! Get the Free Molecular regime thermodynamics pre-factor of the coagulation kernel. |
---|
| 432 | REAL(kind=mm_wp), INTENT(in) :: t !! Temperature (K). |
---|
| 433 | REAL(kind=mm_wp) :: res !! Free Molecular regime thermodynamics pre-factor (\(m^{5/2}.s^{-1}\)). |
---|
| 434 | res = (6._mm_wp*mm_kboltz*t/mm_rhoaer)**(0.5_mm_wp) |
---|
| 435 | RETURN |
---|
| 436 | END FUNCTION mm_get_kfm |
---|
| 437 | |
---|
| 438 | ! ELEMENTAL FUNCTION mm_eta_g(t) RESULT (res) |
---|
| 439 | ! !! Get the air viscosity at a given temperature. |
---|
| 440 | ! !! |
---|
| 441 | ! !! The function computes the air viscosity at temperature __t__ using Sutherland method. |
---|
| 442 | ! REAL(kind=mm_wp), INTENT(in) :: t !! Temperature (K). |
---|
| 443 | ! REAL(kind=mm_wp) :: res !! Air viscosity at given temperature (\(Pa.s^{-1}\)). |
---|
| 444 | ! REAL (kind=mm_wp), PARAMETER :: eta0 = 1.75e-5_mm_wp, & |
---|
| 445 | ! tsut = 109._mm_wp, & |
---|
| 446 | ! tref = 293._mm_wp |
---|
| 447 | ! res = eta0 *dsqrt(t/tref)*(1._mm_wp+tsut/tref)/(1._mm_wp+tsut/t) |
---|
| 448 | ! RETURN |
---|
| 449 | ! END FUNCTION mm_eta_g |
---|
| 450 | ! |
---|
| 451 | ! ELEMENTAL FUNCTION mm_lambda_g(t,p) RESULT(res) |
---|
| 452 | ! !! Get the air mean free path at given temperature and pressure. |
---|
| 453 | ! !! |
---|
| 454 | ! !! The method computes the air mean free path: |
---|
| 455 | ! !! |
---|
| 456 | ! !! $$ \lambda_{g} = \dfrac{k_{b}T}{4\sqrt{2}\pi r_{a}^2 P} $$ |
---|
| 457 | ! !! |
---|
| 458 | ! !! Where \(\lambda_{g}\), is the air mean free path, \(k_{b}\) the Boltzmann constant, T the |
---|
| 459 | ! !! temperature, P the pressure level and \(r_{a}\) the radius of an _air molecule_. |
---|
| 460 | ! REAL(kind=mm_wp), INTENT(in) :: t !! Temperature (K). |
---|
| 461 | ! REAL(kind=mm_wp), INTENT(in) :: p !! Pressure level (Pa). |
---|
| 462 | ! REAL(kind=mm_wp) :: res !! Air mean free path (m). |
---|
| 463 | ! res = mm_kboltz*t/(4._mm_wp*dsqrt(2._mm_wp)*mm_pi*(mm_air_rad**2)*p) |
---|
| 464 | ! RETURN |
---|
| 465 | ! END FUNCTION mm_lambda_g |
---|
| 466 | |
---|
| 467 | END MODULE MM_METHODS |
---|