!---------------------------------------------------------------------------
! This module has been modified to use a larger reference cluster in the
! calculation of atomic potentials.
!
! E.W.F. Smeets  6-2-18
!---------------------------------------------------------------------------

MODULE CRP_C3v_AtomSurface

  USE CRP_Constants
  USE CRP_General
  USE Spline

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: Initialize_CRP_C3v_AtomSurface_Module, &
            Initialize_CRP_C3v_AtomSurface_PES, &
            Calculate_CRP_C3v_AtomSurface_PES

  INTEGER, PARAMETER :: idf3 = 10
  REAL   :: fouri3D(idf3, idf3)
!  INTEGER, PARAMETER :: idz = 57, idrep = 46
  REAL, PARAMETER :: sq3 = 1.7320508075688772935, usq3 = 1.0 / sq3

  INTEGER :: CRP_C3v_AtomSurface_Module_SetUp = 0

  INTERFACE Calculate_CRP_C3v_AtomSurface_PES
    MODULE PROCEDURE Calculate_CRP_C3v_AtomSurface_PES_Scalar, &
                     Calculate_CRP_C3v_AtomSurface_PES_Array
  END INTERFACE

CONTAINS

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

    IF ( CRP_C3v_AtomSurface_Module_SetUp .LT. 1 ) THEN
      CRP_C3v_AtomSurface_Module_SetUp = 1
      CALL FOUR3D()
    END IF
  END SUBROUTINE

  ! Initialize_CRP_C3v_AtomSurface_PES
  !   Initialize a PES.
  SUBROUTINE Initialize_CRP_C3v_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_C3v_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 ATII( 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_C3v_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 ATII( 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

  ! Read_AtomSurface_Data
  !   This programs reads the data files for the 3D PES and determines
  !   the 3D Interpolation function. The 1D potential is read from the
  !   file INTREP.DAT and calculated by interpolation in murII.
  !   WARNING: the Z values must be the same for all sites.
  SUBROUTINE Read_AtomSurface_Data( PES )
    IMPLICIT NONE

    TYPE ( CRP_AtomSurface_PES ) :: PES

!   DELTA: is the nearest neighbour distance on the surface
!   IDELTA=233 means delta is in Angstroms
!   IDELTA=247 means delta is in a.u.
!    REAL :: delta
!    INTEGER          :: idelta

!    REAL :: potfin, derifin
!    REAL :: vasint

    REAL :: b0, b1, der1, der2, deriz, dz1, dz2, pot, vm1
    INTEGER          :: i, j

! ----------------------------------------------------
!  First we read the 1D corrugation reducing function
! ----------------------------------------------------
    OPEN(10, FILE=TRIM(ADJUSTL(PES%DataSet)) // "/Atom/intrep.dat", STATUS="OLD")
!    READ(10, *) delta, idelta
!    READ(10, *) vasint
    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
!EWF
!EWF
!   PRINT *, "READ intrep OK"
!EWF
    CLOSE(10)

    CALL Compute_Spline1D( PES%CorrugationFunction1D, 2, dz1, 2, dz2 )
!    potfin = PES%CorrugationFunction1D%V(PES%CorrugationFunction1D%N)
!    derifin = dz2

! ---------------------------------------------------------------
!  Then we read the cuts through the 3D PES at the various sites
! ---------------------------------------------------------------
    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 MURII(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 = dz1 - deriz
        END IF
        IF (i .EQ. PES%Cuts(j)%Spline%NX) THEN
          der2 = dz2 - deriz
        END IF
      END DO
      CLOSE(10)
!EWF
!EWF  now to make sure that we read in the file
!      PRINT *, "READ ATOM OK: ", PES%Cuts(j)%FileName
!EWF 
      CALL Compute_Spline1D( PES%Cuts(j)%Spline, 2, der1, 2, der2 )
    END DO
  END SUBROUTINE

!************************ F O U R 3 D ******************************
!     Matrix allowing to calculate the coefficients of the Fourier
!     interpolation for the 3D Interpolation Function.
!     This matrix depends on the set of reference sites.
!*******************************************************************
  SUBROUTINE FOUR3D()
    IMPLICIT NONE

    REAL :: tour(idf3, idf3)
    INTEGER          :: i, j

    DATA tour/3.0,9.0,3.0,9.0,3*18.0,9.0,18.0,3.0, &
              6.0,-6.0,-3.0,3.0,-12.0,24.0,0.0,3.0,-12.0,-3.0, &
              2*0.0,2*-5.19615242270663188056,-20.78460969082652752224, &
              2*0.0,5.19615242270663188056,20.78460969082652752224, &
              5.19615242270663188056, &
              6.0,-6.0,6.0,-6.0,2*6.0,-18.0,-6.0,2*6.0, &
              6.0,18.0,-3.0,-9.0,3*0.0,-9.0,0.0,-3.0, &
              2*0.0,5.19615242270663188056,-15.58845726811989564168, &
              3*0.0,15.58845726811989564168,0.0,-5.19615242270663188056, &
              6.0,-6.0,-3.0,3.0,6.0,-12.0,0.0,3.0,6.0,-3.0, &
              2*0.0,2*-5.19615242270663188056,10.39230484541326376112, &
              2*0.0,5.19615242270663188056,-10.39230484541326376112, &
              5.19615242270663188056, &
              3.0,-3.0,3.0,-3.0,2*-6.0,18.0,-3.0,-6.0,3.0, &
              2.0,6.0,2.0,6.0,3*-6.0,6.0,-6.0,2.0/

    DO i = 1, idf3
      DO j = 1, idf3
        fouri3D(i, j) = tour(i, j) / 108.0
      END DO
    END DO
  END SUBROUTINE

!************************ A T I I **************************************
!     Calculation of the 3D potential as well as its
!     first derivatives using the Fourier series expansion.
!     The atom position is xa, ya, za.

!     FOURI3D: comes from the solution of the linear system associated
!              with the Fourier expansion and reference sites. It is
!              calculated in FOUR3D which is called within the input
!              data reading routine because it must be called once before
!              the first call to ATII
!      Version 1.0           H.F. Busnengo        09/09/10
!***********************************************************************
  SUBROUTINE ATII( xa, ya, za, v, dvdx, dvdy, dvdz, PES )
    IMPLICIT NONE

    TYPE ( CRP_AtomSurface_PES ) :: PES

    REAL :: xa, ya, za, v, dvdx, dvdy, dvdz
    REAL :: vrep, dvrepdx, dvrepdy, dvrepdz
    REAL :: x0c, y0c

    REAL :: a(idf3), fxy(idf3), dfdx(idf3), dfdy(idf3), b(idf3)
    REAL :: vs(idf3), dvsdz(idf3)

    INTEGER :: i, j, ksit

!   Contribution from 1D potential
    CALL ORIGEN2(xa, ya, PES%Geometry%LatticeConstant, x0c, y0c)
    CALL MURII(x0c, y0c, za, vrep, dvrepdx, dvrepdy, dvrepdz, PES)

!   Interpolation over Z for each site
    IF (za .LT. PES%Cuts(1)%Spline%X(1) .OR. za .GT. PES%Cuts(1)%Spline%X(PES%Cuts(1)%Spline%NX)) THEN
      PRINT *, "ERROR: Z outside range for 3D PES", za
      STOP
    END IF

    DO i = 1, SIZE(PES%Cuts)
      vs(i) = Evaluate_Spline1D( PES%Cuts(i)%Spline, za )
      dvsdz(i) = Evaluate_Spline1D_Derivative( PES%Cuts(i)%Spline, za )
    END DO

!   Calculate basis functions for Fourier expansion
    CALL FOUR3II( xa, ya, fxy, dfdx, dfdy, PES )

!   Calculation of potential and derivatives
    v = 0.0
    dvdx = 0.0
    dvdy = 0.0
    dvdz = 0.0

    DO j = 1, idf3
      a(j) = 0.0
      b(j) = 0.0
      DO ksit = 1, idf3
        a(j) = a(j) + fouri3D(ksit, j) * vs(ksit)
        b(j) = b(j) + fouri3D(ksit, j) * dvsdz(ksit)
      END DO
      v = v + a(j) * fxy(j)
      dvdx = dvdx + a(j) * dfdx(j)
      dvdy = dvdy + a(j) * dfdy(j)
      dvdz = dvdz + b(j) * fxy(j)
    END DO

!   Addition of 1D term y para que al infinito valga cero,
!   NO se suma VASINT.
    v = v + vrep
    dvdx = dvdx + dvrepdx
    dvdy = dvdy + dvrepdy
    dvdz = dvdz + dvrepdz
  END SUBROUTINE

!************************ F O U R 3 I I ******************************
!     Calculates the basis functions of the Fourier expansion and
!     their derivatives with respect to X and Y. 3D potential.
!*********************************************************************
  SUBROUTINE FOUR3II( xa, ya, fxy, dfdx, dfdy, PES )
    IMPLICIT NONE

    REAL :: xa, ya
    REAL :: fxy(idf3), dfdx(idf3), dfdy(idf3)

    TYPE ( CRP_AtomSurface_PES ) :: PES

    INTEGER :: i

    REAL :: fac, bigx, bigy, fbigx, fbigy
    REAL :: c2a, c2b, c2c, s2a, s2b, s2c
    REAL :: c3a, c3b, c3c, s3a, s3b, s3c
    REAL :: c4a, c4b, c4c, s4a, s4b, s4c
    REAL :: c5a, c5b, c5c, c5d, c5e, c5f, s5a, s5b, s5c, s5d, s5e, s5f
    REAL :: c6a, c6b, c6c, s6a, s6b, s6c
    REAL :: c7a, c7b, c7c, s7a, s7b, s7c

    fac = 2.0 * CRP_Constants_PI / PES%Geometry%LatticeConstant
    bigx = xa - ya * usq3
    bigy = 2.0 * ya * usq3
    fbigx = fac * bigx
    fbigy = fac * bigy

!   Basis functions and derivatives with respect to crystal coordinates
    fxy(1) = 1.0
    dfdx(1) = 0.0
    dfdy(1) = 0.0

    c2a = COS(fbigx)
    c2b = COS(fbigy)
    c2c = COS(fbigx + fbigy)
    s2a = SIN(fbigx)
    s2b = SIN(fbigy)
    s2c = SIN(fbigx + fbigy)

    fxy(2) = c2a + c2b + c2c
    dfdx(2) = -fac * (s2a + s2c)
    dfdy(2) = -fac * (s2b + s2c)

    fxy(3) =- s2a - s2b + s2c
    dfdx(3) = -fac * (c2a - c2c)
    dfdy(3) = -fac * (c2b - c2c)

    c3a = COS(2.0 * fbigx + fbigy)
    c3b = COS(fbigx + 2.0 * fbigy)
    c3c = COS(fbigx - fbigy)
    s3a = SIN(2.0 * fbigx + fbigy)
    s3b = SIN(fbigx + 2.0 * fbigy)
    s3c = SIN(fbigx - fbigy)

    fxy(4) = c3a + c3b + c3c
    dfdx(4) = -fac * (2.0 * s3a + s3b + s3c)
    dfdy(4) = -fac * (s3a + 2.0 * s3b - s3c)

    c4a = COS(2.0 * fbigx)
    c4b = COS(2.0 * fbigy)
    c4c = COS(2.0 * (fbigx + fbigy))
    s4a = SIN(2.0 * fbigx)
    s4b = SIN(2.0 * fbigy)
    s4c = SIN(2.0 * (fbigx + fbigy))

    fxy(5) = c4a + c4b + c4c
    dfdx(5) = -2.0 * fac * (s4a + s4c)
    dfdy(5) = -2.0 * fac * (s4b + s4c)

    fxy(6) = -s4a - s4b + s4c
    dfdx(6) = -2.0 * fac * (c4a - c4c)
    dfdy(6) = -2.0 * fac * (c4b - c4c)

    c5a = COS(3.0 * fbigx + fbigy)
    c5b = COS(fbigx + 3.0 * fbigy)
    c5c = COS(2.0 * fbigx + 3.0 * fbigy)
    c5d = COS(3.0 * fbigx + 2.0 * fbigy)
    c5e = COS(-fbigx + 2.0 * fbigy)
    c5f = COS(2.0 * fbigx - fbigy)
    s5a = SIN(3.0 * fbigx + fbigy)
    s5b = SIN(fbigx + 3.0 * fbigy)
    s5c = SIN(2.0 * fbigx + 3.0 * fbigy)
    s5d = SIN(3.0 * fbigx + 2.0 * fbigy)
    s5e = SIN(-fbigx + 2.0 * fbigy)
    s5f = SIN(2.0 * fbigx - fbigy)

    fxy(7) = c5a + c5b + c5c + c5d + c5e + c5f
    dfdx(7) = -fac * (3.0 * s5a + s5b + 2.0 * s5c + 3.0 * s5d - s5e + 2.0 * s5f)
    dfdy(7) = -fac * (s5a + 3.0 * s5b + 3.0 * s5c + 2.0 * s5d + 2.0 * s5e - s5f)

    fxy(8) = -s5a - s5b + s5c + s5d - s5e - s5f
    dfdx(8) = fac * (-3.0 * c5a - c5b + 2.0 * c5c + 3.0 * c5d + c5e - 2.0 * c5f)
    dfdy(8) = fac * (-c5a - 3.0 * c5b + 3.0 * c5c + 2.0 * c5d - 2.0 * c5e + c5f)

    c6a = COS(3.0 * fbigx)
    c6b = COS(3.0 * fbigy)
    c6c = COS(3.0 * (fbigx + fbigy))
    s6a = SIN(3.0 * fbigx)
    s6b = SIN(3.0 * fbigy)
    s6c = SIN(3.0 * (fbigx + fbigy))

    fxy(9) = c6a + c6b + c6c
    dfdx(9) = -3.0 * fac * (s6a + s6c)
    dfdy(9) = -3.0 * fac * (s6b + s6c)

    c7a = COS(2.0 * (2.0 * fbigx + fbigy))
    c7b = COS(2.0 * (fbigx + 2.0 * fbigy))
    c7c = COS(2.0 * (fbigx - fbigy))
    s7a = SIN(2.0 * (2.0 * fbigx + fbigy))
    s7b = SIN(2.0 * (fbigx + 2.0 * fbigy))
    s7c = SIN(2.0 * (fbigx - fbigy))

    fxy(10) = c7a + c7b + c7c
    dfdx(10) = -2.0 * fac * (2.0 * s7a + s7b + s7c)
    dfdy(10) = -2.0 * fac * (s7a + 2.0 * s7b - s7c)

!   Derivatives with respect to cartesian coordinates
    DO i = 1, idf3
      dfdy(i) = (-dfdx(i) + 2.0 * dfdy(i)) * usq3
    END DO
  END SUBROUTINE

!************************ M U R I I **********************************
!   Calculates 1D potential and derivatives with respect to x,y,z.
!   A sum is carried out over all atoms on the surface at a
!   distance from the elementary quadrangle smaller than a
!   prescribed value (see program SNEARN). The crystal coordinates
!   for these atoms are given in IVEC. The first index of IVEC
!   is the atom index and the second is 1 for X and 2 for Y.
!   The actual number of nearest neighbours is NVEC
!   The 1D potential and its derivative are given through VREPII.
!   Version 1.0  H.F. Busnengo
!   Version 2.0  A. Salin                 01/02/02
!*********************************************************************
!   This routine had been modified to include a larger reference cluster.
!   E.W.F. Smeets
  SUBROUTINE MURII( x, y, z, v, dvdx, dvdy, dvdz, PES )
    IMPLICIT NONE

    INTEGER i,j,k,l,m,n
    PARAMETER(n=3,m=3)          
  
    TYPE ( CRP_AtomSurface_PES ) :: PES
    REAL, PARAMETER    :: Constants_PI       = 3.1415926535897932384626433832795028841971    ! accurate enough for most CPU's...
    REAL :: x, y, z, v, dvdx, dvdy, dvdz, uuc, vuc, yijk, xijk, zijk, r, vr, dvdr, dvdrsr
    REAL cossurf,sinsurf

    IF ( m .GT. PES%Geometry%NumLayers - 1 ) THEN
      PRINT *,"ERROR in MURII not enough layers in slab"
      STOP
    END IF
    IF ( PES%Disp1 .NE. 0.0 ) THEN
      PRINT *, "Module MURII in C3v Atom Potential not designed for use with displacements"
      STOP
    END IF 

    v = 0.0
    dvdx = 0.0
    dvdy = 0.0
    dvdz = 0.0

    cossurf = COS( Constants_PI / 3.0 )
    sinsurf = SIN( Constants_PI / 3.0 )

    !loop over all surface atoms
    DO i = -n, n + 1
      DO j = -n, n + 1
        DO k = 0, m
          !generate crystal coordinates based on fcc(111)
          uuc = (FLOAT(i) + MOD(k, 3) * (1.0 / 3.0)) * PES%Geometry%LatticeConstant
          vuc = (FLOAT(j) + MOD(k, 3) * (1.0 / 3.0)) * PES%Geometry%LatticeConstant
          xijk = uuc + vuc * cossurf
          yijk = vuc * sinsurf
          zijk = 0.0
          IF ( k .GT. 0 ) THEN
            DO l = 1, k
              zijk = zijk - PES%Geometry%InterlayerSpacings(l)
            END DO
          END IF

          r = SQRT( (x - xijk)**2 + (y - yijk)**2 + (z - zijk)**2 )
!          PRINT *, "r=", r
!         -----------------------------------------
!         Calculating the 1D repulsive potential

          IF(r .GT. PES%CorrugationFunction1D%X(PES%CorrugationFunction1D%NX)) THEN
            vr = 0.0
            dvdr = 0.0
          ELSE
            IF (r .LT. PES%CorrugationFunction1D%X(1)) THEN
              PRINT *, "Error in MURII: R too small"
              STOP
            ELSE
              CALL SPLINT(PES%CorrugationFunction1D%X, PES%CorrugationFunction1D%F, PES%CorrugationFunction1D%Coefs, &
                          PES%CorrugationFunction1D%NX, r, vr, dvdr)
            END IF
          END IF
!         -------------------------------------------
          dvdrsr = dvdr / r

          v = v + vr
          IF (r .GT. 0.0) THEN
            dvdx = dvdx + dvdrsr * (x - xijk)
            dvdy = dvdy + dvdrsr * (y - yijk)
            dvdz = dvdz + dvdrsr * (z - zijk)
          ELSE
            !if top layer 
            IF ( k .EQ. 0 ) THEN
              dvdz = dvdz + dvdr
            ELSE
              PRINT *, "ERROR in MURII -- r smaller then 0"
              STOP
            END IF
          END IF
        END DO 
      END DO
    END DO
    RETURN
  END SUBROUTINE
!************************  O R I G E N 2 *****************************
!     Shifts the coordinate to the inside of the quadrangle with
!     bottom left corner at the origin. Input and output are
!     cartesian coordinates.
!     X,Y are the initial coordinates. DELTA is the internuclear
!     distance on the surface and XT,YT are the calculated shifted
!     values.
!             Version 1.0              01/02/02
!*********************************************************************
  SUBROUTINE ORIGEN2( x, y, delta, xt, yt )
    IMPLICIT NONE

    INTEGER          :: i, ind(2)
    REAL :: x, y, delta, xt, yt, ori(2), bigx, bigy

    bigx = x - y * usq3
    bigy = 2.0 * y * usq3
    ori(1) = bigx / delta
    ori(2) = bigy / delta

    DO i = 1, 2
      IF (ori(i) .GE. 0.0) THEN
        ind(i) = ori(i)
      ELSE
        ind(i) = ori(i) - 1
      ENDIF
    END DO

    bigx = bigx - ind(1) * delta
    bigy = bigy - ind(2) * delta
    xt = bigx + bigy * 0.5
    yt = sq3 * bigy * 0.5
  END SUBROUTINE

END MODULE

