source: trunk/LMDZ.TITAN/libf/muphytitan/mm_methods.f90 @ 3094

Last change on this file since 3094 was 3090, checked in by slebonnois, 15 months ago

BdeBatz? : Cleans microphysics and makes few corrections for physics

File size: 20.7 KB
RevLine 
[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
40MODULE 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]163CONTAINS
[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
467END MODULE MM_METHODS
Note: See TracBrowser for help on using the repository browser.