Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

mp2m_intgcm.F90 @ 3607

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

Rev	Line
[3560]	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