! 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_CHEMISTRY_EMISSIONS
!
!-----------------------------------------------------------------------
!
!***  EMISSIONS MODULE FOR READ ROUTINES.
!
!-----------------------------------------------------------------------
! HISTORY LOG:
!
!   2012-05-14  Jorba - Creation of the module.
!
!-----------------------------------------------------------------------
!
      USE NETCDF

!      USE MODULE_INCLUDE

      USE MODULE_DM_PARALLEL, ONLY : MYPE_SHARE,MPI_COMM_COMP,DSTRB    &
                                    ,ITS_B1,ITE_B1,JTS_B1,JTE_B1
! FOR DEBUG AND COMPUTATION OF TOTAL EMISSIONS - DARE
!      USE MODULE_DYNAMICS_INTERNAL_STATE, ONLY : INTERNAL_STATE
!
      USE MODULE_BSC_CHEM_DATA
!
      USE MODULE_BSC_CHEMISTRY_EMISSION_AQMEII
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE READ_ACCMIP_EMISSIONS(                                &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY                      &
                ,E_XYL,E_HNO3,E_NO2                                    &
                ,E_CO,E_NO,E_OLE,E_SO2,E_TOL                           &
                ,E_ISOP,E_MEOH,E_ALD2,E_IOLE                           &
                ,E_FORM,E_ETHA,E_ETOH,E_ETH,E_TERP,E_PAR,E_ALDX        &
                ,E_NO2_AIR,E_NO_AIR                                    &
                ,DZ8W,Z_AT_W,AIRDENSITY,CHEM,NUM_GAS_TOTAL,rh_emi      &
                ,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) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,NTIMESTEP,NCHEM,NUM_GAS_TOTAL

      REAL, INTENT(IN) :: TCHEM,DTCHEM

      REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_XYL,E_HNO3,E_NO2                                        

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_CO, E_NO, E_OLE, E_SO2, E_TOL, E_ISOP, E_MEOH, E_ALD2,    &
           E_FORM, E_ETHA, E_ETOH, E_ETH, E_TERP, E_PAR, E_ALDX,       &
           E_IOLE,E_NO2_AIR,E_NO_AIR

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W,AIRDENSITY

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(INOUT) :: rh_emi

      REAL,DIMENSION(ITS:ITE,1:LM+1,JTS:JTE),INTENT(IN) :: Z_AT_W

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS_TOTAL) :: CHEM
!Temporal to read DARE from int_state_dyn
!      TYPE(INTERNAL_STATE),POINTER       :: INT_STATE                    !<-- The dynamics internal state

!
!----------------------------------------------------------------------
!***
!***  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

      real :: zmax,conv_rho,fred

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

      LOGICAL :: EMI_ANTHRO,EMI_BBFOREST,EMI_BBGRASS,EMI_OCEAN,EMI_SOIL &
                ,EMI_SHIPS,EMI_AIRCRAFT

      REAL :: TOTAL_EMI_RED

      REAL, SAVE :: TOTAL_EMI=0.
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!

      MYPE=MYPE_SHARE

!      rh_emi=0.

      EMI_ANTHRO=.TRUE.
      EMI_BBFOREST=.TRUE.
      EMI_BBGRASS=.TRUE.
      EMI_OCEAN=.TRUE.
      EMI_SOIL=.TRUE.
      EMI_SHIPS=.TRUE.
      EMI_AIRCRAFT=.TRUE. 

      IF(MYPE==0)THEN
        print *,'----------------------------------'
        print *,'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_SOIL     : ',EMI_SOIL
        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_SOIL_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 .OR. MOD(TCHEM,3600.0)==0.)THEN !FIRSTIME WE READ EMISSONS
      IF(NTIMESTEP==NCHEM) THEN !ONLY READ EMISSIONS AT FIRST TIMESTEP, THEN CONSTANT
! 1. READ ANTHRO EMISSIONS FROM EMI_ANTHRO_l_month01.nc - distribute vertically 100 m a.g.l.
       IF(EMI_ANTHRO) THEN
        FILENAME='EMI_ANTHRO_l_month01.nc'
        zmax=1300.  !100.   tornar a posar a 100.!!!

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

        call read_emivert (input_id,'ALDX',E_ALDX,dz8w,zmax,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        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)
        call read_emivert (input_id,'ETHA',E_ETHA,dz8w,zmax,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'ETH',E_ETH,dz8w,zmax,mype         &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'ETOH',E_ETOH,dz8w,zmax,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'FORM',E_FORM,dz8w,zmax,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'IOLE',E_IOLE,dz8w,zmax,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'NO',E_NO,dz8w,zmax,mype           &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'OLE',E_OLE,dz8w,zmax,mype         &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'PAR',E_PAR,dz8w,zmax,mype         &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'SO2',E_SO2,dz8w,zmax,mype         &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'TOL',E_TOL,dz8w,zmax,mype         &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'XYL',E_XYL,dz8w,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_id)
        endif
      ENDIF
! 2. READ BIOMASS BURNING FROM EMI_BBFOREST_l_month01.nc - distribute vertically within 1300 m a.g.l.
       IF(EMI_BBFOREST) THEN
        FILENAME='EMI_BBFOREST_l_month01.nc'
        zmax=1300.
        fred=2.  !reduce emission factor of fred to account for aerosol scattering of radiation
!Temporal - rh_emi for photolysis rate reduction
        rh_emi=0.
        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening EMI_BBFOREST_l_month01.nc ncfile'
          call check_stat(stat,message)
        endif
!Temporal - rh_emi
        call read_tmprh_emibb (input_id,'CO',rh_emi,dz8w,zmax,mype     &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )
!
        call read_emivert_bb (input_id,'CO',E_CO,dz8w,zmax,fred,mype   &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'ETHA',E_ETHA,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'ETH',E_ETH,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'ETOH',E_ETOH,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'FORM',E_FORM,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'IOLE',E_IOLE,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'ISOP',E_ISOP,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'NO2',E_NO2,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'NO',E_NO,dz8w,zmax,fred,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'OLE',E_OLE,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'PAR',E_PAR,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'SO2',E_SO2,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'TERP',E_TERP,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'TOL',E_TOL,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'XYL',E_XYL,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        if(mype==0)then
          stat=nf90_close(input_id)
        endif
      ENDIF
! 3. READ BIOMASS BURNING FROM EMI_BBGRASS_l_month01.nc - distribute vertically within 200 m a.g.l.
      IF(EMI_BBGRASS) THEN
        FILENAME='EMI_BBGRASS_l_month01.nc'                           
        zmax=200.
        fred=2. !reduction to account for aerosol scattering effect on radiation
 
        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)         
          message='opening EMI_BBGRASS_l_month01.nc ncfile'
          call check_stat(stat,message)
        endif   
!Temporal - rh_emi
        call read_tmprh_emibb (input_id,'CO',rh_emi,dz8w,zmax,mype     &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )
!!
        call read_emivert_bb (input_id,'CO',E_CO,dz8w,zmax,fred,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'ETHA',E_ETHA,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'ETH',E_ETH,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'ETOH',E_ETOH,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'FORM',E_FORM,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'IOLE',E_IOLE,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'ISOP',E_ISOP,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'NO2',E_NO2,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'NO',E_NO,dz8w,zmax,fred,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'OLE',E_OLE,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'PAR',E_PAR,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'SO2',E_SO2,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'TERP',E_TERP,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'TOL',E_TOL,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'XYL',E_XYL,dz8w,zmax,fred,mype        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        if(mype==0)then
          stat=nf90_close(input_id)
        endif
      ENDIF
! 4. READ OCEAN EMISSIONS FROM EMI_OCEAN_l_month01.nc - distribute vertically 30 m a.g.l.
      IF(EMI_OCEAN) THEN
        FILENAME='EMI_OCEAN_l_month01.nc'
        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)
        if(mype==0)then
          stat=nf90_close(input_id)
        endif
      ENDIF
! 5. DISTRIBUTE EMISSIONS FROM EMI_SOIL_l_month01.nc - distribute vertically 30 m a.g.l.
      IF(EMI_SOIL) THEN
        FILENAME='EMI_SOIL_l_month01.nc'
        zmax=30.

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening EMI_SOIL_l_month01.nc ncfile'
          call check_stat(stat,message)
        endif
        call read_emivert (input_id,'NO',E_NO,dz8w,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_id)
        endif
      ENDIF
! 6. DISTRIBUTE EMISSIONS FROM EMI_SHIPS_l_month01.nc - distribute vertically 500 m a.g.l.
      IF(EMI_SHIPS) THEN
        FILENAME='EMI_SHIPS_l_month01.nc'                               
        zmax=500.
                
        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)         
          message='opening EMI_SHIPS_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)
        call read_emivert (input_id,'ETHA',E_ETHA,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'ETH',E_ETH,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'IOLE',E_IOLE,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'NO',E_NO,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'OLE',E_OLE,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'PAR',E_PAR,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'SO2',E_SO2,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'TOL',E_TOL,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'XYL',E_XYL,dz8w,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_id)
        endif
      ENDIF
! 7. DISTRIBUTE EMISSIONS FROM EMI_AIRCRAFT_l_month01.nc
      IF(EMI_AIRCRAFT) THEN
        FILENAME='EMI_AIRCRAFT_l_month01.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening EMI_AIRCRAFT_l_month01.nc ncfile'
          call check_stat(stat,message)
        endif
        call read_emiair (input_id,'NO2',E_NO2_AIR,dz8w,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        var='NO'
        call read_emiair (input_id,var,E_NO_AIR,dz8w,mype            &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        if(mype==0)then
          stat=nf90_close(input_id)
        endif
       ENDIF
      ENDIF !NTIMESTEP==NCHEM


! 8. INGEST EMISSIONS IN THE ATMOSPHERE
! AIRDENSITY[kg/m3]; dtchem [s]; dz8w[m]
! E_... [mol/(h*km2)]; CONC[ppmv]
! CONC[ppmv]=E_...[mol/(h*km2)]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! 8.047e-6=PMair[kg/mol]/3600[s]=0.02897/3600
! conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)

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

        do k=kme,kms,-1  !LM to 1
        kflip=LM-k+1
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
        conv_rho=8.047e-6/AIRDENSITY(i,kflip,j)*dtchem

        chem(i,j,k,P_ALDX)  =  chem(i,j,k,P_ALDX)                          &
                         + E_ALDX(i,j,k)*conv_rho
        chem(i,j,k,P_CO)  =  chem(i,j,k,P_CO)                          &
                         + E_CO(i,j,k)*conv_rho
        chem(i,j,k,P_ETHA)  =  chem(i,j,k,P_ETHA)                          &
                         + E_ETHA(i,j,k)*conv_rho
        chem(i,j,k,P_ETH)  =  chem(i,j,k,P_ETH)                          &
                         + E_ETH(i,j,k)*conv_rho
        chem(i,j,k,P_ETOH)  =  chem(i,j,k,P_ETOH)                          &
                         + E_ETOH(i,j,k)*conv_rho
        chem(i,j,k,P_FORM)  =  chem(i,j,k,P_FORM)                          &
                         + E_FORM(i,j,k)*conv_rho
        chem(i,j,k,P_IOLE)  =  chem(i,j,k,P_IOLE)                          &
                         + E_IOLE(i,j,k)*conv_rho
        chem(i,j,k,P_NO)  =  chem(i,j,k,P_NO)                          &
                         + E_NO(i,j,k)*conv_rho
        chem(i,j,k,P_OLE)  =  chem(i,j,k,P_OLE)                          &
                         + E_OLE(i,j,k)*conv_rho
        chem(i,j,k,P_PAR)  =  chem(i,j,k,P_PAR)                          &
                         + E_PAR(i,j,k)*conv_rho
        chem(i,j,k,P_SO2)  =  chem(i,j,k,P_SO2)                          &
                         + E_SO2(i,j,k)*conv_rho
        chem(i,j,k,P_TOL)  =  chem(i,j,k,P_TOL)                          &
                         + E_TOL(i,j,k)*conv_rho
        chem(i,j,k,P_XYL)  =  chem(i,j,k,P_XYL)                          &
                         + E_XYL(i,j,k)*conv_rho
        chem(i,j,k,P_ISOP)  =  chem(i,j,k,P_ISOP)                          &
                         + E_ISOP(i,j,k)*conv_rho
        chem(i,j,k,P_TERP)  =  chem(i,j,k,P_TERP)                          &
                         + E_TERP(i,j,k)*conv_rho

        IF(EMI_AIRCRAFT) THEN
          chem(i,j,k,P_NO2)  =  chem(i,j,k,P_NO2)                          &
                         + E_NO2_AIR(i,j,k)*conv_rho/1000.
          chem(i,j,k,P_NO)   =  chem(i,j,k,P_NO)                          &
                         + E_NO_AIR(i,j,k)*conv_rho/1000.

          TOTAL_EMI = TOTAL_EMI + E_NO_AIR(i,j,k)*DARE(j)*dz8w(i,kflip,j)*dtchem/3600.*1e-9  ! E_NO_AIR [mol_NO/h km3]

        ENDIF
! FOR DEBUG AND TOTAL EMISSION COMPUTATION
!        TOTAL_EMI = TOTAL_EMI + E_NO(i,j,k)*DARE(j)*dz8w(i,k,j)*dtchem/3600.*1e-9 ! [mol_NOgas]
        TOTAL_EMI = TOTAL_EMI + E_CO(i,j,k)*DARE(j)*dz8w(i,kflip,j)*dtchem/3600.*1e-6 ! [mol_COgas] E_CO[mol/h km2 m] pel tema del dz[m]

        enddo
 
      enddo
      enddo

!      TOTAL_EMI_RED=0.

!     CALL MPI_ALLREDUCE(TOTAL_EMI,TOTAL_EMI_RED,1,mpi_real                &
!                        ,mpi_sum,mpi_comm_comp,irecv)    

!      TOTAL_EMI_RED=TOTAL_EMI_RED*30.*1e-12 !30 g/mol_NO  units [Tg]
!      TOTAL_EMI_RED=TOTAL_EMI_RED*28.01*1e-12 !28.01 g/mol_CO  units [Tg]

!      IF(MYPE==0) PRINT *,'TOTAL_EMI AT ',TCHEM/3600.,' hour :', TOTAL_EMI_RED,' Tg' !30 g/mol_NO

!                          
!-----------------------------------------------------------------------
!                          
      RETURN               
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_ACCMIP_EMISSIONS
!                          
!***********************************************************************
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 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 read_emivert (input_id,var,emi,dz8w,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) :: 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_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
          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
          enddo
         endif
        enddo
        enddo

end subroutine read_emivert
!---------------------------------------------------------------------
subroutine read_emiair (input_id,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_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 ( 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

      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_id,trim(var),ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_3d,start=(/1,1,1,1/),count=(/ide-3,jde-4,25,1/))
          stat=nf90_inq_varid(input_id,'lev',ncid_in)
          stat=nf90_get_var(input_id,ncid_in,real_1d,start=(/1/),count=(/25/))
! move from real_2d to temp1 - include 90 and -90 lats and ghost cells
          do k=1,25
             call padh_nc(real_3d(:,:,k),temp1(:,:,k),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 k=1,25
          call dstrb(temp1(:,:,k),temp2,1,1,1,25,k,mype,mpi_comm_comp)
        enddo         

        do j=jts,jte
        do i=its,ite
           have_emi=.FALSE.
          do k=1,25
            if(temp2(i,j,k).gt.0) have_emi=.true.
          enddo
          if(have_emi)then
            k=LM
            kflip=LM-k+1
            kemi=1
            dztot=dz8w(i,kflip,j)
            do while(kemi.le.25)
              do while(dztot.lt.(real_1d(kemi)*1000.))
                k=k-1
                kflip=kflip+1
                dztot=dztot+dz8w(i,kflip,j)
              enddo
              emi(i,j,k)=emi(i,j,k)+temp2(i,j,kemi)/4.4 !/dz8w(i,kflip,j)*dzdilution
              kemi=kemi+1
            enddo
          endif
        enddo
        enddo

end subroutine read_emiair

!---------------------------------------------------------------------
subroutine read_tmprh_emibb (input_id,var,rh,dz8w,zmax,mype            &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )
! Temporal routine to include effect of biomass burning smoke in photolysis calculations
! Assume smoke cloud as water cloud, thus, define relative humidity to 80% where there are BB emissions
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

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

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

      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.

!        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
           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=1,kflip !lm,k,-1
             k=LM-kk+1
!             if(temp2(i,j,lm).gt.0)then
               rh(i,kk,j)=min(1.,rh(i,kk,j)+0.9)
!             endif
           enddo
         endif
        enddo
        enddo

end subroutine read_tmprh_emibb
!---------------------------------------------------------------------
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.

!        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
          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/fred
          enddo
         endif
        enddo
        enddo

end subroutine read_emivert_bb
!---------------------------------------------------------------------

!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE READ_AQMEII_PHASE2_EMISSIONS(                         &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
!NEW_EMISS=3
                ,E_CO,E_NO2,E_NO,E_SO2,E_PAR,E_OLE,E_TOL,E_XYL,E_FORM  &
                ,E_ETH,E_ISOP,E_MEOH,E_ETHA,E_TERP                     &
!NH3
                ,E_NH3,E_BC,E_OM                                        &
!
                ,XLONG,Z_AT_W,FIS,AIRDENSITY,DZ8W                      &
                ,CHEM,NUM_GAS                                          &
!                ,DZ8W,Z_AT_W,AIRDENSITY,CHEM,NUM_GAS_TOTAL             &
!                ,DARE                                                  &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  READ EMISSIONS FROM AQMEII-P2 DATABASE FOR REGIONAL EU RUNS
!              EMISSIONS FROM TNO
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 11-02-13
!
! ABSTRACT:
!     READ EMISSIONS FROM AQMEII-P2 DATABASE FOR REGIONAL RUNS  
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   11-02-13  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) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,START_HOUR                                 &
                           ,NTIMESTEP,NCHEM,NUM_GAS

      REAL, INTENT(IN) :: TCHEM,DTCHEM
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS) :: CHEM
!      REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_CO, E_NO2, E_NO, E_SO2,E_PAR, E_OLE, E_TOL, E_XYL,E_FORM, &
           E_ETH, E_ISOP, E_MEOH, E_ETHA, E_TERP, E_NH3, E_BC, E_OM

!      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W,AIRDENSITY

      REAL,DIMENSION(ITS:ITE,1:LM+1,JTS:JTE),INTENT(IN) :: Z_AT_W
!
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS
!
     REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: XLONG 
!
     REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: AIRDENSITY,DZ8W
!
!      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS_TOTAL) :: CHEM
!Temporal to read DARE from int_state_dyn
!      TYPE(INTERNAL_STATE),POINTER       :: INT_STATE                    !<-- The dynamics internal state

!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      integer :: mype,i,j,k,l,ncid,stat,kflip
!
      INTEGER, PARAMETER :: NSNAP=13, SPECS=29, SPEC_CB05=16 !INCLUDE NH3

      REAL :: check_in,check_in_in,check_out,conv_rho

      INTEGER :: p,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR 
     
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM) :: vdfact

