#include "tm5.inc" MODULE mo_aero ! *mo_aero* contains phyiscal switches and parameters ! for the ECHAM/HAM aerosol model. ! ! Author: ! ------- ! Philip Stier, MPI-MET 12/2002 ! !!$ USE mo_linked_list, ONLY: NETCDF, GRIB USE mo_aero_m7, ONLY: nmod !!$ USE mo_control, ONLY: lcolumn IMPLICIT NONE !--- 0) Submodel ID: INTEGER :: id_ham !--- 1) Switches: !--- 1.1) Physical: !--- Define control variables and pre-set with default values: LOGICAL :: lm7 = .TRUE. ! Aerosol dynamics and thermodynamics scheme M7 INTEGER :: ncdnc = 0, & ! CDNC activation scheme: ! ! ncdnc = 0 OFF => standard ECHAM5 ! ! = 1 Lohmann et al. (1999) + Lin and Leaitch (1997) ! = 2 Lohmann et al. (1999) + Abdul-Razzak and Ghan (2000) ! = 3 Lohmann et al. (1999) + ( Nenes et al. (2003) ) ! nicnc = 0, & ! ICNC scheme: ! ! ncdnc = 0 OFF ! = 1 Kaercher and Lohmann (2002) ! nauto = 1, & ! Autoconversion scheme: ! ! nauto = 1 Beheng (1994) - ECHAM5 Standard ! = 2 Khairoutdinov and Kogan (2000) ! ndust = 2, & ! Dust emission scheme: ! ! ndust = 1 Balkanski et al. (2002) ! = 2 Tegen et al. (2002) ! nseasalt = 2, & ! Sea Salt emission scheme: ! ! nseasalt = 1 Monahan (1986) ! = 2 Schulz et al. (2002) ! npist = 3, & ! DMS emission scheme: ! ! npist = 1 Liss & Merlivat (1986) ! = 2 Wanninkhof (1992) ! = 3 Nightingale (2000) ! nemiss = 1 ! Emission inventory ! ! nemiss =1 old version ! nemiss =2 AEROCOM emissions 2000 LOGICAL :: lodiag = .FALSE. ! Extended diagnostics LOGICAL :: laero_rad = .FALSE. ! Radiation calculation LOGICAL :: lorad(nmod) = .FALSE. ! switch for each mode LOGICAL :: lodiagrad = .FALSE. ! Extended radiation diagnostics INTEGER :: nwv = 0 ! nwv: number of additional wavelengths ! for the radiation calculations ! (max currently set to 10) REAL :: cwv(10) = 0. ! cwv: array of additional wavelengths ! for the radiation calculations [m] LOGICAL :: lomassfix = .TRUE. ! Mass fixer in convective scheme !--- 1.2) Technical: !!$ INTEGER :: NFILETYPE = GRIB ! Output stream filetypes !--- 2) Parameters: !-- 2.1) Number of aerosol compounds: (needs to be harmonized with nmode in mo_aero_m7) INTEGER, PARAMETER :: ntype=6 !--- 2.2) Mode names: CHARACTER(LEN=2), PARAMETER :: cmode(nmod)=(/'NS','KS','AS','CS','KI','AI','CI'/) !--- 2.3) Compound names: CHARACTER(LEN=3), PARAMETER :: ctype(ntype)=(/'SO4','BC ','OC ','SS ','DU ','WAT'/) !--- 2.4) Index field of tracer indices for the aerosol numbers in each mode: INTEGER :: nindex(nmod) !--- 2.5) Emissions: !--- Carbon Emissions REAL, PARAMETER :: zbb_wsoc_perc = 0.65, & ! Biom. Burn. Percentage of Water Soluble OC (WSOC) [1] ! (M.O. Andreae; Talk: Smoke and Climate) zbge_wsoc_perc = 0.65, & ! Assume same Percentage of WSOC for biogenic OC !>>> TvN ! The value of 1.4 for the POM to OC mass ratio is an outdated estimate. ! In the current code we apply different ratios ! for emissions from vegetation fires and other emissions. ! For further details, see comment in emission_data.F90. ! The use of a single constant value, on the other hand, ! would have the advantage that the simulated POM concentrations ! can easily be converted to OC. ! An average value of 1.8 seems reasonable. ! Assuming that there are no substantial contributions from ! elements other than H and O, a value of 1.8 can be obtained ! with an H:C atomic ratio of 1.6 and and O:C ratio of 0.5, ! which are well within the range of oxidation states ! presented by Heald et al. (GRL, 2010). ! According to the model of Kuwata et al. (Environ. Sci. Technol., 2012), ! the resulting particle density would be close to the value ! assumed in the model (doc = 1.3 g/cm3 in mo_aero_m7.F90). !zom2oc = 1.4, & ! Mass ratio organic species to organic carbon ! (Seinfeld and Pandis, 1998, p709; ! Ferek et al., JGR, 1998) ! ! The emission radii for carbonaceous aerosols of the original code below ! correspond to the values recommended by AeroCom (Dentener et al., ACP, 2006), ! but adapted to sigma = 1.59 as used in M7 (Stier et al., ACP, 2005). ! See also Figure C2 from Dentener et al. for a linear relation ! between emission radius and sigma. ! ! For comparison, Bond et al. (JGR, 2013) give number median radii ! between 25 and 40 nm for fresh BC in the urban areas ! of Tokyo, Nagoya, and Seoul, ! of 60 nm in plumes associated with wildfires, ! and about 15 nm from aircraft jet engines. ! These values are volume-equivalent radii (see their Fig. 4). ! ! According to the original paper by Schwarz et al. (GRL, 2008) ! the corresponding geometric standard deviation ! is sigma = 1.71 for the urban BC ! and 1.43 for the biomass burning aerosol. ! ! For BC in biomass burning plumes, ! Kondo et al (JGR, 2011) estimated ! number median radii in the range 68-70.5 nm (+- 6-8 nm) ! and geometric standard deviation between 1.32 and 1.36 (+- 0.01-0.04), ! for particles thickly coated by organics. ! ! Janhaell et al. (ACP, 2010) have compiled measurements of ! particle size in fresh biomass burning smoke from vegetation fires. ! They mention that particles from biomass burning are dominated ! by an accumulation mode. ! They also present a relation between the geometric mean diameter Dg ! and geometric standard deviation sigma for fresh smoke: ! Dg (um) = (584 +- 5) - (269 +-1) sigma ! This gives a geometric mean radius of 78 um for sigma = 1.59, ! in close agreement with the value used by Stier et al. ! Particles emitted by grass and savannah fires are generally ! somewhat smaller than those from wood burning. ! Janhaell et al. estimate that the mean emission radii ! for grass and savannah fires, resp., are 12.5 and 10 nm smaller. ! These differences is not accounted for in the model. ! ! In a later version of ECHAM-HAM particles the emission radius ! for biomass burning was reduced to the value for fossil fuel ! (Zhang et al., ACP, 2012). ! However, such as a small value seems inconsistent with measurements. ! cmr_ff = 0.03E-6, & ! Fossil fuel emissions: ! assumed number median radius of the emitted ! particles with the standard deviation given ! in mo_aero_m7 [m]. Has to lie within the ! Aitken mode for the current setup! cmr_bb = 0.075E-6, & ! Biomass burning emissions: ! Assumed number median radius of the emitted ! particles with the standard deviation given ! in mo_aero_m7 [m]. Has to lie within the ! Accumulation mode for the current setup! cmr_bg = 0.03E-6, &! Biogenic secondary particle formation: ! Assumed number median radius of the emitted ! particles with the standard deviation given ! in mo_aero_m7 [m]. Has to lie within the ! Aitken mode for the current setup! cmr_sk = 0.03E-6, &! SO4 primary emission ---> aitken mode ! Assumed number median radius of the emitted ! particles with the standard deviation given ! in mo_aero_m7 [m]. Has to lie within the ! Aitken mode for the current setup! cmr_sa = 0.075E-6, &! SO4 primary emission ---> accumulation mode ! Assumed number median radius of the emitted ! particles with the standard deviation given ! in mo_aero_m7 [m]. Has to lie within the ! Accumulation mode for the current setup! cmr_sc = 0.75E-6, &! SO4 primary emission ---> coarse mode ! Assumed number median radius of the emitted ! particles with the standard deviation given ! in mo_aero_m7 [m]. Has to lie within the ! Coarse mode for the current setup! facso2 = 0.975, &! factor to scale primary SO4 emissions ! AEROCOM assumption 2.5 % of the SO2 emissions ! in the from of SO4 so2ts = 1./1.998 ! conversion factor SO2 to S REAL, PUBLIC :: zm2n_bcki_ff, zm2n_bcki_bb, & zm2n_bcks_bb, zm2n_ocki_ff, & zm2n_ocki_bb, zm2n_ocki_bg, & zm2n_ocks_bb, zm2n_ocks_bg, & zm2n_s4ks_sk, zm2n_s4as_sa, & zm2n_s4cs_sc !!$CONTAINS !!$ !!$ !!$ SUBROUTINE aero_initialize !!$ !!$ ! Purpose: !!$ ! --------- !!$ ! Initializes constants and parameters !!$ ! used in the HAM aerosol model. !!$ ! Performs consistency checks. !!$ ! !!$ ! Author: !!$ ! --------- !!$ ! Philip Stier, MPI 03/2003 !!$ ! !!$ ! Interface: !!$ ! --------- !!$ ! *aero_initialize* is called from *call_init_submodels* in *call_submodels* !!$ ! needs to be called after initialization of the !!$ ! submodel as it makes use of parameters in mo_aero_m7 !!$ ! !!$ !!$ USE mo_tracer, ONLY: flag, ntrac, trlist, AEROSOLNUMBER !!$ USE mo_constants, ONLY: api !!$ USE mo_radiation, ONLY: iaero !!$ USE mo_mpi, ONLY: p_parallel_io !!$ USE mo_doctor, ONLY: nout !!$ USE mo_exception, ONLY: finish !!$ USE mo_aero_m7, ONLY: cmr2ram !!$ USE mo_aero_trac, ONLY: idt_mbcki, idt_mbcks, & !!$ idt_mocki, idt_mocks, & !!$ idt_ms4ks, idt_ms4as, & !!$ idt_ms4cs !!$ USE mo_aero_m7, ONLY: iaiti, iaits, iaccs, icoas !!$ !!$ IMPLICIT NONE !!$ !!$ INTEGER :: jwv, jmod, jt !!$ !!$ !--- 1) Consistency checks: !!$ !!$ !--- 1.1) Radiation: !!$ !!$ IF (nwv > 10 ) & !!$ CALL finish('aero_initialize','maximal number of additional wavelengths exceeded') !!$ !!$ IF (iaero==4 .AND. ANY(lorad(:))) THEN !!$ laero_rad=.TRUE. !!$ ELSE IF (iaero/=4 .AND. ANY(lorad(:))) THEN !!$ CALL finish('aero_initialize','inconsistent setting of iaero in radctl') !!$ ELSE IF (iaero==4 .AND. .NOT.ANY(lorad(:))) THEN !!$ CALL finish('aero_initialize','inconsistent setting of iaero and lorad') !!$ END IF !!$ !!$ !--- 1.2) Output type: !!$ !!$ IF(nfiletype/=GRIB .AND. nfiletype/=NETCDF) THEN !!$ CALL finish('aero_initialize','selected output filetype not supported') !!$ END IF !!$ !!$ !--- 2) Consistency checks and display of information: !!$ !!$ IF (p_parallel_io) THEN !!$ WRITE(nout,*) '' !!$ WRITE(nout,*) '' !!$ WRITE(nout,*) '----------------------------------------------------------' !!$ WRITE(nout,*) '----------------------------------------------------------' !!$ WRITE(nout,*) '--- Initialization of the ECHAM/HAM aerosol model ---' !!$ WRITE(nout,*) '---' !!$ WRITE(nout,*) '--- Default values of aeroctl modified by setaero:' !!$ WRITE(nout,*) '---' !!$ WRITE(nout,*) '--- New settings: lm7 = ', lm7 !!$ WRITE(nout,*) '--- ncdnc = ', ncdnc !!$ IF (ncdnc==0) THEN !!$ WRITE(nout,*) '--- => no aerosol-CDNC coupling' !!$ ELSE IF (ncdnc==1) THEN !!$ WRITE(nout,*) '--- => Lohmann et al. (1999) +' !!$ WRITE(nout,*) '--- Lin and Leaitch (1997)' !!$ ELSE IF (ncdnc==2) THEN !!$ WRITE(nout,*) '--- => Lohmann et al. (1999) +' !!$ WRITE(nout,*) '--- Abdul-Razzak and Ghan (2000)' !!$ END IF !!$ WRITE(nout,*) '--- nicnc = ', nicnc !!$ IF (nicnc==0) THEN !!$ WRITE(nout,*) '--- => no aerosol-ICNC coupling' !!$ ELSE IF (ncdnc>0 .AND. nicnc==1) THEN !!$ WRITE(nout,*) '--- => Kaercher and Lohmann (2002)' !!$ ELSE IF (ncdnc==0 .AND. nicnc>0) THEN !!$ WRITE(nout,*) '--- => ICNC scheme requires CDNC scheme!' !!$ CALL finish('aero_initialize','inconsistent combination of ncdnc and nicnc') !!$ END IF !!$ WRITE(nout,*) '--- nauto = ', nauto !!$ WRITE(nout,*) '--- => Autoconversion scheme:' !!$ IF (nauto==1) THEN !!$ WRITE(nout,*) '--- Beheng (1994) - ECHAM5 Standard' !!$ ELSE IF (nauto==2 .AND. ncdnc>0) THEN !!$ WRITE(nout,*) '--- Khairoutdinov and Kogan (2000)' !!$ ELSE IF (nauto==2 .AND. ncdnc==0) THEN !!$ WRITE(nout,*) '--- Khairoutdinov and Kogan (2000)' !!$ WRITE(nout,*) '--- scheme requires CDNC scheme!' !!$ CALL finish('aero_initialize','inconsistent combination of nauto and ncdnc') !!$ ELSE !!$ CALL finish('aero_initialize','invalid setting for nauto') !!$ END IF !!$ WRITE(nout,*) '--- ndust = ', ndust !!$ IF (ndust==1) THEN !!$ WRITE(nout,*) '--- => Balkanski et al. (2002)' !!$ ELSE IF (ndust==2) THEN !!$ WRITE(nout,*) '--- => Tegen et al. (2002)' !!$ IF (lcolumn) THEN !!$ WRITE(nout,*) '--- WARNING:' !!$ WRITE(nout,*) '--- This dust emission scheme ' !!$ WRITE(nout,*) '--- does not work in SCM mode!' !!$ WRITE(nout,*) '--- Dust emissions deactivated!' !!$ ndust=0 !!$ WRITE(nout,*) '--- => ndust = ', ndust !!$ END IF !lcolumn !!$ ELSE IF (ndust==0) THEN !!$ WRITE(nout,*) '--- => DUST EMISSIONS DEACTIVATED!' !!$ END IF !!$ WRITE(nout,*) '--- nseasalt = ', nseasalt !!$ IF (nseasalt==1) THEN !!$ WRITE(nout,*) '--- => Monahan (1986)' !!$ ELSE IF (nseasalt==2) THEN !!$ WRITE(nout,*) '--- => Schulz et al. (2002)' !!$ ELSE IF (nseasalt==0) THEN !!$ WRITE(nout,*) '--- => SEASALT EMISSIONS DEACTIVATED!' !!$ END IF !!$ WRITE(nout,*) '--- npist = ', npist !!$ IF (npist==1) THEN !!$ WRITE(nout,*) '--- => Air-sea exchange:' !!$ WRITE(nout,*) '--- Liss & Merlivat (1986)' !!$ ELSE IF (npist==2) THEN !!$ WRITE(nout,*) '--- => Air-sea exchange:' !!$ WRITE(nout,*) '--- Wanninkhof (1992)' !!$ ELSE IF (npist==3) THEN !!$ WRITE(nout,*) '--- => Air-sea exchange:' !!$ WRITE(nout,*) '--- Nightingale (2000)' !!$ END IF !!$ WRITE(nout,*) '--- nemiss = ', nemiss !!$ IF (nemiss==1) THEN !!$ WRITE(nout,*) '--- => 1985 emission data' !!$ ELSE IF (nemiss==2) THEN !!$ WRITE(nout,*) '--- => AEROCOM emissions 2000' !!$ END IF !!$ IF (lodiag) THEN !!$ WRITE(nout,*) '--- lodiag = ', lodiag !!$ WRITE(nout,*) '--- => Aerosol diagnostics activated' !!$ ELSE !!$ WRITE(nout,*) '--- lodiag = ', lodiag !!$ WRITE(nout,*) '--- => Aerosol diagnostics deactivated' !!$ END IF !!$ IF (laero_rad) THEN !!$ WRITE(nout,*) '--- lorad = ', lorad !!$ WRITE(nout,*) '--- => Radiation calculation for:' !!$ WRITE(nout,*) '---' !!$ DO jmod=1, nmod !!$ IF (lorad(jmod)) THEN !!$ WRITE(nout,*) '--- Mode ', jmod !!$ END IF !!$ END DO !!$ WRITE(nout,*) '---' !!$ IF (nwv>0) THEN !!$ WRITE(nout,*) '--- nwv = ', nwv !!$ WRITE(nout,*) '--- => Additional wavelengs requested:' !!$ WRITE(nout,*) '---' !!$ DO jwv=1, nwv !!$ WRITE(nout,fmt="(A,E8.2,A)") '--- ',cwv(jwv), ' [m]' !!$ END DO !!$ END IF !!$ ELSE !!$ WRITE(nout,*) '--- Radiation calculations deactivated!' !!$ END IF !!$ IF (lodiagrad) THEN !!$ WRITE(nout,*) '--- lodiagrad = ', lodiagrad !!$ WRITE(nout,*) '--- => Extended radiation diagnostics!' !!$ END IF !!$ WRITE(nout,*) '---' !!$ IF(lomassfix) THEN !!$ WRITE(nout,*) '--- Mass fixer in convection activated!' !!$ ELSE !!$ WRITE(nout,*) '--- Mass fixer in convection deactivated!' !!$ END IF !!$ WRITE(nout,*) '---' !!$ IF(nfiletype==GRIB) THEN !!$ WRITE(nout,*) '--- Output filetype set to GRIB' !!$ ELSE IF(nfiletype==NETCDF) THEN !!$ WRITE(nout,*) '--- Output filetype set to NetCDF' !!$ END IF !!$ END IF !!$ !!$ !--- 2) Initialize constants and parameters: !!$ !!$ !--- 2.1) Emissions !!$ ! Calculate factors to convert mass flux in number flux for !!$ ! given number median radii (cmr) and standard deviation !!$ ! (implicitly by the conversion factor cmr2ram) of the modes !!$ ! !!$ ! N = M/m = M/(4/3 * pi * dens * R(averageMass)**3) !!$ ! = M * (3/(4*pi*dens*R(averageMass))) !!$ ! ! !!$ ! = M * zm2n_xx !!$ !!$ zm2n_bcki_ff=3./(4.*api*flag('density',idt_mbcki)*(cmr_ff*cmr2ram(iaiti))**3.) !!$ zm2n_bcki_bb=3./(4.*api*flag('density',idt_mbcki)*(cmr_bb*cmr2ram(iaiti))**3.) !!$ !!$ zm2n_bcks_bb=3./(4.*api*flag('density',idt_mbcks)*(cmr_bb*cmr2ram(iaits))**3.) !!$ !!$ zm2n_ocki_ff=3./(4.*api*flag('density',idt_mocki)*(cmr_ff*cmr2ram(iaiti))**3.) !!$ zm2n_ocki_bb=3./(4.*api*flag('density',idt_mocki)*(cmr_bb*cmr2ram(iaiti))**3.) !!$ zm2n_ocki_bg=3./(4.*api*flag('density',idt_mocki)*(cmr_bg*cmr2ram(iaiti))**3.) !!$ !!$ zm2n_ocks_bb=3./(4.*api*flag('density',idt_mocks)*(cmr_bb*cmr2ram(iaits))**3.) !!$ zm2n_ocks_bg=3./(4.*api*flag('density',idt_mocks)*(cmr_bg*cmr2ram(iaits))**3.) !!$ !!$ !?????????????? !!$ zm2n_s4ks_sk=3./(4.*api*flag('density',idt_ms4ks)*(cmr_sk*cmr2ram(iaits))**3.) !!$ zm2n_s4as_sa=3./(4.*api*flag('density',idt_ms4as)*(cmr_sa*cmr2ram(iaccs))**3.) !!$ zm2n_s4cs_sc=3./(4.*api*flag('density',idt_ms4cs)*(cmr_sc*cmr2ram(icoas))**3.) !!$ !???????????? !!$ !!$ !--- 3) Set up index matrices for access of tracer by compound and mode: !!$ !!$ IF (p_parallel_io) THEN !!$ WRITE(nout,*) '---' !!$ WRITE(nout,*) '--- Mapping of ECHAM tracers HAM mode-indices:' !!$ WRITE(nout,*) '---' !!$ END IF !!$ !!$ DO jmod=1, nmod !!$ DO jt=1, ntrac !!$ IF(trlist%ti(jt)%nphase==AEROSOLNUMBER .AND. trlist%ti(jt)%mode==jmod) THEN !!$ nindex(jmod)=jt !!$ IF (p_parallel_io) THEN !!$ WRITE(nout,*) '--- ', TRIM(trlist%ti(jt)%fullname),': ', jmod !!$ END IF !!$ CYCLE !!$ END IF !!$ END DO !!$ END DO !!$ !!$ !--- 4) Finish: !!$ !!$ IF (p_parallel_io) THEN !!$ WRITE(nout,*) '---' !!$ WRITE(nout,*) '--- Parameters for ECHAM5-HAM initialized ---' !!$ WRITE(nout,*) '----------------------------------------------------------' !!$ WRITE(nout,*) '----------------------------------------------------------' !!$ WRITE(nout,*) '' !!$ WRITE(nout,*) '' !!$ END IF !!$ END SUBROUTINE aero_initialize !!$ !!$ !!$ SUBROUTINE setaero !!$ !!$ ! *setaero* modifies pre-set switches of the aeroctl !!$ ! namelist for the configuration of the !!$ ! ECHAM/HAM aerosol model !!$ ! !!$ ! Authors: !!$ ! -------- !!$ ! Philip Stier, MPI-MET 12/2002 !!$ ! !!$ ! *setaero* is called from *call_init_submodels* in *call_submodels* !!$ ! !!$ !!$ USE mo_mpi, ONLY: p_parallel, p_parallel_io, p_bcast, p_io !!$ USE mo_namelist, ONLY: position_nml, nnml, POSITIONED !!$ !!$ IMPLICIT NONE !!$ !!$ INCLUDE 'aeroctl.inc' !!$ !!$ !--- Local variables: !!$ !!$ INTEGER :: ierr !!$ !!$ !--- 1) Read namelist: !!$ !!$ IF (p_parallel_io) THEN !!$ CALL position_nml ('AEROCTL', status=ierr) !!$ SELECT CASE (ierr) !!$ CASE (POSITIONED) !!$ READ (nnml, aeroctl) !!$ END SELECT !!$ ENDIF !!$ !!$ !--- 2) Broadcast over processors: !!$ !!$ IF (p_parallel) THEN !!$ CALL p_bcast (lm7, p_io) !!$ CALL p_bcast (ncdnc, p_io) !!$ CALL p_bcast (nicnc, p_io) !!$ CALL p_bcast (nauto, p_io) !!$ CALL p_bcast (ndust, p_io) !!$ CALL p_bcast (nseasalt, p_io) !!$ CALL p_bcast (npist, p_io) !!$ CALL p_bcast (nemiss, p_io) !!$ CALL p_bcast (lodiag, p_io) !!$ CALL p_bcast (nfiletype, p_io) !!$ CALL p_bcast (lorad, p_io) !!$ CALL p_bcast (lodiagrad, p_io) !!$ CALL p_bcast (nwv, p_io) !!$ CALL p_bcast (cwv, p_io) !!$ CALL p_bcast (lomassfix, p_io) !!$ END IF !!$ !!$ END SUBROUTINE setaero END MODULE mo_aero