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

! Authors:
! -------- Alba , BSC, January 2013
!--- Unit conversion
   USE NETCDF 

! PARAMETERs inherent to TNO inventory
! num_tno_ant = number of SNAPs
! spec_tno_ant = number of variables
! spec_c0b5 = number of variables needed in CB05

 INTEGER, PARAMETER ::  spec_tno_ant= 29, &  !INCLUDE NH3 28, &           
                        num_tno_ant= 13,  &
                        spec_cb05 = 16       !INCLUDE NH3 15

  REAL, DIMENSION(spec_tno_ant) :: Mol_weig


!!!!!!!!!CB05 species!!!!!!!!
!CO
! NO2
! NO
!SO2
!PAR= 1.5 propane +4 butane +5 pentane+ 6hexanes + 1 propene +1 ethyne +2 other
!alkenes + 1 benzene + 1 trimethylbenzene + 2 alkoxy alkanes +4 other alkanals +
!3 ketones +1 acids (alkanoic) +1 other nmvocs
!OLE= 1 propene + 1 other alkenes
!TOL= 1 methylbenzene + 0.25 other aromatics
!XYL= 1 dimethylbenzene + 1 trimethylbenzene +0.75 other aromatics
!FOR = 1 formaldehyde
!ETH=1 ethene
!ISOP= 1 isoprene
!MEOH= alcohols
!NR= 1.5 propane +1 ethene +1 ethyne + 5 benzene + 1 esters + 1 acids+ 1 acetonitrile
!ETHA= 1 ethane
!TERP= 1 monoterpenes


 INTEGER, PARAMETER   ::                               nlon  = 309 ,     &
                                                        nlat  = 249 ,     &
                                                        nlev  = 24 !,       &
!year  = 2010 ,    &
!month = 08  ,     &
!day   = 01  ,     &
!hour_in= 24
                        
! time-split definition
  REAL, DIMENSION(12,num_tno_ant) :: month_var
  REAL, DIMENSION(7, num_tno_ant) :: week_var
  REAL, DIMENSION(28,num_tno_ant) :: day_var



  DATA month_var /                                                           &
      1.20 ,1.15, 1.05 ,1.00 ,0.90 ,0.85 ,0.80 ,0.875,0.95 ,1.00 ,1.075,1.15,&
      1.7  ,1.5,  1.30 ,1.0  ,0.7  ,0.4  ,0.2  ,0.4  ,0.7  ,1.05 ,1.4  ,1.65,&
