module MEGANFactorsMod
  !-----------------------------------------------------------------------
  ! !DESCRIPTION:
  ! Manages input of MEGAN emissions factors from netCDF file
  !
  ! !USES:
  use shr_kind_mod, only : r8 => shr_kind_r8
  use abortutils,   only : endrun
  use clm_varctl,   only : iulog
  use shr_log_mod,  only : errMsg => shr_log_errMsg
  !
  implicit none
  private
  !
  ! !PUBLIC MEMBERS:
  public :: megan_factors_init
  public :: megan_factors_get
  public :: comp_names
  !
  ! !PUBLIC DATA:
  real(r8), public, allocatable :: LDF(:)  ! light dependent fraction
  real(r8), public, allocatable :: Agro(:) ! growing leaf age factor
  real(r8), public, allocatable :: Amat(:) ! mature leaf age factor
  real(r8), public, allocatable :: Anew(:) ! new leaf age factor
  real(r8), public, allocatable :: Aold(:) ! old leaf age factor
  real(r8), public, allocatable :: betaT(:)! temperature factor
  real(r8), public, allocatable :: ct1(:)  ! temperature coefficient 1
  real(r8), public, allocatable :: ct2(:)  ! temperature coefficient 2
  real(r8), public, allocatable :: Ceo(:)  ! Eopt coefficient
  !
  ! !PRIVATE MEMBERS:
  integer :: npfts ! number of plant function types
  !
  type emis_eff_t
     real(r8) , pointer :: eff (:)  !  [real(r8) (:)]  emissions efficiency factor 
     real(r8) :: wght            ! molecular weight
     integer :: class_num        ! MEGAN class number
  endtype emis_eff_t
  !
  type(emis_eff_t) , pointer :: comp_factors_table (:)   !  [type(emis_eff_t) (:)]  hash table of MEGAN factors (points to an array of pointers) 
  integer , pointer :: hash_table_indices (:)            !  [integer (:)]  pointer to hash table indices 
  integer, parameter :: tbl_hash_sz = 2**16           ! hash table size
  !
  character(len=40), allocatable :: comp_names(:)     ! MEGAN compound names
  real(r8),          allocatable :: comp_molecwghts(:)! MEGAN compound molecular weights

  character(len=*), parameter, private :: sourcefile = &
       __FILE__
  !-----------------------------------------------------------------------

