| 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) |
|---|
| 3 | ! email of the author : jeremie.burgalat@univ-reims.fr |
|---|
| 4 | ! |
|---|
| 5 | ! This software is a computer program whose purpose is to compute |
|---|
| 6 | ! microphysics processes using a two-moments scheme. |
|---|
| 7 | ! |
|---|
| 8 | ! This library is governed by the CeCILL-B license under French law and |
|---|
| 9 | ! abiding by the rules of distribution of free software. You can use, |
|---|
| 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 |
|---|
| 12 | ! "http://www.cecill.info". |
|---|
| 13 | ! |
|---|
| 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 |
|---|
| 18 | ! liability. |
|---|
| 19 | ! |
|---|
| 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 |
|---|
| 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 | ! |
|---|
| 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 |
|---|
| 37 | !! date: 2013-2015,2017,2022-2023 |
|---|
| 38 | !! modifications: B. de Batz de Trenquelléon |
|---|
| 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)]], |
|---|
| 46 | !! [[mm_methods(module):mm_sigX(interface)]] and [[mm_methods(module):mm_psatX(interface)]]) compute related equations |
|---|
| 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 | !! |
|---|
| 51 | !! | name | description |
|---|
| 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 | |
|---|
| 67 | PRIVATE |
|---|
| 68 | |
|---|
| 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 |
|---|
| 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 | !! ``` |
|---|
| 81 | !! |
|---|
| 82 | !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method |
|---|
| 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 |
|---|
| 86 | END INTERFACE mm_sigX |
|---|
| 87 | |
|---|
| 88 | !> Interface to Latent heat computation functions. |
|---|
| 89 | !! |
|---|
| 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 | !! |
|---|
| 96 | !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method |
|---|
| 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 |
|---|
| 100 | END INTERFACE mm_LheatX |
|---|
| 101 | |
|---|
| 102 | !> Interface to saturation vapor pressure computation functions. |
|---|
| 103 | !! |
|---|
| 104 | !! ```fortran |
|---|
| 105 | !! FUNCTION mm_psatX(temp,xESP) |
|---|
| 106 | !! ``` |
|---|
| 107 | !! |
|---|
| 108 | !! The method computes the saturation vapor pressure of a given specie at given temperature(s). |
|---|
| 109 | !! |
|---|
| 110 | !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method |
|---|
| 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 |
|---|
| 114 | END INTERFACE mm_psatX |
|---|
| 115 | |
|---|
| 116 | !> Interface to saturation mass mixing ratio computation functions. |
|---|
| 117 | !! |
|---|
| 118 | !! The method computes the mass mixing ratio at saturation of a given specie at given temperature(s) |
|---|
| 119 | !! and pressure level(s). |
|---|
| 120 | !! |
|---|
| 121 | !! ```fortran |
|---|
| 122 | !! FUNCTION mm_qsatX(temp,pres,xESP) |
|---|
| 123 | !! ``` |
|---|
| 124 | !! |
|---|
| 125 | !! __xESP__ must always be given as a scalar. If __temp__ and __pres__ are given as a vector (of same |
|---|
| 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 |
|---|
| 130 | END INTERFACE mm_qsatx |
|---|
| 131 | |
|---|
| 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) |
|---|
| 135 | !! and pressure level(s). |
|---|
| 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 | |
|---|
| 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 | !! |
|---|
| 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 |
|---|
| 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 |
|---|
| 161 | END INTERFACE mm_fshape |
|---|
| 162 | |
|---|
| 163 | CONTAINS |
|---|
| 164 | |
|---|
| 165 | FUNCTION fshape_sc(cost,rap) RESULT(res) |
|---|
| 166 | !! Get the shape factor of a ccn (scalar). |
|---|
| 167 | !! |
|---|
| 168 | !! The method computes the shape factor for the heterogeneous nucleation on a fractal particle. |
|---|
| 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 |
|---|
| 179 | b = (rap**3) * (2._mm_wp - 3._mm_wp*(rap-cost)/phi + ((rap-cost)/phi)**3) |
|---|
| 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 |
|---|
| 196 | ELSEWHERE |
|---|
| 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 |
|---|
| 211 | ! - DUMMY |
|---|
| 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 |
|---|
| 216 | ftm=MAX(1._mm_wp-temp/xESP%tc,1.e-3_mm_wp) |
|---|
| 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 |
|---|
| 219 | |
|---|
| 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}\)). |
|---|
| 227 | REAL(kind=mm_wp) :: ftm |
|---|
| 228 | INTEGER :: i |
|---|
| 229 | DO i=1,SIZE(temp) |
|---|
| 230 | ftm=MAX(1._mm_wp-temp(i)/xESP%tc,1.e-3_mm_wp) |
|---|
| 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) / & |
|---|
| 232 | xESP%masmol |
|---|
| 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). |
|---|
| 238 | !! |
|---|
| 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) |
|---|
| 248 | res = sig*1e-3_mm_wp ! dyn/cm -> N/m |
|---|
| 249 | END FUNCTION sigX_sc |
|---|
| 250 | |
|---|
| 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 |
|---|
| 259 | REAL(kind=mm_wp) :: tr,tbr,sig0,sig |
|---|
| 260 | tbr = xESP%tb/xESP%tc |
|---|
| 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 |
|---|
| 262 | DO i=1,SIZE(temp) |
|---|
| 263 | tr = MIN(temp(i)/xESP%tc,0.99_mm_wp) |
|---|
| 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 |
|---|
| 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). |
|---|
| 271 | !! |
|---|
| 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) * & |
|---|
| 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) |
|---|
| 281 | ELSE |
|---|
| 282 | qsat = XESP%a_sat*x/abs(1._mm_wp-x) ! approx for t > tc |
|---|
| 283 | ENDIF |
|---|
| 284 | res = xESP%pc*exp(qsat) |
|---|
| 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). |
|---|
| 291 | !! |
|---|
| 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 |
|---|
| 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) |
|---|
| 303 | ELSE |
|---|
| 304 | qsat = XESP%a_sat*x/abs(1._mm_wp-x) ! approx for t > tc |
|---|
| 305 | ENDIF |
|---|
| 306 | res(i) = xESP%pc*exp(qsat) |
|---|
| 307 | ENDDO |
|---|
| 308 | ! now convert bar to Pa |
|---|
| 309 | res = res * 1e5_mm_wp |
|---|
| 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). |
|---|
| 314 | !! |
|---|
| 315 | !! @warning |
|---|
| 316 | !! The method applies a multiplicative factor of 0.80 if the specie is CH4 : |
|---|
| 317 | !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere. |
|---|
| 318 | REAL(kind=mm_wp), INTENT(in) :: temp !! Temperature (K). |
|---|
| 319 | REAL(kind=mm_wp), INTENT(in) :: pres !! Pressure level (Pa). |
|---|
| 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 |
|---|
| 323 | psat = mm_psatX(temp,xESP) |
|---|
| 324 | res = (psat / pres) * xESP%fmol2fmas |
|---|
| 325 | ! Peculiar case of CH4 : x0.80 (dissolution in N2) |
|---|
| 326 | IF (xESP%name == "CH4") THEN |
|---|
| 327 | res = res * 0.80_mm_wp |
|---|
| 328 | IF (mm_debug) WRITE(*,'(a)') "[DEBUG] mm_qsat: applying .85 factor to qsat for CH4 specie (N2 dissolution)" |
|---|
| 329 | ENDIF |
|---|
| 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). |
|---|
| 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. |
|---|
| 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. |
|---|
| 341 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: res !! Mass mixing ratios of the specie. |
|---|
| 342 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: psat |
|---|
| 343 | psat = mm_psatX(temp,xESP) |
|---|
| 344 | res = (psat / pres) * xESP%fmol2fmas |
|---|
| 345 | ! Peculiar case of CH4 : x0.80 (dissolution in N2) |
|---|
| 346 | IF (xESP%name == "CH4") THEN |
|---|
| 347 | res = res * 0.80_mm_wp |
|---|
| 348 | IF (mm_debug) WRITE(*,'(a)') "[DEBUG] mm_qsat: applying .85 factor to qsat for CH4 specie (N2 dissolution)" |
|---|
| 349 | ENDIF |
|---|
| 350 | END FUNCTION qsatX_ve |
|---|
| 351 | |
|---|
| 352 | FUNCTION ysatX_sc(temp,pres,xESP) RESULT(res) |
|---|
| 353 | !! Get the molar mixing ratio of a given specie at saturation (scalar). |
|---|
| 354 | !! Compute saturation profiles (mol/mol) for condensable tracers |
|---|
| 355 | !! |
|---|
| 356 | !! @warning |
|---|
| 357 | !! The method applies a multiplicative factor of 0.80 if the specie is CH4 : |
|---|
| 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 |
|---|
| 365 | ! Fray and Schmidt (2009) |
|---|
| 366 | res = (1.0e5 / pres) * exp(1.340e1 - 2.536e3/temp) |
|---|
| 367 | |
|---|
| 368 | ELSE IF(xESP%name == "C2H6") THEN |
|---|
| 369 | ! Fray and Schmidt (2009) |
|---|
| 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 == "AC6H6") THEN |
|---|
| 373 | ! Fray and Schmidt (2009) |
|---|
| 374 | res = (1.0e5 / pres) * exp(1.735e1 - 5.663e3/temp) |
|---|
| 375 | |
|---|
| 376 | ELSE IF(xESP%name == "HCN") THEN |
|---|
| 377 | ! Fray and Schmidt (2009) |
|---|
| 378 | res = (1.0e5 / pres) * exp(1.393e1 - 3.624e3/temp - 1.325e5/temp**2 + 6.314e6/temp**3 - 1.128e8/temp**4) |
|---|
| 379 | |
|---|
| 380 | ELSE IF (xESP%name == "CH4") THEN |
|---|
| 381 | ! Fray and Schmidt (2009) |
|---|
| 382 | res = (1.0e5 / pres) * exp(1.051e1 - 1.110e3/temp - 4.341e3/temp**2 + 1.035e5/temp**3 - 7.910e5/temp**4) |
|---|
| 383 | ! Peculiar case of CH4 : x0.80 (dissolution in N2) |
|---|
| 384 | res = res * 0.80_mm_wp |
|---|
| 385 | ! Forcing CH4 to 1.4% minimum |
|---|
| 386 | IF (res < 0.014) THEN |
|---|
| 387 | res = 0.014 |
|---|
| 388 | ENDIF |
|---|
| 389 | ENDIF |
|---|
| 390 | END FUNCTION ysatX_sc |
|---|
| 391 | |
|---|
| 392 | FUNCTION ysatX_ve(temp,pres,xESP) RESULT(res) |
|---|
| 393 | !! Get the molar mixing ratio of a given specie at saturation (vector). |
|---|
| 394 | !! Compute saturation profiles (mol/mol) for condensable tracers |
|---|
| 395 | !! |
|---|
| 396 | !! @warning |
|---|
| 397 | !! The method applies a multiplicative factor of 0.80 if the specie is CH4 : |
|---|
| 398 | !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere. |
|---|
| 399 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! Temperatures (K). |
|---|
| 400 | REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: pres !! Pressure levels (Pa). |
|---|
| 401 | TYPE(mm_esp), INTENT(in) :: xESP !! Specie properties. |
|---|
| 402 | REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: res !! Molar mixing ratios of the specie. |
|---|
| 403 | |
|---|
| 404 | IF(xESP%name == "C2H2") THEN |
|---|
| 405 | ! Fray and Schmidt (2009) |
|---|
| 406 | res = (1.0e5 / pres) * exp(1.340e1 - 2.536e3/temp) |
|---|
| 407 | |
|---|
| 408 | ELSE IF(xESP%name == "C2H6") THEN |
|---|
| 409 | ! Fray and Schmidt (2009) |
|---|
| 410 | 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) |
|---|
| 411 | |
|---|
| 412 | ELSE IF(xESP%name == "AC6H6") THEN |
|---|
| 413 | ! Fray and Schmidt (2009) |
|---|
| 414 | res = (1.0e5 / pres) * exp(1.735e1 - 5.663e3/temp) |
|---|
| 415 | |
|---|
| 416 | ELSE IF(xESP%name == "HCN") THEN |
|---|
| 417 | ! Fray and Schmidt (2009) |
|---|
| 418 | res = (1.0e5 / pres) * exp(1.393e1 - 3.624e3/temp - 1.325e5/temp**2 + 6.314e6/temp**3 - 1.128e8/temp**4) |
|---|
| 419 | |
|---|
| 420 | ! Peculiar case : CH4 : x0.85 (dissolution in N2) |
|---|
| 421 | ELSE IF (xESP%name == "CH4") THEN |
|---|
| 422 | res = (1.0e5 / pres) * exp(1.051e1 - 1.110e3/temp - 4.341e3/temp**2 + 1.035e5/temp**3 - 7.910e5/temp**4) |
|---|
| 423 | ! Peculiar case of CH4 : x0.80 (dissolution in N2) |
|---|
| 424 | res = res * 0.80_mm_wp |
|---|
| 425 | ! Forcing CH4 to 1.4% minimum |
|---|
| 426 | WHERE (res(:) < 0.014) res(:) = 0.014 |
|---|
| 427 | ENDIF |
|---|
| 428 | END FUNCTION ysatX_ve |
|---|
| 429 | |
|---|
| 430 | ELEMENTAL FUNCTION mm_get_kco(t) RESULT(res) |
|---|
| 431 | !! Get the Continuous regime thermodynamics pre-factor of the coagulation kernel. |
|---|
| 432 | REAL(kind=mm_wp), INTENT(in) :: t !! Temperature (K). |
|---|
| 433 | REAL(kind=mm_wp) :: res !! Continuous regime thermodynamics pre-factor (\(m^{3}.s^{-1}\)). |
|---|
| 434 | res = 2._mm_wp*mm_kboltz*t / (3._mm_wp*mm_eta_g(t)) |
|---|
| 435 | RETURN |
|---|
| 436 | END FUNCTION mm_get_kco |
|---|
| 437 | |
|---|
| 438 | ELEMENTAL FUNCTION mm_get_kfm(t) RESULT(res) |
|---|
| 439 | !! Get the Free Molecular regime thermodynamics pre-factor of the coagulation kernel. |
|---|
| 440 | REAL(kind=mm_wp), INTENT(in) :: t !! Temperature (K). |
|---|
| 441 | REAL(kind=mm_wp) :: res !! Free Molecular regime thermodynamics pre-factor (\(m^{5/2}.s^{-1}\)). |
|---|
| 442 | res = (6._mm_wp*mm_kboltz*t/mm_rhoaer)**(0.5_mm_wp) |
|---|
| 443 | RETURN |
|---|
| 444 | END FUNCTION mm_get_kfm |
|---|
| 445 | |
|---|
| 446 | ! ELEMENTAL FUNCTION mm_eta_g(t) RESULT (res) |
|---|
| 447 | ! !! Get the air viscosity at a given temperature. |
|---|
| 448 | ! !! |
|---|
| 449 | ! !! The function computes the air viscosity at temperature __t__ using Sutherland method. |
|---|
| 450 | ! REAL(kind=mm_wp), INTENT(in) :: t !! Temperature (K). |
|---|
| 451 | ! REAL(kind=mm_wp) :: res !! Air viscosity at given temperature (\(Pa.s^{-1}\)). |
|---|
| 452 | ! REAL (kind=mm_wp), PARAMETER :: eta0 = 1.75e-5_mm_wp, & |
|---|
| 453 | ! tsut = 109._mm_wp, & |
|---|
| 454 | ! tref = 293._mm_wp |
|---|
| 455 | ! res = eta0 *dsqrt(t/tref)*(1._mm_wp+tsut/tref)/(1._mm_wp+tsut/t) |
|---|
| 456 | ! RETURN |
|---|
| 457 | ! END FUNCTION mm_eta_g |
|---|
| 458 | ! |
|---|
| 459 | ! ELEMENTAL FUNCTION mm_lambda_g(t,p) RESULT(res) |
|---|
| 460 | ! !! Get the air mean free path at given temperature and pressure. |
|---|
| 461 | ! !! |
|---|
| 462 | ! !! The method computes the air mean free path: |
|---|
| 463 | ! !! |
|---|
| 464 | ! !! $$ \lambda_{g} = \dfrac{k_{b}T}{4\sqrt{2}\pi r_{a}^2 P} $$ |
|---|
| 465 | ! !! |
|---|
| 466 | ! !! Where \(\lambda_{g}\), is the air mean free path, \(k_{b}\) the Boltzmann constant, T the |
|---|
| 467 | ! !! temperature, P the pressure level and \(r_{a}\) the radius of an _air molecule_. |
|---|
| 468 | ! REAL(kind=mm_wp), INTENT(in) :: t !! Temperature (K). |
|---|
| 469 | ! REAL(kind=mm_wp), INTENT(in) :: p !! Pressure level (Pa). |
|---|
| 470 | ! REAL(kind=mm_wp) :: res !! Air mean free path (m). |
|---|
| 471 | ! res = mm_kboltz*t/(4._mm_wp*dsqrt(2._mm_wp)*mm_pi*(mm_air_rad**2)*p) |
|---|
| 472 | ! RETURN |
|---|
| 473 | ! END FUNCTION mm_lambda_g |
|---|
| 474 | |
|---|
| 475 | END MODULE MM_METHODS |
|---|