!1.02 ,1.02, 1.02 ,1.02 ,1.02 ,1.02 ,1.0  ,0.84 ,1.02 ,1.02 ,1.02 ,0.90,&
      1.02 ,1.02, 1.02 ,1.02 ,1.02 ,1.02 ,1.0  ,0.90 ,1.02 ,1.02 ,1.02 ,0.92,&
      1.2  ,1.2,  1.2  ,0.8  ,0.8  ,0.8  ,0.8  ,0.8  ,0.8  ,1.2  ,1.2  ,1.2, &
      0.95 ,0.96, 1.02 ,1.0  ,1.01 ,1.03 ,1.03 ,1.01 ,1.04 ,1.03 ,1.01 ,0.91,&
      0.88 ,0.92, 0.98 ,1.03 ,1.05 ,1.06 ,1.01 ,1.02 ,1.06 ,1.05 ,1.01 ,0.93,&
      0.88 ,0.92, 0.98 ,1.03 ,1.05 ,1.06 ,1.01 ,1.02 ,1.06 ,1.05 ,1.01 ,0.93,&
      0.88 ,0.92, 0.98 ,1.03 ,1.05 ,1.06 ,1.01 ,1.02 ,1.06 ,1.05 ,1.01 ,0.93,&
      0.88 ,0.92, 0.98 ,1.03 ,1.05 ,1.06 ,1.01 ,1.02 ,1.06 ,1.05 ,1.01 ,0.93,&
      0.88 ,0.92, 0.98 ,1.03 ,1.05 ,1.06 ,1.01 ,1.02 ,1.06 ,1.05 ,1.01 ,0.93,&
      0.88 ,0.92, 0.98 ,1.03 ,1.05 ,1.06 ,1.01 ,1.02 ,1.06 ,1.05 ,1.01 ,0.93,&
      1.00 ,1.00, 1.00 ,1.00 ,1.00 ,1.00 ,1.00 ,1.00 ,1.00 ,1.00 ,1.00 ,1.00,&
      0.45 ,1.3,  2.35 ,1.7  ,0.85 ,0.85 ,0.85 ,1.0  ,1.1  ,0.65 ,0.45 ,0.45/
      

  DATA week_var/                                     &
      1.06,  1.06,  1.06,  1.06,  1.06,  0.85,  0.85,&
      1.08,  1.08,  1.08,  1.08,  1.08,  0.80,  0.80,&
      1.02,  1.02,  1.02,  1.02,  1.02,  1.02,  1.0 ,&
      1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,&
      1.20,  1.20,  1.20,  1.20,  1.20,  0.50,  0.50,&
      1.02,  1.06,  1.08,  1.10,  1.14,  0.81,  0.79,&
      1.02,  1.06,  1.08,  1.10,  1.14,  0.81,  0.79,&
      1.02,  1.06,  1.08,  1.10,  1.14,  0.81,  0.79,&
      1.02,  1.06,  1.08,  1.10,  1.14,  0.81,  0.79,&
      1.02,  1.06,  1.08,  1.10,  1.14,  0.81,  0.79,&
      1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,&
      1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,&
      1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 ,  1.0 /

  DATA day_var/                                       0.79,&
      0.72, 0.72, 0.71, 0.74, 0.80, 0.92, 1.08, 1.19, 1.22,&
      1.21, 1.21, 1.17, 1.15, 1.14, 1.13, 1.10, 1.07, 1.04,&
      1.02, 1.02, 1.01, 0.96, 0.88, 0.79, 0.72, 0.72, 0.71,&
                                                      0.38,&
      0.36, 0.36, 0.36, 0.37, 0.50, 1.19, 1.53, 1.57, 1.56,&
      1.35, 1.16, 1.07, 1.06, 1.00, 0.98, 0.99, 1.12, 1.41,&
      1.52, 1.39, 1.35, 1.00, 0.42, 0.38, 0.36, 0.36, 0.36,&
                                                      1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
                                                      1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
                                                      0.50,&
      0.35, 0.20, 0.10, 0.10, 0.20, 0.75, 1.25, 1.40, 1.50,&
      1.50, 1.50, 1.50, 1.50, 1.50, 1.50, 1.50, 1.40, 1.25,&
      1.10, 1.00, 0.90, 0.80, 0.70, 0.50, 0.35, 0.20, 0.10,&
                                                      0.19,&
      0.09, 0.06, 0.05, 0.09, 0.22, 0.86, 1.84, 1.86, 1.41,&
      1.24, 1.20, 1.32, 1.44, 1.45, 1.59, 2.03, 2.08, 1.51,&
      1.06, 0.74, 0.62, 0.61, 0.44, 0.19, 0.09, 0.06, 0.05,&
                                                      0.19,&
      0.09, 0.06, 0.05, 0.09, 0.22, 0.86, 1.84, 1.86, 1.41,&
      1.24, 1.20, 1.32, 1.44, 1.45, 1.59, 2.03, 2.08, 1.51,&
      1.06, 0.74, 0.62, 0.61, 0.44, 0.19, 0.09, 0.06, 0.05,&
                                                      0.19,&
      0.09, 0.06, 0.05, 0.09, 0.22, 0.86, 1.84, 1.86, 1.41,&
      1.24, 1.20, 1.32, 1.44, 1.45, 1.59, 2.03, 2.08, 1.51,&
      1.06, 0.74, 0.62, 0.61, 0.44, 0.19, 0.09, 0.06, 0.05,&
                                                      0.19,&
      0.09, 0.06, 0.05, 0.09, 0.22, 0.86, 1.84, 1.86, 1.41,&
      1.24, 1.20, 1.32, 1.44, 1.45, 1.59, 2.03, 2.08, 1.51,&
      1.06, 0.74, 0.62, 0.61, 0.44, 0.19, 0.09, 0.06, 0.05,&
                                                      0.19,&
      0.09, 0.06, 0.05, 0.09, 0.22, 0.86, 1.84, 1.86, 1.41,&
      1.24, 1.20, 1.32, 1.44, 1.45, 1.59, 2.03, 2.08, 1.51,&
      1.06, 0.74, 0.62, 0.61, 0.44, 0.19, 0.09, 0.06, 0.05,&
                                                      0.19,&
      0.09, 0.06, 0.05, 0.09, 0.22, 0.86, 1.84, 1.86, 1.41,&
      1.24, 1.20, 1.32, 1.44, 1.45, 1.59, 2.03, 2.08, 1.51,&
      1.06, 0.74, 0.62, 0.61, 0.44, 0.19, 0.09, 0.06, 0.05,&
                                                      1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
                                                      1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,&
      1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00/


 DATA Mol_weig /28.01,46.0055,30.01,64.06,32.04,30.07,44.1, &
    58.12, 72.15,86.18, 28.05, 42.08, 26.04, 68.12, 136.24,&
    56.11, 78.11, 92.14, 106.17,120.2, 134.22,60.05,46.07, &
    30.03, 58.12, 58.08, 60.05, 41.05, 17.03  / !INCLUDE NH3 17.03

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

