MODULE strataer_local_var_mod ! This module contains strato microphysic model parameters & variables IMPLICIT NONE !============= GENERAL PARAMS ============= !flag for type emission scenario: (0) background aer ; (1) volcanic eruption with Sulfur ; !(2,3) strato aer injections (SAI) ; (4) volcanic eruption chimistry; (5) rocket INTEGER,SAVE :: flag_emit !$OMP THREADPRIVATE(flag_emit) ! flag for emission altitude distribution: (0) gaussian; (1) uniform INTEGER,SAVE :: flag_emit_distrib !$OMP THREADPRIVATE(flag_emit_distrib) ! flag to choose nucleation nucleation method LOGICAL,SAVE :: flag_new_nucl ! T=new routine from A. Maattanen (LATMOS), F=older routine from H. Vehkamäki (FMI) !$OMP THREADPRIVATE(flag_new_nucl) ! Use relative humidity from 2D model stratospheric H2O because LMDz is too dry in the stratosphere ! (no CH4 oxidation) LOGICAL,SAVE :: flag_H2O2d_nucleation !$OMP THREADPRIVATE(flag_H2O2d_nucleation) ! OH reduction from SO2. OH is reduced when its reaction with SO2 competes sufficiently with its reaction ! with O3 (Bekki, 1995). As a result, SO2 lifetime is extended. 2D model O3 climatologies are needed. LOGICAL,SAVE :: flag_OH_reduced !$OMP THREADPRIVATE(flag_OH_reduced) ! H2SO4 photolysis: H2SO4 is converted into SO2 by complex photolytic processes. Here simplified approach ! by setting H2SO4 cross-sections = 0.3*HCl cross-sections (Rinsland et al., 1995) LOGICAL,SAVE :: flag_H2SO4_photolysis !$OMP THREADPRIVATE(flag_H2SO4_photolysis) ! flag for minimum lifetime (=1.5 pdt phys) LOGICAL,SAVE :: flag_min_rreduce !$OMP THREADPRIVATE(flag_min_rreduce) ! flag to read new climato (O3, H2O & H2SO4_LIFET) LOGICAL,SAVE :: flag_newclim_file !$OMP THREADPRIVATE(flag_newclim_file) ! flag to choose new H2SO4 density and weight percent from Tabazadeh et al. (1994). LOGICAL,SAVE :: flag_new_strat_compo !$OMP THREADPRIVATE(flag_new_strat_compo) ! Verbose mode to get more print info LOGICAL, SAVE :: flag_verbose_strataer !$OMP THREADPRIVATE(flag_verbose_strataer) !============= NUCLEATION VARS ============= ! MOLECULAR ACCOMODATION OF H2SO4 (Raes and Van Dingen) REAL,SAVE :: ALPH2SO4 ! H2SO4 accommodation coefficient [condensation/evaporation] !$OMP THREADPRIVATE(ALPH2SO4) ! flag to constraint nucleation rate in a lat/pres box LOGICAL,SAVE :: flag_nuc_rate_box ! Nucleation rate limit or not to a lat/pres !$OMP THREADPRIVATE(flag_nuc_rate_box) REAL,SAVE :: nuclat_min ! min lat to activate nuc rate REAL,SAVE :: nuclat_max ! max lat to activate nuc rate REAL,SAVE :: nucpres_min ! min pres to activate nuc rate REAL,SAVE :: nucpres_max ! max pres to activate nuc rate !$OMP THREADPRIVATE(nuclat_min, nuclat_max, nucpres_min, nucpres_max) LOGICAL,SAVE :: ok_qemiss !$OMP THREADPRIVATE(ok_qemiss) INTEGER,SAVE :: flh2o ! ds stratemit : flh2o =0 (tr_seri), flh2o=1 (dq) !$OMP THREADPRIVATE(flh2o) REAL,ALLOCATABLE,SAVE :: budg_emi(:,:) !DIMENSION(klon,n) !$OMP THREADPRIVATE(budg_emi) !============= EMISSION VARS ============= !--flag_emit=1 OR == 4 -- Volcanic eruption(s) INTEGER,SAVE :: nErupt ! number of eruptions specs REAL,SAVE :: injdur ! volcanic injection duration !$OMP THREADPRIVATE(nErupt, injdur) INTEGER,ALLOCATABLE,SAVE :: year_emit_vol(:) ! year of emission date INTEGER,ALLOCATABLE,SAVE :: mth_emit_vol(:) ! month of emission date INTEGER,ALLOCATABLE,SAVE :: day_emit_vol(:) ! day of emission date !$OMP THREADPRIVATE(year_emit_vol, mth_emit_vol, day_emit_vol) REAL,ALLOCATABLE,SAVE :: altemiss_vol(:) ! emission altitude in m REAL,ALLOCATABLE,SAVE :: sigma_alt_vol(:) ! standard deviation of emission altitude in m !$OMP THREADPRIVATE(altemiss_vol, sigma_alt_vol) INTEGER,ALLOCATABLE,SAVE :: ponde_lonlat_vol(:) ! lon/lat ponderation factor REAL,ALLOCATABLE,SAVE :: xlat_min_vol(:) ! min latitude of volcano in degree REAL,ALLOCATABLE,SAVE :: xlat_max_vol(:) ! max latitude of volcano in degree REAL,ALLOCATABLE,SAVE :: xlon_min_vol(:) ! min longitude of volcano in degree REAL,ALLOCATABLE,SAVE :: xlon_max_vol(:) ! max longitude of volcano in degree !$OMP THREADPRIVATE(ponde_lonlat_vol, xlat_min_vol, xlat_max_vol, xlon_min_vol, xlon_max_vol) !--flag_emit=1 INTEGER,SAVE :: nAerErupt ! number Aerosol !$OMP THREADPRIVATE(nAerErupt) REAL,ALLOCATABLE,SAVE :: m_sulf_emiss_vol(:) ! emitted sulfur mass in kgS, e.g. 7Tg(S)=14Tg(SO2) REAL,ALLOCATABLE,SAVE :: m_aer_emiss_vol(:,:) !$OMP THREADPRIVATE(m_sulf_emiss_vol,m_aer_emiss_vol) !--flag_emit=2 --SAI REAL,SAVE :: m_aer_emiss_sai ! emitted sulfur mass in kgS, eg 1e9=1TgS, 1e10=10TgS REAL,SAVE :: altemiss_sai ! emission altitude in m REAL,SAVE :: sigma_alt_sai ! standard deviation of emission altitude in m !$OMP THREADPRIVATE(m_aer_emiss_sai, altemiss_sai, sigma_alt_sai) INTEGER,SAVE :: year_emit_sai_start INTEGER,SAVE :: year_emit_sai_end INTEGER,SAVE :: mth_emit_sai_start INTEGER,SAVE :: mth_emit_sai_end INTEGER,SAVE :: day_emit_sai_start INTEGER,SAVE :: day_emit_sai_end !$OMP THREADPRIVATE(year_emit_sai_start, year_emit_sai_end) !$OMP THREADPRIVATE(mth_emit_sai_start, mth_emit_sai_end) !$OMP THREADPRIVATE(day_emit_sai_start, day_emit_sai_end) REAL,SAVE :: xlat_sai ! latitude of SAI in degree REAL,SAVE :: xlon_sai ! longitude of SAI in degree !$OMP THREADPRIVATE(xlat_sai, xlon_sai) !--flag_emit=3 -- SAI REAL,SAVE :: xlat_max_sai ! maximum latitude of SAI in degrees REAL,SAVE :: xlat_min_sai ! minimum latitude of SAI in degrees !$OMP THREADPRIVATE(xlat_min_sai,xlat_max_sai) !--flag_emit=4 -- volc species INTEGER,SAVE :: nSpeciesErupt ! number of species Repr INTEGER,ALLOCATABLE,SAVE :: id_species(:) ! indice species Repr REAL,ALLOCATABLE,SAVE :: m_species_emiss_vol(:,:) ! emitted species !$OMP THREADPRIVATE(nSpeciesErupt,id_species,m_species_emiss_vol) INTEGER,ALLOCATABLE,SAVE :: id_HCl INTEGER,ALLOCATABLE,SAVE :: id_HBr INTEGER,ALLOCATABLE,SAVE :: id_NOx INTEGER,ALLOCATABLE,SAVE :: id_H2O !$OMP THREADPRIVATE(id_HCl,id_HBr,id_NOx,id_H2O) REAL,ALLOCATABLE,SAVE :: m_Chlore_emiss_vol(:) ! emitted Chlore mass REAL,ALLOCATABLE,SAVE :: m_Brome_emiss_vol(:) ! emitted Brome mass REAL,ALLOCATABLE,SAVE :: m_NOx_emiss_vol(:) ! emitted NOx mass REAL,ALLOCATABLE,SAVE :: m_H2O_emiss_vol(:) ! emitted H2O mass REAL,ALLOCATABLE,SAVE :: m_H2O_emiss_vol_daily(:) !$OMP THREADPRIVATE(m_Chlore_emiss_vol,m_Brome_emiss_vol,m_NOx_emiss_vol,m_H2O_emiss_vol) !$OMP THREADPRIVATE(m_H2O_emiss_vol_daily) !--flag_emit=5 -- Rockets Emitted INTEGER, SAVE :: ifreqroc ! frequence (=2 ex: tous les 2 mois) !$OMP THREADPRIVATE(ifreqroc) INTEGER,ALLOCATABLE,SAVE :: day_emit_roc(:) ! day of emission date !$OMP THREADPRIVATE(day_emit_roc) REAL,ALLOCATABLE,SAVE :: RRSI(:) ! radius [cm] for each aerosol size REAL,ALLOCATABLE,SAVE :: Vbin(:) ! volume [m3] for each aerosol size !$OMP THREADPRIVATE(RRSI, Vbin) REAL,SAVE :: dlat, dlon ! delta latitude and d longitude of grid in degree !$OMP THREADPRIVATE(dlat, dlon) CONTAINS SUBROUTINE strataer_init() USE ioipsl_getin_p_mod, ONLY : getin_p USE print_control_mod, ONLY : lunout USE mod_phys_lmdz_para, ONLY : is_master USE infotrac_phy, ONLY: id_OCS_strat,id_SO2_strat,id_H2SO4_strat,nbtr_sulgas,nbtr_bin USE phys_local_var_mod, ONLY : mdw USE aerophys, ONLY: mdwmin, V_rat USE YOMCST , ONLY : RPI INTEGER :: it WRITE(lunout,*) 'IN STRATAER_LOCAL_VAR INIT WELCOME!' !============= Check Sulfur aerosols ID ============= WRITE(lunout,*) 'STRATAER_LOCAL_VAR INIT: id_OCS_strat=',id_OCS_strat,' id_SO2_strat=',id_SO2_strat,' id_H2SO4_strat=',id_H2SO4_strat IF(id_OCS_strat < 0 .OR. id_OCS_strat > nbtr_sulgas) THEN WRITE(lunout,*) 'ERROR : OCS index id_OCS_strat=',id_OCS_strat,' is negative or superior than the total sulfur gases !' CALL abort_physic('strataer_local_var_mod','Wrong OCS index, check your tracer.def file.',1) ELSEIF(id_SO2_strat < 0 .OR. id_SO2_strat > nbtr_sulgas) THEN WRITE(lunout,*) 'ERROR : SO2 index id_SO2_strat=',id_SO2_strat,' is negative or superior than the total sulfur gases !' CALL abort_physic('strataer_local_var_mod','Wrong SO2 index, check your tracer.def file.',1) ELSEIF(id_H2SO4_strat < 0 .OR. id_H2SO4_strat > nbtr_sulgas) THEN WRITE(lunout,*) 'ERROR : H2SO4 index id_H2SO4_strat=',id_H2SO4_strat,' is negative or superior than the total sulfur gases !' CALL abort_physic('strataer_local_var_mod','Wrong H2SO4 index, check your tracer.def file.',1) ENDIF !============= Init params ============= flag_emit = 0 ! Background (default) flag_emit_distrib = 0 ! Gaussian (default) flag_new_nucl = .TRUE. ! Define nucleation routine (default: A. Maattanen - LATMOS) flag_verbose_strataer = .FALSE. ! verbose mode flag_newclim_file = .TRUE. ! Define input climato file (default: all climato) flag_H2O2d_nucleation = .FALSE. ! Use H2O 2D climato (default: No) flag_OH_reduced = .FALSE. ! OH reduce (default: No) flag_H2SO4_photolysis = .FALSE. ! H2SO4 photolysis (default: No) flag_min_rreduce = .TRUE. ! Minimum lifetime=1.5 pdt phys (default: Yes) flag_new_strat_compo =.TRUE. ! H2SO4/H2O weight percent & density routine (default: S. Bekki) ok_qemiss = .FALSE. ! H2O emission flag ! nuc init ALPH2SO4 = 0.1 flag_nuc_rate_box = .FALSE. nuclat_min=0 ; nuclat_max=0 nucpres_min=0 ; nucpres_max=0 ! emiss init nErupt = 0 ! eruption number injdur = 0 ! init injection duration nAerErupt = 1 ; nSpeciesErupt = 1 ifreqroc=2 ; flh2o=0 !============= Read params ============= CALL getin_p('flag_emit',flag_emit) CALL getin_p('flag_emit_distrib',flag_emit_distrib) CALL getin_p('flag_verbose_strataer',flag_verbose_strataer) CALL getin_p('flag_new_nucl',flag_new_nucl) CALL getin_p('flag_newclim_file',flag_newclim_file) CALL getin_p('flag_H2O2d_nucleation',flag_H2O2d_nucleation) CALL getin_p('flag_OH_reduced',flag_OH_reduced) CALL getin_p('flag_H2SO4_photolysis',flag_H2SO4_photolysis) CALL getin_p('flag_min_rreduce',flag_min_rreduce) CALL getin_p('flag_new_strat_compo',flag_new_strat_compo) CALL getin_p('ok_qemiss',ok_qemiss) !============= Test flag coherence ============= IF (.NOT. flag_newclim_file) THEN IF (flag_H2SO4_photolysis .OR. flag_OH_reduced .OR. flag_H2O2d_nucleation) THEN WRITE(lunout,*) 'ERROR : flag_newclim_file=',flag_newclim_file, & ' whereas flag_H2SO4_photolysis=',flag_H2SO4_photolysis,', flag_OH_reduced=',flag_OH_reduced, & ' and flag_H2O2d_nucleation=',flag_H2O2d_nucleation CALL abort_physic('strataer_local_var_mod','Incompatible options in physiq_def file !',1) ENDIF IF(flag_min_rreduce) THEN WRITE(lunout,*) 'Warning : flag_min_rreduce will be ignored with old climato file !' ENDIF ENDIF !============= Print params ============= IF (is_master) THEN WRITE(lunout,*) 'flag_emit = ',flag_emit WRITE(lunout,*) 'IN STRATAER : flag_new_nucl = ',flag_new_nucl WRITE(lunout,*) 'IN STRATAER : flag_newclim_file = ',flag_newclim_file WRITE(lunout,*) 'IN STRATAER : flag_emit_distrib = ',flag_emit_distrib WRITE(lunout,*) 'IN STRATAER : flag_verbose_strataer = ',flag_verbose_strataer IF (flag_emit == 1 .OR. flag_emit == 4) THEN WRITE(lunout,*) 'IN STRATAER : flag_H2O2d_nucleation = ',flag_H2O2d_nucleation WRITE(lunout,*) 'IN STRATAER : flag_OH_reduced = ',flag_OH_reduced WRITE(lunout,*) 'IN STRATAER : flag_H2SO4_photolysis = ',flag_H2SO4_photolysis WRITE(lunout,*) 'IN STRATAER : flag_min_rreduce = ',flag_min_rreduce WRITE(lunout,*) 'IN STRATAER : flag_new_strat_compo = ',flag_new_strat_compo WRITE(lunout,*) 'IN STRATAER : ok_qemiss = ',ok_qemiss ENDIF ENDIF ! if master !--initialising dry diameters to geometrically spaced mass/volume (see Jacobson 1994) mdw(1)=mdwmin IF (V_rat.LT.1.62) THEN ! compensate for dip in second bin for lower volume ratio mdw(2)=mdw(1)*2.**(1./3.) DO it=3, nbtr_bin mdw(it)=mdw(it-1)*V_rat**(1./3.) ENDDO ELSE DO it=2, nbtr_bin mdw(it)=mdw(it-1)*V_rat**(1./3.) ENDDO ENDIF IF (is_master) WRITE(lunout,*) 'init mdw=', mdw ! compute particle radius RRSI [cm] and volume Vbin [m3] from diameter mdw [m] ALLOCATE(RRSI(nbtr_bin), Vbin(nbtr_bin)) DO it=1,nbtr_bin ! [cm] RRSI(it)=mdw(it)/2.*100. ! [m3] Vbin(it)=4.0*RPI*((mdw(it)/2.)**3)/3.0 ENDDO IF (is_master) THEN WRITE(lunout,*) 'init RRSI=', RRSI WRITE(lunout,*) 'init Vbin=', Vbin ENDIF WRITE(lunout,*) 'IN STRATAER INIT END' END SUBROUTINE strataer_init END MODULE strataer_local_var_mod