!      REAL, DIMENSION( IDS:IDE,JDS:JDE,NSNAP,SPECS) :: tno_annual
!      REAL, DIMENSION( IMS:IME,JMS:JME,NSNAP,SPECS) :: emis_ant
!      REAL, DIMENSION( IDS:IDE,JDS:JDE,NSNAP,SPECS) :: emis_read
      REAL, ALLOCATABLE,DIMENSION(:,:,:,:) :: emis_read
!
      REAL, ALLOCATABLE,DIMENSION(:,:,:) :: temp1
!
      REAL, ALLOCATABLE,DIMENSION(:,:,:,:) :: emission_ant
!
      REAL, ALLOCATABLE,DIMENSION(:,:,:,:) :: emi_tot
!
      REAL, ALLOCATABLE,DIMENSION(:,:,:,:) :: emi_cb05

!
!      LOGICAL, SAVE :: FIRSTIME=.TRUE.
!   
      REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:,:) :: emis_ant


!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!

      MYPE=MYPE_SHARE

!      IF(FIRSTIME)THEN
!        ALLOCATE(emis_ant(IMS:IME,JMS:JME,NSNAP,SPECS))
!        FIRSTIME=.FALSE.
!      ENDIF
! *** FIRST STEP AND HOURLY ONLY
! 1. READ NETCDF WITH AQMEII ANNUAL EMISSION PER SNAP SECTOR (NETCDF) FROM AQMEII
! 2. TIME SPLIT FROM ANNUAL TO HOURLY EMISSION
! 3. VERTICAL DISTRIBUTION
! 4. UNITS CONVERSION FROM [Tg/km2*h] to [mol/km2*h]
! 5. NMVOC CHEMICAL SPECIATION CBM05
! *** ALL STEPS
! 6. INGEST EMISSIONS IN THE ATMOSPHERE
      


      IF(NTIMESTEP==NCHEM .OR. MOD(TCHEM,3600.0)==0.)THEN !FIRSTIME WE READ EMISSONS
!      IF(NTIMESTEP==NCHEM) THEN !ONLY READ EMISSIONS AT FIRST TIMESTEP, THEN CONSTANT
      ALLOCATE(emis_ant(IMS:IME,JMS:JME,NSNAP,SPECS))
      ALLOCATE(emis_read(IDS:IDE,JDS:JDE,NSNAP,SPECS))
      ALLOCATE(temp1(IMS:IME,JMS:JME,NSNAP))
      ALLOCATE(emission_ant(IMS:IME,JMS:JME,NSNAP,SPECS))
      ALLOCATE(emi_tot(IMS:IME,JMS:JME,LM,SPECS))
      ALLOCATE(emi_cb05(IMS:IME,JMS:JME,LM,SPEC_CB05))

! *** FIRST STEP ONLY *** !
! 1. READ NETCDF WITH AQMEII ANNUAL EMISSIONS 
      IF(MYPE==0)THEN
      PRINT *,'1. READ TNO EMISSIONS INPUT DATA',NTIMESTEP,'=NTIMESTEP'
      CALL READ_NC(emis_read,IDE-2,JDE-2,NSNAP,SPECS) !emis_ant(itotal,jtotal,snap,gas)                        
      ENDIF
!input_array=emis_read(ids:ide,jds:jde,...
!output_array=emis_ant(ims:ime,jms:jme,...
      do k=1,SPECS
         do l=1,NSNAP
!      IF(MYPE==0) THEN
!       PRINT *,'IN DSTRB:',k,l,NTIMESTEP,'=NTIMESTEP'
!      ENDIF
           call dstrb(emis_read(:,:,l,k),temp1,1,1,1,NSNAP,l,mype,mpi_comm_comp)
           emis_ant(:,:,l,k)=temp1(:,:,l)
         enddo
       enddo
      
      DEALLOCATE(emis_read,temp1)

! 2. TIME SPLIT FROM ANNUAL TO HOURLY EMISSION
      CALL CURRENT_TIME(NTIMESTEP,START_YEAR,START_MONTH,START_DAY,START_HOUR,TCHEM,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR)

      IF(MYPE==0) THEN
       PRINT *,'2. TNO TIME SPLIT:','NTIMESTEP=',NTIMESTEP,'TCHEM=',TCHEM
       PRINT *,'ST_YEAR=',START_YEAR,' ST_MONTH=',START_MONTH,' ST_DAY=',START_DAY,'ST_HOUR=',START_HOUR
       PRINT *,'CU_YEAR=',CU_YEAR,' CU_MONTH=',CU_MONTH,' CU_DAY=',CU_DAY,'CU_HOUR=',CU_HOUR
      ENDIF

      CALL time_split ( emis_ant,  emission_ant, XLONG                  &
                       ,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR                 &
                       ,IMS,IME,JMS,JME                                 &
                       ,ITS,ITE,JTS,JTE ) !input: emis_ant, output: emission_ant Units: Mg/km2*ĥour

! 3. VERTICAL DISTRIBUTION
      emi_tot=0.
!     !--- Apply vertical emission distribution and create total emissions
      DO l = 1, num_tno_ant   ! Here we sum all SNAPS , so one dimension less!! 

!!         CALL em_vert_dist(l, nlon, nlat, nlev, height, vdfact,0)
         CALL em_vert_dist(l,LM,Z_AT_W,FIS,vdfact,0                     &
                       ,IMS,IME,JMS,JME                                 &
                       ,ITS,ITE,JTS,JTE )

         DO k = 1,LM !1, nlev
           DO j = JTS,JTE !1, nlat
             DO i = ITS,ITE !1, nlon
               DO p=1, 4  ! 
   emi_tot(i,j,k,p)=emi_tot(i,j,k,p)+emission_ant(i,j,l,p)*vdfact(i,j,k)
               END DO
             END DO
           END DO
         END DO

!!! FOr NMVOCs different vertical desegragation

!!     CALL em_vert_dist(l, nlon, nlat, nlev, height, vdfact,1)
         CALL em_vert_dist(l,LM,Z_AT_W,FIS,vdfact,1                     &
                       ,IMS,IME,JMS,JME                                 &
                       ,ITS,ITE,JTS,JTE )


       DO k = 1,LM !1, nlev
           DO j = JTS,JTE !1, nlat
             DO i = ITS,ITE !1, nlon
               DO p=5, spec_tno_ant !!! FOR NVOCS
   emi_tot(i,j,k,p)=emi_tot(i,j,k,p)+emission_ant(i,j,l,p)*vdfact(i,j,k)
               END DO
                p=spec_tno_ant  !NH3 
               emi_tot (i,j,k,p)  = emi_tot (i,j,k,p) + emission_ant (i,j,l,p) *vdfact(i,j,k)
             END DO
           END DO
       END DO

      END DO !l=1,num_tno_ant

      IF(MYPE==0)THEN
      print*,'done vertical distribution 1'
      ENDIF

! 4. CONVERT TO CB05 SPECIES

!! CALL convert_tno_cb05(emi_tot,emi_cb05)
      CALL convert_tno_cb05(emi_tot,emi_cb05                            &
                       ,IMS,IME,JMS,JME,LM                              &
                       ,ITS,ITE,JTS,JTE )

      IF(MYPE==0)THEN
       print*,'4. CONVERT TNO CB05'
      ENDIF

!FOR DEBUG
      IF(MYPE==0) THEN
       PRINT *,'FOR DEBUG OUTPUT TNO EMISSIONS',NTIMESTEP,'=NTIMESTEP'
       PRINT *,emi_cb05(ITE,JTE,:,1)
      ENDIF

! 5. FROM emi_cb05 to E_CO, E_NO, E_NO2, ....

      DO k=1,LM
        kflip=LM-k+1
        E_CO  (:,:,kflip)    = emi_cb05(:,:,k,1) !CO
        E_NO2 (:,:,kflip)    = emi_cb05(:,:,k,2) !NO2
        E_NO  (:,:,kflip)    = emi_cb05(:,:,k,3) !NO
        E_SO2 (:,:,kflip)    = emi_cb05(:,:,k,4) !SO2
        E_PAR (:,:,kflip)    = emi_cb05(:,:,k,5) !PAR
        E_OLE (:,:,kflip)    = emi_cb05(:,:,k,6) !OLE
        E_TOL (:,:,kflip)    = emi_cb05(:,:,k,7) !TOL
        E_XYL (:,:,kflip)    = emi_cb05(:,:,k,8) !XYL
        E_FORM(:,:,kflip)    = emi_cb05(:,:,k,9) !FORM
        E_ETH (:,:,kflip)    = emi_cb05(:,:,k,10)!ETH
!        E_ISOP(:,:,kflip)   = emi_cb05(:,:,k,11)!ISOP
        E_MEOH(:,:,kflip)    = emi_cb05(:,:,k,12)!MEOH
                                           !13 !NR
        E_ETHA(:,:,kflip)    = emi_cb05(:,:,k,14)!ETHA
!        E_TERP(:,:,kflip)  = emi_cb05(:,:,k,15)!TERP
        E_NH3(:,:,kflip)     = emi_cb05 (:,:,k,spec_cb05) !NH3
      ENDDO

!FOR DEBUG
      IF(MYPE==0) THEN
       PRINT *,'EMI ARRAYS READY E_CO E_NO E_NO2 ...',NTIMESTEP
      ENDIF
!
      DEALLOCATE(emis_ant,emission_ant,emi_tot,emi_cb05)
!
      ENDIF !NTIMESTEP==NCHEM


! 6. INGEST EMISSIONS IN THE ATMOSPHERE
! AIRDENSITY[kg/m3]; dtchem [s]; dz8w[m]
! E_... [mol/(h*km2)]; CONC[ppmv]
! CONC[ppmv]=E_...[mol/(h*km2)]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! 8.047e-6=PMair[kg/mol]/3600[s]=0.02897/3600
! conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)

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

        do k=LM,1,-1  !LM to 1
        kflip=LM-k+1
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
      conv_rho=8.047e-6/AIRDENSITY(i,kflip,j)*dtchem/dz8w(i,kflip,j)*CONVEMI

        chem(i,j,k,P_CO)  =  chem(i,j,k,P_CO)                           &
                         + E_CO(i,j,k)*conv_rho 
        chem(i,j,k,P_NO2) =  chem(i,j,k,P_NO2)                          &
                         + E_NO2(i,j,k)*conv_rho
        chem(i,j,k,P_NO)  =  chem(i,j,k,P_NO)                           &
                         + E_NO(i,j,k)*conv_rho
        chem(i,j,k,P_SO2)  =  chem(i,j,k,P_SO2)                         &
                         + E_SO2(i,j,k)*conv_rho
        chem(i,j,k,P_PAR)  =  chem(i,j,k,P_PAR)                         &
                         + E_PAR(i,j,k)*conv_rho
        chem(i,j,k,P_OLE)  =  chem(i,j,k,P_OLE)                         &
                         + E_OLE(i,j,k)*conv_rho
        chem(i,j,k,P_TOL)  =  chem(i,j,k,P_TOL)                         &
                         + E_TOL(i,j,k)*conv_rho
        chem(i,j,k,P_XYL)  =  chem(i,j,k,P_XYL)                         &
                         + E_XYL(i,j,k)*conv_rho
        chem(i,j,k,P_FORM)  =  chem(i,j,k,P_FORM)                       &
                         + E_FORM(i,j,k)*conv_rho
        chem(i,j,k,P_ETH)  =  chem(i,j,k,P_ETH)                         &
                         + E_ETH(i,j,k)*conv_rho
        chem(i,j,k,P_MEOH)  =  chem(i,j,k,P_MEOH)                       &
                         + E_MEOH(i,j,k)*conv_rho
        chem(i,j,k,P_ETHA)  =  chem(i,j,k,P_ETHA)                       &
                         + E_ETHA(i,j,k)*conv_rho

        enddo
      enddo
      enddo

!                          
!-----------------------------------------------------------------------
!                          
      RETURN               
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_AQMEII_PHASE2_EMISSIONS
!                          
!***********************************************************************
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE READ_AQMEII_PHASE3_EMISSIONS(                         &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
!NEW_EMISS=3
                ,E_CO,E_NO2,E_NO,E_SO2,E_PAR,E_OLE,E_TOL,E_XYL,E_FORM  &
                ,E_ETH,E_ISOP,E_MEOH,E_ETHA,E_TERP                     &
!NH3
                ,E_NH3,E_BC,E_OM                                        &
!
                ,XLONG,Z_AT_W,FIS,AIRDENSITY,DZ8W                      &
                ,CHEM,NUM_GAS                                          &
!                ,DZ8W,Z_AT_W,AIRDENSITY,CHEM,NUM_GAS_TOTAL             &
!                ,DARE                                                  &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  READ EMISSIONS FROM AQMEII-P2 DATABASE FOR REGIONAL EU RUNS
!              EMISSIONS FROM TNO
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 11-02-13
!
! ABSTRACT:
!     READ EMISSIONS FROM AQMEII-P2 DATABASE FOR REGIONAL RUNS  
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   11-02-13  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) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,START_HOUR                                 &
                           ,NTIMESTEP,NCHEM,NUM_GAS

      REAL, INTENT(IN) :: TCHEM,DTCHEM
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS) :: CHEM
!      REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_CO, E_NO2, E_NO, E_SO2,E_PAR, E_OLE, E_TOL, E_XYL,E_FORM, &
           E_ETH, E_ISOP, E_MEOH, E_ETHA, E_TERP, E_NH3, E_BC, E_OM

!      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W,AIRDENSITY

      REAL,DIMENSION(ITS:ITE,1:LM+1,JTS:JTE),INTENT(IN) :: Z_AT_W
!
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS
!
     REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: XLONG 
!
     REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: AIRDENSITY,DZ8W
!
!      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS_TOTAL) :: CHEM
!Temporal to read DARE from int_state_dyn
!      TYPE(INTERNAL_STATE),POINTER       :: INT_STATE                    !<-- The dynamics internal state

!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      integer :: mype,i,j,k,l,ncid,stat,kflip
!
      INTEGER, PARAMETER :: NSNAP=13, SPECS=29, SPEC_CB05=16 !INCLUDE NH3

      REAL :: check_in,check_in_in,check_out,conv_rho

      INTEGER :: p,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR 
     
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM) :: vdfact

!      REAL, DIMENSION( IDS:IDE,JDS:JDE,NSNAP,SPECS) :: tno_annual
!      REAL, DIMENSION( IMS:IME,JMS:JME,NSNAP,SPECS) :: emis_ant
!      REAL, DIMENSION( IDS:IDE,JDS:JDE,NSNAP,SPECS) :: emis_read
      REAL, ALLOCATABLE,DIMENSION(:,:,:,:) :: emis_read
!
      REAL, ALLOCATABLE,DIMENSION(:,:,:) :: temp1
!
      REAL, ALLOCATABLE,DIMENSION(:,:,:,:) :: emission_ant
!
      REAL, ALLOCATABLE,DIMENSION(:,:,:,:) :: emi_tot
!
      REAL, ALLOCATABLE,DIMENSION(:,:,:,:) :: emi_cb05

!
!      LOGICAL, SAVE :: FIRSTIME=.TRUE.
!   
      REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:,:) :: emis_ant


!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!

      MYPE=MYPE_SHARE

!      IF(FIRSTIME)THEN
!        ALLOCATE(emis_ant(IMS:IME,JMS:JME,NSNAP,SPECS))
!        FIRSTIME=.FALSE.
!      ENDIF
! *** FIRST STEP AND HOURLY ONLY
! 1. READ NETCDF WITH AQMEII ANNUAL EMISSION PER SNAP SECTOR (NETCDF) FROM AQMEII
! 2. TIME SPLIT FROM ANNUAL TO HOURLY EMISSION
! 3. VERTICAL DISTRIBUTION
! 4. UNITS CONVERSION FROM [Tg/km2*h] to [mol/km2*h]
! 5. NMVOC CHEMICAL SPECIATION CBM05
! *** ALL STEPS
! 6. INGEST EMISSIONS IN THE ATMOSPHERE
      


      IF(NTIMESTEP==NCHEM .OR. MOD(TCHEM,3600.0)==0.)THEN !FIRSTIME WE READ EMISSONS
