!
! CDDL HEADER START
!
! The contents of this file are subject to the terms of the Common Development
! and Distribution License Version 1.0 (the "License").
!
! You can obtain a copy of the license at
! http://www.opensource.org/licenses/CDDL-1.0.  See the License for the
! specific language governing permissions and limitations under the License.
!
! When distributing Covered Code, include this CDDL HEADER in each file and
! include the License file in a prominent location with the name LICENSE.CDDL.
! If applicable, add the following below this CDDL HEADER, with the fields
! enclosed by brackets "[]" replaced with your own identifying information:
!
! Portions Copyright (c) [yyyy] [name of copyright owner]. All rights reserved.
!
! CDDL HEADER END
!

!
! Copyright (c) 2013--2018, Regents of the University of Minnesota.
! All rights reserved.
!
! Contributors:
!    Ellad B. Tadmor
!    Ryan S. Elliott
!    Stephen M. Whalen
!

!
! Release: This file is part of the kim-api.git package.
!


#include "KIM_API_status.h"
#define THIS_FILE_NAME __FILE__
#define TRUEFALSE(TRUTH) merge(1,0,(TRUTH))

!-------------------------------------------------------------------------------
!
! module mod_neighborlist :
!
!    Module contains type and routines related to neighbor list calculation
!
!-------------------------------------------------------------------------------

module mod_neighborlist

  use, intrinsic :: iso_c_binding
  use KIM_API_F03

  public setup_neighborlist_KIM_access, get_neigh

  type neighObject_type
     integer(c_int), pointer :: neighborList(:,:)
     real(c_double), pointer :: RijList(:,:,:)
  end type neighObject_type

contains

!-------------------------------------------------------------------------------
!
! setup_neighborlist_KIM_access :
!
!    Store necessary pointers in KIM API object to access the neighbor list
!    data and methods.
!
!-------------------------------------------------------------------------------
subroutine setup_neighborlist_KIM_access(pkim, neighObject)
  implicit none

  !-- Transferred variables
  type(c_ptr),                    intent(in) :: pkim
  type(neighObject_type), target, intent(in) :: neighObject

  !-- Local variables
  integer(c_int), parameter :: SizeOne = 1
  integer(c_int)            :: ier, idum

  ! store location of neighObject variable
  !
  ier = kim_api_set_data(pkim, "neighObject", SizeOne, c_loc(neighObject))
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_set_data", ier)
     stop
  endif
  ier = kim_api_set_method(pkim, "get_neigh", SizeOne, c_funloc(get_neigh))
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_set_method", ier)
     stop
  endif

  return

end subroutine setup_neighborlist_KIM_access

