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

Last change on this file since 3496 was 3496, checked in by debatzbr, 2 weeks ago

Final clean and debug for the microphysical model

File size: 20.9 KB
Line 
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
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)]],
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
163CONTAINS
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
475END MODULE MM_METHODS
Note: See TracBrowser for help on using the repository browser.