Context Navigation

mp2m_globals.F90 @ 3590

Last change on this file since 3590 was 3583, checked in by debatzbr, 7 days ago
Fixes the display of microphysical parameters
File size: 45.1 KB

Line
1	MODULE MP2M_GLOBALS
2	!============================================================================
3	!
4	! Purpose
5	! -------
6	! Parameters and global variables module.
7	! Defines and initialize all the parameters and global variables that are
8	! common to all other modules of the library.
9	!
10	! It is separated in two parts :
11	! - Main parameters and global saved variables. Most of these variables should be initialized
12	! once and should hold the same value during run-time. These variables are completly public and
13	! initialized by [[mm_globals(module):mm_global_init(interface)]] method.
14	! - The second part defines a set of vectors that defines the vertical structure of the atmosphere.
15	! Each time a new atmospheric column has to be computed (either on a new timestep or on a new couple
16	! of longitude/latitude), these vectors should be intialized with new values by calling
17	! [[mm_globals(module):mm_column_init(function)]] method.
18	!
19	! @note
20	! All the vectors that represent the vertical structure of the atmosphere (altitude, pressure and
21	! temperature...) are oriented from the __TOP__ of the atmosphere to the __GROUND__.
22	!
23	! Global variables overview:
24	! - Protected variables
25	! - Control flags
26	! - Related free parameters
27	! - Physical constants
28	! - Free parameters
29	! - Miscellaneous parameters
30	! - Vertical structure part
31	!
32	! The module also contains thirteen methods:
33	! - mm_global_init_0
34	! - mm_global_init_1
35	! - mm_column_init
36	! - mm_aerosols_init
37	! - mm_alpha_s, mm_alpha_f
38	! - mm_effg
39	! - mm_set_moments_thresholds
40	! - mm_get_rcs, mm_get_rcf
41	! - mm_dump_parameters
42	! - check_r1, check_l1, check_i1, check_s1
43	!
44	! Authors
45	! -------
46	! B. de Batz de Trenquelléon, J. Burgalat (11/2024)
47	!
48	!============================================================================
49	USE MP2M_MPREC
50	! From lint
51	USE LINT_DATASETS
52	! From swift
53	USE SWIFT_CFGPARSE
54	USE SWIFT_STRING_OP
55	USE SWIFT_ERRORS
56	IMPLICIT NONE
57
58	PUBLIC
59
60	PRIVATE :: check_r1,check_i1,check_l1,check_s1
61
62	! ~~~~~~~~~~~~~~~~~~~
63	! Protected variables
64	! ~~~~~~~~~~~~~~~~~~~
65	! The following variables are read-only outside this module.
66	! One must call the afferent subroutine to update them.
67
68	! Initialization control flags (cannot be updated)
69	PROTECTED :: mm_ini,mm_ini_col,mm_ini_aer
70	! Model parameters (mm_global_init)
71	PROTECTED :: mm_dt,mm_rhoaer,mm_df,mm_rm,mm_haze_prod_pCH4,mm_p_prod,mm_rc_prod,mm_tx_prod,mm_rpla,mm_g0,mm_rb2ra
72	! Atmospheric vertical structure (mm_column_init)
73	PROTECTED :: mm_nla,mm_nle,mm_zlay,mm_zlev,mm_play,mm_plev,mm_temp,mm_rhoair,mm_btemp,mm_dzlev,mm_dzlay
74	! Moments parameters (mm_aerosols_init)
75	PROTECTED :: mm_m0aer_s, mm_m3aer_s, mm_m0aer_f, mm_m3aer_f
76	! Moments parameters (derived, are updated with moments parameters)
77	PROTECTED :: mm_rcs, mm_rcf
78	! Thresholds parameters
79	PROTECTED :: mm_m0as_min, mm_m3as_min, mm_rcs_min, mm_m0af_min, mm_m3af_min, mm_rcf_min
80
81	! ~~~~~~~~~~~~~
82	! Control flags
83	! ~~~~~~~~~~~~~
84	! Enable/Disable haze production.
85	LOGICAL, SAVE :: mm_w_haze_prod = .true.
86	! Enable/Disable haze production from CH4 photolysis.
87	LOGICAL, SAVE :: mm_haze_prod_pCH4 = .true.
88	! Enable/Disable haze sedimentation.
89	LOGICAL, SAVE :: mm_w_haze_sed = .true.
90	! Enable/Disable haze coagulation.
91	LOGICAL, SAVE :: mm_w_haze_coag = .true.
92	! Force all aerosols moments to fall at M0 settling velocity.
93	LOGICAL, SAVE :: mm_wsed_m0 = .false.
94	! Force all aerosols moments to fall at M3 settling velocity.
95	LOGICAL, SAVE :: mm_wsed_m3 = .false.
96	! Enable/Disable spherical probability transfert.
97	LOGICAL, SAVE :: mm_w_ps2s = .true.
98	! Enable/Disable aerosol electric charge correction.
99	LOGICAL, SAVE :: mm_w_qe = .true.
100
101	! Enable/Disable QnD debug mode (can be used for devel).
102	LOGICAL, SAVE :: mm_debug = .false.
103	! Enable/Disable log mode (for configuration only).
104	LOGICAL, SAVE :: mm_log = .false.
105	! Enable/Disable effective G for computations.
106	LOGICAL, SAVE :: mm_use_effg = .true.
107
108	! Initialization control flag [[mm_globals(module):mm_global_init(interface)]].
109	LOGICAL, PUBLIC, SAVE :: mm_ini = .false.
110	! Initialization control flag [[mm_globals(module):mm_column_init(function)]].
111	LOGICAL, PUBLIC, SAVE :: mm_ini_col = .false.
112	! Initialization control flag [[mm_globals(module):mm_aerosols_init(function)]].
113	LOGICAL, PUBLIC, SAVE :: mm_ini_aer = .false.
114
115	! ~~~~~~~~~~~~~~~~~~~~~~~
116	! Related free parameters
117	! ~~~~~~~~~~~~~~~~~~~~~~~
118	! No mode interaction for coagulation (i.e. no coagulation at all).
119	INTEGER, PARAMETER :: mm_coag_no = 0
120	! SS mode interaction for coagulation.
121	INTEGER, PARAMETER :: mm_coag_ss = 1
122	! SF mode interaction for coagulation.
123	INTEGER, PARAMETER :: mm_coag_sf = 2
124	! FF mode interaction for coagulation.
125	INTEGER, PARAMETER :: mm_coag_ff = 4
126	! Default interactions to activate (all by default).
127	INTEGER, SAVE :: mm_coag_choice = mm_coag_ss+mm_coag_sf+mm_coag_ff
128
129	! ~~~~~~~~~~~~~~~~~~
130	! Physical constants
131	! ~~~~~~~~~~~~~~~~~~
132	! Pi number.
133	REAL(kind=mm_wp), PARAMETER :: mm_pi = 4._mm_wp*atan(1._mm_wp)
134	! Avogadro number (mol-1).
135	REAL(kind=mm_wp), PARAMETER :: mm_navo = 6.0221367e23_mm_wp
136	! Boltzmann constant (J.K-1).
137	REAL(kind=mm_wp), PARAMETER :: mm_kboltz = 1.3806488e-23_mm_wp
138	! Perfect gas constant (J.mol-1.K-1).
139	REAL(kind=mm_wp), PARAMETER :: mm_rgas = mm_kboltz * mm_navo
140	! Approximated slip-flow correction coefficient.
141	REAL(kind=mm_wp), PARAMETER :: mm_akn = 1.591_mm_wp
142
143	! ~~~~~~~~~~~~~~~
144	! Free parameters
145	! ~~~~~~~~~~~~~~~
146	! Spherical aerosol production pressure level (Pa).
147	REAL(kind=mm_wp), SAVE :: mm_p_prod = 1.e-2_mm_wp
148	! Spherical aerosol production rate (kg.m-2.s-1).
149	REAL(kind=mm_wp), SAVE :: mm_tx_prod = 9.8e-14_mm_wp
150	! Spherical aerosol equivalent radius production (m)
151	REAL(kind=mm_wp), SAVE :: mm_rc_prod = 1.e-9_mm_wp
152	! Monomer radius (m).
153	REAL(kind=mm_wp), SAVE :: mm_rm = 1.e-8_mm_wp
154	! Fractal dimension of fractal aerosols.
155	REAL(kind=mm_wp), SAVE :: mm_df = 2._mm_wp
156	! Aerosol density (kg.m-3).
157	REAL(kind=mm_wp), SAVE :: mm_rhoaer = 8.e2_mm_wp
158
159	! Total number of aerosols minimum threshold for the spherical mode.
160	REAL(kind=mm_wp), SAVE :: mm_m0as_min = 1.e-8_mm_wp
161	! Total volume of aerosols minimum threshold for the spherical mode.
162	REAL(kind=mm_wp), SAVE :: mm_m3as_min = 1.e-35_mm_wp
163	! Characteristic radius minimum threshold for the spherical mode.
164	REAL(kind=mm_wp), SAVE :: mm_rcs_min = 1.e-9_mm_wp
165	! Total number of aerosols minimum threshold for the fractal mode.
166	REAL(kind=mm_wp), SAVE :: mm_m0af_min = 1.e-8_mm_wp
167	! Total volume of aerosols minimum threshold for the fractal mode.
168	REAL(kind=mm_wp), SAVE :: mm_m3af_min = 1.e-35_mm_wp
169	! Characteristic radius minimum threshold for the fractal mode.
170	REAL(kind=mm_wp), SAVE :: mm_rcf_min = 1.e-9_mm_wp
171
172	! Planet radius (m) and gravity acceleration (m.s-2).
173	! WARNING: initialization for Pluto.
174	REAL(kind=mm_wp), SAVE :: mm_rpla = 1187000._mm_wp
175	REAL(kind=mm_wp), SAVE :: mm_g0 = 0.617_mm_wp
176	! Air molecules mean radius (m), molar mass (kg.mol-1), and molecular mass (kg).
177	! WARNING: initialization for N2.
178	REAL(kind=mm_wp), SAVE :: mm_air_rad = 1.75e-10_mm_wp
179	REAL(kind=mm_wp), SAVE :: mm_air_mmol = 28.e-3_mm_wp
180	REAL(kind=mm_wp), SAVE :: mm_air_mmas = 28.e-3_mm_wp / mm_navo
181	! Microphysical time-step (s).
182	REAL(kind=mm_wp), SAVE :: mm_dt = 180._mm_wp
183
184	! ~~~~~~~~~~~~~~~~~~~~~~~~
185	! Miscellaneous parameters
186	! ~~~~~~~~~~~~~~~~~~~~~~~~
187
188	! Bulk to apparent radius
189	! ~~~~~~~~~~~~~~~~~~~~~~~
190	! Bulk to apparent radius conversion pre-factor (m^X).
191	!
192	! With r_a = r_b^(3/Df) . r_m^((Df-3)/(Df))
193	! Then rb2ra = r_m^((Df-3)/(Df))
194	REAL(kind=mm_wp), SAVE :: mm_rb2ra = 1._mm_wp
195
196	! Inter-moment relation
197	! ~~~~~~~~~~~~~~~~~~~~~
198	! Alpha function parameters.
199	! It stores the parameters of the inter-moments relation functions.
200	!
201	! The inter-moments relation function is represented by the sum of exponential quadratic expressions:
202	! alpha(k) = Sum_{i=1}^{n} exp(a_i.k^2 + bi.k^2 + c_i)
203	TYPE, PUBLIC :: aprm
204	! Quadratic coefficients of the quadratic expressions.
205	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: a
206	! Linear coefficients of the quadratic expressions.
207	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: b
208	! Free term of the quadratic expressions.
209	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: c
210	END TYPE
211	! Inter-moment relation set of parameters for the spherical mode.
212	TYPE(aprm), PUBLIC, SAVE :: mm_asp
213	! Inter-moment relation set of parameters for the fractal mode.
214	TYPE(aprm), PUBLIC, SAVE :: mm_afp
215
216	! Transfert probabilities (S --> F)
217	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
218	! Data set for linear interpolation of transfert probability (M0/CO).
219	TYPE(dset1d), PUBLIC, SAVE, TARGET :: mm_pco0p
220	! Data set for linear interpolation of transfert probability (M3/CO).
221	TYPE(dset1d), PUBLIC, SAVE, TARGET :: mm_pco3p
222	! Data set for linear interpolation of transfert probability (M0/FM).
223	TYPE(dset1d), PUBLIC, SAVE, TARGET :: mm_pfm0p
224	! Data set for linear interpolation of transfert probability (M3/FM).
225	TYPE(dset1d), PUBLIC, SAVE, TARGET :: mm_pfm3p
226
227	! Mean electric correction
228	! ~~~~~~~~~~~~~~~~~~~~~~~~
229	! Data set for Q_SF(M0).
230	TYPE(dset2d), PUBLIC, SAVE, TARGET :: mm_qbsf0
231	! Extended values of [[mm_gcm(module):mm_qbsf0(variable)]] dataset.
232	REAL(kind=mm_wp), PUBLIC, SAVE, DIMENSION(2,2) :: mm_qbsf0_e
233	! Data set for Q_SF(M3).
234	TYPE(dset2d), PUBLIC, SAVE, TARGET :: mm_qbsf3
235	! Extended values of [[mm_gcm(module):mm_qbsf3(variable)]] dataset.
236	REAL(kind=mm_wp), PUBLIC, SAVE, DIMENSION(2,2) :: mm_qbsf3_e
237	! Data set for Q_FF(M0).
238	TYPE(dset2d), PUBLIC, SAVE, TARGET :: mm_qbff0
239	! Extended values of [[mm_gcm(module):mm_qbff0(variable)]] dataset.
240	REAL(kind=mm_wp), PUBLIC, SAVE, DIMENSION(2,2) :: mm_qbff0_e
241
242	! btk coefficients
243	! ~~~~~~~~~~~~~~~~
244	! Coefficients for Free-molecular regime kernel approximation (b_0(t)).
245	REAL(kind=mm_wp), PUBLIC, SAVE, DIMENSION(5) :: mm_bt0 = (/1._mm_wp,1._mm_wp,1._mm_wp,1._mm_wp,1._mm_wp/)
246	! Coefficients for Free-molecular regime kernel approximation (b_3(t)).
247	REAL(kind=mm_wp), PUBLIC, SAVE, DIMENSION(5) :: mm_bt3 = (/1._mm_wp,1._mm_wp,1._mm_wp,1._mm_wp,1._mm_wp/)
248
249	! ~~~~~~~~~~~~~~~~~~~~~~~
250	! Vertical structure part
251	! ~~~~~~~~~~~~~~~~~~~~~~~
252	! Number of vertical layers.
253	INTEGER, SAVE :: mm_nla = -1
254	! Number of vertical levels.
255	INTEGER, SAVE :: mm_nle = -1
256
257	! Altitude layers (m).
258	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_zlay
259	! Altitude levels (m).
260	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_zlev
261	!> Pressure layers (Pa).
262	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_play
263	! Pressure levels (Pa).
264	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_plev
265	! Temperature vertical profile (K).
266	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_temp
267	! Air density vertical profile (kg.m-3).
268	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_rhoair
269	! Temperature vertical profil at interfaces (K).
270	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_btemp
271
272	! Atmospheric levels thickness (m).
273	! @note: __mm_dzlev__ is defined on the total number of layers and actually
274	! corresponds to the thickness of a given layer.
275	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_dzlev
276	! Atmospheric layers thickness (m).
277	! @note: __mm_dzlay__ is defined on the total number of layers. The last
278	! value of __mm_dzlay__ is set to twice the altitude of the ground layer.
279	! This value corresponds to the thickness between the center of the
280	! __GROUND__ layer and below the surface.
281	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_dzlay
282
283	! Spherical mode - 0th order moment (m-3).
284	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0aer_s
285	! Spherical mode - 3rd order moment (m3.m-3).
286	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3aer_s
287	! Spherical mode - characteristic radius (m).
288	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_rcs
289	! Fractal mode - 0th order moment (m-3).
290	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0aer_f
291	! Fractal mode - 3rd order moment (m3.m-3).
292	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3aer_f
293	! Fractal mode - characteristic radius (m).
294	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_rcf
295
296	! Spherical aerosol precipitation (kg.m-2).
297	REAL(kind=mm_wp), SAVE :: mm_aers_prec = 0._mm_wp
298	! Fractal aerosol precipitation (kg.m-2).
299	REAL(kind=mm_wp), SAVE :: mm_aerf_prec = 0._mm_wp
300
301	! Spherical mode (M0) settling velocity (m.s-1).
302	! @note: This variable is always negative.
303	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0as_vsed
304	! Spherical mode (M3) settling velocity (m.s-1).
305	! @note: This variable is always negative.
306	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3as_vsed
307	! Fractal mode (M0) settling velocity (m.s-1).
308	! @note: This variable is always negative.
309	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0af_vsed
310	! Fractal mode (M3) settling velocity (m.s-1).
311	! @note: This variable is always negative.
312	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3af_vsed
313
314	! Spherical aerosol mass fluxes (kg.m-2.s-1).
315	! @note: This variable is always negative.
316	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_aer_s_flux
317	! Fractal aerosol mass fluxes (kg.m-2.s-1).
318	! @note: This variable is always negative.
319	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_aer_f_flux
320
321	! All variables related to column computations should be private to each thread
322	!$OMP THREADPRIVATE(mm_ini_col,mm_ini_aer)
323	!$OMP THREADPRIVATE(mm_zlay,mm_zlev,mm_play,mm_plev,mm_temp,mm_rhoair,mm_btemp,mm_dzlev,mm_dzlay)
324	!$OMP THREADPRIVATE(mm_m0aer_s,mm_m3aer_s,mm_m0aer_f,mm_m3aer_f)
325	!$OMP THREADPRIVATE(mm_rcs,mm_rcf)
326	!$OMP THREADPRIVATE(mm_m0as_vsed,mm_m3as_vsed,mm_m0af_vsed,mm_m3af_vsed)
327	!$OMP THREADPRIVATE(mm_aer_s_flux,mm_aer_f_flux)
328	!$OMP THREADPRIVATE(mm_m0as_min,mm_m3as_min,mm_rcs_min,mm_m0af_min,mm_m3af_min,mm_rcf_min)
329	!$OMP THREADPRIVATE(mm_nla,mm_nle)
330
331	! Interface to global initialization.
332	! The method performs the global initialization of the model.
333	INTERFACE mm_global_init
334	MODULE PROCEDURE mm_global_init_0,mm_global_init_1
335	END INTERFACE mm_global_init
336
337	! Check an option from the configuration system.
338	! The method checks for an option in the configuration system and optionally
339	! set a default value if the option is not found. This is an overloaded method
340	! that can take in input either a floating point, integer, logical or string
341	! option value.
342	INTERFACE mm_check_opt
343	MODULE PROCEDURE check_r1,check_i1,check_l1,check_s1
344	END INTERFACE mm_check_opt
345
346
347	CONTAINS
348
349
350	!============================================================================
351	! INITIALIZATION METHODS
352	!============================================================================
353
354	FUNCTION mm_global_init_0(dt,df,rm,rho_aer,haze_prod_pCH4,p_prod,tx_prod,rc_prod,&
355	rplanet,g0,air_rad,air_mmol, &
356	coag_interactions,w_haze_prod,w_haze_sed,w_haze_coag, &
357	force_wsed_to_m0,force_wsed_to_m3, &
358	m0as_min,rcs_min,m0af_min,rcf_min,debug) RESULT(err)
359	!! Initialize global parameters of the model.
360	!!
361	!! The function initializes all the global parameters of the model from direct input.
362	!! Store input values in global variables
363	!!
364	!! @note
365	!! If the method fails to initialize parameters the model should be aborted as the
366	!! global variables of the model will not be correctly setup.
367	!!
368	! Microphysical timestep (s).
369	REAL(kind=mm_wp), INTENT(in) :: dt
370	! Fractal dimension of fractal aerosol (-).
371	REAL(kind=mm_wp), INTENT(in) :: df
372	! Monomer radius (m).
373	REAL(kind=mm_wp), INTENT(in) :: rm
374	! Aerosol density(kg.m-3).
375	REAL(kind=mm_wp), INTENT(in) :: rho_aer
376	! Enable/Disable production from CH4 photolysis.
377	LOGICAL, INTENT(in) :: haze_prod_pCH4
378	! Aerosol production pressure level (Pa).
379	REAL(kind=mm_wp), INTENT(in) :: p_prod
380	! Spherical aerosol production rate kg.m-2.s-1).
381	REAL(kind=mm_wp), INTENT(in) :: tx_prod
382	! Spherical aerosol characteristic radius of production (m).
383	REAL(kind=mm_wp), INTENT(in) :: rc_prod
384	! Planet radius (m).
385	REAL(kind=mm_wp), INTENT(in) :: rplanet
386	! Planet gravity acceleration at ground level (m.s-2).
387	REAL(kind=mm_wp), INTENT(in) :: g0
388	! Radius of air molecules (m).
389	REAL(kind=mm_wp), INTENT(in) :: air_rad
390	! Molar mass of air molecules (kg.mol-1).
391	REAL(kind=mm_wp), INTENT(in) :: air_mmol
392
393	! Coagulation interactions process control flag.
394	INTEGER, INTENT(in) :: coag_interactions
395	! Haze production process control flag.
396	LOGICAL, INTENT(in) :: w_haze_prod
397	! Haze sedimentation process control flag.
398	LOGICAL, INTENT(in) :: w_haze_sed
399	! Haze coagulation process control flag.
400	LOGICAL, INTENT(in) :: w_haze_coag
401	! Force __all__ aerosols moments to fall at M0 settling velocity.
402	LOGICAL, INTENT(in) :: force_wsed_to_m0
403	! Force __all__ aerosols moments to fall at M3 settling velocity
404	LOGICAL, INTENT(in) :: force_wsed_to_m3
405
406	! Minimum threshold for M0 of the spherical mode (m-3).
407	REAL(kind=mm_wp), INTENT(in) :: m0as_min
408	! Minimum threshold for the characteristic radius of the spherical mode (m).
409	REAL(kind=mm_wp), INTENT(in) :: rcs_min
410	! Minimum threshold for M0 of the factal mode (m-3).
411	REAL(kind=mm_wp), INTENT(in) :: m0af_min
412	! Minimum threshold for the characteristic radius of the fractal mode (m).
413	REAL(kind=mm_wp), INTENT(in) :: rcf_min
414
415	! Debug mode control flag.
416	LOGICAL, INTENT(in) :: debug
417
418	! Error status of the function.
419	TYPE(error) :: err
420
421	err = noerror
422
423	! Sanity check:
424	IF (mm_ini) THEN
425	err = error("mm_global_init: YAMMS global initialization already performed !",-1)
426	RETURN
427	ENDIF
428
429	! Free parameters:
430	mm_dt = dt
431	mm_df = df
432	mm_rm = rm
433	mm_rhoaer = rho_aer
434	mm_haze_prod_pCH4 = haze_prod_pCH4
435	mm_p_prod = p_prod
436	mm_tx_prod = tx_prod
437	mm_rc_prod = rc_prod
438	mm_rpla = rplanet
439	mm_g0 = g0
440	mm_air_rad = air_rad
441	mm_air_mmol = air_mmol
442	mm_air_mmas = air_mmol / mm_navo
443
444	! Microphysical processes:
445	mm_coag_choice = coag_interactions
446	IF (mm_coag_choice < 0 .OR. mm_coag_choice > 7) THEN
447	err = error("mm_global_init: Invalid choice for coagulation interactions activation",-1)
448	RETURN
449	ENDIF
450	mm_w_haze_prod = w_haze_prod
451	mm_w_haze_sed = w_haze_sed
452	mm_w_haze_coag = w_haze_coag
453	mm_wsed_m0 = force_wsed_to_m0
454	mm_wsed_m3 = force_wsed_to_m3
455
456	! Moment threshold flags:
457	mm_m0as_min = MAX(0._mm_wp,m0as_min)
458	mm_rcs_min = MAX(1.e-10_mm_wp,rcs_min)
459	mm_m0af_min = MAX(0._mm_wp,m0af_min)
460	mm_rcf_min = MAX(mm_rm,rcf_min)
461
462	! Debug mode:
463	mm_debug = debug
464
465	! Computes M3 thresholds from user-defined thresholds:
466	mm_m3as_min = mm_m0as_minmm_alpha_s(3._mm_wp) mm_rcs_min**3._mm_wp
467	mm_m3af_min = mm_m0af_minmm_alpha_f(3._mm_wp) mm_rcf_min**3._mm_wp
468
469	! Computes conversion factor for bulk to apparent radius:
470	mm_rb2ra = mm_rm**((mm_df-3._mm_wp)/mm_df)
471
472	! Sanity check for settling velocity:
473	IF (mm_wsed_m0 .AND. mm_wsed_m3) THEN
474	err = error("'wsed_m0' and 'wsed_m3' options are mutually exclusive",-1)
475	ENDIF
476
477	! End of initialization:
478	mm_ini = err == noerror
479
480	END FUNCTION mm_global_init_0
481
482
483	FUNCTION mm_global_init_1(cfg) RESULT(err)
484	!! Set global configuration from a configuration file.
485	!!
486	!! @note:
487	!! See [[mm_globals(module):mm_global_init_0(function)]].
488	!!
489
490	! Configuration file path.
491	TYPE(cfgparser), INTENT(in) :: cfg
492	! Error status of the function.
493	TYPE(error) :: err
494
495	err = noerror
496
497	! Sanity check:
498	IF (mm_ini) THEN
499	err = error("mm_global_init: YAMMS global initialization already performed !",-1)
500	RETURN
501	ENDIF
502
503	! Free parameters:
504	err = mm_check_opt(cfg_get_value(cfg,"timestep",mm_dt),mm_dt,wlog=mm_log)
505	IF (err/=0) RETURN
506	err = mm_check_opt(cfg_get_value(cfg,"df",mm_df),mm_df,wlog=mm_log)
507	IF (err/=0) RETURN
508	err = mm_check_opt(cfg_get_value(cfg,"rm",mm_rm),mm_rm,wlog=mm_log)
509	IF (err/=0) RETURN
510	err = mm_check_opt(cfg_get_value(cfg,"rho_aer",mm_rhoaer),mm_rhoaer,wlog=mm_log)
511	IF (err/=0) RETURN
512	err = mm_check_opt(cfg_get_value(cfg,"call_haze_prod",mm_haze_prod_pCH4),mm_haze_prod_pCH4,wlog=mm_log)
513	IF (err/=0) RETURN
514	err = mm_check_opt(cfg_get_value(cfg,"p_prod",mm_p_prod),mm_p_prod,wlog=mm_log)
515	IF (err/=0) RETURN
516	err = mm_check_opt(cfg_get_value(cfg,"tx_prod",mm_tx_prod),mm_tx_prod,wlog=mm_log)
517	IF (err/=0) RETURN
518	err = mm_check_opt(cfg_get_value(cfg,"rc_prod",mm_rc_prod),mm_rc_prod,wlog=mm_log)
519	IF (err/=0) RETURN
520	err = mm_check_opt(cfg_get_value(cfg,"planet_radius",mm_rpla),mm_rpla,wlog=mm_log)
521	IF (err/=0) RETURN
522	err = mm_check_opt(cfg_get_value(cfg,"g0",mm_g0),mm_g0,wlog=mm_log)
523	IF (err/=0) RETURN
524	err = mm_check_opt(cfg_get_value(cfg,"air_radius",mm_air_rad),mm_air_rad,wlog=mm_log)
525	IF (err/=0) RETURN
526	err = mm_check_opt(cfg_get_value(cfg,"air_molarmass",mm_air_mmol),mm_air_mmol,wlog=mm_log)
527	IF (err/=0) RETURN
528	err = mm_check_opt(cfg_get_value(cfg,"air_molecularmass",mm_air_mmas),mm_air_mmas,wlog=mm_log)
529	IF (err/=0) RETURN
530
531	! Microphysical processes:
532	err = mm_check_opt(cfg_get_value(cfg,"haze_coag_interactions",mm_coag_choice),mm_coag_choice,wlog=mm_log)
533	IF (err/=0) RETURN
534	IF (mm_coag_choice < 0 .OR. mm_coag_choice > 7) THEN
535	err = error("mm_global_init: Invalid choice for coagulation interactions activation",-1)
536	RETURN
537	ENDIF
538	err = mm_check_opt(cfg_get_value(cfg,"haze_production",mm_w_haze_prod),mm_w_haze_prod,wlog=mm_log)
539	IF (err/=0) RETURN
540	err = mm_check_opt(cfg_get_value(cfg,"haze_sedimentation",mm_w_haze_sed),mm_w_haze_sed,wlog=mm_log)
541	IF (err/=0) RETURN
542	err = mm_check_opt(cfg_get_value(cfg,"haze_coagulation",mm_w_haze_coag),mm_w_haze_coag,wlog=mm_log)
543	IF (err/=0) RETURN
544	err = mm_check_opt(cfg_get_value(cfg,"wsed_m0",mm_wsed_m0),mm_wsed_m0,wlog=mm_log)
545	IF (err/=0) RETURN
546	err = mm_check_opt(cfg_get_value(cfg,"wsed_m3",mm_wsed_m3),mm_wsed_m3,wlog=mm_log)
547	IF (err/=0) RETURN
548
549	! Moment threshold flags:
550	err = mm_check_opt(cfg_get_value(cfg,"m0as_min",mm_m0as_min),mm_m0as_min,wlog=mm_log)
551	IF (err/=0) RETURN
552	err = mm_check_opt(cfg_get_value(cfg,"rcs_min",mm_rcs_min),mm_rcs_min,wlog=mm_log)
553	IF (err/=0) RETURN
554	err = mm_check_opt(cfg_get_value(cfg,"m0af_min",mm_m0af_min),mm_m0af_min,wlog=mm_log)
555	IF (err/=0) RETURN
556	err = mm_check_opt(cfg_get_value(cfg,"rcf_min",mm_rcf_min),mm_rcf_min,wlog=mm_log)
557	IF (err/=0) RETURN
558
559	! Debug mode:
560	err = mm_check_opt(cfg_get_value(cfg,"debug",mm_debug),mm_debug,wlog=mm_log)
561	IF (err/=0) RETURN
562
563	! Computes M3 thresholds from user-defined thresholds:
564	mm_m0as_min = MAX(0._mm_wp,mm_m0as_min)
565	mm_rcs_min = MAX(1.e-10_mm_wp,mm_rcs_min)
566	mm_m0af_min = MAX(0._mm_wp,mm_m0af_min)
567	mm_rcf_min = MAX(mm_rm,mm_rcf_min)
568	mm_m3as_min = mm_m0as_minmm_alpha_s(3._mm_wp) mm_rcs_min**3._mm_wp
569	mm_m3af_min = mm_m0af_minmm_alpha_f(3._mm_wp) mm_rcf_min**3._mm_wp
570
571	! Computes conversion factor for bulk to apparent radius:
572	mm_rb2ra = mm_rm**((mm_df-3._mm_wp)/mm_df)
573
574	! Sanity check for settling velocity:
575	IF (mm_wsed_m0 .AND. mm_wsed_m3) THEN
576	err = error("'wsed_m0' and 'wsed_m3' options are mutually exclusive",-1)
577	ENDIF
578
579	! End of initialization:
580	mm_ini = err == noerror
581
582	END FUNCTION mm_global_init_1
583
584
585	FUNCTION mm_column_init(plev,zlev,play,zlay,temp) RESULT(err)
586	!! Initialize vertical atmospheric fields.
587	!!
588	!! This subroutine initializes vertical fields needed by the microphysics:
589	!! 1. Save reversed input field into "local" array
590	!! 2. Compute thicknesses layers and levels
591	!! 3. Interpolate temperature at levels
592	!!
593	!! @warning
594	!! The method should be called whenever the vertical structure of the atmosphere changes.
595	!! All the input vectors should be defined from __GROUND__ to __TOP__ of the atmosphere,
596	!! otherwise nasty things will occur in computations.
597	!!
598	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: plev ! Pressure levels (Pa).
599	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: zlev ! Altitude levels (m).
600	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: play ! Pressure layers (Pa).
601	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: zlay ! Altitude at the center of each layer (m).
602	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: temp ! Temperature at the center of each layer (K).
603	TYPE(error) :: err ! Error status of the function.
604	INTEGER :: i
605
606	err = noerror
607	mm_ini_col = .false.
608
609	! Global initialization must be done before:
610	IF (.NOT.mm_ini) THEN
611	err = error("mm_column_init: Global initialization not done yet",-1)
612	RETURN
613	ENDIF
614
615	! Check number of vertical layers:
616	IF (mm_nla < 0) THEN
617	mm_nla = SIZE(play)
618	ELSE
619	IF (mm_nla /= SIZE(play)) THEN
620	err = error("mm_column_init: mm_nla cannot be modified dynamically within the run",-1)
621	RETURN
622	ENDIF
623	ENDIF
624
625	! Check number of vertical levels:
626	IF (mm_nle < 0) THEN
627	mm_nle = SIZE(plev)
628	ELSE
629	IF (mm_nle /= SIZE(plev)) THEN
630	err = error("mm_column_init: mm_nle cannot be modified dynamically within the run",-1)
631	RETURN
632	ENDIF
633	ENDIF
634
635	! Sanity check:
636	IF (mm_nla+1 /= mm_nle) THEN
637	err = error("mm_column_init: Inconsistent number of layers/levels",-1)
638	RETURN
639	ENDIF
640
641	! Allocates if required:
642	IF (.NOT.ALLOCATED(mm_plev)) ALLOCATE(mm_plev(mm_nle))
643	IF (.NOT.ALLOCATED(mm_zlev)) ALLOCATE(mm_zlev(mm_nle))
644	IF (.NOT.ALLOCATED(mm_play)) ALLOCATE(mm_play(mm_nla))
645	IF (.NOT.ALLOCATED(mm_zlay)) ALLOCATE(mm_zlay(mm_nla))
646	IF (.NOT.ALLOCATED(mm_temp)) ALLOCATE(mm_temp(mm_nla))
647	IF (.NOT.ALLOCATED(mm_btemp)) ALLOCATE(mm_btemp(mm_nle))
648	IF (.NOT.ALLOCATED(mm_dzlev)) ALLOCATE(mm_dzlev(mm_nla))
649	IF (.NOT.ALLOCATED(mm_dzlay)) ALLOCATE(mm_dzlay(mm_nla))
650	IF (.NOT.ALLOCATED(mm_rhoair)) ALLOCATE(mm_rhoair(mm_nla))
651
652	! Saves reversed input vectors:
653	mm_plev = plev(mm_nle:1:-1)
654	mm_zlev = zlev(mm_nle:1:-1)
655	mm_play = play(mm_nla:1:-1)
656	mm_zlay = zlay(mm_nla:1:-1)
657	mm_temp = temp(mm_nla:1:-1)
658
659	! Computes temperature vertical profil at interfaces:
660	mm_btemp(2:mm_nla) = (mm_temp(1:mm_nla-1) + mm_temp(2:mm_nla)) / 2._mm_wp
661	mm_btemp(1) = mm_temp(1)
662	mm_btemp(mm_nle) = mm_temp(mm_nla) + (mm_temp(mm_nla) - mm_temp(mm_nla-1)) / 2._mm_wp
663
664	! Computes atmospheric levels thickness:
665	mm_dzlev(1:mm_nla) = mm_zlev(1:mm_nle-1)-mm_zlev(2:mm_nle)
666
667	! Computes atmospheric layers thickness :
668	mm_dzlay(1:mm_nla-1) = mm_zlay(1:mm_nla-1)-mm_zlay(2:mm_nla)
669	mm_dzlay(mm_nla) = mm_dzlay(mm_nla-1)
670
671	! Hydrostatic equilibrium:
672	mm_rhoair(1:mm_nla) = (mm_plev(2:mm_nle)-mm_plev(1:mm_nla)) / (mm_effg(mm_zlay)*mm_dzlev)
673
674	! Write out profiles for debug and log:
675	IF (mm_log.AND.mm_debug) THEN
676	WRITE(*,'(a)') '# TEMP PLAY ZLAY DZLAY RHOAIR'
677	DO i=1,mm_nla
678	WRITE(*,'(5(ES15.7,2X))') mm_temp(i),mm_play(i),mm_zlay(i),mm_dzlay(i), mm_rhoair(i)
679	ENDDO
680	WRITE(*,'(a)') '# TEMP PLEV ZLEV DZLEV'
681	DO i=1,mm_nle
682	IF (i /= mm_nle) THEN
683	WRITE(*,'(4(ES15.7,2X))') mm_btemp(i),mm_plev(i),mm_zlev(i),mm_dzlev(i)
684	ELSE
685	WRITE(*,'(3(ES15.7,2X))') mm_btemp(i),mm_plev(i),mm_zlev(i)
686	ENDIF
687	ENDDO
688	ENDIF
689
690	! End of initialization:
691	mm_ini_col = .true.
692
693	RETURN
694	END FUNCTION mm_column_init
695
696
697	FUNCTION mm_aerosols_init(m0aer_s,m3aer_s,m0aer_f,m3aer_f) RESULT(err)
698	!! Initialize aerosol tracers vertical grid.
699	!!
700	!! The subroutine initializes aerosols microphysics tracers columns. It allocates variables if
701	!! required and stores input vectors in reversed order. It also computes the characteristic radii
702	!! of each mode.
703	!!
704	!! @warning
705	!! The method should be called after mm_global_init and mm_column_init. Moreover, it should be called
706	!! whenever the vertical structure of the atmosphere changes.
707	!! All the input vectors should be defined from __GROUND__ to __TOP__ of the atmosphere,
708	!! otherwise nasty things will occur in computations.
709	!!
710	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m0aer_s ! 0th order moment of the spherical mode (m-2).
711	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m3aer_s ! 3rd order moment of the spherical mode (m3.m-2).
712	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m0aer_f ! 0th order moment of the fractal mode (m-2).
713	REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m3aer_f ! 3rd order moment of the fractal mode (m3.m-2).
714	TYPE(error) :: err ! Error status of the function.
715
716	err = noerror
717
718	! Global initialization must be done before:
719	IF (.NOT.mm_ini) THEN
720	err = error("mm_aerosols_init: Global initialization not done yet",-1) ; RETURN
721	ENDIF
722
723	! Column initialization must be done before:
724	IF (.NOT.mm_ini_col) THEN
725	err = error("mm_aerosols_init: Column initialization not done yet",-1) ; RETURN
726	ENDIF
727
728	! Sanity check:
729	IF (SIZE(m0aer_s) /= mm_nla) THEN
730	err = error("mm_aerosols_init: Invalid size for input arrays",-1) ; RETURN
731	ENDIF
732
733	! Allocate variable if required:
734	IF (.NOT.ALLOCATED(mm_m0aer_s)) ALLOCATE(mm_m0aer_s(mm_nla))
735	IF (.NOT.ALLOCATED(mm_m3aer_s)) ALLOCATE(mm_m3aer_s(mm_nla))
736	IF (.NOT.ALLOCATED(mm_m0aer_f)) ALLOCATE(mm_m0aer_f(mm_nla))
737	IF (.NOT.ALLOCATED(mm_m3aer_f)) ALLOCATE(mm_m3aer_f(mm_nla))
738	IF (.NOT.ALLOCATED(mm_rcs)) ALLOCATE(mm_rcs(mm_nla))
739	IF (.NOT.ALLOCATED(mm_rcf)) ALLOCATE(mm_rcf(mm_nla))
740
741	! Allocate memory for diagnostics if required:
742	IF (.NOT.ALLOCATED(mm_m0as_vsed)) THEN
743	ALLOCATE(mm_m0as_vsed(mm_nla))
744	mm_m0as_vsed(:) = 0._mm_wp
745	ENDIF
746	IF (.NOT.ALLOCATED(mm_m3as_vsed)) THEN
747	ALLOCATE(mm_m3as_vsed(mm_nla))
748	mm_m3as_vsed(:) = 0._mm_wp
749	ENDIF
750	IF (.NOT.ALLOCATED(mm_m0af_vsed)) THEN
751	ALLOCATE(mm_m0af_vsed(mm_nla))
752	mm_m0af_vsed(:) = 0._mm_wp
753	ENDIF
754	IF (.NOT.ALLOCATED(mm_m3af_vsed)) THEN
755	ALLOCATE(mm_m3af_vsed(mm_nla))
756	mm_m3af_vsed(:) = 0._mm_wp
757	ENDIF
758	IF (.NOT.ALLOCATED(mm_aer_s_flux)) THEN
759	ALLOCATE(mm_aer_s_flux(mm_nla))
760	mm_aer_s_flux(:) = 0._mm_wp
761	ENDIF
762	IF (.NOT.ALLOCATED(mm_aer_f_flux)) THEN
763	ALLOCATE(mm_aer_f_flux(mm_nla))
764	mm_aer_f_flux(:) = 0._mm_wp
765	ENDIF
766
767	! Initialization of aerosol tracers:
768	! @note: mm_dzlev is already from top to ground
769	mm_m0aer_s = m0aer_s(mm_nla:1:-1)/mm_dzlev(:)
770	mm_m3aer_s = m3aer_s(mm_nla:1:-1)/mm_dzlev(:)
771	mm_m0aer_f = m0aer_f(mm_nla:1:-1)/mm_dzlev(:)
772	mm_m3aer_f = m3aer_f(mm_nla:1:-1)/mm_dzlev(:)
773
774	! Setup threshold (useful for preventing bugs):
775	call mm_set_moments_thresholds()
776
777	! Initialization of spherical aerosol characteristic radii:
778	WHERE(mm_m3aer_s > 0._mm_wp .AND. mm_m0aer_s > 0._mm_wp)
779	mm_rcs = mm_get_rcs(mm_m0aer_s,mm_m3aer_s)
780	ELSEWHERE
781	mm_rcs = 0._mm_wp
782	ENDWHERE
783
784	! Initialization of fractal aerosol characteristic radii:
785	WHERE(mm_m3aer_f > 0._mm_wp .AND. mm_m0aer_f > 0._mm_wp)
786	mm_rcf = mm_get_rcf(mm_m0aer_f,mm_m3aer_f)
787	ELSEWHERE
788	mm_rcf = 0._mm_wp
789	ENDWHERE
790
791	! End of initialization:
792	mm_ini_aer = .true.
793
794	END FUNCTION mm_aerosols_init
795
796
797	!============================================================================
798	! INTER-MOMENT RELATION METHODS
799	!============================================================================
800
801	PURE FUNCTION mm_alpha_s(k) RESULT (res)
802	!! Inter-moment relation for spherical aerosols size distribution law.
803	!! Mk / M0 = rc^k . alpha(k)
804	!!
805	REAL(kind=mm_wp), INTENT(in) :: k ! k order of the moment.
806	REAL(kind=mm_wp) :: sigma ! Standard deviation.
807	REAL(kind=mm_wp) :: res ! Alpha value.
808
809	! Titan's case
810	!~~~~~~~~~~~~~
811	! res = SUM(dexp(mm_asp%ak2 + mm_asp%bk + mm_asp%c))
812
813	! Pluto's case
814	!~~~~~~~~~~~~~
815	sigma = 0.2_mm_wp
816	res = exp(k*2 sigma**2 / 2._mm_wp)
817
818	RETURN
819	END FUNCTION mm_alpha_s
820
821
822	PURE FUNCTION mm_alpha_f(k) RESULT (res)
823	!! Inter-moment relation for fractal aerosols size distribution law.
824	!! Mk / M0 = rc^k . alpha(k)
825	!!
826	REAL(kind=mm_wp), INTENT(in) :: k ! k order of the moment.
827	REAL(kind=mm_wp) :: sigma ! Standard deviation.
828	REAL(kind=mm_wp) :: res ! Alpha value.
829
830	! Titan's case
831	!~~~~~~~~~~~~~
832	! res = SUM(dexp(mm_afp%ak2 + mm_afp%bk + mm_afp%c))
833
834	! Pluto's case
835	!~~~~~~~~~~~~~
836	sigma = 0.35_mm_wp
837	res = exp(k*2 sigma**2 / 2._mm_wp)
838
839	RETURN
840	END FUNCTION mm_alpha_f
841
842
843	!============================================================================
844	! MISCELLANEOUS METHODS
845	!============================================================================
846
847	ELEMENTAL FUNCTION mm_effg(z) RESULT(effg)
848	!! Compute effective gravitational acceleration.
849	!!
850	REAL(kind=mm_wp), INTENT(in) :: z ! Altitude (m)
851	REAL(kind=mm_wp) :: effg ! Effective gravitational acceleration (m.s-2)
852	effg = mm_g0
853	IF (mm_use_effg) THEN
854	effg = effg * (mm_rpla/(mm_rpla+z))**2
855	ENDIF
856	RETURN
857	END FUNCTION mm_effg
858
859
860	SUBROUTINE mm_set_moments_thresholds()
861	!! Apply minimum threshold for the aerosols moments.
862	!!
863	!! The method resets moments (for both modes and orders, 0 and 3) values to zero if
864	!! their current value is below the minimum threholds.
865	!!
866	INTEGER :: i
867	DO i=1,mm_nla
868	IF ((mm_m0aer_s(i) < mm_m0as_min) .OR. (mm_m3aer_s(i) < mm_m3as_min)) THEN
869	mm_m0aer_s(i) = 0._mm_wp
870	mm_m3aer_s(i) = 0._mm_wp
871	ENDIF
872	IF ((mm_m0aer_f(i) < mm_m0af_min) .OR. (mm_m3aer_f(i) < mm_m3af_min)) THEN
873	mm_m0aer_f(i) = 0._mm_wp
874	mm_m3aer_f(i) = 0._mm_wp
875	ENDIF
876	ENDDO
877	END SUBROUTINE mm_set_moments_thresholds
878
879
880	ELEMENTAL FUNCTION mm_get_rcs(m0,m3) RESULT(res)
881	!! Get the characteristic radius for the spherical aerosols size distribution.
882	!!
883	!! The method computes the characteristic radius of the spherical aerosol size distribution
884	!! law according to its moments and its inter-moments relation.
885	!!
886	REAL(kind=mm_wp), INTENT(in) :: m0 ! 0th order moment
887	REAL(kind=mm_wp), INTENT(in) :: m3 ! 3rd order moment
888	REAL(kind=mm_wp) :: res ! Radius
889	res = (m3 / (m0mm_alpha_s(3._mm_wp)))*(1._mm_wp/3._mm_wp)
890	END FUNCTION mm_get_rcs
891
892
893	ELEMENTAL FUNCTION mm_get_rcf(m0,m3) RESULT(res)
894	!! Get the characteristic radius for the fractal aerosols size distribution.
895	!!
896	!! The method computes the characteristic radius of the fractal aerosol size distribution
897	!! law according to its moments and its inter-moments relation.
898	!!
899	REAL(kind=mm_wp), INTENT(in) :: m0 ! 0th order moment
900	REAL(kind=mm_wp), INTENT(in) :: m3 ! 3rd order moment
901	REAL(kind=mm_wp) :: res ! Radius
902	res = (m3 / (m0mm_alpha_f(3._mm_wp)))*(1._mm_wp/3._mm_wp)
903	END FUNCTION mm_get_rcf
904
905
906	SUBROUTINE mm_dump_parameters()
907	!! Dump global parameters on stdout.
908	!!
909	WRITE(*,'(a)') "========= YAMMS PARAMETERS ============"
910	WRITE(*,'(a,a)') "mm_fp_precision : ", mm_wp_s
911	WRITE(*,'(a,L2)') "mm_debug : ", mm_debug
912	WRITE(*,'(a)') "---------------------------------------"
913	WRITE(*,'(a)') "Microphysical control flags"
914
915	! Haze production:
916	WRITE(*,'(a,L2)') "mm_w_haze_prod : ", mm_w_haze_prod
917	WRITE(*,'(a,ES14.7)') "mm_rc_prod (m) : ", mm_rc_prod
918	WRITE(*,'(a,L2)') "mm_haze_prod_pCH4 : ", mm_haze_prod_pCH4
919	IF (.NOT. mm_haze_prod_pCH4) THEN
920	WRITE(*,'(a,ES14.7)') " --> mm_p_prod (Pa) : ", mm_p_prod
921	WRITE(*,'(a,ES14.7)') " --> mm_tx_prod (kg.m-2.s-1): ", mm_tx_prod
922
923	ENDIF
924
925	! Haze coagulation:
926	WRITE(*,'(a,L2)') "mm_w_haze_coag : ", mm_w_haze_coag
927	IF (mm_w_haze_coag) THEN
928	WRITE(*,'(a,I2.2)') " --> mm_coag_interactions : ", mm_coag_choice
929	ENDIF
930
931	! Haze sedimentation:
932	WRITE(*,'(a,L2)') "mm_w_haze_sed : ", mm_w_haze_sed
933	IF (mm_w_haze_sed) THEN
934	WRITE(*,'(a,L2)') " --> mm_wsed_m0 : ", mm_wsed_m0
935	WRITE(*,'(a,L2)') " --> mm_wsed_m3 : ", mm_wsed_m3
936	ENDIF
937	WRITE(*,'(a)') "---------------------------------------"
938
939	! Haze threshold:
940	WRITE(*,'(a)') "Spherical aerosol thresholds"
941	WRITE(*,'(a,ES14.7)') " mm_m0as_min (m-3) : ", mm_m0as_min
942	WRITE(*,'(a,ES14.7)') " mm_rcs_min (m) : ", mm_rcs_min
943	WRITE(*,'(a)') "Fractal aerosol thresholds"
944	WRITE(*,'(a,ES14.7)') " mm_m0af_min (m-3) : ", mm_m0af_min
945	WRITE(*,'(a,ES14.7)') " mm_rcf_min (m) : ", mm_rcf_min
946	WRITE(*,'(a)') "---------------------------------------"
947
948	! Free parameters:
949	WRITE(*,'(a)') "Free parameters"
950	WRITE(*,'(a,ES14.7)') "mm_rm (m) : ", mm_rm
951	WRITE(*,'(a,ES14.7)') "mm_df (-) : ", mm_df
952	WRITE(*,'(a,ES14.7)') "mm_rhoaer (kg.m-3) : ", mm_rhoaer
953	WRITE(*,'(a,ES14.7)') "mm_rplanete (m) : ", mm_rpla
954	WRITE(*,'(a,ES14.7)') "mm_g0 (m.s-2) : ", mm_g0
955	WRITE(*,'(a,ES14.7)') "mm_air_rad (m) : ", mm_air_rad
956	WRITE(*,'(a,ES14.7)') "mm_air_mmol (kg.mol-1) : ", mm_air_mmol
957	WRITE(*,'(a,ES14.7)') "mm_air_mmas (kg) : ", mm_air_mmas
958	WRITE(*,'(a,ES14.7)') "mm_dt (s) : ", mm_dt
959	IF (mm_nla > -1) THEN
960	WRITE(*,'(a,I3.3)') "mm_nla : ", mm_nla
961	ELSE
962	WRITE(*,'(a)') "mm_nla : not initialized yet"
963	ENDIF
964	WRITE(*,'(a)') "======================================="
965	END SUBROUTINE mm_dump_parameters
966
967
968	! =========================================================================
969	! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
970	! CONFIGURATION PARSER checking methods
971	! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
972	! =========================================================================
973
974	FUNCTION check_r1(err,var,def,wlog) RESULT(ret)
975	!! Check an option value (float).
976	!!
977	!! The method checks an option value and optionally set a default value, __def__ to initialize
978	!! __var__ on error if given.
979	!!
980	TYPE(error), INTENT(in) :: err ! Error object from value getter.
981	REAL(kind=mm_wp), INTENT(inout) :: var ! Input/output option value.
982	REAL(kind=mm_wp), INTENT(in), OPTIONAL :: def ! Default value to set.
983	LOGICAL, INTENT(in), OPTIONAL :: wlog ! .true. to print warning/error message.
984	TYPE(error) :: ret ! Input error.
985	CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
986	LOGICAL :: zlog
987	ret = err
988	zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
989	IF (err == 0) RETURN
990	IF (PRESENT(def)) THEN
991	var = def
992	IF (zlog) WRITE(*,'(a,a,a)') error_to_string(err,'',.true.),defmsg,to_string(var)
993	ret = noerror
994	ELSE
995	IF (zlog) WRITE(*,'(a)') error_to_string(err,'',.true.)
996	ENDIF
997	END FUNCTION check_r1
998
999	FUNCTION check_l1(err,var,def,wlog) RESULT(ret)
1000	!! Check an option value (logical).
1001	!!
1002	!! The method checks an option value and optionally set a default value, __def__ to initialize
1003	!! __var__ on error if given.
1004	!!
1005	TYPE(error), INTENT(in) :: err ! Error object from value getter.
1006	LOGICAL, INTENT(inout) :: var ! Input/output option value.
1007	LOGICAL, INTENT(in), OPTIONAL :: def ! Default value to set.
1008	LOGICAL, INTENT(in), OPTIONAL :: wlog ! .true. to print warning/error message.
1009	TYPE(error) :: ret ! Input error.
1010	CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
1011	LOGICAL :: zlog
1012	ret = err
1013	zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
1014	IF (err == 0) RETURN
1015	IF (PRESENT(def)) THEN
1016	var = def
1017	IF (zlog) WRITE(*,'(a,a,a)') error_to_string(err,'',.true.),defmsg,to_string(var)
1018	ret = noerror
1019	ELSE
1020	IF (zlog) WRITE(*,'(a)') error_to_string(err,'',.true.)
1021	ENDIF
1022	END FUNCTION check_l1
1023
1024	FUNCTION check_i1(err,var,def,wlog) RESULT(ret)
1025	!! Check an option value (integer).
1026	!!
1027	!! The method checks an option value and optionally set a default value, __def__ to initialize
1028	!! __var__ on error if given.
1029	!!
1030	TYPE(error), INTENT(in) :: err ! Error object from value getter.
1031	INTEGER, INTENT(inout) :: var ! Input/output option value.
1032	INTEGER, INTENT(in), OPTIONAL :: def ! Default value to set.
1033	LOGICAL, INTENT(in), OPTIONAL :: wlog ! .true. to print warning/error message.
1034	TYPE(error) :: ret ! Input error.
1035	CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
1036	LOGICAL :: zlog
1037	ret = err
1038	zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
1039	IF (err == 0) RETURN
1040	IF (PRESENT(def)) THEN
1041	var = def
1042	IF (zlog) WRITE(*,'(a,a,a)') error_to_string(err,'',.true.),defmsg,to_string(var)
1043	ret = noerror
1044	ELSE
1045	IF (zlog) WRITE(*,'(a)') error_to_string(err,'',.true.)
1046	ENDIF
1047	END FUNCTION check_i1
1048
1049	FUNCTION check_s1(err,var,def,wlog) RESULT(ret)
1050	!! Check an option value (string).
1051	!!
1052	!! The method checks an option value and optionally set a default value, __def__ to initialize
1053	!! __var__ on error if given.
1054	!!
1055	TYPE(error), INTENT(in) :: err ! Error object from value getter.
1056	CHARACTER(len=*), INTENT(inout) :: var ! Input/output option value.
1057	CHARACTER(len=*), INTENT(in), OPTIONAL :: def ! Default value to set.
1058	LOGICAL, INTENT(in), OPTIONAL :: wlog ! .true. to print warning/error message.
1059	TYPE(error) :: ret ! Input error.
1060	CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
1061	LOGICAL :: zlog
1062	ret = err
1063	zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
1064	IF (err == 0) RETURN
1065	IF (PRESENT(def)) THEN
1066	var = TRIM(def)
1067	IF (zlog) WRITE(*,'(a,a,a)') error_to_string(err,'',.true.),defmsg,var
1068	ret = noerror
1069	ELSE
1070	IF (zlog) WRITE(*,'(a)') error_to_string(err,'')
1071	ENDIF
1072	RETURN
1073	END FUNCTION check_s1
1074
1075	END MODULE MP2M_GLOBALS

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format