! Copyright 2008-2021 Earth Sciences Department, BSC-CNS
!
! This file is part of MONARCH.
!
! MONARCH is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! MONARCH is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with MONARCH. If not, see <http://www.gnu.org/licenses/>.
!
      MODULE MODULE_BSC_AERO_MECHANISM
!
!-----------------------------------------------------------------------
!
!***  AERO BSC MECHANISM MODULE.
!
!-----------------------------------------------------------------------
! HISTORY LOG:
!
!   2014-03-11  Jorba - Creation of the module.
!
!-----------------------------------------------------------------------
!
      USE NETCDF
!     
      USE MODULE_DM_PARALLEL, ONLY : MYPE_SHARE,MPI_COMM_COMP,DSTRB     &
                                    ,ITS_B1,ITE_B1,JTS_B1,JTE_B1
!
      USE MODULE_BSC_CHEM_DATA
!
      USE module_data_radm2 !FOR MEGAN
!
      USE MODULE_BIOEMI_MEGAN2, ONLY : bio_emissions_megan2,READ_MEGAN_CNST_FIELDS !FOR MEGAN
      USE MODULE_SULFUR_CHEM, ONLY : RUN_SULFUR
!
!      USE MODULE_SULFUR_NITRATE_CHEM, ONLY : RUN_SULFUR_NITRATE
!
      USE MODULE_SULFUR_AQ_CHEM, ONLY : RUN_SULFUR_AQUEOUS
      USE TRACERS_SOA, ONLY: soa_bins, soa_cond, soa_tr, &
                         soa_init, soa_calc, soa_finalize, &
                         isoa_apin, isoa_isop, isoa_oh, isoa_o3, isoa_no3, &
                         isoa_isopp1, isoa_isopp2, isoa_apinp1, isoa_apinp2
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE AERO_BSC_DRIVER(GLOBAL,NTIMESTEP,DT,NCHEM             &
               ,T_PHY,RELHUM,WATER,NUM_WATER,P_QC,P_QV,P_QR            &
               ,START_YEAR,START_MONTH,START_DAY,START_HOUR            &
               ,JULDAY,XLAT,XLONG,P_PHY,T2,RSWIN                       &
               ,DZ8W,Z_AT_W,AIRDENSITY                                 &
               ,EMISS_AERO,NUM_AERO                                    &
               ,AERO_BSC,NUM_AERO_BSC                                  &
               ,NUM_ASH,NUM_DUST,NUM_SALT                              &
               ,NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4,NUM_UNSPC        &
               ,CHEM,NUM_GAS_TOTAL                                     &
               ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC,E_DMS    &
               ,GLAT,GLON                                              &
               ,DARE,JPNL,KHET                                         &
               ,IDS,IDE,JDS,JDE,LM                                     &
               ,IMS,IME,JMS,JME,KMS,KME                                &
               ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  AERO BSC DRIVER 
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 11-03-14
!
! ABSTRACT:
!     READ EMISSIONS FROM AEROCOM-ACCMIP DATABASE FOR GLOBAL RUNS
!     READ CLIMATOLOGIES OF O3/OH/NO3/SO2/XYL/TERP OR DYNAMIC FIELDS FROM CHEM
!     SOLVE THE AEROSOL MECHANISM FOR OM,BC,SO4 OR OM,BC,SO4,NO3-,NH4+  
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   11-03-14  JORBA      - ORIGINATOR OF THE SUBROUTINE
!
! USAGE: CALL AERO_BSC_DRIVER FROM CHEM_DRIVER    
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      LOGICAL,INTENT(IN) :: GLOBAL           ! global/regional flag
      INTEGER,INTENT(IN) :: NTIMESTEP        ! number of dynamics time step
      INTEGER,INTENT(IN) :: NCHEM            ! Number of dynamics timesteps between calls to chemistry

      REAL,INTENT(IN)    :: DT               ! dynamics time step

      INTEGER,INTENT(IN) :: NUM_AERO         ! Total Number of bins from Ash/Dust/Salt/OM/BC/SO4/NO3-/NH4+/UNSPC
      INTEGER,INTENT(IN) :: NUM_AERO_BSC     ! Total Number of bins from OM/BC/SO4/NO3-/NH4+/UNSPC BSC AEROSOLS
      INTEGER,INTENT(IN) :: NUM_ASH,NUM_DUST,NUM_SALT !Number of bins from Ash/Dust/Salt
      INTEGER,INTENT(IN) :: NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4,NUM_UNSPC ! Number of bins from OM/BC/SO4/NO3-/NH4+/UNSPC BSC AEROSOLS
      INTEGER,INTENT(IN) :: NUM_GAS_TOTAL    ! total number of gas-phase species implemented in the NMMB module
      INTEGER,INTENT(IN) :: NUM_WATER        ! total number of water species from microphysics
      INTEGER,INTENT(IN) :: P_QC,P_QV,P_QR        ! position of water vapor and cloud water in WATER array
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE  ! global cell indexs
      INTEGER,INTENT(IN) :: LM               ! Number of vertical layers
      INTEGER,INTENT(IN) :: IMS, IME, JMS, JME, KMS, KME   ! local cell indexes with halo widths
      INTEGER,INTENT(IN) :: ITS,ITE,JTS,JTE  ! local cell indexes w/o halo     
      INTEGER,INTENT(IN) :: START_YEAR,START_MONTH,START_DAY,START_HOUR ! Starting date of the simulation
      INTEGER,INTENT(IN) :: JULDAY
      INTEGER,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: JPNL ! Number of vertical layers where to solve the chemistry
      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: XLAT,XLONG
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: T2,RSWIN
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: P_PHY
      REAL,DIMENSION(JDS:JDE) :: DARE ! Gridbox area (m2)
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: T_PHY  ! AIR TEMPERATURE(X,Z,Y) Z=1 bottom Z=LM top (K)
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: RELHUM ! Relative humidity(X,Z,Y) Z=1 bottom Z=LM top (%)
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W & ! Depth of layers(X,Z,Y) Z=1 bottom Z=LM top (m)
                                           ,Z_AT_W & ! Layer height(X,Z,Y) Z=1 bottom Z=LM top (m asl)
                                       ,AIRDENSITY   ! Density of air(X,Z,Y) Z=1 bottom Z=LM top (kg/m3)

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_WATER),INTENT(IN) :: WATER ! WATER array from microphysics

      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(INOUT) :: E_BC & !EMISSIONS OF BC/OM/SO4 UNSPECIATED FINE AND COARSE AND DMS
                                       ,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC,E_DMS

      REAL,DIMENSION(IMS:IME,JMS:JME,MAX(1,NUM_AERO)),INTENT(INOUT) :: EMISS_AERO ! Array with aero_bsc emissions
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_AERO_BSC),INTENT(INOUT)  :: AERO_BSC ! Array with the aero_bsc aerosols dimension(X,Y,Z,num_aero_bsc) Z=1 top  Z=LM bottom (kg/m3)
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS_TOTAL),INTENT(INOUT) :: CHEM     ! Array with the gas-phase species dimension(X,Y,Z,num_gas) Z=1 top  Z=LM bottom (ppmv)
      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: GLAT, GLON
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM),INTENT(INOUT) :: KHET
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      REAL :: DTCHEM,TCHEM
      REAL :: PTP_TAU_BC,PTP_TAU_OM
      INTEGER :: i,j,k
      LOGICAL :: PTP_CONV
!      INTEGER :: EMI_SOA_DENT !=1 DENTENER;2 TSIGARIDIS;3 HODZIC+SPRACKLEN 
      LOGICAL :: CLIM_GAS
!MEGAN VARIABLES
    REAL,ALLOCATABLE,DIMENSION(:,:,:) :: E_BIO

    INTEGER :: NE_AREA
    CHARACTER*120 :: FCLIM,message,var,FCLIML
    integer :: input_id_clim,ncid_in,stat,mype,input_id_climl,lvl
    REAL :: zmin,zmax
! EQSAM
      real, parameter    :: avog = 6.022e23
      real, parameter    :: eqsam_conv = 1.e12 / avog ! unit conversion factor
                                                      ! from molecules cm-3
                                                      ! to umol m-3
      integer, parameter :: nca=11     ! number of input variables
      integer, parameter :: nco=36     ! number of output variables
      integer            :: iopt=1     ! aerosol state and history
                                       ! 1 selects metastable (wet)
                                       ! 2 selects solid (dry)
      integer, parameter :: loop=1     ! only one timestep
      integer, parameter :: imax=1     ! only one timestep
      integer, parameter :: ipunit=99  ! diagnostic output printing (not used)
      real, dimension(imax, nca) :: yi ! input array
      real, dimension(imax, nco) :: yo ! output array
      real, parameter :: dust5_threshold=1.0e-10 !dust bin5 conc. threshold for heterogeneous formation of nitrate
      real, parameter :: ssa5_threshold=1.0e-10  !ssa bin5 conc. threshold for heterogeneous formation of nitrate
!
    LOGICAL, SAVE :: FIRSTIME=.TRUE.

    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:) :: msebio_isop

    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:) :: pftp_bt, pftp_nt, pftp_sb, pftp_hb

    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:) :: mlai

    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:) :: mtsa

    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:) :: mswdown

    REAL*8 :: CURR_SECS
    CHARACTER*120 :: FILENAME,FILENAME2,FILENAME9
    INTEGER :: INPUT_ID
    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:) :: DZ_CLIM
    LOGICAL, SAVE :: FIRSTTIME2=.TRUE.
    REAL, DIMENSION(IMS:IME,JMS:JME,1:LM) :: OH_CLIM,O3_CLIM,HO2_CLIM

    REAL,DIMENSION(IDS:IDE-3,JDS:JDE-4,1:64) :: real_3d,real_phot
    REAL,DIMENSION(ITS:ITE,JTS:JTE,1:64) :: temp1,DZCLIM
    REAL,DIMENSION(IMS:IME,JMS:JME,1:64) :: temp2
    REAL :: HOUR_CLIM
    REAL :: dztop,dzbot,dctop,dcbot,pclim
    INTEGER :: kclim,kflip
!
    CHARACTER*2  :: LVLSTR2
    CHARACTER*1  :: LVLSTR1
    INTEGER :: input_id9,input_id10
!      INTEGER :: P_BC1   & !fine phob bc
!                ,P_BC2   & !fine phil bc
!                ,P_SO4   & !fine so4--
!                ,P_NO3b1 & !fine as sulfate no3-
!                ,P_NO3b2 & !coarse_on_dustbin5 no3-
!                ,P_NO3b3 & !coarse_on_ssabin5  no3-
!                ,P_NH4   & !fine as sulfate nh4+
!                ,P_UNSPCF & !fine unspecified matter
!                ,P_UNSPCC & !coarse unspecified matter
!                           !OA DESCRIPTION
!                           !DENENER                TSIGARIDIS             HODZIC+SPRACKLEN
!                ,P_OM1   & !PRIMARY ORGANIC PHOB   POA PHOB               POA ANTHRO PHOB  
!                ,P_OM2   & !PRIMARY ORGANIC PHIL   POA PHIL               POA ANTHRO PHIL
!                ,P_OM3   & !SOA PHOB               NOT USED               POA BIOMASS BURNING PHOB
!                ,P_OM4   & !SOA PHIL               SOA ISOPP1A            POA BIOMASS BURNING PHIL
!                ,P_OM5   & !NOT USED               SOA ISOPP2A            BIOGENIC SOA
!                ,P_OM6   & !NOT USED               SOA APINP1A            ANTRHO SOA
!                ,P_OM7   & !NOT USED               SOA APINP2A            BIOMASS BURNING SOA
!                ,P_OM8     !NOT USED               NOT USED               ENHANCED BIOGENIC SOA

!SOA TSIGARIDIS
!      real,parameter :: avog = 6.02252e23
      real,parameter :: molec2ug=1.d12/avog ! multiply with MW later!!
      real :: voc2nox_denom,a,b,c,d,e,f
      real,dimension(77) :: g

      INTEGER :: V,BIN
     REAL :: PPM2MOLEC

!NUCLEATION SO4mm
     REAL :: FRAC_SO4mm
     INTEGER :: IT,JT,KT
     REAL :: factoraa,factorab,airdenbox
     REAL,parameter :: avognumkpp=6.02252e23       ! number of Avogadro molecules/mole
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!
   MYPE=MYPE_SHARE
   DTCHEM=DT*NCHEM
   TCHEM=START_HOUR*3600.0+DT*NTIMESTEP     
   EMI_SOA_DENT = 3 !=1 DENTENER;2 TSIGARIDIS;3 HODZIC+SPRACKLEN
!  
   IF (MYPE==0)THEN
     WRITE(0,*) 'SOA MODULE USED : ',EMI_SOA_DENT
   ENDIF
!
!1. READ AND COMPUTE EMISSIONS: ANTHRO, OCEAN, BIOGENIC, SOA_SPECIFIC_DENTENER
!   IF(GLOBAL)THEN
!1.1 READ ANTHRO AND OCEAN EMISSIONS
!OLD Spada et al.2017 emissions - most emissions deactivated, only read DMS ocean
!new version emissions are read in emission_driver from chem_driver
!2019/02/22 All function deactivated since all emissions are read in emission_driver
!   CALL READ_AEROCOM_ACCMIP_EMISSIONS_AERO_BSC(                        &
!                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
!                ,START_YEAR,START_MONTH,START_DAY                      &
!                ,EMISS_AERO,NUM_AERO                                   &
!                ,DZ8W,Z_AT_W,AIRDENSITY                                &
!                ,AERO_BSC,NUM_AERO_BSC                                 &
!                ,NUM_ASH,NUM_DUST,NUM_SALT                             &
!                ,NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4                 &
!                ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_DMS                     &
!                ,GLAT,GLON                                             &
!                ,NUM_GAS_TOTAL,CHEM                                    &
!                ,XLAT,XLONG                                            &
!                ,EMI_SOA_DENT                                          &
!                ,DARE                                                  &
!                ,IDS,IDE,JDS,JDE,LM                                    &
!                ,IMS,IME,JMS,JME,KMS,KME                               &
!                ,ITS,ITE,JTS,JTE)
!           ELSE !READ REGIONAL EMISSIONS
!READ REGIONAL EMISSIONS FOR OM, BC, SO4, NO3, NH4, DMS
!IF BIOG AVAILABLE AND NO MEGAN ISOP, TERP
!THIS IS READ FROM EMISSION_DRIVER
!           ENDIF
!1.2 CALCULATE BIOGENIC EMISSIONS: MEGAN MODEL
   IF(MECH==6.OR.MECH==7)THEN
! CONTENT OF CHEM ARRAY
!                      P_SO2=1
!                      P_DMS=2
!                      P_PINENE_A=3
!                      P_PINENE_B=4
!                      P_TOL=5
!                      P_XYL=6
!
! bc+om+su
          IF(MECH==6)THEN
          NE_AREA = 11
          ELSEIF(MECH==7)THEN
! bc+om+su+ni+nh
          NE_AREA = 5  
          ENDIF

          ALLOCATE(E_BIO(its:ite, jts:jte, NE_AREA),stat=i)
