! 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 
!
!-----------------------------------------------------------------------
!
!***  THE OUTER DRIVER FOR THE EMISS, PHOT, AND FULL 3-D CHEMICAL MECHN.
!
!-----------------------------------------------------------------------
! HISTORY LOG:
!
!   2008-12-23  Jorba - Creation of the module.
!   2009-11-24  Jorba - Gas indexes through module chem_data
!
!-----------------------------------------------------------------------
!
      USE MODULE_KINDS, ONLY          : KINT,KFPT
!
      USE MODULE_DM_PARALLEL, ONLY    : MYPE_SHARE,MPI_COMM_COMP,DSTRB   &
                                       ,ITS_B1,ITE_B1,JTS_B1,JTE_B1    
                                       

!
      USE MODULE_EXCHANGE, ONLY    : HALO_EXCH
!
      USE MODULE_FLTBNDS,ONLY : POLEHN,POLEWN,SWAPHN,SWAPWN
!
      USE MODULE_CONSTANTS, ONLY : G,EPSQ,R_D,P608
!
      USE MODULE_DRYDEPWESELY, ONLY : DEP_INIT,WESELY_DRIVER
!
      USE MODULE_BIOEMI_SIMPLE, ONLY : BIO_EMISSIONS
!
      USE MODULE_BIOEMI_MEGAN2, ONLY : bio_emissions_megan2,READ_MEGAN_CNST_FIELDS
!
      USE MODULE_BSC_CHEM_DATA
!
      USE MODULE_BSC_CHEMISTRY_EMISSIONS, ONLY : READ_ACCMIP_EMISSIONS, &
          READ_ACCMIP_EMISSIONS_BCOC,READ_AQMEII_PHASE2_EMISSIONS,      &
          READ_AQMEII_PHASE3_EMISSIONS,READ_CALIOPE_GFAS_EMISSIONS,     &
          READ_HERMESv3_GFAS_GLOBAL_EMISSIONS,                          &
          READ_HERMESv3HOURLY_GFASDAILY_GLOBAL_EMISSIONS,               &
          READ_TRACER_FUKUSHIMA,                                        &
          CURRENT_TIME,READ_IS4FIRE_EMISSIONS
!
      USE MODULE_BSC_AERO_MECHANISM, ONLY : AERO_BSC_DRIVER
!
      USE MODULE_SOLVER_INTERNAL_STATE
!
      USE MONARCH_DIAGNOSTICS
!
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
      LOGICAL,SAVE :: FIRST_CHEM=.TRUE.
!
!-----------------------------------------------------------------------
!
      PRIVATE
!
      PUBLIC :: CHEM_DRIVER !,CHEMISTRY_INITIALIZE
!
!-----------------------------------------------------------------------
!
      INTEGER :: MYPE

!      integer, parameter :: nphoto_fastj=14

      REAL,PARAMETER :: DEGRAD=3.1415926/180.
      REAL,PARAMETER :: RTD=1./DEGRAD
      REAL,PARAMETER :: GPKG = 1.0E+03  ! g/kg
      REAL,PARAMETER :: M2PHA = 1.0E+04 ! 1 hectare = 1.0e4 m**2
      
! MOLECULAR WEIGHT OF CHEM SPCS CBM4:
      INTEGER,PARAMETER :: SPC=32
      REAL :: MOLWT(SPC)
      DATA MOLWT/16.0, 34.0,121.0,139.0, &
                 92.0,108.0,106.0,  1.0, &
                 47.0, 79.0,109.0, 63.0, &
                 31.0,108.0, 72.0, 28.0, &
                 28.0,  1.0, 84.0, 14.0, &
                 30.0, 68.0, 27.0, 44.0, &
                 48.0, 46.0, 17.0, 33.0, &
                 16.0, 62.0, 30.0, 75.0/
!
!   Mass balance variables
!
     logical  :: mass_balance       = .false. 
     real(kfpt),SAVE :: my_mass_emited     = 0.0
     real(kfpt),SAVE :: my_mass_boundaries = 0.0
     real(kfpt),SAVE :: my_mass_top        = 0.0
     real(kfpt),SAVE :: my_mass_ground     = 0.0
     real(kfpt),SAVE :: my_mass_volume     = 0.0
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE CHEM_DRIVER(GLOBAL,NTIMESTEP,NSTEPS_SPINUP            &
           ,DT,NPHS,NEMIS,NPHOT                                        &
           ,NPRECIP                                                    &
           ,START_YEAR,START_MONTH,START_DAY                           &
           ,START_HOUR,JULDAY                                          &
           ,INPES,JNPES                                                &
           ,NUM_TRACERS_TOTAL                                          &
           ,NUM_AERO                                                   &
           ,NUM_ASH,NUM_DUST,NUM_SALT,NUM_OM,NUM_BC,NUM_SO4            &
           ,NUM_NO3,NUM_NH4,NUM_UNSPC                                  &
           ,NUM_AERO_UCI                                               &
           ,NUM_GAS_TOTAL,NUM_WATER_FERR                               &
           ,INDX_AERO_START,INDX_AERO_END                              &
           ,INDX_UCI_START,INDX_UCI_END                                &
           ,INDX_GAS_START,INDX_GAS_END                                &
           ,INDX_WATER_START,INDX_WATER_END                            &
           ,PD,GLAT,GLON,PT,FIS,PSGML1,SGML2                           &
           ,U,V,T,Q                                                    &
!no p_qv in nmmb ,P_QV,P_QC,P_QR,P_QI,P_QS,P_QG                              &
           ,P_QC,P_QR,P_QI,P_QS,P_QG                                   &
           ,PDSG1,DSG2                                                 &
           ,PBLH                                                       &
           ,TRACERS                                                    &
           ,CHEM                                                       &
           ,EMISS_AERO                                                 &
           ,E_XYL,E_HNO3,E_HCHO                                        &
           ,E_NO2,E_ISODBG                                             &
           ,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                                         &
           ,E_NH3                                                      &
!NEW_EMISS 6
           ,E_HONO,E_BENZENE,E_CH4                                     &
!
           ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC              &
           ,E_DMS,E_DMS_OCEAN                                          &
           ,E_BC_GFAS,E_OM_GFAS,E_SO2_GFAS,E_DMS_GFAS                  &
           ,E_UNSPCF_GFAS,E_CO_GFAS                                    &
                ,E_CO_BB,E_NO_BB,E_SO2_BB,E_NH3_BB                     &
                ,E_BC_BB,E_OM_BB                                       &
           ,tph_o2,tph_o31d,tph_o33p,tph_no2,tph_no3o2                 &
           ,tph_no3o,tph_hno2                                          &
           ,tph_hno3,tph_hno4,tph_h2o2,tph_ch2or,tph_ch2om,tph_ch3cho  &
           ,tph_ch3coch3,tph_ch3coc2h5,tph_hcocho,tph_ch3cocho         &
           ,tph_hcochest,tph_ch3o2h,tph_ch3coo2h                       &
           ,tph_ch3ono2,tph_hcochob,tph_n2o5                           &
           ,IVGTYP,TSKIN,T2,RSWIN,CZMEAN,VEGFRC,RMOL,USTAR,Z0          &
           ,CUPREC,ACPREC                                              &
           ,LEMIS,LPHOT,LDRYDEP                                        &
           ,LCLDCHEM,LRESCLD,LCONVCLD,LCHEM                            &
           ,EXCH_H,AKHS,VDIFF_CHEM                                     &
          ,CALL_PRECIP                                                &
           ,ADRYDEP,WETDEP                                             &
           ,RDYH,RDXH,DYH,DXH,DYV,DXV                                  &
!           ,DARE                                                       &
           ,IDS,IDE,JDS,JDE,LM                                         &
           ,IMS,IME,JMS,JME,KMS,KME                                    &
           ,ITS,ITE,JTS,JTE                                            &
           ,DIAGNOSTICS                                                &
           )
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  CHEM_DRIVER   CHEMISTRY OUTER DRIVER
!   PRGRMMR: JORBA           ORG: W/NP22     DATE: 09-02-09
!
! ABSTRACT:
!     CHEM_DRIVER DRIVES THE CHEMISTRY SCHEMES
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   09-02-09  JORBA      - ORIGINATOR OF THE DRIVER
!   09-11-24  JORBA      - NEW NUM_GAS INDEXES
!
! USAGE: CALL CHEM_DRIVER FROM PHY_RUN
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
      IMPLICIT NONE

      INCLUDE "mpif.h"
!
!-----------------------------------------------------------------------
!
!   LOGICAL,INTENT(IN) :: GLOBAL,CALL_PRECIP
!
!   INTEGER,INTENT(IN) :: NTIMESTEP,NSTEPS_SPINUP                       &
!                           ,START_HOUR,JULDAY                          &
!                           ,START_YEAR,START_MONTH,START_DAY           
!   INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                            &
!                           ,IMS,IME,JMS,JME,KMS,KME                    &


   LOGICAL,INTENT(IN) :: GLOBAL
!
   INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                            &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE,NSTEPS_SPINUP              &
                           ,NPHS,NEMIS,NPHOT,NPRECIP,NTIMESTEP         &
                           ,START_HOUR,JULDAY                          &
                           ,START_YEAR,START_MONTH,START_DAY           &
                           ,NUM_TRACERS_TOTAL,NUM_GAS_TOTAL            &
                           ,NUM_AERO                                   &
                           ,NUM_ASH,NUM_DUST,NUM_SALT                  &
                           ,NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4      &
                           ,NUM_UNSPC                                  &
                           ,NUM_AERO_UCI                               &
                           ,NUM_WATER_FERR,INPES,JNPES                 &
                           ,INDX_AERO_START,INDX_AERO_END              &
                           ,INDX_UCI_START,INDX_UCI_END                &
                           ,INDX_GAS_START,INDX_GAS_END                &
                           ,INDX_WATER_START,INDX_WATER_END             

   REAL,INTENT(IN) :: DT,PT,RDYH,DYH,DYV

   REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: PD,GLAT,GLON,FIS

   REAL,DIMENSION(1:LM),INTENT(IN) :: DSG2,PDSG1,PSGML1,SGML2

   REAL,DIMENSION(JDS:JDE),INTENT(IN) :: RDXH,DXH,DXV !DARE

   REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: U,V,T,Q,EXCH_H

   REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: AKHS !,CUPREC,ACPREC

   REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: CUPREC,ACPREC

!no p_qv from nmmb  INTEGER,INTENT(IN) :: P_QV,P_QC,P_QR,P_QI,P_QS,P_QG
   INTEGER,INTENT(IN) :: P_QC,P_QR,P_QI,P_QS,P_QG

   REAL,DIMENSION(IMS:IME,JMS:JME,1:LM,NUM_TRACERS_TOTAL)              &
                   ,INTENT(INOUT) :: TRACERS
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS_TOTAL)                &
                   ,INTENT(INOUT) :: CHEM
!
   REAL,DIMENSION(IMS:IME,JMS:JME,MAX(1,NUM_AERO))                     &
                    ,INTENT(INOUT) :: EMISS_AERO
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE,MAX(1,NUM_GAS_TOTAL))   &  !1:NUM_GAS_TOTAL)                     &
                    ,INTENT(INOUT) :: ADRYDEP, WETDEP
!
   REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) ::           &
           E_ISODBG                                                    &
          ,E_SO2, E_MEOH, E_ALD2                                       &
          ,E_FORM, E_ETHA, E_ETOH, E_TERP                              &
          ,E_TOL,E_XYL,E_HNO3,E_CO,E_ETH,E_PAR,E_HCHO,E_ISOP           &
          ,E_OLE,E_NO2,E_NO                                            &
          ,E_ALDX,E_IOLE,E_NO2_AIR,E_NO_AIR,E_NH3                      &
!NEW_EMISS 6
          ,E_HONO,E_BENZENE,E_CH4                                      &
!
          ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC               &
          ,E_DMS,E_DMS_OCEAN                                           &
          ,E_BC_GFAS,E_OM_GFAS,E_SO2_GFAS,E_DMS_GFAS,E_UNSPCF_GFAS     &
          ,E_CO_GFAS                                                   &
          ,E_CO_BB,E_NO_BB,E_SO2_BB,E_NH3_BB                           &
          ,E_BC_BB,E_OM_BB                                        
!
   REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) ::           &
           tph_o2,tph_o31d,tph_o33p,tph_no2,tph_no3o2                  &
          ,tph_no3o,tph_hno2                                           &
          ,tph_hno3,tph_hno4,tph_h2o2,tph_ch2or,tph_ch2om,tph_ch3cho   &
          ,tph_ch3coch3,tph_ch3coc2h5,tph_hcocho,tph_ch3cocho          &
          ,tph_hcochest,tph_ch3o2h,tph_ch3coo2h,tph_ch3ono2            &
          ,tph_hcochob,tph_n2o5
!
   LOGICAL,INTENT(IN) :: CALL_PRECIP
!
   INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IVGTYP
!
   REAL, DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: TSKIN,T2,RSWIN       &
                                                 ,CZMEAN,VEGFRC,PBLH
!
   REAL, DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: RMOL,USTAR,Z0
!
   LOGICAL,INTENT(IN) :: LPHOT,LCHEM,LEMIS,LDRYDEP,LCLDCHEM,VDIFF_CHEM
!
   LOGICAL,INTENT(IN) :: LRESCLD,LCONVCLD
!
!  Diagnostics object attached to current solver internal state
   TYPE(MONARCH_DIAGNOSTICS_T), INTENT(IN) :: DIAGNOSTICS
!
!-----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!-----------------------------------------------------------------------
!
   INTEGER :: I,J,K,N,NK,AS,AE,CS,CE,BS,BE,WS,WE,KFLIP
!
   INTEGER,DIMENSION(ITS:ITE,JTS:JTE) :: LPAR,JPNL,LPART,JPNLT
!
   INTEGER,PARAMETER :: P_QV=5 !only works with Ferrier: P_QC=1,P_QR=2,P_QS=3,P_QG=4
!
   INTEGER,PARAMETER :: NUM_WATER=5 !NUM_WATER_FERR+1 !only works with Ferrier: P_QC=1,P_QR=2,P_QS=3,P_QG=4
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_WATER) :: WATER !INCLUDES QV,QC,QR,QS,QG
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM) :: OZONE_PHY
!
   REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE) :: T_PHY
!
   REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE,NUM_WATER) :: MOIST_PHY !INCLUDES QV,QC,QR,QS,QG with kflip
!
   REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE) :: P_PHY
!
   REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE) :: OZONE_FLIP,AIRDENSITY       &
                      ,CLOUDMR,DZ8W,RELHUM,RELHUMT,DP8W                                     
!
   REAL,DIMENSION(ITS:ITE,1:LM+1,JTS:JTE) :: Z_AT_W,P8W
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE) :: XLAT,XLONG,PBLH_ITS
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM) :: KHET
!
   REAL :: COS_SZA,DP
!
   REAL,DIMENSION(LM,nphoto_fastj) :: VALUEJ
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:NUM_GAS_TOTAL) :: DDVEL
!
   REAL,DIMENSION(JDS:JDE) :: DARE
!
   LOGICAL :: CHANGE,CHANGE_CU
!
   INTEGER :: INDX_NH3,INDX_SO2
!
!   REAL,DIMENSION(IMS:IME,JMS:JME) :: RAINC,RAINNC
   REAL,DIMENSION(ITS:ITE,JTS:JTE) :: RAINC,RAINNC
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE) :: DU,EMI_TOTAL_DBG
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM) :: QV,QC,QR,QI,QS,QG
!
   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:,:)  :: AERO_BSC
   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:,:)  :: AERO_UCI
   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: ACPREC_P,CUPREC_P,ACPREC_P2,CUPREC_P2
!
   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: RH_EMI !RH_EMI temporal for BB effect on photolysis
   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: RELHUM_P
!   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: ADRYDEP,WETDEP,RH_EMI !RH_EMI temporal for BB effect on photolysis
!
   LOGICAL  ::  CALL_PHOT
!
!FOR GLOBAL BUDGETS
   LOGICAL  :: DO_BUDGET
!   REAL*8,SAVE   :: TOT_BUDG
   REAL*8   :: TOT_BUDG
   REAL*8   :: TOT_BUDG_RED
   REAL     :: TCHEM,VAL_CHEM
   INTEGER  :: CU_YEAR,CU_MONTH,CU_DAY,CU_HOUR
   INTEGER  :: IRECV
!
!   INTEGER  :: EMI_SOA_DENT !=1 DENTENER;2 TSIGARIDIS;3 HODZIC+SPRACKLEN
   INTEGER,SAVE  :: NUM_AERO_BSC
   LOGICAL,SAVE  :: RUN_AERO_BSC
!   INTEGER,SAVE ::       &
!                 P_BC1   & !fine phob bc
!                ,P_BC2   & !fine phil bc
!                ,P_SO4   & !fine so4--
!                ,P_NO3b1 & !fine as sulfate no3-
!                ,P_NO3b2 & !coarse_on_dustbin5 no3-
!                ,P_NO3b3 & !coarse_on_ssabin5  no3-
!                ,P_NH4   & !fine as sulfate nh4+
!                ,P_UNSPCF & !fine unspeciated matter
!                ,P_UNSPCC & !coarse unspeciated matter
                           !OA DESCRIPTION
                           !DENENER                TSIGARIDIS             HODZIC+SPRACKLEN
!                ,P_OM1   & !PRIMARY ORGANIC PHOB   POA PHOB               POA ANTHRO PHOB  
!                ,P_OM2   & !PRIMARY ORGANIC PHIL   POA PHIL               POA ANTHRO PHIL
!                ,P_OM3   & !SOA PHOB               NOT USED               POA BIOMASS BURNING PHOB
!                ,P_OM4   & !SOA PHIL               SOA ISOPP1A            POA BIOMASS BURNING PHIL
!                ,P_OM5   & !NOT USED               SOA ISOPP2A            BIOGENIC SOA
!                ,P_OM6   & !NOT USED               SOA APINP1A            ANTRHO SOA
!                ,P_OM7   & !NOT USED               SOA APINP2A            BIOMASS BURNING SOA
!                ,P_OM8     !NOT USED               NOT USED               ENHANCED BIOGENIC SOA
!
! Mass Balance
     integer(kint)           :: iyr ,imo ,idy ,ihr ,imi ,ise, istat
     real(kfpt)              :: all_mass_emited,all_mass_boundaries,all_mass_ground,all_mass_volume,totmass
     character(len=100) :: message
     character(len=3), dimension(12) :: month= (/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC'/)

     integer :: I_EMI,J_EMI
     real :: conv_rho
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:N_GC_WDEP+1) :: RESWDEPAC

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:N_GC_WDEP+8) :: CONVDEPAC
!
!-----------------------------------------------------------------------
!
      MYPE=MYPE_SHARE
!
!-----------------------------------------------------------------------
!***  FIRST CHEM TIME STEP FLAG
!-----------------------------------------------------------------------
! 
       firstchem: IF(FIRST_CHEM)THEN
!
!-----------------------------------------------------------------------
!***  FLAGS SELECTED IN CONFIGURE_FILE
!-----------------------------------------------------------------------
!
       IF(MYPE==0)THEN
         WRITE(0,*) '**** FIRSTTIME = ',FIRST_CHEM,'  ****'
         WRITE(0,*) '**** FLAGS IN CHEMISTRY ***************'
         WRITE(0,*)' MECH =',MECH
         WRITE(0,*)' LEMIS =',LEMIS
         WRITE(0,*)' LPHOT =',LPHOT
         WRITE(0,*)' LDRYDEP =',LDRYDEP
         WRITE(0,*)' LCLDCHEM =',LCLDCHEM
         WRITE(0,*)' LRESCLD =',LRESCLD
         WRITE(0,*)' LCONVCLD =',LCONVCLD
         WRITE(0,*)' LCHEM =',LCHEM
         WRITE(0,*)' INIT  =',INIT
         WRITE(0,*)' NUM_ASH =',NUM_ASH
         WRITE(0,*)' NUM_DUST =',NUM_DUST
         WRITE(0,*)' NUM_SALT =',NUM_SALT
         WRITE(0,*)' NUM_OM =',NUM_OM
         WRITE(0,*)' NUM_BC =',NUM_BC
         WRITE(0,*)' NUM_SO4 =',NUM_SO4
         WRITE(0,*)' NUM_NO3 =',NUM_NO3
         WRITE(0,*)' NUM_NH4 =',NUM_NH4
         WRITE(0,*)' NUM_UNSPC=',NUM_UNSPC
         WRITE(0,*)' NUM_UCI =',NUM_AERO_UCI
         WRITE(0,*)'*************************************'
       ENDIF
!
!-----------------------------------------------------------------------
!***  ALLOCATE ARRAYS          
!-----------------------------------------------------------------------
!
        ALLOCATE(ACPREC_P(ITS:ITE,JTS:JTE))
        ALLOCATE(CUPREC_P(ITS:ITE,JTS:JTE))
        ALLOCATE(ACPREC_P2(ITS:ITE,JTS:JTE))
        ALLOCATE(CUPREC_P2(ITS:ITE,JTS:JTE))
        ACPREC_P=ACPREC !0. !EXCESIVE WET DEP OF GASES
        CUPREC_P=CUPREC !0. 
        ADRYDEP=0.
        WETDEP=0.
        DU=0.
        EMI_TOTAL_DBG=0.
        tph_no2=0.
!Temporal RH_EMI for BB smoke on photolysiss
          ALLOCATE(RH_EMI(ITS:ITE,1:LM,JTS:JTE))
          RH_EMI=0.
!
        IF(NUM_AERO_UCI.GT.0)THEN !AEROSOL UCI MECHANISM ACTIVATED
          ALLOCATE(AERO_UCI(ITS:ITE,JTS:JTE,1:LM,1:NUM_AERO_UCI))
          ALLOCATE(RELHUM_P(ITS:ITE,1:LM,JTS:JTE))
          AERO_UCI=0.
          RELHUM_P=0.
        ENDIF
!
        RUN_AERO_BSC=(NUM_OM+NUM_BC+NUM_SO4+NUM_NO3+NUM_NH4+NUM_UNSPC>0)
        NUM_AERO_BSC=NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+NUM_SO4+NUM_NO3+NUM_NH4+NUM_UNSPC
        IF(NUM_AERO_BSC>0) THEN !AEROSOL BSC MECHANISM ACTIVATED
          ALLOCATE(AERO_BSC(ITS:ITE,JTS:JTE,1:LM,1:NUM_AERO_BSC))
          AERO_BSC=0.
        ENDIF
!
      ENDIF firstchem
!
!-----------------------------------------------------------------------
!***  BUILD AERO AND WATER ARRAY FROM TRACERS
!-----------------------------------------------------------------------
!
      AS=INDX_UCI_START
      AE=INDX_UCI_END
