Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mp2m_intgcm.F90 @ 3590

Last change on this file since 3590 was 3560, checked in by debatzbr, 5 weeks ago
Addition of the microphysics model in moments.
File size: 12.0 KB

Line
1	MODULE MP2M_INTGCM
2	!============================================================================
3	!
4	! Purpose
5	! -------
6	! Interface to YAMMS for the LMDZ GCM.
7	! --> It initializes all the parameters of the model from direct input (mm_global_init).
8	!
9	! The module also contains three methods:
10	! - mm_initialize(dt,haze_prod_pCH4,p_prod,tx_prod,rc_prod,rm,df,rho_aer,rplanet,g0,air_rad,air_mmol,cfgpath)
11	! - read_aprm(parser,sec,pp)
12	! - abort_program(err)
13	!
14	! Authors
15	! -------
16	! B. de Batz de Trenquelléon, J. Burgalat (11/2024)
17	!
18	!============================================================================
19
20	USE MP2M_MPREC
21	USE MP2M_GLOBALS
22	USE MP2M_MICROPHYSICS
23	USE MP2M_HAZE
24	USE MP2M_METHODS
25	USE SWIFT_CFGPARSE
26	USE LINT_DATASETS
27	IMPLICIT NONE
28
29	CONTAINS
30
31	SUBROUTINE mm_initialize(dt,haze_prod_pCH4,p_prod,tx_prod,rc_prod,rm,df,rho_aer,rplanet,g0,air_rad,air_mmol,cfgpath)
32	!! Initialize global parameters of the model.
33	!!
34	!! The function initializes all the global parameters of the model from direct input.
35	!! Boolean parameters are optional as they are rather testing parameters.
36	!!
37	!! @note
38	!! If the subroutine fails to initialize parameters, the run is aborted.
39	!!
40	!! @warning
41	!! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
42	!! initializes global variable that are not thread private.
43	!!
44
45	! Microphysics timestep (s).
46	REAL(kind=mm_wp), INTENT(in) :: dt
47	! Enable/Disable production from CH4 photolysis.
48	LOGICAL :: haze_prod_pCH4
49	! Aerosol production pressure level (Pa).
50	REAL(kind=mm_wp), INTENT(in) :: p_prod
51	! Spherical aerosol production rate (kg.m-2.s-1).
52	REAL(kind=mm_wp), INTENT(in) :: tx_prod
53	! Spherical aerosol characteristic radius production (m).
54	REAL(kind=mm_wp), INTENT(in) :: rc_prod
55	! Monomer radius (m).
56	REAL(kind=mm_wp), INTENT(in) :: rm
57	! Fractal dimension of aerosols (-).
58	REAL(kind=mm_wp), INTENT(in) :: df
59	! Aerosol density (kg.m-3).
60	REAL(kind=mm_wp), INTENT(in) :: rho_aer
61	! Planet radius (m).
62	REAL(kind=mm_wp), INTENT(in) :: rplanet
63	! Planet gravity acceleration at ground level (m.s-2).
64	REAL(kind=mm_wp), INTENT(in) :: g0
65	! Mean radius of air molecules (m).
66	REAL(kind=mm_wp), INTENT(in) :: air_rad
67	! Mean molar mass of air molecules (kg.mol-1).
68	REAL(kind=mm_wp), INTENT(in) :: air_mmol
69	! Internal microphysics configuration file.
70	CHARACTER(len=*), INTENT(in), OPTIONAL :: cfgpath
71
72	! Microphysical configuration file.
73	TYPE(cfgparser) :: cparser
74	! Look-up tables (transfert probabilities, mean electric correction).
75	CHARACTER(len=st_slen) :: pssfile,mqfile
76	! Enable/disable Haze process.
77	LOGICAL :: w_h_prod,w_h_sed,w_h_coag,fwsed_m0,fwsed_m3
78	! Coagulation interactions
79	INTEGER :: coag_choice
80	! Thresholds related parameters.
81	REAL(kind=mm_wp) :: m0as_min,rcs_min,m0af_min,rcf_min
82	! Debug mode control flag (may print lot of stuff if enabled).
83	LOGICAL :: wdebug
84
85	! Local variables.
86	TYPE(error) :: err
87	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: tmp
88
89	!-----------------------------
90	! 1. Parameters initialization
91	!-----------------------------
92	w_h_prod = .true.
93	w_h_sed = .true.
94	w_h_coag = .true.
95	fwsed_m0 = .true.
96	fwsed_m3 = .false.
97	coag_choice = 7
98	m0as_min = 1e-8_mm_wp
99	rcs_min = 1e-9_mm_wp
100	m0af_min = 1e-8_mm_wp
101	rcf_min = 1e-9_mm_wp
102	wdebug = .false.
103
104	WRITE(*,'(a)') "##### MM_GCM SPEAKING #####"
105	WRITE(*,'(a)') "I will initialize the microphysics model in moments YAMMS"
106	WRITE(*,'(a)') "On error I will simply abort the program. Stay near your computer !"
107	WRITE(,)
108	WRITE(*,'(a)') "Reading muphys configuration file ("//trim(cfgpath)//")."
109	err = cfg_read_config(cparser,TRIM(cfgpath),.true.)
110	IF (err /= 0) THEN
111	WRITE(*,'(a)') "Error when reading muphys configuration file in mm_initialize..."
112	call abort_program(err)
113	ENDIF
114
115	! YAMMS internal parameters:
116	! ~~~~~~~~~~~~~~~~~~~~~~~~~~
117	! The following parameters are primarily used to test and debug YAMMS.
118	! They are set in an optional configuration file and default to suitable values for production runs.
119	err = mm_check_opt(cfg_get_value(cparser,"haze_production",w_h_prod) ,w_h_prod ,.true. ,mm_log)
120	err = mm_check_opt(cfg_get_value(cparser,"haze_sedimentation",w_h_sed) ,w_h_sed ,.true. ,mm_log)
121	err = mm_check_opt(cfg_get_value(cparser,"haze_coagulation",w_h_coag) ,w_h_coag ,.true. ,mm_log)
122	err = mm_check_opt(cfg_get_value(cparser,"wsed_m0",fwsed_m0) ,fwsed_m0 ,.true. ,mm_log)
123	err = mm_check_opt(cfg_get_value(cparser,"wsed_m3",fwsed_m3) ,fwsed_m3 ,.false. ,mm_log)
124	err = mm_check_opt(cfg_get_value(cparser,"haze_coag_interactions",coag_choice),coag_choice,7 ,mm_log)
125	err = mm_check_opt(cfg_get_value(cparser,"m0as_min",m0as_min) ,m0as_min ,1e-8_mm_wp,mm_log)
126	err = mm_check_opt(cfg_get_value(cparser,"rcs_min",rcs_min) ,rcs_min ,1e-9_mm_wp,mm_log)
127	err = mm_check_opt(cfg_get_value(cparser,"m0af_min",m0af_min) ,m0af_min ,1e-8_mm_wp,mm_log)
128	err = mm_check_opt(cfg_get_value(cparser,"rcf_min",rcf_min) ,rcf_min ,rm ,mm_log)
129	err = mm_check_opt(cfg_get_value(cparser,"debug",wdebug) ,wdebug ,.false. ,mm_log)
130
131	! Alpha function:
132	! ~~~~~~~~~~~~~~~
133	! Spherical mode inter-moments function parameters.
134	IF (.NOT.cfg_has_section(cparser,'alpha_s')) call abort_program(error("Cannot find [alpha_s] section",-1))
135	err = read_aprm(cparser,'alpha_s',mm_asp)
136	IF (err /= 0) call abort_program(error("alpha_s: "//TRIM(err%msg),-1))
137	! Fractal mode inter-moments function parameters.
138	IF (.NOT.cfg_has_section(cparser,'alpha_f')) call abort_program(error("Cannot find [alpha_f] section",-1))
139	err = read_aprm(cparser,'alpha_f',mm_afp)
140	IF (err /= 0) call abort_program(error("alpha_s: "//TRIM(err%msg),-1))
141
142	! Transfert probabilities (S --> F):
143	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
144	err = mm_check_opt(cfg_get_value(cparser, "transfert_probability", mm_w_ps2s), mm_w_ps2s, wlog=mm_log)
145	IF (err/=0) call abort_program(err)
146
147	IF (mm_w_haze_coag .AND. mm_w_ps2s) THEN
148	err = mm_check_opt(cfg_get_value(cparser, "ps2s_file", pssfile), pssfile)
149	IF (err /= 0) call abort_program(err)
150
151	IF (.NOT.read_dset(pssfile,'p_m0_co',mm_pco0p)) THEN
152	call abort_program(error("Cannot get 'p_m0_co' from "//pssfile,-1))
153	ENDIF
154	IF (.NOT.read_dset(pssfile,'p_m3_co',mm_pco3p)) THEN
155	call abort_program(error("Cannot get 'p_m3_co' from "//pssfile,-1))
156	ENDIF
157	IF (.NOT.read_dset(pssfile,'p_m0_fm',mm_pfm0p)) THEN
158	call abort_program(error("Cannot get 'p_m0_fm' from "//pssfile,-1))
159	ENDIF
160	IF (.NOT.read_dset(pssfile,'p_m3_fm',mm_pfm3p)) THEN
161	call abort_program(error("Cannot get 'p_m3_fm' from "//pssfile,-1))
162	ENDIF
163	ENDIF
164
165	! Mean electric correction:
166	! ~~~~~~~~~~~~~~~~~~~~~~~~~
167	err = mm_check_opt(cfg_get_value(cparser, "electric_charging", mm_w_qe), mm_w_qe, wlog=mm_log)
168	IF (err/=0) call abort_program(err)
169
170	IF (mm_w_haze_coag .AND. mm_w_qe) THEN
171	err = mm_check_opt(cfg_get_value(cparser, "mq_file", mqfile), mqfile)
172	IF (err /= 0) call abort_program(err)
173
174	IF (.NOT.read_dset(mqfile,'qbsf0',mm_qbsf0)) THEN
175	call abort_program(error("Cannot get 'qbsf0' from "//mqfile,-1))
176	ELSE
177	mm_qbsf0_e(1,1) = MINVAL(mm_qbsf0%x)
178	mm_qbsf0_e(1,2) = MAXVAL(mm_qbsf0%x)
179	mm_qbsf0_e(2,1) = MINVAL(mm_qbsf0%y)
180	mm_qbsf0_e(2,2) = MAXVAL(mm_qbsf0%y)
181	ENDIF
182	IF (.NOT.read_dset(mqfile,'qbsf3',mm_qbsf3)) THEN
183	call abort_program(error("Cannot get 'qbsf3' from "//mqfile,-1))
184	ELSE
185	mm_qbsf3_e(1,1) = MINVAL(mm_qbsf3%x)
186	mm_qbsf3_e(1,2) = MAXVAL(mm_qbsf3%x)
187	mm_qbsf3_e(2,1) = MINVAL(mm_qbsf3%y)
188	mm_qbsf3_e(2,2) = MAXVAL(mm_qbsf3%y)
189	ENDIF
190	IF (.NOT.read_dset(mqfile,'qbff0',mm_qbff0)) THEN
191	call abort_program(error("Cannot get 'qbff0' from "//mqfile,-1))
192	ELSE
193	mm_qbff0_e(1,1) = MINVAL(mm_qbff0%x)
194	mm_qbff0_e(1,2) = MAXVAL(mm_qbff0%x)
195	mm_qbff0_e(2,1) = MINVAL(mm_qbff0%y)
196	mm_qbff0_e(2,2) = MAXVAL(mm_qbff0%y)
197	ENDIF
198	ENDIF
199
200	! btk coefficients:
201	! ~~~~~~~~~~~~~~~~~
202	IF (.NOT.cfg_has_section(cparser,'btks')) call abort_program(error("Cannot find [btks] section",-1))
203
204	err = cfg_get_value(cparser,"btks/bt0",tmp) ; IF (err/=0) call abort_program(error("bt0: "//TRIM(err%msg),-1))
205	IF (SIZE(tmp) /= 5) call abort_program(error("bt0: Inconsistent number of coefficients",-1))
206	mm_bt0 = tmp
207	err = cfg_get_value(cparser,"btks/bt3",tmp) ; IF (err/=0) call abort_program(error("bt3: "//TRIM(err%msg),-1))
208	IF (SIZE(tmp) /= 5) call abort_program(error("bt3: Inconsistent number of coefficients",-1))
209	mm_bt3 = tmp
210
211	!------------------------
212	! 2. YAMMS initialization
213	!------------------------
214	err = mm_global_init_0(dt,df,rm,rho_aer,haze_prod_pCH4,p_prod,tx_prod,rc_prod, &
215	rplanet,g0,air_rad,air_mmol,coag_choice, &
216	w_h_prod,w_h_sed,w_h_coag,fwsed_m0,fwsed_m3, &
217	m0as_min,rcs_min,m0af_min,rcf_min,wdebug)
218	IF (err /= 0) call abort_program(err)
219
220	! Dump parameters.
221	WRITE(*,'(a)') "========= MUPHYS PARAMETERS ==========="
222	WRITE(*,'(a,L2)') "transfert_probability: ", mm_w_ps2s
223	WRITE(*,'(a,L2)') "electric_charging : ", mm_w_qe
224	call mm_dump_parameters()
225
226	END SUBROUTINE mm_initialize
227
228
229	FUNCTION read_aprm(parser,sec,pp) RESULT(err)
230	!! Read and store alpha function parameters.
231	!!
232	TYPE(cfgparser), INTENT(in) :: parser !! Configuration parser
233	CHARACTER(len=*), INTENT(in) :: sec !! Name of the section that contains the parameters.
234	TYPE(aprm), INTENT(out) :: pp !! Object that stores the parameters values.
235	TYPE(error) :: err !! Error status of the function.
236	err = cfg_get_value(parser,TRIM(sec)//'/a',pp%a) ; IF (err /= 0) RETURN
237	err = cfg_get_value(parser,TRIM(sec)//'/b',pp%b) ; IF (err /= 0) RETURN
238	err = cfg_get_value(parser,TRIM(sec)//'/c',pp%c) ; IF (err /= 0) RETURN
239	IF (SIZE(pp%a) /= SIZE(pp%b) .OR. SIZE(pp%a) /= SIZE(pp%c)) &
240	err = error("Inconsistent number of coefficients (a,b, and c must have the same size)",-1)
241	RETURN
242	END FUNCTION read_aprm
243
244
245	SUBROUTINE abort_program(err)
246	!! Dump error message and abort the program.
247	!!
248	TYPE(error), INTENT(in) :: err !! Error object.
249	WRITE(stderr,'(a)') "ERROR: "//TRIM(err%msg)
250	CALL EXIT(err%id)
251	END SUBROUTINE abort_program
252
253	END MODULE MP2M_INTGCM

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

Download in other formats:

Original Format