CONTAINS

  SUBROUTINE time_split(emis_ant,  emission_ant,lon                      &
                       ,year_utc,month_utc,day_utc,hour_utc              &
                       ,IMS,IME,JMS,JME                                  &
                       ,ITS,ITE,JTS,JTE )
                        
!*time_split* distribute annual emissions over months, weeks and days of a year
                           
   USE MODULE_DM_PARALLEL, ONLY : MYPE_SHARE
 
    IMPLICIT none

    INTEGER , INTENT(in) :: IMS,IME,JMS,JME,ITS,ITE,JTS,JTE
    INTEGER, INTENT(in)                                 :: year_utc, month_utc ,day_utc, hour_utc
!    REAL, DIMENSION(nlon,nlat,num_tno_ant,spec_tno_ant), INTENT(in)  :: emis_ant
!    REAL, DIMENSION(nlon,nlat),                          INTENT(in)  :: lon
    REAL, DIMENSION(IMS:IME,JMS:JME,num_tno_ant,spec_tno_ant), INTENT(in)  :: emis_ant
    REAL, DIMENSION(ITS:ITE,JTS:JTE),                          INTENT(in)  :: lon
    
!    REAL, DIMENSION(nlon,nlat,num_tno_ant,spec_tno_ant), INTENT(out) :: emission_ant
    REAL, DIMENSION(IMS:IME,JMS:JME,num_tno_ant,spec_tno_ant), INTENT(out) :: emission_ant

 
! allocate local
    INTEGER                                             :: k, l, i, j,MYPE
    INTEGER                                             :: day_start, day_end
    INTEGER                                             :: days_month(12)
!    INTEGER, DIMENSION(nlon,nlat)                       :: hour
    INTEGER, DIMENSION(ITS:ITE,JTS:JTE)                 :: year_lt,month_lt,day_lt,hour_lt,day_week_lt
    LOGICAL                                             :: isummer_time
    REAL                                                :: out_emi,in_emi

    DATA days_month/31,28,31,30,31,30,31,31,30,31,30,31/

!--- Handle time zones in an approximate way; political factors not included
!--- on which day of march does the summertime start and on which day of october does it end
    
    day_start = int(31.0 - mod(4.0 + 5.0 * year_utc / 4.0, 7.0) + 1.0)
    
    day_end   = int(31.0 - mod(1.0 + 5.0 * year_utc / 4.0, 7.0) + 1.0)

    isummer_time = .false.
    
    IF ( (month_utc .eq. 3 ) .and. (day_utc   .ge. day_start) ) isummer_time = .true.
    IF ( (month_utc .gt. 3 ) .and. (month_utc .lt. 10)        ) isummer_time = .true.
    IF ( (month_utc .eq. 10) .and. (day_utc   .le. day_end)   ) isummer_time = .true.

    DO i = ITS,ITE !1, nlon
     DO j = JTS,JTE !1, nlat
     
       IF (isummer_time) THEN
       
         hour_lt(i,j) = hour_utc + int(lon(i,j) / 15.0) + 1
         
       ELSE 
       
         hour_lt(i,j) = hour_utc + int(lon(i,j) / 15.0)
         
       END IF

      year_lt(i,j)=year_utc
      month_lt(i,j)=month_utc
      day_lt(i,j)=day_utc

      IF(hour_lt(i,j).LE.0) then
       hour_lt(i,j)=24+hour_lt(i,j)
        IF (day_utc>1) day_lt(i,j)=day_utc-1
        IF(day_utc.EQ.1) THEN
               IF(month_utc>1)THEN
                  month_lt(i,j)=month_utc-1
                  day_lt(i,j)=days_month(month_lt(i,j))
               ENDIF
               IF(month_utc.EQ.1)THEN
                  month_lt(i,j)=12  !change year -> december!!
                  year_lt(i,j)=year_utc-1
                  day_lt(i,j)=days_month(month_lt(i,j))
               ENDIF
        END IF
      ELSEIF(hour_lt(i,j).GT.24) then !hour>0
       hour_lt(i,j)=hour_lt(i,j)-24
       if(day_utc.EQ.days_month(month_lt(i,j)))THEN
          if(month_lt(i,j).EQ.12)THEN
             day_lt(i,j)=1
             month_lt(i,j)=1
             year_lt(i,j)=year_lt(i,j)+1
          ELSE
             day_lt(i,j)=1
             month_lt(i,j)=month_lt(i,j)+1
          ENDIF
       ELSE
         day_lt(i,j)=day_lt(i,j)+1
       ENDIF

     ENDIF