!           
      BS=INDX_AERO_START
      BE=INDX_AERO_END 
!  
      WS=INDX_WATER_START
      WE=INDX_WATER_END
      DO K=1,LM
      DO J=JTS,JTE
      DO I=ITS,ITE
!
         IF(NUM_AERO_UCI.GT.0)THEN
           DO N=AS,AE
            NK=N-AS+1
            AERO_UCI(I,J,K,NK)=TRACERS(I,J,K,N)
           ENDDO
         ENDIF
!
         IF(NUM_AERO_BSC.GT.0)THEN
           DO N=BS,BE
            NK=N-BS+1
            AERO_BSC(I,J,K,NK)=TRACERS(I,J,K,N)
           ENDDO
         ENDIF
!
        DO N=WS,WE
           NK=N-INDX_WATER_START+1
           WATER(I,J,K,NK)=TRACERS(I,J,K,N)             ! P_QC=1,P_QR=2,P_QS=3,P_QG=4 works for ferrier MP
        ENDDO
           WATER(I,J,K,P_QV)=Q(I,J,K)/(1.-Q(I,J,K))        ! Water vapor mixing ratio P_QV=5 works for ferrier MP
!
      ENDDO
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!***  MODEL OZONE-INPUT TO PHOTOLYSIS SCHEME
!-----------------------------------------------------------------------
!
      IF(MECH.EQ.1 .OR. MECH.EQ.2 .OR. MECH.EQ.22 .OR. MECH.EQ.3 .OR. MECH.EQ.6 .OR. MECH.EQ.7 .OR. MECH.EQ.37)THEN !NOT DO IT FOR MECH==4,5 - NO COMPLETE GAS-PHASE 
!
      DO K=1,LM
      DO J=JTS,JTE
      DO I=ITS,ITE
        OZONE_PHY(I,J,K)=CHEM(I,J,K,P_O3)
      ENDDO
      ENDDO
      ENDDO
!
      ELSEIF(MECH.EQ.4 .OR. MECH.EQ.5)THEN !NOT DO IT FOR MECH==4,5 - NO COMPLETE GAS-PHASE
        OZONE_PHY=0. !DUMMY VALUE - ONLY USED IN CALL PREP - NOT NEEDED FOR MECH==4 OR 5
      ENDIF
!
!-----------------------------------------------------------------------
!***  COMPUTE GRIDBOX AREA (m2)
!-----------------------------------------------------------------------
!
      IF(GLOBAL)THEN
        DARE=0.
        DO J=JDS+2,JDE+2
          DARE(J)=DXH(J)*DYH
        ENDDO
        DARE(JDS)=DARE(JDS+2)
        DARE(JDS+1)=dxv(jds+1)*dyv*0.5*4.
        DARE(JDE-1)=dxv(jde-2)*dyv*0.5*4.
        DARE(JDE)=DARE(JDE-2)        
      ELSE !REGIONAL
        DO J=JDS,JDE
          DARE(J)=DXH(J)*DYH
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!***  CALL PREPROCESS FOR CHEMISTRY
!-----------------------------------------------------------------------
!
      IF(MYPE==0)THEN
        WRITE(0,*) 'CALL PREP_DRIVER'
      ENDIF
!
      CALL PREP_DRIVER(PD,PT,GLAT,GLON,FIS,PSGML1,SGML2                &
                    ,T,Q,WATER,NUM_WATER,P_QV,P_QC,P_QR,P_QI,P_QS,P_QG &
                    ,PDSG1,DSG2,OZONE_PHY                              &
                    ,XLAT,XLONG,P8W,DZ8W,CLOUDMR,AIRDENSITY,RELHUM     &
                    ,Z_AT_W,OZONE_FLIP,T_PHY,P_PHY,MOIST_PHY,DP8W      &
                    ,LPAR,JPNL,LPART,JPNLT                             &
                    ,IDS,IDE,JDS,JDE,LM                                &
                    ,IMS,IME,JMS,JME,KMS,KME                           &
                    ,ITS,ITE,JTS,JTE)
!
!-----------------------------------------------------------------------
!***  CALL EMISSION DRIVER
!-----------------------------------------------------------------------
!
      IF(LEMIS)THEN
!
        IF(MYPE==0)THEN
          WRITE(0,*) 'CALL EMISSION DRIVER'
        ENDIF
!
        CALL EMISSION_DRIVER(FIRST_CHEM,GLOBAL,NTIMESTEP,DT,NPHS,NEMIS &
                ,NSTEPS_SPINUP                                         &
                ,START_YEAR,START_MONTH,START_DAY                      &
                ,START_HOUR,JULDAY                                     &
                ,P_QC,P_QV,P_QR,NUM_WATER                              &
                ,T_PHY,MOIST_PHY,P_PHY,IVGTYP,T2,RSWIN,VEGFRC          &
                ,USTAR,Z0,XLAT,XLONG                                   &
                ,CHEM,NUM_GAS_TOTAL                                    &
                ,AERO_BSC,NUM_AERO_BSC                                 &
!NEW_EMISS 0 and 1
                ,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_XYL,E_HNO3,E_HCHO,E_NO2,E_ISODBG                    &
!NEW_EMISS 2
                ,E_ALDX,E_IOLE,E_NO2_AIR,E_NO_AIR                      &
!NH3
                ,E_NH3,E_BC,E_OM                                       &
!NEW_EMISS 6
                ,E_HONO,E_BENZENE,E_CH4                                &
                ,E_CO_BB,E_NO_BB,E_SO2_BB,E_NH3_BB                     &
                ,E_BC_BB,E_OM_BB                                       &
!NEW_EMISS 37
                ,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_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,Z_AT_W,AIRDENSITY,FIS,rh_emi                     &
                ,DARE,DP8W,EMI_TOTAL_DBG                               &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  CALL PHOTOLYSIS DRIVER - PHOTOLYSIS RATES ph_... units (min{-1})
!-----------------------------------------------------------------------
!
      IF(LPHOT)THEN
! TO ACCOUNT FOR SPINUP
        CALL_PHOT=(FIRST_CHEM.OR.(MOD(NTIMESTEP,NPHOT)==0))
!
        IF(CALL_PHOT)THEN
!
          IF(MYPE==0)THEN
            WRITE(0,*) 'CALL PHOT_DRIVER AT NTIME:',NTIMESTEP          &
           ,OZONE_PHY(ITS,JTS,10),CHEM(ITS,JTS,10,P_O3),P_O3,LPHOT
            WRITE(0,*) 'BEFORE PHOT_DRIVER AT NTIME:',NTIMESTEP          &
           ,'H2O2 1-LM: ',ph_h2O2(ITS,:,JTS)
          ENDIF
!
!Temporal - include effect of BB smoke cloud through RH
!remove when aerosol effects explicitly treated
!          relhumt=min(1.,relhum+rh_emi) !INCLUDE EFFECT OF BB
          relhumt=min(1.,relhum)
!
          CALL PHOT_DRIVER(NTIMESTEP,DT,START_HOUR,JULDAY              &
                     ,XLAT,XLONG,P8W,DZ8W,CLOUDMR,AIRDENSITY           &
                     ,relhumt,z_at_w,T_PHY                             &
                     ,OZONE_FLIP                                       &
                     ,LPAR,JPNL                                        &
                     ,VALUEJ,COS_SZA                                   &
                     ,IDS,IDE,JDS,JDE,LM                               &
                     ,IMS,IME,JMS,JME,KMS,KME                          &
                     ,ITS,ITE,JTS,JTE)
!
          IF(MYPE==0)THEN
            WRITE(0,*) 'AFTER PHOT_DRIVER AT NTIME:',NTIMESTEP          &
           ,'H2O2 1-LM: ',ph_h2O2(ITS,:,JTS)
          ENDIF
!
        ENDIF !CALL_PHOT
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  CALL DRY_DEPOSITION DRIVER - DDVEL UNITS (m/s)
!-----------------------------------------------------------------------
!
      IF(LDRYDEP)THEN
!
        IF(MYPE==0)THEN
          WRITE(0,*) 'CALL DRYDEP_DRIVER'
        ENDIF
!
        CALL DRYDEP_DRIVER(FIRST_CHEM,NTIMESTEP,DT,NPHS,START_HOUR     &
           ,JULDAY,XLAT,XLONG                                          &
           ,T_PHY                                                      &
           ,MOIST_PHY,NUM_WATER                                        &
           ,P_QC,P_QV,P_QR,P_PHY                                       &
           ,CHEM                                                       &
           ,NUM_GAS_TOTAL                                              &
           ,AIRDENSITY                                                 &
           ,DDVEL                                                      &
           ,ADRYDEP(ITS:ITE,JTS:JTE,1:NUM_GAS_TOTAL)                   &
           ,IVGTYP(ITS:ITE,JTS:JTE),TSKIN(ITS:ITE,JTS:JTE)             &
           ,RSWIN(ITS:ITE,JTS:JTE),VEGFRC(ITS:ITE,JTS:JTE)             &
           ,RMOL(ITS:ITE,JTS:JTE),USTAR(ITS:ITE,JTS:JTE)               &
           ,Z0(ITS:ITE,JTS:JTE),DZ8W,Z_AT_W                            &
           ,EXCH_H,AKHS,VDIFF_CHEM                                     &
           ,IDS,IDE,JDS,JDE,LM                                         &
           ,IMS,IME,JMS,JME,KMS,KME                                    &
           ,ITS,ITE,JTS,JTE)
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  CALL CLOUD CHEMISTRY - WDEP UNITS (kg ha-1)
!-----------------------------------------------------------------------
!
      IF(LCLDCHEM.AND.CALL_PRECIP)THEN
!
        IF(MYPE==0)THEN
          WRITE(0,*) 'CALL CLOUD CHEMISTRY'
        ENDIF
!
!*** COMPUTE RAINC AND RAINNC
        RAINC=0.
        RAINNC=0.
!*** UPDATE ACPREC_P AND CUPREC_P: PCP OF TIMESTEP
        DO J=JTS,JTE
        DO I=ITS,ITE
          ACPREC_P2(I,J)=MAX(ACPREC(I,J)-ACPREC_P(I,J),0.)
          CUPREC_P2(I,J)=MAX(CUPREC(I,J)-CUPREC_P(I,J),0.)
          ACPREC_P(I,J)=MAX(ACPREC(I,J)-ACPREC_P(I,J),0.)
          CUPREC_P(I,J)=MAX(CUPREC(I,J)-CUPREC_P(I,J),0.)
          !FILLING PBLH_ITS(ITS,JTS) FOR CONVCLD ROUTINES
          PBLH_ITS(I,J)=PBLH(I,J)
!        
          DO K=1,LM
            KFLIP=LM-K+1
!SPECIFIC HUMIDITY
            QV(I,J,K)=Q(I,J,KFLIP)
!MIXING RATIOS
            QC(I,J,K)=WATER(I,J,KFLIP,P_QC)
            QR(I,J,K)=WATER(I,J,KFLIP,P_QR)
            QI(I,J,K)=0. !NO ICE IN FERRIER WATER(I,J,KFLIP,P_QI)
            QS(I,J,K)=WATER(I,J,KFLIP,P_QS)
            QG(I,J,K)=WATER(I,J,KFLIP,P_QG)
          ENDDO
!COMPUTE RAINNC AND RAINC (m): PCP. OF TIMESTEP
          RAINNC(I,J)=MAX(ACPREC_P(I,J)-CUPREC_P(I,J),0.)
          RAINC(I,J) =MAX(CUPREC_P(I,J),0.)
!SAVE ACC. PRCP OF TIMESTEP FOR NEXT TIMESTEP
          ACPREC_P(I,J)=ACPREC(I,J)
          CUPREC_P(I,J)=CUPREC(I,J)
        ENDDO
        ENDDO
!
!***  RUN CLDCHEM DRIVER
!
        CALL CLDCHEM_DRIVER(NTIMESTEP,DT,NPRECIP                       &
                           ,LRESCLD                                    &
                           ,LCONVCLD                                   &
                           ,START_HOUR                                 &
                           ,CHEM                                       &
                           ,NUM_GAS_TOTAL                              &
                           ,T_PHY                                      &
                           ,DZ8W                                       &
                           ,P_PHY                                      &
                           ,AIRDENSITY                                 &
                           ,PBLH_ITS                                   &
                           ,QV                                         &
                           ,QC                                         &
                           ,QR                                         &
                           ,QI                                         &
                           ,QS                                         &
                           ,QG                                         &
                           ,RAINC(ITS:ITE,JTS:JTE)                     &
                           ,RAINNC(ITS:ITE,JTS:JTE)                    &
                           ,Z_AT_W,WETDEP,RESWDEPAC,CONVDEPAC          &
                           ,IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE)
!
     ENDIF
!
!-----------------------------------------------------------------------
!***  CALL CHEMICAL MECHANISM DRIVER - CHEM_GAS UNITS (ppmv)
!-----------------------------------------------------------------------
!
      IF(LCHEM)THEN
!
        IF(MYPE==0)THEN
          WRITE(0,*) 'CALL MECHANISM_DRIVER',OZONE_PHY(ITS,JTS,10)     &
                     ,CHEM(ITS,JTS,10,P_O3),P_O3
        ENDIF
!
        CALL MECHANISM_DRIVER(NTIMESTEP,DT,NPHS                        &
            ,T,START_HOUR                                              &
            ,CHEM,NUM_GAS_TOTAL                                        &
            ,P8W,AIRDENSITY,WATER,NUM_WATER,P_QV                       &
            ,JPNL                                                      &
            ,IDS,IDE,JDS,JDE,LM                                        &
            ,IMS,IME,JMS,JME,KMS,KME                                   &
            ,ITS,ITE,JTS,JTE)
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  CALL BSC AEROSOL CHEMICAL MECHANISM DRIVER - AERO UNITS (kg m-3)
!-----------------------------------------------------------------------
!
      IF(RUN_AERO_BSC .AND. LCHEM .AND.                                &
         .NOT.mass_balance) THEN
!
        IF(MYPE==0)THEN
          WRITE(0,*) 'CALL AERO_BSC_DRIVER'
        ENDIF
!
!!!DEBUGGG
        KHET=0.
!!!DEBUGG
        CALL AERO_BSC_DRIVER(GLOBAL,NTIMESTEP,DT,NPHS                  &
              ,T_PHY,RELHUM,WATER,NUM_WATER,P_QC,P_QV,P_QR             &
              ,START_YEAR,START_MONTH,START_DAY,START_HOUR             &
               ,JULDAY,XLAT,XLONG,P_PHY,T2,RSWIN                       &
              ,DZ8W,Z_AT_W,AIRDENSITY                                  &
              ,EMISS_AERO,NUM_AERO                                     &
              ,AERO_BSC,NUM_AERO_BSC                                   &
              ,NUM_ASH,NUM_DUST,NUM_SALT                               &
              ,NUM_OM,NUM_BC,NUM_SO4,NUM_NO3,NUM_NH4,NUM_UNSPC         &
              ,CHEM,NUM_GAS_TOTAL                                      &
              ,E_BC,E_OM,E_SO4,E_NO3,E_NH4,E_UNSPCF,E_UNSPCC           &
              ,E_DMS_OCEAN                                             &
              ,GLAT,GLON                                               &
              ,DARE,JPNL,KHET                                          &
              ,IDS,IDE,JDS,JDE,LM                                      &
              ,IMS,IME,JMS,JME,KMS,KME                                 &
              ,ITS,ITE,JTS,JTE)
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  CALL UCI AEROSOL CHEMICAL MECHANISM DRIVER
!-----------------------------------------------------------------------
!
      IF(NUM_AERO_UCI.GT.0)THEN
!
        IF(MYPE==0)THEN
!          WRITE(0,*) 'AS=',INDX_UCI_START
!          WRITE(0,*) 'AE=',INDX_UCI_END
!          WRITE(0,*) 'CS=',INDX_GAS_START
!          WRITE(0,*) 'CE=',INDX_GAS_END
!          WRITE(0,*) 'WS=',INDX_WATER_START
!          WRITE(0,*) 'WE=',INDX_WATER_END
!          WRITE(0,*) 'TRACERS(ITS,JTS,LM,AS)=',TRACERS(ITS,JTS,LM,AS)
!          WRITE(0,*) 'TRACERS(ITS,JTS,LM,CS)=',TRACERS(ITS,JTS,LM,CS)
!
          WRITE(0,*) 'CALL UCI AEROSOL DRIVER NOT AVAILABLE'
!          WRITE(0,*) 'DEBUG AERO_UCI(ITS,JTS,LM,1)=',AERO_UCI(ITS,JTS,LM,1)
!          WRITE(0,*) 'DEBUG AERO_UCI(ITS,JTS,LM,3)=',AERO_UCI(ITS,JTS,LM,3)
!          WRITE(0,*) 'DEBUG CHEM(ITS,JTS,LM,1)=',CHEM(ITS,JTS,LM,1)
!          WRITE(0,*) 'DEBUG CHEM(ITS,JTS,LM,3)=',CHEM(ITS,JTS,LM,3)
!          WRITE(0,*) 'DEBUG T_PHY(ITS,LM,JTS)=',T_PHY(ITS,LM,JTS)
!          WRITE(0,*) 'DEBUG T_PHY(ITS,1,JTS)=',T_PHY(ITS,1,JTS)
!          WRITE(0,*) 'DEBUG RELHUM(ITS,LM,JTS)=',RELHUM(ITS,LM,JTS)
!          WRITE(0,*) 'DEBUG RELHUM(ITS,1,JTS)=',RELHUM(ITS,1,JTS)
!          WRITE(0,*) 'DEBUG RELHUM_P(ITS,LM,JTS)=',RELHUM_P(ITS,LM,JTS)
!          WRITE(0,*) 'DEBUG RELHUM_P(ITS,1,JTS)=',RELHUM_P(ITS,1,JTS)
        ENDIF
!
!        CALL AERO_UCI_DRIVER(NTIMESTEP,DT,NPHS                         &
!              ,T_PHY,RELHUM,RELHUM_P                                   &
!              ,AERO_UCI,NUM_AERO_UCI                                   &
!              ,CHEM,NUM_GAS_TOTAL                                      &
!              ,JPNL                                                    &
!              ,IDS,IDE,JDS,JDE,LM                                      &
!              ,IMS,IME,JMS,JME,KMS,KME                                 &
!              ,ITS,ITE,JTS,JTE)
!
!        RELHUM_P(:,:,:)=RELHUM(:,:,:)
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  STRATOSPHERIC CHEMISTRY
!
!     STE = 0 CB05 CHEMISTRY
!     STE = 1 CARIOLLE
!     STE = 2 CLIMATOLOGY
!     STE = 3 COPCAT
!
!-----------------------------------------------------------------------
!***  CALL OZONE LINEAR MODEL
!-----------------------------------------------------------------------
!
      IF (STE == 1) THEN
!
        IF(MYPE==0)THEN
          WRITE(0,*) 'CALL CARIOLLE LINEAR MODEL'
        ENDIF
!
        CALL STE_DRIVER(NTIMESTEP,DT,NPHS                              &
          ,START_MONTH,XLAT,XLONG                                      &
          ,CHEM(:,:,:,P_O3),T_PHY,P_PHY,DZ8W                           &
          ,CZMEAN(ITS:ITE,JTS:JTE)                                     &
          ,JPNLT                                                       &
          ,IDS,IDE,JDS,JDE,LM                                          &
          ,IMS,IME,JMS,JME,KMS,KME                                     &
          ,ITS,ITE,JTS,JTE)
!
      ENDIF
!
      IF (STE == 2) THEN  
!
        IF(MYPE==0)THEN
          WRITE(0,*) 'CALL CLIMATOLOGY O3 STRATO'
        ENDIF
!
        CALL STE_CLIMATO(NTIMESTEP,DT,NPHS,START_MONTH                 &
          ,CHEM(:,:,:,P_O3),P_PHY,DZ8W                                 &
          ,JPNLT,FIRST_CHEM                                            &
          ,IDS,IDE,JDS,JDE,LM                                          &
          ,IMS,IME,JMS,JME,KMS,KME                                     &
          ,ITS,ITE,JTS,JTE)
!
      ENDIF
!
      IF (STE == 3) THEN
!
        IF(MYPE==0)THEN
          WRITE(0,*) 'CALL COPCAT LINEAR MODEL'
        ENDIF
!
        CALL STE_DRIVER_COPCAT(NTIMESTEP,DT,NPHS                       &
          ,START_MONTH,XLAT,XLONG                                      &
          ,CHEM(:,:,:,P_O3),T_PHY,P_PHY,DZ8W                           &
          ,CZMEAN(ITS:ITE,JTS:JTE)                                     &
          ,JPNLT                                                       &
          ,IDS,IDE,JDS,JDE,LM                                          &
          ,IMS,IME,JMS,JME,KMS,KME                                     &
          ,ITS,ITE,JTS,JTE)
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  COMPUTE OZONE IN DOBSON UNITS
!     d N [DU] / d P [mbar] = 0.78914 vmr [ppm]
!-----------------------------------------------------------------------
!
!      IF (STE .GT. 0) THEN
!        DO J=JTS,JTE
!        DO I=ITS,ITE
!          DU(I,J)=0.
!          DO K=JPNLT(I,J),LM-1 !FOR DEBUG CARIOLLE ONLY CONSIDER ABOVE TROPOPAUSE
!            DP=(P_PHY(I,K,J)-P_PHY(I,K+1,J))/100. !from Pa to mbar
!            DU(I,J)=DU(I,J)+DP*(OZONE_FLIP(I,K,J)+OZONE_FLIP(I,K+1,J))/2.
!          ENDDO
!          DU(I,J)=DU(I,J)*0.78914
!        ENDDO
!        ENDDO
!      ENDIF
!------------------------------------------------------------------------
!*** DEBUG SECTION 
!------------------------------------------------------------------------
!
      DO J=JTS,JTE
      DO I=ITS,ITE
        DO K=1,LM
          KFLIP=LM+1-K
          tph_no2(I,J,K)=ph_h2o2(I,K,J)
      ENDDO
      ENDDO
      ENDDO
!
!------------------------------------------------------------------------
!*** RETURN AERO_BSC AND AERO_UCI ARRAY AGAIN TO TRACERS
!------------------------------------------------------------------------
!
      DO K=1,LM
      DO J=JTS,JTE
      DO I=ITS,ITE
        IF(NUM_AERO_UCI.GT.0)THEN
          DO N=AS,AE
            NK=N-AS+1
            TRACERS(I,J,K,N)=AERO_UCI(I,J,K,NK)
          ENDDO
        ENDIF
        IF(NUM_AERO_BSC.GT.0)THEN
          DO N=BS,BE
            NK=N-BS+1
            TRACERS(I,J,K,N)=AERO_BSC(I,J,K,NK)
          ENDDO
        ENDIF
      ENDDO
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!*** SET FIRST_CHEM FALSE AFTER FIRST TIME
!-----------------------------------------------------------------------
!
      IF(FIRST_CHEM) FIRST_CHEM=.FALSE.
!
!-----------------------------------------------------------------------
!
      RETURN
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CHEM_DRIVER
!
!---------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!---------------------------------------------------------------------
      SUBROUTINE PREP_DRIVER(PD,PT,GLAT,GLON,FIS,PSGML1,SGML2          &
                    ,T,Q,WATER,NUM_WATER,P_QV,P_QC,P_QR,P_QI,P_QS,P_QG &
                    ,PDSG1,DSG2,OZONE_PHY                              &
                    ,XLAT,XLONG,P8W,DZ8W,CLOUDMR,AIRDENSITY,RELHUM     &
                    ,z_at_w,OZONE_FLIP,T_PHY,P_PHY,MOIST,DP8W          &
                    ,LPAR,JPNL,LPART,JPNLT                             &
                    ,IDS,IDE,JDS,JDE,LM                                &
                    ,IMS,IME,JMS,JME,KMS,KME                           &
                    ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  DIAGNOSTICS REQUIRED FOR PHOT AND MECHANISM_DRIVER
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 09-03-06
!
! ABSTRACT:
!     DIAGNOSE PRESSURE, DZ, CLOUDMR, AIRDENSITY AND RELHUM
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   09-02-16  JORBA      - ORIGINATOR OF THE DRIVER
!
! USAGE: CALL PREP_DRIVER FROM CHEM_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,NUM_WATER                  
!
      REAL,INTENT(IN) :: PT
!
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: PD,GLAT,GLON,FIS    
!
      INTEGER,DIMENSION(ITS:ITE,JTS:JTE),INTENT(OUT) :: LPAR,JPNL,LPART,JPNLT
!
      REAL,DIMENSION(1:LM),INTENT(IN) :: DSG2,PDSG1,PSGML1,SGML2
!
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: T,Q
!
      INTEGER,INTENT(IN) :: P_QV,P_QC,P_QR,P_QI,P_QS,P_QG
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_WATER),INTENT(IN) :: WATER
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM),INTENT(IN) :: OZONE_PHY
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(OUT) :: OZONE_FLIP
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(OUT) :: T_PHY
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(OUT) :: XLAT,XLONG
!
      REAL,DIMENSION(ITS:ITE,1:LM+1,JTS:JTE),INTENT(OUT) :: Z_AT_W,P8W
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(OUT) :: CLOUDMR,DZ8W &
                     ,AIRDENSITY,RELHUM,DP8W
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(OUT) :: P_PHY
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE,NUM_WATER),INTENT(OUT) :: MOIST
!
!----------------------------------------------------------------------
!***  LOCAL VARIABLES
!----------------------------------------------------------------------
!
      INTEGER :: I,J,iclm,jclm,K,KFLIP,LL

      REAL :: PDSL,PLYR

      REAL,DIMENSION(1:LM) :: TL,QL,QCL,QRL,QSL,CHEML,DZ2,DELT2

