MODULE module_bioemi_megan2
! WRF-Chem MEGAN v2.04 code adapted for MONARCH

!WRF was developed at the National Center for Atmospheric Research (NCAR)
!which is operated by the University Corporation for Atmospheric Research
!(UCAR). NCAR and UCAR make no proprietary claims, either statutory or
!otherwise, to this version and release of WRF and consider WRF to be in
!the public domain for use by any person or entity for any purpose without
!any fee or charge. UCAR requests that any WRF user include this notice on
!any partial or full copies of WRF. WRF is provided on an "AS IS" basis and
!any warranties, either express or implied, including but not limited to
!implied warranties of non-infringement, originality, merchantability and
!fitness for a particular purpose, are disclaimed. In no event shall UCAR be
!liable for any damages, whatsoever, whether direct, indirect, consequential
!or special, that arise out of or in connection with the access, use or
!performance of WRF, including infringement actions.

  USE module_data_megan2

  ! MEGAN v2.04 Emissions Module for WRF-Chem
  !
  !  Reference: 
  !
  !    Estimates of global terrestial isoprene emissions using MEGAN
  !    (Model of Emissions of Gases and Aerosols from Nature )
  !    A. Guenther, T. Karl, P. Harley, C. Wiedinmyer, P.I. Palmer, and C. Geron
  !    Atmospheric Chemistry and Physics, 6, 3181-3210, 2006.
  !
  !    MEGAN v2.0 Documentation
  !
  !
  ! August 2007
  !
  ! Serena H. Chung          Washington State University
  ! Tan Sakulyanontvittaya   University of Colorado
  ! Christine Wiedinmyer     National Center for Atmospheric Research
  !
  !
  !  11/08/2007 SHC Took out some "if (ktau ==1) then ... end if " statements
  !

  !...conversion between radians and degrees
  REAL, PARAMETER, PRIVATE :: PI = 3.14159
  REAL, PARAMETER, PRIVATE :: D2RAD = PI/180.0