!--- Get day of the week:
    CALL dayofweek (day_lt(i,j), month_lt(i,j), year_lt(i,j),day_week_lt(i,j))

!    IF(MYPE==0)THEN
!      print *,'UTC:',year_utc,month_utc,day_utc
!      print *,'LT :',year_lt(i,j),month_lt(i,j),day_lt(i,j)
!    ENDIF


     END DO
    END DO

!--- Anthropogenic:

    out_emi=0.
    in_emi=0.

    DO i=ITS,ITE !1,nlon
     DO j=JTS,JTE !1,nlat
      DO k=1,spec_tno_ant
       DO l=1,num_tno_ant
         
         emission_ant(i,j,l,k) = emis_ant(i,j,l,k) * month_var(month_lt(i,j),l) * week_var(day_week_lt(i,j),l) * day_var(hour_lt(i,j),l) /(365.*24.)
        
      END DO
      END DO
     END DO
    END DO

    RETURN

  END SUBROUTINE time_split


  SUBROUTINE dayofweek (nday, nmonth, nyear, day)
  
!*dayofweek* calculates the day of the week given the date; works for years in the range 2000 to 2099; method from internet
  
    IMPLICIT none

! Allocate input
    INTEGER, INTENT(in)    :: nday, nmonth, nyear
    
! Allocate output
    INTEGER, INTENT(out)   :: day
    
! Allocate local
    INTEGER                   hlp, hlp1, hlp2, years
    INTEGER, DIMENSION(12) :: code

! error check on input
    IF (nyear .lt. 1700 .or. nyear .gt. 2200) THEN
      PRINT*,'FROM DayOfWeek: YEAR OUT OF RANGE; MUST BE BETWEEN 1700 AND 2200; SETTING DAY=1'
      day = 1
      RETURN
    END IF
    IF (nmonth .gt. 12 .or. nmonth .lt. 1) THEN
      print*,'FROM DayOfWeek: MONTH OUT OF RANGE; SETTING DAY=1'
      day = 1
      RETURN
    END IF
    IF (nday .gt. 31 .or. nday .lt. 1) THEN
      print*,'FROM DayOfWeek: DAY OUT OF RANGE; SETTING DAY=1'
      day = 1
      RETURN
    END IF

! set up monthly codes
    code(1) = 6 ! jan
    code(2) = 2 ! feb
    code(3) = 2 ! mar
    code(4) = 5 ! apr
    code(5) = 0 ! may
    code(6) = 3 ! jun
    code(7) = 5 ! jul
    code(8) = 1 ! aug
    code(9) = 4 ! sep
    code(10)= 6 ! oct
    code(11)= 2 ! nov
    code(12)= 4 ! dec

! handle leap years; subtract 1 from final day IF leap year
    hlp = 0
    IF (nmonth .eq. 1 .or. nmonth .eq. 2) THEN
    
      IF (mod(nyear,4) .eq. 0) THEN
      
        IF (mod(nyear,100) .eq. 0) THEN
        
          IF (mod(nyear,400) .eq. 0) THEN
          
            hlp = 1
            
          ELSE
          
            hlp = 0
            
          END IF
          
        ELSE
        
          hlp = 1
          
        END IF
        
      ELSE
      
        hlp = 0
        
      END IF
      
    END IF

!--- Calculate day in week:
    IF (nyear .lt. 1800 .and. nyear .ge. 1700) years = 1700
    IF (nyear .lt. 1900 .and. nyear .ge. 1800) years = 1800
    IF (nyear .lt. 2000 .and. nyear .ge. 1900) years = 1900
    IF (nyear .lt. 2100 .and. nyear .ge. 2000) years = 2000
    IF (nyear .lt. 2200 .and. nyear .ge. 2100) years = 2100
    IF (nyear .lt. 2300 .and. nyear .ge. 2200) years = 2200

    hlp1 = nyear - years
    
    hlp1 = hlp1  + hlp1 / 4

    hlp2 = hlp1 + code(nmonth) + nday
    
    hlp2 = hlp2 - 7 * (hlp2/7)

    day  = hlp2 - hlp

