!> General routines and types for doing the CRP.
MODULE CRP_General
  USE Spline
  USE UnitConversion

! To initialize the module call:
!   SUBROUTINE Initialize_CRP_General_Module()

! This module provides the following functions:
!   SUBROUTINE CAMBCORD(xa,ya,za,xb,yb,zb,x,y,z,r,teta,fi)
!   SUBROUTINE CHECKR(zin,nin,zc,nc)
!   SUBROUTINE DPL2D(ax,im,ay,jn,x,m,y,n,f,cx,cy,cint,idx,idy,res)
!   FUNCTION DPL(n,x,y,m,t)
!   FUNCTION DPLP(n,x,y,m,t)
!   SUBROUTINE DPLCOFT(n,x,t,c,dc,k)
!   SUBROUTINE DSPLIN(n,x,y,cm,cm1,ic1,cmn,icn,alpha,beta,b)
!   SUBROUTINE LOCATE(t,k,x,n)
!   SUBROUTINE SPLCOFII(x,y,x0,y0,ia,ja,idx,idy)
!   SUBROUTINE SPLIN2D(x,m,y,n,f,cx,cy,cint,idx,idy)
!   SUBROUTINE SPLINII(f,d2fdx,d2fdy,d4fdydx,ia,ja,vint,idx,idy)
!   SUBROUTINE SPLINT(xa,ya,cya,n,x,y,yp)
!   SUBROUTINE TRICYCLE(alpha,beta,gamma,cbot,ctop,b,x,n,z)
!   SUBROUTINE TRIDIA(alpha,beta,gamma,b,x,n)
!   SUBROUTINE TRISPL(n,x,y,cm,alpha,beta,gamma,b,bz)
!   SUBROUTINE UBICAR(XA,X,N,KLO,PARO)

!> A 1D cut from the 3D atom-surface PES.
  TYPE PESCut3D
    REAL    :: X, Y
    TYPE (Spline1D)     :: Spline
    CHARACTER(LEN = 50) :: FileName
  END TYPE PESCut3D

!> A 2D cut from the 6D atom-surface PES.
  TYPE PESCut6D
    REAL    :: X, Y, Theta, Phi
    TYPE (Spline2D)     :: Spline
    CHARACTER(LEN = 50) :: FileName
  END TYPE

!> The 2D (Z,r) gas phase potential.
  TYPE CRP_GasPhase_2D
    TYPE (Spline1D)  :: Zdep, Rdep     ! The Z and R dependence of the gas phase potential
    REAL :: ZsoMin, ZsoMax ! The values of Z between which switching occurs
  END TYPE CRP_GasPhase_2D

!> The geometry of the slab.
  TYPE Slab_Geometry
    REAL          :: LatticeConstant
    INTEGER                   :: NumLayers
    LOGICAL       :: Alloced = .FALSE.
    REAL, POINTER :: InterlayerSpacings(:)
  END TYPE

!> The dataset for the 1D molecule-surface PES
  TYPE CRP_AtomSurface_PES
    CHARACTER(LEN = 50)      :: DataSet         ! The name of the data set
    REAL                     :: Mixing          ! Mixing coefficient
    TYPE (Slab_Geometry)     :: Geometry       ! The geometry of the slab
    INTEGER                  :: Symmetry        ! The symmetry of the surface
    TYPE (Spline1D)          :: CorrugationFunction1D ! The 1D corrugation function
    INTEGER                  :: NumCuts
    TYPE (PESCut3D), POINTER :: Cuts(:) ! The 1D cuts through the 3D surface
    TYPE (Spline3DPeriodic)  :: SplineFunction ! The spline function of the PES, if used (currently in C4v code)
    TYPE (Units)             :: InputUnits
    REAL                     :: Disp1, Disp2
    LOGICAL                  :: Alloced = .FALSE.
    CHARACTER( LEN=255 )     :: InfoShort = "", InfoLong = "", InfoRef = ""
  END TYPE CRP_AtomSurface_PES