CONTAINS

  SUBROUTINE bio_emissions_megan2(ktau,dtstep,dtchem,                  &
       curr_secs,julday,gmt,xlat,xlong,p_phy,rho_phy,dz8w,             &
       chem, num_gas, ne_area,                                         &
       current_month,                                                  &
       T2,swdown,                                                      &
       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, kts,kte                                  )


    USE module_data_mgn2mech
    USE MODULE_DM_PARALLEL, ONLY : MYPE_SHARE
    USE MODULE_BSC_CHEM_DATA, ONLY :     &
                             P_NO        &
                            ,P_FORM      &
                            ,P_ALD2      &
                            ,P_ALDX      &
                            ,P_PAR       &
                            ,P_CO        &
                            ,P_MEOH      &
                            ,P_OLE       &
                            ,P_ETH       &
                            ,P_IOLE      &
                            ,P_TOL       &
                            ,P_ISOP      &
                            ,P_TERP      &
                            ,P_ETOH      &
                            ,P_PINENE_A  &
                            ,MECH

    IMPLICIT NONE

    ! Subroutine arguments

    ! ...domain id, current time step counter, xyz indices ..
    INTEGER,   INTENT(IN   ) :: ktau,                               &
         ids,ide, jds,jde,lm,                                          & 
         ims,ime, jms,jme, kms,kme,                                    &
         its,ite, jts,jte, kts,kte, num_gas

    ! ...current julian day
    INTEGER, INTENT (IN) :: julday   
    !...GTM hour of start of simulation, time step in seconds
    REAL, INTENT(IN) :: gmt,dtstep,dtchem

    ! ...number of seconds into the simulation
    REAL(KIND=8), INTENT(IN) :: curr_secs

    ! ...3rd dimension size of array e_bio
    INTEGER, INTENT (IN) :: ne_area

    !...pressure (Pa)
    REAL,  DIMENSION( its:ite , kms:kme , jts:jte ),                   &
         INTENT(IN) :: p_phy

    !...latitude and longitude (degrees)
    REAL,  DIMENSION( its:ite , jts:jte ),                             &
         INTENT(IN) :: xlat, xlong

    !... air density (kg air/m3)
    REAL, DIMENSION( its:ite, kms:kme, jts:jte ),                      &
         INTENT(IN) :: rho_phy

    !...full layer height (m)
   REAL,  DIMENSION( its:ite , kms:kme , jts:jte )         ,           &
          INTENT(IN) :: dz8w

    !...2-meter temperature (K)
    REAL,  DIMENSION( ims:ime , jms:jme ),                             &
         INTENT(IN) :: T2

    !...downward shortwave surface flux (W/m2)
    REAL,  DIMENSION( ims:ime , jms:jme ),                             &
         INTENT(IN) :: swdown                                    

    !...Number of MEGAN v2.04 species as specified by the namelist 
    !...variable nmegan; nmegan should equal n_spca_spc (this will
    !...be checked later.)  Currently nmegan=n_spca_spc=138.
    INTEGER, PARAMETER :: nmegan=138
    
    !...Emissions factors for nmegan=n_spca_spc=138 MEGAN v2.04 species
    REAL, DIMENSION (ims:ime, jms:jme , nmegan) :: EFmegan       

    !...Emission factor for isoprene (read in from file
    !...(wrfbiochemi_d<domain>)
    !...(moles compound/km^2/hr)
    REAL,  DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: msebio_isop

    !...Plant functional group percentage  (read in from file
    !...(wrfbiochemi_d<domain>)
    REAL, DIMENSION ( ims:ime , jms:jme ), INTENT(IN) :: pftp_bt, pftp_nt, pftp_sb, pftp_hb


    !..."Climatological" Leaf area index  (read in from file
    !...(wrfbiochemi_d<domain>)
    REAL,  DIMENSION( ims:ime , jms:jme , 12 ), INTENT(IN) :: mlai

    !..."Climatological" surface air temperature (K) (read in from file
    !...(wrfbiochemi_d<domain>)
    REAL,  DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: mtsa

    !..."Climatological" downward radiation (W/m2) (read in from file
    !...(wrfbiochemi_d<domain>)
    REAL, DIMENSION ( ims:ime , jms:jme ), INTENT(IN) :: mswdown

    !...Actual emissions for a few selected species as diagnostics, using
    !...MEGAN v2.0 classes of species classification
    !...(mol km-2 hr-1)

    !...Actual biogenic emissions, converted to mechanisms species.
    !...(ppm m/min)
   REAL, DIMENSION( its:ite, jts:jte, ne_area ),                       &
         INTENT(INOUT ) :: e_bio

    !...Actual biogenic emissions, converted to mechanisms species.
    !...These variables were originally for BEIS3.11 biogenic emissions
    !...modules.
    !...(moles compound/km^2/hr)

    !...Array of chemical concentrations
    !...  in  - concentrations before biogenic emissions
    !...  out - concentrations after biogeniec emissions
    !... gas-phace concentrations are in ppm
    REAL, DIMENSION( its:ite, jts:jte, kms:kme, num_gas ),            &
         INTENT(INOUT) :: chem

    !...Current month
    INTEGER, INTENT(IN) :: current_month

    ! Local parameters

    !...Below which set emissions rate to zero (mol km-2 hr-1)
    REAL, PARAMETER :: min_emis = 0.001
    

    !...number of days in each month
    INTEGER, PARAMETER :: DaysInMonth(12) = (/   &
         31,28,31,30,31,30,31,31,30,31,30,31 /)


    ! Local Scalars

    INTEGER :: i,j,k,i_class, i_spc, icount, p_in_chem
    INTEGER :: previous_month

    !...minutes since start of run to the middle of the
    !...current times step (seconds included as decimals)
    REAL(KIND=8) :: xtime
 
    !...the GMT hour of the middle of the current time step
    !...(can be greater than 24)
    INTEGER :: ixhour
    REAL(KIND=8) :: xhour

    !...minutes past the previous hour mark, at the
    !...middle of the current time step
    REAL :: xmin

    !...the GMT hour of the middle of the current time step
    !...(between 0 and 24)
    REAL :: gmtp

    !...GMT hour plus minutes (in fractaionl hour) of the middle
    !...of the current time step
    REAL :: tmidh

    !...Current and previous month leaf area index
    REAL :: LAIc, LAIp

    !...temperature((K) and pressure (mb)
    REAL :: tsa, tsa24, pres

    !...latitude and longitude (degrees)
    REAL :: lat, lon

    !...downward solar radiation, current and some 24-hour mean (W/m2)
    REAL :: swd, swd24
    !...photosynthetic photon flux density (i.e. PPDF or PAR)  
    !...(micromole m-2 s-1)
    REAL :: par, par24, pardb, pardif

    !...solar zenith angle (radians), cosine of zenith angle
    REAL :: zen , coszen

    !...days in the previous month
    REAL :: tstlen

    !...emissions factor (microgram m-2 hr-1)
    REAL :: epsilon

    !...MEGAN v2.04 emissions adjustment factors for leaf area, temperature,
    !...light, leaf age, and soil moisture
    !...(dimensionless)
    REAL :: gam_LHT, gam_TMP, gam_PHO,gam_AGE, gam_SMT

    !...normalized ratio accounting for production and loss within 
    !...plant canopies (dimensionless)
    REAL :: rho

    !...Some light-dependent factor (dimensionless)
    REAL :: ldf

    !...conversion factor to convert emissions rates in 
    !...mol km-2 hr-1 to concentrations in ppm
    REAL :: emis2ppm

    !...conversion factor from mol km-2 hr-1 to ppm m min-1
    REAL :: convert2

    !...emission rate converted to mechanism species in mol km-2 hr-1
    REAL :: gas_emis

    ! Local Arrays

    !...emissions adjustment factors for n_mgn_spc=20 classes of
    !...MEGAN v2.04 specie.
    !...adjust_factor = [GAMMA]*[rho] (see comments later)
    !...(dimensionless)
    REAL, DIMENSION(n_mgn_spc) :: adjust_factor

    !...plant functional type fractions
    REAL :: pft_frac(n_pft)

    !...actually emissions rates of n_spca_spc=138 MEGAN v2.04 species
    !...(mol km-2 hr-2)
    REAL, DIMENSION ( n_spca_spc ) :: E_megan2

      LOGICAL, SAVE :: FIRSTIME = .TRUE.   ! flag for first pass thru

    ! End header ------------------------------------------------------


    ! MEGAN v2.04 has nmegan=n_spca_spc=138 species, which are lumped 
    ! into n_mgn_spc=20 classes.  The number, names and indices of
    ! these classes and species are defined in module_data_megan2.F.
    ! They need to follow a few rules
    
    IF ( FIRSTIME ) THEN 

       ! The size of variable EFmegan(:,:,nmegan) is allocated based on
       ! the value of namelist variable nmegan.  nmegan should be equal
       ! to n_spca_spc (though can be greater than to n_spca_spc).
       IF ( nmegan .NE. n_spca_spc ) THEN
      IF(MYPE_SHARE==0)THEN
        WRITE(0,*) 'namelist variable nmegan does not match n_spca_spc'
      ENDIF
       END IF

       ! For programming, the ordering of the  species or classes of
       ! species should not matter, except that isoprene should always
       ! be first; therefore, imgn_isop=1 and is_isoprene=1 always.
       IF ( (imgn_isop .NE. 1) .OR. (is_isoprene .NE. 1) ) THEN
      IF(MYPE_SHARE==0)THEN
        WRITE(0,*) 'imgn_isop and is_isoprene in bio_emissions_megan should be 1'
      ENDIF
       END IF


        FIRSTIME = .FALSE.
    END IF


    ! Initialize diagnostic output
    e_bio     ( its:ite , jts:jte , 1:ne_area) = 0.0
    
    !...the following is redundant if there is no
    !...bug in the subroutine


    ! Extract climatological values for relevant months.
    !
    !  In MEGAN v2.04, emissions rates dependent on ambient conditions
    !  of the past 24 hours to the past month or so. The implementation
    !  of MEGAN v2.04 here uses monthly-mean values of the previous
    !  month for any past history required by the model.  The monthly-
    !  -mean values should be provided as input in the
    !  wrfbiochemi_d<domain> file.  Fully implementation (not done here)
    !  require online calculations of 24-hour and 240-hour mean of
    !  surface air temperature and downward PAR
    !
    !  MEGAN v2.04 also requires time-dependent leaf area index to
    !  estimate leaf age.  Here, leaf area indices of the current
    !  and the previous months are used.  The data should be
    !  provided in wrfbiochemi_d<domain> file.

    IF (current_month > 1) THEN
       previous_month = current_month -1
    ELSE
       previous_month = 12
    END IF


    ! Following module_phot_fastj.F, determine current
    ! time of day in GMT at the middle of the current 
    ! time step, tmidh.
    !     ktau  - time step counter
    !     dstep - time step in seconds
    !     gmt   - starting hour (in GMT) of the simulation

    !...minutes since start of run to the middle of the
    !...current times step (seconds included as decimals)
    !(old way in r4 this will fail in about 2 yrs)...
!    xtime=(ktau-1)*dtstep/60. + dtstep/120.
    xtime = (ktau*dtstep)/60._8 + real(dtchem/120.,8)
    !...the GMT hour of the middle of the current time step
    !...(can be greater than 24)
    ixhour = int(gmt + 0.01) + int(xtime/60._8)
    xhour=real(ixhour,8)
    !...minutes past the previous hour mark, at the
    !...middle of the current time step
    xmin = 60.*gmt + real(xtime-xhour*60._8,8)
    !...the GMT hour of the middle of the current time step
    !...(between 0 and 24)
    gmtp=MOD(xhour,24._8)
    !...GMT hour plus minutes (in fractaionl hour) of the middle
    !...of the current time step
    tmidh= gmtp + xmin/60.

      IF(MYPE_SHARE==0)THEN
        WRITE(0,*) 'calculate MEGAN emissions at ktau, gmtp, tmidh = ',ktau, gmtp, tmidh, curr_secs, dtstep, ixhour, xhour, xmin
      ENDIF

    ! Get the mechanism converstion table
    ! ( Even though the mechanism converstion table is time-independent,
    ! do this for all time steps to be sure there will be no issue with 
    ! restart runs.  This should be edited eventually to reduce 
    ! redundant calculations.)
    ! SHC  (11/08/2007)
!MONARCH
        IF(MECH.EQ.22.OR.MECH.EQ.3.OR.MECH.EQ.37)THEN
          CALL get_megan2cbm05_table
        ELSEIF(MECH.EQ.6.OR.MECH.EQ.7)THEN
          CALL get_megan2sulsoa_global_table
        ENDIF
!MONARCH

    ! Calcuate biogenic emissions grid by grid

    j_loop: DO j = jts, jte
       i_loop: DO i = its, ite


          ! Put variables of ambient conditions into scalar variables

          tsa   = T2(i,j)                     ! air temperature at 2-meter (K)
          pres  = 0.01*p_phy(i,kts,j)         ! surface pressure (mb)
          lat   = xlat(i,j)                   ! latitude (degree) 
          lon   = xlong(i,j)                  ! longitude (degress)
          swd   = swdown(i,j)                 ! downward solar radiation (W/m2)
          LAIc  = mlai(i,j,current_month)     ! current month leaf area index
          LAIp  = mlai(i,j,previous_month)    ! previous month leaf area index

          !...Emissions are dependent on the ambient conditions in the last
          !...24 to 240 hours; here, use input data for monthly mean of the
          !...the previous month
          tsa24 = mtsa    (i,j) ! [=]K
          swd24 = mswdown (i,j) ! [=] W/m2

          !...Perform checks on max and min bounds for temperature
          IF (tsa .LT. 200.0) THEN
      IF(MYPE_SHARE==0)THEN
        WRITE(0,*) 'temperature too low at i,j:',i,j
      ENDIF
          END IF
          IF (tsa .GT. 315.0 ) THEN
      IF(MYPE_SHARE==0)THEN
        WRITE(0,*) 'temperature too high at i,j:',i,j
      ENDIF
             tsa = 315.0
          END IF

!          !...Calculate zenith angle (in radians)
!          !...(NOTE: nonstandard longitude input here: >0 for W, <0 for E!!)
!          !...(subroutine calc_zenithb is in module_bioemis_beis313.F)
!          CALL calc_zenithb(lat,-lon,julday,tmidh,zen)
!          coszen = COS(zen)

          !....Convert downward solar radiation to photosynthetically
          !....active radiation

!          !......(subroutine getpar is in module_bioemis_beis313.F)
!          CALL getpar( swd, pres, zen, pardb, pardif )
!          par = pardb + pardif ! micro-mole/m2/s

          !......assume 4.766 (umol m-2 s-1) per (W m-2)
          !......assume 1/2 of swd is in 400-700 nm band
          par = 4.766 * 0.5 * swd

          !......Check max/min bounds of PAR
          IF ( par .LT. 0.00 .OR. par .GT. 2600.0 ) THEN
      IF(MYPE_SHARE==0)THEN
        WRITE(0,*) 'par out of range at i,j:',i,j
      ENDIF
          END IF

          !......For the 24-avg PAR, 
          !......assume 4.766 (umol m-2 s-1) per (W m-2)
          !......assume 1/2 of swd is in 400-700 band
          par24 = swd24 * 4.766 * 0.5

          IF ( par24 .LT. 0.00 .OR. par24 .GT. 2600.0 ) THEN
      IF(MYPE_SHARE==0)THEN
        WRITE(0,*) 'par24 out of range at i,j:',i,j
      ENDIF
          END IF

          ! ------------------------------------------------------------
          !
          !  MEGAN v2.04 Box Model
          !
          !  Reference: 
          !
          !    Estimates of global terrestial isoprene emissions using MEGAN
          !    (Model of Emissions of Gases and Aerosols from Nature )
          !    A. Guenther, T. Karl, P. Harley, C. Wiedinmyer, 
          !    P.I. Palmer, and C. Geron
          !    Atmospheric Chemistry and Physics, 6, 3181-3210, 2006      
          !
          !    MEGAN v2.0 Documentation
          !
          !
          !  The following code is based on Tan's megan.F dated 11/21/2006
          !
          !   Scientific algorithm
          !
          !           Emission = [epsilon][gamma][rho]
          !
          !         where [epsilon] = emission factor (usually um m-2 hr or mole km-2 hr-1)
          !               [gamma]   = emission activity factor (dimensionless)
          !               [rho]     = production and loss within plant canopies
          !                         (dimensionless)
          !
          !            [gamma]  = [gamma_CE][gamma_age][gamma_SM]
          !
          !         where [gamma_CE]  = canopy correction factor
          !               [gamma_age] = leaf age correction factor
          !               [gamma_SM]  = soil moisture correction factor
          !
          !            [gamma_CE] = [gamma_LAI][gamma_T]((1-LDF) + LDF*[gamma_P] )
          !                      
          !         where [gamma_LAI] = leaf area index factor
          !               [gamma_P]   = PPFD emission activity factor
          !               [gamma_T]   = temperature response factor
          !               LDF         = 
          !
          !           Emission = [epsilon][gamma_LAI][gamma_T][gamma_age]
          !                      x ((1-LDF) + LDF*[gamma_P] )[rho]
          !
          !     or
          ! 
          !           Emission = adjust_factor [epsilon]
          !
          !         where
          !
          !           adjust_fact = [gamma_LAI][gamma_T][gamma_age]((1-LDF) + LDF*[gamma_P] )[rho]


          !
          ! Calculate the dimensionless emission adjustment factor. 
          ! MEGAN v2.04 has n_spca_spc = 138 species.  These species are 
          ! lumped into n_mgn_spc=20 classes.  The emission adjustment
          ! factors are different for the 20 classes of species.
          !
          ! NOTE: This version of the code contains the corrected equation for 
          ! gamma P (based on a revised version of equation 11b from Guenther et al., 2006)
          ! CW (08/16/2007)
          !
          ! NOTE: This version of the code contains the updated emission factors (static)
          ! and beta values based on Alex's V2.1 notes sent out on August 13, 2007
          ! CW (08/16/2007)
          ! 
          ! NOTE: This version of the code applies the same gamma T equation to the 
          ! emissions of all compounds other than isoprene. This occurs regardless 
          ! of whether the emissions are light dependent or not. This is NOT the same 
          ! as what Alex has in his code. In his code, the light-dependent emissions
          ! are also given the isoprene gamma T. Because all emissions (other than isoprene
          ! are assigned the same gamma T, this could lead to overestimates of emissions
          ! at high temperatures (>40C). Light-dependent emisisons (e.g., SQTs) should
          ! fall off at high temperatures. (CW, 08/16/2007)

          !...Calculate adjustment factor components that are species-independent

          !......Get the leaf area index factor gam_LHT
          CALL GAMMA_LAI( LAIc, gam_LHT)

          !......Get the light emission activity factor gam_PHO
          CALL GAMMA_P( julday, tmidh, lat, lon, par, par24, gam_PHO )

          !......Get the soil moisture factor gam_SMT
          !......for now, set = 1.0
          gam_SMT = 1.0

          !...Calculate the overall emissions adjustment factors, for
          !...each of the n_mgn_spc=20 classes of compounds

          DO i_class = 1, n_mgn_spc
             
             ! Get the temperature response factor gam_TMP
             !  One algorithm for isoprene, and one for non-isoprene

             IF ( i_class == imgn_isop ) THEN
                CALL GAMMA_TISOP( tsa, tsa24, gam_TMP )
             ELSE
                CALL GAMMA_TNISP( i_class , tsa, gam_TMP  )
             END IF

             ! Get the leaf age correction factor gam_AGE

             !...Time step (days) between LAIc and LAIp:
             !...Since monthly mean LAI is used,
             !...use # of days in the previous month
             tstlen = REAL(DaysInMonth(previous_month),KIND(1.0))

             CALL GAMMA_A( i_class , LAIp, LAIc, TSTLEN, tsa24, gam_AGE )

             ! rho - normalized ratio accounting for production and
             ! oss within plant canopies; rho_fct is defined in 
             ! module_data_megan2.F; currently rho_fct = 1.0 for all 
             ! species (dimensionless)
             rho = rho_fct(i_class)

             ! Fraction of emission to apply light-dependence factor
             ! ldf_fct is defined in module_data_megan2.F
             ! (dimensionless)
             ldf = ldf_fct(i_class)

             ! The overall emissions adjustment factor
             ! (dimensionless)

             adjust_factor(i_class) = gam_TMP * gam_AGE * gam_LHT * gam_SMT * rho * &
                  ( (1.0-LDF) + gam_PHO*LDF )

          END DO !i_class = 1, n_mgn_spc (loop over classes of MEGAN species )


          ! For isoprene, the emission factor is already read in from
          ! wrfbiochemi_d<domain> file; therefore, actual emissions rate
          ! can be calculated here already.
          ! (mol km-2 hr-1)
          E_megan2(is_isoprene) = adjust_factor(imgn_isop)*msebio_isop(i,j)
          IF ( E_megan2(is_isoprene) .LT. min_emis ) E_megan2(is_isoprene)=0.


          ! Calculate emissions for all n_spca_spc=nmegan=138 MEGAN v2.04
          ! species, except for isoprene.  For non-isoprene emissions,
          ! the emission factor [epsilon] has to be calculated
          ! for the first time step.

          !...Loop over species, because emission factor [epsilon] is 
          !...different for each species
          !...( i_spc = 1 is skipped in the do loop below to skip 
          !...isoprene; this works because is_isoprene = 1 )
          DO i_spc = 2, n_spca_spc 

             ! The lumped class in which the current species is a member
             i_class = mg20_map (i_spc)

             ! Calculate emission factor (microgram m-2 hr-1) for 
             ! species i_spc 
             ! ( Even though EFmegan is time invariant, for now calculate
             ! EFmegan for every time step to be sure there will be
             ! no issue with restart runs.
             ! SHC  (11/08/2007)
!             IF ( ktau .EQ. 1 ) THEN

                ! Grab plant functional type fractions for current grid
                ! cell (pftp_* is the plant functional type % and was
                ! read in from wrfbiochemi_d<domain> file.)
                pft_frac(k_bt) = 0.01*pftp_bt(i,j)
                pft_frac(k_nt) = 0.01*pftp_nt(i,j)
                pft_frac(k_sb) = 0.01*pftp_sb(i,j)
                pft_frac(k_hb) = 0.01*pftp_hb(i,j)

                ! Sum up emissions factor over plant functional types
                epsilon = 0.0
                DO k = 1, n_pft !loop over plant functional types
                   epsilon = epsilon +                             &
                        pft_frac(k)*EF(i_class,k)*EF_frac(i_spc,k)
                END DO

                ! Store emission factor to variable EFmegan (which is
                ! declared in Registry/registry.chem)
                ! (migrogram m-2 hr-1)
                EFmegan(i,j,i_spc) = epsilon

!             END IF ! ( ktau .EQ. 1 )

             ! Calculate actual emission rate for species i_spc;
             ! also, convert units from (microgram m-2 hr-1) to 
             ! (mol km-2 hr-1)
             E_megan2(i_spc) = EFmegan(i,j,i_spc)*        &
                  adjust_factor(i_class)/spca_mwt(i_spc)
             IF ( E_megan2(i_spc) .LT. min_emis ) E_megan2(i_spc)=0.

          END DO !i_spc = 2, n_spca_spc, loop over all non-isoprene species


          ! Output emissions for some species as diagnostics
          ! (mol km-2 hr-1)


          ! Speciate the n_spca_spc=nmegan=138 species into
          ! the gas-phase mechanism species


          !...conversion factor to convert emissions rates in 
          !...mol km-2 hr-1 to concentrations in ppm
          !         0.02897 kg/mol is molecular of air
          !         rho_phy is air density in kg air/m3
          !         dz8w is layer height in meters
          !         dtchem is time step in seconds
          emis2ppm = 0.02897*dtchem/(rho_phy(i,kts,j)*dz8w(i,kts,j)*3600.)

          !...conversion factor from mol km-2 hr-1 to ppm m min-1
          !...(e_bio is in units of ppm m min-1)
          convert2 = 0.02897/(rho_phy(i,kts,j)*60.)


          !...

             DO icount = 1, n_megan2cbm05

                IF ( p_of_cbm05 (icount) .NE. non_react ) THEN

                   ! Get index to chem array for the corresponding CBMZ
                   ! species.
                   p_in_chem = p_of_cbm05(icount)

                      ! Emission rate of mechanism species in mol km-2 hr-1
                      gas_emis = cbm05_per_megan(icount) * E_megan2(p_of_megan2cbm05(icount))

                      ! Increase gas-phase concentrations (in ppmv) due to
                      ! biogenic emissions
!MSPADA8 S DEBUG
                      chem(i,j,kme,p_in_chem) = chem(i,j,kme,p_in_chem) + gas_emis * emis2ppm
!MSPADA8 E DEBUG
                      
                      ! Add emissions to diagnostic output variables.
                      ! ebio_xxx (mol km-2 hr-1) were originally used by the
                      ! BEIS3.11 biogenic emissions module.
                      ! I have also borrowed variable e_bio (ppm m min-1).
                      convert2=1.
!MONARCH
                    IF(MECH==2.OR.MECH==22.OR.MECH==3.OR.MECH==37)THEN
                      IF ( p_in_chem .EQ. p_isop ) THEN
                         e_bio(i,j,p_isop)   = e_bio(i,j,p_isop)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_terp) THEN
                         e_bio(i,j,p_terp)   = e_bio(i,j,p_terp)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_ole) THEN
                         e_bio(i,j,p_ole)   = e_bio(i,j,p_ole)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_par) THEN
                         e_bio(i,j,p_par)   = e_bio(i,j,p_par)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_meoh) THEN
                         e_bio(i,j,p_meoh)   = e_bio(i,j,p_meoh)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_no) THEN
                         e_bio(i,j,p_no)   = e_bio(i,j,p_no)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_ald2) THEN
                         e_bio(i,j,p_ald2)   = e_bio(i,j,p_ald2)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_etoh) THEN
                         e_bio(i,j,p_etoh)   = e_bio(i,j,p_etoh)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_form) THEN
                         e_bio(i,j,p_form)   = e_bio(i,j,p_form)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_aldx) THEN
                         e_bio(i,j,p_aldx)   = e_bio(i,j,p_aldx)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_tol) THEN
                         e_bio(i,j,p_tol)   = e_bio(i,j,p_tol)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_iole) THEN
                         e_bio(i,j,p_iole)   = e_bio(i,j,p_iole)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_co) THEN
                         e_bio(i,j,p_co)   = e_bio(i,j,p_co)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_etha) THEN
                         e_bio(i,j,p_etha)   = e_bio(i,j,p_etha)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_eth) THEN
                         e_bio(i,j,p_eth)   = e_bio(i,j,p_eth)  + gas_emis*convert2
                      ENDIF
                   ELSEIF(MECH==6)THEN
                      IF ( p_in_chem .EQ. p_pinene_a) THEN
                         e_bio(i,j,p_pinene_a)   = e_bio(i,j,p_pinene_a)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_isop) THEN
                         e_bio(i,j,p_isop)   = e_bio(i,j,p_isop)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_tol) THEN
                         e_bio(i,j,p_tol)   = e_bio(i,j,p_tol)  + gas_emis*convert2
                      ENDIF
                   ELSEIF(MECH==7)THEN
                      IF ( p_in_chem .EQ. p_pinene_a) THEN
                         e_bio(i,j,p_pinene_a)   = e_bio(i,j,p_pinene_a)  + gas_emis*convert2
                      ELSE IF ( p_in_chem .EQ. p_isop) THEN
                         e_bio(i,j,p_isop)   = e_bio(i,j,p_isop)  + gas_emis*convert2
                      ENDIF
                   ENDIF