! handle negatives and zero's
!  DO while (day.le.0)
!   day = day+7
!  END DO

! handle past and future centuries
    IF (nyear .lt. 1800 .and. nyear .ge. 1700) day = day + 5
    IF (nyear .lt. 1900 .and. nyear .ge. 1800) day = day + 3
    IF (nyear .lt. 2000 .and. nyear .ge. 1900) day = day + 1
    IF (nyear .lt. 2200 .and. nyear .ge. 2100) day = day - 2
    IF (nyear .lt. 2300 .and. nyear .ge. 2200) day = day - 4

! handle negatives and zero's
    DO WHILE (day .le. 0)
      day = day + 7
    END DO

  END SUBROUTINE dayofweek

!SUBROUTINE em_vert_dist(isnap, nlon, nlat, nlev, nmmb_hgt, vdfact,ch4_nmvoc)
SUBROUTINE em_vert_dist(isnap, nlev, nmmb_hgt_in, FIS, vdfact,ch4_nmvoc       &
                       ,IMS,IME,JMS,JME                               &
                       ,ITS,ITE,JTS,JTE )

   USE MODULE_DM_PARALLEL, ONLY : MYPE_SHARE

    IMPLICIT none

!--- Allocate input
    INTEGER, INTENT(IN) :: IMS,IME,JMS,JME,ITS,ITE,JTS,JTE
!    INTEGER, INTENT(in)      :: isnap, nlon, nlat,nlev,ch4_nmvoc
    INTEGER, INTENT(in)      :: isnap, nlev,ch4_nmvoc
    REAL, DIMENSION(ITS:ITE,1:nlev+1,JTS:JTE), INTENT(in)  :: nmmb_hgt_in
    REAL, DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS
!--- Allocate output
    REAL, DIMENSION(ITS:ITE, JTS:JTE, nlev), INTENT(out) :: vdfact

!--- Allocate local
    INTEGER         :: MYPE
    INTEGER                         :: i, j, k, l,y,check_k,denom
    REAL, DIMENSION(24)             :: nmmb_hgt
    REAL,PARAMETER :: G=9.8060226 !Same as module_constants
    REAL, DIMENSION(6)              :: em_hgt
    REAL, DIMENSION(6, num_tno_ant) :: vfactor,vfactor1

    DATA em_hgt  /90.0, 170., 310., 470., 710., 990. /    ! TNO vertical layer mean height (m)

    DATA vfactor / 0.00, 0.00, 0.08, 0.46, 0.29, 0.17,  &  ! SNAP-1:  Public Power stations
                  0.50, 0.50, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-2:  Comm./inst. combustion
!                   0.90, 0.10, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-34:  Industrial_combustion
                   0.00, 0.04, 0.19, 0.41, 0.30, 0.06,  &  ! SNAP-4:  Industrial_processes
                   0.90, 0.10, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-5:  Extraction fossil fuel
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-6:  Solvents
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-71:  Road
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-72:  Road traffic
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-73:  Road traffic
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-74:  Road traffic
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-75:  Road traffic
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-8:  Other mobile (trains, plains etc.)
                   0.10, 0.15, 0.40, 0.35, 0.00, 0.00,  &  ! SNAP-9:  Waste
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00   /  ! SNAP-10: Agriculture




    DATA vfactor1 / 0.00, 0.00, 0.08, 0.46, 0.29, 0.17,  &  ! SNAP-1:  PublicPower stations
                  0.50, 0.50, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-2:  Comm./inst.combustion
!                   0.90, 0.10, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-34:!                   Industrial_combustion
                   0.90, 0.10, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-4:Industrial_processes
                   0.90, 0.10, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-5:  Extractionfossil fuel
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-6:  Solvents
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-71:  Road
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-72:  Roadtraffic
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-73:  Roadtraffic
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-74:  Roadtraffic
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-75:  Roadtraffic
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00,  &  ! SNAP-8:  Othermobile (trains, plains etc.)
                   0.10, 0.15, 0.40, 0.35, 0.00, 0.00,  &  ! SNAP-9:  Waste
                   1.00, 0.00, 0.00, 0.00, 0.00, 0.00   /  ! SNAP-10:Agriculture

      MYPE=MYPE_SHARE

    IF(ch4_nmvoc.EQ.1) vfactor=vfactor1

    vdfact=0.