!      IF(NTIMESTEP==NCHEM) THEN !ONLY READ EMISSIONS AT FIRST TIMESTEP, THEN CONSTANT
      ALLOCATE(emis_ant(IMS:IME,JMS:JME,NSNAP,SPECS))
      ALLOCATE(emis_read(IDS:IDE,JDS:JDE,NSNAP,SPECS))
      ALLOCATE(temp1(IMS:IME,JMS:JME,NSNAP))
      ALLOCATE(emission_ant(IMS:IME,JMS:JME,NSNAP,SPECS))
      ALLOCATE(emi_tot(IMS:IME,JMS:JME,LM,SPECS))
      ALLOCATE(emi_cb05(IMS:IME,JMS:JME,LM,SPEC_CB05))

! *** FIRST STEP ONLY *** !
! 1. READ NETCDF WITH AQMEII ANNUAL EMISSIONS 
      IF(MYPE==0)THEN
      PRINT *,'1. READ TNO EMISSIONS INPUT DATA',NTIMESTEP,'=NTIMESTEP'
      CALL READ_NC(emis_read,IDE-2,JDE-2,NSNAP,SPECS) !emis_ant(itotal,jtotal,snap,gas)                        
      ENDIF
!input_array=emis_read(ids:ide,jds:jde,...
!output_array=emis_ant(ims:ime,jms:jme,...
      do k=1,SPECS
         do l=1,NSNAP
!      IF(MYPE==0) THEN
!       PRINT *,'IN DSTRB:',k,l,NTIMESTEP,'=NTIMESTEP'
!      ENDIF
           call dstrb(emis_read(:,:,l,k),temp1,1,1,1,NSNAP,l,mype,mpi_comm_comp)
           emis_ant(:,:,l,k)=temp1(:,:,l)
         enddo
       enddo
      
      DEALLOCATE(emis_read,temp1)

! 2. TIME SPLIT FROM ANNUAL TO HOURLY EMISSION
      CALL CURRENT_TIME(NTIMESTEP,START_YEAR,START_MONTH,START_DAY,START_HOUR,TCHEM,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR)

      IF(MYPE==0) THEN
       PRINT *,'2. TNO TIME SPLIT:','NTIMESTEP=',NTIMESTEP,'TCHEM=',TCHEM
       PRINT *,'ST_YEAR=',START_YEAR,' ST_MONTH=',START_MONTH,' ST_DAY=',START_DAY,'ST_HOUR=',START_HOUR
       PRINT *,'CU_YEAR=',CU_YEAR,' CU_MONTH=',CU_MONTH,' CU_DAY=',CU_DAY,'CU_HOUR=',CU_HOUR
      ENDIF

      CALL time_split ( emis_ant,  emission_ant, XLONG                  &
                       ,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR                 &
                       ,IMS,IME,JMS,JME                                 &
                       ,ITS,ITE,JTS,JTE ) !input: emis_ant, output: emission_ant Units: Mg/km2*ĥour

! 3. VERTICAL DISTRIBUTION
      emi_tot=0.
!     !--- Apply vertical emission distribution and create total emissions
      DO l = 1, num_tno_ant   ! Here we sum all SNAPS , so one dimension less!! 

!!         CALL em_vert_dist(l, nlon, nlat, nlev, height, vdfact,0)
         CALL em_vert_dist(l,LM,Z_AT_W,FIS,vdfact,0                     &
                       ,IMS,IME,JMS,JME                                 &
                       ,ITS,ITE,JTS,JTE )

         DO k = 1,LM !1, nlev
           DO j = JTS,JTE !1, nlat
             DO i = ITS,ITE !1, nlon
               DO p=1, 4  ! 
   emi_tot(i,j,k,p)=emi_tot(i,j,k,p)+emission_ant(i,j,l,p)*vdfact(i,j,k)
               END DO
             END DO
           END DO
         END DO

!!! FOr NMVOCs different vertical desegragation

!!     CALL em_vert_dist(l, nlon, nlat, nlev, height, vdfact,1)
         CALL em_vert_dist(l,LM,Z_AT_W,FIS,vdfact,1                     &
                       ,IMS,IME,JMS,JME                                 &
                       ,ITS,ITE,JTS,JTE )


       DO k = 1,LM !1, nlev
           DO j = JTS,JTE !1, nlat
             DO i = ITS,ITE !1, nlon
               DO p=5, spec_tno_ant !!! FOR NVOCS
   emi_tot(i,j,k,p)=emi_tot(i,j,k,p)+emission_ant(i,j,l,p)*vdfact(i,j,k)
               END DO
                p=spec_tno_ant  !NH3 
               emi_tot (i,j,k,p)  = emi_tot (i,j,k,p) + emission_ant (i,j,l,p) *vdfact(i,j,k)
             END DO
           END DO
       END DO

      END DO !l=1,num_tno_ant

      IF(MYPE==0)THEN
      print*,'done vertical distribution 1'
      ENDIF

! 4. CONVERT TO CB05 SPECIES

!! CALL convert_tno_cb05(emi_tot,emi_cb05)
      CALL convert_tno_cb05(emi_tot,emi_cb05                            &
                       ,IMS,IME,JMS,JME,LM                              &
                       ,ITS,ITE,JTS,JTE )

      IF(MYPE==0)THEN
       print*,'4. CONVERT TNO CB05'
      ENDIF

!FOR DEBUG
      IF(MYPE==0) THEN
       PRINT *,'FOR DEBUG OUTPUT TNO EMISSIONS',NTIMESTEP,'=NTIMESTEP'
       PRINT *,emi_cb05(ITE,JTE,:,1)
      ENDIF

! 5. FROM emi_cb05 to E_CO, E_NO, E_NO2, ....

      DO k=1,LM
        kflip=LM-k+1
        E_CO  (:,:,kflip)    = emi_cb05(:,:,k,1) !CO
        E_NO2 (:,:,kflip)    = emi_cb05(:,:,k,2) !NO2
        E_NO  (:,:,kflip)    = emi_cb05(:,:,k,3) !NO
        E_SO2 (:,:,kflip)    = emi_cb05(:,:,k,4) !SO2
        E_PAR (:,:,kflip)    = emi_cb05(:,:,k,5) !PAR
        E_OLE (:,:,kflip)    = emi_cb05(:,:,k,6) !OLE
        E_TOL (:,:,kflip)    = emi_cb05(:,:,k,7) !TOL
        E_XYL (:,:,kflip)    = emi_cb05(:,:,k,8) !XYL
        E_FORM(:,:,kflip)    = emi_cb05(:,:,k,9) !FORM
        E_ETH (:,:,kflip)    = emi_cb05(:,:,k,10)!ETH
!        E_ISOP(:,:,kflip)   = emi_cb05(:,:,k,11)!ISOP
        E_MEOH(:,:,kflip)    = emi_cb05(:,:,k,12)!MEOH
                                           !13 !NR
        E_ETHA(:,:,kflip)    = emi_cb05(:,:,k,14)!ETHA
!        E_TERP(:,:,kflip)  = emi_cb05(:,:,k,15)!TERP
        E_NH3(:,:,kflip)     = emi_cb05 (:,:,k,spec_cb05) !NH3
      ENDDO

!FOR DEBUG
      IF(MYPE==0) THEN
       PRINT *,'EMI ARRAYS READY E_CO E_NO E_NO2 ...',NTIMESTEP
      ENDIF
!
      DEALLOCATE(emis_ant,emission_ant,emi_tot,emi_cb05)
!
      ENDIF !NTIMESTEP==NCHEM


! 6. INGEST EMISSIONS IN THE ATMOSPHERE
! AIRDENSITY[kg/m3]; dtchem [s]; dz8w[m]
! E_... [mol/(h*km2)]; CONC[ppmv]
! CONC[ppmv]=E_...[mol/(h*km2)]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! 8.047e-6=PMair[kg/mol]/3600[s]=0.02897/3600
! conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)

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

        do k=LM,1,-1  !LM to 1
        kflip=LM-k+1
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
      conv_rho=8.047e-6/AIRDENSITY(i,kflip,j)*dtchem/dz8w(i,kflip,j)*CONVEMI

        chem(i,j,k,P_CO)  =  chem(i,j,k,P_CO)                           &
                         + E_CO(i,j,k)*conv_rho 
        chem(i,j,k,P_NO2) =  chem(i,j,k,P_NO2)                          &
                         + E_NO2(i,j,k)*conv_rho
        chem(i,j,k,P_NO)  =  chem(i,j,k,P_NO)                           &
                         + E_NO(i,j,k)*conv_rho
        chem(i,j,k,P_SO2)  =  chem(i,j,k,P_SO2)                         &
                         + E_SO2(i,j,k)*conv_rho
        chem(i,j,k,P_PAR)  =  chem(i,j,k,P_PAR)                         &
                         + E_PAR(i,j,k)*conv_rho
        chem(i,j,k,P_OLE)  =  chem(i,j,k,P_OLE)                         &
                         + E_OLE(i,j,k)*conv_rho
        chem(i,j,k,P_TOL)  =  chem(i,j,k,P_TOL)                         &
                         + E_TOL(i,j,k)*conv_rho
        chem(i,j,k,P_XYL)  =  chem(i,j,k,P_XYL)                         &
                         + E_XYL(i,j,k)*conv_rho
        chem(i,j,k,P_FORM)  =  chem(i,j,k,P_FORM)                       &
                         + E_FORM(i,j,k)*conv_rho
        chem(i,j,k,P_ETH)  =  chem(i,j,k,P_ETH)                         &
                         + E_ETH(i,j,k)*conv_rho
        chem(i,j,k,P_MEOH)  =  chem(i,j,k,P_MEOH)                       &
                         + E_MEOH(i,j,k)*conv_rho
        chem(i,j,k,P_ETHA)  =  chem(i,j,k,P_ETHA)                       &
                         + E_ETHA(i,j,k)*conv_rho

        enddo
      enddo
      enddo

!                          
!-----------------------------------------------------------------------
!                          
      RETURN               
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_AQMEII_PHASE3_EMISSIONS
!                          
!***********************************************************************
!-----------------------------------------------------------------------
      SUBROUTINE READ_IS4FIRE_EMISSIONS(                               &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
                ,E_CO,E_NO,E_SO2,E_NH3                                 &
!                ,E_ETH,E_ISOP,E_MEOH,E_ETHA,E_TERP                     &
                ,E_BC,E_OM                                             &
                ,XLAT,XLONG,AIRDENSITY,DZ8W                            &
                ,CHEM,NUM_GAS,AERO_BSC,NUM_BSC_AERO                    &
                ,P_BC1,P_BC2,P_OM1,P_OM2                               &
                ,DARE                                                  &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  READ EMISSIONS FROM IS4FIRE   DATABASE FOR REGIONAL EU RUNS
!              EMISSIONS FROM FMI
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 24-12-14
!
! ABSTRACT:
!     READ EMISSIONS FROM AQMEII-P2 DATABASE FOR REGIONAL RUNS  
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   11-02-13  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
!
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,START_HOUR                                 &
                           ,NTIMESTEP,NCHEM,NUM_GAS                    &
                           ,NUM_BSC_AERO,P_BC1,P_BC2,P_OM1,P_OM2

      REAL, INTENT(IN) :: TCHEM,DTCHEM
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS) :: CHEM
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_BSC_AERO) :: AERO_BSC
!
      REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE
!
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_CO, E_NO, E_SO2,E_NH3,E_BC, E_OM
!
     REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: XLONG, XLAT
!
     REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: AIRDENSITY,DZ8W
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
!
      CHARACTER :: DUMMY_CHAR*190, filename*38
!
      CHARACTER :: char_year*4,char_month*2,char_day*2
!
      integer :: mype,i,j,k,kk,l,kflip,ine,jne
!
      REAL :: conv_rho,conv_rho2,dztop,dzbot,lon_fire,lat_fire
!
      REAL :: lon_is4fire, lat_is4fire,emi_fire,zmax,zmin
!
      INTEGER :: CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR 
!
      REAL :: femi(LM),hour_in_day_index(24)
!
      LOGICAL :: end_file
!
      LOGICAL, SAVE :: FIRSTIME=.TRUE.
!   
      REAL, SAVE, ALLOCATABLE,DIMENSION(:,:) :: E_IS4FIRE
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!

      MYPE=MYPE_SHARE

      IF(FIRSTIME)THEN
        ALLOCATE(E_IS4FIRE(ITS:ITE,JTS:JTE))
        FIRSTIME=.FALSE.
      ENDIF

! *** FIRST STEP AND HOURLY ONLY
! 1. READ SA2 IS4FIRE DAILY EMISSIONS
! 2. TIME SPLIT FROM DAILY  TO HOURLY EMISSION
! 3. VERTICAL DISTRIBUTION
! 4. UNITS CONVERSION FROM [kg/s] to [mol/km2*h] or [kg/km2*h]
! 5. NMVOC CHEMICAL SPECIATION FROM IS4FIRE TO CBM05
! *** ALL STEPS
! 6. INGEST EMISSIONS IN THE ATMOSPHERE
!
      IF(NTIMESTEP==NCHEM .OR. MOD(TCHEM,3600.0)==0.)THEN !FIRSTIME WE READ EMISSONS
!
      CALL CURRENT_TIME(NTIMESTEP,START_YEAR,START_MONTH,START_DAY,START_HOUR,TCHEM,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR)
!
! *** FIRST HOUR OF THE DAY STEP ONLY *** !
! 1. READ SA2 IS4FIRE 0.1 GLOBAL ANNUAL EMISSIONS 
!
      IF(CU_HOUR.EQ.0)THEN !READ EMISSION OF THE DAY
      IF(MYPE==0) THEN
       PRINT *,'1. IS4FIRE TIME SPLIT:','NTIMESTEP=',NTIMESTEP,'TCHEM=',TCHEM
       PRINT *,'ST_YEAR=',START_YEAR,' ST_MONTH=',START_MONTH,' ST_DAY=',START_DAY,'ST_HOUR=',START_HOUR
       PRINT *,'CU_YEAR=',CU_YEAR,' CU_MONTH=',CU_MONTH,' CU_DAY=',CU_DAY,'CU_HOUR=',CU_HOUR
       PRINT *,'1. READ IS4FIRE EMISSIONS INPUT DATA',NTIMESTEP,'=NTIMESTEP'
      ENDIF

      E_IS4FIRE=0.

      write(char_year,'(i4.4)') CU_YEAR
      write(char_month,'(i2.2)') CU_MONTH
      write(char_day,'(i2.2)') CU_DAY

      filename='reanal_v1_3_global_0_1deg_'//char_YEAR//char_MONTH//char_DAY//'.sa2'
      if(mype==0) print*,'IS4FIRE FILENAME: ',filename
      open(10,file=filename,status='old')
      do i=1,25
        read(10,*)
      enddo
      !read hour_in_day_index
      read(10,'(a19,24f5.2)') dummy_char, hour_in_day_index
      do i=1,8
        read(10,*)
      enddo
      !start read emission fluxes
      end_file=.TRUE.
      do while(end_file)
        ine=0
        jne=0
        read(10,'(a52)') dummy_char
        if(dummy_char(1:6).eq.' val =')then
           read(dummy_char,'(a6,4x,f8.3,7x,f8.3,6x,es13.7e2)') dummy_char,lon_is4fire,lat_is4fire,emi_fire
        else
           print *,dummy_char
           exit
        endif
            lon_fire=-179.95+(lon_is4fire-1)*0.1
            lat_fire=-89.95+(lat_is4fire-1)*0.1
            DO J=JTS,JTE-1
            DO I=ITS,ITE-1
       !implementation (neighbor)
               IF(XLONG(I,J).LE.lon_fire.AND.XLONG(I+1,J).GT.lon_fire.AND.XLAT(I,J).LE.lat_fire.AND.XLAT(I,J+1).GT.lat_fire)THEN
                 if(abs(XLONG(I,J)-lon_fire).lt.abs(XLONG(I+1,J)-lon_fire))then
                   ine=I
                 else
                   ine=I+1
                 endif
                 if(abs(XLAT(I,J)-lat_fire).lt.abs(XLAT(I,J+1)-lat_fire))then
                   jne=J
                 else
                   jne=J+1
                 endif
                 if(ine.gt.0.and.jne.gt.0)then !ingest emissions
                   E_IS4FIRE(ine,jne)=emi_fire
                 endif
               ENDIF !XLONG
             ENDDO !ITS
             ENDDO !JTS
        enddo !dowhile
        ENDIF !CU_HOUR
        ENDIF !FIRST TIMESTEP OR HOURLY STEP

! 2. INGEST EMISSIONS WITH TIME SPLIT FROM DAILY TO HOURLY EMISSION AND VERTICAL DISTRIBUTION AND CHEMICAL SPECIATION
        DO J=JTS,JTE
        DO I=ITS,ITE
          IF(E_IS4FIRE(i,j).GT.0.)then !ingest emissions
        !vertical distribution of emissions
        !50% in 0-200. m
              zmax=200.
              zmin=0. 
              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