!MONARCH
                END IF ! ( p_of_cbmz (icount) .NE. non_react )

             END DO


       END DO i_loop ! i = its, ite
    END DO j_loop    ! j = jts, jte

  END SUBROUTINE bio_emissions_megan2

    ! -----------------------------------------------------------------
    !  SUBROUTINE GAMMA_TISOP returns the GAMMA_T value for isoprene
    !  Orginally from Tan's gamma_etc.F
    ! -----------------------------------------------------------------

    SUBROUTINE GAMMA_TISOP( TEMP, D_TEMP, gam_T )
      !
      !  Description :
      !
      !    MEGAN biogenic emissions adjustment factor for temperature
      !    for isoprene
      !
      !  Reference: 
      !
      !    Estimates of global terrestial isoprene emissions using MEGAN
      !    (Model of Emissions of Gases and Aerosols from Nature )
      !    A. Guenther, T. Karl, P. Harley, C. Wiedinmyer, 
      !    P.I. Palmer, and C. Geron
      !    Atmospheric Chemistry and Physics, 6, 3181-3210, 2006      !
      !

      IMPLICIT NONE

      ! hourly surface air temperature (K)
      ! (here use instantaneous temperature
      REAL, INTENT(IN)  :: TEMP
      ! daily-mean surface airtemperature (K)
      ! (here use the previous month's monthly mean)
      REAL, INTENT(IN)  :: D_TEMP
      !temperature adjustment factor
      REAL, INTENT(OUT) :: gam_T

      ! Local parameters
      REAL :: Eopt, Topt, X
      REAL :: AAA, BBB
      REAL, PARAMETER :: CT1 = 80.0
      REAL, PARAMETER :: CT2 = 200.0
      
      ! End header ----------------------------------------------------

      ! Below Eqn (14) of Guenther et al. [2006]
      ! (assuming T_daily = D_TEMP)
      Eopt = 1.75 * EXP(0.08*(D_TEMP-297.0))

      ! Eqn (8) of Guenther et al. [2006]
      ! (assuming T_daily = D_TEMP)
      Topt = 313.0 + ( 0.6*(D_TEMP-297.0) )

      ! Eqn (5) of Guenther et al. [2006]
      X = ( (1.0/Topt)-(1.0/TEMP) ) / 0.00831
      AAA = Eopt*CT2*EXP(CT1*X)
      BBB = (  CT2-CT1*( 1.0-EXP(CT2*X) )  )
      gam_T = AAA/BBB

    END SUBROUTINE GAMMA_TISOP

    ! -----------------------------------------------------------------
    ! SUBROUITINE GAMMA_TNISP returns the GAMMA_T value for 
    ! non-isoprene species
    ! Originally from Tan's gamma_etc.F
    !------------------------------------------------------------------

    SUBROUTINE GAMMA_TNISP( SPCNUM, TEMP, gam_T )
      !
      !  Description :
      !
      !    MEGAN biogenic emissions adjustment factor for temperature
      !    for non-isoprene species.
      !
      !  Reference:
      !
      !    MEGAN v2.0 Documentation
      !
      ! Method:
      !
      !    GAMMA_T =  exp[BETA*(T-Ts)]
      !      where BETA   = temperature dependent parameter
      !            Ts     = standard temperature (normally 303K, 30C)
      !

      IMPLICIT NONE

      INTEGER, INTENT(IN) :: SPCNUM               ! Species number
      REAL, INTENT(IN)    :: TEMP
      REAL, INTENT(OUT)   :: gam_T
      REAL, PARAMETER     :: Ts = 303.0
      
      ! End header ----------------------------------------------------

      ! TDF_PRM is defined in module_data_megan2.F
      gam_T = EXP( TDF_PRM(SPCNUM)*(TEMP-Ts) )

    END SUBROUTINE GAMMA_TNISP


    ! --------------------------------------------------------------------
    ! SUBROUTINE GAMMA_LAI
    ! Originally from Tan's gamma_etc.F
    ! --------------------------------------------------------------------

    SUBROUTINE GAMMA_LAI(LAI, gam_L )
      !  Description :
      !
      !    MEGAN biogenic emissions adjustment factor for leaf area
      !    index
      !
      !  Reference: 
      !
      !    Estimates of global terrestial isoprene emissions using MEGAN
      !    (Model of Emissions of Gases and Aerosols from Nature )
      !    A. Guenther, T. Karl, P. Harley, C. Wiedinmyer, 
      !    P.I. Palmer, and C. Geron
      !    Atmospheric Chemistry and Physics, 6, 3181-3210, 2006      !
      !
      ! Method:
      !                       0.49[LAI]
      !        GAMMA_LAI = ----------------    (dimensionless)
      !                    (1+0.2LAI^2)^0.5
      !

      IMPLICIT NONE
      REAL, INTENT(IN)  ::  LAI 
      REAL, INTENT(OUT) :: gam_L

      ! End header ----------------------------------------------------

      
      ! Eqn (15) of Guenther et al. [2006]
      gam_L = (0.49*LAI) / ( SQRT(1.0+0.2*(LAI**2)) )

      RETURN
    END SUBROUTINE GAMMA_LAI

    !-------------------------------------------------------------------
    ! SUBROUTINE GAMMA_P 
    ! Originally from Tan's gamma_etc.F
    !-------------------------------------------------------------------
    SUBROUTINE GAMMA_P(             &
         DOY_in, tmidh, LAT, LONG,  &                    
         PPFD, D_PPFD, gam_P        &
         )
      !
      !  Description :
      !
      !    MEGAN biogenic emissions adjustment factor for
      !    photosynthetic photon flux density (PPFD or PAR)
      !
      !  Reference: 
      !
      !    Estimates of global terrestial isoprene emissions using MEGAN
      !    (Model of Emissions of Gases and Aerosols from Nature )
      !    A. Guenther, T. Karl, P. Harley, C. Wiedinmyer, 
      !    P.I. Palmer, and C. Geron
      !    Atmospheric Chemistry and Physics, 6, 3181-3210, 2006      
      !  
      !  Method:
      !
      !    GAMMA_P = 0.0         sin(a)<=0
      !
      !    GAMMA_P = sin(a)[2.46*0.9*PHI^3*(1+0.0005(Pdaily-400))]
      !                                  0<a<180
      !           where PHI = above canopy PPFD transmission (non-dimension)
      !           Pdaily    = daily average above canopy PPFD (umol/m2s)
      !              a      = solar angle (degree)
      !
      !         Note: AAA = 2.46*BBB*PHI-0.9*PHI^2
      !               BBB = (1+0.0005(Pdaily-400))
      !           GAMMA_P = sin(a)*AAA
      !
      !                       Pac
      !             PHI = -----------
      !                   sin(a)*Ptoa
      !
      !     where Pac  = above canopy PPFD (umol/m2s)
      !                 Ptoa = PPFD at the top of atmosphere (umol/m2s)
      !
      !             Pac =  SRAD * 4.766 mmmol/m2-s * 0.5
      !
      !             Ptoa = 3000 + 99*cos[2*3.14-( DOY-10)/365 )]
      !        where DOY = day of year (julian day)
      !
      ! NOTE: This code has been corrected. The gamma P equation as defined in the
      ! original Guenther et al., 2006 (equation 11b) is incorrect. This has the
      ! corrected algorithm. (CW, 08/16/2007)
      !-----------------------------------------------------------------

      IMPLICIT NONE

      INTEGER, INTENT(IN) :: DOY_in ! julian day at GMT

      ! GMT hour plus minutes (in fractaionl hour) of the middle
      ! of the current time step
      REAL, INTENT(IN)  :: tmidh
      REAL, INTENT(IN)  ::  LAT    ! Latitude [=] degrees
      REAL, INTENT(IN)  ::  LONG   ! Longitude [=] degrees
      REAL, INTENT(IN)  ::  PPFD   ! Photosynthetic Photon Flus Density
      REAL, INTENT(IN)  ::  D_PPFD ! Daily PPFD
      REAL, INTENT(OUT) ::  gam_P  ! GAMMA_P


      !...  Local scalars
      INTEGER :: DOY                 ! local julian day
      REAL :: HOUR                   ! solar hour
      REAL :: AAA, BBB
      REAL :: SIN_solarangle         ! sin(solar angle)
      REAL :: Ptoa, Pac, PHI

      ! End header ----------------------------------------------------

      ! Convert time of the middle of the current time step
      ! from GMT to solar hour (include minutes in decimals)
      DOY = DOY_in
      HOUR = tmidh + long/15.
      IF ( HOUR .LT. 0.0 ) THEN
         HOUR = HOUR + 24.0
         DOY  = DOY - 1
      ENDIF

      ! Above canopy photosynthetic photo flux density (PPFD)
      ! ( micromole/m2/s )
      Pac = PPFD
 
      ! Get sin of solar elevation angle
      CALL SOLARANGLE( DOY, HOUR, LAT, SIN_solarangle )

      ! Calculate gamma_p in Eqn (10) of Guenther et al. [2006]
      IF ( SIN_solarangle .LE. 0.0 ) THEN
         ! Eqn (11a) of Guenther et al. [2006]
         gam_P = 0.0
      ELSE
         ! PPFD at top of the atmosphere
         ! Eqn (13) of Guenther et al. [2006]
         ! ( micromole/m2/s )
         Ptoa = 3000.0 + 99.0 * COS( 2.*3.14*(DOY-10.)/365. )
         ! Above canopy PPFD transmission
         ! Eqn (12) of Guenther et al. [2006]
         ! (nondimensional)
         PHI = Pac/(SIN_solarangle * Ptoa)
         ! Eqn (11b) of Guenther et al. [2006]
         ! (Note: typo in the paper; correction made 08/06/2007)
         BBB = 1. + 0.0005*( D_PPFD-400. )
         AAA = 2.46 * BBB * PHI - 0.9 * (PHI**2)
         gam_P = SIN_solarangle * AAA

      ENDIF
      ! Screening the unforced errors
      ! IF solar elevation angle is less than 1 THEN
      ! gamma_p can not be greater than 0.1.
      IF (SIN_solarangle .LE. 0.0175 .AND. gam_P .GT. 0.1) THEN
         gam_P = 0.1
      ENDIF


    END SUBROUTINE GAMMA_P

    ! ----------------------------------------------------------------
    ! SUBROUTINE GAMMA_A returns GAMMA_A
    ! Originally from Tan's gamma_etc.F
    !------------------------------------------------------------------
    SUBROUTINE GAMMA_A( i_spc, LAIp, LAIc, TSTLEN, D_TEMP, gam_A )
      !  Description :
      !
      !    MEGAN biogenic emissions adjustment factor for leaf age
      !
      !  Reference: 
      !
      !    Estimates of global terrestial isoprene emissions using MEGAN
      !    (Model of Emissions of Gases and Aerosols from Nature )
      !    A. Guenther, T. Karl, P. Harley, C. Wiedinmyer, 
      !    P.I. Palmer, and C. Geron
      !    Atmospheric Chemistry and Physics, 6, 3181-3210, 2006
      !
      !    MEGAN v2.0 Documentation
      !
      !
      ! Method:
      !
      !     GAMMA_age = Fnew*Anew + Fgro*Agro + Fmat*Amat + Fold*Aold
      !      where Fnew = new foliage fraction
      !            Fgro = growing foliage fraction
      !                 Fmat = mature foliage fraction
      !                 Fold = old foliage fraction
      !                 Anew = relative emission activity for new foliage
      !                 Agro = relative emission activity for growing foliage
      !                 Amat = relative emission activity for mature foliage
      !                 Aold = relative emission activity for old foliage
      !
      !
      !             For foliage fraction
      !             Case 1) LAIc = LAIp
      !             Fnew = 0.0  , Fgro = 0.1  , Fmat = 0.8  , Fold = 0.1
      !
      !             Case 2) LAIp > LAIc
      !             Fnew = 0.0  , Fgro = 0.0
      !             Fmat = 1-Fold
      !             Fold = (LAIp-LAIc)/LAIp
      !
      !             Case 3) LAIp < LAIc
      !             Fnew = 1-(LAIp/LAIc)                       t <= ti
      !                  = (ti/t) * ( 1-(LAIp/LAIc) )          t >  ti
      !
      !             Fmat = LAIp/LAIc                           t <= tm
      !                  = (LAIp/LAIc) +
      !                      ( (t-tm)/t ) * ( 1-(LAIp/LAIc) )  t >  tm
      !
      !             Fgro = 1 - Fnew - Fmat
      !             Fold = 0.0
      !
      !           where
      !             ti = 5 + (0.7*(300-Tt))                   Tt <= 303
      !                = 2.9                                  Tt >  303
      !             tm = 2.3*ti
      !
      !             t  = length of the time step (days)
      !             ti = number of days between budbreak and the induction of
      !                  emission
      !             tm = number of days between budbreak and the initiation of
      !                  peak emissions rates
      !             Tt = average temperature (K) near top of the canopy during
      !                  current time period (daily ave temp for this case)
      !
      !
      !             For relative emission activity
      !             Case 1) Constant
      !             Anew = 1.0  , Agro = 1.0  , Amat = 1.0  , Aold = 1.0
      !
      !             Case 2) Monoterpenes
      !             Anew = 2.0  , Agro = 1.8  , Amat = 0.95 , Aold = 1.0
      !
      !             Case 3) Sesquiterpenes
      !             Anew = 0.4  , Agro = 0.6  , Amat = 1.075, Aold = 1.0
      !
      !             Case 4) Methanol
      !             Anew = 3.0  , Agro = 2.6  , Amat = 0.85 , Aold = 1.0
      !
      !             Case 5) Isoprene
      !             Anew = 0.05 , Agro = 0.6  , Amat = 1.125, Aold = 1.0


      IMPLICIT NONE

      ! SUBROUTINE arguments

      !..."Pointer" for class of species
      INTEGER, INTENT(IN) :: i_spc
      !...average temperature of the previous 24-hours
      REAL, INTENT(IN) :: D_TEMP
      !...leaf area index of the current and previous
      !...month
      REAL, INTENT(IN) :: LAIp, LAIc
      !...time step between LAIc and LAIp (days)
      REAL, INTENT(IN) ::     TSTLEN
      !...emissions adjustment factor accounting for leaf age
      REAL, INTENT(OUT) :: gam_A

      ! Local scalars

      !...leaf age fractions
      REAL :: Fnew, Fgro, Fmat, Fold
      !...relative emission activity index
      INTEGER ::  AINDX 
      !...time step between LAIC and LAIp (days)
      INTEGER :: t 
      !...number of days between budbreak and the induction emission
      REAL     ti
      !...number of days between budbreak  and the initiation of peak
      !...emissions rates
      REAL     tm
      !

      REAL     Tt                   ! average temperature (K)
      ! daily ave temp

      ! End header ----------------------------------------------------

      ! Choose relative emission activity class
      ! See Table 2 of MEGAN v2.0 Documentation
      !

      IF (      (i_spc==imgn_acto) .OR. (i_spc==imgn_acta) .OR. (i_spc==imgn_form)   &
           .OR. (i_spc==imgn_ch4)  .OR. (i_spc==imgn_no)   .OR. (i_spc==imgn_co)     &
           ) THEN
         AINDX = 1

      ELSE IF ( (i_spc==imgn_myrc) .OR. (i_spc==imgn_sabi) .OR. (i_spc==imgn_limo)   &
           .OR. (i_spc==imgn_3car) .OR. (i_spc==imgn_ocim) .OR. (i_spc==imgn_bpin)   &
           .OR. (i_spc==imgn_apin) .OR. ( i_spc==imgn_omtp)                          &
           ) THEN
         AINDX = 2

      ELSE IF ( (i_spc==imgn_afarn) .OR. (i_spc==imgn_bcar) .OR. (i_spc==imgn_osqt)  &
           ) THEN
         AINDX = 3

      ELSE IF (i_spc==imgn_meoh) THEN
         aindx = 4

      ELSE IF ( (i_spc==imgn_isop) .OR. (i_spc==imgn_mbo) ) THEN
         aindx = 5
      ELSE
      END IF



      ! Time step between LAIp and LAIc (days)
      t = TSTLEN
      ! Tt is the average ambient air temperature (K) of the preceeding time
      ! interval.  Here, use the monthly-mean surface air temperature
      Tt   = D_TEMP

      ! Calculate foliage fraction
      ! (section 3.2.2 of Guenther et al. [2006])
      IF (LAIp .EQ. LAIc) THEN
         Fnew = 0.0
         Fgro = 0.1
         Fmat = 0.8
         Fold = 0.1
      ELSEIF (LAIp .GT. LAIc) THEN
         Fnew = 0.0
         Fgro = 0.0
         Fold = ( LAIp-LAIc ) / LAIp
         Fmat = 1.0-Fold
      ELSE ! LAIp < LAIc
         ! Calculate ti, which is the number of days between budbreak and
         ! the induction of isoprene emission.
         IF (Tt .LE. 303.0) THEN
            ! Eqn (18a) of Guenther et al. [2006]
            ti = 5.0 + 0.7*(300.0-Tt)
         ELSE
            ! Eqn (18b) of Guenther et al. [2006]
            ti = 2.9
         ENDIF
         ! tm is the number of days between budbreak and the initiation
         ! of peak isoprene emissions rates.
         ! Eqn (19) of Guenther et al. [2006]
         tm = 2.3*ti

         ! Calculate Fnew and Fmat, then Fgro and Fold
         !  Fnew
         IF (t .LE. ti) THEN
            ! Eqn (17a) of Guenther et al. [2006]
            Fnew = 1.0 - (LAIp/LAIc)
         ELSE
            ! Eqn (17b) of Guenther et al. [2006]
            Fnew = (ti/t) * ( 1-(LAIp/LAIc) )
         ENDIF

         ! Fmat
         IF (t .LE. tm) THEN
            ! Eqn (17c) of Guenther et al. [2006]
            Fmat = LAIp/LAIc
         ELSE
            ! Eqn (17d) of Guenther et al. [2006]
            Fmat = (LAIp/LAIc) + ( (t-tm)/t ) * ( 1-(LAIp/LAIc) )
         ENDIF

         Fgro = 1.0 - Fnew - Fmat
         Fold = 0.0

      ENDIF

      !Calculate GAMMA_A
      ! Anew, Agro, Amat, Aold are defined in module_data_megan2.F
      gam_A = Fnew*Anew(AINDX) + Fgro*Agro(AINDX)    &
           + Fmat*Amat(AINDX) + Fold*Aold(AINDX)


    END SUBROUTINE GAMMA_A

    ! ----------------------------------------------------------------
    ! SUBROUTINE SOLARANGLE calculates the solar angle
    ! Originally from Tan's solarangle.F
    !------------------------------------------------------------------
    SUBROUTINE SOLARANGLE( DAY, SHOUR, LAT, SIN_solarangle )
      !
      !
      !   Input:
      !            1) Day of year
      !            2) Latitude
      !            3) Hour
      !
      !   Output: sin of solar angle
      !

      IMPLICIT NONE

      ! Arguments
      INTEGER, INTENT(IN) :: DAY                  ! DOY or julian day
      REAL, INTENT(IN)    :: SHOUR                ! Solar hour
      REAL, INTENT(IN)    :: LAT                  ! Latitude
      REAL, INTENT(OUT)   :: SIN_solarangle

      ! Local scalars
      REAL    :: sindelta, cosdelta, A, B

      ! End header -----------------------------------------------------

      sindelta = -SIN(0.40907) * COS( 6.28*(REAL(DAY,KIND(0.))+10.)/365. )
      cosdelta = SQRT(1.-sindelta**2.)

      A = SIN( LAT*D2RAD ) * sindelta
      B = COS( LAT*D2RAD ) * cosdelta

      SIN_solarangle = A + B * COS(2.*PI*(SHOUR-12.)/24.)


    END SUBROUTINE SOLARANGLE


