Context Navigation

mp2m_intgcm.F90 @ 3953

Last change on this file since 3953 was 3953, checked in by debatzbr, 4 weeks ago
Pluto PCM: Fix minor bug. BBT
File size: 13.2 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,call_CH4hazeprod,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,call_CH4hazeprod,p_prod,tx_prod,rc_prod,rm,df,rho_aer,rplanet,g0,air_rad,air_mmol,clouds,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 :: call_CH4hazeprod
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	! Clouds microphysics control flag.
70	LOGICAL, INTENT(in) :: clouds
71	! Internal microphysics configuration file.
72	CHARACTER(len=*), INTENT(in), OPTIONAL :: cfgpath
73
74	! Microphysical configuration file.
75	TYPE(cfgparser) :: cparser
76	! Look-up tables - Haze related: transfert probabilities, mean electric correction.
77	CHARACTER(len=st_slen) :: pssfile,mqfile
78	! Look-up tables - Cloud related: species properties.
79	CHARACTER(len=st_slen) :: spcpath
80	! Enable/disable Haze process.
81	LOGICAL :: w_h_prod,w_h_sed,w_h_coag,fwsed_m0,fwsed_m3
82	! Coagulation interactions
83	INTEGER :: coag_choice
84	! Thresholds related parameters.
85	REAL(kind=mm_wp) :: m0as_min,rcs_min,m0af_min,rcf_min
86	REAL(kind=mm_wp) :: m0ccn_min,drad_min
87	! Debug mode control flag (may print lot of stuff if enabled).
88	LOGICAL :: wdebug
89
90	! Local variables.
91	INTEGER :: i
92	TYPE(error) :: err
93	REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: tmp
94
95	!-----------------------------
96	! 1. Parameters initialization
97	!-----------------------------
98	w_h_prod = .true.
99	w_h_sed = .true.
100	w_h_coag = .true.
101	fwsed_m0 = .true.
102	fwsed_m3 = .false.
103	coag_choice = 7
104	m0as_min = 1e-8_mm_wp
105	rcs_min = 1e-9_mm_wp
106	m0af_min = 1e-8_mm_wp
107	rcf_min = 1e-9_mm_wp
108	m0ccn_min = 1e-8_mm_wp
109	drad_min = 1e-9_mm_wp
110	wdebug = .false.
111
112	WRITE(*,'(a)') "##### MM_GCM SPEAKING #####"
113	WRITE(*,'(a)') "I will initialize the microphysics model in moments YAMMS"
114	WRITE(*,'(a)') "On error I will simply abort the program. Stay near your computer !"
115	WRITE(,)
116	WRITE(*,'(a)') "Reading muphys configuration file ("//trim(cfgpath)//")."
117	err = cfg_read_config(cparser,TRIM(cfgpath),.true.)
118	IF (err /= 0) THEN
119	WRITE(*,'(a)') "Error when reading muphys configuration file in mm_initialize..."
120	call abort_program(err)
121	ENDIF
122
123	! YAMMS internal parameters:
124	! ~~~~~~~~~~~~~~~~~~~~~~~~~~
125	! The following parameters are primarily used to test and debug YAMMS.
126	! They are set in an optional configuration file and default to suitable values for production runs.
127	err = mm_check_opt(cfg_get_value(cparser,"haze_production",w_h_prod) ,w_h_prod ,.true. ,mm_log)
128	err = mm_check_opt(cfg_get_value(cparser,"haze_sedimentation",w_h_sed) ,w_h_sed ,.true. ,mm_log)
129	err = mm_check_opt(cfg_get_value(cparser,"haze_coagulation",w_h_coag) ,w_h_coag ,.true. ,mm_log)
130	err = mm_check_opt(cfg_get_value(cparser,"wsed_m0",fwsed_m0) ,fwsed_m0 ,.true. ,mm_log)
131	err = mm_check_opt(cfg_get_value(cparser,"wsed_m3",fwsed_m3) ,fwsed_m3 ,.false. ,mm_log)
132	err = mm_check_opt(cfg_get_value(cparser,"haze_coag_interactions",coag_choice),coag_choice,7 ,mm_log)
133	err = mm_check_opt(cfg_get_value(cparser,"m0as_min",m0as_min) ,m0as_min ,1e-8_mm_wp,mm_log)
134	err = mm_check_opt(cfg_get_value(cparser,"rcs_min",rcs_min) ,rcs_min ,1e-9_mm_wp,mm_log)
135	err = mm_check_opt(cfg_get_value(cparser,"m0af_min",m0af_min) ,m0af_min ,1e-8_mm_wp,mm_log)
136	err = mm_check_opt(cfg_get_value(cparser,"rcf_min",rcf_min) ,rcf_min ,rm ,mm_log)
137	err = mm_check_opt(cfg_get_value(cparser,"m0ccn_min",m0ccn_min) ,m0ccn_min ,1e-8_mm_wp,mm_log)
138	err = mm_check_opt(cfg_get_value(cparser,"drad_min",drad_min) ,drad_min ,1e-9_mm_wp,mm_log)
139	err = mm_check_opt(cfg_get_value(cparser,"debug",wdebug) ,wdebug ,.false. ,mm_log)
140
141	! Retrieve clouds species configuration file
142	spcpath = ''
143	IF (clouds) THEN
144	err = mm_check_opt(cfg_get_value(cparser,"species_cfg",spcpath), spcpath, wlog=mm_log)
145	IF (err/=0) call abort_program(err)
146	ENDIF
147
148	! Alpha function:
149	! ~~~~~~~~~~~~~~~
150	! Spherical mode inter-moments function parameters.
151	IF (.NOT.cfg_has_section(cparser,'alpha_s')) call abort_program(error("Cannot find [alpha_s] section",-1))
152	err = read_aprm(cparser,'alpha_s',mm_asp)
153	IF (err /= 0) call abort_program(error("alpha_s: "//TRIM(err%msg),-1))
154	! Fractal mode inter-moments function parameters.
155	IF (.NOT.cfg_has_section(cparser,'alpha_f')) call abort_program(error("Cannot find [alpha_f] section",-1))
156	err = read_aprm(cparser,'alpha_f',mm_afp)
157	IF (err /= 0) call abort_program(error("alpha_s: "//TRIM(err%msg),-1))
158
159	! Transfert probabilities (S --> F):
160	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
161	err = mm_check_opt(cfg_get_value(cparser, "transfert_probability", mm_call_ps2s), mm_call_ps2s, wlog=mm_log)
162	IF (err/=0) call abort_program(err)
163
164	IF (mm_call_hazecoag .AND. mm_call_ps2s) THEN
165	err = mm_check_opt(cfg_get_value(cparser, "ps2s_file", pssfile), pssfile)
166	IF (err /= 0) call abort_program(err)
167
168	IF (.NOT.read_dset(pssfile,'p_m0_co',mm_pco0p)) THEN
169	call abort_program(error("Cannot get 'p_m0_co' from "//pssfile,-1))
170	ENDIF
171	IF (.NOT.read_dset(pssfile,'p_m3_co',mm_pco3p)) THEN
172	call abort_program(error("Cannot get 'p_m3_co' from "//pssfile,-1))
173	ENDIF
174	IF (.NOT.read_dset(pssfile,'p_m0_fm',mm_pfm0p)) THEN
175	call abort_program(error("Cannot get 'p_m0_fm' from "//pssfile,-1))
176	ENDIF
177	IF (.NOT.read_dset(pssfile,'p_m3_fm',mm_pfm3p)) THEN
178	call abort_program(error("Cannot get 'p_m3_fm' from "//pssfile,-1))
179	ENDIF
180	ENDIF
181
182	! Mean electric correction:
183	! ~~~~~~~~~~~~~~~~~~~~~~~~~
184	err = mm_check_opt(cfg_get_value(cparser, "electric_charging", mm_call_qe), mm_call_qe, wlog=mm_log)
185	IF (err/=0) call abort_program(err)
186
187	IF (mm_call_hazecoag .AND. mm_call_qe) THEN
188	err = mm_check_opt(cfg_get_value(cparser, "mq_file", mqfile), mqfile)
189	IF (err /= 0) call abort_program(err)
190
191	IF (.NOT.read_dset(mqfile,'qbsf0',mm_qbsf0)) THEN
192	call abort_program(error("Cannot get 'qbsf0' from "//mqfile,-1))
193	ELSE
194	mm_qbsf0_e(1,1) = MINVAL(mm_qbsf0%x)
195	mm_qbsf0_e(1,2) = MAXVAL(mm_qbsf0%x)
196	mm_qbsf0_e(2,1) = MINVAL(mm_qbsf0%y)
197	mm_qbsf0_e(2,2) = MAXVAL(mm_qbsf0%y)
198	ENDIF
199	IF (.NOT.read_dset(mqfile,'qbsf3',mm_qbsf3)) THEN
200	call abort_program(error("Cannot get 'qbsf3' from "//mqfile,-1))
201	ELSE
202	mm_qbsf3_e(1,1) = MINVAL(mm_qbsf3%x)
203	mm_qbsf3_e(1,2) = MAXVAL(mm_qbsf3%x)
204	mm_qbsf3_e(2,1) = MINVAL(mm_qbsf3%y)
205	mm_qbsf3_e(2,2) = MAXVAL(mm_qbsf3%y)
206	ENDIF
207	IF (.NOT.read_dset(mqfile,'qbff0',mm_qbff0)) THEN
208	call abort_program(error("Cannot get 'qbff0' from "//mqfile,-1))
209	ELSE
210	mm_qbff0_e(1,1) = MINVAL(mm_qbff0%x)
211	mm_qbff0_e(1,2) = MAXVAL(mm_qbff0%x)
212	mm_qbff0_e(2,1) = MINVAL(mm_qbff0%y)
213	mm_qbff0_e(2,2) = MAXVAL(mm_qbff0%y)
214	ENDIF
215	ENDIF
216
217	! btk coefficients:
218	! ~~~~~~~~~~~~~~~~~
219	IF (.NOT.cfg_has_section(cparser,'btks')) call abort_program(error("Cannot find [btks] section",-1))
220
221	err = cfg_get_value(cparser,"btks/bt0",tmp) ; IF (err/=0) call abort_program(error("bt0: "//TRIM(err%msg),-1))
222	IF (SIZE(tmp) /= 5) call abort_program(error("bt0: Inconsistent number of coefficients",-1))
223	mm_bt0 = tmp
224	err = cfg_get_value(cparser,"btks/bt3",tmp) ; IF (err/=0) call abort_program(error("bt3: "//TRIM(err%msg),-1))
225	IF (SIZE(tmp) /= 5) call abort_program(error("bt3: Inconsistent number of coefficients",-1))
226	mm_bt3 = tmp
227
228	!------------------------
229	! 2. YAMMS initialization
230	!------------------------
231	err = mm_global_init_0(dt,df,rm,rho_aer,call_CH4hazeprod,p_prod,tx_prod,rc_prod, &
232	rplanet,g0,air_rad,air_mmol,coag_choice, &
233	w_h_prod,w_h_sed,w_h_coag,fwsed_m0,fwsed_m3, &
234	m0as_min,rcs_min,m0af_min,rcf_min, &
235	clouds,spcpath,m0ccn_min,drad_min, &
236	wdebug)
237	IF (err /= 0) call abort_program(err)
238
239	! Dump parameters.
240	WRITE(*,'(a)') "========= MUPHYS PARAMETERS ==========="
241	WRITE(*,'(a,L2)') "transfert_probability: ", mm_call_ps2s
242	WRITE(*,'(a,L2)') "electric_charging : ", mm_call_qe
243	call mm_dump_parameters()
244
245	IF (clouds) THEN
246	DO i = 1, size(mm_xESPS)
247	print*, TRIM(mm_xESPS(i)%name), " fmol2fmas = ", mm_xESPS(i)%fmol2fmas
248	ENDDO
249	ENDIF
250
251	END SUBROUTINE mm_initialize
252
253
254	FUNCTION read_aprm(parser,sec,pp) RESULT(err)
255	!! Read and store alpha function parameters.
256	!!
257	TYPE(cfgparser), INTENT(in) :: parser !! Configuration parser
258	CHARACTER(len=*), INTENT(in) :: sec !! Name of the section that contains the parameters.
259	TYPE(aprm), INTENT(out) :: pp !! Object that stores the parameters values.
260	TYPE(error) :: err !! Error status of the function.
261	err = cfg_get_value(parser,TRIM(sec)//'/a',pp%a) ; IF (err /= 0) RETURN
262	err = cfg_get_value(parser,TRIM(sec)//'/b',pp%b) ; IF (err /= 0) RETURN
263	err = cfg_get_value(parser,TRIM(sec)//'/c',pp%c) ; IF (err /= 0) RETURN
264	IF (SIZE(pp%a) /= SIZE(pp%b) .OR. SIZE(pp%a) /= SIZE(pp%c)) &
265	err = error("Inconsistent number of coefficients (a,b, and c must have the same size)",-1)
266	RETURN
267	END FUNCTION read_aprm
268
269
270	SUBROUTINE abort_program(err)
271	!! Dump error message and abort the program.
272	!!
273	TYPE(error), INTENT(in) :: err !! Error object.
274	WRITE(stderr,'(a)') "ERROR: "//TRIM(err%msg)
275	CALL EXIT(err%id)
276	END SUBROUTINE abort_program
277
278	END MODULE MP2M_INTGCM

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

Download in other formats:

Original Format