#define TRACEBACK write (gol,'("in ",a," (",a,i6,")")') rname, __FILE__, __LINE__ ; call goErr #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if ! #include "tm5.inc" #include "output.inc" ! !------------------------------------------------------------------------------ ! TM5 ! !------------------------------------------------------------------------------ !BOP ! ! !MODULE: EMISSION ! ! !DESCRIPTION: wrappers around various emissions (init/declare/apply/done) ! routines, needed for TM5 CBM4 version. ! Also hold emissions budget variables. ! !\\ !\\ ! !INTERFACE: ! MODULE EMISSION ! ! !USES: ! USE GO, ONLY : gol, goErr, goPr use GO, ONLY : GO_Timer_Def, GO_Timer_End, GO_Timer_Start USE TM5_DISTGRID, ONLY : dgrid, Get_DistGrid, scatter, gather USE dims, ONLY : nregions, okdebug USE emission_data, ONLY : plandr, emis2D ! , bmbcycle, bb_lm #ifdef with_m7 USE emission_data, ONLY : emis_number, emis_mass, emis_temp #endif #ifdef with_budgets USE emission_data, ONLY : budemi_dat, budemi_data, sum_emission USE budget_global, ONLY : nbud_vg,nbudg USE chem_param, ONLY : ntracet #endif use emission_nox , only : Emission_NOx_Init , Emission_NOx_Done , emission_nox_declare use emission_co , only : Emission_CO_Init , Emission_CO_Done , emission_co_declare , emission_co_apply use emission_nmvoc, only : Emission_NMVOC_Init, Emission_NMVOC_Done , emission_nmvoc_declare, emission_nmvoc_apply use emission_ch4 , only : Emission_CH4_Init , Emission_CH4_Done , emission_ch4_declare , emission_ch4_apply use emission_nh3 , only : Emission_nh3_Init , Emission_nh3_Done , emission_nh3_declare , emission_nh3_apply use emission_sox , only : Emission_SOx_Init , Emission_SOx_Done , emission_sox_declare , emission_sox_apply use emission_dms , only : Emission_DMS_Init , emission_dms_done , emission_dms_declare , emission_dms_apply use emission_rn222, only : Emission_rn222_Init, emission_rn222_done , emission_rn222_declare, emission_rn222_apply #ifdef with_online_bvoc USE emission_bvoc, ONLY : declare_emission_bvoc, free_emission_bvoc, emission_apply_bvoc #else use emission_isop , only: Emission_isop_Init , Emission_isop_Done , emission_isop_declare , emission_isop_apply use emission_terp , only: Emission_terp_Init , Emission_terp_Done , emission_terp_declare , emission_terp_apply #endif #ifdef with_m7 use emission_dust, only : emission_dust_done , emission_dust_declare use emission_pom , only : Emission_POM_Init, Emission_POM_Done , emission_pom_declare use emission_bc , only : Emission_BC_Init , Emission_BC_Done , emission_bc_declare !!$ use emission_ss, only: declare_emission_ss , free_emission_ss #endif IMPLICIT NONE PRIVATE ! ! !PUBLIC MEMBER FUNCTIONS: ! PUBLIC :: Emission_Init ! allocate/init budget var; call other emiss-related init PUBLIC :: Emission_Done ! gather/write final budget PUBLIC :: Declare_Emission ! allocate emiss var (new run), read emiss data (new month) PUBLIC :: Emission_Apply ! ! ! !PRIVATE DATA MEMBERS: ! ! budemig_all (used to sum budemig from all processors) is used in chemistry for its NOx values. #ifdef with_budgets REAL, DIMENSION(nbudg, nbud_vg, ntracet) :: budemig REAL, DIMENSION(nbudg, nbud_vg, ntracet), PUBLIC :: budemig_all ! for buggy MPI (see budget_global.F90) #endif integer :: itim_appl, itim_co, itim_voc, itim_nh3, itim_sox, itim_dms, itim_ch4, itim_isop, itim_rn222 CHARACTER(len=*), PARAMETER :: mname = 'emission' ! ! !REVISION HISTORY: ! 16 Jul 2010 - P. Le Sager - fix for m7 with GFED_8days ! 20 Aug 2010 - A. Strunk - Adapted to AR5 emissions + various other changes. ! 27 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition ! 02 Apr 2014 - J. E. Williams - Updated for terpenes ! ! - NO MORE REVISION HISTORY. This is gathered from repository from now on. !EOP !---------------------------------------------------------------------- CONTAINS !---------------------------------------------------------------------- ! TM5 ! !---------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_INIT ! ! !DESCRIPTION: Initialise emission fields and parameters by reading ! the rc-file. Allocate and initialize budget variables. !\\ !\\ ! !INTERFACE: ! SUBROUTINE EMISSION_INIT( status ) ! ! !USES: ! use GO, only : TrcFile, Init, Done, ReadRc use meteodata, only : Set, oro_dat use dims, only : iglbsfc, nregions, lm use dims, only : idate, ndyn_max, tref use global_data, only : inputdir, rcfile use emission_data, only : emis_input_dir, use_tiedkte use emission_data, only : emis_input_dir_gfed use emission_data, only : emis_input_dir_retro use emission_data, only : emis_input_year_nat use emission_data, only : emis_input_year_bc use emission_data, only : emis_input_year_oc use emission_data, only : emis_input_year_sox use emission_data, only : emis_input_year_nh3 use emission_data, only : emis_input_year_nox use emission_data, only : emis_input_year_co use emission_data, only : emis_input_year_nmvoc use emission_data, only : emis_input_year_ch4 use emission_data, only : ch4_fixyear use emission_data, only : cmip6_ch4_dirname use emission_data, only : LCMIP6, LCMIP6BMB, LCMIP6_CH4 use emission_data, only : LAR5, LAR5BMB, LEDGAR4, LRETROF, LGFED3 use emission_data, only : LLPJ, LHYMN, LMACCITY, LMEGAN, LMACC #ifdef with_ch4_emis use emission_data, only : emis_input_dir_natch4 #endif #ifdef with_m7 use chem_param, only : mode_nm use emission_data, only : emis_input_dir_aerocom use emission_data, only : emis_input_dir_dust, emis_input_dust use mo_aero_m7, only : nmod,nnucl use mo_aero_nucl, only : d_form use mo_aero, only : nsoa use ebischeme, only : isoprene_on #endif use emission_data, only : emis_input_dir_cmip6 use emission_data, only : emis_input_dir_ar5 use emission_data, only : emis_input_dir_mac use emission_data, only : emis_input_dir_ed4 use emission_data, only : emis_input_dir_dms use emission_data, only : emis_input_dir_rn222 use emission_data, only : emis_input_dir_megan use emission_data, only : emis_ch4_single, emis_ch4_fix3d use emission_data, only : emis_ch4_fixed_ppb, emis_zch4_fname use emission_data, only : emis_bb_trop_cycle, bb_cycle, scale_cycle use emission_read, only : emission_read_init #ifdef with_online_nox use online_nox_data, only : input_nox_dir #endif ! ! !OUTPUT PARAMETERS: ! INTEGER, INTENT(out) :: status ! ! !REVISION HISTORY: ! 27 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition ! !EOP !------------------------------------------------------------------------------ !BOC CHARACTER(len=*), PARAMETER :: rname = mname//'/Emission_Init' INTEGER :: region, i1, i2, j1, j2, ntim, lmr, imode TYPE(TrcFile) :: rcF REAL :: dtime integer :: emis_input_year integer :: emis_input_year_ntcf integer :: emis_input_year_aer integer :: emis_input_year_o3 ! ----------------------------------- ! read settings from rcfile ! ----------------------------------- call Init( rcF, rcfile, status ) IF_NOTOK_RETURN(status=1) if (okdebug) then write(gol,*) "EMISS-INFO - running year : ", idate(1) ; call goPr end if ! emission base year (assumption: no run overlapping more than one year) call ReadRc( rcF, 'input.emis.year', emis_input_year, status, default=idate(1) ) IF_ERROR_RETURN(status=1) ! natural emissions (MACC, MEGAN, LPJ) CALL ReadRc( rcF, 'input.natemis.year', emis_input_year_nat, status, default= emis_input_year ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - Natural emissions requested for year: ', emis_input_year_nat; call goPr write(gol,*) 'EMISS-INFO - Anthropogenic and biomass burning emissions'; call goPr write(gol,*) 'EMISS-INFO - requested for the following years:'; call goPr ! anthropogenic and biomass burning emissions of all NTCFs, excluding CH4 call ReadRc( rcF, 'input.emis.year.ntcf', emis_input_year_ntcf, status, default=emis_input_year ) IF_ERROR_RETURN(status=1) ! aerosol precursors (BC, OC, SOx, NH3) call ReadRc( rcF, 'input.emis.year.aer', emis_input_year_aer, status, default=emis_input_year_ntcf ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'input.emis.year.bc', emis_input_year_bc, status, default=emis_input_year_aer ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - BC: ', emis_input_year_bc; call goPr call ReadRc( rcF, 'input.emis.year.oc', emis_input_year_oc, status, default=emis_input_year_aer ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - OC: ', emis_input_year_oc; call goPr call ReadRc( rcF, 'input.emis.year.sox', emis_input_year_sox, status, default=emis_input_year_aer ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - SOx: ', emis_input_year_sox; call goPr call ReadRc( rcF, 'input.emis.year.nh3', emis_input_year_nh3, status, default=emis_input_year_aer ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - NH3: ', emis_input_year_nh3; call goPr ! tropospheric ozone precursors (NOx, CO, NMVOCs incl. isoprene and terpenes) call ReadRc( rcF, 'input.emis.year.o3', emis_input_year_o3, status, default=emis_input_year_ntcf ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'input.emis.year.nox', emis_input_year_nox, status, default=emis_input_year_o3 ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - NOx: ', emis_input_year_nox; call goPr call ReadRc( rcF, 'input.emis.year.co', emis_input_year_co, status, default=emis_input_year_o3 ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - CO: ', emis_input_year_co; call goPr call ReadRc( rcF, 'input.emis.year.nmvoc', emis_input_year_nmvoc, status, default=emis_input_year_o3 ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - NMVOC:', emis_input_year_nmvoc; call goPr if (emis_input_year_co /= emis_input_year_nmvoc) then write(gol,*) 'ERROR: Emission year for CO and NMVOCs should be the same.'; call goErr write(gol,*) 'ERROR: This is a restriction built in for AerChemMIP.'; call goErr write(gol,*) 'ERROR: Please comment these messages in the code,'; call goErr write(gol,*) 'ERROR: in case you want to use different years.'; call goErr status=1; TRACEBACK; return end if ! CH4 emissions call ReadRc( rcF, 'input.ch4.fixyear', ch4_fixyear, status, default = .false. ) IF_ERROR_RETURN(status=1) if (ch4_fixyear) then CALL ReadRc( rcF, 'input.ch4.year', emis_input_year_ch4, status, default=emis_input_year ) IF_ERROR_RETURN(status=1) write(gol,*) 'EMISS-INFO - CH4 boundary conditions fixed to year: ', emis_input_year_ch4; call goPr else emis_input_year_ch4=emis_input_year write(gol,*) 'EMISS-INFO - CH4 boundary conditions for year: ', emis_input_year_ch4; call goPr if (emis_input_year_ch4 /= idate(1) ) then write(gol,*) 'ERROR: CH4 boundary conditions are not fixed'; call goErr write(gol,*) 'ERROR: and not set to the current year either.'; call goErr write(gol,*) 'ERROR: This combination is currently not allowed.'; call goErr write(gol,*) 'ERROR: To remove this restriction,'; call goErr write(gol,*) 'ERROR: please comment these messages in the code.'; call goErr write(gol,*) 'ERROR: To use fixed boundary conditions,'; call goErr write(gol,*) 'ERROR: please use input.ch4.fixyear.'; call goErr status=1; TRACEBACK; return endif endif ! default directory for emissions data is "standard input files" dir emis_input_dir=trim(inputdir) ! directory of each data provider call ReadRc( rcF, 'input.emis.dir.CMIP6', emis_input_dir_cmip6, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'input.emis.dir.AR5', emis_input_dir_ar5, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'input.emis.dir.MACC', emis_input_dir_mac, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'input.emis.dir.ED41', emis_input_dir_ed4, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'input.emis.dir.gfed', emis_input_dir_gfed, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'input.emis.dir.retro', emis_input_dir_retro, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'input.emis.dir.MEGAN', emis_input_dir_megan, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) #ifdef with_ch4_emis ! for both HYMN and LPJ datasets call ReadRc( rcF, 'input.emis.dir.natch4', emis_input_dir_natch4, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) #endif ! Flags call ReadRc( rcF, 'use_cmip6', LCMIP6, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_cmip6_fires', LCMIP6BMB,status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_ar5', LAR5, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_ar5_fires', LAR5BMB, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_edgar4', LEDGAR4, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_retro_fires', LRETROF, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_gfed3', LGFED3, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_macc', LMACC, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_lpj', LLPJ, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_hymn', LHYMN, status, default=.false. ) IF_ERROR_RETURN(status=1) call ReadRc( rcF, 'use_maccity', LMACCITY,status, default=.false. ) IF_ERROR_RETURN(status=1) IF(LMACCITY) LMACC=.true. ! ensure that MACC data are read. LMACCITY just add anthro sector to MACC's sector list. call ReadRc( rcF, 'use_megan', LMEGAN, status, default=.false. ) IF_ERROR_RETURN(status=1) ! very basic checks if (count((/ LCMIP6, LAR5, LEDGAR4, LMACCITY /)) > 1) then write(gol,*) 'ERROR: You use more than one ANTHROPOGENIC inventory'; call goErr status=1; TRACEBACK; return end if if (count((/ LCMIP6BMB, LAR5BMB, LRETROF, LGFED3 /)) > 1) then write(gol,*) 'ERROR: You use more than one BIOMASS BURNING inventory'; call goErr status=1; TRACEBACK; return end if ! CH4 call ReadRc( rcF, 'input.conc.ch4.cmip6', LCMIP6_CH4, status, default=.true. ) IF_ERROR_RETURN(status=1) if (.not.LCMIP6_CH4 .and. (LCMIP6 .and. LCMIP6BMB) ) then write(gol,'("ERROR: When using CMIP6 emissions, CMIP6 CH4 mixing ratios should be used")'); call goErr status=1; TRACEBACK; return endif if (LCMIP6_CH4) then #ifdef with_ch4_emis write (gol,'("Surface CH4 will be nudged to zonal mean values from CMIP6")'); call goPr #else write(gol,'("WARNING: CH4 emissions are not used")'); call goPr write(gol,'("WARNING: Surface CH4 will be fixed to zonal mean values from CMIP6")'); call goPr #endif if (.not.LCMIP6 .or. .not.LCMIP6BMB) then write(gol,'("WARNING: CMIP6 CH4 mixing ratios used, while CMIP6 emissions are not")'); call goPr endif ! dir with the monthly data (yearly data for stratosphere read in boundary.F90) CALL ReadRc( rcF, 'input.conc.ch4.cmip6.dir.month', cmip6_ch4_dirname, status ) IF_NOTOK_RETURN(status=1) emis_ch4_single = .false. else call ReadRc( rcF, 'input.emis.ch4.single', emis_ch4_single, status ) IF_NOTOK_RETURN(status=1) if ( emis_ch4_single ) then #ifdef with_ch4_emis write (gol,'("ERROR: Switch off CH4 emissions when using a single mixing ratio")'); call goErr status=1; TRACEBACK; return #endif call ReadRc( rcF, 'input.emis.ch4.fixed_ppb', emis_ch4_fixed_ppb, status ) IF_NOTOK_RETURN(status=1) call ReadRc( rcF, 'input.emis.ch4.fix3d', emis_ch4_fix3d, status, default=.true. ) IF_NOTOK_RETURN(status=1) if ( emis_ch4_fix3d ) then write (gol,*) '3-D CH4 will be fixed to ', emis_ch4_fixed_ppb, ' ppb'; call goPr else write (gol,*) 'Surface CH4 will be fixed to ', emis_ch4_fixed_ppb, ' ppb'; call goPr endif else call ReadRc( rcF, 'input.emis.ch4.surf', emis_zch4_fname, status ) IF_NOTOK_RETURN(status=1) #ifdef with_ch4_emis write (gol,'("Surface CH4 will be nudged to a zonal background field")'); call goPr #else write(gol,'("WARNING: CH4 emissions are not used")'); call goPr write(gol,'("WARNING: Surface CH4 will be fixed to a zonal background field")'); call goPr #endif endif endif ! init providers info call emission_read_init( rcF, status ) #ifdef with_online_nox call ReadRc( rcF, 'input.onlinenox.dir', input_nox_dir, status ) IF_NOTOK_RETURN(status=1) #endif ! are convection fluxes computed (Tiedkte) or read? call ReadRc( rcF, 'tiedtke', use_tiedkte, status ) IF_NOTOK_RETURN(status=1) #ifdef with_m7 call ReadRc( rcF, 'input.emis.dir.aerocom', emis_input_dir_aerocom, status, default=emis_input_dir ) IF_NOTOK_RETURN(status=1) call ReadRc( rcF, 'input.emis.dust', emis_input_dust, status, default="AEROCOM" ) IF_NOTOK_RETURN(status=1) call ReadRc( rcF, 'input.emis.dir.dust', emis_input_dir_dust, status, default=emis_input_dir ) IF_NOTOK_RETURN(status=1) call ReadRc( rcF, 'input.nucleation.scheme', nnucl, status ) IF_NOTOK_RETURN(status=1) call ReadRc( rcF, 'input.soa.scheme', nsoa, status ) IF_NOTOK_RETURN(status=1) if (nsoa==2) then write (gol,*) 'INFO: Chemical production of SOA '; call goPr end if call ReadRc( rcF, 'input.KK.d_form', d_form, status, default=5.0 ) IF_ERROR_RETURN(status=1) write (gol,*) 'INFO: Diameter of formed particles in Kerminen&Kulmala parammeterization ',d_form, ' nm' ; call goPr call ReadRc( rcF, 'input.soa.isoprene_on', isoprene_on, status, default=.true. ) IF_ERROR_RETURN(status=1) if (isoprene_on) then write (gol,*) 'INFO: production of SOA from isoprene on'; call goPr end if ! Output info on the chosen new particle formation scheme ! and force unknown scheme into Vehkamaki et al. if (nnucl==1) then write (gol,*) 'INFO: Nucleation scheme Vehkamaki et al. '; call goPr else if (nnucl==2) then write (gol,*) 'INFO: Nucleation scheme Kulmala et al. '; call goPr else if (nnucl==3) then write (gol,*) 'INFO: Nucleation scheme Paasonen et al. '; call goPr else if (nnucl==4) then write (gol,*) 'INFO: Nucleation scheme Riccobono et al. '; call goPr else write (gol,*) 'INFO: Nucleation scheme ',nnucl,' not recognised. ' ; call goPr nnucl=1 write (gol,*) 'INFO: Using Vehkamaki et al. (nnucl = ',nnucl,') ' ; call goPr end if ! end SUBROUTINE EMISSION_INIT #endif call ReadRc( rcF, 'input.emis.dir.dms', emis_input_dir_dms, status, default=emis_input_dir ) IF_NOTOK_RETURN(status=1) call ReadRc( rcF, 'input.emis.dir.rn222', emis_input_dir_rn222, status, default=emis_input_dir ) IF_ERROR_RETURN(status=1) ! Get biomassburning time splitting factors (same for all constituents) ! ----------------------------------------------------------------------------------- call ReadRc( rcF, 'input.emis.bb.dailycycle', emis_bb_trop_cycle, status, default=.false. ) IF_ERROR_RETURN(status=1) if (emis_bb_trop_cycle) then do region = 1, nregions dtime = float(ndyn_max)/(2*tref(region)) ! timestep emissions (CMK changed 5/2006) ntim = 86400/nint(dtime) ! number of timesteps in 24 hours for this region allocate(bb_cycle(region)%scalef(ntim)) call scale_cycle(ntim, bb_cycle(region)%scalef) end do end if ! used by vertical distribution: CALL Set( oro_dat(iglbsfc), status, used=.TRUE. ) ! Allocate data ! ------------- DO region=1,nregions CALL GET_DISTGRID( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 ) lmr = lm(region) ALLOCATE( plandr(region)%surf(i1:i2, j1:j2)) ALLOCATE( emis2D(region)%surf(i1:i2, j1:j2)) #ifdef with_m7 ! aerosols (up to lmr instead of bb_lm) DO imode=1,nmod ALLOCATE(emis_number(region,imode)%d4( i1:i2, j1:j2, lmr, mode_nm(imode))) ALLOCATE(emis_mass (region,imode)%d4( i1:i2, j1:j2, lmr, mode_nm(imode))) ENDDO ALLOCATE(emis_temp(region)%surf(i1:i2, j1:j2)) #endif #ifdef with_budgets ALLOCATE( budemi_dat(region)%emi(i1:i2, j1:j2, nbud_vg, ntracet) ) budemi_dat(region)%emi = 0.0 sum_emission(region) = 0.0 #endif ENDDO ! Done ! ------------- call Done( rcF, status ) IF_NOTOK_RETURN(status=1) ! define timers: call GO_Timer_Def( itim_appl, 'emission appl', status ) IF_NOTOK_RETURN(status=1) call GO_Timer_Def( itim_co, 'emission co', status ) IF_NOTOK_RETURN(status=1) call GO_Timer_Def( itim_voc, 'emission voc', status ) IF_NOTOK_RETURN(status=1) call GO_Timer_Def( itim_dms, 'emission dms', status ) IF_NOTOK_RETURN(status=1) call GO_Timer_Def( itim_nh3, 'emission nh3', status ) IF_NOTOK_RETURN(status=1) call GO_Timer_Def( itim_sox, 'emission sox', status ) IF_NOTOK_RETURN(status=1) call GO_Timer_Def( itim_ch4, 'emission ch4 ', status ) IF_NOTOK_RETURN(status=1) call GO_Timer_Def( itim_isop, 'emission isop', status ) IF_NOTOK_RETURN(status=1) call GO_Timer_Def( itim_rn222, 'emission rn222', status ) IF_NOTOK_RETURN(status=1) status = 0 END SUBROUTINE EMISSION_INIT !EOC !------------------------------------------------------------------------------ ! TM5 ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: EMISSION_DONE ! ! !DESCRIPTION: calculate and write final budgets !\\ !\\ ! !INTERFACE: ! SUBROUTINE EMISSION_DONE( status ) ! ! !USES: ! USE dims, ONLY : nregions, im, jm #ifdef with_budgets USE chem_param, ONLY : ntracet, names USE budget_global, ONLY : budget_file_global, nbud_vg, budg_dat, nbudg, NHAB #ifdef with_hdf4 USE file_hdf, ONLY : THdfFile, TSds USE file_hdf, ONLY : Init, Done, WriteAttribute, WriteData, SetDim #endif USE Dims, ONLY : region_name USE partools, ONLY : isRoot, par_reduce, par_reduce_element #endif use emission_data, only : bb_cycle use emission_data, only : emis_bb_trop_cycle ! ! !OUTPUT PARAMETERS: ! INTEGER, INTENT(out) :: status ! ! !REVISION HISTORY: ! 16 Jul 2010 - A. Strunk - ! 27 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition ! !EOP !------------------------------------------------------------ !BOC CHARACTER(len=*), PARAMETER :: rname = mname//'/Emission_Done' INTEGER :: region, i1, i2, j1, j2 #ifdef with_budgets #ifdef with_hdf4 TYPE(THdfFile) :: io TYPE(TSds) :: sds #endif REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: collect_emissions INTEGER :: nsend,j,i,n,nzone,nzone_v real, dimension(nregions) :: sum_emission_all #endif ! --- begin --------------------------------- #ifdef with_budgets ! add up contribution from all proc DO region = 1, nregions CALL PAR_REDUCE(sum_emission(region), 'SUM', sum_emission_all(region), status) IF_NOTOK_RETURN(status=1) END DO ! Write global budget of tracer #1 IF ( isRoot ) THEN write (gol,'("EMISS-INFO - ----------------------------------------------")'); call goPr write (gol,'("EMISS-INFO - Budget of tracer ",a," (kg) ")') trim(names(1)) ; call goPr write (gol,'("EMISS-INFO - ----------------------------------------------")'); call goPr do region = 1, nregions write (gol,'(A,E13.6)') 'EMISS-INFO - mass emitted : ',sum_emission_all(region); call goPr enddo #ifdef with_hdf4 CALL Init(io, budget_file_global, 'write', status) IF_NOTOK_RETURN(status=1) CALL WriteAttribute(io, 'sum_emission', sum_emission_all, status) IF_NOTOK_RETURN(status=1) #endif budemig = 0.0 END IF ! Gather budgets REG: DO region = 1, nregions CALL GET_DISTGRID( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 ) if (isRoot) then ALLOCATE(collect_emissions(im(region), jm(region), nbud_vg, ntracet)) else ALLOCATE(collect_emissions(1,1,1,1) ) end if CALL GATHER( dgrid(region), budemi_dat(region)%emi, collect_emissions, 0, status) IF_NOTOK_RETURN(status=1) #ifdef with_hdf4 ! write Not-Horizontally-Aggregated-Budgets IF (isRoot.and.NHAB) THEN CALL Init(Sds,io, 'budemi_dat_'//region_name(region),(/im(region),jm(region),nbud_vg,ntracet/), 'real(4)', status) CALL SetDim(Sds, 0, 'im_'//region_name(region),'longitude', (/(j, j=1,im(region))/), status) CALL SetDim(Sds, 1, 'jm_'//region_name(region),'latitude', (/(j, j=1,jm(region))/), status) CALL SetDim(Sds, 2, 'nbud_vg','vertical layer', (/(j, j=1,nbud_vg)/), status) CALL SetDim(Sds, 3, 'ntracet','tracer number', (/(j, j=1,ntracet)/), status) IF_NOTOK_RETURN(status=1) CALL WriteData(Sds,collect_emissions,status) IF_NOTOK_RETURN(status=1) CALL Done(Sds, status) IF_NOTOK_RETURN(status=1) ENDIF #endif ! horizontally aggregates budgets DO n=1,ntracet DO nzone_v=1,nbud_vg DO j=j1,j2 DO i=i1,i2 nzone = budg_dat(region)%nzong(i,j) budemig(nzone,nzone_v,n) = budemig(nzone,nzone_v,n) + budemi_dat(region)%emi(i,j,nzone_v,n) END DO END DO !j END DO !nzone_v END DO !nt DEALLOCATE( collect_emissions ) DEALLOCATE( budemi_dat(region)%emi ) ENDDO REG CALL PAR_REDUCE_ELEMENT( budemig, 'SUM', budemig_all, status) IF_NOTOK_RETURN(status=1) #ifdef with_hdf4 ! Write horizontally aggregated budget IF ( isRoot ) THEN CALL Init(Sds,io, 'budemi',(/nbudg,nbud_vg,ntracet/), 'real(8)', status) IF_NOTOK_RETURN(status=1) CALL SetDim(Sds, 0, 'nbudg','horizontal region', (/(j, j=1,nbudg)/), status) CALL SetDim(Sds, 1, 'nbud_vg','vertical layer', (/(j, j=1,nbud_vg)/), status) CALL SetDim(Sds, 2, 'ntracet','tracer number', (/(j, j=1,ntracet)/), status) IF_NOTOK_RETURN(status=1) CALL WriteData(Sds,budemig_all,status) IF_NOTOK_RETURN(status=1) CALL Done(Sds, status) IF_NOTOK_RETURN(status=1) CALL Done(io, status) IF_NOTOK_RETURN(status=1) ENDIF #endif #endif /* BUDGETS */ ! call other emission_*_done routines CALL FREE_EMISSION(status) IF_NOTOK_RETURN(status=1) ! ----------------------------------------------------------------------------------- ! Free biomassburning time splitting factors (now globally, instead of by constituent) if( emis_bb_trop_cycle ) then do region = 1, nregions deallocate(bb_cycle(region)%scalef) end do end if ! ----------------------------------------------------------------------------------- ! ok status = 0 END SUBROUTINE EMISSION_DONE !EOC !--------------------------------------------------------------------------- ! TM5 ! !--------------------------------------------------------------------------- !BOP ! ! !IROUTINE: DECLARE_EMISSION ! ! !DESCRIPTION: Called at run start (init/allocate emiss data) and then at ! beginning of every month to just read in data. ! Called from SS_MONTHLY_UPDATE. !\\ !\\ ! !INTERFACE: ! SUBROUTINE DECLARE_EMISSION( status ) ! ! !USES: ! USE Grid, ONLY : FillGrid USE MDF, ONLY : MDF_Open, MDF_NETCDF, MDF_READ, MDF_Inq_VarID, MDF_Get_Var, MDF_Close USE dims, ONLY : im, jm, lm, newsrun USE dims, ONLY : nregions, iglbsfc, nlat180, nlon360 USE chem_param #ifdef with_m7 USE mo_aero_m7, ONLY : nmod #endif USE partools, ONLY : isRoot USE global_data, ONLY : emis_data USE meteodata, ONLY : global_lli #ifdef with_online_nox use Online_NOx, only : Online_NOx_Init ! use online_nox_data, only : mlai2d_onlinenox #endif #ifdef with_online_bvoc USE Emission_BVOC, ONLY : Online_BVOC_Init #endif ! AR5/EDGAR4 use emission_data, only : emis_input_dir ! ! !OUTPUT PARAMETERS: ! INTEGER, INTENT(out) :: status ! ! !REVISION HISTORY: ! 16 Jul 2010 - A. Strunk - Adapted to revised emission_*.F90 routines ! 27 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition ! ! !REMARKS: ! - anything that is done only if it's a newrun, and that does not require meteo data, should go in INIT ! !EOP !------------------------------------------------------------------------------ !BOC CHARACTER(len=*), PARAMETER :: rname = mname//'/declare_emission' INTEGER :: region, imode, hid, varid REAL, DIMENSION(:,:), ALLOCATABLE :: pland type(emis_data), dimension(nregions) :: wrk ! ----------------- ! Reset M7 emission ! ----------------- #ifdef with_m7 DO region=1,nregions DO imode=1,nmod emis_number(region,imode)%d4 = 0.0 emis_mass (region,imode)%d4 = 0.0 END DO END DO #endif ! --------------------------------------------------------------- ! ** land fraction ! --------------------------------------------------------------- IF( newsrun ) THEN if(isRoot)then ALLOCATE( pland(nlon360,nlat180) ) DO region=1,nregions allocate( wrk(region)%surf(im(region),jm(region)) ) end DO else ALLOCATE( pland(1,1) ) DO region=1,nregions allocate( wrk(region)%surf(1,1)) end DO end if if (isRoot)then CALL MDF_Open( TRIM(emis_input_dir)//'/land/landfraction.nc4', MDF_NETCDF, MDF_READ, hid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( hid, 'LANDFRACTION', varid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Get_Var( hid, varid, pland, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Close( hid, status ) IF_NOTOK_RETURN(status=1) ! coarsen or distribute to zoom regions: DO region = 1, nregions ! convert grid: CALL FillGrid( global_lli(region), 'n', wrk(region)%surf, & global_lli(iglbsfc), 'n', pland, 'area-aver', status ) IF_NOTOK_RETURN(status=1) END DO end if DO region = 1, nregions call scatter( dgrid(region), plandr(region)%surf, wrk(region)%surf, 0, status) IF_NOTOK_RETURN(status=1) DEALLOCATE( wrk(region)%surf ) END DO DEALLOCATE( pland ) ENDIF ! --------------------------------------------------------------- ! ** init each constituent ! --------------------------------------------------------------- ! ** 1st time, initialise emissions IF ( newsrun ) THEN CALL Emission_NOx_Init( status ) IF_NOTOK_RETURN(status=1) #ifdef with_online_nox ! init online nox module: CALL Online_NOx_Init( status ) IF_NOTOK_RETURN(status=1) #endif CALL Emission_NMVOC_Init( status ) IF_NOTOK_RETURN(status=1) CALL Emission_NH3_Init( status ) IF_NOTOK_RETURN(status=1) CALL Emission_CO_Init( status ) IF_NOTOK_RETURN(status=1) CALL Emission_CH4_Init( status ) IF_NOTOK_RETURN(status=1) CALL Emission_SOx_Init( status ) IF_NOTOK_RETURN(status=1) CALL Emission_DMS_Init( status ) IF_NOTOK_RETURN(status=1) CALL Emission_rn222_Init( status ) IF_NOTOK_RETURN(status=1) #ifdef with_m7 call emission_bc_init( status ) IF_NOTOK_RETURN(status=1) call emission_pom_init( status ) IF_NOTOK_RETURN(status=1) #endif END IF ! ** every month, read and re-grid CALL emission_nox_declare( status ) IF_NOTOK_RETURN(status=1) CALL emission_nmvoc_declare( status ) IF_NOTOK_RETURN(status=1) CALL emission_nh3_declare( status ) IF_NOTOK_RETURN(status=1) CALL emission_co_declare( status ) IF_NOTOK_RETURN(status=1) CALL emission_ch4_declare( status ) IF_NOTOK_RETURN(status=1) CALL emission_sox_declare( status ) IF_NOTOK_RETURN(status=1) CALL emission_dms_declare( status ) IF_NOTOK_RETURN(status=1) ! ** special case of bio voc/isoprene #ifdef with_online_bvoc CALL Online_BVOC_Init( status ) IF_NOTOK_RETURN(status=1) CALL declare_emission_bvoc( status ) #else IF ( newsrun ) THEN CALL Emission_isop_Init( status ) IF_NOTOK_RETURN(status=1) CALL Emission_terp_Init( status ) IF_NOTOK_RETURN(status=1) END IF CALL emission_isop_declare( status ) IF_NOTOK_RETURN(status=1) CALL emission_terp_declare( status ) IF_NOTOK_RETURN(status=1) #endif CALL emission_rn222_declare( status ) IF_NOTOK_RETURN(status=1) #ifdef with_m7 CALL emission_bc_declare( status) IF_NOTOK_RETURN(status=1) CALL emission_pom_declare( status ) IF_NOTOK_RETURN(status=1) CALL emission_dust_declare(status) IF_NOTOK_RETURN(status=1) !!$ CALL declare_emission_ss(status) !!$ IF_NOTOK_RETURN(status=1) #endif ! ok status = 0 END SUBROUTINE DECLARE_EMISSION !EOC !------------------------------------------------------------------- ! TM5 ! !------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_APPLY ! ! !DESCRIPTION: Call emission_apply methods of constituent modules. ! --> add current emissions to tracers array. !\\ !\\ ! !INTERFACE: ! SUBROUTINE EMISSION_APPLY( region, status ) ! ! !USES: ! USE chem_param ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(in) :: region ! ! !OUTPUT PARAMETERS: ! INTEGER, INTENT(out) :: status ! ! !REVISION HISTORY: ! 16 Jul 2010 - A. Strunk - Adapted to revised emission_*.F90 routines ! 27 Mar 2012 - P. Le Sager - cleanup for lat-lon mpi decomposition ! !EOP !----------------------------------------------------------------- !BOC CHARACTER(len=*), PARAMETER :: rname = mname//'/emission_apply' ! --- begin -------------------------------------- ! start timing: call GO_Timer_Start( itim_appl, status ) IF_NOTOK_RETURN(status=1) IF (okdebug) then WRITE(gol,*) 'start of emission_apply for region:',region ; call goPr END IF ! CO emissions call GO_Timer_Start( itim_co, status ) IF_NOTOK_RETURN(status=1) CALL emission_co_apply( region, status ) IF_NOTOK_RETURN(status=1) call GO_Timer_End( itim_co, status ) IF_NOTOK_RETURN(status=1) ! CH4 emissions call GO_Timer_Start( itim_ch4, status ) IF_NOTOK_RETURN(status=1) CALL emission_ch4_apply(region, status ) IF_NOTOK_RETURN(status=1) call GO_Timer_End( itim_ch4, status ) IF_NOTOK_RETURN(status=1) ! biogenic NMHC emissions (isoprene) call GO_Timer_Start( itim_isop, status ) IF_NOTOK_RETURN(status=1) #ifdef with_online_bvoc CALL emission_apply_bvoc( region, status ) #else CALL emission_isop_apply( region, status ) IF_NOTOK_RETURN(status=1) CALL emission_terp_apply( region, status ) IF_NOTOK_RETURN(status=1) #endif call GO_Timer_End( itim_isop, status ) IF_NOTOK_RETURN(status=1) ! add di-methyl sulfide emissions: call GO_Timer_Start( itim_dms, status ) IF_NOTOK_RETURN(status=1) CALL emission_dms_apply(region, status) IF_NOTOK_RETURN(status=1) call GO_Timer_End( itim_dms, status ) IF_NOTOK_RETURN(status=1) ! add SOx emissions: call GO_Timer_Start( itim_sox, status ) IF_NOTOK_RETURN(status=1) CALL emission_sox_apply( region, status ) IF_NOTOK_RETURN(status=1) call GO_Timer_End( itim_sox, status ) IF_NOTOK_RETURN(status=1) ! add NH3 emissions: call GO_Timer_Start( itim_nh3, status ) IF_NOTOK_RETURN(status=1) CALL emission_nh3_apply(region, status) IF_NOTOK_RETURN(status=1) call GO_Timer_End( itim_nh3, status ) IF_NOTOK_RETURN(status=1) ! add Rn222 emissions: call GO_Timer_Start( itim_rn222, status ) IF_NOTOK_RETURN(status=1) CALL emission_rn222_apply(region, status) IF_NOTOK_RETURN(status=1) call GO_Timer_End( itim_rn222, status ) IF_NOTOK_RETURN(status=1) ! black carbon and particulate organic matter emissions are added in the sedimentation routine... ! seasalt and dust (which also sediment) are added in tracer_after_read... ! add non-methane voc emissions: call GO_Timer_Start( itim_voc, status ) IF_NOTOK_RETURN(status=1) CALL emission_nmvoc_apply( region, status ) IF_NOTOK_RETURN(status=1) call GO_Timer_End( itim_voc, status ) IF_NOTOK_RETURN(status=1) IF(okdebug) then WRITE(gol,*) 'End of adding emission '; call goPr END IF ! end timing: call GO_Timer_End( itim_appl, status ) IF_NOTOK_RETURN(status=1) ! ok status = 0 END SUBROUTINE EMISSION_APPLY !EOC !---------------------------------------------------------------------------- ! TM5 ! !---------------------------------------------------------------------------- !BOP ! ! !IROUTINE: FREE_EMISSION ! ! !DESCRIPTION: Deallocate space needed to handle the emissions by calling ! *done methods of constituents' modules. !\\ !\\ ! !INTERFACE: ! SUBROUTINE FREE_EMISSION( status ) ! ! !USES: ! USE dims, ONLY : nregions #ifdef with_m7 USE mo_aero_m7, ONLY : nmod #endif #ifdef with_online_nox USE Online_NOx, ONLY : Online_NOx_Done #endif #ifdef with_online_bvoc USE Emission_BVOC, ONLY : Online_BVOC_Done #endif ! ! !OUTPUT PARAMETERS: ! INTEGER, INTENT(out) :: status ! ! !REVISION HISTORY: ! 16 Jul 2010 - A. Strunk - Adapted to revised emission_*.F90 routines ! 27 Mar 2012 - P. Le Sager - Adapted for lon-lat MPI domain decomposition ! !EOP !--------------------------------------------------------------------------- !BOC CHARACTER(len=*), PARAMETER :: rname = mname//'/free_emission' INTEGER :: region, imode ! --- begin ----------------------------------- DO region = 1, nregions DEALLOCATE(plandr(region)%surf) DEALLOCATE(emis2D(region)%surf) #ifdef with_m7 ! aerosols: DO imode = 1, nmod DEALLOCATE(emis_number(region,imode)%d4) DEALLOCATE(emis_mass(region,imode)%d4) ENDDO DEALLOCATE(emis_temp(region)%surf) #endif ENDDO CALL Emission_NOx_Done( status ) IF_NOTOK_RETURN(status=1) #ifdef with_online_nox CALL Online_NOx_Done( status ) IF_NOTOK_RETURN(status=1) #endif CALL emission_nh3_done( status ) IF_NOTOK_RETURN(status=1) CALL Emission_CO_Done( status ) IF_NOTOK_RETURN(status=1) CALL Emission_CH4_Done( status ) IF_NOTOK_RETURN(status=1) CALL Emission_SOx_Done( status ) IF_NOTOK_RETURN(status=1) CALL emission_dms_done( status ) IF_NOTOK_RETURN(status=1) #ifdef with_online_bvoc CALL free_emission_bvoc ( status ) ! done with online bvoc module: CALL Online_BVOC_Done( status ) IF_NOTOK_RETURN(status=1) #else CALL Emission_isop_Done ( status ) IF_NOTOK_RETURN(status=1) CALL Emission_terp_Done ( status ) IF_NOTOK_RETURN(status=1) #endif CALL emission_rn222_done( status ) IF_NOTOK_RETURN(status=1) #ifdef with_m7 CALL emission_bc_done( status ) IF_NOTOK_RETURN(status=1) CALL emission_pom_done( status ) IF_NOTOK_RETURN(status=1) CALL emission_dust_done !!$ CALL free_emission_ss #endif CALL Emission_NMVOC_Done( status ) IF_NOTOK_RETURN(status=1) ! done status = 0 END SUBROUTINE FREE_EMISSION !EOC END MODULE EMISSION