!MONARCH
!----------------------------------------------------------------------
!----------------------------------------------------------------------
  SUBROUTINE 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                                           )
!----------------------------------------------------------------------
! READS CNST FIELDS isopEF, PFTP, LAIs, prevT, prevSWDOWN
! from:
!isop.dat   lai02.dat  lai04.dat  lai06.dat  lai08.dat  lai10.dat  lai12.dat   pft_hb.dat  pft_sb.dat
!lai01.dat  lai03.dat  lai05.dat  lai07.dat  lai09.dat  lai11.dat  pft_bt.dat  pft_nt.dat
!mtsa.dat   mswdonwn.dat
!----------------------------------------------------------------------
    USE MODULE_DM_PARALLEL, ONLY : MYPE_SHARE,MPI_COMM_COMP,DSTRB
    USE MODULE_EXCHANGE, ONLY    : HALO_EXCH
!----------------------------------------------------------------------
!MEGAN VARIABLES
    REAL,  DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: msebio_isop
    REAL, DIMENSION ( ims:ime , jms:jme ), INTENT(OUT) :: pftp_bt, pftp_nt, pftp_sb, pftp_hb
    REAL,  DIMENSION( ims:ime , jms:jme , 12 ), INTENT(OUT) :: mlai
    REAL,  DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: mtsa
    REAL,  DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: mswdown