!> The dataset for the 6D molecule-surface PES
  TYPE CRP_MoleculeSurface_PES
    CHARACTER(LEN = 50)        :: DataSet         ! The name of the data set
    REAL                       :: Mixing          ! Mixing coefficient
    TYPE (Slab_Geometry)       :: Geometry       ! The geometry of the slab
    INTEGER                    :: Symmetry        ! The symmetry of the surface
    REAL                       :: ccDef ! Some parameters of the PES
    TYPE (CRP_AtomSurface_PES) :: AtomSurface ! The associated AtomSurface PES
    TYPE (CRP_GasPhase_2D)     :: GasPhase     ! The gas phase potential
    INTEGER                    :: NumCuts
    TYPE (PESCut6D), POINTER   :: Cuts(:) ! The 2D cuts through the 6D surface
    LOGICAL                    :: CutsInterpolation ! Do the cuts describe the interpolation function?
    TYPE (Units)               :: InputUnits
    REAL                       :: Rmin, Rmax, Zmin, Zasy
    LOGICAL                    :: Alloced = .FALSE.
    CHARACTER( LEN=255 )       :: InfoShort = "", InfoLong = "", InfoRef = ""
  END TYPE CRP_MoleculeSurface_PES

CONTAINS

!  SUBROUTINE Initialize_CRP_General_Module()
!    IMPLICIT NONE
!  END SUBROUTINE

  SUBROUTINE Allocate_Slab_Geometry( Geometry )
    IMPLICIT NONE

    TYPE ( Slab_Geometry ) :: Geometry

    ALLOCATE( Geometry%InterlayerSpacings( Geometry%NumLayers - 1 ) )
    Geometry%Alloced = .TRUE.
  END SUBROUTINE

  SUBROUTINE Deallocate_Slab_Geometry( Geometry )
    IMPLICIT NONE

    TYPE ( Slab_Geometry ) :: Geometry

    DEALLOCATE( Geometry%InterlayerSpacings )
    Geometry%Alloced = .FALSE.
  END SUBROUTINE

  SUBROUTINE Deallocate_PESCut3D( Cut )
    IMPLICIT NONE

    TYPE ( PESCut3D ) :: Cut

    CALL Deallocate_Spline1D( Cut%Spline )
  END SUBROUTINE

  SUBROUTINE Deallocate_PESCut6D( Cut )
    IMPLICIT NONE

    TYPE ( PESCut6D ) :: Cut

    CALL Deallocate_Spline2D( Cut%Spline )
  END SUBROUTINE

  SUBROUTINE Destroy_CRP_GasPhase_PES( PES )
    IMPLICIT NONE

    TYPE ( CRP_GasPhase_2D ) :: PES

    CALL Deallocate_Spline1D( PES%Zdep )
    CALL Deallocate_Spline1D( PES%Rdep )
    PES%ZsoMin = 0.0
    PES%ZsoMax = 0.0
  END SUBROUTINE

  SUBROUTINE Destroy_CRP_AtomSurface_PES( PES )
    IMPLICIT NONE

    TYPE ( CRP_AtomSurface_PES ) :: PES
    INTEGER :: i

    PES%DataSet = ""
    PES%Mixing = 0.0
    CALL Deallocate_Slab_Geometry( PES%Geometry )
    CALL Deallocate_Spline1D( PES%CorrugationFunction1D )
    DO i = 1, PES%NumCuts
      CALL Deallocate_PESCut3D( PES%Cuts(i) )
    END DO
    DEALLOCATE( PES%Cuts )
    IF ( PES%Symmetry .EQ. 4 ) THEN
      CALL Deallocate_Spline3DPeriodic( PES%SplineFunction )
    END IF
    PES%Symmetry = 0
    PES%Disp1 = 0.0
    PES%Disp2 = 0.0
    PES%InfoShort = ""
    PES%InfoLong = ""
    PES%InfoRef = ""
    PES%Alloced = .FALSE.
  END SUBROUTINE

  SUBROUTINE Destroy_CRP_MoleculeSurface_PES( PES )
    IMPLICIT NONE

    TYPE ( CRP_MoleculeSurface_PES ) :: PES
    INTEGER :: i

    PES%DataSet = ""
    PES%Mixing = 0.0
    CALL Deallocate_Slab_Geometry( PES%Geometry )
    PES%Symmetry = 0
    PES%ccDef = 0.0
    CALL Destroy_CRP_AtomSurface_PES( PES%AtomSurface )
    CALL Destroy_CRP_GasPhase_PES( PES%GasPhase )
    DO i = 1, PES%NumCuts
      CALL Deallocate_PESCut6D( PES%Cuts(i) )
    END DO
    DEALLOCATE( PES%Cuts )
    PES%CutsInterpolation = .FALSE.
    PES%Zmin = 0.0
    PES%Zasy = 0.0
    PES%Rmin = 0.0
    PES%Rmax = 0.0
    PES%InfoShort = ""
    PES%InfoLong = ""
    PES%InfoRef = ""
    PES%Alloced = .FALSE.
  END SUBROUTINE

