source: trunk/LMDZ.TITAN/libf/muphytitan/mm_globals.f90 @ 3026

Last change on this file since 3026 was 2242, checked in by jvatant, 5 years ago

+ Update the interface with YAMMS so it now correctly handles the small values of the moments,
requiring dynamics to have a threshold quite low (set to 1D-200) and a sanity check in calmufi
corresponding to this value. Thus it removes 'most' of the unphysical radius obtained in
YAMMS. There are still some, but at least there is no more problem of model stability for the moments
and the code can run.
Still, take care the day you want to calculate opacities from the radii and not the moments.
Although, note that there are some negative values, in the output files, but theses negatives are

harmless, as they are only present in output files, dynamics reseting to epsilon after.

+ Given theses pbs with the radii, also update the optics so that it computes the opacities in
a simpler way, directly for M3, through look-up tables, M3 being a good proxy.
--JVO

File size: 67.1 KB
Line 
1! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
2! Contributor: J. Burgalat (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_globals.f90
35!! summary: Parameters and global variables module.
36!! author: J. Burgalat
37!! date: 2013-2015,2017
38
39MODULE MM_GLOBALS
40  !! Parameters and global variables module.
41  !! 
42  !! # Module overview
43  !!
44  !! The module defines all the parameters and global variables that are common
45  !! to all other modules of the library.
46  !!
47  !! It is separated in two parts :
48  !!
49  !! - Main parameters and global saved variables. Most of these variables should
50  !!   be initialized once and should hold the same value during run-time. These
51  !!   variables are completly public and initialized by [[mm_globals(module):mm_global_init(interface)]]
52  !!   method.
53  !! - The second part defines a set of vectors that defines the vertical structure of the atmosphere.
54  !!   Each time a new atmospheric column has to be computed (either on a new timestep or on a new couple
55  !!   of longitude/latitude), these vectors should be intialized with new values by calling
56  !!   [[mm_globals(module):mm_column_init(function)]] method.
57  !!   This part is separated in two sets :
58  !!
59  !!   - The atmospheric structure with temperature, pressure levels and altitude definitions.
60  !!   - The vertical profiles of tracers with the moments of the two aerosols modes (both \(M_{0}\)
61  !!     and \(M_{3}\) for a total of 4 vectors), the _clouds_ microphysics moments tracers (i.e.
62  !!     \(M_{0}\) and \(M_{3}\) for the ccn and \(M_{3}\) for the ice components).
63  !!     Additionally, the module also stores intermediates variables of interest such as the
64  !!     characteristic radii of the aerosols modes, the mean drop radius and the drop density,
65  !!     the molar fraction of each condensible species (related to ice components) and some
66  !!     scalar variables that holds arrays sizes.
67  !!
68  !! @note
69  !! All the vectors that represent the vertical structure of the atmosphere (altitude, pressure and
70  !! temperature...) are oriented from the __TOP__ of the atmosphere to the __GROUND__.
71  !!
72  !! @note
73  !! The module also imports errors module from __FCCP__ library to get definitions of the error object
74  !! everywhere in the library ([[mm_globals(module)]] is always imported, except in [[mm_mprec(module)]]).
75  !!
76  !! # Global variables
77  !!
78  !! [[mm_globals(module)]] module contains the declaration of all global/common variable that are shared
79  !! by all other modules of the model. Except for few physical constant which are declared as parameters,
80  !! these variables are onlu SAVEd. They are initialized by [[mm_globals(module):mm_global_init(interface)]]
81  !! methods.
82  !! the following sections list all the global variables by category.
83  !!
84  !! ## Control flags
85  !!
86  !! | Name               | Description
87  !! | :----------------- | :-----------------
88  !! | mm_log             | Enable log mode (verbose)
89  !! | mm_w_haze_prod     | Enable/Disable haze production
90  !! | mm_w_haze_sed      | Enable/Disable haze sedimentation
91  !! | mm_w_haze_coag     | Enable/Disable haze coagulation
92  !! | mm_w_clouds        | Enable/Disable clouds microphysics
93  !! | mm_w_clouds_sed    | Enable/Disable clouds microphysics sedimentation
94  !! | mm_w_clouds_nucond | Enable/Disable clouds microphysics nucleation/condensation
95  !! | mm_wsed_m0         | Force all aerosols moments to fall at M0 settling velocity
96  !! | mm_wsed_m3         | Force all aerosols moments to fall at M3 settling velocity
97  !! | mm_no_fiadero_w    | Enable/Disable __Fiadero__ correction
98  !!
99  !! ### Related free parameters:
100  !!
101  !! | Name            | Description
102  !! | :-------------- | :-----------------
103  !! | mm_fiadero_min  | Minimum ratio for __Fiadero__'s correction
104  !! | mm_fiadero_max  | Maximum ratio for __Fiadero__'s correction
105  !! | mm_coag_choice  | Coagulation interaction activation flag. It should be a combination of [[mm_globals(module):mm_coag_no(variable)]], [[mm_globals(module):mm_coag_ss(variable)]], [[mm_globals(module):mm_coag_sf(variable)]] and [[mm_globals(module):mm_coag_ff(variable)]].
106  !!
107  !! ## Physical constants
108  !!
109  !! | Name      | Description
110  !! | :-------- | :-----------------
111  !! | mm_pi     | Pi number
112  !! | mm_navo   | Avogadro number
113  !! | mm_kboltz | Boltzmann constant (\(J.K^{-1}\))
114  !! | mm_rgas   | Perfect gas constant (\(J.mol^{-1}.K^{-1}\))
115  !! | mm_fdes   | Desorption energy (\(J\)) (nucleation)
116  !! | mm_fdif   | Surface diffusion energy (\(J\)) (nucleation)
117  !! | mm_fnus   | Jump frequency (\(s^{-1}\)) (nucleation)
118  !! | mm_akn    | Approximated slip-flow correction coefficient (
119  !!
120  !! ## Free parameters
121  !!
122  !! | Name        | Description
123  !! | :---------- | :-----------------
124  !! | mm_rhoaer   | Aerosol density (in \(kg.m^{-3}\))
125  !! | mm_df       | Fractal dimension
126  !! | mm_rm       | Monomer radius (in m)
127  !! | mm_p_prod   | Spherical aerosols production pressure level (Pa)
128  !! | mm_p_rcprod | Spherical aerosols equivalent radius production (m)
129  !! | mm_tx_prod  | Production rate of spherical aerosols (\(kg.m^{-2}.s^{-1}\))
130  !! | mm_d_prod   | Time-dependent sine wve pre-factor.
131  !! | mm_w_prod   | Angular frequency of the time-dependent production rate.
132  !! | mm_ne       | Electric charging of aerosols (\(e^{-}.m^{-1}\)) (unused)
133  !! | mm_rb2ra    | Bulk to apparent radius conversion pre-factor (\(m^X\))
134  !! | mm_rpla     | Planet radius (m)
135  !! | mm_g0       | Planet acceleration due to gravity constant (ground) (\(m.s^{-2}\))
136  !! | mm_air_rad  | Air molecules mean radius (m)
137  !! | mm_air_mmol | Air molecules molar mass (\(kg.mol^{-1}\))
138  !! | mm_dt       | Microphysic time step (s)
139  USE MM_MPREC
140  USE MM_INTERFACES
141  ! from swift
142  USE CFGPARSE
143  USE STRING_OP
144  USE ERRORS
145  IMPLICIT NONE
146
147  PUBLIC
148
149  PRIVATE :: cldprop_sc,cldprop_ve,read_esp,check_r1,check_i1,check_l1,check_s1
150
151  ! Protected variables
152  ! the following variables are read-only outside this module.
153  ! One must call the afferent subroutine to update them.
154   
155  ! initialization control flags (cannot be updated)
156  PROTECTED :: mm_ini,mm_ini_col,mm_ini_aer,mm_ini_cld
157  ! model parameters (mm_global_init)
158  PROTECTED :: mm_dt,mm_rhoaer,mm_df,mm_rm,mm_p_prod,mm_rc_prod,mm_tx_prod,mm_rpla,mm_g0,mm_rb2ra
159  ! atmospheric vertical structure (mm_column_init)
160  PROTECTED :: mm_nla,mm_nle,mm_zlay,mm_zlev,mm_play,mm_plev,mm_temp,mm_rhoair,mm_btemp,mm_dzlev,mm_dzlay
161  ! Condensible species parameters (mm_global_init)
162  PROTECTED :: mm_nesp,mm_spcname,mm_xESPS
163  ! Moments parameters (mm_aerosols_init / mm_clouds_init)
164  PROTECTED :: mm_m0aer_s, mm_m3aer_s, mm_m0aer_f, mm_m3aer_f, mm_m0ccn, mm_m3ccn, mm_m3ice
165  ! Moments parameters (derived, are updated with moments parameters)
166  PROTECTED :: mm_rcs, mm_rcf, mm_drad, mm_drho
167
168  LOGICAL, SAVE :: mm_debug = .true.  !! Enable QnD debug mode (can be used for devel).
169  LOGICAL, SAVE :: mm_log = .false.   !! Enable log mode (for configuration only).
170
171  LOGICAL, SAVE :: mm_w_haze_prod = .true. !! Enable/Disable haze production.
172  LOGICAL, SAVE :: mm_w_haze_sed = .true.  !! Enable/Disable haze sedimentation.
173  LOGICAL, SAVE :: mm_w_haze_coag = .true. !! Activate haze coagulation.
174
175  LOGICAL, SAVE :: mm_wsed_m0 = .false. !! Force all aerosols moments to fall at M0 settling velocity.
176  LOGICAL, SAVE :: mm_wsed_m3 = .false. !! Force all aerosols moments to fall at M3 settling velocity.
177
178  LOGICAL, SAVE :: mm_var_prod = .false. !! Time variation of production rate control flag.
179
180  LOGICAL, SAVE :: mm_use_effg = .true. !! Enable/Disable effective G for computations.
181
182  !> Enable/Disable __Fiadero__'s correction.
183  !!
184  !! This flag enables/disables the __Fiadero__ correction alogrithm for fractal mode settling velocity
185  !! computation.
186  !!
187  !! @bug
188  !! Currently, the Fiadero correction creates instatibilities on the vertical structure. It seems to be
189  !! related to the coupling between the two moments. In order to reduce the instabilities, settling
190  !! velocity of moments are forced to be the same, see [[mm_globals(module):mm_wsed_m0(variable)]] and
191  !! [[mm_globals(module):mm_wsed_m3(variable)]]).
192  LOGICAL, SAVE          :: mm_no_fiadero_w = .false.
193
194  !> Minimum ratio for __Fiadero__ correction.
195  !!
196  !! When [[mm_globals(module):mm_no_fiadero_w(variable)]] is disabled, this variable defines the minimum
197  !! value of the moment's ratio between two adjacents vertical cells to be used within the correction.
198  REAL(kind=mm_wp), SAVE :: mm_fiadero_min  = 0.1_mm_wp
199
200  !> Maximum ratio for __Fiadero__ correction.
201  !!
202  !! When [[mm_globals(module):mm_no_fiadero_w(variable)]] is disabled, this variable defines the maximum
203  !! value of the moment's ratio between two adjacents vertical cells to be used within the correction.
204  REAL(kind=mm_wp), SAVE :: mm_fiadero_max  = 10._mm_wp
205
206  LOGICAL, SAVE :: mm_w_clouds = .true.       !! Enable/Disable clouds microphysics.
207  LOGICAL, SAVE :: mm_w_cloud_sed = .true.    !! Enable/Disable cloud sedimentation.
208  LOGICAL, SAVE :: mm_w_cloud_nucond = .true. !! Activate cloud nucleation/condensation.
209
210  INTEGER, PARAMETER :: mm_coag_no = 0 !! no mode interaction for coagulation (i.e. no coagulation at all).
211  INTEGER, PARAMETER :: mm_coag_ss = 1 !! SS mode interaction for coagulation.
212  INTEGER, PARAMETER :: mm_coag_sf = 2 !! SF mode interaction for coagulation.
213  INTEGER, PARAMETER :: mm_coag_ff = 4 !! FF mode interaction for coagulation.
214  !> Default interactions to activate (all by default).
215  INTEGER, SAVE      :: mm_coag_choice = mm_coag_ss+mm_coag_sf+mm_coag_ff
216
217  !> Pi number.
218  REAL(kind=mm_wp), PARAMETER :: mm_pi = 4._mm_wp*atan(1._mm_wp)
219  !> Avogadro number.
220  REAL(kind=mm_wp), PARAMETER :: mm_navo = 6.0221367e23_mm_wp
221  !> Boltzmann constant (\(J.K^{-1}\)).
222  REAL(kind=mm_wp), PARAMETER :: mm_kboltz = 1.3806488e-23_mm_wp
223  !> Perfect gas constant (\(J.mol^{-1}.K^{-1}\)).
224  REAL(kind=mm_wp), PARAMETER :: mm_rgas = mm_kboltz * mm_navo
225  !> Desorption energy (\(J\)) (nucleation).
226  REAL(kind=mm_wp), PARAMETER :: mm_fdes = 0.288e-19_mm_wp
227  !> Surface diffusion energy (\(J\)) (nucleation).
228  REAL(kind=mm_wp), PARAMETER :: mm_fdif = 0.288e-20_mm_wp
229  !> Jump frequency (\(s^{-1}\)) (nucleation).
230  REAL(kind=mm_wp), PARAMETER :: mm_nus = 1.e+13_mm_wp
231  !> Approximated slip-flow correction coefficient.
232  REAL(kind=mm_wp), PARAMETER :: mm_akn = 1.591_mm_wp
233
234  !> Aerosols density (\(kg.m^{-3}\)).
235  REAL(kind=mm_wp), SAVE :: mm_rhoaer = 1.e3_mm_wp
236
237  !> Fractal dimension of fractal aerosols.
238  REAL(kind=mm_wp), SAVE :: mm_df = 3._mm_wp
239
240  !> Monomer radius (m).
241  REAL(kind=mm_wp), SAVE :: mm_rm = 6.66e-8_mm_wp
242
243  !> Spherical aerosols production pressure level (Pa).
244  REAL(kind=mm_wp), SAVE :: mm_p_prod = 1._mm_wp
245
246  !> Spherical aerosols equivalent radius production (m)
247  REAL(kind=mm_wp), SAVE :: mm_rc_prod = 1.3101721857598102e-9_mm_wp
248
249  !> Production rate of spherical aerosols (\(kg.m^{-2}.s^{-1}\)).
250  REAL(kind=mm_wp), SAVE :: mm_tx_prod = 3.5e-13_mm_wp
251
252  !> Aerosol production delta if time variations is enabled (fraction).
253  REAL(kind=mm_wp), SAVE :: mm_d_prod  = 0.25_mm_wp
254
255  !> Aerosol production variations angular frequency if time variations is enabled (\(rad.s^{-1}\)).
256  REAL(kind=mm_wp), SAVE :: mm_w_prod  = 2.*mm_pi / (86400.*16.)
257
258
259  !> Electric charging of aerosols (\(e^{-}.m^{-1}\)).
260  REAL(kind=mm_wp), SAVE :: mm_ne = -15.e6_mm_wp
261
262  !> Bulk to apparent radius conversion pre-factor (\(m^{X}\)).
263  !!
264  !! It is initialized using [[mm_globals(module):mm_rm(variable)]] in
265  !! [[mm_globals(module):mm_global_init(interface)]] from the following equation:
266  !!
267  !! $$ r_{a} = r_{b}^{3/D_{f}}\times r_{m}^{\frac{D_{f}-3}{D_{f}}} $$
268  !!
269  !! Where \(r_{a}\) is the apparent radius, \(r_{b}\) the bulk radius and
270  !! \(rb2ra = r_{m}^{\frac{D_{f}-3}{D_{f}}}\) is the returned pre-factor
271  REAL(kind=mm_wp), SAVE :: mm_rb2ra = 1._mm_wp
272
273  !> Characteristic radius threshold.
274  REAL(kind=mm_wp), SAVE :: mm_rc_min = 1.e-200_mm_wp
275
276  !> Name of condensible species.
277  CHARACTER(len=30), DIMENSION(:), ALLOCATABLE, SAVE :: mm_spcname
278
279  TYPE, PUBLIC :: mm_esp
280    !! Cloud related chemical specie properties.
281    !!
282    !! This derived type is used in thermodynamic methods related to cloud microphysics.
283    !! Most of its fields represent parameters of equations from \cite{reid1986}.
284    CHARACTER(LEN=10) :: name      !! Specie name.
285    REAL(kind=mm_wp)  :: mas       !! Molecular weight (kg).
286    REAL(kind=mm_wp)  :: vol       !! Molecular volume (\(m^{3}\)).
287    REAL(kind=mm_wp)  :: ray       !! Molecular radius (m).
288    REAL(kind=mm_wp)  :: masmol    !! Molar mass (\(kg.mol^{-1}\)).
289    REAL(kind=mm_wp)  :: rho       !! density (liquid) (\(kg.m^{-3}\)).
290    REAL(kind=mm_wp)  :: tc        !! Critical temperature (K).
291    REAL(kind=mm_wp)  :: pc        !! Critical pressure (Bar).
292    REAL(kind=mm_wp)  :: tb        !! Boiling point temperature (K).
293    REAL(kind=mm_wp)  :: w         !! Acentric factor (--).
294    REAL(kind=mm_wp)  :: a_sat     !! Saturation equation A coefficient.
295    REAL(kind=mm_wp)  :: b_sat     !! Saturation equation B coefficient.
296    REAL(kind=mm_wp)  :: c_sat     !! saturation equation C coefficient.
297    REAL(kind=mm_wp)  :: d_sat     !! Saturation equation D coefficient.
298    REAL(kind=mm_wp)  :: mteta     !! Wettability.
299    REAL(kind=mm_wp)  :: tx_prod   !! Production rate.
300    REAL(kind=mm_wp)  :: fmol2fmas !! molar fraction to mass fraction coefficient.
301    ! = masmol(X)/masmol(AIR)
302  END TYPE mm_esp
303
304  !> Planet radius (m).
305  REAL(kind=mm_wp), SAVE                        :: mm_rpla     = 2575000._mm_wp
306  !> Planet acceleration due to gravity constant (ground) (\(m.s^{-2}\)).
307  REAL(kind=mm_wp), SAVE                        :: mm_g0       = 1.35_mm_wp
308  !> Air molecules mean radius (m).
309  REAL(kind=mm_wp), SAVE                        :: mm_air_rad  = 1.75e-10_mm_wp
310  !> Air molecules molar mass (\(kg.mol^{-1}\)).
311  REAL(kind=mm_wp), SAVE                        :: mm_air_mmol = 28e-3_mm_wp
312  !> Microphysic time step (s).
313  REAL(kind=mm_wp), SAVE                        :: mm_dt       = 5529.6_mm_wp
314  !> Model current time tracer (s).
315  REAL(kind=mm_wp), SAVE                        :: mm_ct       = 0.0
316  !> Total number of clouds condensible species.
317  INTEGER, SAVE                                 :: mm_nesp     = -1
318  !> Clouds chemical species properties.
319  TYPE(mm_esp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_xESPS
320
321  !------------------------
322  ! Vertical structure part
323  !------------------------
324
325  !> Number of vertical layers.
326  INTEGER, SAVE :: mm_nla = -1
327  !> Number of vertical levels.
328  INTEGER, SAVE :: mm_nle = -1
329
330  !> Altitude layers (m).
331  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_zlay
332  !> Altitude levels (m).
333  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_zlev
334  !> Pressure layers (Pa).
335  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_play
336  !> Pressure levels (Pa).
337  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_plev
338  !>  Temperature vertical profile (K).
339  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_temp
340  !>  Air density vertical profile (\(kg.m^{-3}\)).
341  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_rhoair
342  !> Temperature vertical profil at interfaces (K).
343  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_btemp
344
345  !> Atmospheric levels thickness (m).
346  !!
347  !! Atmospheric thickness between two adjacent levels (\(m\)) from the
348  !! __TOP__ to the __GROUND__.
349  !! @note __mm_dzlev__ is defined on the total number of layers and actually
350  !! corresponds to the thickness of a given layer.
351  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_dzlev
352
353  !> Atmospheric layers "thickness" (m).
354  !!
355  !! Atmospheric thickness between the center of two adjacent layers (\(m\))
356  !! from the __TOP__ to the __GROUND__.
357  !! @note
358  !! __mm_dzlay__ is defined on the total number of layers. The last
359  !! value of __mm_dzlay__ is set to twice the altitude of the ground layer.
360  !! @note This value corresponds to the thickness between the center of the
361  !! __GROUND__ layer and below the surface. It is arbitrary and not used.
362  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_dzlay
363
364  !> Spherical mode \(0^{th}\) order moment (\(m^{-3}\)).
365  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0aer_s
366  !> Spherical mode \(3^{rd}\) order moment (\(m^{3}.m^{-3}\)).
367  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3aer_s
368  !> Fractal mode \(0^{th}\) order moment (\(m^{-3}\)).
369  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0aer_f
370  !> Fractal mode \(3^{rd}\) order moment (\(m^{3}.m^{-3}\)).
371  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3aer_f
372  !> CCN \(0^{th}\) order moment (\(m^{-3}\)).
373  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0ccn
374  !> CCN \(3^{rd}\) order moment (\(m^{3}.m^{-3}\)).
375  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3ccn
376
377  !> Ice components 3rd order moments (\(m^{3}.m^{-3}\)).
378  !!
379  !! It is a 2D array with the vertical layers in first dimension, and the number of ice
380  !! components in the second.
381  !! @note
382  !! Both [[mm_globals(module):mm_m3ice(variable)]] and [[mm_globals(module):mm_gazs(variable)]]
383  !! share the same indexing (related to species order).
384  REAL(kind=mm_wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: mm_m3ice
385
386  !> Condensible species molar fraction (\(mol.mol^{-1}\)).
387  !!
388  !! It is a 2D array with the vertical layers in first dimension, and
389  !! the number of condensible species in the second.
390  !! @note
391  !! Both [[mm_globals(module):mm_m3ice(variable)]] and [[mm_globals(module):mm_gazs(variable)]]
392  !! share the same indexing (related to species order).
393  REAL(kind=mm_wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: mm_gazs
394
395  !> Spherical mode characteristic radius (m).
396  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_rcs
397  !> Fractal mode characteristic radius (m).
398  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_rcf
399  !> Mean Drop radius (m).
400  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_drad
401  !> Mean Drop density (\(kg.m^{-3}\)).
402  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_drho
403
404  !> Aerosols precipitations (m).
405  !!
406  !! Aerosols precipitations take into account both spherical and fractal modes.
407  !! It is updated in [[mm_haze(module):mm_haze_microphysics(subroutine)]].
408  REAL(kind=mm_wp), SAVE :: mm_aer_prec = 0._mm_wp
409
410  !> Spherical mode \(M_{0}\) settling velocity (\(m.s^{-1}\)).
411  !!
412  !! It is a vector with the vertical layers that contains the settling velocity for
413  !! the \(0^{th}\) order moment of the spherical mode.
414  !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
415  !! @note
416  !! This variable is always negative.
417  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0as_vsed
418
419  !> Spherical mode \(M_{3}\) settling velocity (\(m.s^{-1}\)).
420  !!
421  !! It is a vector with the vertical layers that contains the settling velocity for the
422  !! \(3^{rd}\) order moment of the spherical mode.
423  !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
424  !! @note
425  !! This variable is always negative.
426  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3as_vsed
427
428  !> Fractal mode \(M_{0}\) settling velocity (\(m.s^{-1}\)).
429  !!
430  !! It is a vector with the vertical layers that contains the settling velocity for the
431  !! \(0^{th}\) order moment of the fractal mode.
432  !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
433  !! @note
434  !! This variable is always negative.
435  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0af_vsed
436
437  !> Fractal mode \(M_{3}\) settling velocity (\(m.s^{-1}\)).
438  !!
439  !! It is a vector with the vertical layers that contains the settling velocity for the
440  !! \(3^{rd}\) order moment of the fractal mode.
441  !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
442  !! @note
443  !! This variable is always negative.
444  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3af_vsed
445
446  !> Spherical aerosol mass fluxes (\(kg.m^{-2}.s^{-1}\)).
447  !!
448  !! It is a vector with the vertical layers that contains the mass fluxes for spherical aerosols.
449  !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
450  !! @note
451  !! This variable is always negative.
452  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_aer_s_flux
453
454  !> Fractal aerosol mass fluxes (\(kg.m^{-2}.s^{-1}\)).
455  !!
456  !! It is a vector with the vertical layers that contains the mass fluxes for fractal aerosols
457  !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
458  !! @note
459  !! This variable is always negative.
460  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_aer_f_flux
461
462  !> CCN precipitations (m).
463  !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
464  REAL(kind=mm_wp), SAVE :: mm_ccn_prec = 0._mm_wp
465
466  !> CCN mass fluxes (\(kg.m^{-2}.s^{-1}\)).
467  !!
468  !! It is a vector with the vertical layers that contains the
469  !! mass fluxes for CCN.
470  !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
471  !! @note
472  !! This variable is always negative.
473  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_ccn_flux
474
475  !> Ice components precipitations (m).
476  !!
477  !! It is a vector of [[mm_globals(module):mm_nesp(variable)]] values which share the same indexing
478  !! than [[mm_globals(module):mm_m3ice(variable)]] and [[mm_globals(module):mm_gazs(variable)]].
479  !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
480  !! @note
481  !! This variable is always negative.
482  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_ice_prec
483
484  !> Ice components sedimentation fluxes (\(kg.m^{-2}.s-1\)).
485  !!
486  !! It is a 2D-array with the vertical layers in first dimension and the number of ice components
487  !! in the second. It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
488  !! @note
489  !! This variable is always negative.
490  REAL(kind=mm_wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: mm_ice_fluxes
491
492  !> Condensible species saturation ratio (--).
493  !!
494  !! It is a 2D-array with the vertical layers in first dimension and the number of condensible
495  !! species in the second.
496  !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
497  REAL(kind=mm_wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: mm_gazs_sat
498
499  !> [[mm_globals(module):mm_global_init(interface)]] initialization control flag.
500  LOGICAL, PUBLIC, SAVE :: mm_ini     = .false.
501
502  !> [[mm_globals(module):mm_column_init(function)]] initialization control flag.
503  LOGICAL, PUBLIC, SAVE :: mm_ini_col = .false.
504
505  !> [[mm_globals(module):mm_aerosols_init(function)]] initialization control flag.
506  LOGICAL, PUBLIC, SAVE :: mm_ini_aer = .false.
507
508  !> [[mm_globals(module):mm_clouds_init(function)]] initialization control flag.
509  LOGICAL, PUBLIC, SAVE :: mm_ini_cld = .false.
510
511  !> Interface to cloud properties methods.
512  !!
513  !! The method computes clouds properties (mean drop radius and denstity) from their afferent
514  !! moments. It is overloaded to compute properties at a single level or over all the vertical
515  !! atmospheric structure.
516  INTERFACE mm_cloud_properties
517    MODULE PROCEDURE cldprop_sc,cldprop_ve
518  END INTERFACE
519
520  !> Interface to global initialization.
521  !!
522  !! The method performs the global initialization of the model.
523  !! @warning
524  !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
525  !! initializes global variable that are not thread private.
526  !!
527  !! '''
528  !! !$OMP SINGLE
529  !! call mm_global_init(...)
530  !! !$OMP END SINGLE
531  INTERFACE mm_global_init
532    MODULE PROCEDURE mm_global_init_0,mm_global_init_1
533  END INTERFACE
534
535  !> Check an option from the configuration system.
536  !!
537  !! The method checks for an option in the configuration system and optionally
538  !! set a default value if the option is not found. This is an overloaded method
539  !! that can take in input either a floating point, integer, logical or string
540  !! option value.
541  INTERFACE mm_check_opt
542    MODULE PROCEDURE check_r1,check_i1,check_l1,check_s1
543  END INTERFACE
544
545  ! --- OPENMP ---------------
546  ! All variable related to column computations should be private to each thread
547  !
548  !$OMP THREADPRIVATE(mm_ini_col,mm_ini_aer,mm_ini_cld)
549  !$OMP THREADPRIVATE(mm_zlay,mm_zlev,mm_play,mm_plev,mm_temp,mm_rhoair,mm_btemp,mm_dzlev,mm_dzlay)
550  !$OMP THREADPRIVATE(mm_m0aer_s,mm_m3aer_s,mm_m0aer_f,mm_m3aer_f)
551  !$OMP THREADPRIVATE(mm_m0ccn,mm_m3ccn,mm_m3ice,mm_gazs)
552  !$OMP THREADPRIVATE(mm_rcs,mm_rcf,mm_drad,mm_drho)
553  !$OMP THREADPRIVATE(mm_aer_s_flux,mm_aer_f_flux,mm_ccn_flux,mm_ice_prec,mm_ice_fluxes,mm_gazs_sat)
554  !$OMP THREADPRIVATE(mm_m0as_vsed,mm_m3as_vsed,mm_m0af_vsed,mm_m3af_vsed)
555
556  !$OMP THREADPRIVATE(mm_nla,mm_nle)
557
558  ! --------------------------
559
560
561  CONTAINS
562
563  FUNCTION mm_global_init_0(dt,df,rm,rho_aer,p_prod,tx_prod,rc_prod,rplanet,g0, &
564                            air_rad,air_mmol,coag_interactions,clouds,spcfile,  &
565                            w_haze_prod,w_haze_sed,w_haze_coag,w_cloud_nucond,  &
566                            w_cloud_sed,force_wsed_to_m0,force_wsed_to_m3,      &
567                            no_fiadero,fiadero_min,fiadero_max) RESULT(err)
568    !! Initialize global parameters of the model.
569    !!
570    !! The function initializes all the global parameters of the model from direct input.
571    !! Boolean (and Fiadero) parameters are optional as they are rather testing parameters. Their
572    !! default values are suitable for production runs. 
573    !! @note
574    !! If the method fails to initialize parameters (i.e. returned error is not 0). Then the model
575    !! should probably be aborted as the global variables of the model will not be correctly setup.
576    !! @warning
577    !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
578    !! initializes global variable that are not thread private.
579    !!
580    !! '''
581    !! !$OMP SINGLE
582    !! call mm_global_init_0(...)
583    !! !$OMP END SINGLE
584    REAL(kind=mm_wp), INTENT(in)           :: dt
585      !! Microphysics timestep in seconds.
586    REAL(kind=mm_wp), INTENT(in)           :: df
587      !! Fractal dimension of fractal aerosol.
588    REAL(kind=mm_wp), INTENT(in)           :: rm
589      !! Monomer radius in meter.
590    REAL(kind=mm_wp), INTENT(in)           :: rho_aer
591      !! Aerosol density in \(kg.m^{-3}\).
592    REAL(kind=mm_wp), INTENT(in)           :: p_prod
593      !!  Aerosol production pressure level in Pa.
594    REAL(kind=mm_wp), INTENT(in)           :: tx_prod
595      !! Spherical aerosol mode production rate in \(kg.m^{-2}.s^{-1}\).
596    REAL(kind=mm_wp), INTENT(in)           :: rc_prod
597      !! Spherical mode characteristic radius for production in meter.
598    REAL(kind=mm_wp), INTENT(in)           :: rplanet
599      !! Planet radius in meter
600    REAL(kind=mm_wp), INTENT(in)           :: g0
601      !! Planet gravity acceleration at ground level in \(m.s^{-2}\).
602    REAL(kind=mm_wp), INTENT(in)           :: air_rad
603      !! Air molecules mean radius in meter.
604    REAL(kind=mm_wp), INTENT(in)           :: air_mmol
605      !! Air molecules mean molar mass in \(kg.mol^{-1}\).
606    INTEGER, INTENT(in)                    :: coag_interactions
607      !! Coagulation interactions process control flag.
608    LOGICAL, INTENT(in)                    :: clouds
609      !! Clouds microphysics control flag.
610    CHARACTER(len=*), INTENT(in)           :: spcfile
611      !! Clouds microphysics condensible species properties file.
612    REAL(kind=mm_wp), INTENT(in), OPTIONAL :: fiadero_max
613      !! Maximum moment ratio threshold for Fiadero correction (default: 10.) .
614    REAL(kind=mm_wp), INTENT(in), OPTIONAL :: fiadero_min
615      !! Minimum moment ratio threshold for Fiadero correction (default: 0.1).
616    LOGICAL, INTENT(in), OPTIONAL          :: w_haze_prod
617      !! Haze microphysics production process control flag (default: T).
618    LOGICAL, INTENT(in), OPTIONAL          :: w_haze_sed
619      !! Haze microphysics sedimentation process control flag (default: T).
620    LOGICAL, INTENT(in), OPTIONAL          :: w_haze_coag
621      !! Haze microphysics coagulation process control flag (default: T).
622    LOGICAL, INTENT(in), OPTIONAL          :: w_cloud_sed
623      !! Cloud microphysics nucleation/conensation process control flag (default: __clouds__ value).
624    LOGICAL, INTENT(in), OPTIONAL          :: w_cloud_nucond
625      !! Cloud microphysics production process control flag (default: __clouds__ value).
626    LOGICAL, INTENT(in), OPTIONAL          :: no_fiadero
627      !! Disable Fiadero correction for haze sedimentation process (default: F).
628    LOGICAL, INTENT(in), OPTIONAL          :: force_wsed_to_m0
629      !! force __all__ aerosols moments to fall at M0 settling velocity (default: T).
630    LOGICAL, INTENT(in), OPTIONAL          :: force_wsed_to_m3
631      !! Force __all__ aerosols moments to fall at M3 settling velocity (default: F).
632    TYPE(error) :: err
633      !! Error status of the function.
634    INTEGER                                           :: i
635    TYPE(cfgparser)                                   :: cp
636    CHARACTER(len=st_slen)                            :: spcpath
637    CHARACTER(len=:), ALLOCATABLE                     :: defmsg
638    CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: species
639    REAL(kind=mm_wp)                                  :: zfiamin,zfiamax
640    LOGICAL                                           :: zwhp,zwhs,zwhc,zwcs,zwcn,znofia, &
641                                                         zwstom0,zwstom3
642
643    zwhp = .true. ; zwhs = .true. ; zwhc = .true.
644    zwcs = clouds ; zwcn = clouds
645    znofia = .false. ; zfiamin = 0.1_mm_wp ; zfiamax = 10._mm_wp
646    zwstom0 = .true. ; zwstom3 = .false.
647    err = noerror
648    IF (mm_ini) THEN
649      err = error("mm_global_init: YAMMS global initialization already performed !",-1)
650      RETURN
651    ENDIF
652
653    ! Store options values in global variables...
654    mm_df          = df
655    mm_rm          = rm
656    mm_rb2ra       = mm_rm**((mm_df-3._mm_wp)/mm_df) ! conversion factor for bulk -> fractal radius
657    mm_rhoaer      = rho_aer
658    mm_p_prod      = p_prod
659    mm_tx_prod     = tx_prod
660    mm_rc_prod     = rc_prod
661    mm_rpla        = rplanet
662    mm_g0          = g0
663    mm_dt          = dt
664    mm_air_rad     = mm_air_rad
665    mm_air_mmol    = air_mmol
666    mm_coag_choice = coag_interactions
667    ! check coagulation interactions choice
668    IF (mm_coag_choice < 0 .OR. mm_coag_choice > 7) THEN
669      err = error("mm_global_init: Invalid choice for coagulation interactions activation",-1)
670      RETURN
671    ENDIF
672
673    mm_w_clouds = clouds
674
675    ! Check clouds microphysics species file
676    ! (only if clouds is activated)
677    IF (mm_w_clouds) THEN
678      IF (LEN_TRIM(spcfile) == 0) THEN
679        err = error("mm_global_init: No species properties file given",-1)
680        RETURN
681      ENDIF
682      ! Reads species properties configuration file 
683      err = cfg_read_config(cp,TRIM(spcfile)) ; IF (err /= 0) RETURN
684      err = cfg_get_value(cp,"used_species",species)
685      IF (err /= 0) THEN
686        err = error("mm_global_init: cannot retrieve 'used_species' values",-1)
687        RETURN
688      ENDIF
689      ! Now attempts to find species properties !!!
690      mm_nesp = SIZE(species)
691      ALLOCATE(mm_spcname(mm_nesp),mm_xESPS(mm_nesp))
692      DO i=1,mm_nesp
693        mm_spcname(i) = to_lower(species(i))
694        IF(.NOT.cfg_has_section(cp,TRIM(mm_spcname(i)))) THEN
695          err = error("mm_global_init: Cannot find "//TRIM(mm_spcname(i))//" properties",-1)
696          RETURN
697        ELSE
698          err = read_esp(cp,TRIM(mm_spcname(i)),mm_xESPS(i))
699          ! compute conversion factor: mol.mol-1 => kg.kg-1
700          mm_xESPS(i)%fmol2fmas = mm_xESPS(i)%masmol / mm_air_mmol
701          IF (err/=0) THEN
702            err = error("mm_global_init: "//TRIM(mm_spcname(i))//": "//TRIM(err%msg),-1)
703            RETURN
704          ENDIF
705        ENDIF
706      ENDDO
707    ENDIF
708
709    ! optional flags
710    ! haze control flags
711    IF (PRESENT(w_haze_prod)) THEN
712      mm_w_haze_prod = w_haze_prod
713    ELSE
714      mm_w_haze_prod = zwhp
715      call printw("mm_haze_production",to_string(mm_w_haze_prod))
716    ENDIF
717    IF (PRESENT(w_haze_sed)) THEN
718      mm_w_haze_sed = w_haze_sed
719    ELSE
720      mm_w_haze_sed = zwhs
721      call printw("mm_haze_sedimentation",to_string(mm_w_haze_sed))
722    ENDIF
723    IF (PRESENT(w_haze_coag)) THEN
724      mm_w_haze_coag = w_haze_coag
725    ELSE
726      mm_w_haze_coag = zwhc
727      call printw("mm_haze_coagulation",to_string(mm_w_haze_coag))
728    ENDIF
729    IF (PRESENT(force_wsed_to_m0)) THEN
730      mm_wsed_m0 = force_wsed_to_m0
731    ELSE
732      mm_wsed_m0 = zwstom0
733      call printw("mm_wsed_m0",to_string(mm_wsed_m0))
734    ENDIF
735    IF (PRESENT(force_wsed_to_m3)) THEN
736      mm_wsed_m3 = force_wsed_to_m3
737    ELSE
738      mm_wsed_m3 = zwstom3
739      call printw("mm_wsed_m3",to_string(mm_wsed_m3))
740    ENDIF
741    IF (PRESENT(no_fiadero)) THEN
742      mm_no_fiadero_w = no_fiadero
743    ELSE
744      mm_no_fiadero_w = znofia
745      call printw("mm_no_fiadero",to_string(mm_no_fiadero_w))
746    ENDIF
747    IF (PRESENT(fiadero_min)) THEN
748      mm_fiadero_min = fiadero_min
749    ELSE
750      mm_fiadero_min = zfiamin
751      call printw("mm_fiadero_min",to_string(mm_fiadero_min))
752    ENDIF
753    IF (PRESENT(fiadero_max)) THEN
754      mm_fiadero_max = fiadero_max
755    ELSE
756      mm_fiadero_max = zfiamax
757      call printw("mm_fiadero_max",to_string(mm_fiadero_max))
758    ENDIF
759    ! clouds control flags
760    IF (mm_w_clouds) THEN
761      IF (PRESENT(w_cloud_sed)) THEN
762        mm_w_cloud_sed = w_cloud_sed
763      ELSE
764        mm_w_cloud_sed = zwcs
765        call printw("mm_cloud_sed",to_string(mm_w_cloud_sed))
766      ENDIF
767      IF (PRESENT(w_cloud_nucond)) THEN
768        mm_w_cloud_nucond = w_cloud_nucond
769      ELSE
770        mm_w_cloud_nucond = zwcs
771        call printw("mm_cloud_nucond",to_string(mm_w_cloud_nucond))
772      ENDIF
773    ENDIF
774
775    ! check w sed flags
776    err = noerror
777    ! special check for settling velocity
778    IF (mm_wsed_m0 .AND. mm_wsed_m3) THEN
779      err = error("'wsed_m0' and 'wsed_m3' options are mutually exclusive",-1)
780    ENDIF
781    mm_ini = err == noerror
782
783    CONTAINS
784
785    SUBROUTINE printw(string,value)
786      !! Print a warning message.
787      CHARACTER(len=*), INTENT(in) :: string !! Name of the option.
788      CHARACTER(len=*), INTENT(in) :: value  !! (string) Value of the option.
789      IF (mm_log) &
790      WRITE(*,'(a,a,a)') "warning: Parameter "//string//"not given... Using default value: "//value
791    END SUBROUTINE printw
792  END FUNCTION mm_global_init_0
793
794  FUNCTION mm_global_init_1(cfg) RESULT(err)
795    !! Set global configuration from a configuration file.
796    !!
797    !! See [[mm_globals(module):mm_global_init_0(function)]].
798    TYPE(cfgparser), INTENT(in) :: cfg  !! Configuration file path.
799    TYPE(error) :: err                  !! Error status of the function.
800    INTEGER                                           :: i
801    TYPE(cfgparser)                                   :: spccfg
802    CHARACTER(len=st_slen)                            :: spcpath
803    CHARACTER(len=:), ALLOCATABLE                     :: defmsg
804    CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: species
805    REAL(kind=mm_wp)                                  :: zfiamin,zfiamax
806    LOGICAL                                           :: zwhp,zwhs,zwhc,zwcs,zwcn,znofia, &
807                                                         zwstom0,zwstom3
808
809    err = noerror
810
811    IF (mm_ini) THEN
812      err = error("mm_global_init: YAMMS global initialization already performed !",-1)
813      RETURN
814    ENDIF
815
816    ! MP2M mandatory parameters
817    err = mm_check_opt(cfg_get_value(cfg,"df",mm_df),mm_df,wlog=mm_log)
818    IF (err/=0) RETURN
819    err = mm_check_opt(cfg_get_value(cfg,"rm",mm_rm),mm_rm,wlog=mm_log)
820    IF (err/=0) RETURN
821    err = mm_check_opt(cfg_get_value(cfg,"rho_aer",mm_rhoaer),mm_rhoaer,wlog=mm_log)
822    IF (err/=0) RETURN
823    err = mm_check_opt(cfg_get_value(cfg,"p_prod",mm_p_prod),mm_p_prod,wlog=mm_log)
824    IF (err/=0) RETURN
825    err = mm_check_opt(cfg_get_value(cfg,"tx_prod",mm_tx_prod),mm_tx_prod,wlog=mm_log)
826    IF (err/=0) RETURN
827    err = mm_check_opt(cfg_get_value(cfg,"rc_prod",mm_rc_prod),mm_rc_prod,wlog=mm_log)
828    IF (err/=0) RETURN
829    err = mm_check_opt(cfg_get_value(cfg,"planet_radius",mm_rpla),mm_rpla,wlog=mm_log)
830    IF (err/=0) RETURN
831    err = mm_check_opt(cfg_get_value(cfg,"g0",mm_g0),mm_g0,wlog=mm_log)
832    IF (err/=0) RETURN
833    err = mm_check_opt(cfg_get_value(cfg,"timestep",mm_dt),mm_dt,wlog=mm_log)
834    IF (err/=0) RETURN
835    err = mm_check_opt(cfg_get_value(cfg,"air_radius",mm_air_rad),mm_air_rad,wlog=mm_log)
836    IF (err/=0) RETURN
837    err = mm_check_opt(cfg_get_value(cfg,"air_molarmass",mm_air_mmol),mm_air_mmol,wlog=mm_log)
838    IF (err/=0) RETURN
839    err = mm_check_opt(cfg_get_value(cfg,"haze_coag_interactions",mm_coag_choice),mm_coag_choice,wlog=mm_log)
840    IF (err/=0) RETURN
841    err = mm_check_opt(cfg_get_value(cfg,"clouds_microphysics",mm_w_clouds),mm_w_clouds,wlog=mm_log)
842    IF (err/=0) RETURN
843
844    ! computes the conversion factor for bulk -> fractal radius
845    mm_rb2ra = mm_rm**((mm_df-3._mm_wp)/mm_df)
846
847    ! Check coagulation interactions choice
848    IF (mm_coag_choice < 0 .OR. mm_coag_choice > 7) THEN
849      err = error("mm_global_init: Invalid choice for coagulation interactions activation",-1)
850      RETURN
851    ENDIF
852
853    ! Check clouds microphysics input
854    ! it is read only if clouds is activated. We must to check if it is self-consistent...
855    IF (mm_w_clouds) THEN
856      ! Gets species property file path
857      err = cfg_get_value(cfg,'specie_cfg',spcpath) ; IF (err /= 0) RETURN
858      ! Reads species properties configuration file 
859      err = cfg_read_config(spccfg,trim(spcpath)) ; IF (err /= 0) RETURN
860      err = cfg_get_value(spccfg,"used_species",species)
861      IF (err /= 0) THEN
862        err = error("mm_global_init: cannot retrieve 'used_species' values",-1)
863        RETURN
864      ENDIF
865      ! Now attempts to find specides properties !!!
866      mm_nesp = SIZE(species)
867      ALLOCATE(mm_spcname(mm_nesp),mm_xESPS(mm_nesp))
868      !mm_spcname(1:mm_nesp) = species(:)
869      DO i=1,mm_nesp
870        mm_spcname(i) = to_lower(species(i))
871        IF (.NOT.cfg_has_section(spccfg,TRIM(mm_spcname(i)))) THEN
872          err = error("mm_global_init: Cannot find "//TRIM(mm_spcname(i))//" properties",-1)
873          RETURN
874        ELSE
875          err = read_esp(spccfg,TRIM(mm_spcname(i)),mm_xESPS(i))
876          ! compute conversion factor: mol.mol-1 => kg.kg-1
877          mm_xESPS(i)%fmol2fmas = mm_xESPS(i)%masmol / mm_air_mmol
878          IF (err/=0) THEN
879            err = error(TRIM(mm_spcname(i))//": "//TRIM(err%msg),-2)
880            RETURN
881          ENDIF
882        ENDIF
883      ENDDO
884    ENDIF
885
886    zwhp = .true. ; zwhs = .true. ; zwhc = .true.
887    zwcs = mm_w_clouds ; zwcn = mm_w_clouds
888    znofia = .false. ; zfiamin = 0.1_mm_wp ; zfiamax = 10._mm_wp
889    zwstom0 = .true. ; zwstom3 = .false.
890
891    ! MP2M Optional parameters
892    err = mm_check_opt(cfg_get_value(cfg,"haze_production",mm_w_haze_prod),mm_w_haze_prod,zwhp,wlog=mm_log)
893    err = mm_check_opt(cfg_get_value(cfg,"haze_sedimentation",mm_w_haze_sed),mm_w_haze_sed,zwhs,wlog=mm_log)
894    err = mm_check_opt(cfg_get_value(cfg,"haze_coagulation",mm_w_haze_coag),mm_w_haze_coag,zwhc,wlog=mm_log)
895    err = mm_check_opt(cfg_get_value(cfg,"clouds_sedimentation",mm_w_cloud_sed),mm_w_cloud_sed,zwcs,wlog=mm_log)
896    err = mm_check_opt(cfg_get_value(cfg,"clouds_nucl_cond",mm_w_cloud_nucond),mm_w_cloud_nucond,zwcn,wlog=mm_log)
897    err = mm_check_opt(cfg_get_value(cfg,"wsed_m0",mm_wsed_m0),mm_wsed_m0,zwstom0,wlog=mm_log)
898    err = mm_check_opt(cfg_get_value(cfg,"wsed_m3",mm_wsed_m3),mm_wsed_m3,zwstom3,wlog=mm_log)
899    err = mm_check_opt(cfg_get_value(cfg,"no_fiadero",mm_no_fiadero_w),mm_no_fiadero_w,znofia,wlog=mm_log)
900    err = mm_check_opt(cfg_get_value(cfg,"fiadero_min_ratio",mm_fiadero_min),mm_fiadero_min,zfiamin,wlog=mm_log)
901    err = mm_check_opt(cfg_get_value(cfg,"fiadero_max_ratio",mm_fiadero_max),mm_fiadero_max,zfiamax,wlog=mm_log)
902
903    err = noerror
904    ! special check for settling velocity
905    IF (mm_wsed_m0 .AND. mm_wsed_m3) THEN
906      err = error("'wsed_m0' and 'wsed_m3' options are mutually exclusive",-1)
907    ENDIF
908    mm_ini = err == noerror
909  END FUNCTION mm_global_init_1
910
911  FUNCTION mm_column_init(plev,zlev,play,zlay,temp) RESULT(err)
912    !! Initialize vertical atmospheric fields.
913    !!
914    !! This subroutine initializes vertical fields needed by the microphysics:
915    !!
916    !! 1. Save reversed input field into "local" array
917    !! 2. Compute thicknesses layers and levels
918    !! 3. Interpolate temperature at levels
919    !!
920    !! The method should be called whenever the vertical structure of the atmosphere changes.
921    !!
922    !! @attention
923    !! All the input vectors should be defined from __GROUND__ to __TOP__ of the atmosphere,
924    !! otherwise nasty things will occur in computations.
925    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: plev !! Pressure levels (Pa).
926    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: zlev !! Altitude levels (m).
927    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: play !! Pressure layers (Pa).
928    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: zlay !! Altitude at the center of each layer (m).
929    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: temp !! Temperature at the center of each layer (K).
930    TYPE(error) :: err                                 !! Error status of the function.
931    INTEGER :: i
932    mm_ini_col = .false.                         
933    err = noerror
934    IF (.NOT.mm_ini) THEN
935      err = error("mm_column_init: Global initialization not done yet",-1)
936      RETURN
937    ENDIF
938    IF (mm_nla < 0) THEN
939      mm_nla = SIZE(play)
940    ELSE
941      IF (mm_nla /= SIZE(play)) THEN
942        err = error("mm_column_init: mm_nla cannot be modified dynamically within the run",-1)
943        RETURN
944      ENDIF
945    ENDIF
946    IF (mm_nle < 0) THEN
947      mm_nle = SIZE(plev)
948    ELSE
949      IF (mm_nle /= SIZE(plev)) THEN
950        err = error("mm_column_init: mm_nle cannot be modified dynamically within the run",-1)
951        RETURN
952      ENDIF
953    ENDIF
954    ! should be trashed soon or later
955    IF (mm_nla+1 /= mm_nle) THEN
956      err = error("mm_column_init: Inconsistent number of layers/levels",-1)
957      RETURN
958    ENDIF
959    ! Allocates if required
960    IF (.NOT.ALLOCATED(mm_plev))   ALLOCATE(mm_plev(mm_nle))
961    IF (.NOT.ALLOCATED(mm_zlev))   ALLOCATE(mm_zlev(mm_nle))
962    IF (.NOT.ALLOCATED(mm_play))   ALLOCATE(mm_play(mm_nla))
963    IF (.NOT.ALLOCATED(mm_zlay))   ALLOCATE(mm_zlay(mm_nla))
964    IF (.NOT.ALLOCATED(mm_temp))   ALLOCATE(mm_temp(mm_nla))
965    IF (.NOT.ALLOCATED(mm_btemp))  ALLOCATE(mm_btemp(mm_nle))
966    IF (.NOT.ALLOCATED(mm_dzlev))  ALLOCATE(mm_dzlev(mm_nla))
967    IF (.NOT.ALLOCATED(mm_dzlay))  ALLOCATE(mm_dzlay(mm_nla))
968    IF (.NOT.ALLOCATED(mm_rhoair)) ALLOCATE(mm_rhoair(mm_nla))
969    ! Saves reversed input vectors
970    mm_zlay = zlay(mm_nla:1:-1) ; mm_zlev = zlev(mm_nle:1:-1)
971    mm_play = play(mm_nla:1:-1) ; mm_plev = plev(mm_nle:1:-1)
972    mm_temp = temp(mm_nla:1:-1)
973    ! Computes others vectors
974    mm_dzlay(1:mm_nla-1) = mm_zlay(1:mm_nla-1)-mm_zlay(2:mm_nla)
975    mm_dzlay(mm_nla)     = mm_dzlay(mm_nla-1) ! actually arbitrary
976    mm_dzlev(1:mm_nla)   = mm_zlev(1:mm_nle-1)-mm_zlev(2:mm_nle)
977    mm_btemp(2:mm_nla)   = (mm_temp(1:mm_nla-1)+mm_temp(2:mm_nla))/2._mm_wp
978    mm_btemp(1)          = mm_temp(1)
979    mm_btemp(mm_nle)     = mm_temp(mm_nla)+(mm_temp(mm_nla)-mm_temp(mm_nla-1))/2._mm_wp
980    ! Hydrostatic equilibrium
981    mm_rhoair(1:mm_nla) = (mm_plev(2:mm_nle)-mm_plev(1:mm_nla)) / &
982                          (mm_effg(mm_zlay)*mm_dzlev)
983    mm_ini_col = .true.                         
984    ! write out profiles (only if BOTH debug and log are enabled).
985    IF (mm_log.AND.mm_debug) THEN
986      WRITE(*,'(a)') '# TEMP             PLAY             ZLAY             DZLAY            RHOAIR'
987      DO i=1,mm_nla
988        WRITE(*,'(5(ES15.7,2X))') mm_temp(i),mm_play(i),mm_zlay(i),mm_dzlay(i), mm_rhoair(i)
989      ENDDO
990      WRITE(*,'(a)') '# TEMP             PLEV             ZLEV             DZLEV'
991      DO i=1,mm_nle
992        IF (i /= mm_nle) THEN
993          WRITE(*,'(4(ES15.7,2X))') mm_btemp(i),mm_plev(i),mm_zlev(i),mm_dzlev(i)
994        ELSE
995          WRITE(*,'(3(ES15.7,2X))') mm_btemp(i),mm_plev(i),mm_zlev(i)
996        ENDIF
997      ENDDO
998    ENDIF
999
1000    RETURN
1001  END FUNCTION mm_column_init
1002
1003  FUNCTION mm_aerosols_init(m0aer_s,m3aer_s,m0aer_f,m3aer_f) RESULT(err)
1004    !! Initialize clouds tracers vertical grid.
1005    !!
1006    !! The subroutine initializes aerosols microphysics tracers columns. It allocates variables if
1007    !! required and stores input vectors in reversed order. It also computes the characteristic radii
1008    !! of each mode.
1009    !! @note
1010    !! All the input arguments should be defined from ground to top.
1011    !!
1012    !! @attention
1013    !! [[mm_globals(module):mm_global_init(interface)]] and [[mm_globals(module):mm_column_init(function)]]
1014    !! must have been called at least once before this method is called. Moreover, this method should be
1015    !! after each call of [[mm_globals(module):mm_column_init(function)]] to reflect changes in the
1016    !! vertical atmospheric structure.
1017    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m0aer_s !! \(0^{th}\) order moment of the spherical mode (\(m^{-2}\)).
1018    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m3aer_s !! \(3^{rd}\) order moment of the spherical mode (\(m^{3}.m^{-2}\)).
1019    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m0aer_f !! \(0^{th}\) order moment of the fractal mode (\(m^{-2}\)).
1020    REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m3aer_f !! \(3^{rd}\) order moment of the fractal mode (\(m^{3}.m^{-2}\)).
1021    TYPE(error) :: err                                    !! Error status of the function.
1022    err = noerror
1023    IF (.NOT.mm_ini) THEN
1024      err = error("mm_aerosols_init: Global initialization not done yet",-1) ; RETURN
1025    ENDIF
1026    IF (.NOT.mm_ini_col) THEN
1027      err = error("mm_aerosols_init: Column initialization not done yet",-1) ; RETURN
1028    ENDIF
1029    ! Check input size ???
1030    IF (SIZE(m0aer_s) /= mm_nla) THEN
1031      err = error("mm_aerosols_init: Invalid size for input arrays",-1) ; RETURN
1032    ENDIF
1033
1034    ! Allocate variable if required
1035    IF (.NOT.ALLOCATED(mm_m0aer_s)) ALLOCATE(mm_m0aer_s(mm_nla))
1036    IF (.NOT.ALLOCATED(mm_m3aer_s)) ALLOCATE(mm_m3aer_s(mm_nla))
1037    IF (.NOT.ALLOCATED(mm_m0aer_f)) ALLOCATE(mm_m0aer_f(mm_nla))
1038    IF (.NOT.ALLOCATED(mm_m3aer_f)) ALLOCATE(mm_m3aer_f(mm_nla))
1039    IF (.NOT.ALLOCATED(mm_rcs))     ALLOCATE(mm_rcs(mm_nla))
1040    IF (.NOT.ALLOCATED(mm_rcf))     ALLOCATE(mm_rcf(mm_nla))
1041    ! Allocate memory for diagnostics
1042    IF (.NOT.ALLOCATED(mm_aer_s_flux)) THEN
1043      ALLOCATE(mm_aer_s_flux(mm_nla)) ; mm_aer_s_flux(:) = 0._mm_wp
1044    ENDIF
1045    IF (.NOT.ALLOCATED(mm_aer_f_flux)) THEN
1046      ALLOCATE(mm_aer_f_flux(mm_nla)) ; mm_aer_f_flux(:) = 0._mm_wp
1047    ENDIF
1048    IF (.NOT.ALLOCATED(mm_m0as_vsed)) THEN
1049      ALLOCATE(mm_m0as_vsed(mm_nla)) ; mm_m0as_vsed(:) = 0._mm_wp
1050    ENDIF
1051    IF (.NOT.ALLOCATED(mm_m3as_vsed)) THEN
1052      ALLOCATE(mm_m3as_vsed(mm_nla)) ; mm_m3as_vsed(:) = 0._mm_wp
1053    ENDIF
1054    IF (.NOT.ALLOCATED(mm_m0af_vsed)) THEN
1055      ALLOCATE(mm_m0af_vsed(mm_nla)) ; mm_m0af_vsed(:) = 0._mm_wp
1056    ENDIF
1057    IF (.NOT.ALLOCATED(mm_m3af_vsed)) THEN
1058      ALLOCATE(mm_m3af_vsed(mm_nla)) ; mm_m3af_vsed(:) = 0._mm_wp
1059    ENDIF
1060    ! note : mm_dzlev is already from top to ground
1061    mm_m0aer_s = m0aer_s(mm_nla:1:-1)/mm_dzlev(:)
1062    mm_m3aer_s = m3aer_s(mm_nla:1:-1)/mm_dzlev(:)
1063    mm_m0aer_f = m0aer_f(mm_nla:1:-1)/mm_dzlev(:)
1064    mm_m3aer_f = m3aer_f(mm_nla:1:-1)/mm_dzlev(:)
1065    ! aerosols characteristic radii
1066    ! il faudrait peut etre revoir la gestion des zeros ici et la
1067    ! remplacer par une valeur seuil des moments.
1068    !
1069    !-> JVO 19 : Done. Zero threshold set at espilon from dynamics on the
1070    ! input moments in calmufi (safer than here). Might still be some unphysical
1071    ! values after the dynamics near the threshold. Could be a could idea to add
1072    ! a sanity check filtering too high values of radii.
1073    !
1074    ! TBD : Add a sanity check for high radii ????
1075    WHERE(mm_m3aer_s > 0._mm_wp .AND. mm_m0aer_s > 0._mm_wp)
1076      mm_rcs = mm_get_rcs(mm_m0aer_s,mm_m3aer_s)
1077    ELSEWHERE
1078      mm_rcs = 0._mm_wp
1079    ENDWHERE
1080    WHERE(mm_m3aer_f > 0._mm_wp .AND. mm_m0aer_f > 0._mm_wp)
1081      mm_rcf = mm_get_rcf(mm_m0aer_f,mm_m3aer_f)
1082    ELSEWHERE
1083      mm_rcf = 0._mm_wp
1084    ENDWHERE
1085    mm_ini_aer = .true.
1086  END FUNCTION mm_aerosols_init
1087
1088  FUNCTION mm_clouds_init(m0ccn,m3ccn,m3ice,gazs) RESULT(err)
1089    !! Initialize clouds tracers vertical grid.
1090    !!
1091    !! The subroutine initializes cloud microphysics tracers columns. It allocates variables if
1092    !! required and stores input vectors in reversed order. It also computes the mean drop radius
1093    !! and density and allocates diagnostic vectors.
1094    !! @note
1095    !! All the input arguments should be defined from ground to top.
1096    !!
1097    !! @attention
1098    !! [[mm_globals(module):mm_global_init(interface)]] and [[mm_globals(module):mm_column_init(function)]]
1099    !! must have been called at least once before this method is called. Moreover, this method should be
1100    !! after each call of [[mm_globals(module):mm_column_init(function)]] to reflect changes in the
1101    !! vertical atmospheric structure.
1102    REAL(kind=mm_wp), DIMENSION(:), INTENT(in)   :: m0ccn !! 0th order moment of the CCN distribution (\(m^{-2}\)).
1103    REAL(kind=mm_wp), DIMENSION(:), INTENT(in)   :: m3ccn !! 3rd order moment of the CCN distribution (\(m^{3}.m^{-2}\)).
1104    REAL(kind=mm_wp), DIMENSION(:,:), INTENT(in) :: m3ice !! 3rd order moments of the ice components (\(m^{3}.m^{-2}\)).
1105    REAL(kind=mm_wp), DIMENSION(:,:), INTENT(in) :: gazs  !! Condensible species gazs molar fraction (\(mol.mol^{-1}\)).
1106    TYPE(error) :: err                                    !! Error status of the function.
1107    INTEGER :: i
1108    err = noerror
1109    IF (.NOT.mm_ini) THEN
1110      err = error("Global initialization not done yet",-8)
1111      RETURN
1112    ENDIF
1113
1114    IF (.NOT.mm_w_clouds) THEN
1115      IF (mm_debug) WRITE(*,'(a)') "WARNING: Cloud microphysic is not enabled..."
1116      RETURN
1117    ENDIF
1118
1119    ! Note:
1120    !  Here we could check that mm_nla is the same size of gazs(DIM=1)
1121    !  Actually, mm_nla should always initialized the first time mm_column_init is called, NOT HERE.
1122    IF (mm_nla < 0)  mm_nla  = SIZE(gazs,DIM=1)
1123    ! Note:
1124    !   here we could check that mm_nesp is the same size of gazs(DIM=2)
1125    !   Actually, mm_nesp should be always initialized in mm_global_init, NOT HERE.
1126    IF (mm_nesp < 0) mm_nesp = SIZE(gazs,DIM=2)
1127
1128    ! Allocate variable if required
1129    IF (.NOT.ALLOCATED(mm_m0ccn))   ALLOCATE(mm_m0ccn(mm_nla))
1130    IF (.NOT.ALLOCATED(mm_m3ccn))   ALLOCATE(mm_m3ccn(mm_nla))
1131    IF (.NOT.ALLOCATED(mm_m3ice))   ALLOCATE(mm_m3ice(mm_nla,mm_nesp))
1132    IF (.NOT.ALLOCATED(mm_gazs))    ALLOCATE(mm_gazs(mm_nla,mm_nesp))
1133    IF (.NOT.ALLOCATED(mm_drad))    ALLOCATE(mm_drad(mm_nla))
1134    IF (.NOT.ALLOCATED(mm_drho))    ALLOCATE(mm_drho(mm_nla))
1135    ! Allocate memory for diagnostics
1136    IF (.NOT.ALLOCATED(mm_ccn_flux)) THEN
1137      ALLOCATE(mm_ccn_flux(mm_nla)) ; mm_ccn_flux(:) = 0._mm_wp
1138    ENDIF
1139    IF (.NOT.ALLOCATED(mm_ice_prec))   THEN
1140      ALLOCATE(mm_ice_prec(mm_nesp)) ; mm_ice_prec(:) = 0._mm_wp
1141    ENDIF
1142    IF (.NOT.ALLOCATED(mm_ice_fluxes)) THEN
1143      ALLOCATE(mm_ice_fluxes(mm_nla,mm_nesp)) ; mm_ice_fluxes(:,:) = 0._mm_wp
1144    ENDIF
1145    IF (.NOT.ALLOCATED(mm_gazs_sat)) THEN
1146      ALLOCATE(mm_gazs_sat(mm_nla,mm_nesp)) ; mm_gazs_sat(:,:) = 0._mm_wp
1147    ENDIF
1148
1149    ! note mm_dzlev already from top to ground
1150    mm_m0ccn = m0ccn(mm_nla:1:-1)/mm_dzlev(:)
1151    mm_m3ccn = m3ccn(mm_nla:1:-1)/mm_dzlev(:)
1152    DO i=1,mm_nesp
1153      mm_m3ice(:,i) = m3ice(mm_nla:1:-1,i)/mm_dzlev(:)
1154      mm_gazs(:,i)  = gazs(mm_nla:1:-1,i)
1155    ENDDO
1156    ! drop mean radius
1157    call mm_cloud_properties(mm_m0ccn,mm_m3ccn,mm_m3ice,mm_drad,mm_drho)
1158    mm_ini_cld = .true.
1159  END FUNCTION mm_clouds_init
1160
1161  SUBROUTINE mm_dump_parameters()
1162    !! Dump model global parameters on stdout.
1163    WRITE(*,'(a)')         "========= YAMMS PARAMETERS ============"
1164    WRITE(*,'(a,L2)')      "mm_w_haze_prod         : ", mm_w_haze_prod
1165    WRITE(*,'(a,ES14.7)')  "   mm_p_prod           : ", mm_p_prod
1166    WRITE(*,'(a,ES14.7)')  "   mm_tx_prod          : ", mm_tx_prod
1167    WRITE(*,'(a,ES14.7)')  "   mm_rc_prod          : ", mm_rc_prod
1168    WRITE(*,'(a,L2)')      "mm_w_haze_coag         : ", mm_w_haze_coag
1169    WRITE(*,'(a,I2.2)')    "   mm_coag_interactions: ", mm_coag_choice
1170    WRITE(*,'(a,L2)')      "mm_w_haze_sed          : ", mm_w_haze_sed
1171    WRITE(*,'(a,L2)')      "   mm_wsed_m0          : ", mm_wsed_m0
1172    WRITE(*,'(a,L2)')      "   mm_wsed_m3          : ", mm_wsed_m3
1173    WRITE(*,'(a,L2)')      "   mm_no_fiadero_w     : ", mm_no_fiadero_w
1174    WRITE(*,'(a,ES14.7)')  "   mm_fiadero_min      : ", mm_fiadero_min
1175    WRITE(*,'(a,ES14.7)')  "   mm_fiadero_max      : ", mm_fiadero_max
1176    WRITE(*,'(a,L2)')      "mm_w_clouds            : ", mm_w_clouds
1177    WRITE(*,'(a,L2)')      "   mm_w_cloud_sed      : ", mm_w_cloud_sed
1178    WRITE(*,'(a,L2)')      "   mm_w_cloud_nucond   : ", mm_w_cloud_nucond
1179    WRITE(*,'(a)')         "---------------------------------------"
1180    WRITE(*,'(a,ES14.7)')  "mm_dt                  : ", mm_dt
1181    IF (mm_nla > -1) THEN
1182      WRITE(*,'(a,I3.3)')    "mm_nla                 : ", mm_nla
1183    ELSE
1184      WRITE(*,'(a)')         "mm_nla                 : not initialized yet"
1185    ENDIF
1186    WRITE(*,'(a,ES14.7)')  "mm_df                  : ", mm_df
1187    WRITE(*,'(a,ES14.7)')  "mm_rm                  : ", mm_rm
1188    WRITE(*,'(a,ES14.7)')  "mm_rpla                : ", mm_rpla
1189    WRITE(*,'(a,ES14.7)')  "mm_g0                  : ", mm_g0
1190    WRITE(*,'(a)')         "======================================="
1191  END SUBROUTINE mm_dump_parameters
1192
1193  ELEMENTAL FUNCTION mm_get_rcs(m0,m3) RESULT(res)
1194    !! Get the characteristic radius for the spherical aerosols size distribution.
1195    !!
1196    !! The method computes the characteristic radius of the size distribution law
1197    !! of the spherical aerosols mode according to its moments and its inter-moments
1198    !! relation.
1199    REAL(kind=mm_wp), INTENT(in) :: m0 !! \(0^{th}\) order moment
1200    REAL(kind=mm_wp), INTENT(in) :: m3 !! \(3^{rd}\) order moment
1201    REAL(kind=mm_wp) :: res            !! Radius
1202    ! arbitrary: if there is no way to compute radius
1203    IF (m3 <= 0._mm_wp .OR. m0 <= 0._mm_wp) res = 1._mm_wp
1204    res = (m3/m0/mm_alpha_s(3._mm_wp))**(1._mm_wp/3._mm_wp)
1205  END FUNCTION mm_get_rcs
1206
1207  ELEMENTAL FUNCTION mm_get_rcf(m0,m3) RESULT(res)
1208    !! Get the characteristic radius for the fractal aerosols size distribution.
1209    !!
1210    !! The method computes the characteristic radius of the size distribution law
1211    !! of the fractal aerosols mode according to its moments and its inter-moments
1212    !! relation.
1213    REAL(kind=mm_wp), INTENT(in) :: m0 !! \(0^{th}\) order moment
1214    REAL(kind=mm_wp), INTENT(in) :: m3 !! \(3^{rd}\) order moment
1215    REAL(kind=mm_wp) :: res            !! Radius
1216    ! arbitrary: if there is no way to compute radius
1217    IF (m3 <= 0._mm_wp .OR. m0 <= 0._mm_wp) res = 1._mm_wp
1218    res = (m3/m0/mm_alpha_f(3._mm_wp))**(1._mm_wp/3._mm_wp)
1219  END FUNCTION mm_get_rcf
1220
1221  ELEMENTAL FUNCTION mm_effg(z) RESULT(effg)
1222    !! Compute effective gravitational acceleration.
1223    REAL(kind=mm_wp), INTENT(in) :: z !! Altitude in meters
1224    REAL(kind=mm_wp) :: effg          !! Effective gravitational acceleration in \(m.s^{-2}\)
1225    effg = mm_g0
1226    IF (mm_use_effg) effg = effg * (mm_rpla/(mm_rpla+z))**2
1227    RETURN
1228  END FUNCTION mm_effg
1229
1230  !==================================
1231  ! --- private methods -------------
1232  !==================================
1233
1234  SUBROUTINE cldprop_sc(m0ccn,m3ccn,m3ice,drad,drho)
1235    !! Get cloud drop properties (scalar).
1236    !!
1237    !! The method computes the mean radius and mean density of cloud drops.
1238    !!
1239    !! @bug
1240    !! A possible bug can happen because of threshold snippet. If __drad__ is greater than
1241    !! __drmax__ (== 100 microns) it is automatically set to __drmax__, but computation of
1242    !! __drho__ remains unmodified. So __drho__ is not correct in that case.
1243    !!
1244    !! @todo
1245    !! Fix the bug of the subroutine, but it is rather minor, since theoretically we do not
1246    !! need the density of the drop.
1247    !!
1248    !! @todo
1249    !! Think about a better implementation of thresholds, and get sure of their consequences in
1250    !! the other parts of the model.
1251    REAL(kind=mm_wp), INTENT(in)               :: m0ccn !! \(0^{th}\) order moment of the ccn
1252    REAL(kind=mm_wp), INTENT(in)               :: m3ccn !! \(3^{rd}\) order moment of the ccn
1253    REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: m3ice !! \(3^{rd}\) order moments of each ice component
1254    REAL(kind=mm_wp), INTENT(out)              :: drad  !! Output mean drop radius
1255    REAL(kind=mm_wp), INTENT(out), OPTIONAL    :: drho  !! Optional output mean drop density
1256    REAL(kind=mm_wp)            :: vtot, wtot, ntot
1257    REAL(kind=mm_wp), PARAMETER :: threshold = 1.e-25_mm_wp,         & 
1258                                       drmin = 1.e-10_mm_wp,         &
1259                                       drmax = 1.e-4_mm_wp,          &
1260                                      athird = 1._mm_wp/3._mm_wp,    &
1261                                       pifac = 4._mm_wp/3._mm_wp*mm_pi
1262    drad = 0._mm_wp
1263    ntot = m0ccn
1264    vtot = pifac*m3ccn+SUM(m3ice)
1265    wtot = pifac*m3ccn*mm_rhoaer+SUM(m3ice*mm_xESPS(:)%rho)
1266    IF (ntot <= threshold .OR. vtot <= 0._mm_wp) THEN
1267      drad  = drmin
1268      IF (PRESENT(drho)) drho  = mm_rhoaer
1269    ELSE
1270      drad = (vtot/ntot/pifac)**athird
1271      drad = MAX(MIN(drad,drmax),drmin)
1272      IF (PRESENT(drho)) drho = wtot/vtot
1273    ENDIF
1274    RETURN
1275  END SUBROUTINE cldprop_sc
1276
1277  SUBROUTINE cldprop_ve(m0ccn,m3ccn,m3ice,drad,drho)
1278    !! Get cloud drop properties (vector).
1279    !!
1280    !! The method performs the same computations than [[mm_globals(module):cldprop_sc(subroutine)]]
1281    !! but for the entire vertical atmospheric structure.
1282    !! Same remarks apply here.
1283    REAL(kind=mm_wp), INTENT(in), DIMENSION(:)            :: m0ccn !! 0th order moment of the ccn.
1284    REAL(kind=mm_wp), INTENT(in), DIMENSION(:)            :: m3ccn !! 3rd order moment of the ccn.
1285    REAL(kind=mm_wp), INTENT(in), DIMENSION(:,:)          :: m3ice !! 3rd order moments of each ice component.
1286    REAL(kind=mm_wp), INTENT(out), DIMENSION(:)           :: drad  !! Output mean drop radius.
1287    REAL(kind=mm_wp), INTENT(out), DIMENSION(:), OPTIONAL :: drho  !! Optional output mean drop density.
1288    INTEGER                                     :: i,ns
1289    REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: vtot,wtot,ntot,rho
1290    REAL(kind=mm_wp), PARAMETER                 :: threshold = 1.e-25_mm_wp,         & 
1291                                                       drmin = 1.e-10_mm_wp,         &
1292                                                       drmax = 1.e-4_mm_wp,          &
1293                                                      athird = 1._mm_wp/3._mm_wp,    &
1294                                                       pifac = 4._mm_wp/3._mm_wp*mm_pi
1295                                                     
1296    ns = SIZE(m0ccn) ; ALLOCATE(vtot(ns),wtot(ns),ntot(ns),rho(ns))
1297    drad = 0._mm_wp
1298    ntot = m0ccn
1299    vtot = pifac*m3ccn+SUM(m3ice,DIM=2)
1300    wtot = pifac*m3ccn*mm_rhoaer
1301    DO i=1,SIZE(m3ice,DIM=2)
1302      wtot = wtot+m3ice(:,i)*mm_xESPS(i)%rho
1303    ENDDO
1304    WHERE(ntot <= threshold .OR. vtot <= 0._mm_wp)
1305      drad  = drmin
1306      rho = mm_rhoaer
1307    ELSEWHERE
1308      drad = (vtot/ntot/pifac)**athird
1309      drad = MAX(MIN(drad,drmax),drmin)
1310      rho = wtot/vtot
1311    END WHERE
1312    IF (PRESENT(drho)) drho  = rho
1313    RETURN
1314  END SUBROUTINE cldprop_ve
1315
1316  ! For configuration file (requires fccp library).
1317
1318  FUNCTION read_esp(parser,sec,pp) RESULT (err)
1319    !! Read and store [[mm_globals(module):mm_esp(type)]] parameters.
1320    TYPE(cfgparser), INTENT(in)   :: parser !! Configuration parser.
1321    CHARACTER(len=*), INTENT(in)  :: sec    !! Name of the specie (should match a section of the configuration.
1322    TYPE(mm_esp), INTENT(out)     :: pp     !! [[mm_globals(module):mm_esp(type)]] object that stores the parameters.
1323    TYPE(error)                   :: err    !! Error status of the function.
1324    err = cfg_get_value(parser,TRIM(sec)//'name',pp%name)       ; IF (err /= 0) RETURN
1325    err = cfg_get_value(parser,TRIM(sec)//'mas',pp%mas)         ; IF (err /= 0) RETURN
1326    err = cfg_get_value(parser,TRIM(sec)//'vol',pp%vol)         ; IF (err /= 0) RETURN
1327    err = cfg_get_value(parser,TRIM(sec)//'ray',pp%ray)         ; IF (err /= 0) RETURN
1328    err = cfg_get_value(parser,TRIM(sec)//'mas',pp%mas)         ; IF (err /= 0) RETURN
1329    err = cfg_get_value(parser,TRIM(sec)//'vol',pp%vol)         ; IF (err /= 0) RETURN
1330    err = cfg_get_value(parser,TRIM(sec)//'ray',pp%ray)         ; IF (err /= 0) RETURN
1331    err = cfg_get_value(parser,TRIM(sec)//'masmol',pp%masmol)   ; IF (err /= 0) RETURN
1332    err = cfg_get_value(parser,TRIM(sec)//'rho',pp%rho)         ; IF (err /= 0) RETURN
1333    err = cfg_get_value(parser,TRIM(sec)//'tc',pp%tc)           ; IF (err /= 0) RETURN
1334    err = cfg_get_value(parser,TRIM(sec)//'pc',pp%pc)           ; IF (err /= 0) RETURN
1335    err = cfg_get_value(parser,TRIM(sec)//'tb',pp%tb)           ; IF (err /= 0) RETURN
1336    err = cfg_get_value(parser,TRIM(sec)//'w',pp%w)             ; IF (err /= 0) RETURN
1337    err = cfg_get_value(parser,TRIM(sec)//'a_sat',pp%a_sat)     ; IF (err /= 0) RETURN
1338    err = cfg_get_value(parser,TRIM(sec)//'b_sat',pp%b_sat)     ; IF (err /= 0) RETURN
1339    err = cfg_get_value(parser,TRIM(sec)//'c_sat',pp%c_sat)     ; IF (err /= 0) RETURN
1340    err = cfg_get_value(parser,TRIM(sec)//'d_sat',pp%d_sat)     ; IF (err /= 0) RETURN
1341    err = cfg_get_value(parser,TRIM(sec)//'mteta',pp%mteta)     ; IF (err /= 0) RETURN
1342    err = cfg_get_value(parser,TRIM(sec)//'tx_prod',pp%tx_prod) ; IF (err /= 0) RETURN
1343    RETURN
1344  END FUNCTION read_esp
1345
1346  ! =========================================================================
1347  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1348  !                CONFIGURATION PARSER checking methods
1349  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1350  ! =========================================================================
1351
1352  FUNCTION check_r1(err,var,def,wlog) RESULT(ret)
1353    !! Check an option value (float).
1354    !!
1355    !! The method checks an option value and optionally set a default value, __def__ to initialize
1356    !! __var__ on error if given.
1357    TYPE(error), INTENT(in)                :: err  !! Error object from value getter.
1358    REAL(kind=mm_wp), INTENT(inout)        :: var  !! Input/output option value.
1359    REAL(kind=mm_wp), INTENT(in), OPTIONAL :: def  !! Default value to set.
1360    LOGICAL, INTENT(in), OPTIONAL          :: wlog !! .true. to print warning/error message.
1361    TYPE(error) :: ret                             !! Input error.
1362    CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
1363    LOGICAL                     :: zlog
1364    ret = err
1365    zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
1366    IF (err == 0) RETURN
1367    IF (PRESENT(def)) THEN
1368      var = def
1369      IF (zlog) WRITE(*,'(a,a,a)') error_to_string(err,'',.true.),defmsg,to_string(var)
1370      ret = noerror
1371    ELSE
1372      IF (zlog) WRITE(*,'(a)') error_to_string(err,'',.true.)
1373    ENDIF
1374  END FUNCTION check_r1
1375
1376  FUNCTION check_l1(err,var,def,wlog) RESULT(ret)
1377    !! Check an option value (logical).
1378    !!
1379    !! The method checks an option value and optionally set a default value, __def__ to initialize
1380    !! __var__ on error if given.
1381    TYPE(error), INTENT(in)       :: err  !! Error object from value getter.
1382    LOGICAL, INTENT(inout)        :: var  !! Input/output option value.
1383    LOGICAL, INTENT(in), OPTIONAL :: def  !! Default value to set.
1384    LOGICAL, INTENT(in), OPTIONAL :: wlog !! .true. to print warning/error message.
1385    TYPE(error) :: ret                    !! Input error.
1386    CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
1387    LOGICAL                     :: zlog
1388    ret = err
1389     zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
1390    IF (err == 0) RETURN
1391    IF (PRESENT(def)) THEN
1392      var = def
1393      IF (zlog) WRITE(*,'(a,a,a)') error_to_string(err,'',.true.),defmsg,to_string(var)
1394      ret = noerror
1395    ELSE
1396      IF (zlog) WRITE(*,'(a)') error_to_string(err,'',.true.)
1397    ENDIF
1398  END FUNCTION check_l1
1399
1400  FUNCTION check_i1(err,var,def,wlog) RESULT(ret)
1401    !! Check an option value (integer).
1402    !!
1403    !! The method checks an option value and optionally set a default value, __def__ to initialize
1404    !! __var__ on error if given.
1405    TYPE(error), INTENT(in)       :: err  !! Error object from value getter.
1406    INTEGER, INTENT(inout)        :: var  !! Input/output option value.
1407    INTEGER, INTENT(in), OPTIONAL :: def  !! Default value to set.
1408    LOGICAL, INTENT(in), OPTIONAL :: wlog !! .true. to print warning/error message.
1409    TYPE(error) :: ret                    !! Input error.
1410    CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
1411    LOGICAL                     :: zlog
1412    ret = err
1413     zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
1414    IF (err == 0) RETURN
1415    IF (PRESENT(def)) THEN
1416      var = def
1417      IF (zlog) WRITE(*,'(a,a,a)') error_to_string(err,'',.true.),defmsg,to_string(var)
1418      ret = noerror
1419    ELSE
1420      IF (zlog) WRITE(*,'(a)') error_to_string(err,'',.true.)
1421    ENDIF
1422  END FUNCTION check_i1
1423
1424  FUNCTION check_s1(err,var,def,wlog) RESULT(ret)
1425    !! Check an option value (string).
1426    !!
1427    !! The method checks an option value and optionally set a default value, __def__ to initialize
1428    !! __var__ on error if given.
1429    TYPE(error), INTENT(in)                      :: err  !! Error object from value getter.
1430    CHARACTER(len=*), INTENT(inout)              :: var  !! Input/output option value.
1431    CHARACTER(len=*), INTENT(in), OPTIONAL       :: def  !! Default value to set.
1432    LOGICAL, INTENT(in), OPTIONAL                :: wlog !! .true. to print warning/error message.
1433    TYPE(error) :: ret                                   !! Input error.
1434    CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
1435    LOGICAL                     :: zlog
1436    ret = err
1437    zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
1438    IF (err == 0) RETURN
1439    IF (PRESENT(def)) THEN
1440      var = TRIM(def)
1441      IF (zlog) WRITE(*,'(a,a,a)') error_to_string(err,'',.true.),defmsg,var
1442      ret = noerror
1443    ELSE
1444      IF (zlog) WRITE(*,'(a)') error_to_string(err,'')
1445    ENDIF
1446    RETURN
1447  END FUNCTION check_s1
1448
1449END MODULE MM_GLOBALS
Note: See TracBrowser for help on using the repository browser.