!
    INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,LM                          &
                         ,IMS,IME,JMS,JME,KMS,KME                     &
                         ,ITS,ITE,JTS,JTE                             
!------------------------------------
!LOCAL VARIABLES
!------------------------------------
    INTEGER :: n,ninput,i,mype
    INTEGER, PARAMETER :: num_files=19
    REAL,DIMENSION(:,:),ALLOCATABLE :: TEMP
    LOGICAL :: opened

    CHARACTER (LEN=15) :: input_files(num_files),infile
    CHARACTER (LEN=4)  :: infile0
    CHARACTER (len=2) cn

    DATA input_files /'isop.dat','pftp_bt.dat','pftp_nt.dat','pftp_sb.dat','pftp_hb.dat', &
         'lai01.dat','lai02.dat','lai03.dat','lai04.dat','lai05.dat','lai06.dat',     &
         'lai07.dat','lai08.dat','lai09.dat','lai10.dat','lai11.dat','lai12.dat',     &
         'mtsa.dat','mswdonwn.dat'/
!------------------------------------
      MYPE=MYPE_SHARE

      allocate(TEMP(IDS:IDE,JDS:JDE),STAT=I)

!-----------------------------------------------------------------------
      select_unit: do n=151,159
        inquire(n,opened=opened)
        if(.not.opened)then
          ninput=n
          exit select_unit
        endif
      enddo select_unit