!-------------------------------------------------------------------------------
!
! get_neigh neighbor list access function
!
! This function implements Locator and Iterator mode
!
!-------------------------------------------------------------------------------
integer(c_int) function get_neigh(pkim,mode,request,part,numnei,pnei1part, &
                                  pRij) bind(c)
  implicit none

  !-- Transferred variables
  type(c_ptr),    intent(in)  :: pkim
  integer(c_int), intent(in)  :: mode
  integer(c_int), intent(in)  :: request
  integer(c_int), intent(out) :: part
  integer(c_int), intent(out) :: numnei
  type(c_ptr),    intent(out) :: pnei1part
  type(c_ptr),    intent(out) :: pRij

  !-- Local variables
  integer(c_int), parameter :: DIM = 3
  integer(c_int), save :: iterVal = 0
  integer(c_int)  N
  integer(c_int)  partToReturn
  integer(c_int), pointer :: numberOfParticles;   type(c_ptr) :: pnParts
  type(neighObject_type), pointer :: neighObject; type(c_ptr) :: pneighObject
  integer(c_int)  ier, idum

  ! unpack number of particles
  pnParts = kim_api_get_data(pkim, "numberOfParticles", ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_get_data", ier)
     stop
  endif
  call c_f_pointer(pnParts, numberOfParticles)

  ! unpack neighbor list object
  pneighObject = kim_api_get_data(pkim, "neighObject", ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_get_data", ier)
     stop
  endif
  call c_f_pointer(pneighObject, neighObject)

  N = size(neighObject%neighborList, 2)

  ! check mode and request
  if (mode.eq.0) then ! iterator mode
     if (request.eq.0) then ! reset iterator
        iterVal = 0
        get_neigh = KIM_STATUS_NEIGH_ITER_INIT_OK
        return
     elseif (request.eq.1) then ! increment iterator
        iterVal = iterVal + 1
        if (iterVal.gt.N) then
           get_neigh = KIM_STATUS_NEIGH_ITER_PAST_END
           return
        else
           partToReturn = iterVal
        endif
     else
        idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                    "Invalid request in get_neigh", &
                                    KIM_STATUS_NEIGH_INVALID_REQUEST)
        get_neigh = KIM_STATUS_NEIGH_INVALID_REQUEST
        return
     endif
  elseif (mode.eq.1) then ! locator mode
     if ( (request.gt.N) .or. (request.lt.1)) then
        idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                    "Invalid part ID in get_neigh", &
                                    KIM_STATUS_PARTICLE_INVALID_ID)
        get_neigh = KIM_STATUS_PARTICLE_INVALID_ID
        return
     else
        partToReturn = request
     endif
  else ! not iterator or locator mode
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "Invalid mode in get_neigh", &
                                 KIM_STATUS_NEIGH_INVALID_MODE)
     get_neigh = KIM_STATUS_NEIGH_INVALID_MODE
     return
  endif

  ! set the returned part
  part = partToReturn

  ! set the returned number of neighbors for the returned part
  numnei = neighObject%neighborList(1,part)

  ! set the location for the returned neighbor list
  pnei1part = c_loc(neighObject%neighborList(2,part))

  ! set pointer to Rij to appropriate value
  if (associated(neighObject%RijList)) then
    pRij = c_loc(neighObject%RijList(1,1,part))
  else
    pRij = c_null_ptr
  endif

  get_neigh = KIM_STATUS_OK
  return
end function get_neigh

end module mod_neighborlist

!*******************************************************************************
!**
!**  PROGRAM ex_test_Ar_FCCcohesiveCutoff_NEIGH_RVEC
!**
!**  KIM compliant program to find (using the Golden section search algorithm)
!**  the minimum energy of one particle in a periodic FCC crystal (spec="Ar") as a
!**  function of lattice spacing.
!**
!**  Works with the following NBC methods:
!**        NEIGH_RVEC_H
!**        NEIGH_RVEC_F
!**
!*******************************************************************************

!-------------------------------------------------------------------------------
!
! Main program
!
!-------------------------------------------------------------------------------
program ex_test_Ar_FCCcohesiveCutoff_NEIGH_RVEC
  use, intrinsic :: iso_c_binding
  use KIM_API_F03
  use mod_neighborlist
  implicit none
  integer(c_int), parameter :: cd = c_double ! used for literal constants

!============================== VARIABLE DEFINITIONS ==========================

  ! parameters controlling behavior of test
  !
  character(len=KIM_KEY_STRING_LENGTH), parameter :: testname = "ex_test_Ar_FCCcohesiveCutoff_NEIGH_RVEC"
  character(len=KIM_KEY_STRING_LENGTH), parameter :: testkimfile = "descriptor.kim"
  character(len=2), parameter :: specname    = 'Ar'
  real(c_double),   parameter :: TOL         = 1.0e-8_cd
  real(c_double),   parameter :: FCCspacing  = 5.26d0 ! in angstroms
  real(c_double),   parameter :: MinSpacing  = 0.800_cd*FCCspacing
  real(c_double),   parameter :: MaxSpacing  = 1.200_cd*FCCspacing
  integer(c_int),   parameter :: DIM         = 3
  integer(c_int),   parameter :: SupportHalf = 1            ! True

  ! significant local variables
  !
  real(c_double) :: FinalSpacing       ! crystal lattice parameter
  real(c_double) :: FinalEnergy        ! energy per particle of crystal
                                       ! at current spacing
  integer(c_int) :: CellsPerCutoff     ! number of unit cells along
                                       ! box (of size cutoff) side
  real(c_double) :: MaxCutoff          ! maximum value for cutoff radius
  integer(c_int) :: N                          ! number of particles

  ! neighbor list
  !
  type(neighObject_type), target :: neighObject
  integer(c_int)  :: NNeighbors  ! maximum number of neighbors for a particle

  ! KIM variables
  !
  character(len=KIM_KEY_STRING_LENGTH) :: modelname  ! KIM-compliant model name
  type(c_ptr)    :: pkim          ! pointer to KIM API object
  integer(c_int) :: ier           ! error flag

  real(c_double), pointer :: param_cutoff;  type(c_ptr) :: pparam_cutoff

  ! other variables
  !
  real(c_double), external  ::  get_model_cutoff_firsttime
  integer(c_int), external  ::  check_model_parameters
  integer(c_int)            ::  idum