!    DO i = ITS,ITE !1, nlon
!      DO j = JTS,JTE !1, nlat
      
!        k = 2 !1  nmmb_hgt(1:LM+1)
!        DO l = 1, 6   !nlev, 2, -1
   
!          check_k=k
        
!             DO WHILE( (((nmmb_hgt(i,k,j)-FIS(i,j)/G)    - em_hgt(l)) *       &
!              ((nmmb_hgt(i,k+1,j)-FIS(i,j)/G) - em_hgt(l)) > 0.0E0).AND. (k<nlev+1))

!              k=k+1 

!             END DO
 
!              DO y = check_k,k
!               denom= k-check_k+1
!              vdfact(i,j,y-1) = vfactor(l, isnap)/(denom) + vdfact(i,j,y-1)
!              END DO

!       IF  (((nmmb_hgt(i,k+1,j)-FIS(i,j)/G)   - em_hgt(l)) > 0.0E0) k=k+1       
!        END DO
        
!      END DO
!    END DO
   DO i = ITS,ITE !1, nlon
     DO j = JTS,JTE !1, nlat

       nmmb_hgt=nmmb_hgt_in(i,2:nlev+1,j)-FIS(i,j)/G

       k = 1
       DO l = 1, 6   !nlev, 2, -1

         check_k=k

        IF((nmmb_hgt(1)   - em_hgt(l)) > 0.0E0) THEN
         vdfact(i,j,1) = vfactor(l, isnap) + vdfact(i,j,1)
        ELSE

            DO WHILE( ((nmmb_hgt(k)   - em_hgt(l)) *       &
             (nmmb_hgt(k+1) - em_hgt(l)) > 0.0E0).AND. (k<(nlev+1)))

             k=k+1

            END DO

             DO y = check_k,k
              denom= k-check_k+1
             vdfact(i,j,y) = vfactor(l, isnap)/(denom) + vdfact(i,j,y)
            END DO

      IF ( ((nmmb_hgt(k+1)   - em_hgt(l)) > 0.0E0).AND.((nmmb_hgt(k+1)- em_hgt(l+1)) < 0.0E0)) k=k+1
     END IF
     END DO

     END DO
   END DO



!     if(MYPE==0)then
!       PRINT *,'vdfact:',vdfact(10,10,:)
!       PRINT *,'nmmb_hgt_in:',nmmb_hgt_in(10,:,10),FIS(10,10),G
!       PRINT *,'nmmb_hgt:',nmmb_hgt
!     endif


    RETURN

  END SUBROUTINE em_vert_dist


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

    IMPLICIT NONE

    INTEGER, INTENT(IN) :: IMS,IME,JMS,JME,LM,ITS,ITE,JTS,JTE

    REAL, DIMENSION(IMS:IME,JMS:JME,1:LM,spec_tno_ant), INTENT (in)      :: emi_tot_in

    REAL, DIMENSION(IMS:IME,JMS:JME,1:LM,spec_cb05) , INTENT (out)       :: emi_cb05

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

    INTEGER                                                         :: i,j,k

     DO i=1, spec_tno_ant
      emi_tot(:,:,:,i)=(emi_tot_in(:,:,:,i)*1.0E+6)/Mol_weig(i)  ! Convert units Mg/(km2 *hour) -> moles/(km2 *hour)

     END DO