!-----------------------------------------------------------------------
        if(mype_share==0)then
          infile=trim('isop.dat')
          open(unit=ninput,file=infile,status='old',form='unformatted')
          read(ninput) TEMP
          close(ninput)
!Isoprene emission factor from isop.dat in ug/m2/h and megan needed in mol/km2/h
!Conversion factor = 1g/1e6ug * 1/PMisop(g/mol) * 1e6m2/km2
!PMisop=68.12 g/mol
        TEMP=TEMP/68.12
        endif

        call dstrb(TEMP,msebio_isop,1,1,1,1,1,MYPE,MPI_COMM_COMP)
        call halo_exch(msebio_isop,1,2,2)
!-----------------------------------------------------------------------
        if(mype_share==0)then
          infile=trim('pftp_bt.dat')
          open(unit=ninput,file=infile,status='old',form='unformatted')
          read(ninput) TEMP
          close(ninput)
        endif

        call dstrb(TEMP,pftp_bt,1,1,1,1,1,MYPE,MPI_COMM_COMP)
        call halo_exch(pftp_bt,1,2,2)
!-----------------------------------------------------------------------
        if(mype_share==0)then
          infile=trim('pftp_nt.dat')
          open(unit=ninput,file=infile,status='old',form='unformatted')
          read(ninput) TEMP
          close(ninput)
        endif

        call dstrb(TEMP,pftp_nt,1,1,1,1,1,MYPE,MPI_COMM_COMP)
        call halo_exch(pftp_nt,1,2,2)