!                E_BC(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)/DARE(jne)*0.74*0.043                 !TPM 74%PM2.5 - 4.3%BC Units:kg/km2/s
             E_BC(i,j,kk)=10.
                E_OM(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)/DARE(jne)*0.74*0.704*1.6             !TPM 74%PM2.5 - 70.4%BC - OM=OC*1.6??
                E_CO(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)*3600./(28./1000.)/DARE(jne)*6.08     !TPM*6.08=CO - Units: mol/h/km2
                E_NO(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)*3600./(30./1000.)/DARE(jne)*0.17     !TPM*0.17=NO - Units: mol/h/km2
                E_NH3(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)*3600./(17./1000.)/DARE(jne)*0.080  !TPM*0.080=NH3 - Units: mol/h/km2
                E_SO2(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)*3600./(64./1000.)/DARE(jne)*0.057  !TPM*0.057=SO2 - Units: mol/h/km2
               !!!!!E_NMVOC SPECIATION TPM*0.32
               !!!!!INGEST COARSE PM 26% TPM IN ASH OR DUST OR SMOKE??

!INGEST BC OM IN AERO ARRAY!!!!

                kflip=LM-kk+1
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
                conv_rho=8.047e-6/AIRDENSITY(i,kflip,j)*dtchem/dz8w(i,kflip,j)
                conv_rho2=dtchem/dz8w(i,kflip,j)*1e3

                chem(i,j,k,P_CO)  =  chem(i,j,k,P_CO)                           &
                                 + E_CO(i,j,k)*conv_rho
                chem(i,j,k,P_NO) =  chem(i,j,k,P_NO)                          &
                                 + E_NO(i,j,k)*conv_rho
                chem(i,j,k,P_NH3)  =  chem(i,j,k,P_NH3)                           &
                                 + E_NH3(i,j,k)*conv_rho
                chem(i,j,k,P_SO2)  =  chem(i,j,k,P_SO2)                         &
                                 + E_SO2(i,j,k)*conv_rho
                AERO_BSC(i,j,k,P_OM1) = AERO_BSC(i,j,k,P_OM1) + E_OM(i,j,k) * conv_rho2 *0.5
                AERO_BSC(i,j,k,P_OM2) = AERO_BSC(i,j,k,P_OM2) + E_OM(i,j,k) * conv_rho2 *0.5
                AERO_BSC(i,j,k,P_BC1) = AERO_BSC(i,j,k,P_BC1) + E_BC(i,j,k) * conv_rho2 *0.8
                AERO_BSC(i,j,k,P_BC2) = AERO_BSC(i,j,k,P_BC2) + E_BC(i,j,k) * conv_rho2 *0.2


              enddo
        !50% in 200-1000. m
              zmax=1000.
              zmin=200. 
              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
!                E_BC(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)/DARE(jne)*0.74*0.043                 !TPM 74%PM2.5 - 4.3%BC Units:kg/km2/s
             E_BC(i,j,kk)=10.
                E_OM(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)/DARE(jne)*0.74*0.704*1.6             !TPM 74%PM2.5 - 70.4%BC - OM=OC*1.6??
                E_CO(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)*3600./(28./1000.)/DARE(jne)*6.08     !TPM*6.08=CO - Units: mol/h/km2
                E_NO(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)*3600./(30./1000.)/DARE(jne)*0.17     !TPM*0.17=NO - Units: mol/h/km2
                E_NH3(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)*3600./(17./1000.)/DARE(jne)*0.080  !TPM*0.080=NH3 - Units: mol/h/km2
                E_SO2(i,j,kk)=femi(kk)*0.5*E_IS4FIRE(i,j)*hour_in_day_index(CU_HOUR+1)*3600./(64./1000.)/DARE(jne)*0.057  !TPM*0.057=SO2 - Units: mol/h/km2
               !!!!!E_NMVOC SPECIATION TPM*0.32

!INGEST BC OM IN AERO ARRAY!!!!

                kflip=LM-kk+1
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
                conv_rho=8.047e-6/AIRDENSITY(i,kflip,j)*dtchem/dz8w(i,kflip,j)
                conv_rho2=dtchem/dz8w(i,kflip,j)*1e3

                chem(i,j,k,P_CO)  =  chem(i,j,k,P_CO)                           &
                                 + E_CO(i,j,k)*conv_rho
                chem(i,j,k,P_NO) =  chem(i,j,k,P_NO)                          &
                                 + E_NO(i,j,k)*conv_rho
                chem(i,j,k,P_NH3)  =  chem(i,j,k,P_NH3)                           &
                                 + E_NH3(i,j,k)*conv_rho
                chem(i,j,k,P_SO2)  =  chem(i,j,k,P_SO2)                         &
                                 + E_SO2(i,j,k)*conv_rho
                AERO_BSC(i,j,k,P_OM1) = AERO_BSC(i,j,k,P_OM1) + E_OM(i,j,k) * conv_rho2 *0.5
                AERO_BSC(i,j,k,P_OM2) = AERO_BSC(i,j,k,P_OM2) + E_OM(i,j,k) * conv_rho2 *0.5
                AERO_BSC(i,j,k,P_BC1) = AERO_BSC(i,j,k,P_BC1) + E_BC(i,j,k) * conv_rho2 *0.8
                AERO_BSC(i,j,k,P_BC2) = AERO_BSC(i,j,k,P_BC2) + E_BC(i,j,k) * conv_rho2 *0.2

              enddo
                 endif !ingest emissions
              enddo !ITS
            enddo !JTS
!                          
!-----------------------------------------------------------------------
!                          
      RETURN               
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_IS4FIRE_EMISSIONS
!                          
!-----------------------------------------------------------------------
!***********************************************************************
! ALBA's routines to be moved to a module
      SUBROUTINE READ_NC(emis_ant2,nlon,nlat,num_tno_ant,spec_tno_ant)
!CALL READ_NC(emis_read,IDE-2,JDE-2,NSNAP,SPECS)
      use netcdf
      
      implicit none

      INTEGER :: nlon,nlat,num_tno_ant,spec_tno_ant,stat,i,j,k,l
      INTEGER                                                           :: ncid
      INTEGER                                                           :: emi_id
      INTEGER                                                           :: num
      REAL,  DIMENSION(nlon,nlat,num_tno_ant,spec_tno_ant)              :: emis_ant1
      REAL,  DIMENSION(nlon+2,nlat+2,num_tno_ant,spec_tno_ant)          :: emis_ant2
      REAL , DIMENSION(nlon,nlat,32)                                    :: pollut
      integer :: start(3), count(3)
      character(len=50) :: snap(num_tno_ant)
!      INTEGER, DIMENSION(spec_tno_ant)                                    :: selec_tno
      INTEGER, DIMENSION(29)                                    :: selec_tno
      CHARACTER(len=300), PARAMETER :: &
      emiss_path ='./'
!      emiss_path ='/gpfs/projects/bsc32/bsc32771/AQMEII/MODEL/run_nmmb_409rrtm/'
!      emiss_path ='../RDATA/NC/REMAP_NMMB/'
!      emiss_path='/scratch/home/developer/ALBA/AQMEII/EMIS/PHASE2/RDATA/NC/REMAP_NMMB/'

      CHARACTER(len=300)                                                   :: fname

      DATA selec_tno /2,4,4,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23, &
                    24,25,26,28,29,30,31,32,3 / !NH3


      snap(1)= '1'
      snap(2)='2'
      snap(3)='34'
      snap(4)='5'
      snap(5)='6'
      snap(6)='71'
      snap(7)='72'
      snap(8)='73'
      snap(9)='74'
      snap(10)='75'
      snap(11)='8'
      snap(12)='9'
      snap(13)='10'

      emis_ant1=0.

      DO num =1, num_tno_ant

!      fname =TRIM(emiss_path)//TRIM('remap_tno_emi_2010')//TRIM(snap(num))//TRIM('.nc') !Mg

      fname=TRIM(emiss_path)//TRIM('remap_tno_area_0')//TRIM(snap(num))//TRIM('.nc')  !Mg/m2

!*     1. Open the netCDF file
!*     -----------------------
      PRINT*, 'Reading file: ', TRIM(fname)
!      stat=nf90_open(TRIM(fname), nf90_nowrite, ncid)
!      stat=nf90_open('./remap_tno_area_01.nc',nf90_nowrite, ncid)
      call check_nc(nf90_open(TRIM(fname), nf90_nowrite, ncid))
      print*,'open file nc',stat
      call check_nc(nf90_inq_varid(ncid,"emi",emi_id))

      count = (/nlon, nlat, 32 /)
      start = (/ 1, 1, 1 /)
      print*,'Get ozone values'
      call check_nc(nf90_get_var(ncid,emi_id,pollut,start,count))

      call check_nc(nf90_close(ncid))

     !We are interesed in only these variables: 

      DO i=1, spec_tno_ant
       emis_ant1(:,:,num,i) = pollut(:,:,selec_tno(i))*1.0e6  !Convert units: m2 to km2 
       IF (i.EQ.2) emis_ant1(:,:,num,i) = emis_ant1(:,:,num,i)* 5/100
       IF (i.EQ.3) emis_ant1(:,:,num,i) = emis_ant1(:,:,num,i)* 95/100
      END DO
     !-> m2 to km2

      PRINT*, "*** SUCCESS reading file ", fname, "!"
!      print*,pollut(149,120,1)
      END DO     ! End loop of read emi-snaps nc files

      emis_ant2=0.
!      DO i=1,nlon
!       DO j=1,nlat
!        DO k=1,spec_tno_ant
!         DO l=1,num_tno_ant

         DO l=1,num_tno_ant
        DO k=1,spec_tno_ant
!          PRINT *,l,k
       DO j=1,nlat
      DO i=1,nlon
           emis_ant2(i+1,j+1,l,k)=emis_ant1(i,j,l,k)
      if(emis_ant1(i,j,l,k).LT.0) emis_ant2(i+1,j+1,l,k)=0
          END DO
        END DO
       END DO
      END DO

      RETURN

      END SUBROUTINE READ_NC

  SUBROUTINE check_nc(status)

    USE netcdf

    INTEGER, INTENT (in) :: status

    IF(status /= nf90_noerr) THEN
      PRINT*,'ERROR:', nf90_strerror(status)
      STOP "Stopped"
    END IF

  END SUBROUTINE check_nc
!---------------------------------------------------------------------
!
      SUBROUTINE CURRENT_TIME(NTIMESTEP,START_YEAR,START_MONTH,START_DAY       &
             ,START_HOUR,TCHEM,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR)
!
!-----------------------------------------------------------------------
!       CALL CURRENT_TIME(START_YEAR,START_MONTH,START_DAY,START_HOUR,TCHEM,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR)
!
!    ONLY APPLICABLE FOR SHORT TERM SIMULATIONS

!
      INTEGER,INTENT(IN) :: START_YEAR,START_MONTH,START_DAY            &
                           ,START_HOUR,NTIMESTEP

      REAL,INTENT(IN)    :: TCHEM

      INTEGER,INTENT(OUT) :: CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR
!
!-----------------------------------------------------------------------
!***  LOCAL VARIABLES
!-----------------------------------------------------------------------
!
      INTEGER   :: ADV_HOUR,ADV_DAY
      INTEGER   :: NEW_YEAR,NEW_MONTH,NEW_DAY,NEW_HOUR
!
!-----------------------------------------------------------------------
!

!emissdummy-cbm4-2009-02-04-09

     IF(NTIMESTEP==4)THEN
       CU_YEAR=START_YEAR
       CU_MONTH=START_MONTH
       CU_DAY=START_DAY
       CU_HOUR=START_HOUR
     ELSE
       !Advance TCHEM seconds in start date
       !TCHEM=START_HOUR*3600+DT*NTIMESTEP
       ADV_HOUR=NINT(TCHEM/3600.)
!       NEW_HOUR=START_HOUR+ADV_HOUR
       NEW_HOUR=ADV_HOUR
!       PRINT *,'DEBUGG CU_TIME-TCHEM=',TCHEM,'NEW_HOUR=',NEW_HOUR
       IF(NEW_HOUR.GE.24)THEN
         ADV_DAY=INT(NEW_HOUR/24.)
         NEW_DAY=START_DAY+ADV_DAY
         NEW_HOUR=NEW_HOUR-(ADV_DAY)*24
         IF(START_MONTH==1.OR.START_MONTH==3.OR.START_MONTH==5            &
           .OR.START_MONTH==7.OR.START_MONTH==8.OR.START_MONTH==10)THEN
           IF(NEW_DAY.GT.31)THEN
             NEW_MONTH=START_MONTH+1
             NEW_DAY=NEW_DAY-31
             NEW_YEAR=START_YEAR
           ELSE
             NEW_YEAR=START_YEAR
             NEW_MONTH=START_MONTH
           ENDIF
         ELSEIF(START_MONTH==4.OR.START_MONTH==6.OR.START_MONTH==9        &
               .OR.START_MONTH==11)THEN
           IF(NEW_DAY.GT.30)THEN
             NEW_MONTH=START_MONTH+1
             NEW_DAY=NEW_DAY-30
             NEW_YEAR=START_YEAR
           ELSE
             NEW_YEAR=START_YEAR
             NEW_MONTH=START_MONTH
           ENDIF
         ELSEIF(START_MONTH==2)THEN
           IF(MOD(START_YEAR,4)==0)THEN !LEAP YEAR
             IF(NEW_DAY.GT.29)THEN
               NEW_MONTH=START_MONTH+1
               NEW_DAY=NEW_DAY-29
               NEW_YEAR=START_YEAR
             ELSE
               NEW_YEAR=START_YEAR
               NEW_MONTH=START_MONTH
             ENDIF
           ELSE
             IF(NEW_DAY.GT.28)THEN
               NEW_MONTH=START_MONTH+1
               NEW_DAY=NEW_DAY-28
               NEW_YEAR=START_YEAR
             ELSE
               NEW_YEAR=START_YEAR
               NEW_MONTH=START_MONTH
             ENDIF
           ENDIF
         ELSEIF(START_MONTH==12)THEN
           IF(NEW_DAY.GT.31)THEN
             NEW_MONTH=1
             NEW_DAY=NEW_DAY-31
             NEW_YEAR=START_YEAR+1
           ELSE
             NEW_YEAR=START_YEAR
             NEW_MONTH=START_MONTH
           ENDIF
         ENDIF

         CU_YEAR=NEW_YEAR
         CU_MONTH=NEW_MONTH
         CU_DAY=NEW_DAY
         CU_HOUR=NEW_HOUR
       ELSE
         CU_YEAR=START_YEAR
         CU_MONTH=START_MONTH
         CU_DAY=START_DAY
         CU_HOUR=NEW_HOUR
       ENDIF
     ENDIF

     RETURN

!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CURRENT_TIME
!
!-----------------------------------------------------------------------
!

!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE READ_TRACER_FUKUSHIMA(                                &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
!
                ,XLAT,XLONG,Z_AT_W,FIS,AIRDENSITY,DZ8W                 &
                ,CHEM,NUM_GAS,DARE,DP8W                                &
                ,E_EMI                                                 &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  READ EMISSIONS FROM FUKUSHIMA EMISSION FILES 
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 11-02-13
!
! ABSTRACT:
!     READ EMISSIONS FROM FUKUSHIMA EMISSION STOHL ET AL: (2012)  
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   13-03-22  JORBA      - ORIGINATOR OF THE SUBROUTINE
!
! USAGE: CALL FROM EMISSION_DRIVER
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
!      USE MODULE_CONSTANTS,ONLY : G,EPSQ,R_D,P608
!
!----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,START_HOUR                                 &
                           ,NTIMESTEP,NCHEM,NUM_GAS

      REAL, INTENT(IN) :: TCHEM,DTCHEM
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS) :: CHEM

      REAL,DIMENSION(ITS:ITE,1:LM+1,JTS:JTE),INTENT(IN) :: Z_AT_W
!
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS
!
     REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: XLONG,XLAT
!
     REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: AIRDENSITY,DZ8W,DP8W
!
     REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE
!
     REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: E_EMI
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      integer :: mype,i,j,k,l,ncid,stat,kflip
!
      INTEGER :: CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR 

      INTEGER :: IDATE,ITIME,E_YEAR,E_MONTH,E_DAY,E_HOUR

      REAL :: CONV_RHO

      REAL :: EMI_APRI(3), EMI_APOST(3)

      REAL,DIMENSION(4) :: EMI_LAY

      DATA EMI_LAY / 0., 50., 300., 1000. /
    
      INTEGER :: CASE_EMI,KBOT,KTOP

      REAL :: NMM_BOT,NMM_TOP,WEIGHT_FACT

      CHARACTER*8 :: CDATE

      CHARACTER*6 :: CTIME

      LOGICAL, SAVE :: FIRSTIME=.TRUE.

      LOGICAL, SAVE :: FIRSTIME2=.TRUE.

      INTEGER, SAVE :: I_EMI=0, J_EMI=0
!     
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!
      MYPE=MYPE_SHARE
!1-LOCATE EMISSION POINT
!2-LOCATE EMISSION TIME
!3-DISTRIBUTE 3 LAYERS EMISSION IN MODEL LAYERS

      IF(FIRSTIME)THEN
! 1- LOCATE EMISSION POINT (LON=141.03E, LAT=37.42N) ONLY FOR GLOBAL RUNS
         J=JTS
         DO I=ITS,ITE-1
!             IF(XLONG(I,J)<141.03 .AND. XLONG(I+1,J)>141.03)THEN
             IF(XLONG(I,J)<20. .AND. XLONG(I+1,J)>20.)THEN
               I_EMI=I
             ENDIF
         ENDDO
         DO J=JTS,JTE-1