!CO
!NO2
!NO
!SO2
!PAR= 1.5 propane +4 butane +5 pentane+ 6hexanes + 1 propene +1 ethyne +2 other
!alkenes + 1 benzene + 1 trimethylbenzene + 2 alkoxy alkanes +4 other alkanals +
!3 ketones +1 acids (alkanoic) +1 other nmvocs
!OLE= 1 propene + 1 other alkenes
!TOL= 1 methylbenzene + 0.25 other aromatics
!XYL= 1 dimethylbenzene + 1 trimethylbenzene +0.75 other aromatics
!FOR = 1 formaldehyde
!ETH=1 ethene
!ISOP= 1 isoprene
!MEOH= alcohols
!NR= 1.5 propane +1 ethene +1 ethyne + 5 benzene + 1 esters + 1 acids+ 1 acetonitrile
!ETHA= 1 ethane
!TERP= 1 monoterpenes
!NH3

         DO k = 1,LM !1, nlev
           DO j = JTS,JTE !1, nlat
             DO i = ITS,ITE !1, nlon
              emi_cb05 (i,j,k,1)  = emi_tot (i,j,k,1)                                                                            !CH4
               emi_cb05 (i,j,k,2)  = emi_tot (i,j,k,2)                                                                           !CO
               emi_cb05 (i,j,k,3)  = emi_tot (i,j,k,3)                                                                           !NO2
               emi_cb05 (i,j,k,4)  = emi_tot (i,j,k,4)                                                                           !SO2
               emi_cb05 (i,j,k,5)  = 1.5*emi_tot (i,j,k,7)+ 4*emi_tot(i,j,k,8)+ 5*emi_tot(i,j,k,9)+6*emi_tot(i,j,k,10)   &       !PAR
               +emi_tot(i,j,k,12)+emi_tot(i,j,k,13)+ 2*emi_tot(i,j,k,16)+  emi_tot(i,j,k,17)                             & 
               +emi_tot(i,j,k,20)+ 2.25*emi_tot(i,j,k,21)+ emi_tot(i,j,k,22)+ 2*emi_tot(i,j,k,23)+ 4*emi_tot(i,j,k,25)   &
                       + 3*emi_tot(i,j,k,26)+emi_tot(i,j,k,21)+emi_tot(i,j,k,28)
               emi_cb05 (i,j,k,6)  = emi_tot(i,j,k,12)+emi_tot(i,j,k,16)                                                          !OLE
               emi_cb05 (i,j,k,7)  = emi_tot(i,j,k,18)+0.25*emi_tot(i,j,k,21)                                                     !TOL
               emi_cb05 (i,j,k,8)  = emi_tot(i,j,k,19)+emi_tot(i,j,k,20)+0.75*emi_tot(i,j,k,21)                                   !XYL
               emi_cb05 (i,j,k,9)  = emi_tot(i,j,k,24)                                                                            !FOR
               emi_cb05 (i,j,k,10)  = emi_tot(i,j,k,11)                                                                           !ETH
               emi_cb05 (i,j,k,11)  = emi_tot(i,j,k,14)                                                                           !ISOP
               emi_cb05 (i,j,k,12)  = emi_tot(i,j,k,5)                                                                            !MEOH
               emi_cb05 (i,j,k,13)  = 1.5*emi_tot(i,j,k,7)+emi_tot(i,j,k,11)+ emi_tot(i,j,k,13) + 5*emi_tot(i,j,k,17) + &           !NR
                  emi_tot(i,j,k,22)+emi_tot(i,j,k,27) +emi_tot(i,j,k,28) 
               emi_cb05 (i,j,k,14)  = emi_tot(i,j,k,6)                                                                            !ETHA
               emi_cb05 (i,j,k,15)  = emi_tot(i,j,k,15)                                                                           !TERP
               emi_cb05 (i,j,k,spec_cb05)  = emi_tot(i,j,k,spec_tno_ant)                                                           !NH3
          END DO
        END DO
      END DO

 END SUBROUTINE



!  SUBROUTINE READ_NC(emis_ant1)

!!     use netcdf