!-----------------------------------------------------------------------
        if(mype_share==0)then
          infile=trim('pftp_sb.dat')
          open(unit=ninput,file=infile,status='old',form='unformatted')
          read(ninput) TEMP
          close(ninput)
        endif

        call dstrb(TEMP,pftp_sb,1,1,1,1,1,MYPE,MPI_COMM_COMP)
        call halo_exch(pftp_sb,1,2,2)
!-----------------------------------------------------------------------
        if(mype_share==0)then
          infile=trim('pftp_hb.dat')
          open(unit=ninput,file=infile,status='old',form='unformatted')
          read(ninput) TEMP
          close(ninput)
        endif

        call dstrb(TEMP,pftp_hb,1,1,1,1,1,MYPE,MPI_COMM_COMP)
        call halo_exch(pftp_hb,1,2,2)
!-----------------------------------------------------------------------
        do n=1,12
          if(mype_share==0)then
            if(n.lt.10) then
              infile0='lai0'
              write(cn,'(i1)') n
              infile=trim(infile0)//trim(cn)//trim('.dat')
            else
              infile0='lai'
              write(cn,'(i2)') n
              infile=trim(infile0)//trim(cn)//trim('.dat')
            endif

            open(unit=ninput,file=infile,status='old',form='unformatted')
            read(ninput) TEMP
            close(ninput)
!Global monthly LAIv for year 2003 values values range from 0 to 6000 and the units are m2 leaf area per 1000 m2 ground area. These values should be divided by 1000 to use with MEGAN2.04
            TEMP=TEMP*1.e-3
          endif

          call dstrb(TEMP,mlai,1,1,1,12,n,MYPE,MPI_COMM_COMP)
        enddo
        call halo_exch(mlai,12,2,2)
!-----------------------------------------------------------------------
        if(mype_share==0)then
          infile=trim('meteo-data.dat')
          open(unit=ninput,file=infile,status='old',form='unformatted')
          read(ninput) TEMP
        endif

        call dstrb(TEMP,mtsa,1,1,1,1,1,MYPE,MPI_COMM_COMP)
        call halo_exch(mtsa,1,2,2)
!-----------------------------------------------------------------------
        if(mype_share==0)then
          read(ninput) TEMP
          close(ninput)
        endif

        call dstrb(TEMP,mswdown,1,1,1,1,1,MYPE,MPI_COMM_COMP)
        call halo_exch(mswdown,1,2,2)
!-----------------------------------------------------------------------

  deallocate(TEMP)

  END SUBROUTINE READ_MEGAN_CNST_FIELDS
!MONARCH
END MODULE module_bioemi_megan2