!             IF(XLAT(I,J)<37.42 .AND. XLAT(I,J+1)>37.42)THEN
             IF(XLAT(I,J)<35. .AND. XLAT(I,J+1)>35.)THEN
               J_EMI=J
             ENDIF
         ENDDO
         FIRSTIME=.FALSE.
       ENDIF
!FROM HERE, ONLY PROCESSOR WITH I_EMI AND J_EMI WILL WORK
      IF(ITS<I_EMI.AND.I_EMI<ITE.AND.JTS<J_EMI.AND.J_EMI<JTE)THEN
! 2- IS IT TIME FOR EMISSION TO START?
!       print *, 'aquui abans'
        CALL CURRENT_TIME(NTIMESTEP,START_YEAR,START_MONTH,START_DAY,START_HOUR,TCHEM,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR)
        OPEN(17,file='xe133_emissions.dat',status='OLD')
        read(17,*)
        read(17,*)
        read(17,*)
        read(17,*)
        read(17,*)
!        print *,'aquie a punt del read'
100     READ(17,*,END=99) IDATE,ITIME,(EMI_APRI(I),EMI_APOST(I),I=1,3)

        write(cdate,'(i8.8)') idate
        write(ctime,'(i6.6)') itime

        read(cdate(1:4),'(i4.4)') e_year
        read(cdate(5:6),'(i2.2)') e_month
        read(cdate(7:8),'(i2.2)') e_day
        read(ctime(1:2),'(i2.2)') e_hour

!100     READ(17,1001,END=99) E_YEAR,E_MONTH,E_DAY,E_HOUR,IDATE,(EMI_APRI(I),EMI_APOST(I),I=1,3)
!1001    FORMAT('(i4.4,i2.2,i2.2,1x,i2.2,i4.4,6(3x,e10.4e3))')        
        PRINT *,'READ FUKU EMI ',E_YEAR,E_MONTH,E_DAY,E_HOUR,EMI_APOST
!        print *,'despres read format'
        IF(E_MONTH==CU_MONTH.AND.E_DAY==CU_DAY.AND.(CU_HOUR>=E_HOUR.AND.CU_HOUR<(E_HOUR+3)))THEN
! 3. INGEST EMISSIONS IN THE ATMOSPHERE
! THREE LAYERS 0-50m; 50-300m; 300-1000m
        CASE_EMI=1 !=1 easy_case emission 3 layers in 3 first model layer; =2 distribute 3 layers in n model layers; =3 debug case

        WRITE(0,*)'EMISSION FUKU AT=',E_MONTH,E_DAY,E_HOUR,' CASE_EMI = ',CASE_EMI

        IF(CASE_EMI==1)THEN
         do k=LM,LM-2,-1  !LM to 1
          kflip=LM-k+1
!EMI_APOST [GBq/s]; CONC[Bq/m3]
!         conv_rho=1e9*dtchem/(DARE(J_EMI)*dz8w(i_emi,kflip,j_emi))
!         conv_rho=1e9*dtchem/(DARE(J_EMI)*dz8w(i_emi,kflip,j_emi)*AIRDENSITY(i_emi,kflip,j_emi))
!         conv_rho=dtchem/(DARE(J_EMI)*dz8w(i_emi,kflip,j_emi)*AIRDENSITY(i_emi,kflip,j_emi)) !emi [kg s-1] !*AIRDENSITY(i_emi,kflip,j_emi))
         conv_rho=dtchem/(DARE(J_EMI)*dz8w(i_emi,kflip,j_emi))
!         conv_rho=dtchem/dz8w(i_emi,kflip,j_emi) !emi [kg m-2 s-1]

         chem(i_emi,j_emi,k,P_TRACER)  =  chem(i_emi,j_emi,k,P_TRACER)                           &
                         + EMI_APOST(kflip)*conv_rho
         E_EMI(i_emi,j_emi,k) = E_EMI(i_emi,j_emi,k)+EMI_APOST(kflip)*dtchem
         enddo
        ELSEIF(CASE_EMI==2)THEN
          kbot=0
          ktop=1
          NMM_BOT=0.
          NMM_TOP=NMM_BOT+dz8w(i_emi,ktop,j_emi)
          DO L=2,4

            IF(EMI_LAY(L).LT.NMM_TOP)THEN
                  WEIGHT_FACT=(EMI_LAY(L)-NMM_BOT)/(NMM_TOP-NMM_BOT)  
                  conv_rho=1e9*dtchem/(DARE(J_EMI)*(EMI_LAY(L)-EMI_LAY(L-1)))*WEIGHT_FACT 
!(EMI_LAY(L)-EMI_LAY(L-1))/(NMM_TOP-NMM_BOT)    !dz8w(i_emi,kflip,j_emi))
                  chem(i_emi,j_emi,LM-kbot,P_TRACER)  =  chem(i_emi,j_emi,LM-kbot,P_TRACER)                           &
                         + EMI_APOST(L)*conv_rho
            ELSEIF(EMI_LAY(L).GE.NMM_TOP)THEN

              IF(EMI_LAY(L-1).GT.NMM_BOT)THEN
! FOR KBOT
                  WEIGHT_FACT=(NMM_TOP-EMI_LAY(L-1))/(NMM_TOP-NMM_BOT)
                  conv_rho=1e9*dtchem/(DARE(J_EMI)*(EMI_LAY(L)-EMI_LAY(L-1)))    
                  chem(i_emi,j_emi,k,P_TRACER)  =  chem(i_emi,j_emi,k,P_TRACER)                           &
                         + EMI_APOST(L)*conv_rho*WEIGHT_FACT
              ENDIF

               DO WHILE(EMI_LAY(L).GT.NMM_TOP)
                 KTOP=KTOP+1
!                 NMM_BOT=NMM_TOP
                 NMM_TOP=NMM_BOT+dz8w(i_emi,ktop,j_emi)
               ENDDO

! FOR KBOT+1 to KTOP
               DO KFLIP=KBOT+1,KTOP       !LM-KBOT+1,LM-(KTOP-1),-1
                  k=LM-kflip+1
                  conv_rho=1e9*dtchem/(DARE(J_EMI)*(EMI_LAY(L)-EMI_LAY(L-1)))    
                  chem(i_emi,j_emi,k,P_TRACER)  =  chem(i_emi,j_emi,k,P_TRACER)                           &
                         + EMI_APOST(L)*conv_rho
               ENDDO

               KBOT=KTOP
               KTOP=KTOP+1
               NMM_BOT=NMM_TOP
               NMM_TOP=NMM_BOT+dz8w(i_emi,ktop,j_emi)

            ENDIF

          ENDDO !L=2,4

        ELSEIF(CASE_EMI==3)THEN
          k=LM
          kflip=LM-k+1
!EMI_APOST [GBq/s]; CONC[Bq/m3]
!         conv_rho=1e9*dtchem/(DARE(J_EMI)*dz8w(i_emi,kflip,j_emi))
!EMI_APOST [Mass/s m2]; CONC[Mass/kg air]
         conv_rho=dtchem/(DARE(J_EMI)*dz8w(i_emi,kflip,j_emi)*AIRDENSITY(i_emi,kflip,j_emi))
         chem(i_emi,j_emi,k,P_TRACER)  =  chem(i_emi,j_emi,k,P_TRACER)                           &
                         + 1.*conv_rho   !EMI_APOST=1.

        ELSEIF(CASE_EMI==4)THEN
         IF(FIRSTIME2)THEN
          k=LM
          kflip=LM-k+1
!EMI_APOST [GBq/s]; CONC[Bq/m3]/AIRDENSITY -> CONC[Bq/kg]
!         conv_rho=1e9*dtchem/(DARE(J_EMI)*dz8w(i_emi,kflip,j_emi)*AIRDENSITY(i_emi,kflip,j_emi))
         conv_rho=1e9*dtchem/dp8w(i_emi,kflip,j_emi)/dare(j_emi)
         chem(i_emi,j_emi,k,P_TRACER)  =  chem(i_emi,j_emi,k,P_TRACER)                           &
                         + 1.*conv_rho   !EMI_APOST=1.
         WRITE(0,*)'EMI ENXUFADA DE 1.'
         FIRSTIME2=.FALSE.
         ENDIF
        ENDIF !CASE_EMI
!         PRINT *,'FUKU EMISS:',CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR,I_EMI,J_EMI,EMI_APOST
         GOTO 99
        ENDIF !TIME FOR EMISION

        GOTO 100

99      CONTINUE
        CLOSE(17)
      ENDIF !I_EMI J_EMI

      RETURN
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE READ_TRACER_FUKUSHIMA
!
!-----------------------------------------------------------------------
!
!---------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE READ_ACCMIP_EMISSIONS_BCOC(                           &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY                      &
                ,E_XYL,E_HNO3,E_NO2                                    &
                ,E_CO,E_NO,E_OLE,E_SO2,E_TOL                           &
                ,E_ISOP,E_MEOH,E_ALD2,E_IOLE                           &
                ,E_FORM,E_ETHA,E_ETOH,E_ETH,E_TERP,E_PAR,E_ALDX        &
                ,E_NO2_AIR,E_NO_AIR                                    &
                ,DZ8W,Z_AT_W,AIRDENSITY,CHEM,NUM_GAS_TOTAL,rh_emi      &
                ,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) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,NTIMESTEP,NCHEM,NUM_GAS_TOTAL

      REAL, INTENT(IN) :: TCHEM,DTCHEM

      REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_XYL,E_HNO3,E_NO2                                        

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_CO, E_NO, E_OLE, E_SO2, E_TOL, E_ISOP, E_MEOH, E_ALD2,    &
           E_FORM, E_ETHA, E_ETOH, E_ETH, E_TERP, E_PAR, E_ALDX,       &
           E_IOLE,E_NO2_AIR,E_NO_AIR

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W,AIRDENSITY

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(INOUT) :: rh_emi

      REAL,DIMENSION(ITS:ITE,1:LM+1,JTS:JTE),INTENT(IN) :: Z_AT_W

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS_TOTAL) :: CHEM
!Temporal to read DARE from int_state_dyn
!      TYPE(INTERNAL_STATE),POINTER       :: INT_STATE                    !<-- The dynamics internal state

!
!----------------------------------------------------------------------
!***
!***  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

      real :: zmax,conv_rho,fred

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

      LOGICAL :: EMI_ANTHRO,EMI_BBFOREST,EMI_BBGRASS,EMI_OCEAN,EMI_SOIL &
                ,EMI_SHIPS,EMI_AIRCRAFT

      REAL :: TOTAL_EMI_RED

      REAL, SAVE :: TOTAL_EMI=0.
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!

      MYPE=MYPE_SHARE

!      rh_emi=0.

      EMI_ANTHRO=.TRUE.
      EMI_BBFOREST=.TRUE.
      EMI_BBGRASS=.TRUE.
      EMI_OCEAN=.FALSE.
      EMI_SOIL=.FALSE.
      EMI_SHIPS=.TRUE.
      EMI_AIRCRAFT=.TRUE. 

      IF(MYPE==0)THEN
        print *,'----------------------------------'
        print *,'ACCMIP EMISSIONS OPTIONS FOR BCOC:'
        print *,'EMI_ANTHRO   : ',EMI_ANTHRO
        print *,'EMI_BBFOREST : ',EMI_BBFOREST
        print *,'EMI_BBGRASS  : ',EMI_BBGRASS
        print *,'EMI_OCEAN    : ',EMI_OCEAN
        print *,'EMI_SOIL     : ',EMI_SOIL
        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_SOIL_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 .OR. MOD(TCHEM,3600.0)==0.)THEN !FIRSTIME WE READ EMISSONS
      IF(NTIMESTEP==NCHEM) THEN !ONLY READ EMISSIONS AT FIRST TIMESTEP, THEN CONSTANT
! 1. READ ANTHRO EMISSIONS FROM EMI_ANTHRO_l_month01.nc - distribute vertically 100 m a.g.l.
       IF(EMI_ANTHRO) THEN
        FILENAME='EMI_ANTHRO_l_month01.nc'
        zmax=1300.  !100.   tornar a posar a 100.!!!

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

        call read_emivert (input_id,'BC',E_ALDX,dz8w,zmax,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'OC',E_CO,dz8w,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_id)
        endif
      ENDIF
! 2. READ BIOMASS BURNING FROM EMI_BBFOREST_l_month01.nc - distribute vertically within 1300 m a.g.l.
       IF(EMI_BBFOREST) THEN
        FILENAME='EMI_BBFOREST_l_month01.nc'
        zmax=1300.
        fred=1.  !reduce emission factor of fred to account for aerosol scattering of radiation
!Temporal - rh_emi for photolysis rate reduction
        rh_emi=0.
        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening EMI_BBFOREST_l_month01.nc ncfile'
          call check_stat(stat,message)
        endif
!
        call read_emivert_bb (input_id,'BC',E_ALDX,dz8w,zmax,fred,mype   &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'OC',E_CO,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        if(mype==0)then
          stat=nf90_close(input_id)
        endif
      ENDIF
! 3. READ BIOMASS BURNING FROM EMI_BBGRASS_l_month01.nc - distribute vertically within 200 m a.g.l.
      IF(EMI_BBGRASS) THEN
        FILENAME='EMI_BBGRASS_l_month01.nc'                           
        zmax=200.
        fred=1. !reduction to account for aerosol scattering effect on radiation
 
        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)         
          message='opening EMI_BBGRASS_l_month01.nc ncfile'
          call check_stat(stat,message)
        endif   
!!
        call read_emivert_bb (input_id,'BC',E_ALDX,dz8w,zmax,fred,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert_bb (input_id,'OC',E_CO,dz8w,zmax,fred,mype      &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

        if(mype==0)then
          stat=nf90_close(input_id)
        endif
      ENDIF
! 4. READ OCEAN EMISSIONS FROM EMI_OCEAN_l_month01.nc - distribute vertically 30 m a.g.l.
      IF(EMI_OCEAN) THEN
        FILENAME='EMI_OCEAN_l_month01.nc'
        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)
        if(mype==0)then
          stat=nf90_close(input_id)
        endif
      ENDIF
! 5. DISTRIBUTE EMISSIONS FROM EMI_SOIL_l_month01.nc - distribute vertically 30 m a.g.l.
      IF(EMI_SOIL) THEN
        FILENAME='EMI_SOIL_l_month01.nc'
        zmax=30.

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening EMI_SOIL_l_month01.nc ncfile'
          call check_stat(stat,message)
        endif
        call read_emivert (input_id,'NO',E_NO,dz8w,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_id)
        endif
      ENDIF
! 6. DISTRIBUTE EMISSIONS FROM EMI_SHIPS_l_month01.nc - distribute vertically 500 m a.g.l.
      IF(EMI_SHIPS) THEN
        FILENAME='EMI_SHIPS_l_month01.nc'                               
        zmax=500.
                
        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)         
          message='opening EMI_SHIPS_l_month01.nc ncfile'
          call check_stat(stat,message) 
        endif   
        call read_emivert (input_id,'BC',E_ALDX,dz8w,zmax,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        call read_emivert (input_id,'OC',E_CO,dz8w,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_id)
        endif
      ENDIF
! 7. DISTRIBUTE EMISSIONS FROM EMI_AIRCRAFT_l_month01.nc
      IF(EMI_AIRCRAFT) THEN
        FILENAME='EMI_AIRCRAFT_l_month01.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening EMI_AIRCRAFT_l_month01.nc ncfile'
          call check_stat(stat,message)
        endif
        call read_emiair (input_id,'BC',E_NO2_AIR,dz8w,mype          &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
        if(mype==0)then
          stat=nf90_close(input_id)
        endif
       ENDIF
      ENDIF !NTIMESTEP==NCHEM


! 8. INGEST EMISSIONS IN THE ATMOSPHERE
! AIRDENSITY[kg/m3]; dtchem [s]; dz8w[m]
! E_... [mol/(h*km2)]; CONC[ppmv]
! CONC[ppmv]=E_...[mol/(h*km2)]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! 8.047e-6=PMair[kg/mol]/3600[s]=0.02897/3600
! conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)

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

        do k=kme,kms,-1  !LM to 1
        kflip=LM-k+1
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
!E_BC[kg m-2 s-1 /dz8w] to P_TRACER[kg m-3]
        conv_rho=1. !/AIRDENSITY(i,k,j) if we want mixing ratio

        chem(i,j,k,P_TRACER)  =  chem(i,j,k,P_TRACER)                          &
                         + E_ALDX(i,j,k)*conv_rho

        IF(EMI_AIRCRAFT) THEN
          chem(i,j,k,P_TRACER)  =  chem(i,j,k,P_TRACER)                        &
                         + E_NO2_AIR(i,j,k)*conv_rho
        ENDIF
        enddo
      enddo
      enddo
!                          
!-----------------------------------------------------------------------
!                          
      RETURN               
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_ACCMIP_EMISSIONS_BCOC
!                          
!-----------------------------------------------------------------------

!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE READ_CALIOPE_GFAS_EMISSIONS(                          &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
                ,E_CO,E_SO2,E_NO,E_NO2,E_HONO,E_NH3,E_ALDX,E_ALD2      &
                ,E_BENZENE,E_ETH,E_ETHA,E_ETOH,E_FORM,E_IOLE           &
                ,E_ISOP,E_MEOH,E_OLE,E_PAR,E_TERP,E_TOL,E_XYL          &
                ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC,E_DMS   &
                ,E_UNSPCF_GFAS,E_BC_GFAS,E_OM_GFAS,E_SO2_GFAS          &
                ,E_DMS_GFAS                                            &
                ,P_BC1,P_BC2,P_OM1,P_OM2,P_SO4,P_NO3b1,P_NH4           &
                ,P_UNSPCF,P_UNSPCC                                     &
                ,DZ8W,AIRDENSITY,CHEM,NUM_GAS_TOTAL                    &
                ,AERO_BSC,NUM_AERO_BSC                                 &
                ,DARE,EMI_TOTAL_DBG                                    &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE) 
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  READ REGIONAL EMISSIONS FROM CALIOPE AND GFAS
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 18-10-2016
!
! ABSTRACT:
!     READ REGIONAL EMISSIONS FROM CALIOPE AND GFAS FOR REGIONAL RUNS
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   18-10-16  JORBA      - ORIGINATOR OF THE SUBROUTINE
!   18-11-16  JORBA      - READ GFAS EMISSIONS
!   21-06-18  JORBA      - ADAPT TO HERMESV3
!   19-02-19  GUEVARA    - ADDED GFAS DMS & PMFINE, OCEAN DMS CHANGED FROM MOZART TO HERMESv3, CORRECTED GFAS_SO2 FACTOR, REMOVED CH4
!
! USAGE: CALL READ_CALIOPE_GFAS_EMISSIONS
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
!      USE MODULE_CONSTANTS,ONLY : G,EPSQ,R_D,P608
!
!----------------------------------------------------------------------
!
      IMPLICIT NONE

      INCLUDE 'netcdf.inc'
!
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,START_HOUR                                 &
                           ,NTIMESTEP,NCHEM,NUM_GAS_TOTAL              &
                           ,NUM_AERO_BSC
      INTEGER,INTENT(IN) ::                                            &
                 P_BC1,P_BC2,P_OM1,P_OM2,P_SO4,P_NO3b1,P_NH4           &
                ,P_UNSPCF,P_UNSPCC
      REAL, INTENT(IN) :: TCHEM,DTCHEM

      REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
                 E_CO,E_SO2,E_NO,E_NO2,E_HONO,E_NH3,E_ALDX,E_ALD2      &
                ,E_BENZENE,E_ETH,E_ETHA,E_ETOH,E_FORM,E_IOLE           &
                ,E_ISOP,E_MEOH,E_OLE,E_PAR,E_TERP,E_TOL,E_XYL          &
                ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC,E_DMS   &
                ,E_BC_GFAS,E_OM_GFAS,E_SO2_GFAS,E_DMS_GFAS             &
                ,E_UNSPCF_GFAS

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W,AIRDENSITY

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

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,NUM_AERO_BSC),INTENT(INOUT) :: AERO_BSC

      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(INOUT) :: EMI_TOTAL_DBG
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      INTEGER :: CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR,time

      CHARACTER*120 :: FILENAME,message,var

      real :: conv_rho_gas_caliope,conv_rho_aero_caliope

      real :: conv_rho_gas_gfas,conv_rho_aero_gfas,conv_rho_gas_dms

      REAL, DIMENSION (11) :: zmin_tfmm, zmax_tfmm

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

      LOGICAL :: EMI_CALIOPE,EMI_GFAS,EMI_DMS

      REAL :: TOTAL_EMI_RED

      REAL, SAVE :: TOTAL_EMI=0.
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!

      MYPE=MYPE_SHARE

      EMI_CALIOPE=.TRUE.
      EMI_GFAS=.TRUE.
      EMI_DMS=.FALSE. !changed to false because now DMS ocean emissions are passed through HERMESv3_GR (CAMS)

      IF(MYPE==0)THEN
        print *,'----------------------------------'
        print *,'CALIOPE AND GFAS EMISSIONS'
        print *,'----------------------------------'
      ENDIF

