MODULE MP2M_INTGCM !============================================================================ ! ! Purpose ! ------- ! Interface to YAMMS for the LMDZ GCM. ! --> It initializes all the parameters of the model from direct input (mm_global_init). ! ! The module also contains three methods: ! - mm_initialize(dt,haze_prod_pCH4,p_prod,tx_prod,rc_prod,rm,df,rho_aer,rplanet,g0,air_rad,air_mmol,cfgpath) ! - read_aprm(parser,sec,pp) ! - abort_program(err) ! ! Authors ! ------- ! B. de Batz de Trenquelléon, J. Burgalat (11/2024) ! !============================================================================ USE MP2M_MPREC USE MP2M_GLOBALS USE MP2M_MICROPHYSICS USE MP2M_HAZE USE MP2M_METHODS USE SWIFT_CFGPARSE USE LINT_DATASETS IMPLICIT NONE CONTAINS SUBROUTINE mm_initialize(dt,haze_prod_pCH4,p_prod,tx_prod,rc_prod,rm,df,rho_aer,rplanet,g0,air_rad,air_mmol,cfgpath) !! Initialize global parameters of the model. !! !! The function initializes all the global parameters of the model from direct input. !! Boolean parameters are optional as they are rather testing parameters. !! !! @note !! If the subroutine fails to initialize parameters, the run is aborted. !! !! @warning !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it !! initializes global variable that are not thread private. !! ! Microphysics timestep (s). REAL(kind=mm_wp), INTENT(in) :: dt ! Enable/Disable production from CH4 photolysis. LOGICAL :: haze_prod_pCH4 ! Aerosol production pressure level (Pa). REAL(kind=mm_wp), INTENT(in) :: p_prod ! Spherical aerosol production rate (kg.m-2.s-1). REAL(kind=mm_wp), INTENT(in) :: tx_prod ! Spherical aerosol characteristic radius production (m). REAL(kind=mm_wp), INTENT(in) :: rc_prod ! Monomer radius (m). REAL(kind=mm_wp), INTENT(in) :: rm ! Fractal dimension of aerosols (-). REAL(kind=mm_wp), INTENT(in) :: df ! Aerosol density (kg.m-3). REAL(kind=mm_wp), INTENT(in) :: rho_aer ! Planet radius (m). REAL(kind=mm_wp), INTENT(in) :: rplanet ! Planet gravity acceleration at ground level (m.s-2). REAL(kind=mm_wp), INTENT(in) :: g0 ! Mean radius of air molecules (m). REAL(kind=mm_wp), INTENT(in) :: air_rad ! Mean molar mass of air molecules (kg.mol-1). REAL(kind=mm_wp), INTENT(in) :: air_mmol ! Internal microphysics configuration file. CHARACTER(len=*), INTENT(in), OPTIONAL :: cfgpath ! Microphysical configuration file. TYPE(cfgparser) :: cparser ! Look-up tables (transfert probabilities, mean electric correction). CHARACTER(len=st_slen) :: pssfile,mqfile ! Enable/disable Haze process. LOGICAL :: w_h_prod,w_h_sed,w_h_coag,fwsed_m0,fwsed_m3 ! Coagulation interactions INTEGER :: coag_choice ! Thresholds related parameters. REAL(kind=mm_wp) :: m0as_min,rcs_min,m0af_min,rcf_min ! Debug mode control flag (may print lot of stuff if enabled). LOGICAL :: wdebug ! Local variables. TYPE(error) :: err REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: tmp !----------------------------- ! 1. Parameters initialization !----------------------------- w_h_prod = .true. w_h_sed = .true. w_h_coag = .true. fwsed_m0 = .true. fwsed_m3 = .false. coag_choice = 7 m0as_min = 1e-8_mm_wp rcs_min = 1e-9_mm_wp m0af_min = 1e-8_mm_wp rcf_min = 1e-9_mm_wp wdebug = .false. WRITE(*,'(a)') "##### MM_GCM SPEAKING #####" WRITE(*,'(a)') "I will initialize the microphysics model in moments YAMMS" WRITE(*,'(a)') "On error I will simply abort the program. Stay near your computer !" WRITE(*,*) WRITE(*,'(a)') "Reading muphys configuration file ("//trim(cfgpath)//")." err = cfg_read_config(cparser,TRIM(cfgpath),.true.) IF (err /= 0) THEN WRITE(*,'(a)') "Error when reading muphys configuration file in mm_initialize..." call abort_program(err) ENDIF ! YAMMS internal parameters: ! ~~~~~~~~~~~~~~~~~~~~~~~~~~ ! The following parameters are primarily used to test and debug YAMMS. ! They are set in an optional configuration file and default to suitable values for production runs. err = mm_check_opt(cfg_get_value(cparser,"haze_production",w_h_prod) ,w_h_prod ,.true. ,mm_log) err = mm_check_opt(cfg_get_value(cparser,"haze_sedimentation",w_h_sed) ,w_h_sed ,.true. ,mm_log) err = mm_check_opt(cfg_get_value(cparser,"haze_coagulation",w_h_coag) ,w_h_coag ,.true. ,mm_log) err = mm_check_opt(cfg_get_value(cparser,"wsed_m0",fwsed_m0) ,fwsed_m0 ,.true. ,mm_log) err = mm_check_opt(cfg_get_value(cparser,"wsed_m3",fwsed_m3) ,fwsed_m3 ,.false. ,mm_log) err = mm_check_opt(cfg_get_value(cparser,"haze_coag_interactions",coag_choice),coag_choice,7 ,mm_log) err = mm_check_opt(cfg_get_value(cparser,"m0as_min",m0as_min) ,m0as_min ,1e-8_mm_wp,mm_log) err = mm_check_opt(cfg_get_value(cparser,"rcs_min",rcs_min) ,rcs_min ,1e-9_mm_wp,mm_log) err = mm_check_opt(cfg_get_value(cparser,"m0af_min",m0af_min) ,m0af_min ,1e-8_mm_wp,mm_log) err = mm_check_opt(cfg_get_value(cparser,"rcf_min",rcf_min) ,rcf_min ,rm ,mm_log) err = mm_check_opt(cfg_get_value(cparser,"debug",wdebug) ,wdebug ,.false. ,mm_log) ! Alpha function: ! ~~~~~~~~~~~~~~~ ! Spherical mode inter-moments function parameters. IF (.NOT.cfg_has_section(cparser,'alpha_s')) call abort_program(error("Cannot find [alpha_s] section",-1)) err = read_aprm(cparser,'alpha_s',mm_asp) IF (err /= 0) call abort_program(error("alpha_s: "//TRIM(err%msg),-1)) ! Fractal mode inter-moments function parameters. IF (.NOT.cfg_has_section(cparser,'alpha_f')) call abort_program(error("Cannot find [alpha_f] section",-1)) err = read_aprm(cparser,'alpha_f',mm_afp) IF (err /= 0) call abort_program(error("alpha_s: "//TRIM(err%msg),-1)) ! Transfert probabilities (S --> F): ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ err = mm_check_opt(cfg_get_value(cparser, "transfert_probability", mm_w_ps2s), mm_w_ps2s, wlog=mm_log) IF (err/=0) call abort_program(err) IF (mm_w_haze_coag .AND. mm_w_ps2s) THEN err = mm_check_opt(cfg_get_value(cparser, "ps2s_file", pssfile), pssfile) IF (err /= 0) call abort_program(err) IF (.NOT.read_dset(pssfile,'p_m0_co',mm_pco0p)) THEN call abort_program(error("Cannot get 'p_m0_co' from "//pssfile,-1)) ENDIF IF (.NOT.read_dset(pssfile,'p_m3_co',mm_pco3p)) THEN call abort_program(error("Cannot get 'p_m3_co' from "//pssfile,-1)) ENDIF IF (.NOT.read_dset(pssfile,'p_m0_fm',mm_pfm0p)) THEN call abort_program(error("Cannot get 'p_m0_fm' from "//pssfile,-1)) ENDIF IF (.NOT.read_dset(pssfile,'p_m3_fm',mm_pfm3p)) THEN call abort_program(error("Cannot get 'p_m3_fm' from "//pssfile,-1)) ENDIF ENDIF ! Mean electric correction: ! ~~~~~~~~~~~~~~~~~~~~~~~~~ err = mm_check_opt(cfg_get_value(cparser, "electric_charging", mm_w_qe), mm_w_qe, wlog=mm_log) IF (err/=0) call abort_program(err) IF (mm_w_haze_coag .AND. mm_w_qe) THEN err = mm_check_opt(cfg_get_value(cparser, "mq_file", mqfile), mqfile) IF (err /= 0) call abort_program(err) IF (.NOT.read_dset(mqfile,'qbsf0',mm_qbsf0)) THEN call abort_program(error("Cannot get 'qbsf0' from "//mqfile,-1)) ELSE mm_qbsf0_e(1,1) = MINVAL(mm_qbsf0%x) mm_qbsf0_e(1,2) = MAXVAL(mm_qbsf0%x) mm_qbsf0_e(2,1) = MINVAL(mm_qbsf0%y) mm_qbsf0_e(2,2) = MAXVAL(mm_qbsf0%y) ENDIF IF (.NOT.read_dset(mqfile,'qbsf3',mm_qbsf3)) THEN call abort_program(error("Cannot get 'qbsf3' from "//mqfile,-1)) ELSE mm_qbsf3_e(1,1) = MINVAL(mm_qbsf3%x) mm_qbsf3_e(1,2) = MAXVAL(mm_qbsf3%x) mm_qbsf3_e(2,1) = MINVAL(mm_qbsf3%y) mm_qbsf3_e(2,2) = MAXVAL(mm_qbsf3%y) ENDIF IF (.NOT.read_dset(mqfile,'qbff0',mm_qbff0)) THEN call abort_program(error("Cannot get 'qbff0' from "//mqfile,-1)) ELSE mm_qbff0_e(1,1) = MINVAL(mm_qbff0%x) mm_qbff0_e(1,2) = MAXVAL(mm_qbff0%x) mm_qbff0_e(2,1) = MINVAL(mm_qbff0%y) mm_qbff0_e(2,2) = MAXVAL(mm_qbff0%y) ENDIF ENDIF ! btk coefficients: ! ~~~~~~~~~~~~~~~~~ IF (.NOT.cfg_has_section(cparser,'btks')) call abort_program(error("Cannot find [btks] section",-1)) err = cfg_get_value(cparser,"btks/bt0",tmp) ; IF (err/=0) call abort_program(error("bt0: "//TRIM(err%msg),-1)) IF (SIZE(tmp) /= 5) call abort_program(error("bt0: Inconsistent number of coefficients",-1)) mm_bt0 = tmp err = cfg_get_value(cparser,"btks/bt3",tmp) ; IF (err/=0) call abort_program(error("bt3: "//TRIM(err%msg),-1)) IF (SIZE(tmp) /= 5) call abort_program(error("bt3: Inconsistent number of coefficients",-1)) mm_bt3 = tmp !------------------------ ! 2. YAMMS initialization !------------------------ err = mm_global_init_0(dt,df,rm,rho_aer,haze_prod_pCH4,p_prod,tx_prod,rc_prod, & rplanet,g0,air_rad,air_mmol,coag_choice, & w_h_prod,w_h_sed,w_h_coag,fwsed_m0,fwsed_m3, & m0as_min,rcs_min,m0af_min,rcf_min,wdebug) IF (err /= 0) call abort_program(err) ! Dump parameters. WRITE(*,'(a)') "========= MUPHYS PARAMETERS ===========" WRITE(*,'(a,L2)') "transfert_probability: ", mm_w_ps2s WRITE(*,'(a,L2)') "electric_charging : ", mm_w_qe call mm_dump_parameters() END SUBROUTINE mm_initialize FUNCTION read_aprm(parser,sec,pp) RESULT(err) !! Read and store alpha function parameters. !! TYPE(cfgparser), INTENT(in) :: parser !! Configuration parser CHARACTER(len=*), INTENT(in) :: sec !! Name of the section that contains the parameters. TYPE(aprm), INTENT(out) :: pp !! Object that stores the parameters values. TYPE(error) :: err !! Error status of the function. err = cfg_get_value(parser,TRIM(sec)//'/a',pp%a) ; IF (err /= 0) RETURN err = cfg_get_value(parser,TRIM(sec)//'/b',pp%b) ; IF (err /= 0) RETURN err = cfg_get_value(parser,TRIM(sec)//'/c',pp%c) ; IF (err /= 0) RETURN IF (SIZE(pp%a) /= SIZE(pp%b) .OR. SIZE(pp%a) /= SIZE(pp%c)) & err = error("Inconsistent number of coefficients (a,b, and c must have the same size)",-1) RETURN END FUNCTION read_aprm SUBROUTINE abort_program(err) !! Dump error message and abort the program. !! TYPE(error), INTENT(in) :: err !! Error object. WRITE(stderr,'(a)') "ERROR: "//TRIM(err%msg) CALL EXIT(err%id) END SUBROUTINE abort_program END MODULE MP2M_INTGCM