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

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

BdeBatz? : Cleans microphysics and makes few corrections for physics

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