! *** FIRST STEP ONLY
! 1. READ ANTHRO EMISSIONS FROM emis_remap_nmmb.nc
! 1.1 DISTRIBUTE EMISSIONS VERTICALLY - 11 layers
! *** ALL STEPS
! 8. INGEST EMISSIONS IN THE ATMOSPHERE

      IF(NTIMESTEP==NCHEM .OR. MOD(TCHEM,3600.0)==0.)THEN !WE READ EMISSONS EVERY HOUR
       CALL CURRENT_TIME(NTIMESTEP,START_YEAR,START_MONTH,START_DAY,START_HOUR,TCHEM,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR)
       time=CU_HOUR+1 !TIME=0UTC IS POSITION 1 IN NCFILE
!
       IF(EMI_CALIOPE) THEN
! 0. INITIALIZE EMISSION ARRAYS TO ZERO EVERYTIME WE READ NEW HOURLY EMISSIONS EXCEPT IN NCHEM
        IF(NTIMESTEP.NE.NCHEM)THEN
          E_CO=0.
          E_SO2=0.
          E_NO=0.
          E_NO2=0.
          E_HONO=0.
          E_NH3=0.
          E_ALDX=0.
          E_ALD2=0.
          E_BENZENE=0.
          E_ETH=0.
          E_ETHA=0.
          E_ETOH=0.
          E_FORM=0.
!         E_CH4=0.
          E_IOLE=0.
          E_ISOP=0.
          E_MEOH=0.
          E_OLE=0.
          E_PAR=0.
          E_TERP=0.
          E_TOL=0.
          E_XYL=0.
          E_BC=0.
          E_OM=0.
          E_SO4=0.
          E_NO3=0.
          E_NH4=0.
          E_UNSPCF=0.
          E_UNSPCC=0.
          E_DMS=0.
        ENDIF

! 1. READ ANTHRO EMISSIONS FROM EMI_ANTHRO_l_month01.nc - distribute vertically zmin,zmax

        FILENAME='hermesv3_nmmb_regional.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening CALIOPE hermesv3_nmmb_regional.nc ncfile'
          call check_stat(stat,message) !'opening EMI_ANTHRO_l_month01.nc ncfile')
        endif