!========================= END VARIABLE DEFINITIONS ==========================


  ! Read in KIM Model name to use
  !
  print '("Please enter a valid KIM model name: ")'
  read(*,*) modelname


  ! We'll use just one particle for this calculation!
  !
  N = 1


  ! Setup the KIM API object
  !
  call setup_KIM_API_object(pkim, testkimfile, modelname, N, specname, SupportHalf)


  ! check for PARAM_FREE_cutoff
  ier = check_model_parameters(pkim)
  if (ier.ne.KIM_STATUS_OK) then
     ! PARAM_FREE_cutoff is not provided by the Model
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                   "exiting...", ier);
     stop
  endif
  !
  ! access the PARAM_FREE_cutoff parameter
  !
  pparam_cutoff = kim_api_get_data(pkim, "PARAM_FREE_cutoff", ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_get_data", ier)
     stop
  endif
  call c_f_pointer(pparam_cutoff, param_cutoff)

  ! Set MaxCutoff to be 2.0 more than the Model's normal cutoff
  !
  MaxCutoff = param_cutoff + 2.0_cd


  ! Set up for first iteration of the loop over the cutoff radius
  param_cutoff = param_cutoff - 2.0_cd
  ier = kim_api_model_reinit(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_model_reinit", ier)
     stop
  endif

  ! allocate storage for neighbor lists
  ! and store necessary pointers in KIM API object
  !

  ! determine maximum number of neighbors we will need
  !
  ! use 0.05_cd as a saftey factor
  CellsPerCutoff = ceiling(param_cutoff/MinSpacing+ 0.05_cd)
  NNeighbors = 4*((2*CellsPerCutoff + 1)**3)
  !
  ! allocate memory for the neighbor list and Rij vectors
  !
  allocate(neighObject%neighborList(NNeighbors+1,N))
  allocate(neighObject%RijList(3,NNeighbors+1,N))
  call setup_neighborlist_KIM_access(pkim, neighObject)
  !

  ! loop over an increasing cutoff radius
  do while (param_cutoff .le. MaxCutoff)
     !
     ! find equilibrium spacing by minimizing coheseive energy with respect
     ! to the periodic box size for the current cutoff value
     !
     call NEIGH_RVEC_compute_equilibrium_spacing(pkim, &
          DIM,CellsPerCutoff,MinSpacing,MaxSpacing,    &
          TOL,N,neighObject,.false.,FinalSpacing,FinalEnergy)

     ! print results to screen
     !
     print '(80(''-''))'
     print '("This is Test          : ",A)', trim(testname)
     print '("Results for KIM Model : ",A)', trim(modelname)
     print *
     print '("Found minimum energy configuration to within",ES25.15)', TOL
     print *
     print '("cutoff = ",ES25.15)', param_cutoff
     print *
     print '("Energy/part = ",ES25.15,"; Spacing = ",ES25.15)', FinalEnergy, &
           FinalSpacing
     print '(80(''-''))'

     !
     ! increment cutoff
     !
     param_cutoff = param_cutoff + 1.0
     ier = kim_api_model_reinit(pkim)
     if (ier.lt.KIM_STATUS_OK) then
        idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                    "kim_api_model_reinit", ier)
        stop
     endif

  enddo

  ! Don't forget to free and/or deallocate
  !
  deallocate(neighObject%neighborList)
  deallocate(neighObject%RijList)
  call free_KIM_API_object(pkim)

  stop

end program ex_test_Ar_FCCcohesiveCutoff_NEIGH_RVEC

!-------------------------------------------------------------------------------
!
! check_model_parameters :
!
!    Scan the Model's parameters and return 1 in PARAM_FREE_cutoff is in the
!    list and 0 if it is not in the list
!
!-------------------------------------------------------------------------------
integer(c_int) function check_model_parameters(pkim)
  use, intrinsic :: iso_c_binding
  use KIM_API_F03
  implicit none

  !-- Transferred variables
  type(c_ptr), intent(in) :: pkim

  !-- Local variables
  character(len=KIM_KEY_STRING_LENGTH) :: parameter
  integer(c_int) :: nParams
  integer(c_int) :: maxStringLength
  integer(c_int) :: paramIndex
  integer(c_int) :: i
  integer(c_int) :: ier

  ier = kim_api_get_num_params(pkim, nParams, maxStringLength)

  print '("The model has defined the following parameters:")'

  do i=1,nParams
     ier = kim_api_get_parameter(pkim, i, parameter)
     print *, i, trim(parameter)
     if (index(parameter,"PARAM_FREE_cutoff").eq.1) then
        paramIndex = i
     endif
  enddo

  if (paramIndex .gt. 0) then
     print '("PARAM_FREE_cutoff IS in the list, at index ",I2)', paramIndex
     check_model_parameters = 1
  else
     print '("PARAM_FREE_cutoff is NOT in the parameter list.")'
     check_model_parameters = 0
  endif

  return

end function check_model_parameters

!-------------------------------------------------------------------------------
!
! NEIGH_RVEC_compute_equilibrium_spacing :
!
!    Use the Golden section search algorithm to find the equilibrium spacing by
!    minimizing the energy of the system with respect to the periodic box size.
!
!-------------------------------------------------------------------------------
subroutine NEIGH_RVEC_compute_equilibrium_spacing(pkim, &
             DIM,CellsPerCutoff,MinSpacing,MaxSpacing,  &
             TOL,N,neighObject,                         &
             verbose,RetSpacing,RetEnergy)
  use, intrinsic :: iso_c_binding
  use KIM_API_F03
  use mod_neighborlist
  implicit none
  integer(c_int), parameter :: cd = c_double ! used for literal constants

  !-- Transferred variables
  type(c_ptr),            intent(in)    :: pkim
  integer(c_int),         intent(in)    :: DIM
  integer(c_int),         intent(in)    :: CellsPerCutoff
  real(c_double),         intent(in)    :: MinSpacing
  real(c_double),         intent(in)    :: MaxSpacing
  real(c_double),         intent(in)    :: TOL
  integer(c_int),         intent(in)    :: N
  type(neighObject_type), intent(inout) :: neighObject
  logical,                intent(in)    :: verbose
  real(c_double),         intent(out)   :: RetSpacing
  real(c_double),         intent(out)   :: RetEnergy

  !-- Local variables
  real(c_double), parameter :: Golden = (1.0_cd + sqrt(5.0_cd))/2.0_cd
  integer(c_int) ier, idum
  real(c_double) Spacings(4)
  real(c_double) Energies(4)
  real(c_double), pointer :: energy;           type(c_ptr) :: penergy
  real(c_double), pointer :: coords(:,:);      type(c_ptr) :: pcoor
  real(c_double), pointer :: cutoff;           type(c_ptr) :: pcutoff
  real(c_double), parameter :: cutpad = 0.750d0 ! in angstroms ! cutoff radius padding
  logical :: halfflag  ! .true. = half neigh list; .false. = full neigh list
  character(len=KIM_KEY_STRING_LENGTH) :: NBC_Method;

  ! Unpack data from KIM object
  !
  call kim_api_getm_data(pkim, ier, &
       "energy",      penergy, 1, &
       "coordinates", pcoor,   1, &
       "cutoff",      pcutoff, 1)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_getm_data", ier)
     stop
  endif
  call c_f_pointer(penergy, energy)
  call c_f_pointer(pcoor, coords, [DIM,N])
  call c_f_pointer(pcutoff, cutoff)

  ! determine which neighbor list type to use
  !
  ier = kim_api_get_nbc_method(pkim, NBC_Method)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_get_nbc_method", ier)
     stop
  endif
  if (index(NBC_Method,"NEIGH_RVEC_H").eq.1) then
     halfflag = .true.
  elseif (index(NBC_Method,"NEIGH_RVEC_F").eq.1) then
     halfflag = .false.
  else
     ier = KIM_STATUS_FAIL
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "Unknown NBC method", ier)
     return
  endif

  ! Initialize for minimization
  !
  Spacings(1) = MinSpacing
  ! compute new neighbor lists (could be done more intelligently, I'm sure)
  call NEIGH_RVEC_periodic_FCC_neighborlist(halfflag, CellsPerCutoff,     &
                                            (cutoff+cutpad), Spacings(1), &
                                            N, neighObject, coords)
  ier = kim_api_model_compute(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_model_compute", ier)
     stop
  endif
  Energies(1) = energy
  if (verbose) &
     print *, "Energy/part = ", Energies(1), "; Spacing = ", Spacings(1)

  ! setup and compute for max spacing
  Spacings(3) = MaxSpacing
  ! compute new neighbor lists (could be done more intelligently, I'm sure)
  call NEIGH_RVEC_periodic_FCC_neighborlist(halfflag, CellsPerCutoff,     &
                                            (cutoff+cutpad), Spacings(3), &
                                            N, neighObject, coords)
  ! Call model compute
  ier = kim_api_model_compute(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_model_compute", ier)
     stop
  endif
  Energies(3) = energy
  if (verbose) &
     print *, "Energy/part = ", Energies(3), "; Spacing = ", Spacings(3)

  ! setup and compute for first intermediate spacing
  Spacings(2) = MinSpacing + (2.0_cd - Golden)*(MaxSpacing - MinSpacing)
  ! compute new neighbor lists (could be done more intelligently, I'm sure)
  call NEIGH_RVEC_periodic_FCC_neighborlist(halfflag, CellsPerCutoff,     &
                                            (cutoff+cutpad), Spacings(2), &
                                            N, neighObject, coords)
  ! Call model compute
  ier = kim_api_model_compute(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_model_compute", ier)
     stop
  endif
  Energies(2) = energy
  if (verbose) &
     print *, "Energy/part = ", Energies(2), "; Spacing = ", Spacings(2)


  ! iterate until convergence.
  !
  do while (abs(Spacings(3) - Spacings(1)) .gt. TOL)
     ! set new spacing
     Spacings(4) = (Spacings(1) + Spacings(3)) - Spacings(2)
     ! compute new neighbor lists (could be done more intelligently, I'm sure)
     call NEIGH_RVEC_periodic_FCC_neighborlist(halfflag, CellsPerCutoff,     &
                                               (cutoff+cutpad), Spacings(4), &
                                               N, neighObject, coords)
     ! Call model compute
     ier = kim_api_model_compute(pkim)
     if (ier.lt.KIM_STATUS_OK) then
        idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                    "kim_api_model_compute", ier)
        stop
     endif
     Energies(4) = energy
     if (verbose) &
        print *, "Energy/part = ", Energies(4), "; Spacing = ", Spacings(4)

     ! determine the new interval
     if (Energies(4) .lt. Energies(2)) then
        ! We want the right-hand interval
        Spacings(1) = Spacings(2); Energies(1) = Energies(2)
        Spacings(2) = Spacings(4); Energies(2) = Energies(4)
     else
        ! We want the left-hand interval
        Spacings(3) = Spacings(1); Energies(3) = Energies(1)
        Spacings(1) = Spacings(4); Energies(1) = Energies(4)
     endif
  enddo

  ! pull out results and return
  !
  RetSpacing = Spacings(2)
  RetEnergy  = Energies(2)

  return

end subroutine NEIGH_RVEC_compute_equilibrium_spacing

!-------------------------------------------------------------------------------
!
! setup_KIM_API_object : Create KIM API object,
!                        allocate memory and set known values.
!
!-------------------------------------------------------------------------------
#define TRUEFALSE(TRUTH) merge(1,0,(TRUTH))
subroutine setup_KIM_API_object(pkim, testkimfile, modelname, N, specname, &
                                SupportHalf)
  use, intrinsic :: iso_c_binding
  use KIM_API_F03
  implicit none

  !-- Transferred variables
  type(c_ptr),                          intent(out) :: pkim
  character(len=KIM_KEY_STRING_LENGTH), intent(in)  :: testkimfile
  character(len=KIM_KEY_STRING_LENGTH), intent(in)  :: modelname
  integer(c_int),                       intent(in)  :: N
  character(len=2),                     intent(in)  :: specname
  integer(c_int),                       intent(in)  :: SupportHalf

  !-- Local variables
  integer(c_int), parameter :: ASpecies = 1  ! hard-wired to 1 particle species
  integer(c_int) ier, idum
  integer(c_int) isHalf
  integer(c_int), pointer :: numberOfParticles;   type(c_ptr) :: pnParts
  integer(c_int), pointer :: numContrib;          type(c_ptr) :: pnumContrib
  integer(c_int), pointer :: numberOfSpecies; type(c_ptr) :: pnOfSpecies
  integer(c_int), pointer :: particleSpecies(:);  type(c_ptr) :: pparticleSpecies

  ! Initialize KIM API object
  !
  ier = kim_api_file_init(pkim, testkimfile, modelname)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_file_init", ier)
     stop
  endif
  call kim_api_allocate(pkim, N, ASpecies, ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_allocate", ier)
     stop
  endif

  ! call model's init routine
  !
  ier = kim_api_model_init(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_model_init", ier)
     stop
  endif

  ! determine if a half list is being used
  isHalf = kim_api_is_half_neighbors(pkim, ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_is_half_neighbors", ier)
     stop
  endif

  ! Unpack data from KIM object whose values need to be set
  !
  call kim_api_getm_data(pkim, ier, &
       "numberOfParticles",           pnParts,           1, &
       "numberContributingParticles", pnumContrib,          &
           TRUEFALSE((SupportHalf.eq.1).and.(isHalf.eq.1)), &
       "numberOfSpecies",             pnOfSpecies,       1, &
       "particleSpecies",             pparticleSpecies,  1)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_getm_data", ier)
     stop
  endif
  call c_f_pointer(pnParts, numberOfParticles)
  if ((SupportHalf.eq.1).and.(isHalf.eq.1)) call c_f_pointer(pnumContrib, &
                                                             numContrib)
  call c_f_pointer(pnOfSpecies, numberOfSpecies)
  call c_f_pointer(pparticleSpecies,  particleSpecies, [N])

  ! Set values
  !
  numberOfParticles   = N
  if ((SupportHalf.eq.1).and.(isHalf.eq.1)) numContrib = 1
  numberOfSpecies = ASpecies
  particleSpecies(:)        = kim_api_get_species_code(pkim, specname, ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_get_species_code", ier)
     stop
  endif

  return

end subroutine setup_KIM_API_object

!-------------------------------------------------------------------------------
!
! free_KIM_API_object : Deallocate storage and destroy KIM API object
!
!-------------------------------------------------------------------------------
subroutine free_KIM_API_object(pkim)
  use, intrinsic :: iso_c_binding
  use KIM_API_F03
  implicit none

  !-- Transferred variables
  type(c_ptr), intent(in)  :: pkim

  !-- Local variables
  integer(c_int) ier, idum

  ! call the model destroy function
  !
  ier = kim_api_model_destroy(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_model_destroy", ier)
     stop
  endif

  ! free all KIM API object storage
  !
  call kim_api_free(pkim, ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error(__LINE__, THIS_FILE_NAME, &
                                 "kim_api_free", ier)
     stop
  endif

  return

end subroutine free_KIM_API_object

!-------------------------------------------------------------------------------
!
! Neigh_RVEC_periodic_FCC_neighborlist
!
!-------------------------------------------------------------------------------
subroutine NEIGH_RVEC_periodic_FCC_neighborlist(half,CellsPerHalfSide,cutoff, &
                                                FCCspacing,N,neighObject, &
                                                coords)
  use, intrinsic :: iso_c_binding
  use KIM_API_F03
  use mod_neighborlist
  implicit none
  integer(c_int), parameter :: cd = c_double ! used for literal constants

  !-- Transferred variables
  logical,                             intent(in)    :: half
  integer(c_int),                      intent(in)    :: CellsPerHalfSide
  real(c_double),                      intent(in)    :: cutoff
  real(c_double),                      intent(in)    :: FCCspacing
  integer(c_int),                      intent(in)    :: N
  real(c_double), dimension(3,N),      intent(out)   :: coords
  type(neighObject_type),              intent(inout) :: neighObject
  !-- Local variables
  real(c_double) dx(3)
  real(c_double) cutoff2
  real(c_double) FCCshifts(3,4)
  real(c_double) latVec(3)
  integer(c_int) part, parti, partj, a(4), i, j, k, m

  if (N.ne.1) then ! check assumption that N==1
     print *,"* ERROR: NEIGH_RVEC_periodic_FCC_neighborlist called with N.ne.1"
     stop
  endif

  ! set coords
  coords(:,1) = 0.0_cd

  cutoff2 = cutoff**2

  ! Cubic FCC cell positions ---------------------------------------------------
  FCCshifts(1,1) = 0.0_cd
  FCCshifts(2,1) = 0.0_cd
  FCCshifts(3,1) = 0.0_cd
  FCCshifts(1,2) = 0.5_cd*FCCspacing
  FCCshifts(2,2) = 0.5_cd*FCCspacing
  FCCshifts(3,2) = 0.0_cd
  FCCshifts(1,3) = 0.5_cd*FCCspacing
  FCCshifts(2,3) = 0.0_cd
  FCCshifts(3,3) = 0.5_cd*FCCspacing
  FCCshifts(1,4) = 0.0_cd
  FCCshifts(2,4) = 0.5_cd*FCCspacing
  FCCshifts(3,4) = 0.5_cd*FCCspacing

  if (half) then
     ! Each particle gets half of its own neighbor-self images
     do part = 1, N
        a(part) = 1
        do i = 0, CellsPerHalfSide
           latVec(1) = i*FCCspacing
           do j = -CellsPerHalfSide, CellsPerHalfSide
              latVec(2) = j*FCCspacing
              do k = -CellsPerHalfSide, CellsPerHalfSide
                 latVec(3) = k*FCCspacing
                 if (i.gt.0 .or. (i.eq.0 .and. (j.gt.0 .or. (j.eq.0 .and. &
                                                             k.gt.0)))) then
                    dx = latVec
                    if (dot_product(dx,dx).lt.cutoff2) then
                       ! we have a neighbor
                       a(part) = a(part) + 1
                       neighObject%neighborList(a(part),part) = part
                       neighObject%RijList(:,a(part)-1,part)  = dx
                    endif
                 endif
              enddo
           enddo
        enddo
     enddo

     ! particle i gets half of the other image particles
     do parti = 1, N
        do partj = parti+1, 4
           do i = -CellsPerHalfSide, CellsPerHalfSide
              latVec(1) = i*FCCspacing
              do j = -CellsPerHalfSide, CellsPerHalfSide
                 latVec(2) = j*FCCspacing
                 do k = -CellsPerHalfSide, CellsPerHalfSide
                    latVec(3) = k*FCCspacing
                    if ((i.ge.0 .and. partj.lt.4).or.(partj.eq.4 .and. i.gt.0) &
                         .or.( partj.eq.4 .and. (i.eq.0 .and. (j.ge.0))) )  then
                       dx = (latVec + FCCshifts(:,partj)) - FCCshifts(:,parti)
                       if (dot_product(dx,dx).lt.cutoff2) then
                          ! we have a neighbor
                          a(parti) = a(parti) + 1
                          neighObject%neighborList(a(parti),parti) = 1
                          neighObject%RijList(:,a(parti)-1,parti)  = dx
                       endif
                    endif
                 enddo
              enddo
           enddo
        enddo
        ! parti has a(parti)-1 neighbors
        neighObject%neighborList(1,parti) = a(parti) - 1
     enddo
  else
     part = 1
     a(part) = 1
     do i=-CellsPerHalfSide,CellsPerHalfSide
        latVec(1) = i*FCCspacing
        do j=-CellsPerHalfSide,CellsPerHalfSide
           latVec(2) = j*FCCspacing
           do k=-CellsPerHalfSide,CellsPerHalfSide
              latVec(3) = k*FCCspacing
              do m=1,4
                 dx = latVec + FCCshifts(:,m)
                 if (dot_product(dx,dx).lt.cutoff2) then
                    if (.not.( (i.eq.0) .and. (j.eq.0) .and. (k.eq.0) .and. &
                               (m.eq.1) )) then
                       ! we have a neighbor
                       a(part) = a(part)+1
                       neighObject%neighborList(a(part),1) = 1
                       neighObject%RijList(:,a(part)-1,1) = dx
                    endif
                 endif
              enddo
           enddo
        enddo
     enddo
     ! part has a(part)-1 neighbors
     neighObject%neighborList(1,1) = a(part)-1
  endif

  return

end subroutine NEIGH_RVEC_periodic_FCC_neighborlist
