MODULE CRP_C4v_AtomSurface
  USE CRP_Constants
  USE CRP_General
  USE Spline

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: Initialize_CRP_C4v_AtomSurface_Module, &
            Initialize_CRP_C4v_AtomSurface_PES, &
            Calculate_CRP_C4v_AtomSurface_PES

  INTERFACE Calculate_CRP_C4v_AtomSurface_PES
    MODULE PROCEDURE Calculate_CRP_C4v_AtomSurface_PES_Scalar, &
                     Calculate_CRP_C4v_AtomSurface_PES_Array
  END INTERFACE

CONTAINS

  ! Initialize_CRP_C4v_AtomSurface_Module
  !   Initialize this module. Call before use.
  SUBROUTINE Initialize_CRP_C4v_AtomSurface_Module()
    IMPLICIT NONE
  END SUBROUTINE

  ! Initialize_CRP_C4v_AtomSurface_PES
  !   Initialize a PES.
  SUBROUTINE Initialize_CRP_C4v_AtomSurface_PES( PES )
    IMPLICIT NONE

    TYPE ( CRP_AtomSurface_PES ) :: PES
    CALL Read_PES_Info( PES )
    CALL Read_AtomSurface_Data( PES )
  END SUBROUTINE

  ! Read_PES_Info
  !   Read information about the PES from disk.
  SUBROUTINE Read_PES_Info( PES )
    IMPLICIT NONE

    INTEGER                      :: i, N
    TYPE ( CRP_AtomSurface_PES ) :: PES

    OPEN(87, FILE=TRIM(ADJUSTL(PES%DataSet)) // "/CRPData.3D", STATUS="OLD")
    READ(87, *) N
    PES%NumCuts = N
    ALLOCATE( PES%Cuts(N) )
    PES%Alloced = .TRUE.
    DO i = 1, N
      READ(87, *) PES%Cuts(i)%X, PES%Cuts(i)%Y, PES%Cuts(i)%FileName
    END DO
    CLOSE(87)
  END SUBROUTINE

  SUBROUTINE Calculate_CRP_C4v_AtomSurface_PES_Scalar( PES, X, Y, Z, V, Fx, Fy, Fz, OutUnits )
    IMPLICIT NONE

    TYPE ( CRP_AtomSurface_PES ) :: PES
    TYPE ( Units )               :: OutUnits
    REAL             :: X, Y, Z, V, Fx, Fy, Fz
    REAL             :: MyX, MyY, MyZ

    MyX = Convert_Length_Units( X, OutUnits, InternalUnits )
    MyY = Convert_Length_Units( Y, OutUnits, InternalUnits )
    MyZ = Convert_Length_Units( Z, OutUnits, InternalUnits )
    CALL int_PES6CuHATOMCu100( MyX, MyY, MyZ, V, Fx, Fy, Fz, PES )
    V = Convert_Energy_Units( V, InternalUnits, OutUnits )
    Fx = Convert_Force_Units( Fx, InternalUnits, OutUnits )
    Fy = Convert_Force_Units( Fy, InternalUnits, OutUnits )
    Fz = Convert_Force_Units( Fz, InternalUnits, OutUnits )
  END SUBROUTINE

  SUBROUTINE Calculate_CRP_C4v_AtomSurface_PES_Array( PES, R, V, F, OutUnits )
    IMPLICIT NONE

    TYPE ( CRP_AtomSurface_PES ) :: PES
    TYPE ( Units )               :: OutUnits
    REAL             :: R(3), V, F(3)
    INTEGER                      :: i
    REAL             :: MyR(3)

    DO i = 1, 3
      MyR(i) = Convert_Length_Units( R(i), OutUnits, InternalUnits )
    END DO
    CALL int_PES6CuHATOMCu100( MyR(1), MyR(2), MyR(3), V, F(1), F(2), F(3), PES )
    V = Convert_Energy_Units( V, InternalUnits, OutUnits )
    DO i = 1, 3
      F(i) = Convert_Force_Units( F(i), InternalUnits, OutUnits )
    END DO
  END SUBROUTINE

  SUBROUTINE ORIGEN( X, Y, Delta, BigX, BigY )
    IMPLICIT NONE

    REAL    :: X, Y, BigX, BigY, Delta, Ori(2)
    INTEGER :: i, Ind(2)

    Ori(1) = X / Delta
    Ori(2) = Y / Delta
    DO i = 1, 2
      IF ( Ori(i) .GE. 0.0 ) THEN
        Ind(i) = Ori(i)
      ELSE
        Ind(i) = Ori(i) - 1
      END IF
    END DO
    BigX = X - Ind(1) * Delta
    BigY = Y - Ind(2) * Delta
  END SUBROUTINE

  SUBROUTINE REGION( BigX0, BigY0, Delta, IRegion )
    IMPLICIT NONE

    REAL    :: BigX0, BigY0, Delta, Aux
    INTEGER :: IRegion
!C
!C     Let us approximately plot the regions here:
!C
!C     XXXXXXXXXXXXXXX
!C     X X    X    X X
!C     X  X 7 X 8 X  X
!C     X   X  X  X   X
!C     X 5  X X X  6 X
!C     X     XXX     X
!C     XXXXXXXXXXXXXXX
!C     X     XXX     X
!C     X 3  X X X  4 X
!C     X   X  X  X   X
!C     X  X 1 X 2 X  X
!C     X X    X    X X
!C     XXXXXXXXXXXXXXX
!C
!C
!C
!C     Lower half of the unit cell
!C
    IF ( BigY0 .LE. Delta / 2.0 ) THEN
      IF ( BigX0 .LE. Delta / 2.0 ) THEN
        IF ( BigX0 .GE. BigY0) THEN
          IRegion = 1
          RETURN
        ELSE
          IRegion = 3
          Aux = BigX0
          BigX0 = BigY0
          BigY0 = Aux
          RETURN
        END IF
      ELSE
        IF ( BigY0 .GE. (Delta - BigX0) ) THEN
          IRegion = 4
          Aux = BigX0
          BigX0 = BigY0
          BigY0 = Delta - Aux
          RETURN
        ELSE
          IRegion = 2
          BigX0 = Delta - BigX0
          RETURN
        END IF
      END IF
!C
!C     Lower half of the unit cell
!C
    ELSE
      IF ( BigX0 .LE. Delta / 2.0 ) THEN
        IF ( BigY0 .GT. (Delta - BigX0) ) THEN
          IRegion = 7
          BigY0 = Delta - BigY0
          RETURN
        ELSE
          IRegion = 5
          Aux = BigX0
          BigX0 = Delta - BigY0
          BigY0 = Aux
          RETURN
        END IF
      ELSE
        IF ( BigX0 .GT. BigY0 ) THEN
          IRegion = 6
          Aux = BigX0
          BigX0 = Delta - BigY0
          BigY0 = Delta - Aux
          RETURN
        ELSE
          IRegion = 8
          BigX0 = Delta - BigX0
          BigY0 = Delta - BigY0
          RETURN
        END IF
      END IF
    END IF
!C
!C     If we arrive here is that there was some error in the coordinates
!C
    WRITE (*,*) 'ERROR IN REGION'
    STOP
  END SUBROUTINE

  SUBROUTINE TRANSF( IRegion, dVdX, dVdY )
    IMPLICIT NONE

    INTEGER :: IRegion
    REAL    :: dVdX, dVdY, Aux

!C     Aqui se transforman las derivadas segun la ubicacion
    IF ( IRegion .EQ. 1 ) THEN
      RETURN
    ELSE IF ( IRegion .EQ. 2 ) THEN
      dVdX = -dVdX
      RETURN
    ELSE IF ( IRegion .EQ. 3 ) THEN
      Aux = dVdX
      dVdX = dVdY
      dVdY = Aux
      RETURN
    ELSE IF ( IRegion .EQ. 4 ) THEN
      Aux = dVdX
      dVdX = -dVdY
      dVdY = Aux
      RETURN
    ELSE IF ( IRegion .EQ. 5 ) THEN
      Aux = dVdX
      dVdX = dVdY
      dVdY = -Aux
      RETURN
    ELSE IF ( IRegion .EQ. 6 ) THEN
      Aux = dVdX
      dVdX = -dVdY
      dVdY = -Aux
      RETURN
    ELSE IF ( IRegion .EQ. 7 ) THEN
      dVdY = -dVdY
      RETURN
    ELSE IF ( IRegion .EQ. 8 ) THEN
      dVdX = -dVdX
      dVdY = -dVdY
      RETURN
    END IF

!C     If we arrive here is that there was some error in the IREG index.
    WRITE (*,*) 'ERROR IN TRANSF'
    STOP
  END SUBROUTINE

  SUBROUTINE Read_AtomSurface_Data( PES )
!C     ------------------------------------------------------------------
!C     A pesar de que en esta rutina se leen los diferentes valores
!C     tabulados de Z. Dichos valores deben ser siempre los mismos
!C     para todos los sitios ! ! ! !  ATENCION: esto NO lo controla
!C     la rutina ! ! ! !
!C     ------------------------------------------------------------------
    IMPLICIT NONE

    TYPE (CRP_AtomSurface_PES) :: PES
    INTEGER :: i, j, k
    REAL :: dz1, dz2

    REAL :: b0, b1, b2, delta, deriz, pot, vm1
    REAL :: der1(SIZE(PES%Cuts)), der2(SIZE(PES%Cuts))

!     ------------------------------------------------------------
!     Reading the data for the repulsive 1D potential

    OPEN(10, FILE=TRIM(ADJUSTL(PES%DataSet)) // "/Atom/intrep.dat", STATUS="OLD")
    READ(10, *) dz1
    READ(10, *) dz2
    dz1 = Convert_Force_Units( dz1, PES%InputUnits, InternalUnits )
    dz2 = Convert_Force_Units( dz2, PES%InputUnits, InternalUnits )
    READ(10, *) PES%CorrugationFunction1D%NX
    CALL Allocate_Spline1D( PES%CorrugationFunction1D, PES%CorrugationFunction1D%NX )
    DO i = 1, PES%CorrugationFunction1D%NX
      READ(10, *) PES%CorrugationFunction1D%X(i), PES%CorrugationFunction1D%F(i)
      PES%CorrugationFunction1D%X(i) = Convert_Length_Units( PES%CorrugationFunction1D%X(i), PES%InputUnits, InternalUnits )
      PES%CorrugationFunction1D%F(i) = Convert_Energy_Units( PES%CorrugationFunction1D%F(i), PES%InputUnits, InternalUnits )
    END DO
    CLOSE(10)

    CALL Compute_Spline1D( PES%CorrugationFunction1D, 2, dz1, 2, dz2 )

!   Now read all cuts from disk...
    DO j = 1, SIZE(PES%Cuts)
      OPEN(10, FILE=TRIM(ADJUSTL(PES%DataSet)) // "/Atom/" // TRIM(ADJUSTL(PES%Cuts(j)%FileName)), STATUS="OLD")
      READ(10, *) PES%Cuts(j)%Spline%NX
      CALL Allocate_Spline1D( PES%Cuts(j)%Spline, PES%Cuts(j)%Spline%NX )
      READ(10, *) dz1
      READ(10, *) dz2
      dz1 = Convert_Force_Units( dz1, PES%InputUnits, InternalUnits )
      dz2 = Convert_Force_Units( dz2, PES%InputUnits, InternalUnits )
      DO i = 1, PES%Cuts(j)%Spline%NX
        READ(10, *) PES%Cuts(j)%Spline%X(i), pot
        PES%Cuts(j)%Spline%X(i) = Convert_Length_Units( PES%Cuts(j)%Spline%X(i), PES%InputUnits, InternalUnits )
        pot = Convert_Energy_Units( pot, PES%InputUnits, InternalUnits )

        IF ( j .GT. 1 .AND. PES%Cuts(j)%Spline%X(i) .NE. PES%Cuts(1)%Spline%X(i) ) THEN
          PRINT *, "Error in data for site ", j
          STOP
        END IF

        CALL MURO(PES%Cuts(j)%X * PES%Geometry%LatticeConstant, PES%Cuts(j)%Y * PES%Geometry%LatticeConstant, &
                  PES%Cuts(j)%Spline%X(i), vm1, b0, b1, deriz, PES)
        PES%Cuts(j)%Spline%F(i) = pot - vm1
        IF (i .EQ. 1) THEN
          der1(j) = dz1 - deriz
        END IF
        IF (i .EQ. PES%Cuts(j)%Spline%NX) THEN
          der2(j) = dz2 - deriz
        END IF
      END DO
      CLOSE(10)

      CALL Compute_Spline1D( PES%Cuts(j)%Spline, 2, der1(j), 2, der2(j) )
    END DO

    CALL Allocate_Spline3DPeriodic( PES%SplineFunction, 5, 5, PES%Cuts(1)%Spline%NX )

    DO i = 1, 5
      PES%SplineFunction%X(i) = FLOAT(i - 1) * PES%Geometry%LatticeConstant * 0.25
    END DO

    DO j = 1, 5
      PES%SplineFunction%Y(j) = FLOAT(j - 1) * PES%Geometry%LatticeConstant * 0.25
    END DO

    DO i = 1, PES%Cuts(1)%Spline%NX
      PES%SplineFunction%Z(i) = PES%Cuts(1)%Spline%X(i)
    END DO

    ! Symmetrize the potential on top
    DO i = 1, PES%Cuts(1)%Spline%NX
      PES%SplineFunction%F(1, 1, i) = PES%Cuts(1)%Spline%F(i)
      PES%SplineFunction%F(1, 5, i) = PES%SplineFunction%F(1, 1, i)
      PES%SplineFunction%F(5, 1, i) = PES%SplineFunction%F(1, 1, i)
      PES%SplineFunction%F(5, 5, i) = PES%SplineFunction%F(1, 1, i)
      IF ( i .EQ. 1 ) THEN
        PES%SplineFunction%Der1(1, 1) = Der1(1)
        PES%SplineFunction%Der1(1, 5) = PES%SplineFunction%Der1(1, 1)
        PES%SplineFunction%Der1(5, 1) = PES%SplineFunction%Der1(1, 1)
        PES%SplineFunction%Der1(5, 5) = PES%SplineFunction%Der1(1, 1)
      END IF
      IF ( i .EQ. PES%Cuts(1)%Spline%NX ) THEN
        PES%SplineFunction%Der2(1, 1) = Der2(1)
        PES%SplineFunction%Der2(1, 5) = PES%SplineFunction%Der2(1, 1)
        PES%SplineFunction%Der2(5, 1) = PES%SplineFunction%Der2(1, 1)
        PES%SplineFunction%Der2(5, 5) = PES%SplineFunction%Der2(1, 1)
      END IF
    END DO

    ! Symnetrize the potential on hollow
    DO i = 1, PES%Cuts(2)%Spline%NX
      PES%SplineFunction%F(3, 3, i) = PES%Cuts(2)%Spline%F(i)
      IF ( i .EQ. 1 ) THEN
        PES%SplineFunction%Der1(3, 3) = Der1(2)
      END IF
      IF ( i .EQ. PES%Cuts(2)%Spline%NX ) THEN
        PES%SplineFunction%Der2(3, 3) = Der2(2)
      END IF
    END DO

    ! Symmetrize the potential on bridge
    DO i = 1, PES%Cuts(3)%Spline%NX
      PES%SplineFunction%F(3, 1, i) = PES%Cuts(3)%Spline%F(i)
      PES%SplineFunction%F(1, 3, i) = PES%SplineFunction%F(3, 1, i)
      PES%SplineFunction%F(5, 3, i) = PES%SplineFunction%F(3, 1, i)
      PES%SplineFunction%F(3, 5, i) = PES%SplineFunction%F(3, 1, i)
      IF ( i .EQ. 1 ) THEN
        PES%SplineFunction%Der1(3, 1) = Der1(3)
        PES%SplineFunction%Der1(1, 3) = PES%SplineFunction%Der1(3, 1)
        PES%SplineFunction%Der1(5, 3) = PES%SplineFunction%Der1(3, 1)
        PES%SplineFunction%Der1(3, 5) = PES%SplineFunction%Der1(3, 1)
      END IF
      IF ( i .EQ. PES%Cuts(3)%Spline%NX ) THEN
        PES%SplineFunction%Der2(3, 1) = Der2(3)
        PES%SplineFunction%Der2(1, 3) = PES%SplineFunction%Der2(3, 1)
        PES%SplineFunction%Der2(5, 3) = PES%SplineFunction%Der2(3, 1)
        PES%SplineFunction%Der2(3, 5) = PES%SplineFunction%Der2(3, 1)
      END IF
    END DO

    ! Symmetrize the potential on t2h
    DO i = 1, PES%Cuts(4)%Spline%NX
      PES%SplineFunction%F(2, 2, i) = PES%Cuts(4)%Spline%F(i)
      PES%SplineFunction%F(4, 4, i) = PES%SplineFunction%F(2, 2, i)
      PES%SplineFunction%F(4, 2, i) = PES%SplineFunction%F(2, 2, i)
      PES%SplineFunction%F(2, 4, i) = PES%SplineFunction%F(2, 2, i)
      IF ( i .EQ. 1 ) THEN
        PES%SplineFunction%Der1(2, 2) = Der1(4)
        PES%SplineFunction%Der1(4, 4) = PES%SplineFunction%Der1(2, 2)
        PES%SplineFunction%Der1(4, 2) = PES%SplineFunction%Der1(2, 2)
        PES%SplineFunction%Der1(2, 4) = PES%SplineFunction%Der1(2, 2)
      END IF
      IF ( i .EQ. PES%Cuts(4)%Spline%NX ) THEN
        PES%SplineFunction%Der2(2, 2) = Der2(4)
        PES%SplineFunction%Der2(4, 4) = PES%SplineFunction%Der2(2,2)
        PES%SplineFunction%Der2(4, 2) = PES%SplineFunction%Der2(2,2)
        PES%SplineFunction%Der2(2, 4) = PES%SplineFunction%Der2(2,2)
      END IF
    END DO

    ! Symmetrize the potential on b2h
    DO i = 1, PES%Cuts(5)%Spline%NX
      PES%SplineFunction%F(3, 2, i) = PES%Cuts(5)%Spline%F(i)
      PES%SplineFunction%F(2, 3, i) = PES%SplineFunction%F(3, 2, i)
      PES%SplineFunction%F(4, 3, i) = PES%SplineFunction%F(3, 2, i)
      PES%SplineFunction%F(3, 4, i) = PES%SplineFunction%F(3, 2, i)
      IF ( i .EQ. 1 ) THEN
        PES%SplineFunction%Der1(3, 2) = Der1(5)
        PES%SplineFunction%Der1(2, 3) = PES%SplineFunction%Der1(3, 2)
        PES%SplineFunction%Der1(4, 3) = PES%SplineFunction%Der1(3, 2)
        PES%SplineFunction%Der1(3, 4) = PES%SplineFunction%Der1(3, 2)
      END IF
      IF ( i .EQ. PES%Cuts(5)%Spline%NX ) THEN
        PES%SplineFunction%Der2(3, 2) = Der2(5)
        PES%SplineFunction%Der2(2, 3) = PES%SplineFunction%Der2(3, 2)
        PES%SplineFunction%Der2(4, 3) = PES%SplineFunction%Der2(3, 2)
        PES%SplineFunction%Der2(3, 4) = PES%SplineFunction%Der2(3, 2)
      END IF
    END DO

    ! Symmetrize the potential on t2b
    DO i = 1, PES%Cuts(6)%Spline%NX
      PES%SplineFunction%F(2, 1, i) = PES%Cuts(6)%Spline%F(i)
      PES%SplineFunction%F(4, 1, i) = PES%SplineFunction%F(2, 1, i)
      PES%SplineFunction%F(1, 2, i) = PES%SplineFunction%F(2, 1, i)
      PES%SplineFunction%F(5, 2, i) = PES%SplineFunction%F(2, 1, i)
      PES%SplineFunction%F(1, 4, i) = PES%SplineFunction%F(2, 1, i)
      PES%SplineFunction%F(5, 4, i) = PES%SplineFunction%F(2, 1, i)
      PES%SplineFunction%F(2, 5, i) = PES%SplineFunction%F(2, 1, i)
      PES%SplineFunction%F(4, 5, i) = PES%SplineFunction%F(2, 1, i)
      IF ( i .EQ. 1 ) THEN
        PES%SplineFunction%Der1(2, 1) = Der1(6)
        PES%SplineFunction%Der1(4, 1) = PES%SplineFunction%Der1(2, 1)
        PES%SplineFunction%Der1(1, 2) = PES%SplineFunction%Der1(2, 1)
        PES%SplineFunction%Der1(5, 2) = PES%SplineFunction%Der1(2, 1)
        PES%SplineFunction%Der1(1, 4) = PES%SplineFunction%Der1(2, 1)
        PES%SplineFunction%Der1(5, 4) = PES%SplineFunction%Der1(2, 1)
        PES%SplineFunction%Der1(2, 5) = PES%SplineFunction%Der1(2, 1)
        PES%SplineFunction%Der1(4, 5) = PES%SplineFunction%Der1(2, 1)
      END IF
      IF ( i .EQ. PES%Cuts(6)%Spline%NX ) THEN
        PES%SplineFunction%Der2(2, 1) = Der2(6)
        PES%SplineFunction%Der2(4, 1) = PES%SplineFunction%Der2(2, 1)
        PES%SplineFunction%Der2(1, 2) = PES%SplineFunction%Der2(2, 1)
        PES%SplineFunction%Der2(5, 2) = PES%SplineFunction%Der2(2, 1)
        PES%SplineFunction%Der2(1, 4) = PES%SplineFunction%Der2(2, 1)
        PES%SplineFunction%Der2(5, 4) = PES%SplineFunction%Der2(2, 1)
        PES%SplineFunction%Der2(2, 5) = PES%SplineFunction%Der2(2, 1)
        PES%SplineFunction%Der2(4, 5) = PES%SplineFunction%Der2(2, 1)
      END IF
    END DO

    CALL Compute_Spline3D_Periodic( PES%SplineFunction )
  END SUBROUTINE

!*********************************************************************************************
  SUBROUTINE MURO( X, Y, Z, V, dVX, dVY, dVZ, PES )
    IMPLICIT NONE

    INTEGER, PARAMETER :: nvec = 32
    REAL :: alpha, vec(nvec, 3), V, X, Y, Z, dVX, dVY, dVZ, r, Vr, dVdr, xij, yij, zij
    INTEGER :: i
    TYPE ( CRP_AtomSurface_PES ) :: PES
    parameter (ALPHA=0.97212628726799359364d0)

    VEC(1,1)=0.
    VEC(1,2)=-2.
    VEC(1,3)=0.
    VEC(2,1)=-1.
    VEC(2,2)=-1.
    VEC(2,3)=0.
    VEC(3,1)=0.
    VEC(3,2)=-1.
    VEC(3,3)=0.
    VEC(4,1)=1.
    VEC(4,2)=-1.
    VEC(4,3)=0
    VEC(5,1)=2.
    VEC(5,2)=-1.
    VEC(5,3)=0.
    VEC(6,1)=-2.
    VEC(6,2)=0.
    VEC(6,3)=0.
    VEC(7,1)=-1.
    VEC(7,2)=0.
    VEC(7,3)=0.
    VEC(8,1)=0.
    VEC(8,2)=0.
    VEC(8,3)=0.
    VEC(9,1)=1.
    VEC(9,2)=0.
    VEC(9,3)=0.
    VEC(10,1)=2.
    VEC(10,2)=0.
    VEC(10,3)=0.
    VEC(11,1)=-1.
    VEC(11,2)=1.
    VEC(11,3)=0.
    VEC(12,1)=0.
    VEC(12,2)=1.
    VEC(12,3)=0.
    VEC(13,1)=1.
    VEC(13,2)=1.
    VEC(13,3)=0.
    VEC(14,1)=2.
    VEC(14,2)=1.
    VEC(14,3)=0.
    VEC(15,1)=0.
    VEC(15,2)=2.
    VEC(15,3)=0.
    VEC(16,1)=1.
    VEC(16,2)=2.
    VEC(16,3)=0.
    VEC(17,1)=-0.5
    VEC(17,2)=-1.5
    VEC(17,3)=-1.
    VEC(18,1)=0.5
    VEC(18,2)=-1.5
    VEC(18,3)=-1.
    VEC(19,1)=1.5
    VEC(19,2)=-1.5
    VEC(19,3)=-1.
    VEC(20,1)=-1.5
    VEC(20,2)=-0.5
    VEC(20,3)=-1.
    VEC(21,1)=-0.5
    VEC(21,2)=-0.5
    VEC(21,3)=-1.
    VEC(22,1)=0.5
    VEC(22,2)=-0.5
    VEC(22,3)=-1.
    VEC(23,1)=1.5
    VEC(23,2)=-0.5
    VEC(23,3)=-1.
    VEC(24,1)=-1.5
    VEC(24,2)=0.5
    VEC(24,3)=-1.
    VEC(25,1)=-0.5
    VEC(25,2)=0.5
    VEC(25,3)=-1.
    VEC(26,1)=0.5
    VEC(26,2)=0.5
    VEC(26,3)=-1.
    VEC(27,1)=1.5
    VEC(27,2)=0.5
    VEC(27,3)=-1.
    VEC(28,1)=2.5
    VEC(28,2)=0.5
    VEC(28,3)=-1.
    VEC(29,1)=-0.5
    VEC(29,2)=1.5
    VEC(29,3)=-1.
    VEC(30,1)=0.5
    VEC(30,2)=1.5
    VEC(30,3)=-1.
    VEC(31,1)=1.5
    VEC(31,2)=1.5
    VEC(31,3)=-1.
    VEC(32,1)=0.5
    VEC(32,2)=2.5
    VEC(32,3)=-1.

    V = 0.0
    dVX = 0.0
    dVY = 0.0
    dVZ = 0.0
    DO i = 1, nVec
      Xij = Vec(i, 1) * PES%Geometry%LatticeConstant
      Yij = Vec(i, 2) * PES%Geometry%LatticeConstant

      ! WARNING: this code only works properly for the first sublevel of
      ! atoms... no more is included in the above list.
      IF ( PES%Geometry%InterlayerSpacings(1) .LT. 0.0 ) THEN
        Zij = -Vec(i, 3) * PES%Geometry%InterlayerSpacings(1) * PES%Geometry%LatticeConstant / SQRT(2.0)
      ELSE
        Zij = Vec(i, 3) * PES%Geometry%InterlayerSpacings(1)
      END IF
      R = SQRT((X - Xij)**2.0 + (Y - Yij)**2.0 + (Z - Zij)**2.0)
      CALL VREP1D( R, Vr, dVdR, PES )
      V = V + Vr
      IF ( R .GT. 0.0 ) THEN
        dVX = dVX + dVdR * (X - Xij) / R
        dVY = dVY + dVdR * (Y - Yij) / R
        dVZ = dVZ + dVdR * (Z - Zij) / R
      END IF
    END DO
  END SUBROUTINE

!*********************************************************************************************
  SUBROUTINE VREP1D( R, Vr, dVdR, PES )
    IMPLICIT NONE

    REAL :: R, Vr, dVdR
    TYPE (CRP_AtomSurface_PES) :: PES

    IF ( R .GT. PES%CorrugationFunction1D%X(PES%CorrugationFunction1D%NX) ) THEN
      VR = 0.0
      DVDR = 0.0
      RETURN
    ENDIF
    IF ( R .LT. 0.0 ) THEN
       WRITE(*,*)'Error en VREP1D: R<0'
       STOP
    ENDIF
    CALL SPLINT(PES%CorrugationFunction1D%X, PES%CorrugationFunction1D%F, PES%CorrugationFunction1D%Coefs, &
                PES%CorrugationFunction1D%NX, r, vr, dvdr)
  END SUBROUTINE

!****************************************************************************************************
  SUBROUTINE int_PES6CuHATOMCu100( X0, Y0, Z0, V, dVdX, dVdY, dVdZ, PES )
    IMPLICIT NONE

    REAL :: X0, Y0, Z0, F0, V, dVdX, dVdY, dVdZ, BigX0, BigY0, X0C, Y0C
    REAL :: VRepul, dVRepdX, dVRepdY, dVRepdZ, dX, dY, dZ
    INTEGER :: IReg
    INTEGER, PARAMETER :: idx = 5, idy = 5, idz = 53
    TYPE ( CRP_AtomSurface_PES ) :: PES

    IF ( Z0 .GE. PES%SplineFunction%Z(PES%SplineFunction%NZ) ) THEN
      V = 0.0
      dVdX = 0.0
      dVdY = 0.0
      dVdZ = 0.0
      RETURN
    END IF

    CALL ORIGEN( X0, Y0, PES%Geometry%LatticeConstant, BigX0, BigY0)
    CALL REGION( BigX0, BigY0, PES%Geometry%LatticeConstant, IReg)

!   -------------------------------
!   Calculate the repulsive potential
    X0C = BigX0
    Y0C = BigY0
    CALL MURO( X0C, Y0C, Z0, VRepul, dVRepdX, dVRepdY, dVRepdZ, PES )

    CALL Evaluate_Spline3D_Periodic( PES%SplineFunction, X0C, Y0C, Z0, F0, dX, dY, dZ )

    V = (F0 + VRepul)
    dVdX = (dX + dVRepdX)
    dVdY = (dY + dVRepdY)
    dVdZ = (dZ + dVRepdZ)
    CALL TRANSF( IReg, dVdX, dVdY)
  END SUBROUTINE
END MODULE