!     PARAMTER CRTLAP SPECIFIES THE CRITICAL LAPSE RATE
!     (IN K/M) IDENTIFYING THE TROPOPAUSE.  WE START
!     LOOKING FOR THE TROPOPAUSE ABOVE PRESSURE LEVEL
!     PSTART (IN PASALS).
      REAL,PARAMETER :: CRTLAP=0.002E0, PSTART=5.0E4
      
      REAL :: PM,DELT,DZ
      REAL,DIMENSION(1:LM) :: TLAPSE,TLAPSE2
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  NOTE: Where to solve chemistry-input to phot and mechanism
!-----------------------------------------------------------------------
!
! LPAR and JPNL is obtained computing the tropopause height in PREP_DRIVER
! If the user wants to fix a constant num of CTM levels uncomment next lines
! If the user wants to use tropopause height uncomment tropopause section
! LPAR: nº of levels of CTM
! JPNL: nº of levels requiring chemistry
      LPAR (:,:) = LM-2 !LM-2 !To avoid problems with photolysis process
      JPNL (:,:) = LM-2 !LM-2

      LPART(:,:) = LM-1 !LM-1
      JPNLT(:,:) = LM-1 !LM-1

!UNITS:
!AIRDENSITY: airdensity [kg/m3]
!DZ8W: layer thickness [m]
!-----------------------------------------------------------------------
!***  NOTE:  THE NMMB HAS IJK STORAGE WITH LAYER 1 AT THE TOP.
!***         THE WRF PHYSICS DRIVERS HAVE IKJ STORAGE WITH LAYER 1
!***         AT THE BOTTOM.
!-----------------------------------------------------------------------
!
      DO JCLM = JTS, JTE 
      DO ICLM = ITS, ITE 
        I=ICLM
        J=JCLM
        PDSL=PD(I,J)
        XLAT(I,J)=GLAT(I,J)*RTD
        XLONG(I,J)=GLON(I,J)*RTD
        P8W(I,LM+1,J)=PT
        Z_AT_W(I,1,J)=FIS(I,J)/G
!
!-----------------------------------------------------------------------
!***  FILL THE SINGLE-COLUMN INPUT
!-----------------------------------------------------------------------
!
        DO K=LM,1,-1   ! We are moving down from the top in the flipped arrays
          KFLIP=LM+1-K ! The flipped index will thus be for the NMMB arrays
!
          PLYR=SGML2(KFLIP)*PDSL+PSGML1(KFLIP)
!
          TL(K)=T(I,J,KFLIP)
          QL(K)=AMAX1(Q(I,J,KFLIP),EPSQ)
          QCL(K)=AMAX1(WATER(I,J,KFLIP,P_QC),EPSQ)
          QRL(K)=AMAX1(WATER(I,J,KFLIP,P_QR),EPSQ)
          QSL(K)=AMAX1(WATER(I,J,KFLIP,P_QS),EPSQ)
!          AIRDENSITY(I,K,J)=RHO_PHY(I,K,J)
          AIRDENSITY(I,K,J)=PLYR/(R_D*TL(K)*(1.+P608*QL(K)))
!
          MOIST(I,K,J,P_QV)=QL(K)/(1.-QL(K))  !!!!REVISAR DIMENSIONS moist
          MOIST(I,K,J,P_QC)=QCL(K)
          MOIST(I,K,J,P_QR)=QRL(K)
          MOIST(I,K,J,P_QS)=QSL(K)
!
          CLOUDMR(I,K,J)=MOIST(I,K,J,P_QC)/0.622
!
          T_PHY(I,K,J)=TL(K)
          P8W(I,K,J)=P8W(I,K+1,J)+PDSG1(KFLIP)+DSG2(KFLIP)*PDSL
!
          P_PHY(I,K,J)=PLYR
          DP8W(I,K,J)=dsg2(KFLIP)*pd(i,j)+pdsg1(KFLIP)
          DZ8W(I,K,J)=TL(K)*(P608*QL(K)+1.)*R_D          &
                       *(P8W(I,K,J)-P8W(I,K+1,J))        &
                       /(P_PHY(I,K,J)*G)
!
          RELHUM(I,K,J)=MIN( .9995, moist(i,k,j,p_qv) / &
!          RELHUM(I,K,J)=MIN( .95, moist(i,k,j,p_qv) / &
                       (3.80*exp(17.27*(t_phy(i,k,j)-273.)/ &
                       (t_phy(i,k,j)-36.))/(.01*p_phy(i,k,j))))
          RELHUM(I,K,J) = MAX(.001,RELHUM(I,K,J))
!
          CHEML(K)=MAX(OZONE_PHY(I,J,KFLIP),EPSQ)
          OZONE_FLIP(I,K,J)=CHEML(K)
!
        ENDDO
!
        DO K=2,LM+1
          Z_AT_W(I,K,J)=Z_AT_W(I,K-1,J)+DZ8W(I,K-1,J)
        ENDDO
!
!       PSFC(I,J)=P8W(I,1,J)
!
        DO 10 K=2,LM-1
!----------------------------------------------------------------------
!     COMPUTE TROPOPAUSE DATA HEIGHT.  AT EACH MASS
!     POINT A SURFACE UP SEARCH IS MADE FOR THE FIRST
!     OCCURRENCE OF A THREE LAYER MEAN LAPSE RATE LESS THAN
!     OR EQUAL TO A CRITICAL LAPSE RATE.  THIS CRITCAL LAPSE
!     RATE IS 2DEG/KM.  THIS IS IN ACCORD WITH THE WMO
!     DEFINITION OF A TROPOPAUSE.  A MAXIMUM TROPOPAUSE
!     PRESSURE OF 500MB IS ENFORCED. ONCE THE TROPOPAUSE
!     IS LOCATED IN A COLUMN, LPAR and JPNL ARE DEFINED.
!----------------------------------------------------------------------
!
          PM=P8W(I,K,J)
          DELT=T_PHY(I,K+1,J)-T_PHY(I,K,J)
!         DZ=0.5*(DZ8W(I,K+1,J)-DZ8W(I,K-1,J))
          DZ=0.5*(Z_AT_W(I,K+1,J)-Z_AT_W(I,K-1,J))
          TLAPSE(K)=-DELT/DZ

          IF ((TLAPSE(K).LT.CRTLAP).AND.(PM.LT.PSTART)) THEN
            IF (K .EQ. LM-1 .AND. TLAPSE(K) .LT. CRTLAP) GOTO 15
            DZ2(K-1) = 0.
            DO 17 LL=K,(LM-2)
              DZ2(LL) = 0.
              DELT2(LL) = 0.
              TLAPSE2(LL) = 0.
!         DZ2(LL) = (2./3.)*(ZINT(I,J,LL-2)-ZINT(I,J,L+1))
              DZ2(LL) = (2./3.)*(Z_AT_W(I,LL+2,J)-Z_AT_W(I,K-1,J))
              IF((DZ2(LL).GT.2000.).AND.(DZ2(LL-1).GT.2000.)) GOTO 15
              DELT2(LL) = T(I,J,LL+2)-T(I,J,K)
              TLAPSE2(LL) = -DELT2(LL)/DZ2(LL)
!
              IF (TLAPSE2(LL) .GT. CRTLAP) THEN
                GOTO 10
              ENDIF
!
   17     CONTINUE
          ELSE
            GOTO 10
          ENDIF
!
   15     CONTINUE

          LPART(I,J) = K
          JPNLT(I,J) = K

          GOTO 20
   10   CONTINUE

        LPART(I,J) = LM-2
        JPNLT(I,J) = LM-2
!!         WRITE(88,*)'REACHED TOP FOR K,P,TLAPSE:  ',K,PM,TLAPSE
   20   CONTINUE
!!!!!!END TROPOPAUSE HEIGHT
!
!*** DEBUG
!
!        IF(I.eq.60.and.J.eq.30)THEN
!          IF(MYPE==0)THEN
!            PRINT *,'PREP_PRCSS:',Z_AT_W(I,:,J),'DZ8W:',DZ8W(I,:,J)
!          ENDIF
!        ENDIF
!
      ENDDO
      ENDDO
!-----------------------------------------------------------------------
!***  END DIAGNOSTICS
!-----------------------------------------------------------------------
!
      RETURN
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PREP_DRIVER
!
!---------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!---------------------------------------------------------------------
      SUBROUTINE EMISSION_DRIVER(FIRST_CHEM,GLOBAL,NTIMESTEP,DT        &
                ,NPHS,NEMIS                                            &
                ,NSTEPS_SPINUP                                         &
                ,START_YEAR,START_MONTH,START_DAY                      &
                ,START_HOUR,JULDAY                                     &
                ,P_QC,P_QV,P_QR,NUM_WATER                              &
                ,T_PHY,MOIST_PHY,P_PHY,IVGTYP,T2,RSWIN,VEGFRC          &
                ,USTAR,Z0,XLAT,XLONG                                   &
                ,CHEM,NUM_GAS                                          &
                ,AERO_BSC,NUM_AERO_BSC                                 &
!NEW_EMISS 0 and 1
                ,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_XYL,E_HNO3,E_HCHO,E_NO2,E_ISODBG                    &
!NEW_EMISS 2
                ,E_ALDX,E_IOLE,E_NO2_AIR,E_NO_AIR                      &
!NH3
                ,E_NH3,E_BC,E_OM                                       &
!NEW_EMISS 6
                ,E_HONO,E_BENZENE,E_CH4                                &
!                ,E_XYL,E_HNO3,E_HCHO                                   &
!                ,E_NO2,E_ISODBG                                        &
!                ,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_CO_BB,E_NO_BB,E_SO2_BB,E_NH3_BB                     &
                ,E_BC_BB,E_OM_BB                                       &
                ,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_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,Z_AT_W,AIRDENSITY,FIS,rh_emi                     &
                ,DARE,DP8W,EMI_TOTAL_DBG                               &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  EMISSION_DRIVER SCHEME
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 09-03-25
!
! ABSTRACT:
!     EMISSION_DRIVER DRIVES THE EMISSIONS FOR THE CHEMISTRY
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   09-03-25  JORBA      - ORIGINATOR OF THE DRIVER
!   09-11-24  JORBA      - NEW NUM_GAS INDEXES
!
! USAGE: CALL EMISS_DRIVER FROM CHEM_DRIVER
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
      USE module_data_radm2
!
!----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      LOGICAL,INTENT(IN) :: GLOBAL,FIRST_CHEM

      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,START_HOUR,NPHS,NEMIS,JULDAY     &
                           ,NSTEPS_SPINUP
      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) :: DT

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

      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS

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

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

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

      INTEGER,INTENT(IN) :: NUM_GAS,NUM_WATER,P_QC,P_QV,P_QR

      INTEGER,INTENT(IN) :: NUM_AERO_BSC                        

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: T_PHY, P_PHY

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE,NUM_WATER),INTENT(IN) :: MOIST_PHY

      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IVGTYP

      REAL, DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: T2,RSWIN,VEGFRC,USTAR,Z0

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

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

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,NUM_AERO_BSC),INTENT(INOUT) :: AERO_BSC
! EMISS FOR NEW_EMISS=0,1
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_XYL,E_HNO3,E_HCHO,                                        &
           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
! EMISS FOR NEW_EMISS=2
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
                 E_ALDX,E_IOLE,E_NO2_AIR,E_NO_AIR 
!NH3
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(INOUT) ::    &
           E_NH3,E_BC,E_OM                                             &
!NEW_EMISS 6
          ,E_HONO,E_BENZENE,E_CH4                                      &
!
!NEW_EMISS 37
                ,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_CO_GFAS                               &
                ,E_CO_BB,E_NO_BB,E_SO2_BB,E_NH3_BB                     &
                ,E_BC_BB,E_OM_BB       
! EMISS FOR NEW_EMISS=3 ALL ALREADY IN OTHER OPTIONS
!      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                
!
      REAL, DIMENSION( IMS:IME, JMS:JME, kms:kme ),INTENT(OUT) ::      &
           E_ISODBG
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(INOUT) :: EMI_TOTAL_DBG
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
!
      INTEGER  :: I,J,K,NCHEM,KFLIP,TT,TTFLIP

      REAL  :: TCHEM,DTCHEM,CONV_RHO,conv_rho_low,sumdz

      LOGICAL  ::  CALL_EMIS

      CHARACTER*80 :: FILENAME

      REAL,ALLOCATABLE,DIMENSION(:,:) :: TEMP1

      REAL,ALLOCATABLE,DIMENSION(:,:,:) :: E_BIO

      INTEGER :: NE_AREA

! FROM CONFIGURE_FILE
!
!      INTEGER :: CNST !0  = EMISSIONS ARE NOT CONSTANT IN TIME
!                      !1  = EMISSIONS ARE CONSTANT IN TIME
!
!      INTEGER :: BIO_MOD !1 = SIMPLE BIOGENIC EMISSIONS ONLINE SCHEME
!                         !2 = MEGAN BIOGENIC EMISSION MODEL
! 
!      INTEGER :: NEW_EMISS  !MOZART EMISSIONS
!
!MEGAN VARIABLES
!
    LOGICAL, SAVE :: FIRSTIME=.TRUE.

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

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

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

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

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

    REAL*8 :: CURR_SECS
!
!!TEMPORAL FOR MOZART EMISSIONS
!! 6 emission classes:
!!   1-Anthropogenic
!!   2-Biomass Burning
!!   3-Biogenic
!!   4-Ocean
!!   5-Volcanos
!!   6-Soil
!      REAL, DIMENSION( IMS:IME, JMS:JME, 1:6 ) ::    &
!       E_CO_A, E_NO_A, E_OLE_A, E_SO2_A, E_TOL_A, &
!       E_ISOP_A,E_MEOH_A,E_ALD2_A,E_FORM_A,E_ETHA_A, &
!       E_ETOH_A,E_ETH_A,E_TERP_A,E_PAR_A   

!     INTEGER :: num_lay_emiss  from namelist
     CHARACTER*1 :: cLAY

!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!
!TEMPORAL INDEX MAPPING TO e_bio array
!      LISO=39
!      LHO2=41
!
!!!DT meteo integration time step in seconds
!!!DTCHEM chemistry integration time step in seconds (DT)
!!!NCHEM*DT time between chemistry execution in seconds
!!!NTIMESTEP*DT time of chemistry integration in seconds (TCHEM)
!!!Be careful, TCHEM different definition than in chemistry routine
!
      NCHEM=NPHS
!      TCHEM=START_HOUR*3600.0+DT*NTIMESTEP !Carefull from wrfchem !!!tchem = gmt*3600.0 + dtstep*(ktau-1)
      TCHEM=START_HOUR*3600.0+DT*NTIMESTEP
      DTCHEM=NCHEM*DT

! TO ACCOUNT FOR SPINUP
       IF(FIRST_CHEM)THEN
! FIRSTIME WE COMPUTE EMISSIONS
!      IF(NTIMESTEP.EQ.NCHEM)THEN !FIRSTIME WE COMPUTE EMISSONS
        CALL_EMIS=.TRUE.
      ELSE
        CALL_EMIS=MOD(NTIMESTEP,NEMIS)==0
      ENDIF

      IF(MYPE==0)THEN
        WRITE(0,*) 'DINS EMISSION DRIVER',GLOBAL,TCHEM,NCHEM,DT,NTIMESTEP,DTCHEM,ONLINE_BIOG,'CALL_EMIS=',CALL_EMIS
      ENDIF
!
!----------------------------------------------------------------------
! COMPUTE ONLINE BIOGENIC EMISSIONS FROM GUENTHER ONLINE SCHEME
! USING USGS LANDUSE CLASSIFICATION OR MEGAN model
!----------------------------------------------------------------------
!
      IF(ONLINE_BIOG)THEN
!
        IF(BIO_MOD.EQ.1) THEN !SIMPLE SCHEME
!
          NE_AREA = 41 !!!CHECK THE EXACT NUMBER-FROM module_data_radm2.F90!!! 
          ALLOCATE(E_BIO(its:ite, jts:jte, NE_AREA),stat=i)
!!UNITS OF EMISSIONS E_BIO (PPM*M/min)
          CALL bio_emissions(                                          &
               julday,t_phy,moist_phy,                                 &
               p_qc,p_qv,p_qr,num_water,                               &
               e_bio,p_phy,ne_area,                                    &
               ivgtyp,RSWIN,vegfrc,ustar,z0,xlat,xlong,z_at_w,         &
               ids,ide, jds,jde, kms,kme,                              &
               ims,ime, jms,jme, kms,kme,                              &
               its,ite, jts,jte, kms,kme)
!
        ELSEIF(BIO_MOD.EQ.2) THEN !MEGAN
!
         IF(MECH==2 .OR. MECH==22)THEN
          NE_AREA = 38 !!!CHECK THE EXACT NUMBER for MEGAN-FROM MODULE_CHEM_DATA.F90!!!
         ELSEIF(MECH==3.OR.MECH==37)THEN
          NE_AREA = 44
         ENDIF
          ALLOCATE(E_BIO(its:ite, jts:jte, NE_AREA),stat=i)
!!!UNITS OF EMISSIONS E_BIO (PPM*M/min)
          IF(FIRSTIME) THEN
            ALLOCATE(msebio_isop(ims:ime , jms:jme))
            ALLOCATE(pftp_bt(ims:ime , jms:jme))
            ALLOCATE(pftp_nt(ims:ime , jms:jme))
            ALLOCATE(pftp_sb(ims:ime , jms:jme))
            ALLOCATE(pftp_hb(ims:ime , jms:jme))
            ALLOCATE(mlai(ims:ime , jms:jme, 12))
            ALLOCATE(mtsa(ims:ime , jms:jme))
            ALLOCATE(mswdown(ims:ime , jms:jme))

            CALL READ_MEGAN_CNST_FIELDS(msebio_isop,pftp_bt,pftp_nt    &
                             ,pftp_sb,pftp_hb,mlai,mtsa,mswdown        &
                             ,ids,ide, jds,jde, LM                     &
                             ,ims,ime, jms,jme, kms,kme                &
                             ,its,ite, jts,jte)
             FIRSTIME=.FALSE.
           ENDIF
!
           CURR_SECS=TCHEM
           CALL bio_emissions_megan2(NTIMESTEP,DT,DTCHEM               &
             ,CURR_SECS,julday,REAL(START_HOUR),xlat,xlong             &
             ,p_phy,AIRDENSITY,dz8w,chem,num_gas,ne_area               &
             ,START_MONTH,T2,RSWIN,e_bio,msebio_isop                   &
             ,pftp_bt,pftp_nt,pftp_sb,pftp_hb,mlai,mtsa,mswdown        &
             ,ids,ide, jds,jde, LM                                     &
             ,ims,ime, jms,jme, kms,kme                                &
             ,its,ite, jts,jte, kms,kme)
        ENDIF
!
      ENDIF
!----------------------------------------------------------------------
! READ EMISSIONS FROM INPUT FILE EVERY HOUR
!----------------------------------------------------------------------
globalrun: IF(.not.GLOBAL.AND.NEW_EMISS.EQ.0) THEN  !Emissions for a regional run and not from AQMEII-Phase2 - from CALIOPE - updated to work with netcdf

      IF(MECH == 2 .OR. MECH == 22 .OR. MECH == 3) THEN !CB05
      IF(CALL_EMIS)THEN !WE READ EMISSIONS FROM FILE
      allocate(temp1(ids:ide,jds:jde),stat=i)

!      num_lay_emiss=6
               
      DO k=num_lay_emiss,1,-1
      kflip=lm-k+1
      write(cLAY,'(i1)') k
      FILENAME='emimodel.2001.07.l.LVL'//cLAY//'.dat'

      IF(CNST == 0)THEN !EMISSIONS EVERY HOUR
          if(mype==0)then
            WRITE(0,*)'WE OPEN THE EMISSION FILE AT:',(START_HOUR+TCHEM/3600.),' ', FILENAME,' Layer: ',kflip
            OPEN(3243,file=FILENAME,STATUS='OLD',form='unformatted')
          endif

!!!!!WE MOVE INTO THE DESIRED HOUR !!!TEMPORAL ONLY VALID FOR 24h RUNS RIGHT NOW

         IF((START_HOUR+TCHEM/3600.).GE.1)THEN
           J=16*(START_HOUR+TCHEM/3600.) !We have 16 gases in the emission file
           DO I=1,J
             if(mype==0)then
               write(0,*) J, I
               read(3243)temp1 !skip gases previous hours
             endif
           ENDDO
         ENDIF
      ELSE !EMISSIONS CONSTANT IN TIME
      if(mype==0)then
        OPEN(3243,file=FILENAME,STATUS='OLD',form='unformatted')
      endif
      ENDIF

      if(mype==0)then
        WRITE(0,*)'READ CO EMISSION AT:', (START_HOUR+TCHEM/3600.)
        read(3243)temp1 !OPEN !sea mask
      endif
      if(mype==0)then
        read(3243)temp1 !CO
      endif
      call dstrb(temp1,E_CO,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !NH3
      endif
      if(mype==0)then
        read(3243)temp1 !NO
      endif
      call dstrb(temp1,E_NO,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !NO2
      endif
      call dstrb(temp1,E_NO2,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !SO2
      endif
      call dstrb(temp1,E_SO2,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !SULF
      endif
      if(mype==0)then
        read(3243)temp1 !ALD2
      endif
      call dstrb(temp1,E_ALD2,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ETH
      endif
      call dstrb(temp1,E_ETH,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !FORM
      endif
      call dstrb(temp1,E_FORM,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !OLE
      endif
      call dstrb(temp1,E_OLE,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !PAR
      endif
      call dstrb(temp1,E_PAR,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !TOL
      endif
      call dstrb(temp1,E_TOL,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !XYL
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ISOP
      endif
      call dstrb(temp1,E_ISOP,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !TERP
      endif
      call dstrb(temp1,E_TERP,1,1,1,lm,kflip,mype,mpi_comm_comp)

      IF(CNST == 0)THEN !EMISSIONS EVERY HOUR CLOSING EMISSION FILE
        if(mype==0)then
          WRITE(0,*)'WE CLOSE THE EMISSION FILE AT:',(START_HOUR*3600.+TCHEM)/3600.
          close(3243)
        endif
      ELSE !EMISSIONS CONSTANT IN TIME
        if(mype==0)then
          close(3243)
        endif
      ENDIF

      ENDDO !num_lay_emiss

      call halo_exch(E_CO,lm,2,2)
      call halo_exch(E_NO,lm,2,2)
      call halo_exch(E_NO2,lm,2,2)
      call halo_exch(E_SO2,lm,2,2)
      call halo_exch(E_ALD2,lm,2,2)
      call halo_exch(E_ETH,lm,2,2)
      call halo_exch(E_FORM,lm,2,2)
      call halo_exch(E_OLE,lm,2,2)
      call halo_exch(E_PAR,lm,2,2)
      call halo_exch(E_TOL,lm,2,2)
      call halo_exch(E_XYL,lm,2,2)
      call halo_exch(E_ISOP,lm,2,2)
      call halo_exch(E_TERP,lm,2,2)

      deallocate(temp1)
      ENDIF !CALL_EMIS
      ENDIF !MECH == 2 or 22 or 3

!----------------------------------------------------------------------
! add emissions regional emissions
!----------------------------------------------------------------------

      IF(MYPE==0)THEN
        WRITE(0,*) 'BEFORE ADDING EMISSIONS CO:',chem(40,40,:,P_CO)
        WRITE(0,*) 'BEFORE ADDING EMISSIONS E_CO:',E_CO(40,40,:)
        WRITE(0,*) 'APPLYING CONVEMI FACTOR = ',CONVEMI
      ENDIF

      DO 201 j=jts,jte
      DO 201 i=its,ite

      DO k=kms,kme
! 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.)
        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)*CONVEMI !From configfile to apply a factor to anthro. emissions

        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_NO2)  =  chem(i,j,k,P_NO2)                        &
                         + E_NO2(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_ALD2)  =  chem(i,j,k,P_ALD2)                      &
                         + E_ALD2(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_FORM)  =  chem(i,j,k,P_FORM)                      &
                         + E_FORM(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_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

        IF(ONLINE_BIOG .and. k.eq.LM) THEN
!
          IF(BIO_MOD==1)THEN !SIMPLE ONLINE
            kflip=LM-k+1
            chem(i,j,k,p_isop) = chem(i,j,k,p_isop)                    &
                           + e_bio(i,j,39)/(dz8w(i,kflip,j)*60.)*dtchem   !liso=39 temporal
            chem(i,j,k,p_terp) = chem(i,j,k,p_terp)                    &  !we use e_bio(lho2) as a temporal storage var
                           + e_bio(i,j,41)/(dz8w(i,kflip,j)*60.)*dtchem   !lho2=41 temporal
            E_ISOP(i,j,k)=e_bio(i,j,39)  !!For debug purpouses
            E_TERP(i,j,k)=e_bio(i,j,41)
          ELSEIF(BIO_MOD==2)THEN !MEGAN
            !EMISSIONS ALREADY IN CHEM ARRAY, DONE IN MEGAN ROUTINE
            !FOR DEBUG WE PUT BIOGEMISS IN E_emiss ARRAYS units (mol km-2 hr-1) WRONG!!!
            E_ISODBG(i,j,LM)=e_bio(i,j,p_isop)
            E_ISODBG(i,j,LM-1)=e_bio(i,j,p_terp)
          ENDIF
!
        ENDIF

        IF(.NOT.ONLINE_BIOG) THEN
           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
        ENDIF

      END DO !k loop
 201  continue

      IF(ONLINE_BIOG) THEN
        DEALLOCATE (E_BIO)
      ENDIF

ELSE  !GLOBALRUN emissions for a global run

mechanism: IF(MECH==1) THEN !CB-IV
IF(CALL_EMIS)THEN !READ EMISSIONS FROM FILE
!------------------------------------------------------------------------
! ***** START ALLOCATION OF EMISSION TO CB-IV SPECIES *******************
!------------------------------------------------------------------------
      IF(NTIMESTEP==NCHEM .OR. MOD(TCHEM,3600.0)==0.)THEN  !READ EVERY O'CLOCK HOUR

      IF(NTIMESTEP==NCHEM)THEN !READ FIRST EMISSION FILE !!!REQUIRES FURTHER ANALYSIS
        IF(MYPE==0)THEN
          WRITE(0,*) 'READ INITIAL EMISSION FILE',TCHEM,NTIMESTEP
        ENDIF
      ELSE
        IF(MYPE==0)THEN
          WRITE(0,*) 'READ EVERY HOUR',TCHEM
        ENDIF
      ENDIF

      allocate(temp1(ids:ide,jds:jde),stat=i)

!      IF (.NOT.NEW_EMISS) THEN ! USE OLD EMISSIONS
      IF (NEW_EMISS.EQ.0) THEN ! USE OLD EMISSIONS
!!!
!*** emissdummy contains:
!'SO2 ' &!
!'NO  ' &!
!'NO2 ' &!
!'HNO3' &!
!'HO  ' &!
!'HCHO' &! XXXXX
!'HC3 ' &!
!'HC5 ' &!
!'HC8 ' &!
!'ETH ' &!
!'CO  ' &!
!'OL2 ' &! XXXXX
!'OLT ' &!
!'OLI ' &!
!'TOL ' &!
!'XYL ' &!
!'KET ' &!
!'CSL ' &!
!'ISO ' &!
!'PM25' &!
!'PM10' &!)
!'OC  ' &!
!'BC  ' &
!'DMS ' &
!'SULF'  /)
!!!

      if(mype==0)then
        IF(CNST == 0)THEN
          CALL EMISS_FILE_NAME(START_YEAR,START_MONTH,START_DAY      &
                            ,START_HOUR,TCHEM,NTIMESTEP,FILENAME)
          WRITE(0,*) 'OPEN emissdummy file: ',FILENAME
        ELSEIF(CNST == 1)THEN
          CALL EMISS_FILE_NAME(START_YEAR,START_MONTH,START_DAY      &
                            ,START_HOUR,START_HOUR*3600.0          &
                            ,0,FILENAME)
          WRITE(0,*) 'OPEN emissdummy file: ',FILENAME
        ENDIF
        open(3243,file=FILENAME,status='old',form='unformatted')
        read(3243)temp1 !SO2
      endif
      if(mype==0)then
        read(3243)temp1 !NO
      endif
      call dstrb(temp1,E_NO,1,1,1,lm,lm,mype,mpi_comm_comp)
      IF(MYPE==0)THEN
        WRITE(0,*) 'READ E_NO:',E_NO(40,40,:)
      ENDIF
      if(mype==0)then
        read(3243)temp1 !NO2
      endif
      call dstrb(temp1,E_NO2,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !HNO3
      endif
      call dstrb(temp1,E_HNO3,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !HO
      endif
!      call dstrb(temp1,E_OH,1,1,1,lm,lm,mype,mpi_comm_comp) !???
      if(mype==0)then
        read(3243)temp1 !HCHO
      endif
      call dstrb(temp1,E_HCHO,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !HC3
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp) !we use XYL as a tempora variable here
      E_PAR=0.35*E_XYL
      if(mype==0)then
        read(3243)temp1 !HC5
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      E_PAR=E_PAR+0.35*E_XYL
      if(mype==0)then
        read(3243)temp1 !HC8
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      E_PAR=E_PAR+0.10*E_XYL
      if(mype==0)then
        read(3243)temp1 !ETH
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      E_PAR=E_PAR+0.2*E_XYL !we finish the diagnostic of PAR variable!!
                      !PAR=0.2*ETH+0.35*HC3+0.35*HC5+0.1*HC8
      if(mype==0)then
        read(3243)temp1 !CO
      endif
      call dstrb(temp1,E_CO,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !OL2
      endif
      call dstrb(temp1,E_ETH,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !OLT
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp) !we use XYL as a tempora variable here
      E_OLE=0.1*E_XYL
      if(mype==0)then
        read(3243)temp1 !OLI
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      E_OLE=E_OLE+0.9*E_XYL !we finish the diagnostic of OLE variable!!
                      !OLE=0.1*OLT+0.9*OLI
      if(mype==0)then
        read(3243)temp1 !TOL
      endif
      call dstrb(temp1,E_TOL,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !XYL
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !KET
      endif
      if(mype==0)then
        read(3243)temp1 !CSL
      endif
      if(mype==0)then
        read(3243)temp1 !ISO
        close(3243)
      endif
      call dstrb(temp1,E_ISOP,1,1,1,lm,lm,mype,mpi_comm_comp)

      call halo_exch(E_TOL,lm,2,2)
      call halo_exch(E_XYL,lm,2,2)
      call halo_exch(E_HNO3,lm,2,2)
      call halo_exch(E_CO,lm,2,2)
      call halo_exch(E_ETH,lm,2,2)
      call halo_exch(E_PAR,lm,2,2)
      call halo_exch(E_HCHO,lm,2,2)
      call halo_exch(E_ISOP,lm,2,2)
      call halo_exch(E_OLE,lm,2,2)
      call halo_exch(E_NO2,lm,2,2)
      call halo_exch(E_NO,lm,2,2)

!      ELSE ! MOZART EMISSIONS
      ELSEIF(NEW_EMISS.EQ.1) THEN !MOZART EMISSIONS

      if(mype==0)then
        OPEN(3243,file='emimodel.2001.02.l.dat',STATUS='OLD',form='unformatted')
        read(3243)temp1 !CO
      endif
      call dstrb(temp1,E_CO,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !NO
      endif
!We distribute NOx to 90% NO and 10% NO2
      call dstrb(0.9*temp1,E_NO,1,1,1,lm,lm,mype,mpi_comm_comp)
      call dstrb(0.1*temp1,E_NO2,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !OLE
      endif
      call dstrb(temp1,E_OLE,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !SO2
      endif
!      call dstrb(temp1,E_SO2,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !TOL
      endif
      call dstrb(temp1,E_TOL,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ISOP
      endif
      call dstrb(temp1,E_ISOP,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !MEOH
      endif
!      call dstrb(temp1,E_MEOH,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ALD2
      endif
      call dstrb(temp1,E_ALD2,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !FORM
      endif
      call dstrb(temp1,E_HCHO,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ETHA
      endif
!      call dstrb(temp1,E_ETHA,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ETOH
      endif
!      call dstrb(temp1,E_ETOH,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ETH
      endif
      call dstrb(temp1,E_ETH,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !TERP
      endif
!      call dstrb(temp1,E_TERP,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !PAR
        close(3243)
      endif
      call dstrb(temp1,E_PAR,1,1,1,lm,lm,mype,mpi_comm_comp)

      call halo_exch(E_CO,lm,2,2)
      call halo_exch(E_NO,lm,2,2)
      call halo_exch(E_NO2,lm,2,2)
      call halo_exch(E_OLE,lm,2,2)
!      call halo_exch(E_SO2,lm,2,2)
      call halo_exch(E_TOL,lm,2,2)
      call halo_exch(E_ISOP,lm,2,2)
!      call halo_exch(E_MEOH,lm,2,2)
      call halo_exch(E_ALD2,lm,2,2)
      call halo_exch(E_HCHO,lm,2,2)
!      call halo_exch(E_ETHA,lm,2,2)
!      call halo_exch(E_ETOH,lm,2,2)
      call halo_exch(E_ETH,lm,2,2)
!      call halo_exch(E_TERP,lm,2,2)
      call halo_exch(E_PAR,lm,2,2)

      ENDIF !OLD EMISS OR MOZART

      deallocate(temp1)

      ENDIF !READ EVERY O'CLOCK HOUR
ENDIF !CALL_EMIS
!----------------------------------------------------------------------
! add emissions
!----------------------------------------------------------------------

      IF(MYPE==0)THEN
        WRITE(0,*) 'BEFORE ADDING EMISSIONS CO:',chem(10,10,:,P_CO)
        WRITE(0,*) 'BEFORE ADDING EMISSIONS E_CO:',E_CO(10,10,:)
      ENDIF

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

!      IF(MYPE==0)THEN
!        WRITE(0,*) 'ADD EMISSION',i,j
!      ENDIF

      DO k=kms,kme

!      IF (.NOT.NEW_EMISS) THEN ! USE OLD EMISSIONS
      IF (NEW_EMISS.EQ.0) THEN !USE OLD EMISSIONS

!       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.)
        conv_rho=8.047e-6/AIRDENSITY(i,k,j)*dtchem/dz8w(i,k,j)
        chem(i,j,k,P_NO)  =  chem(i,j,k,P_NO)                        &
                         + E_NO(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_HNO3)  =  chem(i,j,k,P_HNO3)                        &
                         + E_HNO3(i,j,k)*conv_rho
        chem(i,j,k,P_HCHO)  =  chem(i,j,k,P_HCHO)                        &
                         + E_HCHO(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_CO)  =  chem(i,j,k,P_CO)                        &
                         + E_CO(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_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
!        IF(.NOT.ONLINE_BIOG)THEN
!        chem(i,j,k,P_ISOP)  =  chem(i,j,k,P_ISOP)                        &
!                         + E_ISOP(i,j,k)*conv_rho
!        ENDIF


        IF(ONLINE_BIOG .and. k.eq.LM) THEN
        kflip=LM-k+1
!ADD BIOGENIC EMISSIONS FROM E_BIO VARIABLE
!-------------FROM RACM2 TO CBMZ
!      do j=jts,jte
!      do i=its,ite
!        chem(i,kts,j,p_so2) = chem(i,kts,j,p_so2)    &
!                          + e_bio(i,j,lso2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_sulf) = chem(i,kts,j,p_sulf)    &
!                          + e_bio(i,j,lsulf)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_no2) = chem(i,j,k,p_no2)    &
                          + e_bio(i,j,lno2)/(dz8w(i,kflip,j)*60.)*dtchem
        chem(i,j,k,p_no) = chem(i,j,k,p_no)    &
                          + e_bio(i,j,lno)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_o3) = chem(i,kts,j,p_o3)    &
!                          + e_bio(i,j,lo3)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_hno3) = chem(i,j,k,p_hno3)    &
                          + e_bio(i,j,lhno3)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_h2o2) = chem(i,kts,j,p_h2o2)    &
!                          + e_bio(i,j,lh2o2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_ald) = chem(i,kts,j,p_ald)    &
!                          + e_bio(i,j,lald)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_hcho) = chem(i,j,k,p_hcho)    &
                          + e_bio(i,j,lhcho)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_op1) = chem(i,kts,j,p_op1)    &
!                          + e_bio(i,j,lop1)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_op2) = chem(i,kts,j,p_op2)    &
!                          + e_bio(i,j,lop2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_ora1) = chem(i,kts,j,p_ora1)    &
!                          + e_bio(i,j,lora1)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_ora2) = chem(i,kts,j,p_ora2)    &
!                          + e_bio(i,j,lora2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_nh3) = chem(i,kts,j,p_nh3)    &
!                          + e_bio(i,j,lnh3)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_n2o5) = chem(i,kts,j,p_n2o5)    &
!                          + e_bio(i,j,ln2o5)/(dz8w(i,kts,j)*60.)*dtstep
!!!        chem(i,kts,j,p_no2) = chem(i,kts,j,p_no2)    &
!!!                          + e_bio(i,j,lno2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_pan) = chem(i,kts,j,p_pan)    &
!                          + e_bio(i,j,lpan)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_eth) = chem(i,j,k,p_eth)    &
                          + e_bio(i,j,leth)/(dz8w(i,kflip,j)*60.)*dtchem
        chem(i,j,k,p_co) = chem(i,j,k,p_co)    &
                          + e_bio(i,j,lco)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_ol2) = chem(i,kts,j,p_ol2)    &
!                          + e_bio(i,j,lol2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_olt) = chem(i,kts,j,p_olt)    &
!                          + e_bio(i,j,lolt)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_oli) = chem(i,kts,j,p_oli)    &
!                          + e_bio(i,j,loli)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_tol) = chem(i,j,k,p_tol)    &
                          + e_bio(i,j,ltol)/(dz8w(i,kflip,j)*60.)*dtchem
        chem(i,j,k,p_xyl) = chem(i,j,k,p_xyl)    &
                          + e_bio(i,j,lxyl)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_hono) = chem(i,kts,j,p_hono)    &
!                          + e_bio(i,j,lhono)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_hno4) = chem(i,kts,j,p_hno4)    &
!                          + e_bio(i,j,lhno4)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_ket) = chem(i,kts,j,p_ket)    &
!                          + e_bio(i,j,lket)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_mgly) = chem(i,kts,j,p_mgly)    &
!                          + e_bio(i,j,lmgly)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_onit) = chem(i,kts,j,p_onit)    &
!                          + e_bio(i,j,lonit)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_csl) = chem(i,kts,j,p_csl)    &
!                          + e_bio(i,j,lcsl)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_isop) = chem(i,j,k,p_isop)    &
                          + e_bio(i,j,liso)/(dz8w(i,kflip,j)*60.)*dtchem
!      end do
!      end do

! calc par emissions as a combination of the biogenic emissions
! for radm2 primary voc species
!      do j = jts, jte
!      do i = its, ite
         chem(i,j,k,p_par)  =  chem(i,j,k,p_par)               &
             + (dtchem/(dz8w(i,kflip,j)*60.))*                     &
               ( 0.4*e_bio(i,j,lald) + 2.9*e_bio(i,j,lhc3)         &
               + 4.8*e_bio(i,j,lhc5) + 7.9*e_bio(i,j,lhc8)         &
               + 0.9*e_bio(i,j,lket) + 2.8*e_bio(i,j,loli)         &
               + 1.8*e_bio(i,j,lolt) + 1.0*e_bio(i,j,lora2)        )
!      end do
!      end do
!!-------------------------
!      DEALLOCATE (E_BIO)
!
!FOR DEBUG PURPOUSES
!         E_ISODBG(i,j,k)=E_ISOP(i,j,k)*conv_rho+(e_bio(i,j,liso)/(dz8w(i,k,j)*60.)*dtchem)
      if (k.eq.LM) then
         E_ISODBG(i,j,LM)=e_bio(i,j,liso)/(dz8w(i,kflip,j)*60.)*dtchem
         E_ISODBG(i,j,LM-1)=E_ISOP(i,j,k)*conv_rho
      endif
!
        ELSE
!!ADD BIOGENIC EMISSIONS FROM INPUT FILE
!
        chem(i,j,k,P_ISOP)  =  chem(i,j,k,P_ISOP)                        &
                         + E_ISOP(i,j,k)*conv_rho

        ENDIF !IF ONLINE_BIOG

!      ELSE !MOZART EMISSIONS
      ELSEIF(NEW_EMISS.EQ.1) THEN !MOZART EMISSIONS

        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_OLE)  =  chem(i,j,k,P_OLE)                        &
                         + E_OLE(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_ISOP)  =  chem(i,j,k,P_ISOP)                        &
                         + E_ISOP(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_ALD2)  =  chem(i,j,k,P_ALD2)                        &
                         + E_ALD2(i,j,k)*conv_rho
        chem(i,j,k,P_HCHO)  =  chem(i,j,k,P_HCHO)                        &
                         + E_HCHO(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_ETOH)  =  chem(i,j,k,P_ETOH)                        &
!                         + E_ETOH(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_TERP)  =  chem(i,j,k,P_TERP)                        &
!                         + E_TERP(i,j,k)*conv_rho
        chem(i,j,k,P_PAR)  =  chem(i,j,k,P_PAR)                        &
                         + E_PAR(i,j,k)*conv_rho
      ENDIF

      END DO
 100  continue

      IF(ONLINE_BIOG) THEN
         DEALLOCATE (E_BIO)
      ENDIF

      ELSEIF(MECH == 2 .OR. MECH == 22 .OR. MECH == 3) THEN !CBM05
IF(CALL_EMIS)THEN !READ EMISSION FILE
!------------------------------------------------------------------------
! ***** START ALLOCATION OF EMISSION TO CB05 SPECIES *******************
!------------------------------------------------------------------------
      IF(NTIMESTEP==NCHEM .OR. MOD(TCHEM,3600.0)==0.)THEN  !READ EVERY O'CLOCK HOUR

      IF(NTIMESTEP==NCHEM)THEN !READ FIRST EMISSION FILE !!!REQUIRES FURTHER ANALYSIS
        IF(MYPE==0)THEN
          WRITE(0,*) 'READ INITIAL EMISSION FILE',TCHEM,NTIMESTEP
        ENDIF
      ELSE
        IF(MYPE==0)THEN
          WRITE(0,*) 'READ EVERY HOUR',TCHEM
        ENDIF
      ENDIF

      allocate(temp1(ids:ide,jds:jde),stat=i)


!      IF (.NOT.NEW_EMISS) THEN ! USE OLD EMISSIONS
      IF (NEW_EMISS.EQ.0) THEN !USE OLD EMISSIONS

!!!
!*** emissdummy contains:
!'SO2 ' &!
!'NO  ' &!
!'NO2 ' &!
!'HNO3' &!
!'HO  ' &!
!'HCHO' &! XXXXX
!'HC3 ' &!
!'HC5 ' &!
!'HC8 ' &!
!'ETH ' &!
!'CO  ' &!
!'OL2 ' &! XXXXX
!'OLT ' &!
!'OLI ' &!
!'TOL ' &!
!'XYL ' &!
!'KET ' &!
!'CSL ' &!
!'ISO ' &!
!'PM25' &!
!'PM10' &!)
!'OC  ' &!
!'BC  ' &
!'DMS ' &
!'SULF'  /)
!!!

      if(mype==0)then
        IF(CNST == 0)THEN
          CALL EMISS_FILE_NAME(START_YEAR,START_MONTH,START_DAY      &
                            ,START_HOUR,TCHEM,NTIMESTEP,FILENAME)
          WRITE(0,*) 'OPEN emissdummy file VARIABLE IN TIME: ',FILENAME
        ELSEIF(CNST == 1)THEN
          CALL EMISS_FILE_NAME(START_YEAR,START_MONTH,START_DAY      &
                            ,START_HOUR,START_HOUR*3600.0          &
                            ,0,FILENAME)
          WRITE(0,*) 'OPEN emissdummy file: ',FILENAME
        ENDIF
        open(3243,file=FILENAME,status='old',form='unformatted')
        read(3243)temp1 !SO2
      endif
      call dstrb(temp1,E_SO2,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !NO
      endif
      call dstrb(temp1,E_NO,1,1,1,lm,lm,mype,mpi_comm_comp)
      IF(MYPE==0)THEN
        WRITE(0,*) 'READ E_NO:',E_NO(40,40,:)
      ENDIF
      if(mype==0)then
        read(3243)temp1 !NO2
      endif
      call dstrb(temp1,E_NO2,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !HNO3
      endif
      call dstrb(temp1,E_HNO3,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !HO
      endif
!      call dstrb(temp1,E_OH,1,1,1,lm,lm,mype,mpi_comm_comp) !???
      if(mype==0)then
        read(3243)temp1 !HCHO
      endif
      call dstrb(temp1,E_HCHO,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !HC3
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp) !we use XYL as a tempora variable here
      E_PAR=0.35*E_XYL
      if(mype==0)then
        read(3243)temp1 !HC5
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      E_PAR=E_PAR+0.35*E_XYL
      if(mype==0)then
        read(3243)temp1 !HC8
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      E_PAR=E_PAR+0.10*E_XYL
      if(mype==0)then
        read(3243)temp1 !ETH
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      E_PAR=E_PAR+0.2*E_XYL !we finish the diagnostic of PAR variable!!
                      !PAR=0.2*ETH+0.35*HC3+0.35*HC5+0.1*HC8
      if(mype==0)then
        read(3243)temp1 !CO
      endif
      call dstrb(temp1,E_CO,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !OL2
      endif
      call dstrb(temp1,E_ETH,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !OLT
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp) !we use XYL as a tempora variable here
      E_OLE=0.1*E_XYL
      if(mype==0)then
        read(3243)temp1 !OLI
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      E_OLE=E_OLE+0.9*E_XYL !we finish the diagnostic of OLE variable!!
                      !OLE=0.1*OLT+0.9*OLI
      if(mype==0)then
        read(3243)temp1 !TOL
      endif
      call dstrb(temp1,E_TOL,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !XYL
      endif
      call dstrb(temp1,E_XYL,1,1,1,lm,lm,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !KET
      endif
      if(mype==0)then
        read(3243)temp1 !CSL
      endif
      if(mype==0)then
        read(3243)temp1 !ISO
        close(3243)
      endif
      call dstrb(temp1,E_ISOP,1,1,1,lm,lm,mype,mpi_comm_comp)

      call halo_exch(E_SO2,lm,2,2)
      call halo_exch(E_TOL,lm,2,2)
      call halo_exch(E_XYL,lm,2,2)
      call halo_exch(E_HNO3,lm,2,2)
      call halo_exch(E_CO,lm,2,2)
      call halo_exch(E_ETH,lm,2,2)
      call halo_exch(E_PAR,lm,2,2)
      call halo_exch(E_HCHO,lm,2,2)
      call halo_exch(E_ISOP,lm,2,2)
      call halo_exch(E_OLE,lm,2,2)
      call halo_exch(E_NO2,lm,2,2)
      call halo_exch(E_NO,lm,2,2)


!      ELSE ! MOZART EMISSIONS
      ELSEIF(NEW_EMISS.EQ.1) THEN !MOZART EMISSIONS

      if(mype==0)then      
         WRITE(0,*) 'LAYERS OF EMISSION FILE: ', num_lay_emiss
      endif

!      DO k=1,num_lay_emiss !lm,(lm-num_lay_emiss-1),-1
!      kflip=(lm-num_lay_emiss+1)+k-1

      DO k=num_lay_emiss,1,-1
      kflip=lm-k+1
!      DO kflip=lm,(lm-num_lay_emiss+1),-1
!      k=lm-kflip+1
      write(cLAY,'(i1)') k
      FILENAME='emimodel.2001.07.l.LVL'//cLAY//'.dat'

      IF(CNST == 0)THEN !EMISSIONS EVERY HOUR
!        IF((NTIMESTEP==NCHEM).OR.(MOD((START_HOUR+TCHEM/3600.),24.)==0))THEN !OPEN EMISS FILE AT 00 UTC OF EACH DAY
          if(mype==0)then
            WRITE(0,*)'WE OPEN THE EMISSION FILE AT:',(START_HOUR+TCHEM/3600.),' ', FILENAME,' Layer: ',kflip
            OPEN(3243,file=FILENAME,STATUS='OLD',form='unformatted')
          endif
!        ENDIF

!!!!!WE MOVE INTO THE DESIRED HOUR !!!TEMPORAL ONLY VALID FOR 24h RUNS RIGHT NOW
         IF((START_HOUR+TCHEM/3600.).GE.1)THEN
           J=14*(START_HOUR+TCHEM/3600.)
           DO I=1,J
             if(mype==0)then
               write(0,*) J, I
               read(3243)temp1 !NO
             endif
           ENDDO
         ENDIF
      ELSE !EMISSIONS CONSTANT IN TIME
      if(mype==0)then
        OPEN(3243,file=FILENAME,STATUS='OLD',form='unformatted')
!        read(3243)temp1 !CO
      endif
      ENDIF

      if(mype==0)then
        WRITE(0,*)'READ CO EMISSION AT:', (START_HOUR+TCHEM/3600.)
        read(3243)temp1 !CO            
      endif
      call dstrb(temp1,E_CO,1,1,1,lm,kflip,mype,mpi_comm_comp)
!      call dstrb(temp1,E_CO_A(:,:,j),1,1,1,1,1)
      if(mype==0)then
        read(3243)temp1 !NO
      endif
!!We distribute NOx to 90% NO and 10% NO2
      call dstrb(0.9*temp1,E_NO,1,1,1,lm,kflip,mype,mpi_comm_comp)
      call dstrb(0.1*temp1,E_NO2,1,1,1,lm,kflip,mype,mpi_comm_comp)
!      call dstrb(temp1,E_NO_A(:,:,j),1,1,1,1,1)
      if(mype==0)then
        read(3243)temp1 !OLE
      endif
      call dstrb(temp1,E_OLE,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !SO2
      endif
      call dstrb(temp1,E_SO2,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !TOL
      endif
      call dstrb(temp1,E_TOL,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ISOP
      endif
      call dstrb(temp1,E_ISOP,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !MEOH
      endif
      call dstrb(temp1,E_MEOH,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ALD2
      endif
      call dstrb(temp1,E_ALD2,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !FORM
      endif
      call dstrb(temp1,E_FORM,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ETHA
      endif
      call dstrb(temp1,E_ETHA,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ETOH
      endif
      call dstrb(temp1,E_ETOH,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !ETH
      endif
      call dstrb(temp1,E_ETH,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !TERP
      endif
      call dstrb(temp1,E_TERP,1,1,1,lm,kflip,mype,mpi_comm_comp)
      if(mype==0)then
        read(3243)temp1 !PAR
!        close(3243)
      endif
      call dstrb(temp1,E_PAR,1,1,1,lm,kflip,mype,mpi_comm_comp)

      IF(CNST == 0)THEN !EMISSIONS EVERY HOUR
!        IF((START_HOUR+TCHEM/3600.)==23.)THEN !LAST EMISS HOUR IN EMISS FILE
          if(mype==0)then
            WRITE(0,*)'WE CLOSE THE EMISSION FILE AT:',(START_HOUR*3600.+TCHEM)/3600.
            close(3243)
          endif
!        ENDIF
      ELSE !EMISSIONS CONSTANT IN TIME
      if(mype==0)then
        close(3243)
      endif
      ENDIF

      ENDDO !num_lay_emiss

      call halo_exch(E_CO,lm,2,2)
      call halo_exch(E_NO,lm,2,2)
      call halo_exch(E_NO2,lm,2,2)
      call halo_exch(E_OLE,lm,2,2)
      call halo_exch(E_SO2,lm,2,2)
      call halo_exch(E_TOL,lm,2,2)
      call halo_exch(E_ISOP,lm,2,2)
      call halo_exch(E_MEOH,lm,2,2)
      call halo_exch(E_ALD2,lm,2,2)
      call halo_exch(E_FORM,lm,2,2)
      call halo_exch(E_ETHA,lm,2,2)
      call halo_exch(E_ETOH,lm,2,2)
      call halo_exch(E_ETH,lm,2,2)
      call halo_exch(E_TERP,lm,2,2)
      call halo_exch(E_PAR,lm,2,2)

      ENDIF  !NEW_EMISS

      deallocate(temp1)

      ENDIF  !READ EVERY O'CLOCK HOUR
ENDIF !CALL_EMIS
!----------------------------------------------------------------------
! add emissions
!----------------------------------------------------------------------
IF(NEW_EMISS.LE.1) THEN !old version to ingest emissions for new_emiss = 0 or 1
      IF(MYPE==0)THEN
        WRITE(0,*) 'BEFORE ADDING EMISSIONS CO:',chem(40,40,:,P_CO)
        WRITE(0,*) 'BEFORE ADDING EMISSIONS E_CO:',E_CO(40,40,:)
        WRITE(0,*) 'APPLYING CONVEMI FACTOR = ',CONVEMI
      ENDIF

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

!      IF(MYPE==0)THEN
!        WRITE(0,*) 'ADD EMISSION',i,j
!      ENDIF

      DO k=kme,kms,-1 !k index is for NMMB arrays LM(bottom) to 1(top)
         kflip=lm-k+1 !kflip index is for wrf arrays 1(bottom) to LM(top)
!       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.)
        conv_rho=8.047e-6/AIRDENSITY(i,kflip,j)*dtchem/dz8w(i,kflip,j)*CONVEMI !From configfile to apply a factor to anthro. emissions 

!      if (k.ge.(LM-2)) THEN !we split emission of the first layer in the 3 layers from the ground
!        conv_rho_low=8.047e-6/AIRDENSITY(i,k,j)*dtchem/(dz8w(i,LM,j)+dz8w(i,LM-1,j)+dz8w(i,LM-2,j))*CONVEMI
!      endif

      if (k.ge.(LM-(NUM_EMISS_VERT-1))) THEN !we split emission of the first layer in the NUM_EMISS_VERT layers from the ground
        sumdz = 0.
        do tt=LM,(LM-(NUM_EMISS_VERT-1)),-1
          ttflip=lm-tt+1
          sumdz = sumdz + dz8w(i,ttflip,j)
        enddo
        conv_rho_low=8.047e-6/AIRDENSITY(i,kflip,j)*dtchem/sumdz*CONVEMI
      endif

!      IF (.NOT.NEW_EMISS) THEN ! USE OLD EMISSIONS
      IF (NEW_EMISS.EQ.0) THEN !USE OLD EMISSIONS

        chem(i,j,k,P_SO2)  =  chem(i,j,k,P_SO2)                        &
                         + E_SO2(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_NO2)  =  chem(i,j,k,P_NO2)                        &
                         + E_NO2(i,j,k)*conv_rho
        chem(i,j,k,P_HNO3)  =  chem(i,j,k,P_HNO3)                        &
                         + E_HNO3(i,j,k)*conv_rho
        chem(i,j,k,P_HCHO)  =  chem(i,j,k,P_HCHO)                        &
                         + E_HCHO(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_CO)  =  chem(i,j,k,P_CO)                        &
                         + E_CO(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_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
        IF(.NOT.ONLINE_BIOG)THEN
        chem(i,j,k,P_ISOP)  =  chem(i,j,k,P_ISOP)                        &
                         + E_ISOP(i,j,k)*conv_rho
        ENDIF


        IF(ONLINE_BIOG .and. k.eq.LM) THEN
!        kflip=LM-k+1  It is already defined at the start of the do loop
          IF(BIO_MOD==1)THEN !SIMPLE ONLINE
!ADD BIOGENIC EMISSIONS FROM E_BIO VARIABLE
!-------------FROM RACM2 TO CBMZ
!      do j=jts,jte
!      do i=its,ite
        chem(i,j,k,p_so2) = chem(i,j,k,p_so2)    &
                          + e_bio(i,j,lso2)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_sulf) = chem(i,kts,j,p_sulf)    &
!                          + e_bio(i,j,lsulf)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_no2) = chem(i,j,k,p_no2)    &
                          + e_bio(i,j,lno2)/(dz8w(i,kflip,j)*60.)*dtchem
        chem(i,j,k,p_no) = chem(i,j,k,p_no)    &
                          + e_bio(i,j,lno)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_o3) = chem(i,kts,j,p_o3)    &
!                          + e_bio(i,j,lo3)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_hno3) = chem(i,j,k,p_hno3)    &
                          + e_bio(i,j,lhno3)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_h2o2) = chem(i,kts,j,p_h2o2)    &
!                          + e_bio(i,j,lh2o2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_ald) = chem(i,kts,j,p_ald)    &
!                          + e_bio(i,j,lald)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_hcho) = chem(i,j,k,p_hcho)    &
                          + e_bio(i,j,lhcho)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_op1) = chem(i,kts,j,p_op1)    &
!                          + e_bio(i,j,lop1)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_op2) = chem(i,kts,j,p_op2)    &
!                          + e_bio(i,j,lop2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_ora1) = chem(i,kts,j,p_ora1)    &
!                          + e_bio(i,j,lora1)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_ora2) = chem(i,kts,j,p_ora2)    &
!                          + e_bio(i,j,lora2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_nh3) = chem(i,kts,j,p_nh3)    &
!                          + e_bio(i,j,lnh3)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_n2o5) = chem(i,kts,j,p_n2o5)    &
!                          + e_bio(i,j,ln2o5)/(dz8w(i,kts,j)*60.)*dtstep
!!!        chem(i,kts,j,p_no2) = chem(i,kts,j,p_no2)    &
!!!                          + e_bio(i,j,lno2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_pan) = chem(i,kts,j,p_pan)    &
!                          + e_bio(i,j,lpan)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_eth) = chem(i,j,k,p_eth)    &
                          + e_bio(i,j,leth)/(dz8w(i,kflip,j)*60.)*dtchem
        chem(i,j,k,p_co) = chem(i,j,k,p_co)    &
                          + e_bio(i,j,lco)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_ol2) = chem(i,kts,j,p_ol2)    &
!                          + e_bio(i,j,lol2)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_olt) = chem(i,kts,j,p_olt)    &
!                          + e_bio(i,j,lolt)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_oli) = chem(i,kts,j,p_oli)    &
!                          + e_bio(i,j,loli)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_tol) = chem(i,j,k,p_tol)    &
                          + e_bio(i,j,ltol)/(dz8w(i,kflip,j)*60.)*dtchem
        chem(i,j,k,p_xyl) = chem(i,j,k,p_xyl)    &
                          + e_bio(i,j,lxyl)/(dz8w(i,kflip,j)*60.)*dtchem
!        chem(i,kts,j,p_hono) = chem(i,kts,j,p_hono)    &
!                          + e_bio(i,j,lhono)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_hno4) = chem(i,kts,j,p_hno4)    &
!                          + e_bio(i,j,lhno4)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_ket) = chem(i,kts,j,p_ket)    &
!                          + e_bio(i,j,lket)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_mgly) = chem(i,kts,j,p_mgly)    &
!                          + e_bio(i,j,lmgly)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_onit) = chem(i,kts,j,p_onit)    &
!                          + e_bio(i,j,lonit)/(dz8w(i,kts,j)*60.)*dtstep
!        chem(i,kts,j,p_csl) = chem(i,kts,j,p_csl)    &
!                          + e_bio(i,j,lcsl)/(dz8w(i,kts,j)*60.)*dtstep
        chem(i,j,k,p_isop) = chem(i,j,k,p_isop)    &
                          + e_bio(i,j,liso)/(dz8w(i,kflip,j)*60.)*dtchem
!      end do
!      end do

! calc par emissions as a combination of the biogenic emissions
! for radm2 primary voc species
!      do j = jts, jte
!      do i = its, ite
         chem(i,j,k,p_par)  =  chem(i,j,k,p_par)               &
             + (dtchem/(dz8w(i,kflip,j)*60.))*                     &
               ( 0.4*e_bio(i,j,lald) + 2.9*e_bio(i,j,lhc3)         &
               + 4.8*e_bio(i,j,lhc5) + 7.9*e_bio(i,j,lhc8)         &
               + 0.9*e_bio(i,j,lket) + 2.8*e_bio(i,j,loli)         &
               + 1.8*e_bio(i,j,lolt) + 1.0*e_bio(i,j,lora2)        )
!      end do
!      end do
!!-------------------------
!      DEALLOCATE (E_BIO)
!
 
!FOR DEBUG PURPOUSES
!         E_ISODBG(i,j,k)=E_ISOP(i,j,k)*conv_rho+(e_bio(i,j,liso)/(dz8w(i,k,j)*60.)*dtchem)
      if (k.eq.LM) then
         E_ISODBG(i,j,LM)=e_bio(i,j,liso)/(dz8w(i,kflip,j)*60.)*dtchem
         E_ISODBG(i,j,LM-1)=E_ISOP(i,j,k)*conv_rho
      endif
!
          ENDIF !BIO_MOD
        ELSE
!!ADD BIOGENIC EMISSIONS FROM INPUT FILE
!
        ENDIF

!      ELSE !MOZART EMISSIONS
      ELSEIF(NEW_EMISS.EQ.1) THEN !MOZART EMISSIONS

      if (k.eq.LM) THEN !we split emission of the first layer in the 3 layers from the ground
        chem(i,j,k,P_CO)  =  chem(i,j,k,P_CO)                        &
                         + E_CO(i,j,k)*conv_rho_low
        chem(i,j,k,P_NO)  =  chem(i,j,k,P_NO)                        &
                         + E_NO(i,j,k)*conv_rho_low
        chem(i,j,k,P_NO2)  =  chem(i,j,k,P_NO2)                        &
                         + E_NO2(i,j,k)*conv_rho_low
        chem(i,j,k,P_OLE)  =  chem(i,j,k,P_OLE)                        &
                         + E_OLE(i,j,k)*conv_rho_low
        chem(i,j,k,P_SO2)  =  chem(i,j,k,P_SO2)                        &
                         + E_SO2(i,j,k)*conv_rho_low
        chem(i,j,k,P_TOL)  =  chem(i,j,k,P_TOL)                        &
                         + E_TOL(i,j,k)*conv_rho_low
!        chem(i,j,k,P_ISOP)  =  chem(i,j,k,P_ISOP)                        &
!                         + E_ISOP(i,j,k)*conv_rho
        chem(i,j,k,P_MEOH)  =  chem(i,j,k,P_MEOH)                        &
                         + E_MEOH(i,j,k)*conv_rho_low
        chem(i,j,k,P_ALD2)  =  chem(i,j,k,P_ALD2)                        &
                         + E_ALD2(i,j,k)*conv_rho_low
        chem(i,j,k,P_FORM)  =  chem(i,j,k,P_FORM)                        &
                         + E_FORM(i,j,k)*conv_rho_low
        chem(i,j,k,P_ETHA)  =  chem(i,j,k,P_ETHA)                        &
                         + E_ETHA(i,j,k)*conv_rho_low
        chem(i,j,k,P_ETOH)  =  chem(i,j,k,P_ETOH)                        &
                         + E_ETOH(i,j,k)*conv_rho_low
        chem(i,j,k,P_ETH)  =  chem(i,j,k,P_ETH)                        &
                         + E_ETH(i,j,k)*conv_rho_low
!        chem(i,j,k,P_TERP)  =  chem(i,j,k,P_TERP)                        &
!                         + E_TERP(i,j,k)*conv_rho
        chem(i,j,k,P_PAR)  =  chem(i,j,k,P_PAR)                        &
                         + E_PAR(i,j,k)*conv_rho_low
      endif
      if (k.lt.LM .and. k.ge.(LM-NUM_EMISS_VERT+1)) THEN !we split emission of the first layer in the 3 layers from the ground
        chem(i,j,k,P_CO)  =  chem(i,j,k,P_CO)                        &
            + E_CO(i,j,k)*conv_rho + E_CO(i,j,LM)*conv_rho_low
        chem(i,j,k,P_NO)  =  chem(i,j,k,P_NO)                        &
            + E_NO(i,j,k)*conv_rho + E_NO(i,j,LM)*conv_rho_low
        chem(i,j,k,P_NO2)  =  chem(i,j,k,P_NO2)                        &
            + E_NO2(i,j,k)*conv_rho + E_NO2(i,j,LM)*conv_rho_low
        chem(i,j,k,P_OLE)  =  chem(i,j,k,P_OLE)                        &
            + E_OLE(i,j,k)*conv_rho + E_OLE(i,j,LM)*conv_rho_low
        chem(i,j,k,P_SO2)  =  chem(i,j,k,P_SO2)                        &
            + E_SO2(i,j,k)*conv_rho + E_SO2(i,j,LM)*conv_rho_low
        chem(i,j,k,P_TOL)  =  chem(i,j,k,P_TOL)                        &
            + E_TOL(i,j,k)*conv_rho + E_TOL(i,j,LM)*conv_rho_low
        chem(i,j,k,P_MEOH)  =  chem(i,j,k,P_MEOH)                        &
            + E_MEOH(i,j,k)*conv_rho + E_MEOH(i,j,LM)*conv_rho_low
        chem(i,j,k,P_ALD2)  =  chem(i,j,k,P_ALD2)                        &
            + E_ALD2(i,j,k)*conv_rho + E_ALD2(i,j,LM)*conv_rho_low
        chem(i,j,k,P_FORM)  =  chem(i,j,k,P_FORM)                        &
            + E_FORM(i,j,k)*conv_rho + E_FORM(i,j,LM)*conv_rho_low
        chem(i,j,k,P_ETHA)  =  chem(i,j,k,P_ETHA)                        &
            + E_ETHA(i,j,k)*conv_rho + E_ETHA(i,j,LM)*conv_rho_low
        chem(i,j,k,P_ETOH)  =  chem(i,j,k,P_ETOH)                        &
            + E_ETOH(i,j,k)*conv_rho + E_ETOH(i,j,LM)*conv_rho_low
        chem(i,j,k,P_ETH)  =  chem(i,j,k,P_ETH)                        &
            + E_ETH(i,j,k)*conv_rho + E_ETH(i,j,LM)*conv_rho_low
        chem(i,j,k,P_PAR)  =  chem(i,j,k,P_PAR)                        &
            + E_PAR(i,j,k)*conv_rho + E_PAR(i,j,LM)*conv_rho_low
      endif
      if (k.lt.(LM-NUM_EMISS_VERT+1)) then  !Default one. Emissions
        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_NO2)  =  chem(i,j,k,P_NO2)                        &
                         + E_NO2(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_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_ISOP)  =  chem(i,j,k,P_ISOP)                        &
!                         + E_ISOP(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_ALD2)  =  chem(i,j,k,P_ALD2)                        &
                         + E_ALD2(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_ETHA)  =  chem(i,j,k,P_ETHA)                        &
                         + E_ETHA(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_ETH)  =  chem(i,j,k,P_ETH)                        &
                         + E_ETH(i,j,k)*conv_rho
!        chem(i,j,k,P_TERP)  =  chem(i,j,k,P_TERP)                        &
!                         + E_TERP(i,j,k)*conv_rho
        chem(i,j,k,P_PAR)  =  chem(i,j,k,P_PAR)                        &
                         + E_PAR(i,j,k)*conv_rho
      endif


        IF(ONLINE_BIOG .and. k.eq.LM) THEN
          IF(BIO_MOD==1)THEN !SIMPLE ONLINE
!           kflip=LM-k+1 already defined at the start of the do loop k
           chem(i,j,k,p_isop) = chem(i,j,k,p_isop)    &
                          + e_bio(i,j,39)/(dz8w(i,kflip,j)*60.)*dtchem   !liso=39 temporal
           chem(i,j,k,p_terp) = chem(i,j,k,p_terp)    &  !we use e_bio(lho2) as a temporal storage var
                          + e_bio(i,j,41)/(dz8w(i,kflip,j)*60.)*dtchem   !lho2=41 temporal
           E_ISOP(i,j,k)=e_bio(i,j,39)  !!For debug purpouses
           E_TERP(i,j,k)=e_bio(i,j,41) 
          ELSEIF(BIO_MOD==2)THEN !MEGAN
             !EMISSIONS ALREADY IN CHEM ARRAY, DONE IN MEGAN ROUTINE
             !FOR DEBUG WE PUT BIOGEMISS IN E_emiss ARRAYS units (mol km-2 hr-1) WRONG!!!
!             E_ISOP(i,j,k)=E_ISOP(i,j,k)+e_bio(i,j,p_isop)
!             E_TERP(i,j,k)=E_TERP(i,j,k)+e_bio(i,j,p_terp)
!             E_OLE(i,j,k)=E_OLE(i,j,k)+e_bio(i,j,p_ole)
!             E_PAR(i,j,k)=E_PAR(i,j,k)+e_bio(i,j,p_par)
!             E_MEOH(i,j,k)=E_MEOH(i,j,k)+e_bio(i,j,p_meoh)
!             E_NO(i,j,k)=E_NO(i,j,k)+e_bio(i,j,p_no)
!             E_ALD2(i,j,k)=E_ALD2(i,j,k)+e_bio(i,j,p_ald2)
!             E_ETOH(i,j,k)=E_ETOH(i,j,k)+e_bio(i,j,p_etoh)
!             E_FORM(i,j,k)=E_FORM(i,j,k)+e_bio(i,j,p_form)
!             E_TOL(i,j,k)=E_TOL(i,j,k)+e_bio(i,j,p_tol)
!             E_CO(i,j,k)=E_CO(i,j,k)+e_bio(i,j,p_co)
!             E_ETH(i,j,k)=E_ETH(i,j,k)+e_bio(i,j,p_eth)
!             E_ETHA(i,j,k)=E_ETHA(i,j,k)+e_bio(i,j,p_etha)
!!             E_IOLE(i,j,k)=E_IOLE(i,j,k)+e_bio(i,j,p_iole)

         E_ISODBG(i,j,LM)=e_bio(i,j,p_isop)
         E_ISODBG(i,j,LM-1)=e_bio(i,j,p_terp)

          ENDIF
        ENDIF

        IF(.NOT.ONLINE_BIOG) THEN
           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
        ENDIF

!FOR DEBUG PURPOUSES
!         E_ISODBG(i,j,k)=E_ISOP(i,j,k)*conv_rho+(e_bio(i,j,liso)/(dz8w(i,k,j)*60.)*dtchem)
!      if (k.eq.LM) then
!         E_ISODBG(i,j,LM)=E_CO(i,j,k)
!      endif
!

      ENDIF

      END DO
 200  continue

      IF(ONLINE_BIOG) THEN
         DEALLOCATE (E_BIO)
      ENDIF

ENDIF !NEW_EMISS.LT.1

IF(NEW_EMISS.EQ.2) THEN !ACCMIP emissions with new routine
   CALL 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_HCHO,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,rh_emi            &
                ,DARE                                                  &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!FOR DEBUG PURPOUSES
   IF(ONLINE_BIOG) THEN
     DO J=JTS,JTE
     DO I=ITS,ITE
       E_ISODBG(I,J,LM)=e_bio(i,j,p_isop)
       E_ISODBG(I,J,LM-1)=e_bio(i,j,p_terp)
     ENDDO
     ENDDO
     DEALLOCATE (E_BIO)
   ENDIF
ENDIF !NEW_EMISS.EQ.2

      ENDIF mechanism

      ENDIF globalrun 

IF(.not.GLOBAL.AND.NEW_EMISS.EQ.3) THEN !WE READ EMISSIONS FROM AQMEII-Phase2
   CALL 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                                          &
!
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!FOR DEBUG PURPOUSES
   IF(ONLINE_BIOG) THEN
     DO J=JTS,JTE
     DO I=ITS,ITE
       E_ISODBG(I,J,LM)=e_bio(i,j,p_isop)
       E_ISODBG(I,J,LM-1)=e_bio(i,j,p_terp)
     ENDDO
     ENDDO
     DEALLOCATE (E_BIO)
   ENDIF
ENDIF !NEW_EMISS.EQ.3

IF(.not.GLOBAL.AND.NEW_EMISS.EQ.37) THEN !WE READ EMISSIONS FROM AQMEII-Phase2 TNO-Anthro IS4FIRE-BB
   CALL 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                                          &
!
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!
!  if(.false.)then
   CALL READ_IS4FIRE_EMISSIONS(                                        &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
                ,E_CO_BB,E_NO_BB,E_SO2_BB,E_NH3_BB                     &
!                ,E_ETH,E_ISOP,E_MEOH,E_ETHA,E_TERP                     &
                ,E_BC_BB,E_OM_BB                                       &
                ,XLAT,XLONG,AIRDENSITY,DZ8W                            &
                ,CHEM,NUM_GAS,AERO_BSC,NUM_AERO_BSC                    &
                ,P_BC1,P_BC2,P_OM1,P_OM2                               &
                ,DARE                                                  &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!   endif
!
!FOR DEBUG PURPOUSES
   IF(ONLINE_BIOG) THEN
     DO J=JTS,JTE
     DO I=ITS,ITE
       E_ISODBG(I,J,LM)=e_bio(i,j,p_isop)
       E_ISODBG(I,J,LM-1)=e_bio(i,j,p_terp)
     ENDDO
     ENDDO
     DEALLOCATE (E_BIO)
   ENDIF
ENDIF !NEW_EMISS.EQ.3




IF(NEW_EMISS.EQ.4) THEN !WE READ EMISSIONS FROM TRACER FUKUSHIMA
   CALL 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_CO                                                  &
!
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
ENDIF
IF(NEW_EMISS.EQ.5) THEN !ACCMIP emissions for BC in P_TRACER MECH==4
   CALL 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_HCHO,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,rh_emi            &
                ,DARE                                                  &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
ENDIF !NEW_EMISS.EQ.5

IF(.not.GLOBAL.AND.NEW_EMISS.EQ.6) THEN !WE READ EMISSIONS FROM CALIOPE
   CALL 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                          &
                ,AERO_BSC,NUM_AERO_BSC                                 &
                ,DARE,EMI_TOTAL_DBG                                    &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)

!FOR DEBUG PURPOUSES
   IF(ONLINE_BIOG) THEN
     DO J=JTS,JTE
     DO I=ITS,ITE
       E_ISODBG(I,J,LM)=e_bio(i,j,p_isop)
       E_ISODBG(I,J,LM-1)=e_bio(i,j,p_terp)
     ENDDO
     ENDDO
     DEALLOCATE (E_BIO)
   ENDIF
ENDIF !NEW_EMISS.EQ.6

IF(GLOBAL.AND.NEW_EMISS.EQ.7) THEN !WE READ EMISSIONS FROM HERMESv3-GFAS global
   CALL READ_HERMESv3_GFAS_GLOBAL_EMISSIONS(                           &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
                ,XLAT,XLONG                                            &
!                ,E_CO,E_SO2,E_NO,E_NO2,E_HONO,E_NH3,E_ALDX,E_ALD2      &
!                ,E_BENZENE,E_CH4,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,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                          &
                ,AERO_BSC,NUM_AERO_BSC                                 &
                ,DARE,EMI_TOTAL_DBG                                    &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
ENDIF !NEW_EMISS.EQ.7

IF(GLOBAL.AND.NEW_EMISS.EQ.8) THEN !WE READ EMISSIONS FROM HERMESv3_hourly-GFAS_daily global
   CALL READ_HERMESv3HOURLY_GFASDAILY_GLOBAL_EMISSIONS(                &
                 NTIMESTEP,NCHEM,TCHEM,DTCHEM                          &
                ,START_YEAR,START_MONTH,START_DAY,START_HOUR           &
                ,XLAT,XLONG                                            &
!                ,E_CO,E_SO2,E_NO,E_NO2,E_HONO,E_NH3,E_ALDX,E_ALD2      &
!                ,E_BENZENE,E_CH4,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,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                          &
                ,AERO_BSC,NUM_AERO_BSC                                 &
                ,DARE,EMI_TOTAL_DBG                                    &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
ENDIF !NEW_EMISS.EQ.8
!      IF(MYPE==0)THEN
!        WRITE(0,*) 'AFTER ADDING EMISSIONS CO:',chem(10,10,:,P_CO)
!      ENDIF

!-----------------------------------------------------------------------
!
      END SUBROUTINE EMISSION_DRIVER
!
!---------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!---------------------------------------------------------------------
      SUBROUTINE PHOT_DRIVER(NTIMESTEP,DT,START_HOUR,JULDAY            &
                     ,XLAT,XLONG,P8W,DZ8W,CLOUDMR_PHY                  &
                     ,AIRDENSITY_PHY,RELHUM_PHY                        &
                     ,Z_AT_W,T_PHY                                     &
                     ,OZONE_FLIP                                       &
                     ,LPAR,JPNL                                        &
                     ,VALUEJ,COS_SZA                                   &
                     ,IDS,IDE,JDS,JDE,LM                               &
                     ,IMS,IME,JMS,JME,KMS,KME                          &
                     ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  PHOT_DRIVER PHOTOLYSIS SCHEME DRIVER
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 09-02-16
!
! ABSTRACT:
!     PHOT_DRIVER DRIVES THE PHOTOLYSIS SCHEME FAST-J
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   09-02-16  JORBA      - ORIGINATOR OF THE DRIVER
!
! USAGE: CALL PHOT_DRIVER FROM CHEM_DRIVER
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
      USE MODULE_CONSTANTS,ONLY : G,EPSQ,R_D,P608
!
      USE MODULE_PHOT_FASTJ,ONLY: interface_fastj,mapJrates_tofrom_host
!
      USE module_fastj_data, only:  nb, nc
!
!----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE                            &
                           ,NTIMESTEP,START_HOUR,JULDAY                 
                           
      INTEGER,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: LPAR,JPNL

      REAL,INTENT(IN) :: DT

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

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

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

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

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: CLOUDMR_PHY   &
                    ,AIRDENSITY_PHY,RELHUM_PHY,DZ8W

! FAST-J specific variables
      REAL,DIMENSION(LM,nphoto_fastj),INTENT(OUT) :: VALUEJ
      REAL,INTENT(OUT) :: COS_SZA
!
!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!----------------------------------------------------------------------
! dummy variables, not used for the moment - areosol related

                                       ! Num of spectral intervals across solar
      integer, parameter :: nspint=4   ! spectrum for FAST-J
      integer, parameter :: kmaxd=100  !from module_data_mosaic_other, needs revision!!!
      real, dimension (nspint),save :: wavmid !cm
      real, dimension (nspint, kmaxd+1) :: sizeaer,extaer,waer,gaer,tauaer
      real, dimension (nspint, kmaxd+1) :: l2,l3,l4,l5,l6,l7

!      integer, parameter :: nphoto_fastj=14

      REAL,DIMENSION(1:LM) :: TEMP,OZONE,CLOUDMR                       &
                             ,AIRDENSITY,RELHUM,DZ                     &
                             ,PBND

      REAL,DIMENSION(1:LM+1) :: ZATW

      logical processingAerosols

      REAL XTIME,XHOUR,XMIN,GMTP,TMIDH

      INTEGER ICLM,JCLM,I,J,K,KFLIP,KTS,KTE,ISECFRM0,IXHOUR

      REAL SLA,SLO

      REAL pcnt,psfc
!
!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
!
!!!PUT OUTSIDE THE ROUTINE - from WRFCHEM
      processingAerosols=.false.
!      LPAR=LM-2 !num levels in CTM
!      JPNL=LM-2 !??? some problems with upper limit in wrfchem; num levels requiring chemistry
!      NB=LPAR+1 !for module module_fastj_data
!      NC=2*NB !ditto, and don't confuse this with nc in module_fastj_mie
!      KTE=JPNL !LM-2
      KTS=1
      sizeaer=0.
      extaer=0.
      waer=0.
      gaer=0.
      tauaer=0.
      l2=0.
      l3=0.
      l4=0.
      l5=0.
      l6=0.
      l7=0.
      
!!!!DO NOT do chem at the top level to mimic what used to be done - not yet implemented!!!
!!!

      MYPE=MYPE_SHARE

        XTIME=NTIMESTEP*DT/60. + DT/120.
        IXHOUR=IFIX(START_HOUR+0.01)+IFIX(XTIME/60.)
        XHOUR=FLOAT(IXHOUR)
        XMIN=60.*START_HOUR+(XTIME-XHOUR*60.)
        GMTP=MOD(XHOUR,24.)
        TMIDH=GMTP+XMIN/60.
        ISECFRM0=IFIX(NTIMESTEP*DT)
!
!-----------------------------------------------------------------------
!***  NOTE:  THE NMMB HAS IJK STORAGE WITH LAYER 1 AT THE TOP.
!***         THE OLD PHYSICS DRIVERS HAVE IKJ STORAGE WITH LAYER 1
!***         AT THE BOTTOM.
!-----------------------------------------------------------------------
!
! execute for each i,j column and each nsub subarea
        do jclm = jts, jte !jms,jme !jts, jte
        do iclm = its, ite !ims,ime !its, ite

          NB=LPAR(iclm,jclm)+1 !for module module_fastj_data
          NC=2*NB !ditto, and don't confuse this with nc in module_fastj_mie
          KTE=JPNL(iclm,jclm) !LM-2
!
!-----------------------------------------------------------------------
!***  START WRFCHEM FAST-J INTERFACE
!-----------------------------------------------------------------------
!
          do k = 1, LM !LPAR !kts, lpar
            dz(k) = dz8w(iclm, k, jclm)   ! cell depth (m)
          end do
! set lat, long
          sla = xlat(iclm,jclm)
          slo = xlong(iclm,jclm)
!! set column pressures, temperature, and ozone
          psfc = p8w(iclm,1,jclm) * 10. ! convert pascals to dynes/cm2
          do k = 1, LM !lpar !kts, lpar
            pbnd(k) = p8w(iclm,k,jclm) *10.  ! convert pascals to dynes/cm2
            temp(k) = t_phy(iclm,k,jclm)
            ozone(k) = ozone_flip(iclm,k,jclm) / 1.0e6   ! ppm->mol/mol air
!            cloudmr(k) = moist(iclm,k,jclm,p_qc)/0.622
            cloudmr(k) = cloudmr_phy(iclm,k,jclm)
            AIRDENSITY(k) = AIRDENSITY_PHY(iclm,k,jclm)/28.966e3 ! kg/m3->mole_air/cm3
            relhum(k) = relhum_phy(iclm,k,jclm)
            relhum(k) = MAX(.001,relhum(k))
            zatw(k)=z_at_w(iclm,k,jclm)
          end do
!        zatw(lpar+1)=z_at_w(iclm,lpar+1,jclm)
          zatw(lm+1)=z_at_w(iclm,lm+1,jclm)
!
          call interface_fastj(tmidh,sla,slo,julday,                   &
           pbnd, psfc, temp, ozone,                                    &
           dz, cloudmr, AIRDENSITY, relhum, zatw,                      &
           iclm, jclm, lpar(iclm,jclm), jpnl(iclm,jclm),               &
           isecfrm0, valuej, cos_sza, processingAerosols,              &
           sizeaer,extaer,waer,gaer,tauaer,l2,l3,l4,l5,l6,l7,jppjm)
!
         call mapJrates_tofrom_host( 0,                                &
           ims,ime, jms,jme, kms,kme,                                  &
           its,ite, jts,jte, kts,kte,                                  &
           iclm, jclm, kts,lpar(iclm,jclm),                            &
           valuej) !,                                                      &

      end do
      end do

      return
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PHOT_DRIVER
!
!---------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!---------------------------------------------------------------------
      SUBROUTINE DRYDEP_DRIVER(FIRST,NTIMESTEP,DT,NPHS                 &
                 ,START_HOUR,JULDAY,XLAT,XLONG                         &
                 ,T_PHY,MOIST_PHY,NUM_WATER                            &
                 ,P_QC,P_QV,P_QR,P_PHY,CHEM                            &
                 ,NUM_GAS                                              &
                 ,RHO_PHY,DDVEL,ADRYDEP                                &
                 ,ivgtyp,tsk,gsw,vegfra,rmol,ust,znt,DZ8W,Z_AT_W       &
                 ,EXCH_H,AKHS,VDIFF_CHEM                               &
                 ,IDS,IDE,JDS,JDE,LM                                   &
                 ,IMS,IME,JMS,JME,KMS,KME                              &
                 ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  DRY-DEPOSITION DRIVER FOR GAS-PHASE
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 09-04-30
!
! ABSTRACT:
!     DRYDEP_DRIVER DRIVES THE DRY-DEPOSITION SCHEME FOR GAS-PHASE
!     FOLLOWING WESLEY (1986)
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   09-04-30  JORBA      - ORIGINATOR OF THE DRIVER
!
! USAGE: CALL DRYDEP_DRIVER FROM CHEM_DRIVER
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
!      USE MODULE_DRYDEPWESELY,ONLY: DEP_INIT,WESELY_DRIVER
!       USE MODULE_VERTMX_WRF  !FOR COMPARISON ONLY
!
!----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      LOGICAL,INTENT(IN) :: FIRST,VDIFF_CHEM
!
      INTEGER,INTENT(IN) :: NTIMESTEP,NPHS,START_HOUR,JULDAY
!
      REAL,INTENT(IN)    :: DT
!
      INTEGER,INTENT(IN) :: NUM_GAS                                    &
                           ,P_QC,P_QV,P_QR,NUM_WATER
!
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                         &
                           ,IMS,IME,JMS,JME,KMS,KME                    &
                           ,ITS,ITE,JTS,JTE
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: XLAT,XLONG
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: T_PHY
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE,NUM_WATER),INTENT(IN) ::     &
                     MOIST_PHY
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: P_PHY
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_GAS)                   &
                    ,INTENT(INOUT) :: CHEM
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: RHO_PHY
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:NUM_GAS)                        &
                    ,INTENT(OUT) :: DDVEL
!
      INTEGER,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: IVGTYP
! 
      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: TSK,GSW,VEGFRA     &  
                    ,RMOL,UST,ZNT
!
      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: DZ8W 
!
      REAL,DIMENSION(ITS:ITE,1:LM+1,JTS:JTE),INTENT(IN) :: Z_AT_W 
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:NUM_GAS),INTENT(INOUT) ::       &
                     ADRYDEP
!
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: AKHS
!
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: EXCH_H
!
!-----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!-----------------------------------------------------------------------
!
      INTEGER :: N,IT,JT,K,k_1,kflip
!
      REAL :: DTCHEM,TDRY,CFACT,MDRYDEP
!
      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:NUM_GAS) :: DRYDEP
!
      LOGICAL,SAVE :: NEXT=.FALSE.
!
      REAL,DIMENSION(1:LM) :: phi,phi_in,zsigma_half
!
      REAL,DIMENSION(1:LM+1) :: kt_turb
!
!-----------------------------------------------------------------------
!*** INITIALIZE DRYDEP ARRAYS ONLY FIRST TIME STEP
!-----------------------------------------------------------------------
!
      IF(FIRST)THEN
        CALL DEP_INIT(NUM_GAS            )
      ENDIF