!        do i=1,11 !11 !debug test 11 !LOOP OVER 11 HERMES VERTICAL LEVELS
        call read_hermesv3_regional_time (input_id,'CO',E_CO           &     
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'SO2',E_SO2         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'NO',E_NO           &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'NO2',E_NO2         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'HONO',E_HONO       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'NH3',E_NH3         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'ALDX',E_ALDX       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'ALD2',E_ALD2       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'BENZENE',E_BENZENE &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'ETH',E_ETH         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'ETHA',E_ETHA       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'ETOH',E_ETOH       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'FORM',E_FORM       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'IOLE',E_IOLE       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'ISOP',E_ISOP       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'MEOH',E_MEOH       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'OLE',E_OLE         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'PAR',E_PAR         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'TERP',E_TERP       &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'TOL',E_TOL         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'XYL',E_XYL         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'PEC',E_BC          &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'POA',E_OM          &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'PSO4',E_SO4        &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'PNO3',E_NO3        &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'PNH4',E_NH4        &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'PMFINE',E_UNSPCF   &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'PMC',E_UNSPCC      &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
        call read_hermesv3_regional_time (input_id,'DMS',E_DMS         &
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
!        enddo !i=1,11
        if(mype==0)then
          stat=nf90_close(input_id)
        endif
      ENDIF !EMI_CALIOPE

      IF(EMI_GFAS)THEN

        IF(NTIMESTEP.NE.NCHEM)THEN
          E_BC_GFAS=0.
          E_OM_GFAS=0.
          E_SO2_GFAS=0.
          E_DMS_GFAS=0.
          E_UNSPCF_GFAS=0.
        ENDIF

        FILENAME='gfasv1.2_nmmb_regional.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening gfasv1.2 for regional run'
          call check_stat(stat,message)
        endif

!BC
        call read_hermesv3_regional (input_id,'PEC',E_BC_GFAS          & !bcfire    
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POM
        call read_hermesv3_regional (input_id,'POA',E_OM_GFAS          & !ocfire
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_hermesv3_regional (input_id,'SO2',E_SO2_GFAS         & !so2fire
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!DMS
        call read_hermesv3_regional (input_id,'DMS',E_DMS_GFAS         & !dmsfire
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PMFINE
        call read_hermesv3_regional (input_id,'PMFINE',E_UNSPCF_GFAS   & !pmfinefire
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id)
       endif
      ENDIF !EMI_GFAS

      IF(EMI_DMS)THEN

        IF(NTIMESTEP.NE.NCHEM)THEN
          E_DMS=0.
        ENDIF

        FILENAME='emiss_dms.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening dms for regional run'
          call check_stat(stat,message)
        endif

!DMS
          call read_emivert_reg_v3 (input_id,'total_flux',E_DMS,dz8w   &
                        ,1,CU_DAY,mype                                 &
                        ,IDS,IDE,JDS,JDE,LM                            &
                        ,IMS,IME,JMS,JME,KMS,KME                       &
                        ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id)
       endif
      ENDIF !EMI_DMS

      ENDIF
! 2. INGEST EMISSIONS IN THE ATMOSPHERE

      do j=jts_b1,jte_b1
      do i=its_b1,ite_b1

        do k=kme,kms,-1  !LM to 1
        kflip=LM-k+1
! AIRDENSITY[kg/m3]; dtchem [s]; dz8w[m]; DARE[m2]
! CONC[ppmv]=E_...[mol/s]*3600[s/h]/DARE(j)[m2]*1e6[m2/km2]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! CONC[ppmv]=E_...[mol/s]*dtchemi[s]*PMair[kg/mol]/AIRDENSITY[kg/m3]/DARE(j)[m2]/dz8w[m]*1.e6
! E_... [mol/(h*km2)]; CONC[ppmv]
! CONC[ppmv]=E_...[mol/(h*km2)]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! 8.047e-6=PMair[kg/mol]/3600[s]=0.02897/3600
! conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
        conv_rho_gas_caliope=0.02897/AIRDENSITY(i,kflip,j)*dtchem/dz8w(i,kflip,j)*1e6       ! E_... [mol s-1 m-2]; CONC[ppmv]
        conv_rho_gas_gfas=conv_rho_gas_caliope                                               
        conv_rho_gas_dms=0.02897/(AIRDENSITY(i,kflip,j)*dz8w(i,kflip,j))*dtchem*1e6        ! E_... [kg(S)/m2/day]; CONC[ppmv] !factors added below 32.065 g/mol (S), 1000 because kg(S) 
        conv_rho_aero_caliope=dtchem/dz8w(i,kflip,j)                                       ! E_... [kg s-1 m-2]; CONC[kg m-3]
        conv_rho_aero_gfas=conv_rho_aero_caliope                                           ! E_... [kg m-2 s-1]; CONC[kg m-3]

        IF(EMI_CALIOPE)THEN
        chem(i,j,k,P_CO)      =  chem(i,j,k,P_CO)                          &
                         + E_CO(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_SO2)     =  chem(i,j,k,P_SO2)                         &
                         + E_SO2(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_NO)      =  chem(i,j,k,P_NO)                          &
                         + E_NO(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_NO2)     =  chem(i,j,k,P_NO2)                         &
                         + E_NO2(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_HONO)    =  chem(i,j,k,P_HONO)                        &
                         + E_HONO(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_NH3)     =  chem(i,j,k,P_NH3)                         &
                         + E_NH3(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_ALDX)    =  chem(i,j,k,P_ALDX)                        &
                         + E_ALDX(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_ALD2)    =  chem(i,j,k,P_ALD2)                        &
                         + E_ALD2(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_BENZENE) =  chem(i,j,k,P_BENZENE)                     &
                         + E_BENZENE(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_ETH)     =  chem(i,j,k,P_ETH)                         &
                         + E_ETH(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_ETHA)    =  chem(i,j,k,P_ETHA)                        &
                         + E_ETHA(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_ETOH)    =  chem(i,j,k,P_ETOH)                        &
                         + E_ETOH(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_FORM)    =  chem(i,j,k,P_FORM)                        &
                         + E_FORM(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_IOLE)    =  chem(i,j,k,P_IOLE)                        &
                         + E_IOLE(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_ISOP)    =  chem(i,j,k,P_ISOP)                        &
                         + E_ISOP(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_MEOH)    =  chem(i,j,k,P_MEOH)                        &
                         + E_MEOH(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_OLE)     =  chem(i,j,k,P_OLE)                         &
                         + E_OLE(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_PAR)     =  chem(i,j,k,P_PAR)                         &
                         + E_PAR(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_TERP)    =  chem(i,j,k,P_TERP)                        &
                         + E_TERP(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_TOL)     =  chem(i,j,k,P_TOL)                         &
                         + E_TOL(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_XYL)     =  chem(i,j,k,P_XYL)                         &
                         + E_XYL(i,j,k)*conv_rho_gas_caliope
        chem(i,j,k,P_DMS)     =  chem(i,j,k,P_DMS)                         &
                         + E_DMS(i,j,k)*conv_rho_gas_caliope
        aero_bsc(i,j,k,P_BC1)  =  aero_bsc(i,j,k,P_BC1)                    & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + E_BC(i,j,k)*conv_rho_aero_caliope*0.8
        aero_bsc(i,j,k,P_BC2)  =  aero_bsc(i,j,k,P_BC2)                    & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + E_BC(i,j,k)*conv_rho_aero_caliope*0.2
        aero_bsc(i,j,k,P_OM1)  =  aero_bsc(i,j,k,P_OM1)                    & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + E_OM(i,j,k)*conv_rho_aero_caliope*0.5             ! OM/OC=1.6 not applied, already OA
        aero_bsc(i,j,k,P_OM2)  =  aero_bsc(i,j,k,P_OM2)                    & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + E_OM(i,j,k)*conv_rho_aero_caliope*0.5             ! OM/OC=1.6 not applied, already OA
        aero_bsc(i,j,k,P_SO4)  =  aero_bsc(i,j,k,P_SO4)                    &
                         + E_SO4(i,j,k)*conv_rho_aero_caliope
        aero_bsc(i,j,k,P_NO3b1)=  aero_bsc(i,j,k,P_NO3b1)                  &
                         + E_NO3(i,j,k)*conv_rho_aero_caliope
        aero_bsc(i,j,k,P_NH4)  =  aero_bsc(i,j,k,P_NH4)                    &
                         + E_NH4(i,j,k)*conv_rho_aero_caliope
        aero_bsc(i,j,k,P_UNSPCF)  =  aero_bsc(i,j,k,P_UNSPCF)              &
                         + E_UNSPCF(i,j,k)*conv_rho_aero_caliope
        aero_bsc(i,j,k,P_UNSPCC)  =  aero_bsc(i,j,k,P_UNSPCC)              &
                         + E_UNSPCC(i,j,k)*conv_rho_aero_caliope
        ENDIF

        IF(EMI_GFAS)THEN
        CHEM(i,j,k,P_SO2)  =  CHEM(i,j,k,P_SO2)                             & ! emi in kg(SO2)/m2/s
!                         + E_SO2_GFAS(i,j,k)*conv_rho_gas_gfas*1000/64.066
                         + E_SO2_GFAS(i,j,k)*conv_rho_gas_gfas              ! emi already given in mol/m2/s by HERMESv3_GR
        CHEM(i,j,k,P_DMS)  =  CHEM(i,j,k,P_DMS)                             &
                         + E_DMS_GFAS(i,j,k)*conv_rho_gas_gfas
        AERO_BSC(i,j,k,P_BC1)  =  AERO_BSC(i,j,k,P_BC1)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.8*E_BC_GFAS(i,j,k)*conv_rho_aero_gfas
        AERO_BSC(i,j,k,P_BC2)  =  AERO_BSC(i,j,k,P_BC2)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.2*E_BC_GFAS(i,j,k)*conv_rho_aero_gfas
        AERO_BSC(i,j,k,P_OM1)  =  AERO_BSC(i,j,k,P_OM1)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 1.6*0.5*E_OM_GFAS(i,j,k)*conv_rho_aero_gfas        ! OM/OC=1.6
        AERO_BSC(i,j,k,P_OM2)  =  AERO_BSC(i,j,k,P_OM2)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 1.6*0.5*E_OM_GFAS(i,j,k)*conv_rho_aero_gfas        ! OM/OC=1.6
        AERO_BSC(i,j,k,P_UNSPCF)  =  AERO_BSC(i,j,k,P_UNSPCF)               &
                         + E_UNSPCF_GFAS(i,j,k)*conv_rho_aero_gfas
        ENDIF

        IF(EMI_DMS)THEN
        !/24 because daily totals
        !conv_rho2 -> mixing-ratio emi
        !32.065 g/mol (S)
        !1000 because kg(S)
        CHEM(i,j,k,P_DMS) = CHEM(i,j,k,P_DMS)                                 &
                         + E_DMS(i,j,k)*conv_rho_gas_dms*1000/(32.065*24*3600.) ! emi in kg(S)/m2/day 
        ENDIF
        EMI_TOTAL_DBG(i,j) = EMI_TOTAL_DBG(i,j) + E_NO2(i,j,k) * dtchem * DARE(j) * 1.e-6 ! E_... [mol s-1 km-2];TOTAL [mol]
        enddo
      enddo
      enddo
!
!-----------------------------------------------------------------------
!                          
      RETURN               
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_CALIOPE_GFAS_EMISSIONS
!
!-----------------------------------------------------------------------
!
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE READ_HERMESv3_GFAS_GLOBAL_EMISSIONS(                  &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
                ,XLAT,XLONG                                            &
                ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC,E_DMS   &
                ,E_BC_GFAS,E_OM_GFAS,E_SO2_GFAS,E_DMS_GFAS             &
                ,E_UNSPCF_GFAS,E_SO2,E_NH3,E_CO,E_CO_GFAS              &
                ,P_BC1,P_BC2,P_OM1,P_OM2,P_OM3,P_OM4,P_SO4             &
                ,P_NO3b1,P_NH4,P_UNSPCF,P_UNSPCC                       &
                ,DZ8W,AIRDENSITY,CHEM,NUM_GAS_TOTAL                    &
                ,AERO_BSC,NUM_AERO_BSC                                 &
                ,DARE,EMI_TOTAL_DBG                                    &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE) 
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  READ GLOBAL EMISSIONS FROM HERMESv3 AND GFAS
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 17-05-2017
!
! ABSTRACT:
!     READ GLOBAL EMISSIONS FROM HERMESv3 AND GFAS FOR GLOBAL RUNS
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   17-05-17  JORBA      - ORIGINATOR OF THE SUBROUTINE
!
! USAGE: CALL READ_HERMESv3_GFAS_GLOBAL_EMISSIONS
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
!      USE MODULE_CONSTANTS,ONLY : G,EPSQ,R_D,P608
!
!----------------------------------------------------------------------
!
      IMPLICIT NONE

      INCLUDE 'netcdf.inc'
!
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,START_HOUR                                 &
                           ,NTIMESTEP,NCHEM,NUM_GAS_TOTAL              &
                           ,NUM_AERO_BSC
      INTEGER,INTENT(IN) ::                                            &
                 P_BC1,P_BC2,P_OM1,P_OM2,P_OM3,P_OM4,P_SO4             &
                ,P_NO3b1,P_NH4,P_UNSPCF,P_UNSPCC
      REAL, INTENT(IN) :: TCHEM,DTCHEM

      REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
                 E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC,E_DMS   &
                ,E_BC_GFAS,E_OM_GFAS,E_SO2_GFAS,E_DMS_GFAS             &
                ,E_SO2,E_UNSPCF_GFAS,E_NH3,E_CO,E_CO_GFAS

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W,AIRDENSITY

      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: XLAT,XLONG

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

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,NUM_AERO_BSC),INTENT(INOUT) :: AERO_BSC

      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(INOUT) :: EMI_TOTAL_DBG
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      INTEGER :: CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR,time

      CHARACTER*120 :: FILENAME,message,var

      real :: conv_rho_gas_gfas,conv_rho_aero_gfas

!      REAL, DIMENSION (11) :: zmin_tfmm, zmax_tfmm

!      DATA zmin_tfmm /0.,48.,69.,138.,280.,427.,654.,1052.,1553.,2088.,2957./
!      DATA zmin_tfmm /0.,50.2,108.4,175.1,251.,337.,434.6,545.9,673. &
!                     ,816.6,985.7/  
!      DATA zmax_tfmm /48.,69.,138.,280.,427.,654.,1052.,1553.,2088.,2957.,4031./
!      DATA zmax_tfmm /50.2,108.4,175.1,251.,337.,434.6,545.9,673.    &
!                     ,816.6,985.7,1178./

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

      INTEGER :: FACT_BC,FACT_OM

      LOGICAL :: EMI_HERMES,EMI_GFAS

      REAL :: TOTAL_EMI_RED

      REAL, SAVE :: TOTAL_EMI=0.
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!

      MYPE=MYPE_SHARE
    
      EMI_HERMES=.TRUE.
      EMI_GFAS=.TRUE.

      IF(MYPE==0)THEN
        print *,'-----------------------------------'
        print *,'HERMESv3 AND GFAS GLOBAL  EMISSIONS'
        print *,'-----------------------------------'
      ENDIF

! *** FIRST STEP ONLY
! 1. READ ANTHRO EMISSIONS FROM gfas_global_nmmb.nc
! 1.1 DISTRIBUTE EMISSIONS VERTICALLY - LM layers
! *** ALL STEPS
! 8. INGEST EMISSIONS IN THE ATMOSPHERE

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

        IF(EMI_HERMES)THEN

        FILENAME='hermesv3_nmmb_global.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening hermesv3 for global run'
          call check_stat(stat,message)
        endif

!BC
        call read_hermesv3_global (input_id,'PEC',E_BC                 &     
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POA
        call read_hermesv3_global (input_id,'POA',E_OM                 &     
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PSO4
        call read_hermesv3_global (input_id,'PSO4',E_SO4               &     
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PMFINE
        call read_hermesv3_global (input_id,'PMFINE',E_UNSPCF          & 
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PMCOARSE
        call read_hermesv3_global (input_id,'PMC',E_UNSPCC             &     
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_hermesv3_global (input_id,'SO2',E_SO2                &     
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!DMS
        call read_hermesv3_global (input_id,'DMS',E_DMS                &     
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!NH3
        call read_hermesv3_global (input_id,'NH3',E_NH3                &     
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!CO
        call read_hermesv3_global (input_id,'CO',E_CO                  &     
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id)
       endif
      ENDIF !EMI_HERMES

        IF(EMI_GFAS)THEN

        FILENAME='gfasv1.2_nmmb_global.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening gfasv1.2 for global run'
          call check_stat(stat,message)
        endif

!BC
        call read_hermesv3_global (input_id,'PEC',E_BC_GFAS            & 
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POA
        call read_hermesv3_global (input_id,'POA',E_OM_GFAS            & 
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PMFINE
        call read_hermesv3_global (input_id,'PMFINE',E_UNSPCF_GFAS     & 
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_hermesv3_global (input_id,'SO2',E_SO2_GFAS           & 
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!DMS
        call read_hermesv3_global (input_id,'DMS',E_DMS_GFAS           & 
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!CO
        call read_hermesv3_global (input_id,'CO',E_CO_GFAS             & 
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

       if(mype==0)then
         stat=nf90_close(input_id)
       endif
      ENDIF !EMI_GFAS

      ENDIF
! 2. INGEST EMISSIONS IN THE ATMOSPHERE

      do j=jts_b1,jte_b1
       do i=its_b1,ite_b1
        do k=kme,kms,-1  !LM to 1
        kflip=LM-k+1
! AIRDENSITY[kg/m3]; dtchem [s]; dz8w[m]; DARE[m2]
! CONC[ppmv]=E_...[mol/s]*3600[s/h]/DARE(j)[m2]*1e6[m2/km2]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! CONC[ppmv]=E_...[mol/s]*dtchemi[s]*PMair[kg/mol]/AIRDENSITY[kg/m3]/DARE(j)[m2]/dz8w[m]*1.e6
! E_... [mol/(h*km2)]; CONC[ppmv]
! CONC[ppmv]=E_...[mol/(h*km2)]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! 8.047e-6=PMair[kg/mol]/3600[s]=0.02897/3600
! conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
!        conv_rho_gas_caliope=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)                 ! E_... [mol h-1 km-2]; CONC[ppmv]
!        conv_rho_gas_caliope=0.02897/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)                  ! E_... [mol s-1 km-2]; CONC[ppmv]
!        conv_rho_gas_caliope=0.02897*dtchem/AIRDENSITY(i,kflip,j)/DARE(j)/dz8w(i,k,j)*1.e6 ! E_... [mol s-1]; CONC[ppmv]
!        conv_rho_gas_gfas=0.02897/(AIRDENSITY(i,kflip,j)*dz8w(i,kflip,j))*dtchem*1e6       ! E_... [kg m-2 s-1]; CONC[ppmv]
!        conv_rho_gas_dms=0.02897/(AIRDENSITY(i,kflip,j)*dz8w(i,kflip,j))*dtchem*1e6        ! E_... [kg(S)/m2/day]; CONC[ppmv] !factors added below 32.065 g/mol (S), 1000 because kg(S) 
!        conv_rho_aero_caliope=dtchem/(dz8w(i,k,j)*1e-3)/1000.*1e-9                         ! E_... [g s-1 km-2]; CONC[ppmv]
!        conv_rho_aero_caliope=dtchem/DARE(j)/dz8w(i,k,j)/1000.                             ! E_... [g s-1]; CONC[kg m-3]
        conv_rho_aero_gfas=dtchem/dz8w(i,kflip,j)                                           ! E_... [kg m-2 s-1]; CONC[kg m-3]
        conv_rho_gas_gfas=0.02897/AIRDENSITY(i,kflip,j)*dtchem/dz8w(i,kflip,j)*1e6                  ! E_... [mol s-1 m-2]; CONC[ppmv]

        IF(EMI_HERMES)THEN
        CHEM(i,j,k,P_SO2)  =  CHEM(i,j,k,P_SO2)                             &
                         + E_SO2(i,j,k)*conv_rho_gas_gfas                     
        CHEM(i,j,k,P_DMS)  =  CHEM(i,j,k,P_DMS)                             &
                         + E_DMS(i,j,k)*conv_rho_gas_gfas   
        CHEM(i,j,k,P_NH3)  =  CHEM(i,j,k,P_NH3)                             &
                         + E_NH3(i,j,k)*conv_rho_gas_gfas
        CHEM(i,j,k,P_VOCA) =  CHEM(i,j,k,P_VOCA)                            &
                         + E_CO(i,j,k)*conv_rho_gas_gfas*0.08                 ! Following Hodzic and Jimenez 2011: E(VOCa)/E(CO)=0.08 g g-1_co
        AERO_BSC(i,j,k,P_BC1)  =  AERO_BSC(i,j,k,P_BC1)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.8*E_BC(i,j,k)*conv_rho_aero_gfas  
        AERO_BSC(i,j,k,P_BC2)  =  AERO_BSC(i,j,k,P_BC2)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.2*E_BC(i,j,k)*conv_rho_aero_gfas  
        AERO_BSC(i,j,k,P_OM1)  =  AERO_BSC(i,j,k,P_OM1)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 0.5*E_OM(i,j,k)*conv_rho_aero_gfas                   ! not OM/OC=1.6 conversion needed, emissions already in OA
        AERO_BSC(i,j,k,P_OM2)  =  AERO_BSC(i,j,k,P_OM2)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 0.5*E_OM(i,j,k)*conv_rho_aero_gfas                   ! not OM/OC=1.6 conversion needed, emissions already in OA 
        AERO_BSC(i,j,k,P_SO4)  =  AERO_BSC(i,j,k,P_SO4)                     & 
                         + E_SO4(i,j,k)*conv_rho_aero_gfas  
        AERO_BSC(i,j,k,P_UNSPCF)  =  AERO_BSC(i,j,k,P_UNSPCF)               & 
                         + E_UNSPCF(i,j,k)*conv_rho_aero_gfas  
        AERO_BSC(i,j,k,P_UNSPCC)  =  AERO_BSC(i,j,k,P_UNSPCC)               & 
                         + E_UNSPCC(i,j,k)*conv_rho_aero_gfas  
        ENDIF

        IF(EMI_GFAS)THEN
        CHEM(i,j,k,P_SO2)  =  CHEM(i,j,k,P_SO2)                             & 
                         + E_SO2_GFAS(i,j,k)*conv_rho_gas_gfas 
        CHEM(i,j,k,P_DMS)  =  CHEM(i,j,k,P_DMS)                             & 
                         + E_DMS_GFAS(i,j,k)*conv_rho_gas_gfas            
        CHEM(i,j,k,P_VOCBB) =  CHEM(i,j,k,P_VOCBB)                          &
                         + E_CO_GFAS(i,j,k)*conv_rho_gas_gfas*0.08              ! Following Hodzic and Jimenez 2011: E(VOCa)/E(CO)=0.08 g g-1_co

!        IF(XLAT(i,j).GT.50.)THEN
!          FACT_BC=0.5 !to obtain x3. scaling factor
!          FACT_OM=0.5 !to obtain x1.5 scaling factor
!        ELSE
          FACT_BC=1. !6. already in the input emissions
          FACT_OM=1. !3. already in the input emissions
!        ENDIF
        AERO_BSC(i,j,k,P_BC1)  =  AERO_BSC(i,j,k,P_BC1)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.8*E_BC_GFAS(i,j,k)*conv_rho_aero_gfas*FACT_BC !scaling factor=6
        AERO_BSC(i,j,k,P_BC2)  =  AERO_BSC(i,j,k,P_BC2)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.2*E_BC_GFAS(i,j,k)*conv_rho_aero_gfas*FACT_BC !scaling factor=6
        AERO_BSC(i,j,k,P_OM3)  =  AERO_BSC(i,j,k,P_OM3)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 0.5*E_OM_GFAS(i,j,k)*conv_rho_aero_gfas*FACT_OM !scaling factor=3            ! not OM/OC=1.6 conversion needed, emissions already in OA
        AERO_BSC(i,j,k,P_OM4)  =  AERO_BSC(i,j,k,P_OM4)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 0.5*E_OM_GFAS(i,j,k)*conv_rho_aero_gfas*FACT_OM !scaling factor=3            ! not OM/OC=1.6 conversion needed, emissions already in OA 
        AERO_BSC(i,j,k,P_UNSPCF)  =  AERO_BSC(i,j,k,P_UNSPCF)               & 
                         + E_UNSPCF_GFAS(i,j,k)*conv_rho_aero_gfas
        ENDIF

        enddo
       enddo
      enddo
!
!-----------------------------------------------------------------------
!                          
      RETURN               
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_HERMESv3_GFAS_GLOBAL_EMISSIONS
!
!-----------------------------------------------------------------------
      SUBROUTINE READ_HERMESv3HOURLY_GFASDAILY_GLOBAL_EMISSIONS(       &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
                ,XLAT,XLONG                                            &
                ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC,E_DMS   &
                ,E_BC_GFAS,E_OM_GFAS,E_SO2_GFAS,E_DMS_GFAS             &
                ,E_UNSPCF_GFAS,E_SO2,E_NH3                             &
                ,P_BC1,P_BC2,P_OM1,P_OM2,P_SO4,P_NO3b1,P_NH4           &
                ,P_UNSPCF,P_UNSPCC                                     &
                ,DZ8W,AIRDENSITY,CHEM,NUM_GAS_TOTAL                    &
                ,AERO_BSC,NUM_AERO_BSC                                 &
                ,DARE,EMI_TOTAL_DBG                                    &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE) 
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  READ GLOBAL EMISSIONS FROM HERMESv3_hourly AND GFAS_daily
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 02-05-2018
!
! ABSTRACT:
!     READ GLOBAL EMISSIONS FROM HERMESv3 AND GFAS FOR GLOBAL RUNS
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   02-05-18  JORBA      - ORIGINATOR OF THE SUBROUTINE
!
! USAGE: CALL READ_HERMESv3HOURLY_GFASDAILY_GLOBAL_EMISSIONS
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
!      USE MODULE_CONSTANTS,ONLY : G,EPSQ,R_D,P608
!
!----------------------------------------------------------------------
!
      IMPLICIT NONE

      INCLUDE 'netcdf.inc'
!
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,START_HOUR                                 &
                           ,NTIMESTEP,NCHEM,NUM_GAS_TOTAL              &
                           ,NUM_AERO_BSC
      INTEGER,INTENT(IN) ::                                            &
                 P_BC1,P_BC2,P_OM1,P_OM2,P_SO4,P_NO3b1,P_NH4           &
                ,P_UNSPCF,P_UNSPCC
      REAL, INTENT(IN) :: TCHEM,DTCHEM

      REAL,DIMENSION(JDS:JDE),INTENT(IN) :: DARE

      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
                 E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC,E_DMS   &
                ,E_BC_GFAS,E_OM_GFAS,E_SO2_GFAS,E_DMS_GFAS             &
                ,E_SO2,E_UNSPCF_GFAS,E_NH3

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W,AIRDENSITY

      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: XLAT,XLONG

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

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,NUM_AERO_BSC),INTENT(INOUT) :: AERO_BSC

      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(INOUT) :: EMI_TOTAL_DBG
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      INTEGER :: CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR,time

      CHARACTER*120 :: FILENAME,message,var

      real :: conv_rho_gas_gfas,conv_rho_aero_gfas

!      REAL, DIMENSION (11) :: zmin_tfmm, zmax_tfmm

!      DATA zmin_tfmm /0.,48.,69.,138.,280.,427.,654.,1052.,1553.,2088.,2957./
!      DATA zmin_tfmm /0.,50.2,108.4,175.1,251.,337.,434.6,545.9,673. &
!                     ,816.6,985.7/  
!      DATA zmax_tfmm /48.,69.,138.,280.,427.,654.,1052.,1553.,2088.,2957.,4031./
!      DATA zmax_tfmm /50.2,108.4,175.1,251.,337.,434.6,545.9,673.    &
!                     ,816.6,985.7,1178./

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

      INTEGER :: FACT_BC,FACT_OM

      LOGICAL :: EMI_HERMES,EMI_GFAS

      REAL :: TOTAL_EMI_RED

      REAL, SAVE :: TOTAL_EMI=0.
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!

      MYPE=MYPE_SHARE
    
      EMI_HERMES=.TRUE.
      EMI_GFAS=.TRUE.

      IF(MYPE==0)THEN
        print *,'------------------------------------------------'
        print *,'HERMESv3 HOURLY AND GFAS DAILY GLOBAL  EMISSIONS'
        print *,'------------------------------------------------'
      ENDIF

! *** FIRST STEP ONLY
! 1. READ ANTHRO EMISSIONS FROM gfas_global_nmmb.nc
! 1.1 DISTRIBUTE EMISSIONS VERTICALLY - LM layers
! *** ALL STEPS
! 8. INGEST EMISSIONS IN THE ATMOSPHERE

      IF(EMI_HERMES)THEN
!      IF(NTIMESTEP==NCHEM)THEN !ONLY READ EMISSIONS AT FIRST TIMESTEP, THEN CONSTANT
      IF(NTIMESTEP==NCHEM .OR. MOD(TCHEM,3600.0)==0.)THEN !WE READ EMISSONS EVERY HOUR
        CALL CURRENT_TIME(NTIMESTEP,START_YEAR,START_MONTH,START_DAY,START_HOUR,TCHEM,CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR)
        time=CU_HOUR+1 !TIME=0UTC IS POSITION 1 IN NCFILE

      IF(MYPE==0)THEN
        print *,'READING HOUR HERMESv3 EMISSION: ',CU_HOUR
      ENDIF

! 0. INITIALIZE EMISSION ARRAYS TO ZERO EVERYTIME WE READ NEW HOURLY EMISSIONS EXCEPT IN NCHEM
!        IF(NTIMESTEP.NE.NCHEM)THEN
!          E_BC=0.
!          E_OM=0.
!          E_SO4=0.
!          E_UNSPCF=0.
!          E_UNSPCC=0.
!          E_SO2=0.
!          E_DMS=0.
!        ENDIF

        FILENAME='hermesv3_nmmb_global.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening hermesv3 for global run'
          call check_stat(stat,message)
        endif

!BC
        call read_hermesv3_global_time (input_id,'PEC',E_BC            & !bc    
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POA
        call read_hermesv3_global_time (input_id,'POA',E_OM            & !oc    
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PSO4
        call read_hermesv3_global_time (input_id,'PSO4',E_SO4          & !so4    
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PMFINE
        call read_hermesv3_global_time (input_id,'PMFINE',E_UNSPCF     & !pmfine
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PMCOARSE
        call read_hermesv3_global_time (input_id,'PMC',E_UNSPCC        & !pmcoarse    
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_hermesv3_global_time (input_id,'SO2',E_SO2           & !so2    
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!DMS
        call read_hermesv3_global_time (input_id,'DMS',E_DMS           & !dms    
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!NH3
        call read_hermesv3_global_time (input_id,'NH3',E_NH3           & !nh3    
                ,dz8w,time,mype                                        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)


       if(mype==0)then
         stat=nf90_close(input_id)
       endif
      ENDIF !TIME HOURLY

      ENDIF !EMI_HERMES
     
      IF(EMI_GFAS)THEN

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

        FILENAME='gfasv1.2_nmmb_global.nc'

        if(mype==0)then
          STAT=NF90_OPEN(TRIM(FILENAME),NF90_NOWRITE,INPUT_ID)
          message='opening gfasv1.2 for global run'
          call check_stat(stat,message)
        endif

!BC
        call read_hermesv3_global (input_id,'PEC',E_BC_GFAS            & !bcfire
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!POA
        call read_hermesv3_global (input_id,'POA',E_OM_GFAS            & !ocfire
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!PMFINE
        call read_hermesv3_global (input_id,'PMFINE',E_UNSPCF_GFAS     & !pmfine
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!SO2
        call read_hermesv3_global (input_id,'SO2',E_SO2_GFAS           & !so2fire
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!DMS
        call read_hermesv3_global (input_id,'DMS',E_DMS_GFAS           & !dmsfire
                ,dz8w,mype                                             &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

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

      ENDIF !TIME
 
      ENDIF !EMI_GFAS

! 2. INGEST EMISSIONS IN THE ATMOSPHERE

      do j=jts_b1,jte_b1
       do i=its_b1,ite_b1
        do k=kme,kms,-1  !LM to 1
        kflip=LM-k+1
! AIRDENSITY[kg/m3]; dtchem [s]; dz8w[m]; DARE[m2]
! CONC[ppmv]=E_...[mol/s]*3600[s/h]/DARE(j)[m2]*1e6[m2/km2]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! CONC[ppmv]=E_...[mol/s]*dtchemi[s]*PMair[kg/mol]/AIRDENSITY[kg/m3]/DARE(j)[m2]/dz8w[m]*1.e6
! E_... [mol/(h*km2)]; CONC[ppmv]
! CONC[ppmv]=E_...[mol/(h*km2)]*PMair[kg/mol]/3600[s]/AIRDENSITY[kg/m3]*dtchemi[s]/dz8w[m]
! 8.047e-6=PMair[kg/mol]/3600[s]=0.02897/3600
! conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
!        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions
!        conv_rho_gas_caliope=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)                 ! E_... [mol h-1 km-2]; CONC[ppmv]
!        conv_rho_gas_caliope=0.02897/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)                  ! E_... [mol s-1 km-2]; CONC[ppmv]
!        conv_rho_gas_caliope=0.02897*dtchem/AIRDENSITY(i,kflip,j)/DARE(j)/dz8w(i,k,j)*1.e6 ! E_... [mol s-1]; CONC[ppmv]
!        conv_rho_gas_gfas=0.02897/(AIRDENSITY(i,kflip,j)*dz8w(i,kflip,j))*dtchem*1e6       ! E_... [kg m-2 s-1]; CONC[ppmv]
!        conv_rho_gas_dms=0.02897/(AIRDENSITY(i,kflip,j)*dz8w(i,kflip,j))*dtchem*1e6        ! E_... [kg(S)/m2/day]; CONC[ppmv] !factors added below 32.065 g/mol (S), 1000 because kg(S) 
!        conv_rho_aero_caliope=dtchem/(dz8w(i,k,j)*1e-3)/1000.*1e-9                         ! E_... [g s-1 km-2]; CONC[ppmv]
!        conv_rho_aero_caliope=dtchem/DARE(j)/dz8w(i,k,j)/1000.                             ! E_... [g s-1]; CONC[kg m-3]
        conv_rho_aero_gfas=dtchem/dz8w(i,kflip,j)                                           ! E_... [kg m-2 s-1]; CONC[kg m-3]
        conv_rho_gas_gfas=0.02897/AIRDENSITY(i,kflip,j)*dtchem/dz8w(i,kflip,j)*1e6                  ! E_... [mol s-1 m-2]; CONC[ppmv]

        IF(EMI_HERMES)THEN
        CHEM(i,j,k,P_SO2)  =  CHEM(i,j,k,P_SO2)                             &
                         + E_SO2(i,j,k)*conv_rho_gas_gfas                     
        CHEM(i,j,k,P_DMS)  =  CHEM(i,j,k,P_DMS)                             &
                         + E_DMS(i,j,k)*conv_rho_gas_gfas   
        CHEM(i,j,k,P_NH3)  =  CHEM(i,j,k,P_NH3)                             &
                         + E_NH3(i,j,k)*conv_rho_gas_gfas
        AERO_BSC(i,j,k,P_BC1)  =  AERO_BSC(i,j,k,P_BC1)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.8*E_BC(i,j,k)*conv_rho_aero_gfas  
        AERO_BSC(i,j,k,P_BC2)  =  AERO_BSC(i,j,k,P_BC2)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.2*E_BC(i,j,k)*conv_rho_aero_gfas  
        AERO_BSC(i,j,k,P_OM1)  =  AERO_BSC(i,j,k,P_OM1)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 0.5*E_OM(i,j,k)*conv_rho_aero_gfas                   ! not OM/OC=1.6 conversion needed, emissions already in OA
        AERO_BSC(i,j,k,P_OM2)  =  AERO_BSC(i,j,k,P_OM2)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 0.5*E_OM(i,j,k)*conv_rho_aero_gfas                   ! not OM/OC=1.6 conversion needed, emissions already in OA 
        AERO_BSC(i,j,k,P_SO4)  =  AERO_BSC(i,j,k,P_SO4)                     & 
                         + E_SO4(i,j,k)*conv_rho_aero_gfas  
        AERO_BSC(i,j,k,P_UNSPCF)  =  AERO_BSC(i,j,k,P_UNSPCF)               & 
                         + E_UNSPCF(i,j,k)*conv_rho_aero_gfas  
        AERO_BSC(i,j,k,P_UNSPCC)  =  AERO_BSC(i,j,k,P_UNSPCC)               & 
                         + E_UNSPCC(i,j,k)*conv_rho_aero_gfas  
        ENDIF

        IF(EMI_GFAS)THEN
        CHEM(i,j,k,P_SO2)  =  CHEM(i,j,k,P_SO2)                             & 
                         + E_SO2_GFAS(i,j,k)*conv_rho_gas_gfas 
        CHEM(i,j,k,P_DMS)  =  CHEM(i,j,k,P_DMS)                             & 
                         + E_DMS_GFAS(i,j,k)*conv_rho_gas_gfas            
        IF(XLAT(i,j).GT.50.)THEN
          FACT_BC=0.5 !to obtain x3. scaling factor
          FACT_OM=0.5 !to obtain x1.5 scaling factor
        ELSE
          FACT_BC=1. !6. already in the input emissions
          FACT_OM=1. !3. already in the input emissions
        ENDIF
        AERO_BSC(i,j,k,P_BC1)  =  AERO_BSC(i,j,k,P_BC1)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.8*E_BC_GFAS(i,j,k)*conv_rho_aero_gfas*FACT_BC !scaling factor=6
        AERO_BSC(i,j,k,P_BC2)  =  AERO_BSC(i,j,k,P_BC2)                     & ! Following (i) Chin et al., 2001: 80% phob/ 20% phil
                         + 0.2*E_BC_GFAS(i,j,k)*conv_rho_aero_gfas*FACT_BC !scaling factor=6
        AERO_BSC(i,j,k,P_OM1)  =  AERO_BSC(i,j,k,P_OM1)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 0.5*E_OM_GFAS(i,j,k)*conv_rho_aero_gfas*FACT_OM !scaling factor=3            ! not OM/OC=1.6 conversion needed, emissions already in OA
        AERO_BSC(i,j,k,P_OM2)  =  AERO_BSC(i,j,k,P_OM2)                     & ! Following (i) Cooke et al., 1999 assumed (GOCART): 50% phob/ 50% phil
                         + 0.5*E_OM_GFAS(i,j,k)*conv_rho_aero_gfas*FACT_OM !scaling factor=3            ! not OM/OC=1.6 conversion needed, emissions already in OA 
        AERO_BSC(i,j,k,P_UNSPCF)  =  AERO_BSC(i,j,k,P_UNSPCF)               & 
                         + E_UNSPCF_GFAS(i,j,k)*conv_rho_aero_gfas
        ENDIF

        enddo
       enddo
      enddo
!
!-----------------------------------------------------------------------
!                          
      RETURN               
!                          
!-----------------------------------------------------------------------
!                          
      END SUBROUTINE READ_HERMESv3HOURLY_GFASDAILY_GLOBAL_EMISSIONS
!
!-----------------------------------------------------------------------
!
!---------------------------------------------------------------------
subroutine read_emivert_reg_v2 (input_id,var,emi,dz8w,lay,time,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

      integer, intent(in) :: lay,time

      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 ) :: 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
!----------

        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,lay,time/),count=(/ide-3,jde-4,lay,time/))
          stat=nf90_get_var(input_id,ncid_in,temp1,start=(/1,1,lay,time/),count=(/ide,jde,1,1/))

!out for regional. 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(dztot.lt.zmax)
          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)
              !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) !update emi for the vertical loop
            if (sum(femi).lt.0.995.or.sum(femi).gt.1.005)then
              write(*,*) 'CALIOPE: 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
         endif
        enddo
        enddo

end subroutine read_emivert_reg_v2
!---------------------------------------------------------------------

!---------------------------------------------------------------------
!simplified subroutine
!adds directly emiss layer N to E_...[i,j,n]
subroutine read_emivert_reg_v3 (input_id,var,emi,dz8w,lay,time,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

      integer, intent(in) :: lay,time

      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 ) :: 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
!----------

        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,lay,time/),count=(/ide-3,jde-4,lay,time/))
          stat=nf90_get_var(input_id,ncid_in,temp1,start=(/1,1,time/),count=(/ide,jde,1/))

!out for regional. 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)
! copy emissions to lay
        emi(:,:,LM-lay+1)=temp2(:,:,LM)
! distribute emissions vertically

end subroutine read_emivert_reg_v3
!---------------------------------------------------------------------
subroutine read_emivert_gfas_reg (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

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  !!!WE NEED TO DEAL WITH SCALE_FACTOR AND ADD_OFFSET: VARfinal=SCALE_FACTOR*VAR+ADD_OFFSET
                      !!!CHECK MISSING_VALUE AND FILL_VALUE
          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,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_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,jde,1/))
!apply var_final=scale_factor*var_read+add_offset
          real_2d_apt=scale_factor*real_2d_apt+add_offset
!
!out for regional:  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(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_reg
!-------------------------------------------------------------------------------+++
!
subroutine read_emivert_gfas_reg_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  !!!WE NEED TO DEAL WITH SCALE_FACTOR AND ADD_OFFSET: VARfinal=SCALE_FACTOR*VAR+ADD_OFFSET
                      !!!CHECK MISSING_VALUE AND FILL_VALUE
          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,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_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,jde,1/))
!apply var_final=scale_factor*var_read+add_offset
!          real_2d_apt=scale_factor*real_2d_apt+add_offset
!
!out for regional:  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(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_reg_v2
!-----------------------------------------------------------------------
!
!-------------------------------------------------------------------------------+++
!
subroutine read_hermesv3_global (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
! Produced by HERMESv3 with LM vertical levels same as MONARCH

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, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp
      integer :: ncid_in,k,kflip,stat
!----------
!----------

        real_2d=0.
        temp=0.

        do k=1,LM
          kflip=LM-k+1
          if(mype==0) then
            stat=nf90_inq_varid(input_id,trim(var),ncid_in)
            stat=nf90_get_var(input_id,ncid_in,real_2d(2:ide-1,2:jde-1),start=(/1,1,k/),count=(/ide-2,jde-2,1/))
          endif
          call dstrb(real_2d,temp,1,1,1,lm,lm,mype,mpi_comm_comp)
          ! distribute emissions vertically, already prepared at MONARCH vertical levels
          emi(:,:,kflip)=temp(:,:,LM)
        enddo

        return
end subroutine read_hermesv3_global
!-----------------------------------------------------------------------
!-------------------------------------------------------------------------------+++
!
subroutine read_hermesv3_global_time (input_id,var,emi,dz8w,time,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )
! Subroutine to read ANTHRO hourly w/o ghost cells
! Produced by HERMESv3 with LM vertical levels same as MONARCH

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,time
      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, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp
      integer :: ncid_in,k,kflip,stat
!----------
!----------

        real_2d=0.
        temp=0.

        do k=1,LM
          kflip=LM-k+1
          if(mype==0) then
            stat=nf90_inq_varid(input_id,trim(var),ncid_in)
            stat=nf90_get_var(input_id,ncid_in,real_2d(2:ide-1,2:jde-1),start=(/1,1,k,time/),count=(/ide-2,jde-2,1,1/))
          endif
          call dstrb(real_2d,temp,1,1,1,lm,lm,mype,mpi_comm_comp)
          ! distribute emissions vertically, already prepared at MONARCH vertical levels
          emi(:,:,kflip)=temp(:,:,LM)
        enddo

        return
end subroutine read_hermesv3_global_time
!
!-------------------------------------------------------------------------------+++
!
subroutine read_hermesv3_regional_time (input_id,var,emi,dz8w,time,mype       &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE )
! Subroutine to read ANTHRO hourly for regional domain
! Produced by HERMESv3 with LM vertical levels same as MONARCH

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,time
      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, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp
      integer :: ncid_in,k,kflip,stat
!----------
!----------

        real_2d=0.
        temp=0.

        do k=1,LM
          kflip=LM-k+1
          if(mype==0) then
            stat=nf90_inq_varid(input_id,trim(var),ncid_in)
            stat=nf90_get_var(input_id,ncid_in,real_2d(ids:ide,jds:jde),start=(/1,1,k,time/),count=(/ide,jde,1,1/))
          endif
          call dstrb(real_2d,temp,1,1,1,lm,lm,mype,mpi_comm_comp)
          ! distribute emissions vertically, already prepared at MONARCH vertical levels
          emi(:,:,kflip)=temp(:,:,LM)
        enddo

        return
end subroutine read_hermesv3_regional_time
!-------------------------------------------------------------------------------+++
!
subroutine read_hermesv3_regional (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
! Produced by HERMESv3 with LM vertical levels same as MONARCH FOR REGIONAL DOMAIN

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, DIMENSION( IMS:IME,JMS:JME,1:LM ) :: temp
      integer :: ncid_in,k,kflip,stat
!----------
!----------

        real_2d=0.
        temp=0.

        do k=1,LM
          kflip=LM-k+1
          if(mype==0) then
            stat=nf90_inq_varid(input_id,trim(var),ncid_in)
            stat=nf90_get_var(input_id,ncid_in,real_2d(ids:ide,ids:jde),start=(/1,1,k/),count=(/ide,jde,1/))
          endif
          call dstrb(real_2d,temp,1,1,1,lm,lm,mype,mpi_comm_comp)
          ! distribute emissions vertically, already prepared at MONARCH vertical levels
          emi(:,:,kflip)=temp(:,:,LM)
        enddo

        return
end subroutine read_hermesv3_regional
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
      END MODULE MODULE_BSC_CHEMISTRY_EMISSIONS
!
!-----------------------------------------------------------------------