!UNITS OF EMISSIONS E_BIO (PPM*M/min)
          IF(FIRSTIME) THEN
            ALLOCATE(msebio_isop(ims:ime , jms:jme))
            ALLOCATE(pftp_bt(ims:ime , jms:jme))
            ALLOCATE(pftp_nt(ims:ime , jms:jme))
            ALLOCATE(pftp_sb(ims:ime , jms:jme))
            ALLOCATE(pftp_hb(ims:ime , jms:jme))
            ALLOCATE(mlai(ims:ime , jms:jme, 12))
            ALLOCATE(mtsa(ims:ime , jms:jme))
            ALLOCATE(mswdown(ims:ime , jms:jme))

            CALL READ_MEGAN_CNST_FIELDS(msebio_isop,pftp_bt,pftp_nt    &
                             ,pftp_sb,pftp_hb,mlai,mtsa,mswdown        &
                             ,ids,ide, jds,jde, LM                     &
                             ,ims,ime, jms,jme, kms,kme                &
                             ,its,ite, jts,jte)
             FIRSTIME=.FALSE.
           ENDIF
!
           CURR_SECS=TCHEM
           CALL bio_emissions_megan2(NTIMESTEP,DT,DTCHEM               &
             ,CURR_SECS,julday,REAL(START_HOUR),xlat,xlong             &
             ,p_phy,AIRDENSITY,dz8w,chem,num_gas_total,ne_area         &
             ,START_MONTH,T2,RSWIN,e_bio,msebio_isop                   &
             ,pftp_bt,pftp_nt,pftp_sb,pftp_hb,mlai,mtsa,mswdown        &
             ,ids,ide, jds,jde, LM                                     &
             ,ims,ime, jms,jme, kms,kme                                &
             ,its,ite, jts,jte, kms,kme)
   ENDIF

!1.3 COMPUTE DIRECT FORMATION OF SOA_DENTENER FROM MONOTERPENES
! SOA EMISSION
! Denetener (ACB RECOMMENDATIONS) assumed: E_SOA = 0.15*E_MONOTERPENES (2-22 of megan list)
! we chose 0.10 as in GOCART!!!
! E_BIO(:,:,3) = alpha-pinene (generalized to 2-6 and 8-22 megan species)
! E_BIO(:,:,4) = beta-pinene (megan species number 7)
! SOA1 = OM3 (bin 3)
! SOA2 = OM4 (bin 4)
! assumed: 50% phobic, 50% philic at emission
!
! note: E_BIO is in mol km-2 h-1, it needs to be converted to kg m-2 s-1
!       by using *0.13623404 (mol to kg of monoterpenes i.e. C12H16 structures)
!           EMI_SOA_DENT = 1
           IF (NUM_OM.gt.0.and.EMI_SOA_DENT.eq.1)THEN
             do j=jts,jte
             do i=its,ite
               AERO_BSC(i,j,LM,P_OM3)  =  AERO_BSC(i,j,LM,P_OM3)                     &
                        + 0.10*0.0*E_BIO(i,j,P_PINENE_A)*0.13623404*(dtchem/3600.)/(dz8w(i,1,j)*1e6)
               AERO_BSC(i,j,LM,P_OM4)  =  AERO_BSC(i,j,LM,P_OM4)                     &
                        + 0.10*1.0*E_BIO(i,j,P_PINENE_A)*0.13623404*(dtchem/3600.)/(dz8w(i,1,j)*1e6)
               !diagnostic (kg/m2 acc)
               EMISS_AERO(i,j,NUM_ASH+NUM_DUST+NUM_SALT+P_OM3) = EMISS_AERO(i,j,NUM_ASH+NUM_DUST+NUM_SALT+P_OM3) + 0.10*0.0*E_BIO(i,j,P_PINENE_A)*0.13623404*(dtchem/3600.)/1e6
               EMISS_AERO(i,j,NUM_ASH+NUM_DUST+NUM_SALT+P_OM4) = EMISS_AERO(i,j,NUM_ASH+NUM_DUST+NUM_SALT+P_OM4) + 0.10*1.0*E_BIO(i,j,P_PINENE_A)*0.13623404*(dtchem/3600.)/1e6
             enddo
             enddo 
           ENDIF !EMI_SOA

!2. READ CLIMATOLOGIES OF O3, OH, HO2 IF NO DYNAMICAL CHEM
!TODO: NEEDS RECODING - PRELIMINARY APPROACH
!O3, OH, HO2   (position 8, 9, 10)

      IF(MECH==6.OR.MECH==7)THEN
        CLIM_GAS=.TRUE.
      ELSE
        CLIM_GAS=.FALSE.
      ENDIF
!
      climgas: IF(CLIM_GAS) THEN

      IF(NTIMESTEP==NCHEM .OR. MOD(TCHEM,3600.0*3.)==0.)THEN !WE READ CLIMATOLOGIES EVERY HOUR
!
        HOUR_CLIM=MOD(TCHEM/3600./3.,8.)+1
!O3
       CALL READ_VINTERP_CLIMAT('O3','nmmb_O3.nc','nmmb_phot.nc',CHEM(:,:,:,P_O3),dz8w,int(HOUR_CLIM),IDS,IDE,JDS,JDE,IMS,IME,JMS,JME,ITS,ITE,JTS,JTE,LM,MYPE)
!OH
       CALL READ_VINTERP_CLIMAT('OH','nmmb_OH.nc','nmmb_phot.nc',CHEM(:,:,:,P_OH),dz8w,int(HOUR_CLIM),IDS,IDE,JDS,JDE,IMS,IME,JMS,JME,ITS,ITE,JTS,JTE,LM,MYPE)
!HO2
       CALL READ_VINTERP_CLIMAT('OH','nmmb_HO2.nc','nmmb_phot.nc',CHEM(:,:,:,P_HO2),dz8w,int(HOUR_CLIM),IDS,IDE,JDS,JDE,IMS,IME,JMS,JME,ITS,ITE,JTS,JTE,LM,MYPE)
!
      IF(MECH==7)THEN
!HNO3
       CALL READ_VINTERP_CLIMAT('HNO3','nmmb_HNO3.nc','nmmb_phot.nc',CHEM(:,:,:,P_HNO3),dz8w,int(HOUR_CLIM),IDS,IDE,JDS,JDE,IMS,IME,JMS,JME,ITS,ITE,JTS,JTE,LM,MYPE)
!NO3
       CALL READ_VINTERP_CLIMAT('NO3','nmmb_NO3.nc','nmmb_phot.nc',CHEM(:,:,:,P_NO3),dz8w,int(HOUR_CLIM),IDS,IDE,JDS,JDE,IMS,IME,JMS,JME,ITS,ITE,JTS,JTE,LM,MYPE)
!
      ENDIF !MECH==7
      ENDIF !READ EVERY HOUR
      ENDIF climgas

!3. SOLVE GAS-AQ-HET MECHANISM
!3.1 SULFUR OR SULFUR/NITRATE CHEMISTRY
   IF (MECH==6)THEN
! GLOBAL SULFUR MECHANISM - GAS/AQUEOUSE CHEM
   CALL RUN_SULFUR(NTIMESTEP,DT,NCHEM                                   &
               ,START_HOUR                                              &
               ,AERO_BSC,NUM_AERO_BSC                                   &
               ,NUM_ASH,NUM_DUST,NUM_SALT                               &
               ,NUM_OM,NUM_BC,NUM_SO4                                   &
               ,CHEM,NUM_GAS_TOTAL                                      &
               ,P_PHY,T_PHY,AIRDENSITY,WATER,NUM_WATER,P_QV,P_QC,P_QR   &
               ,JPNL                                                    &
               ,IDS,IDE,JDS,JDE,LM                                      &
               ,IMS,IME,JMS,JME,KMS,KME                                 &
               ,ITS,ITE,JTS,JTE)
   ELSEIF (MECH==7)THEN
! GLOBAL COARSE_DUST_SSA_NITRATE/SULFUR/SOA_HODZIC MECHANISM - GAS/AQUEOUS CHEM
!   CALL RUN_SULFUR_NITRATE(NTIMESTEP,DT,NCHEM                           &
!               ,START_HOUR                                              &
!               ,AERO_BSC,NUM_AERO_BSC                                   &
!               ,NUM_ASH,NUM_DUST,NUM_SALT                               &
!               ,NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4                   &
!               ,CHEM,NUM_GAS_TOTAL                                      &
!               ,P_PHY,T_PHY,AIRDENSITY,WATER,NUM_WATER,P_QV,P_QC,P_QR   &
!               ,RELHUM                                                  &
!               ,JPNL,KHET                                               &
!               ,IDS,IDE,JDS,JDE,LM                                      &
!               ,IMS,IME,JMS,JME,KMS,KME                                 &
!               ,ITS,ITE,JTS,JTE)
   ELSEIF (MECH==37)THEN
! REGIONAL SULFUR MECHANISM - GAS-AQUEOUS-HET CHEM
   CALL RUN_SULFUR_AQUEOUS(NTIMESTEP,DT,NCHEM                           &
               ,START_HOUR                                              &
               ,AERO_BSC,NUM_AERO_BSC                                   &
               ,NUM_ASH,NUM_DUST,NUM_SALT                               &
               ,NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4                   &
               ,CHEM,NUM_GAS_TOTAL                                      &
               ,P_PHY,T_PHY,AIRDENSITY,WATER,NUM_WATER,P_QV,P_QC,P_QR   &
               ,RELHUM                                                  &
               ,JPNL,KHET                                               &
               ,IDS,IDE,JDS,JDE,LM                                      &
               ,IMS,IME,JMS,JME,KMS,KME                                 &
               ,ITS,ITE,JTS,JTE)

!NUCLEATION SO4mm
     do kt=1,lm !-2
     kflip=lm+1-kt
     do jt=jts_b1,jte_b1
     do it=its_b1,ite_b1 
!   factoraa = conversion factor from ppm to molec/cm3 
      airdenbox = AIRDENSITY(IT,KT,JT)/28.966e3 !molecular weight of air 28.966 g/mol
      factoraa = airdenbox*1.0e-6
      factoraa = factoraa*avognumkpp
!   factorab = conversion factor from kg_sulfate/m3 to molec/cm3
!   PM_sulfate=96.09g/mol
      factorab = 1.0e-3/96.09*avognumkpp
      FRAC_SO4mm=1. !0.5
      AERO_BSC(IT,JT,KFLIP,NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+1) = AERO_BSC(IT,JT,KFLIP,NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+1)+  &
          (FRAC_SO4mm*CHEM(IT,JT,KFLIP,P_SULF)*factoraa)/factorab
      CHEM(IT,JT,KFLIP,P_SULF)=MAX((1-FRAC_SO4mm)*CHEM(IT,JT,KFLIP,P_SULF),1.0E-30)
     enddo
     enddo
     enddo
   ENDIF

!3.2 THERMODYNAMIC EQUILIBIRUM FOR FINE SO4--/NO3-/NH4+ USING EQSAMv3
    IF(MECH==7.OR.MECH==37)THEN
!
   IF (MYPE==0)THEN
     WRITE(0,*) 'THERMODYNAMIC EQUILIBIRUM EQSAM WITH MECH: ',MECH
   ENDIF
!
!     do bin=1,2 !NUM_NO3 !DOUBLE CALL NOT IMPLEMENTED
     do k=lm,1,-1
      kflip=lm-k+1
     do j=jts_b1,jte_b1
     do i=its_b1,ite_b1
        PPM2MOLEC=AIRDENSITY(I,KFLIP,J)/28.966*1.0e-9*avog
        yi = 0.
        yo = 0.
        yi(1, 1)  = T_PHY(I,KFLIP,J)                                                                      ! temperature (K)
        yi(1, 2)  = RELHUM(I,KFLIP,J) !* 1.e-2                                                            ! relative humidity (0-1)
        yi(1, 3)  = (CHEM(I,J,K,P_NH3)*PPM2MOLEC+AERO_BSC(I,J,K,P_NH4)*1e9/(molec2ug*18.0))*eqsam_conv    ! total ammonia/um (umol m-3)
        if(mech==7)then
          yi(1, 4)  = (AERO_BSC(i,j,k,P_SO4)*1e9/(molec2ug*96.07))*eqsam_conv  ! total sulfate (umol m-3)
        else
          yi(1, 4)  = (CHEM(I,J,K,P_SULF)*PPM2MOLEC+AERO_BSC(i,j,k,P_SO4)*1e9/(molec2ug*96.07))*eqsam_conv  ! total sulfate (umol m-3)
        endif
        yi(1, 5)  = (CHEM(I,J,K,P_HNO3)*PPM2MOLEC+AERO_BSC(I,J,K,P_NO3b1)*1e9/(molec2ug*62.0))*eqsam_conv ! total nitrate (umol m-3)
!        IF(bin.EQ.1)THEN !fine nitrate
!           yi(1, 6)  = (AERO_BSC(I,J,K,NUM_ASH+NUM_DUST+1)+AERO_BSC(I,J,K,NUM_ASH+NUM_DUST+2)+AERO_BSC(I,J,K,NUM_ASH+NUM_DUST+3) &
!                       +AERO_BSC(I,J,K,NUM_ASH+NUM_DUST+4)+AERO_BSC(I,J,K,NUM_ASH+NUM_DUST+5))                                   &
!                       *1e9/(molec2ug*(22.9898/58.44))*eqsam_conv                                         ! Na+ particle from ssa_bin1 (preliminar)  assumed as 100% NaCl
!           yi(1, 8)  = (AERO_BSC(I,J,K,NUM_ASH+1)+AERO_BSC(I,J,K,NUM_ASH+2)+AERO_BSC(I,J,K,NUM_ASH+3)+AERO_BSC(I,J,K,NUM_ASH+4)+AERO_BSC(I,J,K,NUM_ASH+5)) &
!                       *1e9/(molec2ug*62.0*0.033)*eqsam_conv                                              ! K+ particle from dust_bin5 assumed as 3.3% K2CO3
!           yi(1, 9)  = (AERO_BSC(I,J,K,NUM_ASH+1)+AERO_BSC(I,J,K,NUM_ASH+2)+AERO_BSC(I,J,K,NUM_ASH+3)+AERO_BSC(I,J,K,NUM_ASH+4)+AERO_BSC(I,J,K,NUM_ASH+5)) &
!                       *1e9/(molec2ug*40.078*0.07)*eqsam_conv                                             ! Ca++ particle from dust_bin5 assumed as 7% CaCO3
!           yi(1,10)  = (AERO_BSC(I,J,K,NUM_ASH+1)+AERO_BSC(I,J,K,NUM_ASH+2)+AERO_BSC(I,J,K,NUM_ASH+3)+AERO_BSC(I,J,K,NUM_ASH+4)+AERO_BSC(I,J,K,NUM_ASH+5)) &
!                       *1e9/(molec2ug*24.3*0.055)*eqsam_conv                              ! Mg++ particle from dust_bin5 assumed as 5.5% MgCO3
!        ELSEIF(bin.EQ.2)THEN !coarse nitrate .AND.NUM_DUST>0.AND.AERO_BSC(i,j,k,NUM_ASH+5)>dust5_threshold)THEN    !coarse nitrate on dust_bin5
!           yi(1, 6)  = AERO_BSC(I,J,K,NUM_ASH+NUM_DUST+5)*1e9/(molec2ug*(22.9898/58.44))*eqsam_conv                ! Na+ particle from ssa_bin1 (preliminar)  assumed as 100% NaCl
!           yi(1, 8)  = AERO_BSC(I,J,K,NUM_ASH+5)*1e9/(molec2ug*62.0*0.033)*eqsam_conv                              ! K+ particle from dust_bin5 assumed as 3.3% K2CO3
!           yi(1, 9)  = AERO_BSC(I,J,K,NUM_ASH+5)*1e9/(molec2ug*40.078*0.07)*eqsam_conv                             ! Ca++ particle from dust_bin5 assumed as 7% CaCO3
!           yi(1,10)  = AERO_BSC(I,J,K,NUM_ASH+5)*1e9/(molec2ug*24.3*0.055)*eqsam_conv                              ! Mg++ particle from dust_bin5 assumed as 5.5% MgCO3
!!        ELSEIF(bin.EQ.3.AND.NUM_SALT>0.AND.AERO_BSC(i,j,k,NUM_ASH+NUM_DUST+5)>ssa5_threshold)THEN !coarse nitrate on ssa_bin5
!!           yi(1, 5)  = (CHEM(I,J,K,P_HNO3)*PPM2MOLEC+AERO_BSC(I,J,K,P_NO3b1+bin-1)*1e9/(molec2ug*62.0))*eqsam_conv ! total nitrate (umol m-3)
!!           yi(1, 6)  = AERO_BSC(I,J,K,NUM_ASH+NUM_DUST+5)*1e9/(molec2ug*(22.9898/58.44))*eqsam_conv ! Na+ particle from ssa_bin5 assumed as 100% NaCl
!        ENDIF
        yi(1, 11) = P_PHY(I,KFLIP,J) * 1.e-2 ! pressure (hPa)
        call eqsam_v03d(yi,yo,nca,nco,iopt,loop,imax,ipunit)