!
!-----------------------------------------------------------------------
!*** RUN DRYDEPOSITION
!-----------------------------------------------------------------------
!
      DTCHEM=DT*NPHS

      CALL WESELY_DRIVER(NTIMESTEP,DTCHEM,NPHS                         &
          ,START_HOUR,JULDAY,XLAT,XLONG                                &
          ,T_PHY,MOIST_PHY,NUM_WATER                                   &
          ,P_QC,P_QV,P_QR,P_PHY,CHEM                                   &                   
          ,RHO_PHY,DDVEL                                               &
          ,ivgtyp,tsk,gsw,vegfra,rmol,ust,znt,DZ8W                     &                
          ,NUM_GAS                                                     &
          ,IDS,IDE,JDS,JDE,LM                                          &
          ,IMS,IME,JMS,JME,KMS,KME                                     &
          ,ITS,ITE,JTS,JTE)
!
!*** IF VDIFF_CHEM=TRUE RUN DRY-DEPOSITION
!*** IF FALSE RUN VERTICAL TURBULENT MIXING + DRY-DEPOSITION FROM WRF SCHEME
!
!      IF (VDIFF_CHEM) THEN !RUN DRY-DEP, we have already solved vertical diffusion
!*** COMPUTE DRY-DEPOSITION
!
        DO  N = 1,NUM_GAS
        DO JT = JTS,JTE !JMS,JME
        DO IT = ITS,ITE !IMS,IME
!!!UNITS DDVEL[m/s];CHEM[ppmv];Z[m];DT[s]
!!!DRYDEP[ppmv]
          DRYDEP(IT,JT,N)=DDVEL(IT,JT,N)*CHEM(IT,JT,LM,N)              &
                         /DZ8W(IT,1,JT)*DTCHEM
          CHEM(IT,JT,LM,N)=CHEM(IT,JT,LM,N)-DRYDEP(IT,JT,N)
!!!ACUMULATE DRYDEP:
!!! DRYDEP[ppmv] to ADRYDEP[kg/ha] 
!***Molar mixing ratio
          MDRYDEP=MAX(DRYDEP(IT,JT,N)*1.0E-6,1.0E-30)
!***Units to kg/ha
!!!PMair[kg/mol]=0.02897
!!!MOLWT[g spc/mol]
          CFACT=GC_MOLWT(N)/GPKG*RHO_PHY(IT,1,JT)*DZ8W(IT,1,JT)
          CFACT=CFACT*M2PHA/0.02897
          ADRYDEP(IT,JT,N)=ADRYDEP(IT,JT,N)+MDRYDEP*CFACT
        ENDDO
        ENDDO
        ENDDO
!
!*** END DRY-DEPOSITION
!
!      ELSE      !VDIFF_CHEM=FALSE
!!
!        DO  N = 1,NUM_GAS
!        DO JT = JTS,JTE !JMS,JME
!        DO IT = ITS,ITE !IMS,IME
!         do k=2,LM+1
!            kflip=LM-k+1+1
!            k_1=k-1
!            kt_turb(k)=EXCH_H(IT,JT,kflip)       
!            phi(k_1)=CHEM(IT,JT,kflip,N) 
!         enddo
!         kt_turb(1)=AKHS(IT,JT)
!
!         phi_in=phi
!
!         DO K=2,LM
!           zsigma_half(K)=Z_AT_W(IT,K-1,JT)+DZ8W(IT,K,JT)/2.
!         ENDDO
!           zsigma_half(1)=Z_AT_W(IT,1,JT)/2.
! 
!         CALL vertmx( DTCHEM, phi, kt_turb, RHO_PHY(IT,:,JT),          &
!         z_at_w(IT,:,JT),zsigma_half, DDVEL(IT,JT,N),1,LM )
!
!         do k=1,LM
!           kflip=LM-k+1
!           CHEM(IT,JT,kflip,N)=phi(k)
!         enddo
!         
!!         ADRYDEP(IT,JT,N)=phi_in(1)-phi(1)
!        ENDDO
!        ENDDO
!        ENDDO
!
!      ENDIF
!
      RETURN
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE DRYDEP_DRIVER
!
!---------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!---------------------------------------------------------------------
      SUBROUTINE CLDCHEM_DRIVER(NTIMESTEP,DT,NPHS                      &
                ,LRESCLD,LCONVCLD                                      &
                ,START_HOUR                                            &
                ,CHEM,NUM_GAS                                          &
                ,T_PHY,DZ8W,P_PHY,RHO_PHY,PBLH_ITS                     &
                ,QV,QC,QR,QI,QS,QG                                     &
                ,RAINC,RAINNC,Z_AT_W,WETDEP,RESWDEPAC,CONVDEPAC        &
                ,IDS,IDE,JDS,JDE,LM                                    &
                ,IMS,IME,JMS,JME,KMS,KME                               &
                ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  CLDCHEM_DRIVER 
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 09-06-10
!
! ABSTRACT:
!     CLDCHEM_DRIVER DRIVES THE CLOUD CHEMISTRY
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   09-06-10  JORBA      - ORIGINATOR OF THE DRIVER
!
! USAGE: CALL CLDCHEM_DRIVER FROM CHEM_DRIVER
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
!***SPECIFIC CMAQ WET DEPOSITON MAPPING
!
!      INCLUDE 'CLDCHEM/GC_WDEP_kppcb4.EXT' ! wet deposition table for gases
!      USE MODULE_CHEM_DATA !Now all data of GC_WDEP_kppcb4.EXT is the module
!
!-----------------------------------------------------------------------
!

      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                          &
                           ,IMS,IME,JMS,JME,KMS,KME                     &
                           ,ITS,ITE,JTS,JTE                             &
                           ,NPHS,NTIMESTEP,START_HOUR                   &
                           ,NUM_GAS         

      REAL,INTENT(IN) :: DT

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

      REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) ::             &
               T_PHY,DZ8W,P_PHY,RHO_PHY

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM),INTENT(IN) ::             &
               QV,QC,QR,QI,QS,QG

      REAL,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: RAINC,RAINNC,PBLH_ITS            

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:NUM_GAS),INTENT(INOUT) &
        :: WETDEP

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

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:N_GC_WDEP+1),INTENT(INOUT) :: RESWDEPAC

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:N_GC_WDEP+8),INTENT(INOUT) :: CONVDEPAC

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:N_GC_WDEP+1) :: RESWDEP   

      REAL,DIMENSION(ITS:ITE,JTS:JTE,1:N_GC_WDEP+8) :: CONVDEP

      LOGICAL,INTENT(IN) :: LRESCLD,LCONVCLD

!-----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!-----------------------------------------------------------------------

      INTEGER :: N,I,J,K

      REAL :: TWET,DTCHEM

      LOGICAL,SAVE :: NEXT=.FALSE.

      LOGICAL,SAVE :: FIRSTIME=.TRUE.

!***CMAQ VARIABLES
!      INTEGER,PARAMETER :: N_SPC_WDEP=N_GC_WDEP ! # of wet deposition species
      INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: WDEP_MAP !(1:N_GC_WDEP) !N_SPC_WDEP)       ! wet deposition map to CGRID
      INTEGER :: SPC, STRT, FINI, VAR
      INTEGER, PARAMETER :: GC_STRT = 1

!-----------------------------------------------------------------------

       IF (FIRSTIME) THEN

        FIRSTIME = .FALSE.

        ALLOCATE(WDEP_MAP(1:N_GC_WDEP))

        SPC = 0
        STRT = 1
        FINI = N_GC_WDEP
        DO VAR = STRT, FINI
          SPC = SPC + 1
          WDEP_MAP( VAR ) = GC_STRT - 1 + GC_WDEP_MAP( SPC )
        END DO

        RESWDEPAC=0.
        CONVDEPAC=0.

      ENDIF

      DTCHEM=DT*NPHS

!*** CONVERT UNITS PPM TO MOLAR MIXING RATIO (BY VOLUME)
!*** AND RESET RESWDEP ARRAY
       DO N=1,NUM_GAS
          CHEM(ITS:ITE,JTS:JTE,1:LM,N)=MAX(CHEM(ITS:ITE,JTS:JTE,1:LM,N)  &
                                          * 1.0E-6, 0.)  ! 1.0E-30)
       ENDDO
       DO N=1,(N_GC_WDEP+1)
          RESWDEP(ITS:ITE,JTS:JTE,N)=0.
       ENDDO
       DO N=1,(N_GC_WDEP+8)
          CONVDEP(ITS:ITE,JTS:JTE,N)=0.
       ENDDO

!...compute cloud effects for the resolved clouds and resolved rainwater
      IF (LRESCLD) THEN

          CALL RESCLD (CHEM,NTIMESTEP,DT,NPHS,NUM_GAS                    &
                    ,T_PHY,DZ8W,P_PHY,RHO_PHY                            &
                    ,QC,QR,QI,QS,QG                                      &
                    ,RAINNC,RESWDEP,WDEP_MAP,N_GC_WDEP                   &
                    ,ITS,ITE,JTS,JTE,LM)
      ENDIF
!...compute cloud effects for convective (subgrid) clouds
      IF (LCONVCLD) THEN

          CALL CONVCLD_ACM (CHEM,NTIMESTEP,DT,NPHS,NUM_GAS               &
                            ,T_PHY,DZ8W,P_PHY,QV,RAINC                   &
                            ,Z_AT_W,CONVDEP,WDEP_MAP,N_GC_WDEP           &
                            ,PBLH_ITS                                    &
                            ,ITS,ITE,JTS,JTE,LM)
      ENDIF

!*** CONVERT UNITS BACK TO ORIGINAL UNITS (PPMv) and accumulate dep. (kg/ha)
       DO N=1,NUM_GAS          
          CHEM(ITS:ITE,JTS:JTE,1:LM,N)=CHEM(ITS:ITE,JTS:JTE,1:LM,N)  &
                                          * 1.0E6
       ENDDO

       DO N=1,N_GC_WDEP  
          WETDEP(ITS:ITE,JTS:JTE,WDEP_MAP(N))=                       &
                           WETDEP(ITS:ITE,JTS:JTE,WDEP_MAP(N)) +     &
                                    RESWDEP(ITS:ITE,JTS:JTE,N) +     &
                                    CONVDEP(ITS:ITE,JTS:JTE,N)
          RESWDEPAC(ITS:ITE,JTS:JTE,N)=RESWDEPAC(ITS:ITE,JTS:JTE,N) + &
                                    RESWDEP(ITS:ITE,JTS:JTE,N)
          CONVDEPAC(ITS:ITE,JTS:JTE,N)=CONVDEPAC(ITS:ITE,JTS:JTE,N) + &
                                    CONVDEP(ITS:ITE,JTS:JTE,N)
       ENDDO

!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CLDCHEM_DRIVER
!
!---------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!---------------------------------------------------------------------
      SUBROUTINE MECHANISM_DRIVER(NTIMESTEP,DT,NPHS,TEMPERATURE         &
                      ,START_HOUR                                       &
                      ,CHEM,NUM_GAS_TOTAL                               &
               ,P8W,RHO_PHY,WATER,NUM_WATER,P_QV                        &
!               ,ph_o2,ph_o31d,ph_o33p,ph_no2,ph_no3o2,ph_no3o,ph_hno2   &
!               ,ph_hno3,ph_hno4,ph_h2o2,ph_ch2or,ph_ch2om,ph_ch3cho     &
!               ,ph_ch3coch3,ph_ch3coc2h5,ph_hcocho,ph_ch3cocho          &
!               ,ph_hcochest,ph_ch3o2h,ph_ch3coo2h,ph_ch3ono2,ph_hcochob &
!               ,ph_n2o5                                                 &
                      ,JPNL                                             &
                      ,IDS,IDE,JDS,JDE,LM                               &
                      ,IMS,IME,JMS,JME,KMS,KME                          &
                      ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .     
! SUBPROGRAM:  MECHANISM_DRIVER CHEMISTRY MECHANISM DRIVER
!   PRGRMMR: JORBA            ORG: W/NP22     DATE: 09-01-07       
!     
! ABSTRACT:
!     CHEM_MECHANISM DRIVES THE CHEMISTRY MECHANISM
!     
! PROGRAM HISTORY LOG (with changes to called routines) :
!   09-01-07  JORBA      - ORIGINATOR OF THE DRIVER
!     
! USAGE: CALL CHEM_MECHANISM FROM CHEM_DRIVER
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$  
!-----------------------------------------------------------------------
!
USE MODULE_CBM5, ONLY : RUN_CBM5
!
!USE MODULE_CBM4, ONLY : RUN_CBM4
!
USE MODULE_EBI_SOLVER, ONLY : RUN_EBI
USE MODULE_EBI_SOLVER_EXT, ONLY : RUN_EBI_EXT
!
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                          &
                           ,IMS,IME,JMS,JME,KMS,KME                     &
                           ,ITS,ITE,JTS,JTE                             &
                           ,NPHS,NTIMESTEP,START_HOUR                   &
                           ,NUM_WATER,P_QV
!
      INTEGER,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: JPNL                           
! 
      REAL,INTENT(IN) :: DT

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

!
!      REAL, DIMENSION( ITS:ITE, kms:kme, JTS:JTE ),                 &
!         INTENT(IN) ::                                              &
!           ph_o2,ph_o31d,ph_o33p,ph_no2,ph_no3o2,ph_no3o,ph_hno2,   &
!           ph_hno3,ph_hno4,ph_h2o2,ph_ch2or,ph_ch2om,ph_ch3cho,     &
!           ph_ch3coch3,ph_ch3coc2h5,ph_hcocho,ph_ch3cocho,          &
!           ph_hcochest,ph_ch3o2h,ph_ch3coo2h,ph_ch3ono2,ph_hcochob, &
!           ph_n2o5

      INTEGER,INTENT(IN) :: NUM_GAS_TOTAL         

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

      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: TEMPERATURE

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

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

!-----------------------------------------------------------------------

      IF(MECH==1)THEN !CBMIV
!        CALL RUN_CBM4(NTIMESTEP,DT,NPHS,TEMPERATURE                     &
!               ,START_HOUR                                              &
!               ,CHEM,NUM_GAS_TOTAL                                      &
!               ,P8W,RHO_PHY,WATER,NUM_WATER,P_QV                        &
!!               ,ph_o2,ph_o31d,ph_o33p,ph_no2,ph_no3o2,ph_no3o,ph_hno2   &
!!               ,ph_hno3,ph_hno4,ph_h2o2,ph_ch2or,ph_ch2om,ph_ch3cho     &
!!               ,ph_ch3coch3,ph_ch3coc2h5,ph_hcocho,ph_ch3cocho          &
!!               ,ph_hcochest,ph_ch3o2h,ph_ch3coo2h,ph_ch3ono2,ph_hcochob &
!!               ,ph_n2o5   &
!               ,JPNL                                            &
!               ,IDS,IDE,JDS,JDE,LM                                      &
!               ,IMS,IME,JMS,JME,KMS,KME                                 &
!               ,ITS,ITE,JTS,JTE)

      ELSEIF(MECH==2) THEN !CBM05
        CALL RUN_CBM5(NTIMESTEP,DT,NPHS,TEMPERATURE                     &
               ,START_HOUR                                              &
               ,CHEM,NUM_GAS_TOTAL                                      &
               ,P8W,RHO_PHY,WATER,NUM_WATER,P_QV                        &
!               ,ph_no2,ph_o33p,ph_o31d,ph_no3o2,ph_no3o,ph_hno2         &
!               ,ph_h2o2,ph_hno4,ph_hno3,ph_n2o5,ph_ntr,ph_mepx          &
!               ,ph_ch2or,ph_ch2om,ph_ald2,ph_pan,ph_aldx,ph_mgly        &
!               ,ph_ispd                                                 &
               ,JPNL                                                    &
               ,IDS,IDE,JDS,JDE,LM                                      &
               ,IMS,IME,JMS,JME,KMS,KME                                 &
               ,ITS,ITE,JTS,JTE)
      ELSEIF(MECH==22) THEN !CBM05-EBI-CMAQ
!        test4=real(test8)
!        test8=dble(test4)
        CALL RUN_EBI(NTIMESTEP,DT,NPHS,TEMPERATURE                     &
               ,START_HOUR                                              &
               ,CHEM,NUM_GAS_TOTAL                                      &
               ,P8W,RHO_PHY,WATER,NUM_WATER,P_QV                        &
               ,JPNL                                                    &
               ,IDS,IDE,JDS,JDE,LM                                      &
               ,IMS,IME,JMS,JME,KMS,KME                                 &
               ,ITS,ITE,JTS,JTE)
      ELSEIF(MECH==3.OR.MECH==37) THEN !CBM05-EXT-EBI-CMAQ FOR AERO-UCI
        CALL RUN_EBI_EXT(NTIMESTEP,DT,NPHS,TEMPERATURE                  &
               ,START_HOUR                                              &
               ,CHEM,NUM_GAS_TOTAL                                      &
               ,P8W,RHO_PHY,WATER,NUM_WATER,P_QV                        &
               ,JPNL                                                    &
               ,IDS,IDE,JDS,JDE,LM                                      &
               ,IMS,IME,JMS,JME,KMS,KME                                 &
               ,ITS,ITE,JTS,JTE)
      ELSE 
        !NOTHING
      ENDIF

      RETURN
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE MECHANISM_DRIVER
!
!---------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!---------------------------------------------------------------------
!
      SUBROUTINE EMISS_FILE_NAME(START_YEAR,START_MONTH,START_DAY       &
                            ,START_HOUR,TCHEM,NTIMESTEP,FILENAME)
!
!-----------------------------------------------------------------------
!
!    ONLY APPLICABLE FOR SHORT TERM SIMULATIONS

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

      REAL,INTENT(IN)    :: TCHEM

      CHARACTER*80,INTENT(OUT) :: FILENAME
!
!-----------------------------------------------------------------------
!***  LOCAL VARIABLES
!-----------------------------------------------------------------------
!
      INTEGER   :: ADV_HOUR,ADV_DAY
      INTEGER   :: NEW_YEAR,NEW_MONTH,NEW_DAY,NEW_HOUR

      CHARACTER*4 :: cYYYY
      CHARACTER*2 :: cMM,cDD,cHH
      CHARACTER*16,PARAMETER :: FIX='emissdummy-cbm4-'
!
!-----------------------------------------------------------------------
!

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

     IF(NTIMESTEP==4)THEN
       WRITE(cYYYY,'(i4.4)') START_YEAR
       WRITE(cMM,'(i2.2)') START_MONTH
       WRITE(cDD,'(i2.2)') START_DAY
       WRITE(cHH,'(i2.2)') START_HOUR
     ELSE
       !Advance TCHEM seconds in start date
       ADV_HOUR=NINT(TCHEM/3600.)
       NEW_HOUR=START_HOUR+ADV_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

         WRITE(cYYYY,'(i4.4)') NEW_YEAR
         WRITE(cMM,'(i2.2)') NEW_MONTH
         WRITE(cDD,'(i2.2)') NEW_DAY
         WRITE(cHH,'(i2.2)') NEW_HOUR
       ELSE
         WRITE(cYYYY,'(i4.4)') START_YEAR
         WRITE(cMM,'(i2.2)') START_MONTH
         WRITE(cDD,'(i2.2)') START_DAY
         WRITE(cHH,'(i2.2)') NEW_HOUR
       ENDIF
     ENDIF

      FILENAME=FIX//cYYYY//'-'//cMM//'-'//cDD//'-'//cHH

!
!-----------------------------------------------------------------------
!
      END SUBROUTINE EMISS_FILE_NAME
!
!---------------------------------------------------------------------
!
!----------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!---------------------------------------------------------------------
      SUBROUTINE VDIFH(DTDIF,LMH,RKHS,CT             &
     &                ,RKH,Z,RHO                            &
     &                ,CHEM,CHEMZ0,NUM_TRACERS_CHEM,VDIFF_CHEM        &
     &                ,NUM_GAS                                        &
     &                ,IDS,IDE,JDS,JDE,KDS,KDE                        &
     &                ,IMS,IME,JMS,JME,KMS,KME                        &
     &                ,ITS,ITE,JTS,JTE,KTS,KTE,I,J)
!     ***************************************************************
!     *                                                             *
!     *         VERTICAL DIFFUSION OF MASS VARIABLES                *
!     *                                                             *
!     ***************************************************************
!---------------------------------------------------------------------
!
      IMPLICIT NONE
!
!---------------------------------------------------------------------
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
     &                     ,ITS,ITE,JTS,JTE,KTS,KTE,I,J
!
      INTEGER,INTENT(IN) :: LMH
!
      REAL,INTENT(IN) :: CT,DTDIF,RKHS
!
      REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: RKH
      REAL,DIMENSION(KTS:KTE),INTENT(IN) :: RHO
      REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z
!
      INTEGER,INTENT(IN) :: NUM_TRACERS_CHEM
      INTEGER,INTENT(IN) :: NUM_GAS
      REAL,DIMENSION(1:MAX(1,NUM_TRACERS_CHEM)),INTENT(IN) :: CHEMZ0
      REAL,DIMENSION(KTS:KTE,1:MAX(1,NUM_TRACERS_CHEM)),INTENT(INOUT) :: CHEM
      LOGICAL,INTENT(IN) :: VDIFF_CHEM

!----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
      INTEGER :: K
!
      REAL :: CF,CMB,CMCB,CMQB,CMTB,CTHF,DTOZL,DTOZS                   &
     &       ,RCML,RKHH,RKQS,RSCB,RSQB,RSTB
!
      REAL,DIMENSION(KTS:KTE-1) :: CM,CR,DTOZ,RKCT,RSC,RSQ,RST
!
      INTEGER :: N
      REAL :: CMCHEMB,RSCHEMB
      REAL,DIMENSION(KTS:KTE-1,1:MAX(1,NUM_TRACERS_CHEM)) :: RSCHEM

!----------------------------------------------------------------------
!**********************************************************************
!----------------------------------------------------------------------
      CTHF=0.5*CT
!
      DO K=KTS,LMH-1
        DTOZ(K)=DTDIF/(Z(K)-Z(K+1))
        CR(K)=-DTOZ(K)*RKH(K)
      ENDDO
!
      CM(KTS)=DTOZ(KTS)*RKH(KTS)+RHO(KTS)
!----------------------------------------------------------------------
      IF(NUM_TRACERS_CHEM>0.AND.VDIFF_CHEM)THEN
      DO N=1,NUM_TRACERS_CHEM
      RSCHEM(KTS,N)=CHEM(KTS,N)  *RHO(KTS)
      ENDDO
      ENDIF
!----------------------------------------------------------------------
      DO K=KTS+1,LMH-1
        DTOZL=DTOZ(K)
        CF=-DTOZL*RKH(K-1)/CM(K-1)
        CM(K)=-CR(K-1)*CF+(RKH(K-1)+RKH(K))*DTOZL+RHO(K)
      IF(NUM_TRACERS_CHEM>0.AND.VDIFF_CHEM)THEN
        DO N=1,NUM_TRACERS_CHEM
        RSCHEM(K,N)=-RSCHEM(K-1,N)*CF+CHEM(K,N)  *RHO(K)
        ENDDO
      ENDIF
      ENDDO
!
      DTOZS=DTDIF/(Z(LMH)-Z(LMH+1))
      RKHH=RKH(LMH-1)
!
      CF=-DTOZS*RKHH/CM(LMH-1)
!
      CMB=CR(LMH-1)*CF
!
!----------------------------------------------------------------------
      IF(NUM_TRACERS_CHEM>0.AND.VDIFF_CHEM)THEN
!ALLOW GAS-PHASE SURFACE DIFFUSION
!AKHS=RKHS=0. for gases to force dc/dz=0 at surface
      DO N=1,NUM_TRACERS_CHEM-NUM_GAS
      CMCHEMB=-CMB+(RKHH+RKHS)*DTOZS+RHO(LMH)
      RSCHEMB=-RSCHEM(LMH-1,N)*CF+CHEM(LMH,N)  *RHO(LMH)
      CHEM(LMH,N)=(DTOZS*RKHS*CHEMZ0(N)+RSCHEMB)/CMCHEMB
       DO K=LMH-1,KTS,-1
        RCML=1./CM(K)
        CHEM(K,N)  =(-CR(K)*  CHEM(K+1,N)+RSCHEM(K,N))*RCML
       ENDDO
      ENDDO
      IF(NUM_GAS>0.AND.VDIFF_CHEM)THEN
      DO N=(NUM_TRACERS_CHEM-NUM_GAS+1),NUM_TRACERS_CHEM
      CMCHEMB=-CMB+(RKHH+0.)*DTOZS+RHO(LMH)
      RSCHEMB=-RSCHEM(LMH-1,N)*CF+CHEM(LMH,N)  *RHO(LMH)
       CHEM(LMH,N)=(DTOZS*0.*0.+RSCHEMB)/CMCHEMB
       DO K=LMH-1,KTS,-1
        RCML=1./CM(K)
        CHEM(K,N)  =(-CR(K)*  CHEM(K+1,N)+RSCHEM(K,N))*RCML
       ENDDO
      ENDDO
      ENDIF
      ENDIF
!----------------------------------------------------------------------
!
      END SUBROUTINE VDIFH
!
!----------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
       SUBROUTINE STE_DRIVER(NTIMESTEP,DT,NPHS                     &
          ,START_MONTH,XLAT,XLONG                                  &
          ,OZONE,T_PHY,P_PHY,DZ8W,CZMEAN                           &
          ,JPNLT                                                   &
          ,IDS,IDE,JDS,JDE,LM                                      &
          ,IMS,IME,JMS,JME,KMS,KME                                 &
          ,ITS,ITE,JTS,JTE)
!---------------------------------------------------------------------
!     ***************************************************************
!     *                                                             *
!     *         LINEAR STRATOSPHERIC OZONE PARAMETERIZATION         *
!     *                                                             *
!     *                  CARIOLLE AND TEYSSEDRE (2007)              *
!     *                                                             *
!     ***************************************************************
!---------------------------------------------------------------------
!
      IMPLICIT NONE
!     
!---------------------------------------------------------------------
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE                            &
     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
     &                     ,ITS,ITE,JTS,JTE,LM                 
!    
      INTEGER,INTENT(IN) :: NPHS,START_MONTH,NTIMESTEP
!
   INTEGER,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: JPNLT
!
      REAL,INTENT(IN)    :: DT
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE) :: XLAT,XLONG,CZMEAN
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM) :: OZONE
!
   REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE) :: T_PHY,P_PHY,DZ8W