contains

  !-----------------------------------------------------------------------
  subroutine megan_factors_get( comp_name, factors, class_n, molecwght )
    !
    ! !DESCRIPTION:
    ! Method for getting MEGAN information for a named compound 
    !
    ! !ARGUMENTS:
    character(len=*),intent(in)  :: comp_name      ! MEGAN compound name
    real(r8),        intent(out) :: factors(npfts) ! vegitation type factors for the compound of intrest
    integer,         intent(out) :: class_n        ! MEGAN class number for the compound of intrest
    real(r8),        intent(out) :: molecwght      ! molecular weight of the compound of intrest
    !
    ! LOCAL VARS:
    integer :: hashkey, ndx
    character(len=120) :: errmes
    !-----------------------------------------------------------------------

    hashkey = gen_hashkey(comp_name)
    ndx = hash_table_indices(hashkey)

    if (ndx<1) then 
       errmes = 'megan_factors_get: '//trim(comp_name)//' compound not found in MEGAN table'
       write(iulog,*) trim(errmes)
       call endrun(msg=errMsg(sourcefile, __LINE__))
    endif

    factors(:) = comp_factors_table( ndx )%eff(:)
    class_n    = comp_factors_table( ndx )%class_num
    molecwght  = comp_factors_table( ndx )%wght

  end subroutine megan_factors_get

  !-----------------------------------------------------------------------
  subroutine megan_factors_init( filename )
    !
    ! !DESCRIPTION:
    ! Initializes the MEGAN factors using data from input file 
    !
    ! !USES:
    use ncdio_pio, only : ncd_pio_openfile,ncd_inqdlen
    use pio, only : pio_inq_varid,pio_get_var,file_desc_t,pio_closefile
    use fileutils   , only : getfil
    use clm_varpar  , only : mxpft
    !
    ! !ARGUMENTS:
    character(len=*),intent(in) :: filename ! MEGAN factors input file
    !-----------------------------------------------------------------------

    character(len=256) :: locfn           ! local file name
    type(file_desc_t) :: ncid             ! netcdf id

    integer :: start(2), count(2)

    integer :: ierr, i, vid
    integer :: dimid, n_comps, n_classes, n_patchs
    integer :: class_ef_vid,comp_ef_vid,comp_name_vid,class_num_vid
    integer :: comp_mw_vid
    integer, allocatable :: class_nums(:)

    real(r8),allocatable :: factors(:)
    real(r8),allocatable :: comp_factors(:)
    real(r8),allocatable :: class_factors(:)

    allocate(comp_factors_table(150))
    allocate(hash_table_indices(tbl_hash_sz))


    call getfil(filename, locfn, 0)
    call ncd_pio_openfile (ncid, trim(locfn), 0)

    call ncd_inqdlen( ncid, dimid, n_comps, name='Comp_Num')
    call ncd_inqdlen( ncid, dimid, n_classes, name='Class_Num')
    call ncd_inqdlen( ncid, dimid, n_patchs, name='PFT_Num')

    if ( n_patchs /= mxpft )then
       call endrun(msg='PFT_Num does NOT equal mxpft: '//errMsg(sourcefile, __LINE__))
    end if
    npfts = n_patchs

    ierr = pio_inq_varid(ncid,'Class_EF', class_ef_vid)
    ierr = pio_inq_varid(ncid,'Comp_EF',  comp_ef_vid)
    ierr = pio_inq_varid(ncid,'Comp_Name',comp_name_vid)
    ierr = pio_inq_varid(ncid,'Class_Num',class_num_vid)
    ierr = pio_inq_varid(ncid,'Comp_MW',  comp_mw_vid)

    allocate( factors(n_patchs) ) 
    allocate( comp_factors(n_patchs) )
    allocate( class_factors(n_patchs) )
    
    factors(1:n_patchs) = 0._r8
    comp_factors(1:n_patchs) = 0._r8
    class_factors(1:n_patchs) = 0._r8

    allocate( comp_names(n_comps) )
    allocate( comp_molecwghts(n_comps) )
    allocate( class_nums(n_comps) )

    ierr =  pio_get_var( ncid, comp_name_vid, comp_names ) 
    ierr =  pio_get_var( ncid, comp_mw_vid, comp_molecwghts ) 
    ierr =  pio_get_var( ncid, class_num_vid, class_nums )
 
    ! set up hash table where data is stored
    call  bld_hash_table_indices( comp_names )
    do i=1,n_comps
       start=(/i,1/)
       count=(/1,mxpft/) 
       ierr = pio_get_var( ncid, comp_ef_vid,  start, count, comp_factors )
       start=(/class_nums(i),1/)
       ierr = pio_get_var( ncid, class_ef_vid, start, count, class_factors  )
       factors(:) = comp_factors(:)*class_factors(:)
       call enter_hash_data( trim(comp_names(i)), factors, class_nums(i), comp_molecwghts(i) )
    enddo

    allocate( LDF(n_classes) )
    allocate( Agro(n_classes) )
    allocate( Amat(n_classes) )
    allocate( Anew(n_classes) )
    allocate( Aold(n_classes) )
    allocate( betaT(n_classes) )
    allocate( ct1(n_classes) )
    allocate( ct2(n_classes) )
    allocate( Ceo(n_classes) )

    ierr = pio_inq_varid(ncid,'LDF', vid)
    ierr = pio_get_var( ncid, vid, LDF ) 

    ierr = pio_inq_varid(ncid,'Agro', vid)
    ierr = pio_get_var( ncid, vid, Agro ) 

    ierr = pio_inq_varid(ncid,'Amat', vid)
    ierr = pio_get_var( ncid, vid, Amat ) 

    ierr = pio_inq_varid(ncid,'Anew', vid)
    ierr = pio_get_var( ncid, vid, Anew ) 

    ierr = pio_inq_varid(ncid,'Aold', vid)
    ierr = pio_get_var( ncid, vid, Aold ) 

    ierr = pio_inq_varid(ncid,'betaT', vid)
    ierr = pio_get_var( ncid, vid, betaT ) 

    ierr = pio_inq_varid(ncid,'ct1', vid)
    ierr = pio_get_var( ncid, vid, ct1 ) 

    ierr = pio_inq_varid(ncid,'ct2', vid)
    ierr = pio_get_var( ncid, vid, ct2 ) 

    ierr = pio_inq_varid(ncid,'Ceo', vid)
    ierr = pio_get_var( ncid, vid, Ceo ) 

    call pio_closefile(ncid)

    deallocate( class_nums, comp_factors,class_factors,factors )

  endsubroutine megan_factors_init
!-----------------------------------------------------------------------

  !-----------------------------------------------------------------------
  ! Private methods...

  !-----------------------------------------------------------------------
  !-----------------------------------------------------------------------
  subroutine bld_hash_table_indices( names )
    character(len=*),intent(in) :: names(:)

    integer :: n, i, hashkey

    hash_table_indices(:) = 0

    n = size(names)
    do i=1,n
       hashkey = gen_hashkey(names(i))
       hash_table_indices(hashkey) = i
    enddo

  endsubroutine bld_hash_table_indices

  !-----------------------------------------------------------------------
  !-----------------------------------------------------------------------
  subroutine enter_hash_data( name, data, class_n, molec_wght )
    character(len=*), intent(in) :: name
    real(r8), intent(in) :: data(:)
    integer,  intent(in) :: class_n
    real(r8), intent(in) :: molec_wght

    integer :: hashkey, ndx
    integer :: nfactors

    hashkey = gen_hashkey(name)
    nfactors = size(data)

    ndx = hash_table_indices(hashkey)

    allocate (comp_factors_table(ndx)%eff(nfactors))

    comp_factors_table(ndx)%eff(:) = data(:)
    comp_factors_table(ndx)%class_num = class_n
    comp_factors_table(ndx)%wght = molec_wght

  end subroutine enter_hash_data

  !-----------------------------------------------------------------------
  !from cam_history
  !
  ! Purpose: Generate a hash key on the interval [0 .. tbl_hash_sz-1]
  !          given a character string.
  !
  ! Algorithm is a variant of perl's internal hashing function.
  !
  !-----------------------------------------------------------------------
  integer function gen_hashkey(string)

    implicit none
    !
    !  Arguments:
    !
    character(len=*), intent(in) :: string
    !
    !  Local vars
    !
    integer :: hash
    integer :: i

    integer, parameter :: tbl_max_idx = 15  ! 2**N - 1
    integer, parameter :: gen_hash_key_offset = z'000053db'
    integer, dimension(0:tbl_max_idx) :: tbl_gen_hash_key =  (/61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1/)

    hash = gen_hash_key_offset

    if ( len_trim(string) /= 19 ) then
       !
       ! Process arbitrary string length.
       !
       do i = 1, len_trim(string)
          hash = ieor(hash , (ichar(string(i:i)) * tbl_gen_hash_key(iand(i-1,tbl_max_idx))))
       end do
    else
       !
       ! Special case string length = 19
       !
       do i = 1, tbl_max_idx+1
          hash = ieor(hash , ichar(string(i:i))   * tbl_gen_hash_key(i-1)) 
       end do
       do i = tbl_max_idx+2, len_trim(string)
          hash = ieor(hash , ichar(string(i:i))   * tbl_gen_hash_key(i-tbl_max_idx-2)) 
       end do
    end if

    gen_hashkey = iand(hash, tbl_hash_sz-1)

    return

  end function gen_hashkey

end module MEGANFactorsMod