!        CHEM(I,J,K,P_SULF)            = yo(1, 11) / (eqsam_conv*PPM2MOLEC)   ! H2SO4 CHECK: output eqsam residual H2SO4 (aq) - should go to SO4mm
        if(mech==37)then
           CHEM(I,J,K,P_HNO3)            = yo(1,  9) / (eqsam_conv*PPM2MOLEC)   ! HNO3(g)
        endif
        CHEM(I,J,K,P_NH3)             = yo(1, 10) / (eqsam_conv*PPM2MOLEC)   ! NH3 (g)
        AERO_BSC(I,J,K,P_NH4)         = yo(1, 19) / eqsam_conv * (molec2ug*18.0) * 1e-9 ! total NH4 (aq+s)
        AERO_BSC(I,J,K,P_NO3b1)       = yo(1, 20) / eqsam_conv * (molec2ug*62.0) * 1e-9 ! total NO3p (aq+s)
!        AERO_BSC(I,J,K,P_SO4)         = yo(1, 21) / eqsam_conv * (molec2ug*96.07) * 1e-9 ! total SO4 (aq+s) eqsam assumes H2SO4 goes to (aq)
     enddo
     enddo
     enddo
!
   ENDIF

!3.4 SOA TSIGARIDIS MODULE
!IF EMI_SOA_DENT = 2 WE RUN TSIGARIDIS SOA MODULE
     IF (NUM_OM .gt. 0 .and. EMI_SOA_DENT .eq. 2)THEN
!
   IF (MYPE==0)THEN
     WRITE(0,*) 'SOA MODULE TSIGARIDIS WITH MECH: ',MECH
   ENDIF
!
! SOA init
      soa_cond%dt=DTCHEM
      IF(MECH==6)THEN
      soa_tr%ivoc(isoa_apin)=P_PINENE_A  !ind_Terpenes
      ELSEIF(MECH==37)THEN
      soa_tr%ivoc(isoa_apin)=P_TERP  !ind_Terpenes
      ENDIF
      soa_tr%ivoc(isoa_isop)=P_ISOP      !ind_Isoprene
      soa_tr%ioxidant(isoa_oh)=P_OH      !ind_OH
      soa_tr%ioxidant(isoa_o3)=P_O3      !ind_O3
      soa_tr%ioxidant(isoa_no3)=P_NO3    !ind_NO3
      soa_tr%igas(isoa_isopp1)=P_ISOPP1G !ind_isopp1g
      soa_tr%igas(isoa_isopp2)=P_ISOPP2G !ind_isopp2g
      soa_tr%igas(isoa_apinp1)=P_APINP1G !ind_apinp1g
      soa_tr%igas(isoa_apinp2)=P_APINP2G !ind_apinp2g
      soa_tr%iaer(isoa_isopp1)=P_OM4     !ind_isopp1a
      soa_tr%iaer(isoa_isopp2)=P_OM5     !ind_isopp2a
      soa_tr%iaer(isoa_apinp1)=P_OM6     !ind_apinp1a
      soa_tr%iaer(isoa_apinp2)=P_OM7     !ind_apinp2a
      call soa_init(NUM_GAS_TOTAL)       !nvar

     do k=lm,1,-1
      kflip=lm-k+1
     do j=jts_b1,jte_b1
     do i=its_b1,ite_b1

! SOA, before chemistry. VOCs in ug m-3, oxidants in molecules cm-3
      PPM2MOLEC=AIRDENSITY(I,KFLIP,J)/28.966*1.0e-9*avog
      IF(MECH==6)THEN
      soa_tr%voc(isoa_apin)=CHEM(I,J,K,P_PINENE_A)*PPM2MOLEC*molec2ug*136.d0    !c(ind_Terpenes)*molec2ug*136.d0
      ELSEIF(MECH==37)THEN
      soa_tr%voc(isoa_apin)=CHEM(I,J,K,P_TERP)*PPM2MOLEC*molec2ug*136.d0    !c(ind_Terpenes)*molec2ug*136.d0
      ENDIF
      soa_tr%voc(isoa_isop)=CHEM(I,J,K,P_ISOP)*PPM2MOLEC*molec2ug*68.d0        !c(ind_Isoprene)*molec2ug*68.d0
      soa_tr%oxidant(isoa_oh)=CHEM(I,J,K,P_OH)*PPM2MOLEC      !c(ind_OH)
      soa_tr%oxidant(isoa_o3)=CHEM(I,J,K,P_O3)*PPM2MOLEC      !c(ind_O3)
      IF(MECH==37) soa_tr%oxidant(isoa_no3)=CHEM(I,J,K,P_NO3)*PPM2MOLEC     !c(ind_NO3)

! SOA, after chemistry
        soa_cond%rr(isoa_isop,isoa_oh)=2.55d-11*exp(410.d0/T_PHY(I,KFLIP,J)) !temp) ! Isoprene + OH
        soa_cond%rr(isoa_isop,isoa_o3)=1.23d-14*exp(-2013.d0/T_PHY(I,KFLIP,J)) !temp) ! Isoprene + O3
!        soa_cond%rr(isoa_isop,isoa_no3)=7.8d-13 ! Isoprene + NO3
        soa_cond%rr(isoa_apin,isoa_oh)=2.51d-11*exp(444.d0/T_PHY(I,KFLIP,J)) !temp) ! Terpenes + OH
        soa_cond%rr(isoa_apin,isoa_o3)=1.40d-14*exp(-732.d0/T_PHY(I,KFLIP,J)) !temp) ! Terpenes + O3
!        soa_cond%rr(isoa_apin,isoa_no3)=5.77d-13*exp(841.d0/T_PHY(I,KFLIP,J)) !temp) ! Terpenes + NO3
        do v = 1, soa_bins
          soa_tr%gas(v)=CHEM(I,J,K,soa_tr%igas(v))*PPM2MOLEC*molec2ug*12.d0*1.6d0    !c(soa_tr%igas(v))*molec2ug*12.d0*1.6d0
          soa_tr%aer(v)=AERO_BSC(I,J,K,soa_tr%iaer(v))*1e9         !kg/m3 to ug/m3       !c(soa_tr%iaer(v))*molec2ug*12.d0*1.6d0
        enddo
        IF(MECH==6)THEN
        voc2nox_denom= & !4.2d-12*exp(180.d0/T_PHY(I,KFLIP,J))*c(ind_NO) ! temp)*c(ind_NO)+&  ! XO2 + NO
                      3.5d-12*exp(250.d0/T_PHY(I,KFLIP,J))*CHEM(I,J,K,P_HO2)*PPM2MOLEC    !temp)*c(ind_HO2)+& ! XO2 + HO2
                         !1.7d-14*exp(1300.d0/temp)*c(ind_XO2)  ! XO2 + XO2
        ELSEIF(MECH==37)THEN
        voc2nox_denom= 4.2d-12*exp(180.d0/T_PHY(I,KFLIP,J))*CHEM(I,J,K,P_NO)*PPM2MOLEC+ &  !c(ind_NO) ! temp)*c(ind_NO)+&  ! XO2 + NO
                      3.5d-12*exp(250.d0/T_PHY(I,KFLIP,J))*CHEM(I,J,K,P_HO2)*PPM2MOLEC    !temp)*c(ind_HO2)+& ! XO2 + HO2
                         !1.7d-14*exp(1300.d0/temp)*c(ind_XO2)  ! XO2 + XO2
        ENDIF
        if (voc2nox_denom == 0.d0) then
          soa_cond%voc2nox=0.d0
        else
          IF(MECH==37)THEN
          soa_cond%voc2nox=4.2d-12*exp(180.d0/T_PHY(I,KFLIP,J))*CHEM(I,J,K,P_NO)*PPM2MOLEC/ &  !     temp)*c(ind_NO)/&  ! XO2 + NO
                           voc2nox_denom
          ELSEIF(MECH==6.OR.MECH==7)THEN
          soa_cond%voc2nox=0.d0
          ENDIF
        endif
        soa_cond%temp=T_PHY(I,KFLIP,J)  !temp
        IF(MECH==6.)THEN
        soa_cond%nvoa=AERO_BSC(I,J,K,P_SO4)*1e9 !kg/m3 to ug/m3    !molec2ug*(c(ind_SO4)*96.d0 + &
!                                c(ind_NH4)*19.d0 + &
!                                c(ind_NO3p)*63.d0)
        ELSEIF(MECH==37)THEN
        soa_cond%nvoa=AERO_BSC(I,J,K,P_SO4)*1e9 &
                     +AERO_BSC(I,J,K,P_NH4)*1e9 &
                     +AERO_BSC(I,J,K,P_NO3b1)*1e9 &
                     +AERO_BSC(I,J,K,P_NO3b2)*1e9 &
                     +AERO_BSC(I,J,K,P_NO3b3)*1e9  !kg/m3 to ug/m3    !molec2ug*(c(ind_SO4)*96.d0 + &
!                                c(ind_NH4)*19.d0 + &
!                                c(ind_NO3p)*63.d0)
        ENDIF
        call soa_calc

!+++++++++++++
! updating VOCS after soa mechanism (loss of VOCS)
!+++++++++++++
        CHEM(I,J,K,P_ISOP)=CHEM(I,J,K,P_ISOP)- &
                           (soa_tr%gas(1)+soa_tr%aer(1)-(CHEM(I,J,K,soa_tr%igas(1))*PPM2MOLEC*molec2ug*12.d0*1.6d0)- &
                            AERO_BSC(I,J,K,soa_tr%iaer(1))*1e9)/(0.0288d0)/(molec2ug*68.d0)/PPM2MOLEC
        IF(MECH==6)THEN
        CHEM(I,J,K,P_PINENE_A)=CHEM(I,J,K,P_PINENE_A)- &
                           (soa_tr%gas(3)+soa_tr%aer(3)-(CHEM(I,J,K,soa_tr%igas(3))*PPM2MOLEC*molec2ug*12.d0*1.6d0)- &
                            AERO_BSC(I,J,K,soa_tr%iaer(3))*1e9)/(0.192d0)/(molec2ug*136.d0)/PPM2MOLEC
        ELSEIF(MECH==37)THEN
        CHEM(I,J,K,P_TERP)=CHEM(I,J,K,P_TERP)- &
                           (soa_tr%gas(3)+soa_tr%aer(3)-(CHEM(I,J,K,soa_tr%igas(3))*PPM2MOLEC*molec2ug*12.d0*1.6d0)- &
                            AERO_BSC(I,J,K,soa_tr%iaer(3))*1e9)/(0.192d0)/(molec2ug*136.d0)/PPM2MOLEC

        ENDIF

        do v = 1, soa_bins
          CHEM(I,J,K,soa_tr%igas(v))=soa_tr%gas(v)/(molec2ug*12.d0*1.6d0)/PPM2MOLEC    !ug/m3 to ppmv
          AERO_BSC(I,J,K,soa_tr%iaer(v))=soa_tr%aer(v)*1e-9                !ug/m3 to kg/m3    !/(molec2ug*12.d0*1.6d0)
        enddo
! SOA end

     enddo
     enddo
     enddo

     ENDIF !NUM_OM .AND. SOA_DENT

!4. PHOB-TO-PHIL CONVERSION (BC, OM)
!
! (1) q_phob(t+1)=q_phob(t)-dt/tau*q_phob(t)
! (2) q_phil(t+1)=q_phil(t)+dt/tau*q_phob(t)

   PTP_CONV=.TRUE.
   IF (PTP_CONV)THEN
     IF((NUM_OM.GT.0).OR.(NUM_BC.GT.0))THEN
     !PTP_TAU = 1/tau (s)
     !PTP_TAU=6.43e-6 !1.8 days -> Koch et al., 2001 (GISS-CaseA)
     !PTP_TAU=7.10e-6 !1.6 days -> Emmons et al., 2010 (MOZART)
     PTP_TAU_BC=9.64e-6 !1.2 days -> Chin et al., 2002 (GOCART)
     PTP_TAU_OM=9.64e-6 !1.2 days (also 2.5 days -> Tsigaridis et al., 2014 (ref to GOCART?)) 

     do k=1,lm
     do j=jts_b1,jte_b1
     do i=its_b1,ite_b1

     !OM
     IF (NUM_OM.GT.0)THEN
       IF(MECH==6.OR.MECH==37)THEN
         AERO_BSC(i,j,k,P_OM1)=AERO_BSC(i,j,k,P_OM1)-DTCHEM*PTP_TAU_OM*AERO_BSC(i,j,k,P_OM1) !phob
         AERO_BSC(i,j,k,P_OM2)=AERO_BSC(i,j,k,P_OM2)+DTCHEM*PTP_TAU_OM*AERO_BSC(i,j,k,P_OM1) !phil
       ELSEIF(MECH==7)THEN
         ! ANTHRO POA
         AERO_BSC(i,j,k,P_OM1)=AERO_BSC(i,j,k,P_OM1)-DTCHEM*PTP_TAU_OM*AERO_BSC(i,j,k,P_OM1) !phob
         AERO_BSC(i,j,k,P_OM2)=AERO_BSC(i,j,k,P_OM2)+DTCHEM*PTP_TAU_OM*AERO_BSC(i,j,k,P_OM1) !phil
         ! BIOMASS BURNING POA
         AERO_BSC(i,j,k,P_OM3)=AERO_BSC(i,j,k,P_OM3)-DTCHEM*PTP_TAU_OM*AERO_BSC(i,j,k,P_OM3) !phob
         AERO_BSC(i,j,k,P_OM4)=AERO_BSC(i,j,k,P_OM4)+DTCHEM*PTP_TAU_OM*AERO_BSC(i,j,k,P_OM3) !phil
       ENDIF
     ENDIF

     !BC
     ! BC1=phob, BC2=phil
     IF (NUM_BC.GT.0)THEN
       AERO_BSC(i,j,k,P_BC1)=AERO_BSC(i,j,k,P_BC1)-DTCHEM*PTP_TAU_BC*AERO_BSC(i,j,k,P_BC1) !phob
       AERO_BSC(i,j,k,P_BC2)=AERO_BSC(i,j,k,P_BC2)+DTCHEM*PTP_TAU_BC*AERO_BSC(i,j,k,P_BC1) !phil
     ENDIF

     enddo
     enddo
     enddo
     ENDIF
   ENDIF ! PTP_CONV=.TRUE. 

   IF ( ALLOCATED(E_BIO) )  DEALLOCATE(E_BIO)