!      INTEGER                                                           :: ncid,i
!      INTEGER                                                           :: emi_id
!      INTEGER                                                           :: num
!      REAL,  DIMENSION(nlon,nlat,num_tno_ant,spec_tno_ant)              :: emis_ant1
!      REAL , DIMENSION(nlon,nlat,32)                                    :: pollut
!      integer :: start(3), count(3)
!      character(len=50) :: snap(num_tno_ant)
!      REAL, DIMENSION(spec_tno_ant)                                    :: selec_tno
!      CHARACTER(len=300), PARAMETER :: &
!      emiss_path ='../RDATA/NC/REMAP_NMMB/'
!!      emiss_path='/scratch/home/developer/ALBA/AQMEII/EMIS/PHASE2/RDATA/NC/REMAP_NMMB/'
!
!      CHARACTER(len=300)                                                   :: fname
!      INTENT (out)                                                         emis_ant1
!
!
!     DATA selec_tno /2,4,4,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23, &
!                    24,25,26,28,29,30,31,32 /
!
!
!      snap(1)= '1'
!      snap(2)='2'
!      snap(3)='34'
!      snap(4)='5'
!      snap(5)='6'
!      snap(6)='71'
!      snap(7)='72'
!      snap(8)='73'
!      snap(9)='74'
!      snap(10)='75'
!      snap(11)='8'
!      snap(12)='9'
!      snap(13)='10'
!
!      emis_ant1=0.
!
!      DO num =1, num_tno_ant
!
!!      fname =TRIM(emiss_path)//TRIM('remap_tno_emi_2010')//TRIM(snap(num))//TRIM('.nc') !Mg
!
!      fname=TRIM(emiss_path)//TRIM('remap_tno_area_0')//TRIM(snap(num))//TRIM('.nc')  !Mg/m2
!
!!*     1. Open the netCDF file
!!*     -----------------------
!      PRINT*, 'Reading file: ', TRIM(fname)
!      call check(nf90_open(TRIM(fname), nf90_nowrite, ncid))
!
!      call check(nf90_inq_varid(ncid,"emi",emi_id))
!
!      count = (/nlon, nlat, 32/)
!      start = (/ 1, 1, 1 /)
!      print*,'Get athropogenic values'
!      call check(nf90_get_var(ncid,emi_id,pollut,start,count))
!
!      call check(nf90_close(ncid))
!
!     !We are interesed in only these variables:
!
!     DO i=1, spec_tno_ant
!      emis_ant1(:,:,num,i) = pollut(:,:,selec_tno(i))*1.0e6  !Convert units: m2 to km2
!       IF (i.EQ.2) emis_ant1(:,:,num,i) = emis_ant1(:,:,num,i)* 5/100
!       IF (i.EQ.3) emis_ant1(:,:,num,i) = emis_ant1(:,:,num,i)* 95/100
!    END DO
!     !-> m2 to km2
!
!      PRINT*, "*** SUCCESS reading file ", fname, "!",maxval(emis_ant1(:,:,num,15)), maxval(pollut(:,:,18))
!
!!      print*,emis_ant1(149,120,num,1), num, selec_tno(1)
!    END DO     ! End loop of read emi-snaps nc files
!
!   DO i=1,nlon
!     DO j=1,nlat
!      DO k=1,spec_tno_ant
!       DO l=1,num_tno_ant
!
!      if(emis_ant1(i,j,l,k).LT.0) emis_ant1(i,j,l,k)=0
!
!      END DO
!      END DO
!     END DO
!    END DO
!
!   RETURN
!
! END SUBROUTINE READ_NC
!

!  SUBROUTINE READ_NC_lon(lon1)
!
!     use netcdf
!
!      INTEGER                                                           :: ncid
!      INTEGER                                                           :: emi_id
!      INTEGER                                                           :: num
!      REAL,  DIMENSION(nlon,nlat), INTENT(out)              :: lon1
!      integer :: start(2), count(2)
!!      REAL, ALLOCATABLE, DIMENSION(:,:,:)                              ::
!!      pollut
!!      Declare functions and variables associated with the netCDF library
!!c       integer NF_OPEN,NF_NOWRITE,NF_INQ_DIMID,NF_INQ_VARID,NF_INQ_DIMLEN
!!c       integer NF_GET_VARA_REAL,NF_CLOSE
!
!!     '1' ,'2', '34' ,'5' ,'6' ,'71' ,'72' ,'73','74' ,'75' ,'8','9','10' /
!
!      CHARACTER(len=300), PARAMETER :: &
!      fname ='../../../pout_regional_sigm_at_t_01.nc'
!!      emiss_path='/scratch/home/developer/ALBA/AQMEII/EMIS/PHASE2/RDATA/NC/REMAP_NMMB/'
!
!!*     1. Open the netCDF file
!!*     -----------------------
!      PRINT*, 'Reading longitude: ', TRIM(fname)
!      call check(nf90_open(TRIM(fname), nf90_nowrite, ncid))
!
!      call check(nf90_inq_varid(ncid,"lon",lon_id))
!
!      count = (/nlon, nlat/)
!      start = (/ 1, 1 /)
!      print*,'Get lon values'
!      call check(nf90_get_var(ncid,lon_id,lon1,start,count))
!
!      call check(nf90_close(ncid))
!
!
!      PRINT*, "*** SUCCESS reading file ", fname, "!"
!!      print*,pollut(149,120,1)
!
!
!   RETURN
!
! END SUBROUTINE READ_NC_lon



  SUBROUTINE check(status)

!    USE netcdf

    INTEGER, INTENT (in) :: status
    
    IF(status /= nf90_noerr) THEN 
      PRINT*, nf90_strerror(status)
      STOP "Stopped"
    END IF

  END SUBROUTINE check

END MODULE MODULE_BSC_CHEMISTRY_EMISSION_AQMEII
