iihash.F90

Go to the documentation of this file.

!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!! Copyright (C) 2021 S. Ohlmann
!!
!! This program 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 2, or (at your option)
!! any later version.
!!
!! This program 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 this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
 
module iihash_oct_m
  use debug_oct_m
  use global_oct_m
  use iso_c_binding
  use profiling_oct_m
 
  implicit none
 
  private
  public ::        &
    iihash_t,      &
    iihash_init,   &
    iihash_end,    &
    iihash_insert, &
    iihash_lookup, &
    lihash_t,      &
    lihash_init,   &
    lihash_end,    &
    lihash_insert, &
    lihash_lookup
 
  type iihash_t
    private
    type(c_ptr) :: map
  end type iihash_t
 
  type lihash_t
    private
    type(c_ptr) :: map
  end type lihash_t
 
contains
 
  ! ---------------------------------------------------------
  subroutine iihash_init(h)
    type(iihash_t), intent(out) :: h
 
    interface
      subroutine iihash_map_init(map)
        use iso_c_binding
        implicit none
 
        type(c_ptr), intent(inout) :: map
      end subroutine iihash_map_init
    end interface
 
 
    push_sub(iihash_init)
 
    call iihash_map_init(h%map)
 
    pop_sub(iihash_init)
  end subroutine iihash_init
 
 
  ! ---------------------------------------------------------
  subroutine iihash_end(h)
    type(iihash_t), intent(inout) :: h
 
    interface
      subroutine iihash_map_end(map)
        use iso_c_binding
        implicit none
 
        type(c_ptr), intent(inout) :: map
      end subroutine iihash_map_end
    end interface
 
    push_sub(iihash_end)
 
    call iihash_map_end(h%map)
 
    pop_sub(iihash_end)
  end subroutine iihash_end
 
 
  ! ---------------------------------------------------------
  subroutine iihash_insert(h, key, val)
    type(iihash_t),    intent(inout) :: h
    integer,           intent(in)    :: key
    integer,           intent(in)    :: val
 
    interface
      subroutine iihash_map_insert(map, key, val)
        use iso_c_binding
        implicit none
 
        type(c_ptr), intent(inout) :: map
        integer,     intent(in)    :: key
        integer,     intent(in)    :: val
      end subroutine iihash_map_insert
    end interface
 
    call iihash_map_insert(h%map, key, val)
  end subroutine iihash_insert
 
 
  ! ---------------------------------------------------------
  integer function iihash_lookup(h, key, found)
    type(iihash_t),    intent(in)  :: h
    integer,           intent(in)  :: key
    logical, optional, intent(out) :: found
 
    interface
      subroutine iihash_map_lookup(map, key, ifound, val)
        use iso_c_binding
        implicit none
 
        type(c_ptr), intent(in)    :: map
        integer,     intent(in)    :: key
        integer,     intent(out)   :: ifound
        integer,     intent(out)   :: val
      end subroutine iihash_map_lookup
    end interface
 
    integer :: ifound, val
    logical :: found_
 
    call iihash_map_lookup(h%map, key, ifound, val)
 
    found_ = (ifound == 1)
    if (present(found)) found = found_
 
    iihash_lookup = -1
    if (found_) iihash_lookup = val
 
  end function iihash_lookup
 
  ! ---------------------------------------------------------
  subroutine lihash_init(h)
    type(lihash_t), intent(out) :: h
 
    interface
      subroutine lihash_map_init(map)
        use iso_c_binding
        implicit none
 
        type(c_ptr), intent(inout) :: map
      end subroutine lihash_map_init
    end interface
 
 
    push_sub(lihash_init)
 
    call lihash_map_init(h%map)
 
    pop_sub(lihash_init)
  end subroutine lihash_init
 
 
  ! ---------------------------------------------------------
  subroutine lihash_end(h)
    type(lihash_t), intent(inout) :: h
 
    interface
      subroutine lihash_map_end(map)
        use iso_c_binding
        implicit none
 
        type(c_ptr), intent(inout) :: map
      end subroutine lihash_map_end
    end interface
 
    push_sub(lihash_end)
 
    call lihash_map_end(h%map)
 
    pop_sub(lihash_end)
  end subroutine lihash_end
 
 
  ! ---------------------------------------------------------
  subroutine lihash_insert(h, key, val)
    type(lihash_t),    intent(inout) :: h
    integer(int64),       intent(in)    :: key
    integer,           intent(in)    :: val
 
    interface
      subroutine lihash_map_insert(map, key, val)
        use iso_c_binding
        use, intrinsic :: iso_fortran_env
        implicit none
 
        type(c_ptr), intent(inout) :: map
        integer(int64), intent(in)    :: key
        integer,     intent(in)    :: val
      end subroutine lihash_map_insert
    end interface
 
    call lihash_map_insert(h%map, key, val)
  end subroutine lihash_insert
 
 
  ! ---------------------------------------------------------
  integer function lihash_lookup(h, key, found)
    type(lihash_t),    intent(in)  :: h
    integer(int64),       intent(in)  :: key
    logical, optional, intent(out) :: found
 
    interface
      subroutine lihash_map_lookup(map, key, ifound, val)
        use iso_c_binding
        use, intrinsic :: iso_fortran_env
        implicit none
 
        type(c_ptr), intent(in)    :: map
        integer(int64), intent(in)    :: key
        integer,     intent(out)   :: ifound
        integer,     intent(out)   :: val
      end subroutine lihash_map_lookup
    end interface
 
    integer :: ifound, val
    logical :: found_
 
    call lihash_map_lookup(h%map, key, ifound, val)
 
    found_ = (ifound == 1)
    if (present(found)) found = found_
 
    lihash_lookup = -1
    if (found_) lihash_lookup = val
 
  end function lihash_lookup
 
end module iihash_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: