!
! 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) 2012, Regents of the University of Minnesota.  All rights reserved.
!
! Contributors:
!    Ryan S. Elliott
!    Ellad B. Tadmor
!    Valeriu Smirichinski
!


!*******************************************************************************
!**
!**  PROGRAM ex_test_Al_FCCcohesive_MI_OPBC
!**
!**  KIM compliant program to find (using the Golden section search algorithm)
!**  the minimum energy of one atom in a periodic FCC crystal (spec="Al") as a
!**  function of lattice spacing.
!**
!**  Works with the following NBC methods:
!**        MI_OPBC_H
!**        MI_OPBC_F
!**
!**  Release: This file is part of the openkim-api-v1.1.0 package.
!**
!*******************************************************************************

#include "KIM_API_status.h"
#define THIS_FILE_NAME __FILE__

!-------------------------------------------------------------------------------
!
! Main program
!
!-------------------------------------------------------------------------------
program ex_test_Al_FCCcohesive_MI_OPBC
  use KIM_API
  implicit none

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

  ! parameters controlling behavior of test
  !
  character(len=80), parameter :: testname    = "ex_test_Al_FCCcohesive_MI_OPBC"
  character(len=2),  parameter :: specname    = 'Al'
  double precision,  parameter :: TOL         = 1.0d-8
  double precision,  parameter :: FCCspacing  = 4.050d0 ! in angstroms
  double precision,  parameter :: MinSpacing  = 0.800d0*FCCspacing
  double precision,  parameter :: MaxSpacing  = 1.200d0*FCCspacing
  integer,           parameter :: DIM         = 3
  integer,           parameter :: SupportHalf = 1 ! True

  ! significant local variables
  !
  double precision     :: rcut               ! cutoff radius of the potential

  integer, allocatable :: neighborList(:,:)  ! neighbor list storage

  double precision     :: FinalSpacing       ! crystal lattice parameter

  double precision     :: FinalEnergy        ! energy per atom of crystal
                                             ! at current spacing

  integer              :: CellsPerSide       ! number of unit cells along
                                             ! box side


  ! KIM variables
  !
  character(len=80)         :: modelname     ! KIM-compliant model name

  integer(kind=kim_intptr)  :: pkim          ! pointer to KIM API object

  real*8 coordum(DIM,1);   pointer(pcoor,coordum)         ! coordinate

  integer                   :: N                          ! number of atoms


  ! other variables
  !
  double precision, external  ::  get_model_cutoff_firsttime

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


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


  ! Get model cutoff radius and compute number of atoms needed
  ! (We need 2*cutoff, use 2.125*cutoff for saftey)
  !
  rcut = get_model_cutoff_firsttime(testname, modelname)
  CellsPerSide = ceiling((2.125d0*rcut)/(MinSpacing))
  N = 4*(CellsPerSide**3)


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


  ! allocate storage for neighbor lists, compute them for the first time,
  ! and store necessary pointers in KIM API object
  !
  allocate(neighborList(N+1, N))
  call setup_neighborlist_no_Rij_KIM_access(pkim, N, neighborList)


  ! find equilibrium spacing by minimizing coheseive energy with respect
  ! to the periodic box size
  !
  call MI_OPBC_compute_equilibrium_spacing(pkim, &
         DIM,CellsPerSide,MinSpacing,MaxSpacing, &
         TOL,N,neighborlist,.false.,             &
         FinalSpacing,FinalEnergy)

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


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

  stop

end program ex_test_Al_FCCcohesive_MI_OPBC