!************************ C A M B C O R D ****************************
      SUBROUTINE CAMBCORD(xa,ya,za,xb,yb,zb,x,y,z,r,teta,fi,PES)

!     Calculates the coordinates X,Y,Z (referred to an origin O
!     on the internuclear axis as defined below) and r,theta,phi from
!     the nuclear coordinates (xa,ya,za,xb,yb,zb).
!     The internuclear vector points from A to B.

      IMPLICIT NONE

      TYPE (CRP_MoleculeSurface_PES) :: PES

!       CCDEF: defines the coordinate origin O used to produce the set
!              of molecular data. O is on the internuclear axis and
!              such that OA=|r_B-r_A|*ccdef and OB=|r_B-r_A|*(1-ccdef)

!      REAL rmax,zccmin,ccdef
!      COMMON/DATLIM/rmax,zccmin,ccdef

      REAL xa,ya,za,xb,yb,zb,x,y,z,r,teta,fi,argdacos,dx,dy

      r=SQRT((xb-xa)**2+(yb-ya)**2+(zb-za)**2)
      IF (r.EQ.0.0) THEN
         WRITE(*,*)'ERROR, r=0'
         STOP
      ENDIF
      x=xa*(1.0-PES%ccdef)+xb*PES%ccdef
      y=ya*(1.0-PES%ccdef)+yb*PES%ccdef
      z=za*(1.0-PES%ccdef)+zb*PES%ccdef
      argdacos=(zb-za)/r
      IF (argdacos.GT.1.0) argdacos=1.0
      teta=ACOS(argdacos)
      dx=xb-xa
      dy=yb-ya
      IF(dx.EQ.0.0.AND.dy.EQ.0.0) THEN
        fi=0.0
      ELSE
        fi=ATAN2(dy,dx)
      END IF

      END SUBROUTINE

!************************ C H E C K R ********************************

!     Replaces ZIN by an ordered set of all values of ZIN and ZC
!     (given by increasing order).
!     The first and last value must be the same in ZIN and ZC.

      SUBROUTINE CHECKR(zin,nin,zc,nc)
      IMPLICIT NONE !REAL*8 (a-h,o-z)

      REAL :: zin(:), zout(999), zc(999)
      INTEGER :: nin, nc, jmin, iout, i, j

      IF(zc(1).NE.zin(1)) THEN
        WRITE(*,*) 'Error in data'
        STOP
      END IF
      IF(zc(nc).NE.zin(nin)) THEN
        WRITE(*,*) 'Error in data'
        STOP
      END IF

      jmin=2
      iout=1
      zout(1)=zin(1)
      DO i=2,nc

        DO j=jmin,nin
          iout=iout+1
          IF(zc(i).EQ.zin(j)) THEN
            zout(iout)=zc(i)
            jmin=j+1
            GO TO 11
          ELSE IF(zc(i).LT.zin(j)) THEN
            zout(iout)=zc(i)
            GO TO 11
          ELSE
            zout(iout)=zin(j)
            jmin=j+1
          END IF
        END DO
11      CONTINUE

      END DO

      DO i=1,iout
        zin(i)=zout(i)
      END DO
      nin=iout

      END SUBROUTINE
END MODULE