!
!-----------------------------------------------------------------------
!
      RETURN
!
!----------------------------------------------------------------------
!
      END SUBROUTINE AERO_BSC_DRIVER
!                          
!***********************************************************************
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE READ_AEROCOM_ACCMIP_EMISSIONS_AERO_BSC(               &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY                      &
                ,EMISS_AERO,NUM_AERO                                   &
                ,DZ8W,Z_AT_W,AIRDENSITY                                &
                ,AERO_BSC,NUM_AERO_BSC                                 &
                ,NUM_ASH,NUM_DUST,NUM_SALT                             &
                ,NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4                 &
                ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_DMS                     &
                ,GLAT,GLON                                             &
                ,NUM_GAS_TOTAL,CHEM                                    &
                ,XLAT,XLONG                                            &
                ,EMI_SOA_DENT                                          &
                ,DARE                                                  &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  READ EMISSIONS FROM ACCMIP DATABASE FOR GLOBAL RUNS
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 14-05-12
!
! ABSTRACT:
!     READ EMISSIONS FROM ACCMIP DATABASE FOR GLOBAL RUNS  
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   14-05-12  JORBA      - ORIGINATOR OF THE SUBROUTINE
!
! USAGE: CALL READ_ACCMIP_EMISSIONS FROM EMISSION_DRIVER
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
!      USE MODULE_CONSTANTS,ONLY : G,EPSQ,R_D,P608
!
!----------------------------------------------------------------------
!
      IMPLICIT NONE

      INCLUDE 'netcdf.inc'
!
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: NTIMESTEP        ! Number of dynamic timesteps
      INTEGER,INTENT(IN) :: NCHEM            ! Number of dynamic calls between chemistry calls

      REAL, INTENT(IN)   :: TCHEM,DTCHEM

      INTEGER,INTENT(IN) :: NUM_AERO         ! Total Number of bins from Ash/Dust/Salt/OM/BC/SO4/NO3-/NH4+
      INTEGER,INTENT(IN) :: NUM_AERO_BSC     ! Total Number of bins from OM/BC/SO4/NO3-/NH4+ BSC AEROSOLS
      INTEGER,INTENT(IN) :: NUM_ASH,NUM_DUST,NUM_SALT !Number of bins from Ash/Dust/Salt
      INTEGER,INTENT(IN) :: NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4 ! Number of bins from OM/BC/SO4 BSC AEROSOLS
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE  ! global cell indexs
      INTEGER,INTENT(IN) :: LM               ! Number of vertical layers
      INTEGER,INTENT(IN) :: IMS, IME, JMS, JME, KMS, KME   ! local cell indexes with halo widths
      INTEGER,INTENT(IN) :: ITS,ITE,JTS,JTE  ! local cell indexes w/o halo     
      INTEGER,INTENT(IN) :: START_YEAR,START_MONTH,START_DAY ! Starting date of the simulation

      REAL,DIMENSION(JDS:JDE) :: DARE ! Gridbox area (m2)
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W & ! Depth of layers(X,Z,Y) Z=1 bottom Z=LM top (m)
                                           ,Z_AT_W & ! Layer height(X,Z,Y) Z=1 bottom Z=LM top (m asl)
                                       ,AIRDENSITY   ! Density of air(X,Z,Y) Z=1 bottom Z=LM top (kg/m3)

      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(INOUT) :: E_BC & !EMISSIONS OF BC/OM/SO4 AND DMS
                                       ,E_OM,E_SO4,E_NO3,E_NH4,E_DMS

      REAL,DIMENSION(IMS:IME,JMS:JME,MAX(1,NUM_AERO)),INTENT(INOUT) :: EMISS_AERO ! Array with aero_bsc emissions(X,Y,Z) Z=1 top Z=LM bottom
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_AERO_BSC),INTENT(INOUT)  :: AERO_BSC ! Array with the aero_bsc aerosols dimension(X,Y,Z,num_aero_bsc) Z=1 top  Z=LM bottom (kg/m3)
      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN)  :: GLAT,GLON,XLAT,XLONG
      INTEGER,INTENT(IN) :: NUM_GAS_TOTAL    ! total number of gas-phase species implemented in the NMMB module
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS_TOTAL),INTENT(INOUT) :: CHEM     ! Array with the gas-phase species dimension(X,Y,Z,num_gas) Z=1 top  Z=LM bottom (ppmv)
      INTEGER,INTENT(IN) :: EMI_SOA_DENT
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: real_2d

      REAL, DIMENSION( IDS:IDE,JDS:JDE,1:LM ) :: real_3d

      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: temp1

      REAL, DIMENSION( IMS:IME, JMS:JME ) :: temp2

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme) :: temp3

      CHARACTER*120 :: FILENAME,message,var,FILENAME9

      real :: zmin
      real, dimension(1:4) :: dent
      real :: zmax,conv_rho,fred
      real :: conv_rho2

      integer :: STAT,input_id,ncid_in,mype,i,j,k,kflip,irecv

      INTEGER :: INPUT_ID3
      LOGICAL :: IS4F_HEIGHT,GFAS_BB_EMISS

      LOGICAL :: EMI_ANTHRO,EMI_BBFOREST,EMI_BBGRASS,EMI_OCEAN,EMI_BIOG &
                ,EMI_SHIPS,EMI_AIRCRAFT,EMI_VOLC_DIFF,EMI_VOLC_ERUP

      REAL :: TOTAL_EMI_RED

      REAL, SAVE :: TOTAL_EMI=0.

      REAL :: dzbot,dztop,tmpdist,oldtmpdist
      REAL,DIMENSION(1:LM) :: femi
      INTEGER :: n,nevents,ine,jne,kk
      REAL,ALLOCATABLE,DIMENSION(:,:) :: volc
!
      CHARACTER*2 :: LVLSTR2
      CHARACTER*1 :: LVLSTR1
      INTEGER :: input_id9,input_id10
      INTEGER :: P_BC1   & !fine phob bc
                ,P_BC2   & !fine phil bc
                ,P_SO4   & !fine so4--
                ,P_NO3b1 & !fine as sulfate no3-
                ,P_NO3b2 & !coarse_on_dustbin5 no3-
                ,P_NO3b3 & !coarse_on_ssabin5  no3-
                ,P_NH4   & !fine as sulfate nh4+
                ,P_UNSPCF & !fine unspecified matter
                ,P_UNSPCC & !coarse unspecified matter
                           !OA DESCRIPTION
                           !DENENER                TSIGARIDIS             HODZIC+SPRACKLEN
                ,P_OM1   & !PRIMARY ORGANIC PHOB   POA PHOB               POA ANTHRO PHOB  
                ,P_OM2   & !PRIMARY ORGANIC PHIL   POA PHIL               POA ANTHRO PHIL
                ,P_OM3   & !SOA PHOB               NOT USED               POA BIOMASS BURNING PHOB
                ,P_OM4   & !SOA PHIL               SOA ISOPP1A            POA BIOMASS BURNING PHIL
                ,P_OM5   & !NOT USED               SOA ISOPP2A            BIOGENIC SOA
                ,P_OM6   & !NOT USED               SOA APINP1A            ANTRHO SOA
                ,P_OM7   & !NOT USED               SOA APINP2A            BIOMASS BURNING SOA
                ,P_OM8     !NOT USED               NOT USED               ENHANCED BIOGENIC SOA

!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!
      MYPE=MYPE_SHARE

      EMI_ANTHRO=.FALSE.
      EMI_BBFOREST=.FALSE.
      EMI_BBGRASS=.FALSE.
      IS4F_HEIGHT=.FALSE. !if TRUE use IS4FIRES inj. heights, where available; if FALSE use Dentener
      GFAS_BB_EMISS=.FALSE. !if TRUE use GFAS emiss and inj. heights; if FALSE use Dentener
      EMI_OCEAN=.TRUE.
      EMI_BIOG=.FALSE.
      EMI_SHIPS=.FALSE.
      EMI_AIRCRAFT=.FALSE.
      EMI_VOLC_DIFF=.FALSE. !.TRUE.
      EMI_VOLC_ERUP=.FALSE.


      IF(MYPE==0)THEN
        print *,'----------------------------------'
        print *,'AEROCOM-ACCMIP EMISSIONS OPTIONS:'
        print *,'EMI_ANTHRO   : ',EMI_ANTHRO
        print *,'EMI_BBFOREST : ',EMI_BBFOREST
        print *,'EMI_BBGRASS  : ',EMI_BBGRASS
        print *,'EMI_OCEAN    : ',EMI_OCEAN
        print *,'EMI_BIOG     : ',EMI_BIOG
        print *,'EMI_SHIPS    : ',EMI_SHIPS
        print *,'EMI_AIRCRAFT : ',EMI_AIRCRAFT
        print *,'----------------------------------'
      ENDIF

! *** FIRST STEP ONLY
! 1. READ ANTHRO EMISSIONS FROM EMI_ANTHRO_l_month01.nc
! 1.1 DISTRIBUTE EMISSIONS VERTICALLY - ONLY FIRST LAYER
! 2. READ BIOMASS BURNING FROM EMI_BBFOREST_l_month01.nc
! 2.1 DISTRIBUTE EMISSIONS VERTICALLY - 0 - 1300 m a.g.l.
! 3. READ BIOMASS BURNING FROM EMI_BBGRASS_l_month01.nc
! 3.1 DISTRIBUTE EMISSIONS VERTICALLY - 0 - 200 m a.g.l.
! 4. READ OCEAN EMISSIONS FROM EMI_OCEAN_l_month01.nc
! 4.1 DISTRIBUTE EMISSIONS VERTICALLY - ONLY FIRST LAYER
! 5. DISTRIBUTE EMISSIONS FROM EMI_BIOG_l_month01.nc
! 5.1 DISTRIBUTE EMISSIONS VERTICALLY - ONLY FIRST LAYER
! 6. DISTRIBUTE EMISSIONS FROM EMI_SHIPS_l_month01.nc
! 6.1 DISTRIBUTE EMISSIONS VERTICALLY - 500 m a.g.l. or 0 - 500 m a.g.l.?
! 7. DISTRIBUTE EMISSIONS FROM EMI_AIRCRAFT_l_month01.nc
! 7.1 DISTRIBUTE EMISSIONS VERTICALLY - FROM NETCDF FILE DESCRIPTION
! *** ALL STEPS
! 8. INGEST EMISSIONS IN THE ATMOSPHERE

      IF(NTIMESTEP==NCHEM) THEN !ONLY READ EMISSIONS AT FIRST TIMESTEP, THEN CONSTANT

! 1. READ ANTHRO EMISSIONS - distribute vertically within zmax m a.g.l.
       IF(EMI_ANTHRO) THEN

        FILENAME='accmip_emissions_aerocom.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening accmip_emissions_aerocom_2000.1x1_4.nc ncfile'
          call check_stat(stat,message)
        endif

!START BLACK CARBON
        ! traffic
        zmin=0.
        zmax=10.                                   
        call read_emivert (input_id,'emiss_tra_bc',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! agricultural waste burning
        if(.NOT.GFAS_BB_EMISS)THEN
        zmin=0.
        zmax=100.                                    
        call read_emivert (input_id,'emiss_awb_bc',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        endif
        ! domestic
        zmin=0.
        zmax=10.                                    
        call read_emivert (input_id,'emiss_dom_bc',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! energy production
        zmin=100.
        zmax=300.                                    
        call read_emivert (input_id,'emiss_ene_bc',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! industrial
        zmin=100.
        zmax=300.                                    
        call read_emivert (input_id,'emiss_ind_bc',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! waste
        zmin=100.
        zmax=300.                                    
        call read_emivert (input_id,'emiss_wst_bc',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!END BLACK CARBON


!START PRIMARY ORGANIC CARBON
        ! traffic
        zmin=0.
        zmax=10.
        call read_emivert (input_id,'emiss_tra_oc',E_OM,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! agricultural waste burning
        if(.NOT.GFAS_BB_EMISS)THEN
        zmin=0.
        zmax=100.
        call read_emivert (input_id,'emiss_awb_oc',E_OM,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        endif
        ! domestic
        zmin=0.
        zmax=10.
        call read_emivert (input_id,'emiss_dom_oc',E_OM,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! energy production
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_ene_oc',E_OM,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! industrial
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_ind_oc',E_OM,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! waste
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_wst_oc',E_OM,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!END PRIMARY ORGANIC CARBON

!START SO2
!note use E_SO4 for SO2 emissions
        ! traffic
        zmin=0.
        zmax=10.
        call read_emivert (input_id,'emiss_tra_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! agricultural waste burning
        if(.NOT.GFAS_BB_EMISS)THEN
        zmin=0.
        zmax=100.
        call read_emivert (input_id,'emiss_awb_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        endif
        ! domestic
        zmin=0.
        zmax=10.
        call read_emivert (input_id,'emiss_dom_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! energy production
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_ene_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! industrial
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_ind_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! waste
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_wst_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!END SO2
!START NO2 for NO3-
        IF(NUM_NO3>0)THEN
!note use E_NO3 for NO2 emissions
        ! traffic
        zmin=0.
        zmax=10.
        call read_emivert (input_id,'emiss_tra_nox',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! agricultural waste burning
        if(.NOT.GFAS_BB_EMISS)THEN
        zmin=0.
        zmax=100.
        call read_emivert (input_id,'emiss_awb_nox',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        endif
        ! domestic
        zmin=0.
        zmax=10.
        call read_emivert (input_id,'emiss_dom_nox',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! energy production
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_ene_nox',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! industrial
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_ind_nox',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! waste
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_wst_nox',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        ENDIF
!END NO2
!START NH3
        IF(NUM_NH4>0)THEN
        ! traffic
        zmin=0.
        zmax=10.
        call read_emivert (input_id,'emiss_tra_nh3',E_NH4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! agricultural waste burning
        if(.NOT.GFAS_BB_EMISS)THEN
        zmin=0.
        zmax=100.
        call read_emivert (input_id,'emiss_awb_nh3',E_NH4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        endif
        ! domestic
        zmin=0.
        zmax=10.
        call read_emivert (input_id,'emiss_dom_nh3',E_NH4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! energy production
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_ene_nh3',E_NH4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! industrial
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_ind_nh3',E_NH4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        ! waste
        zmin=100.
        zmax=300.
        call read_emivert (input_id,'emiss_wst_nh3',E_NH4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
       ENDIF
!END NH3

       ENDIF

! 2. READ BIOMASS BURNING - distribute vertically within zmax m a.g.l.
       IF(EMI_BBFOREST) THEN
       if(IS4F_HEIGHT) then

        do k=1,20 ! is4f vertical levels

        write(LVLSTR2,'(I2)') k
        write(LVLSTR1,'(I1)') k
        if(k.ge.10)then
          FILENAME9='is4f_lvl' // LVLSTR2 // '.nc'
        else
          FILENAME9='is4f_lvl0' // LVLSTR1 // '.nc'
        endif

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME9),NF90_NOWRITE,INPUT_ID9) !is4f netcdf input
          message='opening is4fires'
          call check_stat(stat,message)
        endif

        zmin=500.*(k-1)
        zmax=500.*k

!BC
        call read_emivert_is4f (input_id,'emiss_for_bc',E_BC,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POM
        call read_emivert_is4f (input_id,'emiss_for_oc',E_OM,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_emivert_is4f (input_id,'emiss_for_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id9)
       endif


        enddo ! k is4f vertical levels

      else if(GFAS_BB_EMISS)then

        FILENAME9='gfasv1.2_nmmb_global.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME9),NF90_NOWRITE,INPUT_ID9) 
          message='opening gfasv1.2'
          call check_stat(stat,message)
        endif

!BC
        call read_emivert_gfas_v2 (input_id9,'var91',E_BC,dz8w,mype    & !bcfire
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POM
        call read_emivert_gfas_v2 (input_id9,'var90',E_OM,dz8w,mype    & !ocfire
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_emivert_gfas_v2 (input_id9,'var102',E_SO4,dz8w,mype  & !s02fire
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id9)
       endif

       else !use Dentener prescriptions

!!! DENTENER

        do k=1,6 ! dentener vertical levels

        write(LVLSTR2,'(I2)') k
        write(LVLSTR1,'(I1)') k
        if(k.ge.10)then
          FILENAME9='dent_lvl' // LVLSTR2 // '.nc'
        else
          FILENAME9='dent_lvl0' // LVLSTR1 // '.nc'
        endif
        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME9),NF90_NOWRITE,INPUT_ID9) !is4f netcdf input
          message='opening dent'
          call check_stat(stat,message)
        endif

        if(k.eq.1)then
        zmin=0.
        zmax=100.
        endif
        if(k.eq.2)then
        zmin=100.
        zmax=500.
        endif
        if(k.eq.3)then
        zmin=500.
        zmax=1000.
        endif
        if(k.eq.4)then
        zmin=1000.
        zmax=2000.
        endif
        if(k.eq.5)then
        zmin=2000.
        zmax=3000.
        endif
        if(k.eq.6)then
        zmin=3000.
        zmax=6000.
        endif

!BC
        call read_emivert_is4f (input_id,'emiss_for_bc',E_BC,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POM
        call read_emivert_is4f (input_id,'emiss_for_oc',E_OM,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_emivert_is4f (input_id,'emiss_for_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id9)
       endif


        enddo ! k dentener vertical levels

      ENDIF !IS4F_HEIGHT

       ENDIF

! 3. READ BIOMASS BURNING - distribute vertically within zmax m a.g.l.
      IF(EMI_BBGRASS) THEN

       if(IS4F_HEIGHT) then

        do k=1,20 ! is4f vertical levels

        write(LVLSTR2,'(I2)') k
        write(LVLSTR1,'(I1)') k
        if(k.ge.10)then
          FILENAME9='is4f_lvl' // LVLSTR2 // '.nc'
        else
          FILENAME9='is4f_lvl0' // LVLSTR1 // '.nc'
        endif

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME9),NF90_NOWRITE,INPUT_ID9) !is4f netcdf input
          message='opening is4fires'
          call check_stat(stat,message)
        endif

        zmin=500.*(k-1)
        zmax=500.*k

!BC
        call read_emivert_is4f (input_id,'emiss_gra_bc',E_BC,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POM
        call read_emivert_is4f (input_id,'emiss_gra_oc',E_OM,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_emivert_is4f (input_id,'emiss_gra_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id9)
       endif

        enddo ! k is4f vertical levels

!      else if(GFAS_BB_EMISS)then
!
!        FILENAME9='gfasv1.2_nmmb_global.nc'
!
!        if(mype==0)then
!          STAT=NF90_OPEN(TRIM(FILENAME9),NF90_NOWRITE,INPUT_ID9) !is4f netcdf input
!          message='opening gfasv1.2'
!          call check_stat(stat,message)
!        endif
!
!!BC
!        call read_emivert_gfas (input_id9,'bcfire',E_BC,dz8w,mype      &
!                ,GLAT,GLON                                             &
!                ,IDS,IDE,JDS,JDE,LM                                    &
!                ,IMS,IME,JMS,JME,KMS,KME                               &
!                ,ITS,ITE,JTS,JTE)
!!POM
!        call read_emivert_gfas (input_id9,'ocfire',E_OM,dz8w,mype      &
!                ,GLAT,GLON                                             &
!                ,IDS,IDE,JDS,JDE,LM                                    &
!                ,IMS,IME,JMS,JME,KMS,KME                               &
!                ,ITS,ITE,JTS,JTE)
!!SO2
!        call read_emivert_gfas (input_id9,'so2fire',E_SO4,dz8w,mype    &
!                ,GLAT,GLON                                             &
!                ,IDS,IDE,JDS,JDE,LM                                    &
!                ,IMS,IME,JMS,JME,KMS,KME                               &
!                ,ITS,ITE,JTS,JTE)
!
!       if(mype==0)then
!         stat=nf90_close(input_id9)
!       endif

      else ! use Dentener prescriptions

!!! DENTENER

        do k=1,6 ! dentener vertical levels

        write(LVLSTR2,'(I2)') k
        write(LVLSTR1,'(I1)') k
        if(k.ge.10)then
          FILENAME9='dent_lvl' // LVLSTR2 // '.nc'
        else
          FILENAME9='dent_lvl0' // LVLSTR1 // '.nc'
        endif

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME9),NF90_NOWRITE,INPUT_ID9) !is4f netcdf input
          message='opening dent'
          call check_stat(stat,message)
        endif

        if(k.eq.1)then
        zmin=0.
        zmax=100.
        endif
        if(k.eq.2)then
        zmin=100.
        zmax=500.
        endif
        if(k.eq.3)then
        zmin=500.
        zmax=1000.
        endif
        if(k.eq.4)then
        zmin=1000.
        zmax=2000.
        endif
        if(k.eq.5)then
        zmin=2000.
        endif
        if(k.eq.5)then
        zmin=2000.
        zmax=3000.
        endif
        if(k.eq.6)then
        zmin=3000.
        zmax=6000.
        endif

!BC
        call read_emivert_is4f (input_id,'emiss_gra_bc',E_BC,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POM
        call read_emivert_is4f (input_id,'emiss_gra_oc',E_OM,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_emivert_is4f (input_id,'emiss_gra_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,GLAT,GLON                                             &
                ,input_id9                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id9)
       endif

        enddo ! k dentener vertical levels
      ENDIF ! IS4F

      ENDIF

! 4. READ OCEAN EMISSIONS FROM EMI_OCEAN_l_month01.nc - distribute vertically 30 m a.g.l.
      IF(EMI_OCEAN) THEN
!        zmax=30.
!        if(mype==0)then
!          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
!          message='opening EMI_OCEAN_l_month01.nc ncfile'
!          call check_stat(stat,message)
!        endif
!        call read_emivert (input_id,'CO',E_CO,dz8w,zmax,mype          &
!                ,IDS,IDE,JDS,JDE,LM                                    &
!                ,IMS,IME,JMS,JME,KMS,KME                               &
!                ,ITS,ITE,JTS,JTE)

        !DMS EMISSIONS
        ! i) flux from AEROCOM-EXPB 2000 (from Andreas seawater dms*Nightingale u10, Pham biogenic, etc.)
        !    daily for each month of 2000
        !    units=kg(S)/m2
        if(mype==0)then
          STAT=NF90_OPEN(TRIM('dms.nc'),NF90_NOWRITE,INPUT_ID3)
          message='opening DMS emi flux ncfile'
          call check_stat(stat,message)
        endif
        zmin=0.
        zmax=30.
        call read_emivert (input_id3,'total_flux',E_DMS,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id3)
       endif

      ENDIF

! 5. DISTRIBUTE EMISSIONS FROM EMI_BIOG_l_month01.nc - distribute vertically 30 m a.g.l.
      IF(EMI_BIOG) THEN
!        zmax=30.

!        call read_emivert (input_id,'TERP',E_TERP,dz8w,zmax,mype          &
!                ,IDS,IDE,JDS,JDE,LM                                    &
!                ,IMS,IME,JMS,JME,KMS,KME                               &
!                ,ITS,ITE,JTS,JTE)
      ENDIF

! 6. DISTRIBUTE EMISSIONS FROM EMI_SHIPS_l_month01.nc - distribute vertically 500 m a.g.l.
      IF(EMI_SHIPS) THEN
        zmin=0.
        zmax=10.

        call read_emivert (input_id,'emiss_shp_bc',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        call read_emivert (input_id,'emiss_shp_oc',E_OM,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'emiss_shp_so2',E_SO4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'emiss_shp_nox',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_emivert (input_id,'emiss_shp_nh3',E_NH4,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
      ENDIF

! 7. DISTRIBUTE EMISSIONS FROM EMI_AIRCRAFT_l_month01.nc
      IF(EMI_AIRCRAFT) THEN

!        call read_emiair (input_id2,'emiss_air_bc',E_BC,dz8w,mype          &
!                ,IDS,IDE,JDS,JDE,LM                                    &
!                ,IMS,IME,JMS,JME,KMS,KME                               &
!                ,ITS,ITE,JTS,JTE)

        !25 aircraft emission layers from aerocom (kg m-2 s-1)
        !after the main script, each layer is a 2d variable in the emission file
        !each emi layer is treated as a 2d vertical distributed emission...
        !with the only difference of units: here kg m-3 s-1 (not kg m-2 s-1)
        !so a *(zmax-zmin) (m) has been introduced
      
        !first aircraft layer
        zmin=0.
        zmax=610.
        call read_emivert_air (input_id,'emiss_air_bc1',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !2
        zmin=610.*1
        zmax=610.*2
        call read_emivert_air (input_id,'emiss_air_bc2',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !3
        zmin=610.*2
        zmax=610.*3
        call read_emivert_air (input_id,'emiss_air_bc3',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !4
        zmin=610.*3
        zmax=610.*4
        call read_emivert_air (input_id,'emiss_air_bc4',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !5
        zmin=610.*4
        zmax=610.*5
        call read_emivert_air (input_id,'emiss_air_bc5',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !6
        zmin=610.*5
        zmax=610.*6
        call read_emivert_air (input_id,'emiss_air_bc6',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !7
        zmin=610.*6
        zmax=610.*7
        call read_emivert_air (input_id,'emiss_air_bc7',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !8
        zmin=610.*7
        zmax=610.*8
        call read_emivert_air (input_id,'emiss_air_bc8',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !9
        zmin=610.*8
        zmax=610.*9
        call read_emivert_air (input_id,'emiss_air_bc9',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !10
        zmin=610.*9
        zmax=610.*10
        call read_emivert_air (input_id,'emiss_air_bc10',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !11
        zmin=610.*10
        zmax=610.*11
        call read_emivert_air (input_id,'emiss_air_bc11',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !12
        zmin=610.*11
        zmax=610.*12
        call read_emivert_air (input_id,'emiss_air_bc12',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !13
        zmin=610.*12
        zmax=610.*13
        call read_emivert_air (input_id,'emiss_air_bc13',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !14
        zmin=610.*13
        zmax=610.*14
        call read_emivert_air (input_id,'emiss_air_bc14',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !15
        zmin=610.*14
        zmax=610.*15
        call read_emivert_air (input_id,'emiss_air_bc15',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !16
        zmin=610.*15
        zmax=610.*16
        call read_emivert_air (input_id,'emiss_air_bc16',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !17
        zmin=610.*16
        zmax=610.*17
        call read_emivert_air (input_id,'emiss_air_bc17',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !18
        zmin=610.*17
        zmax=610.*18
        call read_emivert_air (input_id,'emiss_air_bc18',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !19
        zmin=610.*18
        zmax=610.*19
        call read_emivert_air (input_id,'emiss_air_bc19',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !20
        zmin=610.*19
        zmax=610.*20
        call read_emivert_air (input_id,'emiss_air_bc20',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !21
        zmin=610.*20
        zmax=610.*21
        call read_emivert_air (input_id,'emiss_air_bc21',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !22
        zmin=610.*21
        zmax=610.*22
        call read_emivert_air (input_id,'emiss_air_bc22',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !23
        zmin=610.*22
        zmax=610.*23
        call read_emivert_air (input_id,'emiss_air_bc23',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !24
        zmin=610.*23
        zmax=610.*24
        call read_emivert_air (input_id,'emiss_air_bc24',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !25
        zmin=610.*24
        zmax=610.*25
        call read_emivert_air (input_id,'emiss_air_bc25',E_BC,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!NO2 EMISS AIRCRAFT
        !first aircraft layer
        zmin=0.
        zmax=610.
        call read_emivert_air (input_id,'emiss_air_nox',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !2
        zmin=610.*1
        zmax=610.*2
        call read_emivert_air (input_id,'emiss_air_nox_2',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !3
        zmin=610.*2
        zmax=610.*3
        call read_emivert_air (input_id,'emiss_air_nox_3',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !4
        zmin=610.*3
        zmax=610.*4
        call read_emivert_air (input_id,'emiss_air_nox_4',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !5
        zmin=610.*4
        zmax=610.*5
        call read_emivert_air (input_id,'emiss_air_nox_5',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !6
        zmin=610.*5
        zmax=610.*6
        call read_emivert_air (input_id,'emiss_air_nox_6',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !7
        zmin=610.*6
        zmax=610.*7
        call read_emivert_air (input_id,'emiss_air_nox_7',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !8
        zmin=610.*7
        zmax=610.*8
        call read_emivert_air (input_id,'emiss_air_nox_8',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !9
        zmin=610.*8
        zmax=610.*9
        call read_emivert_air (input_id,'emiss_air_nox_9',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !10
        zmin=610.*9
        zmax=610.*10
        call read_emivert_air (input_id,'emiss_air_nox_10',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !11
        zmin=610.*10
        zmax=610.*11
        call read_emivert_air (input_id,'emiss_air_nox_11',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !12
        zmin=610.*11
        zmax=610.*12
        call read_emivert_air (input_id,'emiss_air_nox_12',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !13
        zmin=610.*12
        zmax=610.*13
        call read_emivert_air (input_id,'emiss_air_nox_13',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !14
        zmin=610.*13
        zmax=610.*14
        call read_emivert_air (input_id,'emiss_air_nox_14',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !15
        zmin=610.*14
        zmax=610.*15
        call read_emivert_air (input_id,'emiss_air_nox_15',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !16
        zmin=610.*15
        zmax=610.*16
        call read_emivert_air (input_id,'emiss_air_nox_16',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !17
        zmin=610.*16
        zmax=610.*17
        call read_emivert_air (input_id,'emiss_air_nox_17',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !18
        zmin=610.*17
        zmax=610.*18
        call read_emivert_air (input_id,'emiss_air_nox_18',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !19
        zmin=610.*18
        zmax=610.*19
        call read_emivert_air (input_id,'emiss_air_nox_19',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !20
        zmin=610.*19
        zmax=610.*20
        call read_emivert_air (input_id,'emiss_air_nox_20',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !21
        zmin=610.*20
        zmax=610.*21
        call read_emivert_air (input_id,'emiss_air_nox_21',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !22
        zmin=610.*21
        zmax=610.*22
        call read_emivert_air (input_id,'emiss_air_nox_22',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !23
        zmin=610.*22
        zmax=610.*23
        call read_emivert_air (input_id,'emiss_air_nox_23',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !24
        zmin=610.*23
        zmax=610.*24
        call read_emivert_air (input_id,'emiss_air_nox_24',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        !25
        zmin=610.*24
        zmax=610.*25
        call read_emivert_air (input_id,'emiss_air_nox_25',E_NO3,dz8w,zmin,zmax,mype &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!END NO2 AIRCRAFT
       ENDIF

       if(mype==0)then
         stat=nf90_close(input_id)
       endif



       IF(EMI_VOLC_DIFF.OR.EMI_VOLC_ERUP)THEN
         open(10,file=trim('volc.dat'),form='unformatted',status='old')
         read(10) nevents
!         write(*,*) nevents
         allocate(volc(1:nevents,1:4))
         read(10) volc
         close(10)

         do n=1,nevents

! locate emissions
            DO J=JTS,JTE-1
            DO I=ITS,ITE-1
!implementation (neighbor)
               IF(XLONG(I,J).LE.volc(n,1).AND.XLONG(I+1,J).GT.volc(n,1).AND.XLAT(I,J).LE.volc(n,2).AND.XLAT(I,J+1).GT.volc(n,2))THEN
                 if(abs(XLONG(I,J)-volc(n,1)).lt.abs(XLONG(I+1,J)-volc(n,1)))then
                   ine=I
                 else
                   ine=I+1
                 endif
                 if(abs(XLAT(I,J)-volc(n,2)).lt.abs(XLAT(I,J+1)-volc(n,2)))then
                   jne=J
                 else
                   jne=J+1
                 endif
!identify eruption type (eruptive/non-eruptive) and inject
            if(volc(n,3).le.0)then !non-eruptive: all in the surface gridcell
              if(EMI_VOLC_DIFF)then
                E_SO4(ine,jne,LM)=E_SO4(ine,jne,LM)+volc(n,4)*1e6/DARE(jne)/(24.*3600.) !emi from kton(SO2)/day to kg(SO2)/m2/s
                EMISS_AERO(ine,jne,NUM_ASH+NUM_DUST+NUM_SALT+P_SO4)=EMISS_AERO(ine,jne,NUM_ASH+NUM_DUST+NUM_SALT+P_SO4)+dtchem*volc(n,4)*1e6/DARE(jne)/(24.*3600.)
!                write(*,*) 'non-erup',n,ine,jne !debug
              endif
            else !eruptive
              zmax=volc(n,3)
              zmin=volc(n,3)*2./3. !emission injected in the top third of the volcano's cloud
              k=lm
              kflip=LM-k+1
              dzbot=0.
              femi(:)=0.
              dztop=dz8w(i,kflip,j)
              do while(dzbot.lt.zmax)
                 if (min(dztop,zmax)-max(dzbot,zmin).gt.0.)then
                    femi(k)=(min(dztop,zmax)-max(dzbot,zmin))/(zmax-zmin)
                 endif
                 dzbot=dztop
                 dztop=dztop+dz8w(i,kflip,j)
                 k=k-1
                 kflip=kflip+1
              enddo
              do kk=lm,k,-1
                 if(EMI_VOLC_ERUP)then
                   E_SO4(ine,jne,kk)=E_SO4(ine,jne,kk)+volc(n,4)*femi(kk)*1e6/DARE(jne)/(24.*3600.) !emi from kton(SO2)/day to kg(SO2)/m2/s
                   EMISS_AERO(ine,jne,NUM_ASH+NUM_DUST+NUM_SALT+P_SO4)=EMISS_AERO(ine,jne,NUM_ASH+NUM_DUST+NUM_SALT+P_SO4)+dtchem*volc(n,4)*femi(kk)*1e6/DARE(jne)/(24.*3600.)
                 endif
              enddo
            endif !eruptive or not

           ENDIF
         ENDDO
         ENDDO

         enddo !nevents
       ENDIF !EMI_VOLC



     ENDIF !NTIMESTEP==NCHEM


! 8. INGEST EMISSIONS IN THE ATMOSPHERE
!0. Define position of aerosols
       IF(NUM_OM>0)THEN
         P_OM1=NUM_ASH+NUM_DUST+NUM_SALT+1; P_OM2=P_OM1+1; P_OM3=P_OM2+1; P_OM4=P_OM3+1
         IF(EMI_SOA_DENT.GT.1)THEN
          P_OM5=P_OM4+1; P_OM6=P_OM5+1; P_OM7=P_OM6+1
         ENDIF
         IF(EMI_SOA_DENT.GT.2)THEN
          P_OM8=P_OM7+1
         ENDIF
       ELSE
         P_OM1=0;P_OM2=0;P_OM3=0;P_OM4=0;P_OM5=0;P_OM6=0;P_OM7=0;P_OM8=0
       ENDIF

       IF(NUM_BC>0)THEN
         P_BC1=NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+1;P_BC2=P_BC1+1
       ELSE
         P_BC1=0;P_BC2=0
       ENDIF

       IF(NUM_SO4>0)THEN
         P_SO4=NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+1
       ELSE
         P_SO4=0
       ENDIF

       IF(NUM_NO3>0)THEN
         P_NO3b1=NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+NUM_SO4+1
         P_NO3b2=P_NO3b1+1
         P_NO3b3=P_NO3b2+1
       ELSE
         P_NO3b1=0;P_NO3b2=0;P_NO3b3=0
       ENDIF

       IF(NUM_NH4>0)THEN
         P_NH4=NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+NUM_SO4+NUM_NO3+1
       ELSE
         P_NH4=0
       ENDIF

! AIRDENSITY[kg/m3]; dtchem [s]; dz8w[m]
! E_... [kg m-2 s-1]; CONC[kg m-3]
! CONC[kg m-3]=E_...[kg m-2 s-1]*dtchem[s]/dz8w[m]
! conv_rho=dtchem/dz8w
      do k=kme,kms,-1  !LM to 1
      do j=jts,jte
      do i=its,ite
        kflip=LM-k+1
!        conv_rho=dtchem/dz8w(i,k,j)/AIRDENSITY(i,kflip,j) !For mixing ratio
        conv_rho=dtchem/dz8w(i,kflip,j)                        !For concentration
        !8.047e-6=kg(air)/mol(air)/3600s
!        conv_rho2=8.047*dtchem/(AIRDENSITY(i,kflip,j)*dz8w(i,kflip,j))
        conv_rho2=0.02897/(AIRDENSITY(i,kflip,j)*dz8w(i,kflip,j))*dtchem*1e6

        IF(.FALSE.)THEN !EMISSIONS ARE ALREADY INGESTED IN HERMESv3 SUBROUTINES, HERE WE ONLY INGEST DMS EMISSIONS TEMPORALY
!phobic/philic fractions:
!Cooke et al., 1999 assumed (GOCART) 50/50
!Mayol-Bracero et al., 2002 65/35
!---
!OM/OC=1.4 (prescribed ACP, Dentener et al., 2006)
!note that ACCMIP emissions refer to OC, not OM
        IF(NUM_OM>0)THEN
        !POM
        AERO_BSC(i,j,k,P_OM1)  =  AERO_BSC(i,j,k,P_OM1)                     &
                         + 1.6*0.5*E_OM(i,j,k)*conv_rho
        AERO_BSC(i,j,k,P_OM2)  =  AERO_BSC(i,j,k,P_OM2)                     &
                         + 1.6*0.5*E_OM(i,j,k)*conv_rho
!diagnostic
        EMISS_AERO(i,j,P_OM1)=EMISS_AERO(i,j,P_OM1)+1.6*0.5*E_OM(i,j,k)*dtchem ! kg m-2 (acc)
        EMISS_AERO(i,j,P_OM2)=EMISS_AERO(i,j,P_OM2)+1.6*0.5*E_OM(i,j,k)*dtchem ! kg m-2 (acc)
        ENDIF !NUM_OM

        IF(NUM_BC>0)THEN
! Following (i) Chin et al., 2001: 80% phob/ 20% phil
! Other possible assumptions:
! (ii)  Stier et al., 2005: 100% phob/ 0% phil
!
! For OM we found in literature:
! (i)   Koch et al., 2001: 70% phob/ 30% phil
! (ii)  Mayol-Bracero et al., 2002: 65% phob/ 35% phil 
!
        AERO_BSC(i,j,k,P_BC1)  =  AERO_BSC(i,j,k,P_BC1)                     &
                         + 0.8*E_BC(i,j,k)*conv_rho
        AERO_BSC(i,j,k,P_BC2)  =  AERO_BSC(i,j,k,P_BC2)                     &
                         + 0.2*E_BC(i,j,k)*conv_rho

!diagnostic
        EMISS_AERO(i,j,P_BC1)=EMISS_AERO(i,j,P_BC1)+0.8*E_BC(i,j,k)*dtchem ! kg m-2 (acc)
        EMISS_AERO(i,j,P_BC2)=EMISS_AERO(i,j,P_BC2)+0.2*E_BC(i,j,k)*dtchem ! kg m-2 (acc)

        ENDIF

        IF(NUM_SO4>0)THEN
        CHEM(i,j,k,P_SO2)  =  CHEM(i,j,k,P_SO2)                     &
                         + E_SO4(i,j,k)*conv_rho2*1000/64.066 ! emi in kg(SO2)/m2/s
!        write(*,*) 'MSPADA9 e_so4',E_SO4(its,jts,24)
        EMISS_AERO(i,j,P_SO4)=EMISS_AERO(i,j,P_SO4)+E_SO4(i,j,k)*dtchem !estimating so2 emi
        ENDIF
!
        IF(NUM_NO3>0)THEN
        CHEM(i,j,k,P_NO2)  =  CHEM(i,j,k,P_NO2)                     &
                         + E_NO3(i,j,k)*conv_rho2*1000/30.015 ! emi in kg(NOx as NO)/m2/s
        EMISS_AERO(i,j,P_NO3b1)=EMISS_AERO(i,j,P_NO3b1)+E_NO3(i,j,k)*dtchem !estimating no2 emi
        ENDIF
!
        IF(NUM_NH4>0)THEN
        CHEM(i,j,k,P_NH3)  =  CHEM(i,j,k,P_NH3)                     &
                         + E_NH4(i,j,k)*conv_rho2*1000/17.031 ! emi in kg(nh3)/m2/s
        EMISS_AERO(i,j,P_NH4)=EMISS_AERO(i,j,P_NH4)+E_NH4(i,j,k)*dtchem !estimating no2 emi
        ENDIF
!

        IF(EMI_AIRCRAFT) THEN
!ALREADY INGESTED ABOVE
!        IF(NUM_NO3>0)THEN
!        CHEM(i,j,k,P_NO2)  =  CHEM(i,j,k,P_NO2)                          &
!                        + E_NO2_AIR(i,j,k)*conv_rho/1000.
!          ENDIF
        ENDIF
        ENDIF !FALSE TO SKIP INGEST OF EMISSIONS EXCEPT DMS
!DMS EMI
        !/24 because daily totals
        !conv_rho2 -> mixing-ratio emi
        !32.065 g/mol (S)
        !1000 because kg(S)
        IF(EMI_OCEAN)THEN
        CHEM(i,j,k,P_DMS)=CHEM(i,j,k,P_DMS)                                 &
                         +E_DMS(i,j,k)*conv_rho2*1000/(32.065*24*3600.) ! emi in kg(S)/m2/day
        ENDIF

        enddo
      enddo
      enddo
!                          
!-----------------------------------------------------------------------
!                          

      RETURN
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_AEROCOM_ACCMIP_EMISSIONS_AERO_BSC
!                          
!***********************************************************************
!---------------------------------------------------------------------
subroutine read_emivert (input_id,var,emi,dz8w,zmin,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )

implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id,IDS,IDE,JDS,JDE,LM      &
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype

      real, intent(in) :: zmin

      real, intent(in) :: zmax

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme),intent(inout) :: emi

      REAL, DIMENSION( ITS:ITE,1:LM,JTS:JTE) :: dz8w

      CHARACTER (len = *), intent(in) :: var
! LOCAL-----------
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: real_2d

      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: temp1

      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp2
    

      integer :: ncid_in, i,j,k,kk,stat,kflip

      real :: dztot
      real :: dzbot
      real, dimension(1:LM) :: femi
!----------

        real_2d=0.
        temp1=0.
        temp2=0.

        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_2d,start=(/1,1,1/),count=(/ide-3,jde-4,1/))
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          call padh_nc(real_2d,temp1,ids,ide,jds,jde)
        endif
        call dstrb(temp1,temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
! distribute emissions vertically
        do j=jts,jte
        do i=its,ite
         if(temp2(i,j,LM).gt.0)then
          k=lm
          kflip=LM-k+1
          dzbot=0.
          femi(:)=0.
          dztot=dz8w(i,kflip,j)
          do while(dzbot.lt.zmax)
            if (min(dztot,zmax)-max(dzbot,zmin).gt.0.)then
              femi(k)=(min(dztot,zmax)-max(dzbot,zmin))/(zmax-zmin)
              !femi -> fractional contribution of gridcell to vertically distributed emissions
            endif
            dzbot=dztot
            dztot=dztot+dz8w(i,kflip,j)

            k=k-1
            kflip=kflip+1

          enddo
          do kk=lm,k,-1
            emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)
            if (sum(femi).lt.0.995.or.sum(femi).gt.1.005)then
              write(*,*) 'error, sum(femi) = ',sum(femi) !debug
            endif
          enddo
         endif
        enddo
        enddo

end subroutine read_emivert
!---------------------------------------------------------------------
subroutine read_emivert_air (input_id,var,emi,dz8w,zmin,zmax,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )

implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id,IDS,IDE,JDS,JDE,LM      &
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype

      real, intent(in) :: zmin
      real, intent(in) :: zmax

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme),intent(inout) :: emi

      REAL, DIMENSION( ITS:ITE,1:LM,JTS:JTE) :: dz8w

      CHARACTER (len = *), intent(in) :: var
! LOCAL-----------
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: real_2d

      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: temp1

      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp2

      integer :: ncid_in, i,j,k,kk,stat,kflip
      real :: dztot
      real :: dzbot
      real, dimension(1:LM) :: femi
!----------

        real_2d=0.
        temp1=0.
        temp2=0.

        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_2d,start=(/1,1,1/),count=(/ide-3,jde-4,1/))
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          call padh_nc(real_2d,temp1,ids,ide,jds,jde)
        endif
        call dstrb(temp1,temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
! distribute emissions vertically
        do j=jts,jte
        do i=its,ite
         if(temp2(i,j,LM).gt.0)then
          k=lm
          kflip=LM-k+1
          dzbot=0.
          femi(:)=0.
          dztot=dz8w(i,kflip,j)
          do while(dzbot.lt.zmax)
            if (min(dztot,zmax)-max(dzbot,zmin).gt.0.)then
              femi(k)=(min(dztot,zmax)-max(dzbot,zmin))/(zmax-zmin)
            endif
            dzbot=dztot
            dztot=dztot+dz8w(i,kflip,j)
            k=k-1
            kflip=kflip+1
          enddo
          do kk=lm,k,-1
            emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)*(zmax-zmin)
            if (sum(femi).lt.0.995.or.sum(femi).gt.1.005)then
              write(*,*) 'error, sum(femi) = ',sum(femi) !debug
            endif
          enddo
         endif
        enddo
        enddo

end subroutine read_emivert_air
!---------------------------------------------------------------------
! routine for the use of IS4FIRES injection heights derived from MODIS observations
! instead of the prescribed Dentener approach.
! Note that MODIS and then IS4F values are available only where satellite 
! measurements are available: thus, if we use other emissions than IS4FIRES, 
! some inconsistencies could be challenged.
! Anyway, we want to study the correction introduced by the IS4F inj. heights, 
! so - for this purpose - we use ACCMIP emissions and we keep the Dentener 
! approach where IS4F values are not available for ACCMIP fires.
!-------------------------------------------------------------------------------+++
subroutine read_emivert_is4f (input_id,var,emi,dz8w,zmin,zmax,mype          &
                ,GLAT,GLON                                             &
!
                ,input_id9                                             &
!
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )

implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id,IDS,IDE,JDS,JDE,LM      &
!
                ,input_id9                                    &
!
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype

      real, intent(in) :: zmin
      real, intent(in) :: zmax
      real, dimension( ITS:ITE,JTS:JTE),intent(in) :: GLAT,GLON
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme),intent(inout) :: emi

      REAL, DIMENSION( ITS:ITE,1:LM,JTS:JTE) :: dz8w

      CHARACTER (len = *), intent(in) :: var
! LOCAL-----------
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: real_2d

      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: temp1

      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp2
      integer :: ncid_in, i,j,k,kk,stat,kflip
!
      integer :: ncid_in9
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: is4f_2d
      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: is4f_temp1
      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: is4f_temp2
      integer :: ncid_in10
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: sum_2d
      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: sum_temp1
      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: sum_temp2
      real, dimension(1:4) :: dent
!

      real :: dztot
      real :: dzbot
      real, dimension(1:LM) :: femi
!----------

        real_2d=0.
        temp1=0.
        temp2=0.

        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_2d,start=(/1,1,1/),count=(/ide-3,jde-4,1/))
!
          stat=nf90_inq_varid(input_id9,trim('ems_norm_wholeday_gapfill'),ncid_in9)
          stat=nf90_get_var(input_id9,ncid_in9,is4f_2d,start=(/1,1,1/),count=(/ide-3,jde-4,1/))

!
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          call padh_nc(real_2d,temp1,ids,ide,jds,jde)
!
          call padh_nc(is4f_2d,is4f_temp1,ids,ide,jds,jde)
!
        endif
        call dstrb(temp1,temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
!
        call dstrb(is4f_temp1,is4f_temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
!
! distribute emissions vertically
        do j=jts,jte
        do i=its,ite
         if(temp2(i,j,LM).gt.0)then
          k=lm
          kflip=LM-k+1
          dzbot=0.
          femi(:)=0.
          dztot=dz8w(i,kflip,j)
          do while(dzbot.lt.zmax)
            if (min(dztot,zmax)-max(dzbot,zmin).gt.0.)then
              femi(k)=(min(dztot,zmax)-max(dzbot,zmin))/(zmax-zmin)
              !femi -> fractional contribution of gridcell to vertically distributed emissions
            endif
            dzbot=dztot
            dztot=dztot+dz8w(i,kflip,j)
            k=k-1
            kflip=kflip+1
          enddo
          do kk=lm,k,-1
!
           emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)*is4f_temp2(i,j,lm)
!
          enddo !kk
         endif
        enddo
        enddo

end subroutine read_emivert_is4f
!-------------------------------------------------------------------------------+++
subroutine read_emivert_gfas (input_id,var,emi,dz8w,mype               &
                ,GLAT,GLON                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )
! Subroutine to read GFASv1.2 from http://apps.ecmwf.int/datasets/data/cams-gfas/
! biomass burning emissions from MODIS retreivals

implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id,IDS,IDE,JDS,JDE,LM      &
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype
      real, dimension( ITS:ITE,JTS:JTE),intent(in) :: GLAT,GLON
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme),intent(inout) :: emi
      REAL, DIMENSION( ITS:ITE,1:LM,JTS:JTE) :: dz8w
      CHARACTER (len = *), intent(in) :: var
! LOCAL-----------
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: real_2d,real_2d_apt

      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: temp1,apt_temp1

      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp2,apt_temp2
      integer :: ncid_in, i,j,k,kk,stat,kflip
!
      integer :: validRange
!
      real :: scale_factor,add_offset
      real :: dztot,dzbot,zmax,zmin,tmpval
      real, dimension(1:LM) :: femi
!----------
!----------

        real_2d=0.
        real_2d_apt=0.
        temp1=0.
        temp2=0.

        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          stat=nf90_inquire_attribute(input_id,ncid_in,"scale_factor",len=validRange)
          stat=nf90_get_att(input_id,ncid_in,"scale_factor",scale_factor)
          stat=nf90_inquire_attribute(input_id,ncid_in,"add_offset",len=validRange)
          stat=nf90_get_att(input_id,ncid_in,"add_offset",add_offset)
          stat=nf90_get_var(input_id,ncid_in,real_2d,start=(/1,1,1/),count=(/ide-3,jde-4,1/))
!apply var_final=scale_factor*var_read+add_offset
          real_2d=scale_factor*real_2d+add_offset
!read altitude of plume top
          stat=nf90_inq_varid(input_id,"apt",ncid_in)
          stat=nf90_inquire_attribute(input_id,ncid_in,"scale_factor",len=validRange)
          stat=nf90_get_att(input_id,ncid_in,"scale_factor",scale_factor)
          stat=nf90_inquire_attribute(input_id,ncid_in,"add_offset",len=validRange)
          stat=nf90_get_att(input_id,ncid_in,"add_offset",add_offset)
          stat=nf90_get_var(input_id,ncid_in,real_2d_apt,start=(/1,1,1/),count=(/ide-3,jde-4,1/))
!apply var_final=scale_factor*var_read+add_offset
          real_2d_apt=scale_factor*real_2d_apt+add_offset
!
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          call padh_nc(real_2d,temp1,ids,ide,jds,jde)
!
          call padh_nc(real_2d_apt,apt_temp1,ids,ide,jds,jde)
!
        endif
        call dstrb(temp1,temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
!
        call dstrb(apt_temp1,apt_temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
!
! distribute emissions vertically
        do j=jts,jte
        do i=its,ite
         if(temp2(i,j,LM).gt.0)then
          tmpval=temp2(i,j,LM)
!          zmax=10.
!          zmin=0.
          zmax=apt_temp2(i,j,LM)+10.
          zmin=apt_temp2(i,j,LM)-10 !0.
          k=lm
          kflip=LM-k+1
          dzbot=0.
          femi(:)=0.
          dztot=dz8w(i,kflip,j)
          do while(dzbot.lt.zmax)
            if (min(dztot,zmax)-max(dzbot,zmin).gt.0.)then
              femi(k)=(min(dztot,zmax)-max(dzbot,zmin))/(zmax-zmin)
              !femi -> fractional contribution of gridcell to vertically distributed emissions
            endif
            dzbot=dztot
            dztot=dztot+dz8w(i,kflip,j)
            k=k-1
            kflip=kflip+1
          enddo
          do kk=lm,k,-1
!
           emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)
!
          enddo !kk
         endif
        enddo
        enddo

end subroutine read_emivert_gfas
!-------------------------------------------------------------------------------+++
!-------------------------------------------------------------------------------+++
!
subroutine read_emivert_gfas_v2 (input_id,var,emi,dz8w,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )
! Subroutine to read GFASv1.2 from http://apps.ecmwf.int/datasets/data/cams-gfas/
! biomass burning emissions from MODIS retreivals
! Format from /esarchive/recon/ecmwf/gfas/original_files/ga_mc_sfc_gfas_ecmf

implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id,IDS,IDE,JDS,JDE,LM      &
                            ,IMS,IME,JMS,JME,KMS,KME          &
                            ,ITS,ITE,JTS,JTE,mype
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme),intent(inout) :: emi
      REAL, DIMENSION( ITS:ITE,1:LM,JTS:JTE) :: dz8w
      CHARACTER (len = *), intent(in) :: var
! LOCAL-----------
      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: real_2d,real_2d_apt

      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp2,apt_temp2
      integer :: ncid_in, i,j,k,kk,stat,kflip
!
      integer :: validRange
!
      real :: scale_factor,add_offset
      real :: dztot,dzbot,zmax,zmin,tmpval
      real, dimension(1:LM) :: femi
!----------
!----------

        real_2d=0.
        real_2d_apt=0.
        temp2=0.

        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_2d,start=(/1,1,1/),count=(/ide,jde,1/))
!apply var_final=scale_factor*var_read+add_offset
!          real_2d=scale_factor*real_2d+add_offset
!read altitude of plume top
          stat=nf90_inq_varid(input_id,"var120",ncid_in) !apt
          stat=nf90_get_var(input_id,ncid_in,real_2d_apt,start=(/1,1,1/),count=(/ide,jde,1/))
        endif
        call dstrb(real_2d,temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
!
        call dstrb(real_2d_apt,apt_temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
!
! distribute emissions vertically
        do j=jts,jte
        do i=its,ite
         if(temp2(i,j,LM).gt.0)then
          tmpval=temp2(i,j,LM)
!          zmax=10.
!          zmin=0.
          zmax=apt_temp2(i,j,LM)+10.
          zmin=max(apt_temp2(i,j,LM)-10,0.) !0.
          k=lm
          kflip=LM-k+1
          dzbot=0.
          femi(:)=0.
          dztot=dz8w(i,kflip,j)
          do while(dzbot.lt.zmax)
            if (min(dztot,zmax)-max(dzbot,zmin).gt.0.)then
              femi(k)=(min(dztot,zmax)-max(dzbot,zmin))/(zmax-zmin)
              !femi -> fractional contribution of gridcell to vertically distributed emissions
            endif
            dzbot=dztot
            dztot=dztot+dz8w(i,kflip,j)
            k=k-1
            kflip=kflip+1
          enddo
          do kk=lm,k,-1
!
!           emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)
           emi(i,j,kk)=temp2(i,j,LM)*femi(kk) !reset emissions every time we read new emissions
!
            if (sum(femi).lt.0.995.or.sum(femi).gt.1.005)then
              write(*,*) 'GFAS: error, sum(femi) = ',sum(femi),'ijk: ',i,j,kk !debug
              write(*,*) 'femi: ',femi
              write(*,*) 'dz8w: ',dz8w(i,:,j)
              write(*,*) 'zmax zmin: ',zmax,zmin
              stop
            endif
!
          enddo !kk
         endif
        enddo
        enddo

end subroutine read_emivert_gfas_v2
!---------------------------------------------------------------------
! Dentener vertical treatment of fires (Dentener et al., 2006, ACP)
! 6 vertical layers (m) (I-VI): 0-100, 100-500, 500-1000, 1000-2000, 2000-3000, 3000-6000
! 4 latitudes: TR, TE, BOW, BOE: 30S-30N, 30N-60N and 30S-60S, >60N (BOW=Canada, BOE=EurAsia)
! 
! Table 4
! -------
!        I    II   III  IV   V    VI
! TR     0.2  0.4  0.4
! TE     0.2  0.2  0.2  0.4
! BOE    0.1  0.1  0.2  0.2  0.4
! BOW    0.1  0.1  0.1  0.1  0.2  0.4
!
subroutine read_emivert_dent (input_id,var,emi,dz8w,zmin,zmax,dent,mype          &
                ,GLAT,GLON                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )

implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id,IDS,IDE,JDS,JDE,LM      &
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype

      real, intent(in) :: zmin
      real, intent(in) :: zmax
      real, dimension(1:4), intent(in) :: dent
      real, dimension( ITS:ITE,JTS:JTE),intent(in) :: GLAT,GLON
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme),intent(inout) :: emi

      REAL, DIMENSION( ITS:ITE,1:LM,JTS:JTE) :: dz8w

      CHARACTER (len = *), intent(in) :: var
! LOCAL-----------
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: real_2d

      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: temp1

      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp2

      integer :: ncid_in, i,j,k,kk,stat,kflip

      real :: dztot
      real :: dzbot
      real, dimension(1:LM) :: femi
!----------

        real_2d=0.
        temp1=0.
        temp2=0.

!        call read_bbforest(input_id,'CO',E_CO,dz8w,IMS,IME,JMS,JME,LM)
        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_2d,start=(/1,1,1/),count=(/ide-3,jde-4,1/))
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          call padh_nc(real_2d,temp1,ids,ide,jds,jde)
        endif
        call dstrb(temp1,temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
! distribute emissions vertically
        do j=jts,jte
        do i=its,ite
         if(temp2(i,j,LM).gt.0)then
          k=lm
          kflip=LM-k+1
          dzbot=0.
          femi(:)=0.
          dztot=dz8w(i,kflip,j)
          do while(dzbot.lt.zmax)
            if (min(dztot,zmax)-max(dzbot,zmin).gt.0.)then
              femi(k)=(min(dztot,zmax)-max(dzbot,zmin))/(zmax-zmin)
              !femi -> fractional contribution of gridcell to vertically distributed emissions
            endif
            dzbot=dztot
            dztot=dztot+dz8w(i,kflip,j)
            k=k-1
            kflip=kflip+1
          enddo
          do kk=lm,k,-1
            if (GLAT(i,j)*180./3.14159.le.30.0.and.GLAT(i,j)*180./3.14159.gt.-30.0)then
              emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)*dent(1)
            elseif ((GLAT(i,j)*180./3.14159.le.60.0.and.GLAT(i,j)*180./3.14159.gt.30.0).or. &
                    (GLAT(i,j)*180./3.14159.ge.-60.0.and.GLAT(i,j)*180./3.14159.lt.-30.0))then
              emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)*dent(2)
            elseif (GLAT(i,j)*180./3.14159.gt.60.0)then
              if (GLON(I,J)*180./3.14159.gt.-43.0.or.GLON(I,J)*180./3.14159.lt.-170.0)then
                emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)*dent(3) !EurAsia           
              else
                emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk)*dent(4) !Canada
              endif
            elseif (GLAT(i,j)*180./3.14159.lt.-60.0)then
                emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)*femi(kk) ! no deberia pasar!
                write(*,*) 'dentener emissions problem!'
            endif
          enddo
         endif
        enddo
        enddo

end subroutine read_emivert_dent
!---------------------------------------------------------------------
subroutine read_climdz (input_id,var,dzclim,mype                       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE,START_HOUR,TCHEM)
implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id,IDS,IDE,JDS,JDE,LM      &
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype

      REAL, DIMENSION( IMS:IME, JMS:JME, 1:64),intent(out) :: dzclim

      CHARACTER (len = *), intent(in) :: var

      INTEGER, intent(in) :: START_HOUR
      REAL, intent(in) :: TCHEM

! LOCAL-----------

      REAL, DIMENSION ( 1:25 ) :: real_1d

      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: real_3d

      REAL, DIMENSION( IDS:IDE,JDS:JDE, 1:64 ) :: temp1

      REAL, DIMENSION( IMS:IME, JMS:JME, 1:64 ) :: temp2

      integer :: ncid_in, i,j,k,kk,kemi,stat,kflip,IRTN

      real :: dztot,dzdilution

      logical :: have_emi

      real :: CURRENT_HOUR, HOUR_CLIM 



        CURRENT_HOUR=MOD(TCHEM/3600.,24.)
        HOUR_CLIM=MOD(TCHEM/3600./3.,8.)+1
        if(mype==0)then
        write(*,*) 'current_hour, hour_clim, tchem = ',CURRENT_HOUR,HOUR_CLIM,TCHEM 
        write(*,*) 'int(hour_clim)',int(HOUR_CLIM)
        endif
!----------
! Dilution factor of aircraft emissions of [mol/h/km3]/dz8w*dzdilution = [ppmv]. 
! We suppose that aircraft emission is produced within dzdilution [m] vertically.

        dzdilution = 1. !10. ! units [m] idem like dz8w [m]

! Read file from ncdf
        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          do k=1,64
          stat=nf90_get_var(input_id,ncid_in,real_3d,start=(/1,1,k,int(HOUR_CLIM)/),count=(/ide-3,jde-4,k,int(HOUR_CLIM)/))
             call padh_nc(real_3d,temp1(:,:,k),ids,ide,jds,jde)
          enddo
        endif

        do k=1,64
          call dstrb(temp1(:,:,k),temp2,1,1,1,64,k,mype,mpi_comm_comp)
        enddo

        do j=jts,jte
        do i=its,ite
            k=LM
        do k=1,64
           dzclim(i,j,k)=temp2(i,j,k)
        enddo
        enddo
        enddo

end subroutine read_climdz
!---------------------------------------------------------------------
subroutine read_climalba (FILENAME,var,clim,dz8w,mype                     &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE,START_HOUR,TCHEM,DZ_CLIM)
implicit none

include 'netcdf.inc'

      integer, intent(in) :: IDS,IDE,JDS,JDE,LM      &
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype

      REAL, DIMENSION( IMS:IME, JMS:JME, 1:LM),intent(out) :: clim

      REAL, DIMENSION( IMS:IME, JMS:JME, 1:64),intent(in) :: dz_clim

      REAL, DIMENSION(ITS:ITE,1:LM,JTS:JTE) :: dz8w

      CHARACTER (len = *), intent(in) :: var,FILENAME

      INTEGER, intent(in) :: START_HOUR
      REAL, intent(in) :: TCHEM

! LOCAL-----------

      REAL, DIMENSION ( 1:25 ) :: real_1d

      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4,1:64 ) :: real_3d

      REAL, DIMENSION( IDS:IDE,JDS:JDE, 1:64 ) :: temp1

      REAL, DIMENSION( IMS:IME, JMS:JME, 1:64 ) :: temp2

      integer :: ncid_in, i,j,k,kk,kemi,stat,kflip,IRTN,input_id

      real :: dztot,dzdilution

      logical :: have_emi

      real :: CURRENT_HOUR, HOUR_CLIM 

      real :: zmin,zmax,dzbot
      real, dimension (1:LM) :: femi
      integer :: kclim

      CHARACTER*120 :: message
!
        CURRENT_HOUR=MOD(TCHEM/3600.,24.)
        HOUR_CLIM=MOD(TCHEM/3600./3.,8.)+1
        write(*,*) 'current_hour, hour_clim, tchem = ',CURRENT_HOUR,HOUR_CLIM,TCHEM 
        write(*,*) 'int(hour_clim)',int(HOUR_CLIM)
!----------
! Dilution factor of aircraft emissions of [mol/h/km3]/dz8w*dzdilution = [ppmv]. 
! We suppose that aircraft emission is produced within dzdilution [m] vertically.

        dzdilution = 1. !10. ! units [m] idem like dz8w [m]

! Read file from ncdf
        if(mype==0) then
           STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
           message='opening '//var//' clim ncfile'
           call check_stat(stat,message)
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_3d,start=(/1,1,1,int(HOUR_CLIM)/),count=(/ide-3,jde-4,64,int(HOUR_CLIM)/))
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          do k=1,64
             call padh_nc(real_3d(:,:,k),temp1(:,:,k),ids,ide,jds,jde)
          enddo
          stat=nf90_close(input_id)
        endif

        do k=1,64
          call dstrb(temp1(:,:,k),temp2,1,1,1,64,k,mype,mpi_comm_comp)
        enddo

        do j=jts,jte
        do i=its,ite

        do k=1,24
           clim(i,j,k)=temp2(i,j,k)
        enddo

        enddo
        enddo
!!!!!!!!!!!!!!!
!averages
!     do j=jts,jte
!     do i=its,ite
!
!      zmin=0.
!      zmax=0.
!      do kclim=64,1,-1
!
!          zmin=zmax
!          zmax=zmax+DZ_CLIM(i,j,kclim)
!
!          k=lm
!          kflip=LM-k+1
!          dzbot=0.
!          femi(:)=0.
!          dztot=dz8w(i,kflip,j)
!          do while(dzbot.lt.zmax)
!            if (min(dztot,zmax)-max(dzbot,zmin).gt.0.)then
!              femi(k)=(min(dztot,zmax)-max(dzbot,zmin))/dz8w(i,kflip,j)
!            endif
!            dzbot=dztot
!            dztot=dztot+dz8w(i,kflip,j)
!            k=k-1
!            kflip=kflip+1
!          enddo
!          do kk=lm,k,-1
!            clim(i,j,kk)=clim(i,j,kk)+temp2(i,j,kclim)*femi(kk)
!          enddo
!
!      enddo !kclim
!
!     enddo
!     enddo
!     write(*,*) 'debug',clim(its,jts,24),clim(its,jts,1)
!!!!!!!!!!!!!!!

      return

end subroutine read_climalba
!---------------------------------------------------------------------
subroutine read_emiair (input_id2,var,emi,dz8w,mype                     &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id2,IDS,IDE,JDS,JDE,LM      &
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme),intent(inout) :: emi

      REAL, DIMENSION(ITS:ITE,1:LM,JTS:JTE) :: dz8w

      CHARACTER (len = *), intent(in) :: var
! LOCAL-----------

      REAL, DIMENSION ( 1:25 ) :: real_1d

      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4,1:25 ) :: real_3d

      REAL, DIMENSION( IDS:IDE,JDS:JDE, 1:25 ) :: temp1

      REAL, DIMENSION( IMS:IME, JMS:JME, 1:25 ) :: temp2

      integer :: ncid_in, i,j,k,kk,kemi,stat,kflip,IRTN

      integer :: ak
      real :: dzbot,zmin,zmax
      real, dimension(1:LM) :: femi

      real :: dztot,dzdilution

      logical :: have_emi

!----------

! Dilution factor of aircraft emissions of [mol/h/km3]/dz8w*dzdilution = [ppmv]. 
! We suppose that aircraft emission is produced within dzdilution [m] vertically.

        dzdilution = 1. !10. ! units [m] idem like dz8w [m]

! Read file from ncdf
        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id2,trim(var),ncid_in)
          stat=nf90_get_var(input_id2,ncid_in,real_3d,start=(/1,1,1,1/),count=(/ide-3,jde-4,25,1/))
          stat=nf90_inq_varid(input_id2,'lev',ncid_in)
          stat=nf90_get_var(input_id2,ncid_in,real_1d,start=(/1/),count=(/25/))
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          do ak=1,25
             call padh_nc(real_3d(:,:,k),temp1(:,:,ak),ids,ide,jds,jde)
          enddo
        endif
! Distribute real_1d from mype=0 among all processes       
        CALL MPI_BCAST(real_1d,SIZE(real_1d),MPI_REAL,0,MPI_COMM_COMP,IRTN)

        do ak=1,25
          call dstrb(temp1(:,:,ak),temp2,1,1,1,25,ak,mype,mpi_comm_comp)
        enddo

        do j=jts,jte
        do i=its,ite
          do ak=1,25
            if(temp2(i,j,ak).gt.0)then 
              write(*,*) 'qui!'
              zmin=(ak-1)*610.
              zmax=ak*610.

          k=lm
          kflip=LM-k+1
          dzbot=0.
          femi(:)=0.
          dztot=dz8w(i,kflip,j)
          do while(dzbot.lt.zmax)
            k=k-1
            kflip=kflip+1
            if (min(dztot,zmax)-max(dzbot,zmin).gt.0.)then
              femi(k)=(min(dztot,zmax)-max(dzbot,zmin))/(zmax-zmin)
            endif
            dzbot=dztot
            dztot=dztot+dz8w(i,kflip,j)
          enddo
          do kk=lm,k,-1
            emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,ak)*femi(kk)*(zmax-zmin)
            if (sum(femi).lt.0.995.or.sum(femi).gt.1.005)then
              write(*,*) 'error, sum(femi) = ',sum(femi) !debug
            endif
          enddo
             endif
          enddo !ak
        enddo !i
        enddo !j

end subroutine read_emiair
!---------------------------------------------------------------------
subroutine read_emivert_bb (input_id,var,emi,dz8w,zmax,fred,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )

implicit none

include 'netcdf.inc'

      integer, intent(in) :: input_id,IDS,IDE,JDS,JDE,LM      &
                ,IMS,IME,JMS,JME,KMS,KME          &
                ,ITS,ITE,JTS,JTE,mype

      real, intent(in) :: zmax,fred

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme),intent(inout) :: emi

      REAL, DIMENSION( ITS:ITE,1:LM,JTS:JTE) :: dz8w

      CHARACTER (len = *), intent(in) :: var
! LOCAL-----------
      REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ) :: real_2d

      REAL, DIMENSION( IDS:IDE,JDS:JDE ) :: temp1

      REAL, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp2

      integer :: ncid_in, i,j,k,kk,stat,kflip

      real :: dztot
!----------

        real_2d=0.
        temp1=0.
        temp2=0.

        if(mype==0) then
! Extract field info
          stat=nf90_inq_varid(input_id,trim(var),ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_2d,start=(/1,1,1/),count=(/ide-3,jde-4,1/))
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          call padh_nc(real_2d,temp1,ids,ide,jds,jde)
        endif
        call dstrb(temp1,temp2,1,1,1,lm,lm,mype,mpi_comm_comp)
! distribute emissions vertically
        do j=jts,jte
        do i=its,ite
         if(temp2(i,j,LM).gt.0)then
          k=lm
          kflip=LM-k+1
          dztot=dz8w(i,kflip,j)
          do while(dztot.lt.zmax)
            k=k-1
            kflip=kflip+1
            dztot=dztot+dz8w(i,kflip,j)
          enddo
          do kk=lm,k,-1
            emi(i,j,kk)=emi(i,j,kk)+temp2(i,j,LM)/dztot*dz8w(i,LM-kk+1,j)/fred
          enddo
         endif
        enddo
        enddo

end subroutine read_emivert_bb
!---------------------------------------------------------------------
subroutine padh_nc(real_2d,temp1,ids,ide,jds,jde)
  implicit none
  integer,intent(in) :: ids,ide,jds,jde
  REAL, DIMENSION( IDS:IDE-3,JDS:JDE-4 ),intent(in) :: real_2d
  REAL, DIMENSION( IDS:IDE,JDS:JDE ),intent(inout) :: temp1

         temp1(2:ide-2,1)=real_2d(:,1)
         temp1(2:ide-2,2)=real_2d(:,1)

         temp1(2:ide-2,jde-1)=real_2d(:,jde-4)
         temp1(2:ide-2,jde)=real_2d(:,jde-4)

         temp1(2:ide-2,3:jde-2)=real_2d

         temp1(1,:)=temp1(2,:)

         temp1(ide,:)=temp1(ide-2,:)
         temp1(ide-1,:)=temp1(ide-2,:)

end subroutine padh_nc
!***********************************************************************
subroutine check_stat(stat,message)
  use netcdf
  implicit none
  include 'netcdf.inc'

  integer, intent(in)       :: stat
  character*100, intent(in) :: message

  if ( stat /= nf90_NoErr ) then
     print*, 'error in netcdf status while...'
     print*, TRIM(message)
     STOP
  endif

end subroutine check_stat
!-----------------------------------------------------------------------
subroutine READ_VINTERP_CLIMAT(name_gas,gas_file,dz_file,gas_conc,dz_height,timestep,IDS,IDE,JDS,JDE,IMS,IME,JMS,JME,ITS,ITE,JTS,JTE,LM,mype)
  use netcdf
  implicit none

  character(*),intent(in) :: name_gas,gas_file,dz_file
  REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM),INTENT(INOUT) :: gas_conc
  REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: dz_height
  integer,intent(in) :: timestep,mype
  integer,intent(in) :: IDS,IDE,JDS,JDE,IMS,IME,JMS,JME,ITS,ITE,JTS,JTE,LM
! LOCAL VARIABLES
  integer :: file_id,var_id,i,j,k,kflip,kclim,stat
  real :: dzbot,dztop,dcbot,dctop,pclim
  REAL*8, DIMENSION( IDS:IDE-3,JDS:JDE-4,1:64 ) :: real_3d
  REAL, DIMENSION( IDS:IDE,JDS:JDE,1:64 ) :: temp0
  REAL, DIMENSION( IMS:IME,JMS:JME,1:64 ) :: temp1,dzclim

! read gas climat
        IF (MYPE==0)THEN
           WRITE(0,*) 'READING CLIMATOLOGY : ',gas_file
           stat = nf90_open(trim(gas_file),nf90_nowrite,file_id)
           stat = nf90_inq_varid(file_id,trim(name_gas),var_id)
           do k=1,64
             stat = nf90_get_var(file_id,var_id,real_3d,start=(/ids,jds,k,timestep/),count=(/ide-3,jde-4,1,1/))
! move from real_3d to temp1 - include 90 and -90 lats and ghost cells
             call padh_nc(real(real_3d),temp0(:,:,k),ids,ide,jds,jde)
           enddo
           stat = nf90_close(file_id)
        ENDIF 

        do k=1,64
          call dstrb(temp0(:,:,k),temp1,1,1,1,64,k,mype,mpi_comm_comp)
        enddo
! read dz climat
        IF (MYPE==0)THEN
           WRITE(0,*) 'READING DZ : ',dz_file
           stat = nf90_open(trim(dz_file),nf90_nowrite,file_id)
           stat = nf90_inq_varid(file_id,trim('phot'),var_id)
           do k=1,64
             stat = nf90_get_var(file_id,var_id,real_3d,start=(/ids,jds,k,timestep/),count=(/ide-3,jde-4,1,1/))
! move from real_3d to temp1 - include 90 and -90 lats and ghost cells
             call padh_nc(real(real_3d),temp0(:,:,k),ids,ide,jds,jde)
           enddo
           stat = nf90_close(file_id)
        ENDIF

        do k=1,64
          call dstrb(temp0(:,:,k),dzclim,1,1,1,64,k,mype,mpi_comm_comp)
        enddo
!vertical interpolation (64->lm)
       do j=jds,jde
       do i=ids,ide
       if(i.ge.its.and.i.le.ite.and.j.ge.jts.and.j.le.jte)then
       dzbot=0.
       dztop=0.
!       gas_conc(i,j,lm)=temp1(i,j,64) ! surface layer
!       do k=lm-1,1,-1
       do k=lm,1,-1
          gas_conc(i,j,k)=0.
          kflip=lm-k+1
          dzbot=dztop
          dztop=dztop+dz_height(i,kflip,j)
          dcbot=0.
          dctop=0.
          do kclim=64,1,-1
             dcbot=dctop
             dctop=dctop+DZCLIM(i,j,kclim)
             pclim=min(dztop,dctop)-max(dzbot,dcbot)
             if(pclim.gt.0)then
               gas_conc(i,j,k)=gas_conc(i,j,k)+pclim/dz_height(i,kflip,j)*temp1(i,j,kclim)
             endif
          enddo !kclim
       enddo !k
       gas_conc(i,j,1)=gas_conc(i,j,2) ! top layer
       endif
       enddo
       enddo
!
end subroutine READ_VINTERP_CLIMAT
!-----------------------------------------------------------------------
!
      END MODULE MODULE_BSC_AERO_MECHANISM
!
!-----------------------------------------------------------------------