!-------------------------------------------------------------------------------
!
! MI_OPBC_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 MI_OPBC_compute_equilibrium_spacing(pkim, &
             DIM,CellsPerSide,MinSpacing,MaxSpacing, &
             TOL,N,neighborlist,verbose,             &
             RetSpacing,RetEnergy)
  use KIM_API
  implicit none

  !-- Transferred variables
  integer(kind=kim_intptr), intent(in)     :: pkim
  integer,                  intent(in)     :: DIM
  integer,                  intent(in)     :: CellsPerSide
  double precision,         intent(in)     :: MinSpacing
  double precision,         intent(in)     :: MaxSpacing
  double precision,         intent(in)     :: TOL
  integer,                  intent(in)     :: N
  integer,                  intent(inout)  :: neighborList(N+1,N)
  logical,                  intent(in)     :: verbose
  double precision,         intent(out)    :: RetSpacing
  double precision,         intent(out)    :: RetEnergy

  !-- Local variables
  double precision,         parameter :: Golden      = (1.d0 + sqrt(5.d0))/2.d0
  integer ier, idum
  double precision Spacings(4)
  double precision Energies(4)
  integer MiddleAtomId
  real*8 energy;         pointer(penergy,energy)
  real*8 coordum(DIM,1); pointer(pcoor,coordum)
  real*8, pointer :: coords(:,:)
  real*8 cutoff;         pointer(pcutoff,cutoff)
  double precision, parameter :: cutpad = 0.750d0 ! in angstroms ! cutoff radius padding
  real*8 boxSideLengths(DIM);    pointer(pboxSideLengths,boxSideLengths)
  logical :: halfflag  ! .true. = half neighbor list; .false. = full neighbor list
  character(len=64) NBC_Method;  pointer(pNBC_Method,NBC_Method)

  ! Unpack data from KIM object
  !
  call kim_api_getm_data_f(pkim, ier, &
       "energy",         penergy,         1, &
       "coordinates",    pcoor,           1, &
       "cutoff",         pcutoff,         1, &
       "boxSideLengths", pboxSideLengths, 1)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_getm_data_f", ier)
     stop
  endif

  call KIM_to_F90_real_array_2d(coordum, coords, DIM, N)

  ! determine which neighbor list type to use
  !
  pNBC_Method = kim_api_get_nbc_method_f(pkim, ier) ! don't forget to free
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_get_nbc_method_f", ier)
     stop
  endif
  if (index(NBC_Method,"MI_OPBC_H").eq.1) then
     halfflag = .true.
  elseif (index(NBC_Method,"MI_OPBC_F").eq.1) then
     halfflag = .false.
  else
     ier = KIM_STATUS_FAIL
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "Unknown NBC method", ier)
     return
  endif
  call free(pNBC_Method) ! free the memory

  ! Initialize for minimization
  !
  Spacings(1) = MinSpacing
  call create_FCC_configuration(Spacings(1), CellsPerSide, .true., coords, MiddleAtomId)
  boxSideLengths(:) = Spacings(1)*CellsPerSide
  ! compute new neighbor lists (could be done more intelligently, I'm sure)
  call MI_OPBC_periodic_neighborlist(halfflag, N, coords, (cutoff+cutpad), boxSideLengths, MiddleAtomId, neighborList)
  ier = kim_api_model_compute_f(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_model_compute_f", ier)
     stop
  endif
  Energies(1) = energy
  if (verbose) &
     print '("Energy/atom = ",ES25.15,"; Spacing = ",ES25.15)', Energies(1), Spacings(1)

  ! setup and compute for max spacing
  Spacings(3) = MaxSpacing
  call create_FCC_configuration(Spacings(3), CellsPerSide, .true., coords, MiddleAtomId)
  boxSideLengths(:) = Spacings(3)*CellsPerSide
  ! compute new neighbor lists (could be done more intelligently, I'm sure)
  call MI_OPBC_periodic_neighborlist(halfflag, N, coords, (cutoff+cutpad), boxSideLengths, MiddleAtomId, neighborList)
  ! Call model compute
  ier = kim_api_model_compute_f(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_model_compute_f", ier)
     stop
  endif
  Energies(3) = energy
  if (verbose) &
     print '("Energy/atom = ",ES25.15,"; Spacing = ",ES25.15)', Energies(3), Spacings(3)

  ! setup and compute for first intermediate spacing
  Spacings(2) = MinSpacing + (2.0 - Golden)*(MaxSpacing - MinSpacing)
  call create_FCC_configuration(Spacings(2), CellsPerSide, .true., coords, MiddleAtomId)
  boxSideLengths(:) = Spacings(2)*CellsPerSide
  ! compute new neighbor lists (could be done more intelligently, I'm sure)
  call MI_OPBC_periodic_neighborlist(halfflag, N, coords, (cutoff+cutpad), boxSideLengths, MiddleAtomId, neighborList)
  ! Call model compute
  ier = kim_api_model_compute_f(pkim)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_model_compute_f", ier)
     stop
  endif
  Energies(2) = energy
  if (verbose) &
     print '("Energy/atom = ",ES25.15,"; Spacing = ",ES25.15)', Energies(2), 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 atom coordinates based on new spacing
     call create_FCC_configuration(Spacings(4), CellsPerSide, .true., coords, MiddleAtomId)
     ! set new boxSideLengths
     boxSideLengths(:)  = Spacings(4)*CellsPerSide
     ! compute new neighbor lists (could be done more intelligently, I'm sure)
     call MI_OPBC_periodic_neighborlist(halfflag, N, coords, (cutoff+cutpad), boxSideLengths, MiddleAtomId, neighborList)
     ! Call model compute
     ier = kim_api_model_compute_f(pkim)
     if (ier.lt.KIM_STATUS_OK) then
        idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                      "kim_api_model_compute_f", ier)
        stop
     endif
     Energies(4) = energy
     if (verbose) &
        print '("Energy/atom = ",ES25.15,"; Spacing = ",ES25.15)', Energies(4), 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 MI_OPBC_compute_equilibrium_spacing

!-------------------------------------------------------------------------------
!
! get_model_cutoff_firsttime: get cutoff radius of a KIM model *prior* to the
!                             existence of the KIM API object
!
! NOTE: This routine creates a temporary KIM API object and goes through the
!       initialization process in order to read the cutoff radius from the
!       API object.
!
!       This procedure needs to be improved in the future.
!
!-------------------------------------------------------------------------------
double precision function get_model_cutoff_firsttime(testname, modelname)
  use KIM_API
  implicit none

  !-- Transferred variables
  character(len=80),  intent(in)  :: testname
  character(len=80),  intent(in)  :: modelname

  !-- Local variables
  integer, parameter :: ATypes = 1  ! hard-wired to one atomic type
  integer ier, idum
  integer(kind=kim_intptr) pkim_temp
  integer N
  real*8 cutoff; pointer(pcutoff,cutoff)

  ! Initialize the KIM object
  ier = kim_api_init_f(pkim_temp, testname, modelname)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_init_f", ier)
     stop
  endif

  ! To get the `cutoff', we use 1 atom to allocate memory via the KIM system
  !
  N = 1
  call kim_api_allocate_f(pkim_temp, N, ATypes, ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_allocate_f", ier)
     stop
  endif

  ! call model's init routine to put cutoff in KIM API object
  !
  ier = kim_api_model_init_f(pkim_temp)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_model_init_f", ier)
     stop
  endif

  ! access the `cutoff' argument
  !
  pcutoff = kim_api_get_data_f(pkim_temp, "cutoff", ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_get_data_f", ier)
     stop
  endif
  get_model_cutoff_firsttime = cutoff

  ! tear it all down
  !
  ier = kim_api_model_destroy_f(pkim_temp)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_model_destroy_f", ier)
     stop
  endif
  call kim_api_free_f(pkim_temp, ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_free_f", ier)
     stop
  endif

  return

end function get_model_cutoff_firsttime

!-------------------------------------------------------------------------------
!
! 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, testname, modelname, N, specname, SupportHalf)
  use KIM_API
  implicit none

  !-- Transferred variables
  integer(kind=kim_intptr), intent(in)  :: pkim
  character(len=80),        intent(in)  :: testname
  character(len=80),        intent(in)  :: modelname
  integer,                  intent(in)  :: N
  character(len=2),         intent(in)  :: specname
  integer,                  intent(in)  :: SupportHalf

  !-- Local variables
  integer, parameter :: ATypes = 1  ! hard-wired to one atomic type
  integer ier, idum
  integer numberOfParticles;   pointer(pnAtoms,numberOfParticles)
  integer numContrib;          pointer(pnumContrib,numContrib)
  integer numberParticleTypes; pointer(pnparticleTypes,numberParticleTypes)
  integer particleTypesdum(1); pointer(pparticleTypesdum,particleTypesdum)
  integer, pointer :: particleTypes(:)

  ! Initialize KIM API object
  !
  ier = kim_api_init_f(pkim, testname, modelname)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_init_f", ier)
     stop
  endif
  call kim_api_allocate_f(pkim, N, ATypes, ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_allocate_f", ier)
     stop
  endif

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

  ! Unpack data from KIM object whose values need to be set
  !
  call kim_api_getm_data_f(pkim, ier, &
       "numberOfParticles",           pnAtoms,           1,                           &
       "numberContributingParticles", pnumContrib,       TRUEFALSE(SupportHalf.eq.1), &
       "numberParticleTypes",         pnparticleTypes,   1,                           &
       "particleTypes",               pparticleTypesdum, 1)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_getm_data_f", ier)
     stop
  endif

  call KIM_to_F90_int_array_1d(particleTypesdum, particleTypes, N)

  ! Set values
  !
  numberOfParticles   = N
  if (SupportHalf.eq.1) numContrib = 1
  numberParticleTypes = ATypes
  particleTypes(:)        = kim_api_get_partcl_type_code_f(pkim, specname, ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_get_partcl_type_code_f", ier)
     stop
  endif

  return

end subroutine setup_KIM_API_object

!-------------------------------------------------------------------------------
!
! setup_neighborlist_no_Rij_KIM_access :
!
!    Store necessary pointers in KIM API object to access the neighbor list
!    data and methods.
!
!-------------------------------------------------------------------------------
subroutine setup_neighborlist_no_Rij_KIM_access(pkim, N, neighborList)
  use KIM_API
  implicit none

  !-- Transferred variables
  integer(kind=kim_intptr), intent(in) :: pkim
  integer,                  intent(in) :: N
  integer,                  intent(in) :: neighborList(N+1,N)

  !-- Local variables
  integer(kind=kim_intptr), parameter :: SizeOne = 1
  integer,                  external  :: get_neigh_no_Rij
  integer ier, idum

  ! store pointers to neighbor list object and access function
  !
  call kim_api_setm_data_f(pkim, ier, &
       "neighObject", SizeOne, loc(neighborList),     1, &
       "get_neigh",   SizeOne, loc(get_neigh_no_Rij), 1)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_setm_data_f", ier)
     stop
  endif

  return

end subroutine setup_neighborlist_no_Rij_KIM_access

!-------------------------------------------------------------------------------
!
! free_KIM_API_object : Deallocate storage and destroy KIM API object
!
!-------------------------------------------------------------------------------
subroutine free_KIM_API_object(pkim)
  use KIM_API
  implicit none

  !-- Transferred variables
  integer(kind=kim_intptr), intent(in)  :: pkim

  !-- Local variables
  integer ier, idum

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

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

  return

end subroutine free_KIM_API_object

!-------------------------------------------------------------------------------
!
! MI_OPBC_periodic_neighborlist : construct a half or full neighbor list using the
!                                 atom coordinates in coords()
!
!-------------------------------------------------------------------------------
subroutine MI_OPBC_periodic_neighborlist(half, numberOfParticles, coords, rcut, boxSideLengths, MiddleAtomID, neighborList)
  use KIM_API
  implicit none

  !-- Transferred variables
  logical,                                                     intent(in)  :: half
  integer,                                                     intent(in)  :: numberOfParticles
  double precision, dimension(3,numberOfParticles),            intent(in)  :: coords
  double precision,                                            intent(in)  :: rcut
  double precision, dimension(3),                              intent(in)  :: boxSideLengths
  integer,                                                     intent(in)  :: MiddleAtomID
  integer,   dimension(numberOfParticles+1,numberOfParticles), intent(out) :: neighborList ! not memory efficient

  !-- Local variables
  integer i, j, a
  double precision dx(3)
  double precision r2
  double precision rcut2

  rcut2 = rcut**2

  do i=1,numberOfParticles
     a = 1
     do j=1,numberOfParticles
        dx(:) = coords(:, j) - coords(:, i)
        where (abs(dx) > 0.5d0*boxSideLengths)  ! apply PBC
           dx = dx - sign(boxSideLengths,dx)
        endwhere
        r2 = dot_product(dx, dx)
        if (r2.le.rcut2) then
           ! atom j is a neighbor of atom i
           if (half) then
               if ( ((i.eq.MiddleAtomId) .or. (j.eq.MiddleAtomId)) .and. (i .lt. j) ) then
                  a = a+1
                  neighborList(a,i) = j
               endif
           else
               if (i.eq.MiddleAtomId .and. i.ne.j) then
                  a = a+1
                  neighborList(a,i) = j
               endif
           endif
        endif
     enddo
     ! atom i has a-1 neighbors
     neighborList(1,i) = a-1
  enddo

  return

end subroutine MI_OPBC_periodic_neighborlist

!-------------------------------------------------------------------------------
!
! get_neigh_no_Rij neighbor list access function
!
! This function implements Locator and Iterator modes
!
!-------------------------------------------------------------------------------
integer function get_neigh_no_Rij(pkim,mode,request,atom,numnei,pnei1atom,pRij)
  use KIM_API
  implicit none

  !-- Transferred variables
  integer(kind=kim_intptr), intent(in)  :: pkim
  integer,                  intent(in)  :: mode
  integer,                  intent(in)  :: request
  integer,                  intent(out) :: atom
  integer,                  intent(out) :: numnei
  integer nei1atom(1); pointer(pnei1atom, nei1atom) ! actual cray pointer associated with nei1atom
  real*8  Rij(3,1);    pointer(pRij, Rij)

  !-- Local variables
  integer, save :: iterVal = 0
  integer  atomToReturn
  integer  neighborListdum(1); pointer(pneighborListdum, neighborListdum)
  integer, pointer :: neighborList(:,:)
  integer  ier, idum
  integer  numberOfParticles; pointer(pnAtoms, numberOfParticles)
  integer  N

  ! unpack neighbor list object
  pneighborListdum = kim_api_get_data_f(pkim, "neighObject", ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_get_data_f", ier)
     stop
  endif

  pnAtoms = kim_api_get_data_f(pkim, "numberOfParticles", ier)
  if (ier.lt.KIM_STATUS_OK) then
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "kim_api_get_data_f", ier)
     stop
  endif
  N = numberOfParticles
  call KIM_to_F90_int_array_2d(neighborListdum, neighborlist, N+1, N)

  ! check mode and request
  if (mode.eq.0) then ! iterator mode
     if (request.eq.0) then ! reset iterator
        iterVal = 0
        get_neigh_no_Rij = KIM_STATUS_NEIGH_ITER_INIT_OK
        return
     elseif (request.eq.1) then ! increment iterator
        iterVal = iterVal + 1
        if (iterVal.gt.N) then
           get_neigh_no_Rij = KIM_STATUS_NEIGH_ITER_PAST_END
           return
        else
           atomToReturn = iterVal
        endif
     else
        idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                      "Invalid request in get_neigh_no_Rij", KIM_STATUS_NEIGH_INVALID_REQUEST)
        get_neigh_no_Rij = 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_f(__LINE__, THIS_FILE_NAME, &
                                      "Invalid atom ID in get_neigh_no_Rij", KIM_STATUS_PARTICLE_INVALID_ID)
        get_neigh_no_Rij = KIM_STATUS_PARTICLE_INVALID_ID
        return
     else
        atomToReturn = request
     endif
  else ! not iterator or locator mode
     idum = kim_api_report_error_f(__LINE__, THIS_FILE_NAME, &
                                   "Invalid mode in get_neigh_no_Rij", KIM_STATUS_NEIGH_INVALID_MODE)
     get_neigh_no_Rij = KIM_STATUS_NEIGH_INVALID_MODE
     return
  endif

  ! set the returned atom
  atom = atomToReturn

  ! set the returned number of neighbors for the returned atom
  numnei = neighborList(1,atom)

  ! set the location for the returned neighbor list
  pnei1atom = loc(neighborList(2,atom))

  ! set pointer to Rij to NULL
  pRij = 0

  get_neigh_no_Rij = KIM_STATUS_OK
  return
end function get_neigh_no_Rij

!-------------------------------------------------------------------------------
!
! create_FCC_configuration subroutine
!
!  creates a cubic configuration of FCC atoms with lattice spacing `FCCspacing' and
!  `nCellsPerSide' cells along each direction.
!
!  With periodic==.true. this will result in a total number of atoms equal to
!  4*(nCellsPerSide)**3 + 6*(nCellsPerSide)**2 + 3*(nCellsPerSide) + 1
!
!  With periodic==.false. this will result in a total number of atoms equal to
!  4*(nCellsPerSide)**3
!
!  Returns the Id of the atom situated in the middle of the configuration
!  (this atom will have the most neighbors.)
!
!-------------------------------------------------------------------------------
subroutine create_FCC_configuration(FCCspacing, nCellsPerSide, periodic, coords, MiddleAtomId)
  implicit none

  !-- Transferred variables
  double precision, intent(in)  :: FCCspacing
  integer,          intent(in)  :: nCellsPerSide
  logical,          intent(in)  :: periodic
  double precision, intent(out) :: coords(3,*)
  integer,          intent(out) :: MiddleAtomId
  !
  ! cluster setup variables
  !
  double precision FCCshifts(3,4)
  double precision latVec(3)
  integer a, i, j, k, m

  ! Create a cubic FCC cluster
  !
  FCCshifts(1,1) = 0.d0;           FCCshifts(2,1) = 0.d0;           FCCshifts(3,1) = 0.d0
  FCCshifts(1,2) = 0.5*FCCspacing; FCCshifts(2,2) = 0.5*FCCspacing; FCCshifts(3,2) = 0.d0
  FCCshifts(1,3) = 0.5*FCCspacing; FCCshifts(2,3) = 0.d0;           FCCshifts(3,3) = 0.5*FCCspacing
  FCCshifts(1,4) = 0.d0;           FCCshifts(2,4) = 0.5*FCCspacing; FCCshifts(3,4) = 0.5*FCCspacing

  MiddleAtomID = 1 ! Always put middle atom as #1
  a = 1            ! leave space for middle atom as atom #1
  do i=1,nCellsPerSide
     latVec(1) = (i-1)*FCCspacing
     do j=1,nCellsPerSide
        latVec(2) = (j-1)*FCCspacing
        do k=1,nCellsPerSide
           latVec(3) = (k-1)*FCCspacing
           do m=1,4
              a = a+1
              coords(:,a) = latVec + FCCshifts(:,m)
              if ((i.eq.nCellsPerside/2) .and. (j.eq.nCellsPerSide/2) .and. &
                   (k.eq.nCellsPerSide/2) .and. (m.eq.1)) then
                 coords(:,1) = latVec + FCCshifts(:,m) ! put middle atom as atom #1
                 a = a - 1
              endif
           enddo
        enddo
        if (.not. periodic) then
            ! Add in the remaining three faces
            ! pos-x face
            latVec(1) = nCellsPerSide*FCCspacing
            latVec(2) = (i-1)*FCCspacing
            latVec(3) = (j-1)*FCCspacing
            a = a+1; coords(:,a) = latVec
            a = a+1; coords(:,a) = latVec + FCCshifts(:,4)
            ! pos-y face
            latVec(1) = (i-1)*FCCspacing
            latVec(2) = nCellsPerSide*FCCspacing
            latVec(3) = (j-1)*FCCspacing
            a = a+1; coords(:,a) = latVec
            a = a+1; coords(:,a) = latVec + FCCshifts(:,3)
            ! pos-z face
            latVec(1) = (i-1)*FCCspacing
            latVec(2) = (j-1)*FCCspacing
            latVec(3) = nCellsPerSide*FCCspacing
            a = a+1; coords(:,a) = latVec
            a = a+1; coords(:,a) = latVec + FCCshifts(:,2)
         endif
     enddo
     if (.not. periodic) then
         ! Add in the remaining three edges
         latVec(1) = (i-1)*FCCspacing
         latVec(2) = nCellsPerSide*FCCspacing
         latVec(3) = nCellsPerSide*FCCspacing
         a = a+1; coords(:,a) = latVec
         latVec(1) = nCellsPerSide*FCCspacing
         latVec(2) = (i-1)*FCCspacing
         latVec(3) = nCellsPerSide*FCCspacing
         a = a+1; coords(:,a) = latVec
         latVec(1) = nCellsPerSide*FCCspacing
         latVec(2) = nCellsPerSide*FCCspacing
         latVec(3) = (i-1)*FCCspacing
         a = a+1; coords(:,a) = latVec
      endif
  enddo
  if (.not. periodic) then
      ! Add in the remaining corner
      a = a+1; coords(:,a) = nCellsPerSide*FCCspacing
  endif

  return

end subroutine create_FCC_configuration