!
!---------------------------------------------------------------------
!
   INTEGER :: IMONTH,INDX,JNDX,L,KFLIP,KFLIP2,K,KK,STRT,TOP
!
   REAL    :: DTCHEM,OZONE_FLIP,S,DRDT,SZA
!
   REAL,PARAMETER :: DEGRAD=3.1415926/180.
   REAL,PARAMETER :: RTD=1./DEGRAD
!
!---------------------------------------------------------------------
!
           DTCHEM=DT*NPHS
           IMONTH=START_MONTH  
           TOP=LM  !-2

! cariolle pressure vector PRES(L)
!   PHI(K) latitudes of cariolle -- latitudes of nmmb
!   PRESC(L)  pressures Cariolle in hPa
!   COEFF(K=NLATS,L=NLEV,JC=NCOEFF,IM=IMONTH)  cariolle coefficients

         DO JNDX=JTS,JTE 
          DO INDX=ITS,ITE
!COMPUTE SOLAR ZENITH ANGLE
             SZA=ACOS(CZMEAN(INDX,JNDX))*RTD
!COMPUTE DR/DT
!             STRT=1 !WE START FROM THE SURFACE
             STRT=JPNLT(INDX,JNDX)  !WE START FROM THE TROPOPAUSE LAYER
       DO L=STRT,TOP
          KFLIP=LM-L+1  !FOR OZONE NMMB ARRAY
          IF(P_PHY(INDX,L,JNDX).LT.10000.AND.P_PHY(INDX,L,JNDX).GT.(PRESC(1)*100.))THEN !FOR NOW WE APPLY CARIOLLE WHEN PRESS IS BELOW 100hPa
!          IF(P_PHY(INDX,L,JNDX).GT.(PRESC(1)*100.))THEN !WE APPLY CARIOLLE WHEN WE ARE ABOVE THE TROPOPAUSE AND WITHIN CARIOLLE PRESSURE LEVELS
              !r(molec/cm3)=r*P(hPa)/(1.38*1e-19*T(K))
             K=NLEV !NLEV !NLEV NUM VERT LEV CARIOLLE COEFF
             DO WHILE ((PRESC(K)*100.).GT.P_PHY(INDX,L,JNDX)) !FIND THE NEAREST PRESSURE LEVEL OF CARIOLLE COEFs
                K=K-1
             ENDDO

!             IF((P_PHY(INDX,L,JNDX)-(PRESC(K+1)*100.)).LT.((PRESC(K)*100.)-P_PHY(INDX,L,JNDX))) THEN
!                K=K+1
!             ENDIF

!   COEFF(K=NLATS,L=NLEV,JC=NCOEFF,IM=IMONTH)  cariolle coefficients

             OZONE_FLIP=OZONE(INDX,JNDX,KFLIP)*1E-6 !OZONE IN [vmr]
             S=0.
             IF(L.LT.LM)THEN
              DO KK=L+1,TOP
                KFLIP2=LM-KK+1
                S=S+(OZONE(INDX,JNDX,KFLIP2)*1E-6*P_PHY(INDX,KK,JNDX)/100./(1.38E-19*T_PHY(INDX,KK,JNDX))*DZ8W(INDX,KK,JNDX)*100.)
!        Nx=Nav*P[Pa]/(RT)*vmr
!                S=S+(OZONE(INDX,JNDX,KFLIP2)*1E-6*6.023E23*P_PHY(INDX,KK,JNDX)/(8.314*T_PHY(INDX,KK,JNDX))*DZ8W(INDX,KK,JNDX)*100.)
              ENDDO
             ENDIF

                IF(T_PHY(INDX,L,JNDX).LT.195.AND.SZA.LT.87.AND.ABS(XLAT(INDX,JNDX)).GT.45)THEN !Heterogeneous chemistry
!          print *,'Heterogeneous chem: T,SZA,XLAT= ',T_PHY(INDX,L,JNDX),SZA,XLAT(INDX,JNDX)
          DRDT =   COEFF(JNDX,K,1,IMONTH) +                                            &
       COEFF(JNDX,K,2,IMONTH)*(OZONE_FLIP-COEFF(JNDX,K,3,IMONTH)) +                  &
       COEFF(JNDX,K,4,IMONTH)*(T_PHY(INDX,L,JNDX)-COEFF(JNDX,K,5,IMONTH)) +          &
       COEFF(JNDX,K,6,IMONTH)*(S-COEFF(JNDX,K,7,IMONTH)) +                           &
       COEFF(JNDX,K,8,IMONTH)*((3.65/3.8)**2)*OZONE_FLIP           !Total Chlorine at Stratospher 2004=3.65ppbv Nassar et al.(2006) JGR
                ELSE  !NO HETEROGENEOUS CHEMISTRY
          DRDT = COEFF(JNDX,K,1,IMONTH) +                                            &
       COEFF(JNDX,K,2,IMONTH)*(OZONE_FLIP-COEFF(JNDX,K,3,IMONTH)) +                  &
       COEFF(JNDX,K,4,IMONTH)*(T_PHY(INDX,L,JNDX)-COEFF(JNDX,K,5,IMONTH)) +          &
       COEFF(JNDX,K,6,IMONTH)*(S-COEFF(JNDX,K,7,IMONTH))
        ! print *,'No Heterogeneous chem: T,SZA,XLAT,DRDT= ',T_PHY(INDX,L,JNDX),SZA,XLAT(INDX,JNDX),DRDT,(PRESC(K)*100.),P_PHY(INDX,L,JNDX)
                ENDIF

!         print *,'DRDT=',XLAT(INDX,JNDX),P_PHY(INDX,L,JNDX),COEFF(JNDX,K,1,IMONTH),COEFF(JNDX,K,2,IMONTH),OZONE_FLIP,COEFF(JNDX,K,3,IMONTH),COEFF(JNDX,K,4,IMONTH),T_PHY(INDX,L,JNDX) &
!      ,COEFF(JNDX,K,5,IMONTH),COEFF(JNDX,K,6,IMONTH),S,COEFF(JNDX,K,7,IMONTH),COEFF(JNDX,K,8,IMONTH)

            OZONE_FLIP = OZONE_FLIP + DRDT * DTCHEM !WE APPLY THE OZONE TENDENCY
!            print *,'DRDT = ',INDX, JNDX, OZONE_FLIP*1e6,DRDT*1E6*DTCHEM
            OZONE(INDX,JNDX,KFLIP)=OZONE_FLIP*1E6 !BACK TO NMMB ARRAY IN [ppmv]
          ENDIF !P_PHY<100hPa
       ENDDO !TOP

          ENDDO  !INDX
         ENDDO  !JNDX
!!PROBLEM IN NORTH POLE, FILL WITH JTE-1
         DO JNDX=JTS,JTE
          DO INDX=ITS,ITE
            IF(XLAT(INDX,JNDX).GE.89.9)THEN
              OZONE(INDX,JNDX,:)=OZONE(INDX,JNDX-1,:)
            ENDIF
          ENDDO
         ENDDO
!
       RETURN
!
      END SUBROUTINE STE_DRIVER
!
!----------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
       SUBROUTINE STE_CLIMATO(NTIMESTEP,DT,NPHS,START_MONTH        &
          ,OZONE,P_PHY,DZ8W                                        &
          ,JPNLT,FIRST_CHEM                                        &
          ,IDS,IDE,JDS,JDE,LM                                      &
          ,IMS,IME,JMS,JME,KMS,KME                                 &
          ,ITS,ITE,JTS,JTE)
!---------------------------------------------------------------------
!     ***************************************************************
!     *                                                             *
!     *         CLIMATOLOGICAL STRATOSPHERIC OZONE                  *
!     *                                                             *
!     ***************************************************************
!---------------------------------------------------------------------
!            
      IMPLICIT NONE
!            
!---------------------------------------------------------------------
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE                            &
     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
     &                     ,ITS,ITE,JTS,JTE,LM
!    
      INTEGER,INTENT(IN) :: NPHS,START_MONTH,NTIMESTEP
!            
   INTEGER,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: JPNLT
!               
      REAL,INTENT(IN)    :: DT
!         
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM) :: OZONE
!      
   REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE) :: P_PHY,DZ8W
!
   LOGICAL,INTENT(IN) :: FIRST_CHEM
!         
!---------------------------------------------------------------------               
!     
   INTEGER,PARAMETER :: NIN=1999
!
   CHARACTER(25) :: KNAME
!
   CHARACTER(2)  :: CMONTH
! 
   INTEGER :: INDX,JNDX,L,KFLIP,KFLIP2,K,KK,STRT,TOP
!       
   REAL    :: DTCHEM,OZONE_FLIP,S,DRDT,SZA
!
   REAL,PARAMETER :: DEGRAD=3.1415926/180.
!
   REAL,PARAMETER :: RTD=1./DEGRAD
!
   REAL,ALLOCATABLE,DIMENSION(:,:,:) :: TEMP
!
   REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: O3CLIMATO
!
!---------------------------------------------------------------------

           DTCHEM=DT*NPHS
           WRITE(CMONTH,'(I2)') START_MONTH
           TOP=LM  !-2
           STRT=1 !WE START FROM THE SURFACE

!READ CLIMATOLOGY
      IF(FIRST_CHEM)THEN

        IF(.NOT.ALLOCATED(O3CLIMATO))THEN
          ALLOCATE(O3CLIMATO(IMS:IME,JMS:JME,1:3))
          O3CLIMATO(:,:,:)=0.
        ENDIF

        IF(MYPE==0)THEN
          IF(.NOT.ALLOCATED(TEMP))THEN
            ALLOCATE(TEMP(IDS:IDE,JDS:JDE,3))
          ENDIF
          IF(START_MONTH.LT.10)THEN
            KNAME='O3CLIMATO1_'//CMONTH(2:2)//'.dat'
          ELSE
            KNAME='O3CLIMATO1_'//CMONTH//'.dat'
          ENDIF
!         IF(MYPE==0)THEN
          OPEN(NIN,file=KNAME,form='unformatted',status='old')
          READ(NIN) TEMP
          CLOSE(NIN)
!           DEALLOCATE(TEMP)
        ENDIF

        DO L=1,3 !1=10hPa 2=50hPa 3=100hPa
         CALL DSTRB(TEMP(:,:,L),O3CLIMATO(:,:,:),1,1,1,3,L,mype,mpi_comm_comp) !10  hPa
        ENDDO  

        IF(MYPE==0)THEN
          DEALLOCATE(TEMP)
        ENDIF
      ENDIF
!
! Wrtie climatology on top layers of OZONE array
!
         DO JNDX=JTS,JTE
          DO INDX=ITS,ITE
!             STRT=JPNLT(INDX,JNDX)  !WE START FROM THE TROPOPAUSE LAYER
!   print *,'STRT,TOP:',STRT,TOP
       DO L=STRT,TOP
          KFLIP=LM-L+1  !FOR OZONE NMMB ARRAY
          IF(P_PHY(INDX,L,JNDX).LT.10000.AND.P_PHY(INDX,L,JNDX).GT.5000.)THEN !FOR NOW WE APPLY CARIOLLE WHEN PRESS IS BELOW 100hPa
            OZONE(INDX,JNDX,KFLIP)=O3CLIMATO(INDX,JNDX,3)
          ELSEIF(P_PHY(INDX,L,JNDX).LT.5000.AND.P_PHY(INDX,L,JNDX).GT.1000.)THEN
            OZONE(INDX,JNDX,KFLIP)=O3CLIMATO(INDX,JNDX,2)
          ELSEIF(P_PHY(INDX,L,JNDX).LT.1000)THEN
            OZONE(INDX,JNDX,KFLIP)=O3CLIMATO(INDX,JNDX,1)
          ENDIF
       ENDDO

          ENDDO
         ENDDO

       RETURN

      END SUBROUTINE STE_CLIMATO
!
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!
       SUBROUTINE STE_DRIVER_COPCAT(NTIMESTEP,DT,NPHS                     &
          ,START_MONTH,XLAT,XLONG                                  &
          ,OZONE,T_PHY,P_PHY,DZ8W,CZMEAN                           &
          ,JPNLT                                                   &
          ,IDS,IDE,JDS,JDE,LM                                      &
          ,IMS,IME,JMS,JME,KMS,KME                                 &
          ,ITS,ITE,JTS,JTE)
!---------------------------------------------------------------------
!     ***************************************************************
!     *                                                             *
!     *         LINEAR STRATOSPHERIC OZONE PARAMETERIZATION         *
!     *                                                             *
!     *                  COPCAT Monge-Sanz (2011)              *
!     *                                                             *
!     ***************************************************************
!---------------------------------------------------------------------
!
      IMPLICIT NONE
!     
!---------------------------------------------------------------------
      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE                            &
     &                     ,IMS,IME,JMS,JME,KMS,KME                    &
     &                     ,ITS,ITE,JTS,JTE,LM
!    
      INTEGER,INTENT(IN) :: NPHS,START_MONTH,NTIMESTEP
!
   INTEGER,DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: JPNLT
!
      REAL,INTENT(IN)    :: DT
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE) :: XLAT,XLONG,CZMEAN
!
   REAL,DIMENSION(ITS:ITE,JTS:JTE,1:LM) :: OZONE
!
   REAL,DIMENSION(ITS:ITE,1:LM,JTS:JTE) :: T_PHY,P_PHY,DZ8W
!
!---------------------------------------------------------------------
!
   INTEGER :: IMONTH,INDX,JNDX,L,KFLIP,KFLIP2,K,KK,STRT,TOP
!
   REAL    :: DTCHEM,OZONE_FLIP,S,DRDT,SZA
!
   REAL,PARAMETER :: DEGRAD=3.1415926/180.
   REAL,PARAMETER :: RTD=1./DEGRAD
!
!---------------------------------------------------------------------
!
           DTCHEM=DT*NPHS
           IMONTH=START_MONTH
           TOP=LM  !-2

!   copcat pressure vector PRES(L)
!   READ (NIN,*) PHI(K),PRESC(L),(COEFF(K,L,JC,IM),JC=1,NCOEFF)
!   PHI(K) latitudes of copcat -- latitudes of nmmb
!   PRESC(L)  pressures copcat in Pa
!   COEFF(K=NLATS,L=NLEV,JC=NCOEFF,IM=IMONTH)  copcat coefficients

         DO JNDX=JTS,JTE
          DO INDX=ITS,ITE
!COMPUTE SOLAR ZENITH ANGLE
             SZA=ACOS(CZMEAN(INDX,JNDX))*RTD
!COMPUTE DR/DT
!             STRT=1 !WE START FROM THE SURFACE
             STRT=JPNLT(INDX,JNDX)  !WE START FROM THE TROPOPAUSE LAYER
!   print *,'STRT,TOP:',STRT,TOP
       DO L=STRT,TOP
          KFLIP=LM-L+1  !FOR OZONE NMMB ARRAY
          IF(P_PHY(INDX,L,JNDX).LT.10000.AND.P_PHY(INDX,L,JNDX).GT.(PRESC(1)))THEN !FOR NOW WE APPLY CARIOLLE WHEN PRESS IS BELOW 100hPa
!   print *,'WE ARE IN P_PHY PRESC =',P_PHY(INDX,L,JNDX),PRESC(1)*100.
!          IF(P_PHY(INDX,L,JNDX).GT.(PRESC(1)))THEN !WE APPLY CARIOLLE WHEN WE ARE ABOVE THE TROPOPAUSE AND WITHIN CARIOLLE PRESSURE LEVELS
              !r(molec/cm3)=r*P(hPa)/(1.38*1e-19*T(K))
             K=NLEV_COP !NLEV !NLEV NUM VERT LEV CARIOLLE COEFF
             DO WHILE ((PRESC(K)).GT.P_PHY(INDX,L,JNDX)) !FIND THE NEAREST PRESSURE LEVEL OF CARIOLLE COEFs
                K=K-1
             ENDDO

!             IF((P_PHY(INDX,L,JNDX)-(PRESC(K+1)*100.)).LT.((PRESC(K)*100.)-P_PHY(INDX,L,JNDX))) THEN
!                K=K+1
!             ENDIF

!   COEFF(K=NLATS,L=NLEV,JC=NCOEFF,IM=IMONTH)  cariolle coefficients

             OZONE_FLIP=OZONE(INDX,JNDX,KFLIP)*1E-6 !OZONE IN [vmr]
             S=0.
             IF(L.LT.LM)THEN
              DO KK=L+1,TOP
                KFLIP2=LM-KK+1
                S=S+(OZONE(INDX,JNDX,KFLIP2)*1E-6*P_PHY(INDX,KK,JNDX)/(1.38E-19*T_PHY(INDX,KK,JNDX))*DZ8W(INDX,KK,JNDX))
!        Nx=Nav*P[Pa]/(RT)*vmr
!                S=S+(OZONE(INDX,JNDX,KFLIP2)*1E-6*6.023E23*P_PHY(INDX,KK,JNDX)/(8.314*T_PHY(INDX,KK,JNDX))*DZ8W(INDX,KK,JNDX)*100.)
              ENDDO
             ENDIF

          DRDT = COEFF(JNDX,K,1,IMONTH) +                                            &
       COEFF(JNDX,K,2,IMONTH)*(OZONE_FLIP-COEFF(JNDX,K,3,IMONTH)) +                  &
       COEFF(JNDX,K,4,IMONTH)*(T_PHY(INDX,L,JNDX)-COEFF(JNDX,K,5,IMONTH)) +          &
       COEFF(JNDX,K,6,IMONTH)*(S-COEFF(JNDX,K,7,IMONTH))
!         print *,'DRDT=',XLAT(INDX,JNDX),P_PHY(INDX,L,JNDX),COEFF(JNDX,K,1,IMONTH),COEFF(JNDX,K,2,IMONTH),OZONE_FLIP,COEFF(JNDX,K,3,IMONTH),COEFF(JNDX,K,4,IMONTH),T_PHY(INDX,L,JNDX) &
!      ,COEFF(JNDX,K,5,IMONTH),COEFF(JNDX,K,6,IMONTH),S,COEFF(JNDX,K,7,IMONTH),COEFF(JNDX,K,8,IMONTH)
            OZONE_FLIP = OZONE_FLIP + DRDT * DTCHEM !WE APPLY THE OZONE TENDENCY
!            print *,'DRDT = ',INDX, JNDX, OZONE_FLIP*1e6,DRDT*1E6*DTCHEM
            OZONE(INDX,JNDX,KFLIP)=OZONE_FLIP*1E6 !BACK TO NMMB ARRAY IN [ppmv]
          ENDIF !P_PHY<100hPa
       ENDDO !TOP

          ENDDO  !INDX
         ENDDO  !JNDX

!!PROBLEM IN NORTH POLE, FILL WITH JTE-1
         DO JNDX=JTS,JTE
          DO INDX=ITS,ITE
            IF(XLAT(INDX,JNDX).GE.89.9)THEN
              OZONE(INDX,JNDX,:)=OZONE(INDX,JNDX-1,:)
            ENDIF
          ENDDO
         ENDDO
!
       RETURN

      END SUBROUTINE STE_DRIVER_COPCAT
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      END MODULE MODULE_BSC_CHEMISTRY 
!
!-----------------------------------------------------------------------
