!*******************************************************************************
!*MOD* Spline
!*******************************************************************************
!> Spline interpolation library.
!*******************************************************************************
MODULE Spline

!> The dataset for a 1D spline interpolation.
  TYPE Spline1D
    LOGICAL       :: Alloced = .FALSE.
    REAL, POINTER :: X(:), F(:), Coefs(:)
    INTEGER       :: NX = 0
  END TYPE Spline1D

!> The dataset for a 2D spline interpolation.
  TYPE Spline2D
    LOGICAL       :: Alloced = .FALSE.
    REAL, POINTER :: X(:), Y(:), F(:,:), CoefsX(:,:), CoefsY(:,:), CoefsXY(:,:)
    INTEGER       :: NX = 0, NY = 0
  END TYPE

!> The dataset for a periodic 3D spline interpolation.
  TYPE Spline3DPeriodic
    LOGICAL       :: Alloced = .FALSE.
    REAL, POINTER :: X(:), Y(:), Z(:), F(:,:,:), Der1(:,:), Der2(:,:), CoefsX(:,:,:), CoefsY(:,:,:), &
                     CoefsXY(:,:,:), CoefsZ(:,:,:), CoefsZX(:,:,:), CoefsZY(:,:,:), CoefsZXY(:,:,:)
    INTEGER       :: NX = 0, NY = 0, NZ = 0
  END TYPE

  TYPE UBIType
    REAL :: ax0, bx0, cx0, dx0, ay0, by0, cy0, dy0, ax0p, bx0p, cx0p, dx0p, ay0p, by0p, cy0p, dy0p
  END TYPE

  TYPE KODSPLType
    INTEGER :: kod, k, iw, iligne
  END TYPE

!> Wrapper for computing a 1D spline.
  INTERFACE Compute_Spline1D
    MODULE PROCEDURE Compute_Spline1D_Simple, Compute_Spline1D_Advanced
  END INTERFACE

!  PRIVATE :: DPL, DSPLIN, SPLINT, TRISPL
  PRIVATE :: DPL2D, DPLCOFT, DPLP, LOCATE, SPLCOFII, SPLIN2D, SPLINII, TRICYCLE, TRIDIA !, UBICAR

CONTAINS

!*******************************************************************************
!*SUB* Initialize_Spline_Module
!*******************************************************************************
!> Initialize the Spline module. Must be called before use.
!*******************************************************************************
  SUBROUTINE Initialize_Spline_Module()
    IMPLICIT NONE

    !COMMON /KODSPL/ kod, k, iw, iligne
    !INTEGER :: kod, k, iw, iligne

    !iw = 6
    !iligne = 100
    !k = 2
  END SUBROUTINE

!*******************************************************************************
!*SUB* Allocate_Spline1D
!*******************************************************************************
!> Allocate space to store a 1D spline.
!>
!> @param Spline The dataset to allocate.
!> @param NX The number of points to allocate.
!*******************************************************************************
  SUBROUTINE Allocate_Spline1D( Spline, NX )
    IMPLICIT NONE

    TYPE (Spline1D) :: Spline
    INTEGER         :: NX

    Spline%Alloced = .TRUE.
    Spline%NX = NX
    ALLOCATE( Spline%X(NX) )
    ALLOCATE( Spline%F(NX) )
    ALLOCATE( Spline%Coefs(NX) )
  END SUBROUTINE

  SUBROUTINE Deallocate_Spline1D( Spline )
    IMPLICIT NONE

    TYPE (Spline1D) :: Spline

    Spline%Alloced = .FALSE.
    Spline%NX = 0
    DEALLOCATE( Spline%X )
    DEALLOCATE( Spline%F )
    DEALLOCATE( Spline%Coefs )
  END SUBROUTINE

!*******************************************************************************
!*SUB* Allocate_Spline2D
!*******************************************************************************
!> Allocate space to store a 2D spline.
!>
!> @param Spline The dataset to allocate.
!> @param NX The number of points in X.
!> @param NY The number of points in Y.
!*******************************************************************************
  SUBROUTINE Allocate_Spline2D( Spline, NX, NY )
    IMPLICIT NONE

    TYPE (Spline2D) :: Spline
    INTEGER         :: NX, NY

    Spline%Alloced = .TRUE.
    Spline%NX = NX
    Spline%NY = NY
    ALLOCATE( Spline%X(NX) )
    ALLOCATE( Spline%Y(NY) )
    ALLOCATE( Spline%F(NX,NY) )
    ALLOCATE( Spline%CoefsX(NX,NY) )
    ALLOCATE( Spline%CoefsY(NX,NY) )
    ALLOCATE( Spline%CoefsXY(NX,NY) )
  END SUBROUTINE

  SUBROUTINE Deallocate_Spline2D( Spline )
    IMPLICIT NONE

    TYPE (Spline2D) :: Spline

    Spline%Alloced = .FALSE.
    Spline%NX = 0
    Spline%NY = 0
    DEALLOCATE( Spline%X )
    DEALLOCATE( Spline%Y )
    DEALLOCATE( Spline%F )
    DEALLOCATE( Spline%CoefsX )
    DEALLOCATE( Spline%CoefsY )
    DEALLOCATE( Spline%CoefsXY )
  END SUBROUTINE

!*******************************************************************************
!*SUB* Allocate_Spline3DPeriodic
!*******************************************************************************
!> Allocate space to store a 3D spline with periodic conditions in X and Y.
!> 
!> @param Spline The dataset to allocate.
!> @param NX The number of points in X.
!> @param NY The number of points in Y.
!> @param NZ The number of points in Z.
!*******************************************************************************
  SUBROUTINE Allocate_Spline3DPeriodic( Spline, NX, NY, NZ )
    IMPLICIT NONE

    TYPE (Spline3DPeriodic) :: Spline
    INTEGER                 :: NX, NY, NZ

    Spline%Alloced = .TRUE.
    Spline%NX = NX
    Spline%NY = NY
    Spline%NZ = NZ
    ALLOCATE( Spline%X(NX) )
    ALLOCATE( Spline%Y(NY) )
    ALLOCATE( Spline%Z(NZ) )
    ALLOCATE( Spline%F(NX,NY,NZ) )
    ALLOCATE( Spline%Der1(NX,NY) )
    ALLOCATE( Spline%Der2(NX,NY) )
    ALLOCATE( Spline%CoefsX(NX,NY,NZ) )
    ALLOCATE( Spline%CoefsY(NX,NY,NZ) )
    ALLOCATE( Spline%CoefsXY(NX,NY,NZ) )
    ALLOCATE( Spline%CoefsZ(NX,NY,NZ) )
    ALLOCATE( Spline%CoefsZX(NX,NY,NZ) )
    ALLOCATE( Spline%CoefsZY(NX,NY,NZ) )
    ALLOCATE( Spline%CoefsZXY(NX,NY,NZ) )

  END SUBROUTINE

  SUBROUTINE Deallocate_Spline3DPeriodic( Spline )
    IMPLICIT NONE

    TYPE (Spline3DPeriodic ) :: Spline

    Spline%Alloced = .FALSE.
    Spline%NX = 0
    Spline%NY = 0
    Spline%NZ = 0
    DEALLOCATE( Spline%X )
    DEALLOCATE( Spline%Y )
    DEALLOCATE( Spline%Z )
    DEALLOCATE( Spline%F )
    DEALLOCATE( Spline%Der1 )
    DEALLOCATE( Spline%Der2 )
    DEALLOCATE( Spline%CoefsX )
    DEALLOCATE( Spline%CoefsY )
    DEALLOCATE( Spline%CoefsXY )
    DEALLOCATE( Spline%CoefsZ )
    DEALLOCATE( Spline%CoefsZX )
    DEALLOCATE( Spline%CoefsZY )
    DEALLOCATE( Spline%CoefsZXY )
  END SUBROUTINE

!*******************************************************************************
!*SUB* Compute_Spline1D_Simple
!*******************************************************************************
!> Compute a 1 dimensional spline without special boundary conditions
!>
!> @param Spline The dataset to compute.
!*******************************************************************************
  SUBROUTINE Compute_Spline1D_Simple( Spline )
    IMPLICIT NONE

    TYPE (Spline1D)               :: Spline

    CALL DSPLIN( Spline%NX, Spline%X, Spline%F, Spline%Coefs, 0.0, 0, 0.0, 0 )
  END SUBROUTINE

!*******************************************************************************
!*SUB* Compute_Spline1D_Advanced
!*******************************************************************************
!> Compute a 1 dimensional spline with boundary conditions
!>
!> @param Spline The dataset to compute.
!> @param Condition1 The boundary condition on the first point (see DSPLIN)
!> @param Der1 Derivative on the first point (see DSPLIN)
!> @param ConditionN The boundary condition on the last point (see DSPLIN)
!> @param DerN Derivative on the last point (see DSPLIN)
!*******************************************************************************
  SUBROUTINE Compute_Spline1D_Advanced( Spline, Condition1, Der1, ConditionN, DerN )
    IMPLICIT NONE

    TYPE (Spline1D)  :: Spline
    INTEGER          :: Condition1, ConditionN
    REAL :: Der1, DerN

    CALL DSPLIN( Spline%NX, Spline%X, Spline%F, Spline%Coefs, Der1, Condition1, DerN, ConditionN )
  END SUBROUTINE

!*******************************************************************************
!*FNC* Evaluate_Spline1D
!*******************************************************************************
!> Evaluate a 1 dimensional spline
!>
!> @param Spline The dataset to use.
!> @param X The point on which to do the interpolation.
!> @returns The value of the function at X.
!*******************************************************************************
  FUNCTION Evaluate_Spline1D( Spline, X ) RESULT ( Val )
    IMPLICIT NONE

    TYPE (Spline1D) :: Spline
    REAL :: X, Val

    Val = DPL( Spline%NX, Spline%X, Spline%F, Spline%Coefs, X )
  END FUNCTION

!*******************************************************************************
!*FNC* Evaluate_Spline1D_Derivative
!*******************************************************************************
!> Evaluate the derivative of a 1 dimensional spline
!>
!> @param Spline The dataset to use.
!> @param X The point on which to compute the derivative.
!> @returns The derivative of the function at X.
!*******************************************************************************
  FUNCTION Evaluate_Spline1D_Derivative( Spline, X ) RESULT ( Val )
    IMPLICIT NONE

    TYPE (Spline1D) :: Spline
    REAL :: X, Val

    Val = DPLP( Spline%NX, Spline%X, Spline%F, Spline%Coefs, X )
  END FUNCTION

!*******************************************************************************
!*SUB* Compute_Spline2D
!*******************************************************************************
!> Compute a 2 dimensional spline.
!> 
!> @param Spline The Spline2D to compute.
!*******************************************************************************
  SUBROUTINE Compute_Spline2D( Spline )
    IMPLICIT NONE

    TYPE (Spline2D) :: Spline

    CALL SPLIN2D( Spline%X, Spline%NX, Spline%Y, Spline%NY, &
                  Spline%F, Spline%CoefsX, Spline%CoefsY, Spline%CoefsXY, Spline%NX, Spline%NY)
  END SUBROUTINE

!*******************************************************************************
!*SUB* Compute_Spline3D_Periodic
!*******************************************************************************
!> Compute a 3 dimensional spline with periodic conditions in X and Y.
!> 
!> @param Spline The Spline3DPeriodic to compute.
!*******************************************************************************
  SUBROUTINE Compute_Spline3D_Periodic( Spline )
    IMPLICIT NONE

    TYPE (Spline3DPeriodic) :: Spline
    CALL SPLINE3D( Spline%X, Spline%NX, Spline%Y, Spline%NY, Spline%Z, Spline%NZ, Spline%F, Spline%Der1, 2, Spline%Der2, 2, &
                   Spline%CoefsX, Spline%CoefsY, Spline%CoefsXY, Spline%CoefsZ, Spline%CoefsZX, Spline%CoefsZY, Spline%CoefsZXY )
  END SUBROUTINE

!*******************************************************************************
!*FNC* Evaluate_Spline2D
!*******************************************************************************
!> Evaluate a 2 dimensional spline.
!> 
!> @param Spline The Spline2D to evaluate.
!> @param X The X to evaluate on.
!> @param Y The Y to evaluate on.
!> @returns The value at (X, Y).
!*******************************************************************************
  FUNCTION Evaluate_Spline2D( Spline, X, Y ) RESULT ( Val )
    IMPLICIT NONE

    TYPE (Spline2D)  :: Spline
    REAL :: X, Y, Val
    INTEGER :: i, j

    CALL DPL2D( X, i, Y, j, Spline%X, Spline%NX, Spline%Y, Spline%NY, &
                Spline%F, Spline%CoefsX, Spline%CoefsY, Spline%CoefsXY, Spline%NX, Spline%NY, Val )
  END FUNCTION

!*******************************************************************************
!*SUB* Evaluate_Spline2D_Alt
!*******************************************************************************
!> 
!> 
!> @param Spline 
!> @param X 
!> @param Y 
!> @param MyOut 
!> @param switch 
!*******************************************************************************
  SUBROUTINE Evaluate_Spline2D_Alt( Spline, X, Y, MyOut, switch )
    IMPLICIT NONE

    TYPE (Spline2D)  :: Spline
    INTEGER          :: iX, iY
    REAL :: X, Y, MyOut(3)
    LOGICAL          :: switch
    TYPE ( UBIType ) :: ubi

    CALL UBICAR( Spline%X, X, Spline%NX, iX, switch )
    IF (switch) RETURN
    CALL UBICAR( Spline%Y, Y, Spline%NY, iY, switch )
    IF (switch) RETURN
    CALL SPLCOFII( Spline%X, Spline%Y, X, Y, iX, iY, Spline%NX, Spline%NY, ubi )
    CALL SPLINII( Spline%F, Spline%CoefsX, Spline%CoefsY, Spline%CoefsXY, iX, iY, MyOut, Spline%NX, Spline%NY, ubi )
  END SUBROUTINE

!*******************************************************************************
!*SUB* Evaluate_Spline3D_Periodic
!*******************************************************************************
!> 
!> 
!> @param Spline 
!> @param X 
!> @param Y 
!> @param Z 
!> @param F 
!> @param dFdX 
!> @param dFdY 
!> @param dFdZ 
!*******************************************************************************
  SUBROUTINE Evaluate_Spline3D_Periodic( Spline, X, Y, Z, F, dFdX, dFdY, dFdZ )
    IMPLICIT NONE

    TYPE (Spline3DPeriodic) :: Spline
    REAL :: X, Y, Z, F, dFdX, dFdY, dFdZ

    CALL SPLINT3D( Spline%X, Spline%NX, Spline%Y, Spline%NY, Spline%Z, Spline%NZ, Spline%F, Spline%CoefsX, Spline%CoefsY, &
       Spline%CoefsXY, Spline%CoefsZ, Spline%CoefsZX, Spline%CoefsZY, Spline%CoefsZXY, X, Y, Z, F, dFdX, dFdY, dFdZ )
  END SUBROUTINE

!*******************************************************************************
!*SUB* DPL2D
!*******************************************************************************
!> 
!> 
!> @param ax 
!> @param im 
!> @param ay 
!> @param jn 
!> @param x 
!> @param m 
!> @param y 
!> @param n 
!> @param f 
!> @param cx 
!> @param cy 
!> @param cint 
!> @param idx 
!> @param idy 
!> @param res 
!*******************************************************************************
      SUBROUTINE DPL2D(ax,im,ay,jn,x,m,y,n,f,cx,cy,cint,idx,idy,res)
!
!     Calculate f(x,y) in 2D interpolation.
!
!       Author: A. Salin     Version: 2.0    15/01/99

!     AX, AY: point for which the interpolate is required.
!     IM, JN: localization of AX and AY in the last call
!     X,M: set of m abcissae
!     Y,N: set of n ordinates
!     F(i,j): value of functions at (x_i,y_j)
!     CX, CY, CINT: arrays of dimension (idx,idy)
!                   determined by subroutine SPL2D or SPLCYC2D
!     IDX, IDY: dimensions in calling program.
!     RES : value of interpolate.

!     Required subroutine: LOCATE

      IMPLICIT REAL (a-h,o-z)
      PARAMETER (s6=1.0/6.0)

      DIMENSION x(idx),y(idy),f(idx,idy),cx(idx,idy),cy(idx,idy),cint(idx,idy)

      CALL LOCATE(ax,im,x,m)
      CALL LOCATE(ay,jn,y,n)

      IF(im.LE.1.OR.im.GT.m) THEN
        WRITE(*,*) 'x=',ax,'outside interval in DPL2D'
        STOP
      END IF
      IF(jn.LE.1.OR.jn.GT.n) THEN
        WRITE(*,*) 'y=',ay,'outside interval in DPL2D'
        STOP
      END IF

      fx=x(im)-ax
      gx=ax-x(im-1)
      ex=fx+gx
      den=1.0/ex
      c2=-gx*fx*s6*den
      c1=c2*(fx+ex)
      c2=c2*(gx+ex)
      c3=fx*den
      c4=gx*den
!                                              Determine F(x,y_(jn-1))
      cx1=cx(im-1,jn-1)
      cx2=cx(im,jn-1)
      af1=f(im-1,jn-1)
      af2=f(im,jn-1)
      afj=c1*cx1+c2*cx2+c3*af1+c4*af2
!                                               Determine F(x,y_(jn))
      cx1=cx(im-1,jn)
      cx2=cx(im,jn)
      af1=f(im-1,jn)
      af2=f(im,jn)
      afjp=c1*cx1+c2*cx2+c3*af1+c4*af2
!                                               Determine c_(jn-1)(x)
      cx1=cint(im-1,jn-1)
      cx2=cint(im,jn-1)
      af1=cy(im-1,jn-1)
      af2=cy(im,jn-1)
      cy1=c1*cx1+c2*cx2+c3*af1+c4*af2

!                                                 Determine c_(jn)(x)
      cx1=cint(im-1,jn)
      cx2=cint(im,jn)
      af1=cy(im-1,jn)
      af2=cy(im,jn)
      cy2=c1*cx1+c2*cx2+c3*af1+c4*af2
!                                                    Determine f(x,y)
      fy=y(jn)-ay
      gy=ay-y(jn-1)
      ey=fy+gy
      res=(-gy*fy*s6*(cy1*(fy+ey)+cy2*(gy+ey))+(gy*afjp+fy*afj))/ey

      END SUBROUTINE

!*******************************************************************************
!*SUB* DPLCOFT
!*******************************************************************************
!> 
!> 
!> @param n 
!> @param x 
!> @param t 
!> @param c 
!> @param dc 
!> @param k 
!*******************************************************************************
      SUBROUTINE DPLCOFT(n,x,t,c,dc,k)

!     Calculates coefficients for the spline interpolation of a
!     function (C) and its derivative (DC) at point T. The N nodes are
!     X. K is such that t.GE.x(k-1) and t.LT.x(k).

      IMPLICIT REAL (a-h,o-z)

      DIMENSION x(n),c(4),dc(4)

      IF(k.LE.1.OR.k.GT.n) THEN
        klo=0
        khi=n+1
      ELSE

      inc=1
      klo=k-1
      IF(t.GT.x(klo)) THEN
 10     khi=klo+inc
        IF(khi.GT.n) THEN
          khi=n+1
        ELSE IF(t.GT.x(khi)) THEN
          klo=khi
          inc=inc+inc
          GO TO 10
        END IF
      ELSE
        khi=klo
 20     klo=khi-inc
        IF(klo.LT.1) THEN
          klo=0
        ELSE IF(t.LT.x(klo)) THEN
          khi=klo
          inc=inc+inc
          GO TO 20
        END IF
      END IF

      END IF

100   CONTINUE
      IF(khi-klo.GT.1) THEN
        km=(khi+klo)/2
        IF(t.GT.x(km)) THEN
          klo=km
        ELSE
          khi=km
        END IF
        GO TO 100
      END IF
        k=klo+1

      IF(t.EQ.x(1)) k=2

        f=x(k)-t
        g=t-x(k-1)
        e=f+g
        se=1.0/e
        se6=se/6.0
        h=-g*f*se6
        c(1)=h*(f+e)
        c(2)=h*(g+e)
        c(3)=f*se
        c(4)=g*se
        dc(1)=-h-(f+e)*(f-g)*se6
        dc(2)=h-(g+e)*(f-g)*se6
        dc(3)=-se
        dc(4)=se

      END SUBROUTINE

!*******************************************************************************
!*FNC* DPL
!*******************************************************************************
!> 
!> 
!> @param n 
!> @param x 
!> @param y 
!> @param m 
!> @param t 
!> @returns 
!*******************************************************************************
      REAL FUNCTION DPL(n,x,y,m,t)

!        Version 3.0  - 15/1/97       Author: A. SALIN

!        Calculation of a function by interpolation. Double precision.
!        See comments in SUBROUTINE DSPLIN

      IMPLICIT NONE !REAL (a-h,o-z)

      INTEGER          :: n
      REAL :: x(n), y(n), m(n), t
      REAL :: e, f, g
      INTEGER          :: khi, klo, km, inc, k
      LOGICAL          :: order

      !COMMON/KODSPL/kod,k,iw,iligne

    1 FORMAT(' DPL: extrapolation - ',1PE15.8,' <',E15.8)
    2 FORMAT(' DPL: extrapolation - ',1PE15.8,' >',E15.8)

      k = 2

      order=x(2).GT.x(1)
      IF(k.LE.1.OR.k.GT.n) THEN
        klo=0
        khi=n+1
        GO TO 100
      END IF

      inc=1
      klo=k-1
      IF(t.GT.x(klo).EQV.order) THEN
 10     khi=klo+inc
        IF(khi.GT.n) THEN
          khi=n+1
        ELSE IF(t.GT.x(khi).EQV.order) THEN
          klo=khi
          inc=inc+inc
          GO TO 10
        END IF
      ELSE
        khi=klo
 20     klo=khi-inc
        IF(klo.LT.1) THEN
          klo=0
        ELSE IF(t.LT.x(klo).EQV.order) THEN
          khi=klo
          inc=inc+inc
          GO TO 20
        END IF
      END IF

 100  CONTINUE
      IF(khi-klo.GT.1) THEN
        km=(khi+klo)/2
        IF(t.GT.x(km).EQV.order) THEN
          klo=km
        ELSE
          khi=km
        END IF
        GO TO 100
      END IF
        k=klo+1

      IF(t.EQ.x(1)) k=2
      IF(k.LE.1) THEN
        e=x(2)-x(1)
        DPL=((y(2)-y(1))/e-m(2)*e/6.0)*(t-x(1))+y(1)
        !kod=1
        !IF(iw.GT.0.AND.iligne.GT.0) THEN
        !  IF(order) THEN
        !    WRITE(iw,1) t,x(1)
        !  ELSE
        !    WRITE(iw,2) t,x(1)
        !  END IF
        !  iligne=iligne-1
        !END IF
      ELSE IF(k.GT.n) THEN
        e=x(n)-x(n-1)
        DPL=((y(n)-y(n-1))/e+m(n-1)*e/6.0)*(t-x(n))+y(n)
        !kod=2
        !IF(iw.GT.0.AND.iligne.GT.0) THEN
        !  IF(order) THEN
        !    WRITE(iw,2) t,x(n)
        !  ELSE
        !    WRITE(iw,1) t,x(n)
        !  END IF
        !  iligne=iligne-1
        !END IF
      ELSE
        f=x(k)-t
        g=t-x(k-1)
        e=f+g
        DPL=(-g*f*(m(k-1)*(f+e)+m(k)*(g+e))+6.0*(g*y(k)+f*y(k-1)))/(6.0*e)
        !kod=0
      END IF
      END FUNCTION

!*******************************************************************************
!*FNC* DPLP
!*******************************************************************************
!> 
!> 
!> @param n 
!> @param x 
!> @param y 
!> @param m 
!> @param t 
!> @returns 
!*******************************************************************************
      REAL FUNCTION DPLP(n,x,y,m,t)

!        Version 3.0  - 17/1/97       Author: A. SALIN

!        Calculation of the derivative of a function by interpolation.
!        Double precision. See comments in SUBROUTINE DSPLIN.
!        If t is outside the interval over which the function is
!        defined, the derivative is extrapolated linearly from its
!        value for the first two (last two) points of the interval.

      IMPLICIT NONE

      INTEGER          :: n
      REAL :: x(n), y(n), m(n), t
      REAL :: e, e2, f, g
      INTEGER          :: khi, klo, km, inc, k
      LOGICAL          :: order

      !COMMON/KODSPL/kod,k,iw,iligne

    1 FORMAT(' DPLP: extrapolation - ',1PE15.8,' <',E15.8)
    2 FORMAT(' DPLP: extrapolation - ',1PE15.8,' >',E15.8)

      k = 2

      order=x(2).GT.x(1)
      IF(k.LE.1.OR.k.GT.n) THEN
        klo=0
        khi=n+1
        GO TO 100
      END IF

      inc=1
      klo=k-1
      IF(t.GT.x(klo).EQV.order) THEN
 10     khi=klo+inc
        IF(khi.GT.n) THEN
          khi=n+1
        ELSE IF(t.GT.x(khi).EQV.order) THEN
          klo=khi
          inc=inc+inc
          GO TO 10
        END IF
      ELSE
        khi=klo
 20     klo=khi-inc
        IF(klo.LT.1) THEN
          klo=0
        ELSE IF(t.LT.x(klo).EQV.order) THEN
          khi=klo
          inc=inc+inc
          GO TO 20
        END IF
      END IF

 100  CONTINUE
      IF(khi-klo.GT.1) THEN
        km=(khi+klo)/2
        IF(t.GT.x(km).EQV.order) THEN
          klo=km
        ELSE
          khi=km
        END IF
        GO TO 100
      END IF
        k=klo+1

      IF(t.EQ.x(1)) k=2
      IF(k.LE.1) THEN
        e=x(2)-x(1)
        g=t-x(1)
        f=x(2)-t
        DPLP=(y(2)-y(1))/e+(m(2)*(2*g-f)+m(1)*(g-2*f))/6.0
        !kod=1
        !IF(iw.GT.0.AND.iligne.GT.0) THEN
        !  IF(order) THEN
        !    WRITE(iw,1) t,x(1)
        !  ELSE
        !    WRITE(iw,2) t,x(1)
        !  END IF
        !  iligne=iligne-1
        !END IF
      ELSE IF(k.GT.n) THEN
        e=x(n)-x(n-1)
        g=t-x(n-1)
        f=x(n)-t
        DPLP=(y(n)-y(n-1))/e+(m(n)*(2*g-f)+m(n-1)*(g-2*f))/6.0
        !kod=2
        !IF(iw.GT.0.AND.iligne.GT.0) THEN
        !  IF(order) THEN
        !    WRITE(iw,2) t,x(n)
        !  ELSE
        !    WRITE(iw,1) t,x(n)
        !  END IF
        !  iligne=iligne-1
        !END IF
      ELSE
        f=x(k)-t
        g=t-x(k-1)
        e=f+g
        e2=e*e
        DPLP=(-m(k-1)*(3.0*f*f-e2)+m(k)*(3.0*g*g-e2)+6.0*(y(k)-y(k-1)))/(6.0*e)
        !kod=0
      END IF
      END FUNCTION

!*******************************************************************************
!*SUB* DSPLIN
!*******************************************************************************
!> Interpolation package. Given a set of n couples x(i),y(i),
!> DSPLIN defines a cubic spline function F(x) such that:
!>   1)- F(x(i)) = y(i)
!>   2)- F(x), F'(x), F''(x) are continuous in the interval [x(1),x(n)].
!> Required subroutine: TRIDIA.
!> 
!> @param n 
!> @param x 
!> @param y 
!> @param cm 
!> @param cm1 
!> @param ic1 
!> @param cmn 
!> @param icn 
!*******************************************************************************
      SUBROUTINE DSPLIN(n,x,y,cm,cm1,ic1,cmn,icn)!,alpha,beta,b)
!
!        Author: A. Salin   Version 3.2  20/1/86 - 10/6/97
!
!     ****SUBROUTINE DSPLIN: calculates the vector F''(x(i)) which
!     defines the cubic spline function F(x).
!          N= number of pivots x(i).
!          X= array of abcissae. Should be stored by increasing or
!     decreasing order.
!          Y= array of values of Y(i).
!          CM= array of F''(x(i)) with dimension equal to that of X
!     and Y.
!          IC1,CM1,ICN,CMN: define the condition at x(1) and x(n)
!     If IC1=0, function is the same in first two intervals.
!     If IC1=1, second derivative at x(1) given in CM1
!     If IC1=2, first derivative at x(1) given in CM1
!     IF IC1>2, zero second derivative at x(1)
!          Similar definitions for ICN and CMN around x(n)
!          ALPHA, BETA, B are working arrays of dimension N at least.
!     For cyclic spline use the program TRISPL.
!
!     ****DPLCOF: the interpolated function at R is:
!       F=C(1)*CM(K-1)+C(2)*CM(K)+C(3)*Y(K-1)+C(4)*Y(K)
!       where C is obtained from:
!       CALL DPLCOF(n,x,r,c,k)
!       The vector C should be of dimension 4.
!
!     ****Functions DPL,DPLP,DPLP2: calculate respectively the function
!     F(x), its first or second derivative:
!             N= number of pivots
!             X,Y,M= same as X,Y,CM in DSPLIN.
!             T= value for which the function (or its derivative)
!     must be determined.
!     WARNING: when T is outside the interval [X(1),X(N)], F(X)
!     *******  (resp. F', F") is determined by linear extrapolation
!              using the value of F (resp. F', F") for the first two
!              (last two) points in the interval.
!
!     ****Subroutine DINITI et DINTSP: calculate the integral of the
!     function F(x) from X(1) to T. The subroutine DINITI should first
!     be called before the first CALL DINTSP concerning a given
!     function F(x). DINITI calculates the array (CI) of values of the
!     integral of F(x) from X(1) to all X(i).
!
!        Arguments of DINITI:
!             N,X,Y,CM: as in subroutine DSPLIN.
!             CI: array of dimension at least N.
!        Arguments of DINTSP:
!             N,X,Y,CM,CI: as in DINITI
!             T: value of the upper limit of the integration (X(1).LT.T.
!     LE.X(N)).
!             B: value of the integral.
!       The calculations in DINTSP are nearly as rapid as for the deter
!     mination of the function F(x) by DPL.
!
!     Parameters of COMMON/KODSPL/:
!     -----------------------------------------------------
!       -KOD= after execution of one subroutine of the package, KOD
!     takes the value:
!              *0: no error
!              *-1: values of X(i) are not stored in correct order.
!              *1: T outside the interval [X(1),X(N)]. Linear extrapo-
!     lation done using X(1) and X(2).
!              *2: T outside the interval [X(1),X(N)]. Linear extrapo-
!     lation done using X(n-1) and X(n).
!       -K= after the execution of DPL, DPLP or DPLP2, K is such that
!     T lies in the interval [X(k-1),X(k)].
!       -IW= error messages are printed on unit IW unless IW.LE.0
!     Default: 6.
!       -ILIGNE: when T is outside the interval [X(1),X(n)], DPL, DPLP
!     and DPLP2 print a message if ILIGNE.GT.0. The initial value of
!     ILIGNE (defined by DATA) is 100. For every extrapolation, the
!     value is decreased by 1.
!
!     ***************************************************************

      IMPLICIT NONE

!      REAL :: six, douze, zero
!      PARAMETER (six=6.0,douze=12.0,zero=0.0)

      INTEGER, INTENT(IN)          :: n, ic1, icn
      REAL, INTENT(IN) :: x(n), y(n), cm1, cmn
      REAL, INTENT(OUT) :: cm(n)
      REAL             :: alpha(n), beta(n), b(n)
      REAL             :: a, c, d, e, s1, sn, fab1, fabn, fac1, facn
      INTEGER                      :: i, i2

      !INTEGER :: kod, k, iw, iligne
      !COMMON /KODSPL/ kod, k, iw, iligne

   91 FORMAT('Error in the data for DSPLIN',/,'Check abcissae:',1PD15.8,1X,' and ',D15.8,/,'Program stopped')

!                                           Contour condition at X(1)
      IF(ic1.EQ.0) THEN
        s1=0.0
        fac1=(x(2)-x(1))*(1.0+(x(2)-x(1))/(x(3)-x(2)))/6.0
        fab1=-(x(2)-x(1))**2/(6.0*(x(3)-x(2)))
      ELSE IF(ic1.EQ.1) THEN
        s1=-cm1*(x(2)-x(1))/6.0
        fac1=0.0
        fab1=0.0
      ELSE IF(ic1.EQ.2) THEN
        s1=0.5*(cm1-(y(2)-y(1))/(x(2)-x(1)))
        fac1=-(x(2)-x(1))/12.0
        fab1=0.0
      ELSE
!        WRITE(iw,*) 'DSPLIN: unknown condition - use default'
        s1=0.0
        fac1=0.0
        fab1=0.0
      END IF
!                                           Contour condition at X(n)
      IF(icn.EQ.0) THEN
        sn=0.0
        facn=(x(n)-x(n-1))*(1.0+(x(n)-x(n-1))/(x(n-1)-x(n-2)))/6.0
        fabn=-(x(n)-x(n-1))**2/(6.0*(x(n-1)-x(n-2)))
      ELSE IF(icn.EQ.1) THEN
        sn=-cmn*(x(n)-x(n-1))/6.0
        facn=0.0
        fabn=0.0
      ELSE IF(icn.EQ.2) THEN
        sn=-0.5*(cmn-(y(n)-y(n-1))/(x(n)-x(n-1)))
        facn=-(x(n)-x(n-1))/12.0
        fabn=0.0
      ELSE
!        WRITE(iw,*) 'DSPLIN: unknown condition - use default'
        sn=0.0
        facn=0.0
        fabn=0.0
      END IF

      !kod=0
      c=x(2)-x(1)
      e=(y(2)-y(1))/c
      DO i=3,n
        i2=i-2
        a=c
        c=x(i)-x(i-1)
        IF(a*c.LE.0.0) THEN
          !kod=-1
          !IF(iw.GT.0) WRITE(iw,91) x(i-1),x(i)
          STOP
          END IF
        alpha(i2)=(a+c)/3.0
        beta(i2)=c/6.0
        cm(i2)=beta(i2)
        d=e
        e=(y(i)-y(i-1))/c
        b(i2)=e-d
      END DO

      b(1)=b(1)+s1
      b(n-2)=b(n-2)+sn
      alpha(1)=alpha(1)+fac1
      alpha(n-2)=alpha(n-2)+facn
      cm(n-3)=cm(n-3)+fabn
      beta(1)=beta(1)+fab1
!                                            Solve tridiagonal system
      CALL TRIDIA(alpha,cm,beta,b,cm(2),n-2)

      IF(ic1.EQ.0) THEN
        cm(1)=cm(2)*(1.0+(x(2)-x(1))/(x(3)-x(2)))-cm(3)*(x(2)-x(1))/(x(3)-x(2))
      ELSE IF(ic1.EQ.1) THEN
        cm(1)=cm1
      ELSE IF(ic1.EQ.2) THEN
        cm(1)=-6.0*s1/(x(2)-x(1))-cm(2)/2.0
      ELSE
        cm(1)=0.0
      END IF

      IF(icn.EQ.0) THEN
        cm(n)=cm(n-1)*(1.0+(x(n)-x(n-1))/(x(n-1)-x(n-2)))-cm(n-2)*(x(n)-x(n-1))/(x(n-1)-x(n-2))
      ELSE IF(icn.EQ.1) THEN
        cm(n)=cmn
      ELSE IF(icn.EQ.2) THEN
        cm(n)=-6.0*sn/(x(n)-x(n-1))-cm(n-1)/2.0
      ELSE
        cm(n)=0.0
      END IF

      !k=2
      RETURN
      END SUBROUTINE

!*******************************************************************************
!*SUB* SPLCOFII
!*******************************************************************************
!> 
!> 
!> @param x 
!> @param y 
!> @param x0 
!> @param y0 
!> @param ia 
!> @param ja 
!> @param idx 
!> @param idy 
!> @param ubi 
!*******************************************************************************
      SUBROUTINE SPLCOFII(x,y,x0,y0,ia,ja,idx,idy,ubi)

!     This routine assumes that x0 and y0 are in the correct range.
!     If not, no message is issued and the results are wrong.
!     IA and JA indicate the position of X0 and y0 in the grid. They
!     give the index corresponding to the left/bottom corner of the
!     rectangle in which the point (x0,y0) is located.

      IMPLICIT NONE

      INTEGER          :: idx, idy, ia, ja
      REAL :: x(idx), y(idy), x0, y0
      REAL :: dxia2s6, dyja2s6

      TYPE ( UBIType ) :: ubi

      !COMMON/UBI/ax0,bx0,cx0,dx0,ay0,by0,cy0,dy0,ax0p,bx0p,cx0p,dx0p,ay0p,by0p,cy0p,dy0p

      dxia2s6=(x(ia+1)-x(ia))**2/6.0
      dyja2s6=(y(ja+1)-y(ja))**2/6.0
      ubi%ax0=(x(ia+1)-x0)/(x(ia+1)-x(ia))
      ubi%bx0=1.0-ubi%ax0
      ubi%cx0=(ubi%ax0**3-ubi%ax0)*dxia2s6
      ubi%dx0=(ubi%bx0**3-ubi%bx0)*dxia2s6

      ubi%ay0=(y(ja+1)-y0)/(y(ja+1)-y(ja))
      ubi%by0=1.0-ubi%ay0
      ubi%cy0=(ubi%ay0**3-ubi%ay0)*dyja2s6
      ubi%dy0=(ubi%by0**3-ubi%by0)*dyja2s6

      ubi%ax0p=-1.0/(x(ia+1)-x(ia))
      ubi%bx0p=-ubi%ax0p
      ubi%cx0p=(3.0*ubi%ax0**2*ubi%ax0p-ubi%ax0p)*dxia2s6
      ubi%dx0p=(3.0*ubi%bx0**2*ubi%bx0p-ubi%bx0p)*dxia2s6

      ubi%ay0p=-1.0/(y(ja+1)-y(ja))
      ubi%by0p=-ubi%ay0p
      ubi%cy0p=(3.0*ubi%ay0**2*ubi%ay0p-ubi%ay0p)*dyja2s6
      ubi%dy0p=(3.0*ubi%by0**2*ubi%by0p-ubi%by0p)*dyja2s6

      END SUBROUTINE

!*******************************************************************************
!*SUB* SPLIN2D
!*******************************************************************************
!> 
!> 
!> @param x 
!> @param m 
!> @param y 
!> @param n 
!> @param f 
!> @param cx 
!> @param cy 
!> @param cint 
!> @param idx 
!> @param idy 
!*******************************************************************************
      SUBROUTINE SPLIN2D(x,m,y,n,f,cx,cy,cint,idx,idy)
!
!     Two dimensional interpolation by Spline method.
!
!       Author: A. Salin     Version: 1.1    15/04/98 - 18/1/99

!     X,M: set of m abcissae
!     Y,N: set of n ordinates
!     F(i,j): value of functions at (x_i,y_j)
!     CX, CY, CINT: arrays of dimension (idx,idy) determined by
!                      subroutine SPLIN2D
!     IDX, IDY: dimension parameters in calling program

      IMPLICIT REAL (a-h,o-z)
      PARAMETER (idn=999)

      DIMENSION x(idx),y(idy),f(idx,idy),cx(idx,idy),cy(idx,idy),cint(idx,idy)
      DIMENSION cg(idn),g(idn)

      IF(idn.LT.idx.OR.idn.LT.idy) THEN
        WRITE(*,*) 'SPLIN2D: idn too small'
        STOP
      END IF

      DO j=1,n
        CALL DSPLIN(m,x,f(1,j),cx(1,j),0.0,0,0.0,0)
      END DO

      DO i=1,m
        DO j=1,n
          g(j)=f(i,j)
        END DO
        CALL DSPLIN(n,y,g,cg,0.0,0,0.0,0)
        DO j=1,n
          cy(i,j)=cg(j)
        END DO
      END DO

      DO j=1,n
        CALL DSPLIN(m,x,cy(1,j),cint(1,j),0.0,0,0.0,0)
      END DO

      END SUBROUTINE

!*******************************************************************************
!*SUB* SPLINII
!*******************************************************************************
!> 
!> 
!> @param f 
!> @param d2fdx 
!> @param d2fdy 
!> @param d4fdydx 
!> @param ia 
!> @param ja 
!> @param vint 
!> @param idx 
!> @param idy 
!> @param ubi 
!*******************************************************************************
      SUBROUTINE SPLINII(f,d2fdx,d2fdy,d4fdydx,ia,ja,vint,idx,idy,ubi)
!     ------------------------------------------------------------------

!     IA and JA indicate the position of X0 and y0 in the grid. They
!     give the index corresponding to the left/bottom corner of the
!     rectangle in which the point (x0,y0) is located.

      IMPLICIT NONE
      INTEGER          :: ia, ja, idx, idy
      REAL :: f(idx,idy),vint(3)
      REAL :: d2fdx(idx,idy),d2fdy(idx,idy),d4fdydx(idx,idy)
      TYPE ( UBIType ) :: ubi

      !COMMON/UBI/ax0,bx0,cx0,dx0,ay0,by0,cy0,dy0,ax0p,bx0p,cx0p,dx0p,ay0p,by0p,cy0p,dy0p

      vint(1)= ubi%ax0*( ubi%ay0*f(ia,ja)+ubi%by0*f(ia,ja+1) &
                   + ubi%cy0*d2fdy(ia,ja)+ubi%dy0*d2fdy(ia,ja+1) ) &
             + ubi%bx0*( ubi%ay0*f(ia+1,ja)+ubi%by0*f(ia+1,ja+1) &
                   + ubi%cy0*d2fdy(ia+1,ja)+ubi%dy0*d2fdy(ia+1,ja+1) ) &
             + ubi%cx0*( ubi%ay0*d2fdx(ia,ja)+ubi%by0*d2fdx(ia,ja+1) &
                   + ubi%cy0*d4fdydx(ia,ja)+ubi%dy0*d4fdydx(ia,ja+1) ) &
             + ubi%dx0*( ubi%ay0*d2fdx(ia+1,ja)+ubi%by0*d2fdx(ia+1,ja+1) &
                   + ubi%cy0*d4fdydx(ia+1,ja)+ubi%dy0*d4fdydx(ia+1,ja+1) )
      vint(2)= ubi%ay0p*( ubi%ax0*f(ia,ja)+ubi%bx0*f(ia+1,ja) &
                    + ubi%cx0*d2fdx(ia,ja)+ubi%dx0*d2fdx(ia+1,ja) ) &
             + ubi%by0p*( ubi%ax0*f(ia,ja+1)+ubi%bx0*f(ia+1,ja+1) &
                    + ubi%cx0*d2fdx(ia,ja+1)+ubi%dx0*d2fdx(ia+1,ja+1) ) &
             + ubi%cy0p*( ubi%ax0*d2fdy(ia,ja)+ubi%bx0*d2fdy(ia+1,ja) &
                    + ubi%cx0*d4fdydx(ia,ja)+ubi%dx0*d4fdydx(ia+1,ja) ) &
             + ubi%dy0p*( ubi%ax0*d2fdy(ia,ja+1)+ubi%bx0*d2fdy(ia+1,ja+1) &
                    + ubi%cx0*d4fdydx(ia,ja+1)+ubi%dx0*d4fdydx(ia+1,ja+1) )
      vint(3)= ubi%ax0p*( ubi%ay0*f(ia,ja)+ubi%by0*f(ia,ja+1) &
                    + ubi%cy0*d2fdy(ia,ja)+ubi%dy0*d2fdy(ia,ja+1) ) &
             + ubi%bx0p*( ubi%ay0*f(ia+1,ja)+ubi%by0*f(ia+1,ja+1) &
                    + ubi%cy0*d2fdy(ia+1,ja)+ubi%dy0*d2fdy(ia+1,ja+1) ) &
             + ubi%cx0p*( ubi%ay0*d2fdx(ia,ja)+ubi%by0*d2fdx(ia,ja+1) &
                    + ubi%cy0*d4fdydx(ia,ja)+ubi%dy0*d4fdydx(ia,ja+1) ) &
             + ubi%dx0p*( ubi%ay0*d2fdx(ia+1,ja)+ubi%by0*d2fdx(ia+1,ja+1) &
                    + ubi%cy0*d4fdydx(ia+1,ja)+ubi%dy0*d4fdydx(ia+1,ja+1) )

      END SUBROUTINE

!*******************************************************************************
!*SUB* SPLINT
!*******************************************************************************
!> Calculates a function Y and its derivative YP at X by spline interpolation. The N data are XA (nodes) and YA
!> (function at nodes). CYA is calculated by DSPLIN.
!>
!> @param[in] xa Array with X values of spline.
!> @param[in] ya Array with Y values of spline.
!> @param[in] cya Array with spline coefficients.
!> @param[in] n Number of points.
!> @param[in] x Point at which to evaluate the spline.
!> @param[out] y Value of function at x.
!> @param[out] yp Value of derivative at x.
!*******************************************************************************
  SUBROUTINE SPLINT( xa, ya, cya, n, x, y, yp )
    IMPLICIT NONE

    INTEGER, INTENT(IN)          :: n
    REAL, INTENT(IN) :: xa(n), ya(n), cya(n), x
    REAL, INTENT(OUT) :: y, yp
    REAL :: h, a, b
    INTEGER          :: klo, khi, k

    klo = 1
    khi = n

1   CONTINUE
    IF (khi - klo .GT. 1) THEN
      k = (khi + klo) / 2
      IF (xa(k) .GT. x) THEN
        khi = k
      ELSE
        klo = k
      END IF
      GO TO 1
    END IF

    h = xa(khi) - xa(klo)
    a = (xa(khi) - x) / h
    b = (x - xa(klo)) / h
    y = a * ya(klo) + b * ya(khi) + ((a**3 - a) * cya(klo) + (b**3 - b) * cya(khi)) * (h * h) / 6.0
    yp = (ya(khi) - ya(klo)) / h + h * (cya(khi) * (3.0 * b * b - 1.0) - cya(klo) * (3.0 * a * a - 1.0)) / 6.0
  END SUBROUTINE

!*******************************************************************************
!*SUB* TRICYCLE
!*******************************************************************************
!> Solve tridiagonal cyclic system.
!
!  A. SALIN    Version 1    9/8/98
!
!> @param[in,out] alpha Main diagonal (destroyed in TRICYCLE).
!> @param[in] beta Subdiagonal.
!> @param[in] gamma Superdiagonal.
!> @param[in] cbot Element of bottom left corner of matrix.
!> @param[in] ctop Element of top right corner of matrix.
!> @param[in,out] b Right-hand side (destroyed in TRICYCLE).
!> @param[in,out] x Solution.
!> @param[in] n Dimension of system.
!*******************************************************************************
  SUBROUTINE TRICYCLE( alpha, beta, gamma, cbot, ctop, b, x, n )
    IMPLICIT NONE

    INTEGER, INTENT(IN)             :: n
    REAL, INTENT(INOUT) :: alpha(n), b(n), x(n)
    REAL, INTENT(IN)    :: beta(n), gamma(n), cbot, ctop
    REAL                :: z(n)

    REAL :: alp, fact
    INTEGER          :: i

    alp = -alpha(1)
    alpha(1) = alpha(1) - alp
    alpha(n) = alpha(n) - cbot * ctop / alp
    DO i = 1, n
      z(i) = alpha(i)
    END DO
    CALL TRIDIA( alpha, beta, gamma, b, x, n )

    DO i = 1, n
      alpha(i) = z(i)
    END DO
    b(1) = alp
    b(n) = cbot
    DO i = 2, n - 1
      b(i) = 0.0
    END DO
    CALL TRIDIA( alpha, beta, gamma, b, z, n )
    fact = (x(1) + ctop * x(n) / alp) / (1.0 + z(1) + ctop * z(n) / alp)
    DO i = 1, n
      x(i) = x(i) - fact * z(i)
    END DO
  END SUBROUTINE

!*******************************************************************************
!*SUB* TRIDIA
!*******************************************************************************
!> Solve tridiagonal system.
!>
!> @param alpha Main diagonal (destroyed in TRIDIA).
!> @param beta Subdiagonal (first element has index 1).
!> @param gamma Superdiagonal (first element has index 1).
!> @param b Right-hand side (destroyed in TRIDIA).
!> @param x Solution.
!> @param n Dimension of system.
!*******************************************************************************
  SUBROUTINE TRIDIA( alpha, beta, gamma, b, x, n )
    IMPLICIT NONE

    REAL :: rap
    INTEGER          :: i, j, n
    REAL :: alpha(n), beta(n), gamma(n), b(n), x(n)

    DO i = 2, n
      rap = beta(i - 1) / alpha(i - 1)
      alpha(i) = alpha(i) - rap * gamma(i - 1)
      b(i) = b(i) - rap * b(i - 1)
    END DO
    x(n) = b(n) / alpha(n)

    DO j = 2, n
      i = n - j + 1
      x(i) = ( b(i) - gamma(i) * x(i + 1) ) / alpha(i)
    END DO
  END SUBROUTINE

! ************************ T R I S P L ***************************
!     Spline interpolation of a periodic function with period
!     [x(n)-x(1)] - i.e. y(n)=y(1).

!     See general comments in DSPLIN.
!     The vectors ALPHA, BETA, GAMMA, B, BZ are scratch vectors of
!     dimension at list N.
!     Required subroutine: TRIDIA, TRICYCLE
!
!        Author: A. Salin   Version 1  09/06/98
! ***************************************************************
!*******************************************************************************
!*SUB* TRISPL
!*******************************************************************************
!> 
!> 
!> @param n 
!> @param x 
!> @param y 
!> @param cm 
!*******************************************************************************
  SUBROUTINE TRISPL( n, x, y, cm )
    IMPLICIT NONE

    INTEGER, INTENT(IN)             :: n
    REAL, INTENT(IN)    :: x(n), y(n)
    REAL, INTENT(INOUT) :: cm(n)
    REAL                :: alpha(n), beta(n), gamma(n), b(n)

    !INTEGER :: kod, k, iw, iligne
    !COMMON /KODSPL/ kod, k, iw, iligne

    INTEGER :: i, i2
    REAL :: a, c, d, e, cbot, ctop

91  FORMAT("Error in the data for TRISPL",/,"Check abcissae:",1PD15.8,1X," and ",D15.8,/,"Program stopped")
    !kod = 0
    c = x(2) - x(1)
    e = (y(2) - y(1)) / c
    DO i = 3, n
      i2 = i - 2
      a = c
      c = x(i) - x(i - 1)
      IF (a * c .LE. 0.0) THEN
        !kod = -1
        !IF (iw .GT. 0) WRITE(iw, 91) x(i - 1), x(i)
        STOP
      END IF
      alpha(i2) = (a + c) / 3.0
      beta(i2) = c / 6.0
      gamma(i2) = beta(i2)
      d = e
      e = (y(i) - y(i - 1)) / c
      b(i2) = e - d
    END DO

    a = c
    c = x(2) - x(1)
    alpha(n - 1) = (a + c) / 3.0
    beta(n - 1) = c / 6.0
    gamma(n - 1) = beta(n - 1)
    d = e
    e = (y(2) - y(1)) / c
    b(n - 1) = e - d
    cbot = beta(n - 1)
    ctop = cbot

!   Solve tridiagonal system
    CALL TRICYCLE( alpha, beta, gamma, cbot, ctop, b, cm(2), n - 1 )

    cm(1) = cm(n)

    !k = 2
  END SUBROUTINE

!**************************** L O C A T E ***************************
!       Author: A. Salin     Version: 1.0    15/04/98
!
!     Determines k such that t.GT.x(k-1) and t.LE.x(k)
!     (except for t=x(1) in which case k=2)
!     If k is initially in the interval [1,n], then the search starts
!     from x(k).
!********************************************************************
!*******************************************************************************
!*SUB* LOCATE
!*******************************************************************************
!> 
!> 
!> @param t 
!> @param k 
!> @param x 
!> @param n 
!*******************************************************************************
  SUBROUTINE LOCATE( t, k, x, n)
    IMPLICIT NONE

    INTEGER :: k, n, inc, klo, khi, km
    REAL    :: t, x(n)
    LOGICAL :: order

    order = x(2) .GT. x(1)
    IF (k .LE. 1 .OR. k .GT. n) THEN
      klo = 0
      khi = n + 1
      GO TO 100
    END IF

    inc = 1
    klo = k - 1
    IF (t .GT. x(klo) .EQV. order) THEN
 10   khi = klo + inc
      IF (khi .GT. n) THEN
        khi = n + 1
      ELSE IF (t .GT. x(khi) .EQV. order) THEN
        klo = khi
        inc = inc + inc
        GO TO 10
      END IF
    ELSE
      khi = klo
 20   klo = khi - inc
      IF (klo .LT. 1) THEN
        klo = 0
      ELSE IF (t .LT. x(klo) .EQV. order) THEN
        khi = klo
        inc = inc + inc
        GO TO 20
      END IF
    END IF

100 CONTINUE
    IF (khi - klo .GT. 1) THEN
      km = (khi + klo) / 2
      IF (t .GT. x(km) .EQV. order) THEN
        klo = km
      ELSE
        khi = km
      END IF
      GO TO 100
    END IF

    k = klo + 1

    IF (t .EQ. x(1)) k = 2
  END SUBROUTINE

!************************ U B I C A R ********************************
!   Determine KLO such that X is .GE.XA(KLO) and .LT.XA(KLO+1)
!   If X is outside the interval [XA(1),XA(N)], the logical
!   variable PARO takes the value .TRUE.
!*********************************************************************
!*******************************************************************************
!*SUB* UBICAR
!*******************************************************************************
!> 
!> 
!> @param XA 
!> @param X 
!> @param N 
!> @param KLO 
!> @param PARO 
!*******************************************************************************
  SUBROUTINE UBICAR( XA, X, N, KLO, PARO )
    IMPLICIT NONE

    INTEGER :: n, klo, khi, k
    REAL    :: x, xa(N)
    LOGICAL :: paro

    paro = .FALSE.
    IF (x .LT. xa(1) .OR. x .GT. xa(n)) THEN
      PARO = .TRUE.
      RETURN
    END IF
    klo = 1
    khi = n
1   CONTINUE
    IF (khi - klo .GT. 1) THEN
      k = (khi + klo) / 2
      IF (xa(k) .GT. x) THEN
        khi = k
      ELSE
        klo = k
      END IF
      GO TO 1
    END IF
  END SUBROUTINE










!*******************************************************************************
!*SUB* int_PES6CuSPL2DPER
!*******************************************************************************
!> 
!> 
!> @param X 
!> @param L 
!> @param Y 
!> @param M 
!> @param F 
!> @param DFDX 
!> @param DFDY 
!> @param DFDXDY 
!*******************************************************************************
      SUBROUTINE int_PES6CuSPL2DPER(X,L,Y,M,F,DFDX,DFDY,DFDXDY)
      IMPLICIT REAL(A-H,O-Z)
!C     ------------------------------------------------------------------
!C     This routine computes the derivatives needed for a 2D spline
!C     interpolation with periodic boundary conditions in x and y.
!C     Input: X,Y arrays of L,M components contaning the x,y grid.
!C            L,M
!C            F the values of the function on the grid points
!C     ------------------------------------------------------------------
      DIMENSION X(L),Y(M)
      DIMENSION F(L,M),DFDX(L,M),DFDY(L,M),DFDXDY(L,M)
      DIMENSION F1(L),DF1(L),F2(L),DF2(L)
!C     --------------------------------------------
!C     Calculo de la derivada segunda respecto de y
      DO I=1,L
         DO J=1,M
            F1(J)=F(I,J)
         ENDDO
         CALL TRISPL(M,Y,F1,DF1)
         DO J=1,M
            DFDY(I,J)=DF1(J)
         ENDDO
      ENDDO
!C     --------------------------------------------
!C     Calculo de la derivada segunda respecto de x
      DO J=1,M
         DO I=1,L
            F2(I)=F(I,J)
         ENDDO
         CALL TRISPL(L,X,F2,DF2)
         DO I=1,L
            DFDX(I,J)=DF2(I)
         ENDDO
      ENDDO
!C     -----------------------------------------------------------
!C     Calculo de la derivada segunda respecto de x de la derivada
!C     segunda respecto de y
      DO J=1,M
         DO I=1,L
            F2(I)=DFDY(I,J)
         ENDDO
         CALL TRISPL(L,X,F2,DF2)
         DO I=1,L
            DFDXDY(I,J)=DF2(I)
         ENDDO
      ENDDO
      RETURN
      END SUBROUTINE int_PES6CuSPL2DPER
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************
!*******************************************************************************
!*SUB* SPLINE3D
!*******************************************************************************
!> 
!> 
!> @param X 
!> @param L 
!> @param Y 
!> @param M 
!> @param Z 
!> @param N 
!> @param F 
!> @param CM1 
!> @param IC1 
!> @param CMN 
!> @param ICN 
!> @param DFDX 
!> @param DFDY 
!> @param DFDXDY 
!> @param DFDZ 
!> @param DFDZDX 
!> @param DFDZDY 
!> @param DFDZDXDY 
!*******************************************************************************
      SUBROUTINE SPLINE3D(X,L,Y,M,Z,N,F,CM1,IC1,CMN,ICN, &
                DFDX,DFDY,DFDXDY,DFDZ,DFDZDX,DFDZDY,DFDZDXDY)
!C     ------------------------------------------------------------------
!C     This routine computes the derivatives needed for a 3D spline
!C     interpolation with periodic boundary conditions in x and y and
!C     the especified boundary conditiond in z (see dsplin).
!C     Input: X,Y,Z arrays of L,M,N components contaning the x,y,z grid.
!C            L,M,M
!C            F the values of the function on the grid points
!C     If IC1=0, function in Z is the same in first two intervals.
!C     If IC1=1, second derivative at x(1) given in CM1
!C     If IC1=2, first derivative at x(1) given in CM1
!C     IF IC1>2, zero second derivative at x(1)
!C          Similar definitions for ICN and CMN around x(n)
!C     ------------------------------------------------------------------
      IMPLICIT REAL(A-H,O-Z)
      DIMENSION X(L),Y(M),Z(N)
      DIMENSION F(L,M,N),DFDX(L,M,N),DFDY(L,M,N), &
              DFDXDY(L,M,N),DFDZ(L,M,N),DFDZDX(L,M,N), &
              DFDZDY(L,M,N),DFDZDXDY(L,M,N)
      DIMENSION CM1(L,M),CMN(L,M)
      DIMENSION V1(N),V2(N)
      DIMENSION V3(L,M),V4(L,M),V5(L,M),V6(L,M), &
            V7(L,M),V8(L,M),V9(L,M),V10(L,M)
!C     ------------------------------------------------------------------
      DO I=1,L
         DO J=1,M
            DO K=1,N
               V1(K)=F(I,J,K)
               IF (K.EQ.1) DER1=CM1(I,J)
               IF (K.EQ.N) DER2=CMN(I,J)
            ENDDO
            CALL DSPLIN(N,Z,V1,V2,DER1,IC1,DER2,ICN)
            DO K=1,N
               DFDZ(I,J,K)=V2(K)
            ENDDO
         ENDDO
      ENDDO
      DO K=1,N
         DO I=1,L
            DO J=1,M
               V3(I,J)=F(I,J,K)
               V4(I,J)=DFDZ(I,J,K)
            ENDDO
         ENDDO
         CALL int_PES6CuSPL2DPER(X,L,Y,M,V3,V5,V6,V7)
         CALL int_PES6CuSPL2DPER(X,L,Y,M,V4,V8,V9,V10)
         DO I=1,L
            DO J=1,M
               DFDX(I,J,K)=V5(I,J)
               DFDY(I,J,K)=V6(I,J)
               DFDXDY(I,J,K)=V7(I,J)
               DFDZDX(I,J,K)=V8(I,J)
               DFDZDY(I,J,K)=V9(I,J)
               DFDZDXDY(I,J,K)=V10(I,J)
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END SUBROUTINE
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************
!*******************************************************************************
!*SUB* SPLINT3D
!*******************************************************************************
!> 
!> 
!> @param X 
!> @param L 
!> @param Y 
!> @param M 
!> @param Z 
!> @param N 
!> @param F 
!> @param DFDX 
!> @param DFDY 
!> @param DFDXDY 
!> @param DFDZ 
!> @param DFDZDX 
!> @param DFDZDY 
!> @param DFDZDXDY 
!> @param X0 
!> @param Y0 
!> @param Z0 
!> @param F0 
!> @param DX 
!> @param DY 
!> @param DZ 
!*******************************************************************************
      SUBROUTINE SPLINT3D(X,L,Y,M,Z,N,F,DFDX,DFDY,DFDXDY,DFDZ,DFDZDX, &
                           DFDZDY,DFDZDXDY,X0,Y0,Z0,F0,DX,DY,DZ)
      IMPLICIT REAL(A-H,O-Z)
      DIMENSION X(L),Y(M),Z(N)
      DIMENSION F(L,M,N),DFDX(L,M,N),DFDY(L,M,N), &
               DFDXDY(L,M,N),DFDZ(L,M,N),DFDZDX(L,M,N), &
                 DFDZDY(L,M,N),DFDZDXDY(L,M,N)
      LOGICAL PARO

      CALL UBICAR(X,X0,L,IA,PARO)

!c      write(*,*)'IA=',IA
!c      write(*,*)'PARO=',PARO

      DEX=X(IA+1)-X(IA)
      IF (PARO) THEN
         WRITE(*,*)'ERROR: X0 out of range'
         STOP
      ENDIF
!c      WRITE(*,*)'IA=',IA

      CALL UBICAR(Y,Y0,M,JA,PARO)
      DEY=Y(JA+1)-Y(JA)
      IF (PARO) THEN
         WRITE(*,*)'ERROR: Y0 out of range'
         STOP
      ENDIF
!c      WRITE(*,*)'JA=',JA

      CALL UBICAR(Z,Z0,N,KA,PARO)
      DEZ=Z(KA+1)-Z(KA)
      IF (PARO) THEN
         WRITE(*,*)'ERROR: Z0 out of range'
         STOP
      ENDIF
!C     ----------------------------------
      AX0=(X(IA+1)-X0)/DEX
      BX0=1.0-AX0
      CX0=(AX0**3.0-AX0)/6.0*DEX**2.0
      DX0=(BX0**3.0-BX0)/6.0*DEX**2.0

      AY0=(Y(JA+1)-Y0)/DEY
      BY0=1.0-AY0
      CY0=(AY0**3.0-AY0)/6.0*DEY**2.0
      DY0=(BY0**3.0-BY0)/6.0*DEY**2.0

      AZ0=(Z(KA+1)-Z0)/DEZ
      BZ0=1.0-AZ0
      CZ0=(AZ0**3.0-AZ0)/6.0*DEZ**2.0
      DZ0=(BZ0**3.0-BZ0)/6.0*DEZ**2.0

!C     -----------------------------------------------------------
      ATERM=AY0*(AX0*F(IA,JA,KA)+BX0*F(IA+1,JA,KA)+ &
                CX0*DFDX(IA,JA,KA)+DX0*DFDX(IA+1,JA,KA))+ &
           BY0*(AX0*F(IA,JA+1,KA)+BX0*F(IA+1,JA+1,KA)+ &
                CX0*DFDX(IA,JA+1,KA)+DX0*DFDX(IA+1,JA+1,KA))+ &
           CY0*(AX0*DFDY(IA,JA,KA)+BX0*DFDY(IA+1,JA,KA)+ &
                CX0*DFDXDY(IA,JA,KA)+DX0*DFDXDY(IA+1,JA,KA))+ &
           DY0*(AX0*DFDY(IA,JA+1,KA)+BX0*DFDY(IA+1,JA+1,KA)+ &
                CX0*DFDXDY(IA,JA+1,KA)+DX0*DFDXDY(IA+1,JA+1,KA))
      BTERM=AY0*(AX0*F(IA,JA,KA+1)+BX0*F(IA+1,JA,KA+1)+ &
                CX0*DFDX(IA,JA,KA+1)+DX0*DFDX(IA+1,JA,KA+1))+ &
           BY0*(AX0*F(IA,JA+1,KA+1)+BX0*F(IA+1,JA+1,KA+1)+ &
                CX0*DFDX(IA,JA+1,KA+1)+DX0*DFDX(IA+1,JA+1,KA+1))+ &
           CY0*(AX0*DFDY(IA,JA,KA+1)+BX0*DFDY(IA+1,JA,KA+1)+ &
                CX0*DFDXDY(IA,JA,KA+1)+DX0*DFDXDY(IA+1,JA,KA+1))+ &
           DY0*(AX0*DFDY(IA,JA+1,KA+1)+BX0*DFDY(IA+1,JA+1,KA+1)+ &
                CX0*DFDXDY(IA,JA+1,KA+1)+DX0*DFDXDY(IA+1,JA+1,KA+1))
      CTERM=AY0*(AX0*DFDZ(IA,JA,KA)+BX0*DFDZ(IA+1,JA,KA)+ &
                CX0*DFDZDX(IA,JA,KA)+DX0*DFDZDX(IA+1,JA,KA))+ &
           BY0*(AX0*DFDZ(IA,JA+1,KA)+BX0*DFDZ(IA+1,JA+1,KA)+ &
                CX0*DFDZDX(IA,JA+1,KA)+DX0*DFDZDX(IA+1,JA+1,KA))+ &
           CY0*(AX0*DFDZDY(IA,JA,KA)+BX0*DFDZDY(IA+1,JA,KA)+ &
                CX0*DFDZDXDY(IA,JA,KA)+DX0*DFDZDXDY(IA+1,JA,KA))+ &
           DY0*(AX0*DFDZDY(IA,JA+1,KA)+BX0*DFDZDY(IA+1,JA+1,KA)+ &
                CX0*DFDZDXDY(IA,JA+1,KA)+DX0*DFDZDXDY(IA+1,JA+1,KA))
      DTERM=AY0*(AX0*DFDZ(IA,JA,KA+1)+BX0*DFDZ(IA+1,JA,KA+1)+ &
                CX0*DFDZDX(IA,JA,KA+1)+DX0*DFDZDX(IA+1,JA,KA+1))+ &
           BY0*(AX0*DFDZ(IA,JA+1,KA+1)+BX0*DFDZ(IA+1,JA+1,KA+1)+ &
                CX0*DFDZDX(IA,JA+1,KA+1)+DX0*DFDZDX(IA+1,JA+1,KA+1))+ &
           CY0*(AX0*DFDZDY(IA,JA,KA+1)+BX0*DFDZDY(IA+1,JA,KA+1)+ &
                CX0*DFDZDXDY(IA,JA,KA+1)+DX0*DFDZDXDY(IA+1,JA,KA+1))+ &
           DY0*(AX0*DFDZDY(IA,JA+1,KA+1)+BX0*DFDZDY(IA+1,JA+1,KA+1)+ &
              CX0*DFDZDXDY(IA,JA+1,KA+1)+DX0*DFDZDXDY(IA+1,JA+1,KA+1))

      F0=AZ0*ATERM+BZ0*BTERM+CZ0*CTERM+DZ0*DTERM
!C     ----------------------------------------------
      AX0P=-1.0/DEX
      BX0P=-AX0P
      CX0P=(3.0*AX0**2.0*AX0P-AX0P)/6.0*DEX**2.0
      DX0P=(3.0*BX0**2.0*BX0P-BX0P)/6.0*DEX**2.0

      ATERMX=AY0*(AX0P*F(IA,JA,KA)+BX0P*F(IA+1,JA,KA)+ &
                CX0P*DFDX(IA,JA,KA)+DX0P*DFDX(IA+1,JA,KA))+ &
           BY0*(AX0P*F(IA,JA+1,KA)+BX0P*F(IA+1,JA+1,KA)+ &
                CX0P*DFDX(IA,JA+1,KA)+DX0P*DFDX(IA+1,JA+1,KA))+ &
           CY0*(AX0P*DFDY(IA,JA,KA)+BX0P*DFDY(IA+1,JA,KA)+ &
                CX0P*DFDXDY(IA,JA,KA)+DX0P*DFDXDY(IA+1,JA,KA))+ &
           DY0*(AX0P*DFDY(IA,JA+1,KA)+BX0P*DFDY(IA+1,JA+1,KA)+ &
                CX0P*DFDXDY(IA,JA+1,KA)+DX0P*DFDXDY(IA+1,JA+1,KA))
      BTERMX=AY0*(AX0P*F(IA,JA,KA+1)+BX0P*F(IA+1,JA,KA+1)+ &
                CX0P*DFDX(IA,JA,KA+1)+DX0P*DFDX(IA+1,JA,KA+1))+ &
           BY0*(AX0P*F(IA,JA+1,KA+1)+BX0P*F(IA+1,JA+1,KA+1)+ &
                CX0P*DFDX(IA,JA+1,KA+1)+DX0P*DFDX(IA+1,JA+1,KA+1))+ &
           CY0*(AX0P*DFDY(IA,JA,KA+1)+BX0P*DFDY(IA+1,JA,KA+1)+ &
                CX0P*DFDXDY(IA,JA,KA+1)+DX0P*DFDXDY(IA+1,JA,KA+1))+ &
           DY0*(AX0P*DFDY(IA,JA+1,KA+1)+BX0P*DFDY(IA+1,JA+1,KA+1)+ &
                CX0P*DFDXDY(IA,JA+1,KA+1)+DX0P*DFDXDY(IA+1,JA+1,KA+1))
      CTERMX=AY0*(AX0P*DFDZ(IA,JA,KA)+BX0P*DFDZ(IA+1,JA,KA)+ &
                CX0P*DFDZDX(IA,JA,KA)+DX0P*DFDZDX(IA+1,JA,KA))+ &
           BY0*(AX0P*DFDZ(IA,JA+1,KA)+BX0P*DFDZ(IA+1,JA+1,KA)+ &
                CX0P*DFDZDX(IA,JA+1,KA)+DX0P*DFDZDX(IA+1,JA+1,KA))+ &
           CY0*(AX0P*DFDZDY(IA,JA,KA)+BX0P*DFDZDY(IA+1,JA,KA)+ &
                CX0P*DFDZDXDY(IA,JA,KA)+DX0P*DFDZDXDY(IA+1,JA,KA))+ &
           DY0*(AX0P*DFDZDY(IA,JA+1,KA)+BX0P*DFDZDY(IA+1,JA+1,KA)+ &
                CX0P*DFDZDXDY(IA,JA+1,KA)+DX0P*DFDZDXDY(IA+1,JA+1,KA))

      DTERMX=AY0*(AX0P*DFDZ(IA,JA,KA+1)+BX0P*DFDZ(IA+1,JA,KA+1)+ &
                CX0P*DFDZDX(IA,JA,KA+1)+DX0P*DFDZDX(IA+1,JA,KA+1))+ &
           BY0*(AX0P*DFDZ(IA,JA+1,KA+1)+BX0P*DFDZ(IA+1,JA+1,KA+1)+ &
                CX0P*DFDZDX(IA,JA+1,KA+1)+DX0P*DFDZDX(IA+1,JA+1,KA+1))+ &
           CY0*(AX0P*DFDZDY(IA,JA,KA+1)+BX0P*DFDZDY(IA+1,JA,KA+1)+ &
                CX0P*DFDZDXDY(IA,JA,KA+1)+DX0P*DFDZDXDY(IA+1,JA,KA+1))+ &
           DY0*(AX0P*DFDZDY(IA,JA+1,KA+1)+BX0P*DFDZDY(IA+1,JA+1,KA+1)+ &
             CX0P*DFDZDXDY(IA,JA+1,KA+1)+DX0P*DFDZDXDY(IA+1,JA+1,KA+1))


      DX=AZ0*ATERMX+BZ0*BTERMX+CZ0*CTERMX+DZ0*DTERMX
!C     ----------------------------------------------
      AY0P=-1.0/DEY
      BY0P=-AY0P
      CY0P=(3.0*AY0**2.0*AY0P-AY0P)/6.0*DEY**2.0
      DY0P=(3.0*BY0**2.0*BY0P-BY0P)/6.0*DEY**2.0
!C     -----------------------------------------------------------
      ATERMY=AY0P*(AX0*F(IA,JA,KA)+BX0*F(IA+1,JA,KA)+ &
                CX0*DFDX(IA,JA,KA)+DX0*DFDX(IA+1,JA,KA))+ &
           BY0P*(AX0*F(IA,JA+1,KA)+BX0*F(IA+1,JA+1,KA)+ &
                CX0*DFDX(IA,JA+1,KA)+DX0*DFDX(IA+1,JA+1,KA))+ &
           CY0P*(AX0*DFDY(IA,JA,KA)+BX0*DFDY(IA+1,JA,KA)+ &
                CX0*DFDXDY(IA,JA,KA)+DX0*DFDXDY(IA+1,JA,KA))+ &
           DY0P*(AX0*DFDY(IA,JA+1,KA)+BX0*DFDY(IA+1,JA+1,KA)+ &
                CX0*DFDXDY(IA,JA+1,KA)+DX0*DFDXDY(IA+1,JA+1,KA))
      BTERMY=AY0P*(AX0*F(IA,JA,KA+1)+BX0*F(IA+1,JA,KA+1)+ &
                CX0*DFDX(IA,JA,KA+1)+DX0*DFDX(IA+1,JA,KA+1))+ &
           BY0P*(AX0*F(IA,JA+1,KA+1)+BX0*F(IA+1,JA+1,KA+1)+ &
                CX0*DFDX(IA,JA+1,KA+1)+DX0*DFDX(IA+1,JA+1,KA+1))+ &
           CY0P*(AX0*DFDY(IA,JA,KA+1)+BX0*DFDY(IA+1,JA,KA+1)+ &
                CX0*DFDXDY(IA,JA,KA+1)+DX0*DFDXDY(IA+1,JA,KA+1))+ &
           DY0P*(AX0*DFDY(IA,JA+1,KA+1)+BX0*DFDY(IA+1,JA+1,KA+1)+ &
                CX0*DFDXDY(IA,JA+1,KA+1)+DX0*DFDXDY(IA+1,JA+1,KA+1))
      CTERMY=AY0P*(AX0*DFDZ(IA,JA,KA)+BX0*DFDZ(IA+1,JA,KA)+ &
                CX0*DFDZDX(IA,JA,KA)+DX0*DFDZDX(IA+1,JA,KA))+ &
           BY0P*(AX0*DFDZ(IA,JA+1,KA)+BX0*DFDZ(IA+1,JA+1,KA)+ &
                CX0*DFDZDX(IA,JA+1,KA)+DX0*DFDZDX(IA+1,JA+1,KA))+ &
           CY0P*(AX0*DFDZDY(IA,JA,KA)+BX0*DFDZDY(IA+1,JA,KA)+ &
                CX0*DFDZDXDY(IA,JA,KA)+DX0*DFDZDXDY(IA+1,JA,KA))+ &
           DY0P*(AX0*DFDZDY(IA,JA+1,KA)+BX0*DFDZDY(IA+1,JA+1,KA)+ &
                CX0*DFDZDXDY(IA,JA+1,KA)+DX0*DFDZDXDY(IA+1,JA+1,KA))
      DTERMY=AY0P*(AX0*DFDZ(IA,JA,KA+1)+BX0*DFDZ(IA+1,JA,KA+1)+ &
              CX0*DFDZDX(IA,JA,KA+1)+DX0*DFDZDX(IA+1,JA,KA+1))+ &
           BY0P*(AX0*DFDZ(IA,JA+1,KA+1)+BX0*DFDZ(IA+1,JA+1,KA+1)+ &
                CX0*DFDZDX(IA,JA+1,KA+1)+DX0*DFDZDX(IA+1,JA+1,KA+1))+ &
           CY0P*(AX0*DFDZDY(IA,JA,KA+1)+BX0*DFDZDY(IA+1,JA,KA+1)+ &
                CX0*DFDZDXDY(IA,JA,KA+1)+DX0*DFDZDXDY(IA+1,JA,KA+1))+ &
           DY0P*(AX0*DFDZDY(IA,JA+1,KA+1)+BX0*DFDZDY(IA+1,JA+1,KA+1)+ &
              CX0*DFDZDXDY(IA,JA+1,KA+1)+DX0*DFDZDXDY(IA+1,JA+1,KA+1))


      DY=AZ0*ATERMY+BZ0*BTERMY+CZ0*CTERMY+DZ0*DTERMY
!C     ----------------------------------------------
      AZ0P=-1.0/DEZ
      BZ0P=-AZ0P
      CZ0P=(3.0*AZ0**2.0*AZ0P-AZ0P)/6.0*DEZ**2.0
      DZ0P=(3.0*BZ0**2.0*BZ0P-BZ0P)/6.0*DEZ**2.0

      DZ=AZ0P*ATERM+BZ0P*BTERM+CZ0P*CTERM+DZ0P*DTERM
!C     ----------------------------------------------
      RETURN
      END SUBROUTINE
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************
!****************************************************************************************************


!     *********************** T R I D I A ***************************
!*******************************************************************************
!*SUB* int_PES6CuTRIDIA
!*******************************************************************************
!> 
!> 
!> @param alpha 
!> @param beta 
!> @param gamma 
!> @param b 
!> @param x 
!> @param n 
!*******************************************************************************
      SUBROUTINE int_PES6CuTRIDIA(alpha,beta,gamma,b,x,n)
!
!        Solution of tridiagonal systems
!
!     ALPHA: main diagonal (destroyed in TRIDIA).
!     BETA: subdiagonal (first element has index 1).
!     GAMMA: superdiagonal (first element has index 1).
!     B: right-hand side (destroyed in TRIDIA).
!     X: solution.
!     N: dimension of system.
!
      IMPLICIT REAL (a-h,o-z)
      DIMENSION alpha(n),beta(n),gamma(n),b(n),x(n)
!
      DO i=2,n
        rap = beta(i-1) / alpha(i-1)
        alpha(i) = alpha(i) - rap*gamma(i-1)
        b(i) = b(i) - rap*b(i-1)
      END DO
      x(n) = b(n) / alpha(n)

      DO j=2,n
        i = n-j+1
        x(i) = ( b(i) - gamma(i)*x(i+1) ) / alpha(i)
      END DO

      END SUBROUTINE int_PES6CuTRIDIA
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!     *********************** T R I ! Y ! L E ***********************
!*******************************************************************************
!*SUB* int_PES6CuTRICYCLE
!*******************************************************************************
!> 
!> 
!> @param alpha 
!> @param beta 
!> @param gamma 
!> @param cbot 
!> @param ctop 
!> @param b 
!> @param x 
!> @param n 
!> @param z 
!*******************************************************************************
      SUBROUTINE int_PES6CuTRICYCLE(alpha,beta,gamma,cbot,ctop,b,x,n,z)
!
!     Solution of tridiagonal cyclic system
!     Required subroutine: TRIDIA
!
!         A. SALIN    Version 1    9/8/98
!
!     ALPHA: main diagonal (destroyed in TRICYCLE)
!     BETA: subdiagonal
!     GAMMA: superdiagonal
!     CBOT: element of bottom left corner of matrix
!     CTOP: element of top right corner of matrix
!     B: righthand side (destroyed in TRICYCLE)
!     X: solution
!     N: dimension of system
!     Z: scratch vector of dimension N at least

      IMPLICIT REAL (a-h,o-z)
      DIMENSION alpha(n),beta(n),gamma(n),b(n),x(n),z(n)
!
      alp=-alpha(1)
      alpha(1)=alpha(1)-alp
      alpha(n)=alpha(n)-cbot*ctop/alp
      DO i=1,n
        z(i)=alpha(i)
      END DO
      CALL int_PES6CuTRIDIA(alpha,beta,gamma,b,x,n)
!
      DO i=1,n
        alpha(i)=z(i)
      END DO
      b(1)=alp
      b(n)=cbot
      DO i=2,n-1
        b(i)=0.0
      END DO
      CALL int_PES6CuTRIDIA(alpha,beta,gamma,b,z,n)
      fact=(x(1)+ctop*x(n)/alp)/(1.0+z(1)+ctop*z(n)/alp)
      DO i=1,n
        x(i)=x(i)-fact*z(i)
      END DO

      END SUBROUTINE int_PES6CuTRICYCLE
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*******************************************************************************
!*SUB* int_PES6CuSPLINT2
!*******************************************************************************
!> 
!> 
!> @param X 
!> @param Y 
!> @param N 
!> @param M 
!> @param F 
!> @param D2FDX 
!> @param D2FDY 
!> @param D4FDYDX 
!> @param X0 
!> @param Y0 
!> @param IA 
!> @param JA 
!> @param FX0Y0 
!> @param DFDX 
!> @param DFDY 
!> @param idx 
!> @param idy 
!*******************************************************************************
      SUBROUTINE int_PES6CuSPLINT2(X,Y,N,M,F,D2FDX,D2FDY,D4FDYDX,X0,Y0,IA,JA, &
                            FX0Y0,DFDX,DFDY,idx,idy)
!C     ------------------------------------------------------------------
!C     Esta rutina supone que ya se verifico que X0 e Y0 estan dentro
!C     del rango de interpolacion correcto. Si este no es el caso, el
!C     resultado obtenido sera incorrecto y NO se emitira ningun mensaje
!C     indicador!!!
!C     IA y JA indican la posicion de X0 e Y0 en la grilla dando los
!C     indices correspondientes al vertice inferior izquierdo del
!C     rectangulo donde se encuentra el punto (X0,Y0).
      IMPLICIT REAL(A-H,O-Z)
      DIMENSION X(idx),Y(idy),F(idx,idy)
      DIMENSION D2FDX(idx,idy),D2FDY(idx,idy),D4FDYDX(idx,idy)
!C     ------------------------------------------------------------------
      AX0=(X(IA+1)-X0)/(X(IA+1)-X(IA))
      BX0=1.0-AX0
      CX0=1.0/6.0*(AX0**3.0-AX0)*(X(IA+1)-X(IA))**2.0
      DX0=1.0/6.0*(BX0**3.0-BX0)*(X(IA+1)-X(IA))**2.0

      AY0=(Y(JA+1)-Y0)/(Y(JA+1)-Y(JA))
      BY0=1.0-AY0
      CY0=1.0/6.0*(AY0**3.0-AY0)*(Y(JA+1)-Y(JA))**2.0
      DY0=1.0/6.0*(BY0**3.0-BY0)*(Y(JA+1)-Y(JA))**2.0

      AX0P=-1.0/(X(IA+1)-X(IA))
      BX0P=-AX0P
      CX0P=1.0/6.0*(3.0*AX0**2.0*AX0P-AX0P)*(X(IA+1)-X(IA))**2.0
      DX0P=1.0/6.0*(3.0*BX0**2.0*BX0P-BX0P)*(X(IA+1)-X(IA))**2.0

      AY0P=-1.0/(Y(JA+1)-Y(JA))
      BY0P=-AY0P
      CY0P=1.0/6.0*(3.0*AY0**2.0*AY0P-AY0P)*(Y(JA+1)-Y(JA))**2.0
      DY0P=1.0/6.0*(3.0*BY0**2.0*BY0P-BY0P)*(Y(JA+1)-Y(JA))**2.0

      CY0PP=AY0*AY0P**2.0*(Y(JA+1)-Y(JA))**2.0
      DY0PP=BY0*BY0P**2.0*(Y(JA+1)-Y(JA))**2.0

      FX0Y0=AX0*(AY0*F(IA,JA)+BY0*F(IA,JA+1)+ &
                CY0*D2FDY(IA,JA)+DY0*D2FDY(IA,JA+1))+ &
           BX0*(AY0*F(IA+1,JA)+BY0*F(IA+1,JA+1)+ &
                CY0*D2FDY(IA+1,JA)+DY0*D2FDY(IA+1,JA+1))+ &
           CX0*(AY0*D2FDX(IA,JA)+BY0*D2FDX(IA,JA+1)+ &
                CY0*D4FDYDX(IA,JA)+DY0*D4FDYDX(IA,JA+1))+ &
           DX0*(AY0*D2FDX(IA+1,JA)+BY0*D2FDX(IA+1,JA+1)+ &
                CY0*D4FDYDX(IA+1,JA)+DY0*D4FDYDX(IA+1,JA+1))
      DFDX=AX0P*(AY0*F(IA,JA)+BY0*F(IA,JA+1)+ &
               CY0*D2FDY(IA,JA)+DY0*D2FDY(IA,JA+1))+ &
          BX0P*(AY0*F(IA+1,JA)+BY0*F(IA+1,JA+1)+ &
               CY0*D2FDY(IA+1,JA)+DY0*D2FDY(IA+1,JA+1))+ &
          CX0P*(AY0*D2FDX(IA,JA)+BY0*D2FDX(IA,JA+1)+ &
               CY0*D4FDYDX(IA,JA)+DY0*D4FDYDX(IA,JA+1))+ &
          DX0P*(AY0*D2FDX(IA+1,JA)+BY0*D2FDX(IA+1,JA+1)+ &
               CY0*D4FDYDX(IA+1,JA)+DY0*D4FDYDX(IA+1,JA+1))
      DFDY=AY0P*(AX0*F(IA,JA)+BX0*F(IA+1,JA)+ &
                CX0*D2FDX(IA,JA)+DX0*D2FDX(IA+1,JA))+ &
          BY0P*(AX0*F(IA,JA+1)+BX0*F(IA+1,JA+1)+ &
                CX0*D2FDX(IA,JA+1)+DX0*D2FDX(IA+1,JA+1))+ &
          CY0P*(AX0*D2FDY(IA,JA)+BX0*D2FDY(IA+1,JA)+ &
                CX0*D4FDYDX(IA,JA)+DX0*D4FDYDX(IA+1,JA))+ &
          DY0P*(AX0*D2FDY(IA,JA+1)+BX0*D2FDY(IA+1,JA+1)+ &
                CX0*D4FDYDX(IA,JA+1)+DX0*D4FDYDX(IA+1,JA+1))
      RETURN
      END SUBROUTINE int_PES6CuSPLINT2
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*******************************************************************************
!*SUB* int_PES6CuSPLINE2
!*******************************************************************************
!> 
!> 
!> @param X 
!> @param Y 
!> @param N 
!> @param M 
!> @param F 
!> @param D2FDX 
!> @param D2FDY 
!> @param D4FDYDX 
!> @param idx 
!> @param idy 
!*******************************************************************************
      SUBROUTINE int_PES6CuSPLINE2(X,Y,N,M,F,D2FDX,D2FDY,D4FDYDX,idx,idy)
      IMPLICIT REAL(A-H,O-Z)
      INTEGER, PARAMETER :: ndimmax = 16
      DIMENSION X(idx),Y(idy),F(idx,idy)
      DIMENSION FAUX1(idx),FAUX2(idy),FAUX3(idy),Y2(idx),Y2P(idy),Y2PP(idy)
      DIMENSION D2FDX(idx,idy),D2FDY(idx,idy),D4FDYDX(idx,idy)
      DIMENSION a(NDIMMAX),aa(NDIMMAX),aaa(NDIMMAX)
      DIMENSION b(NDIMMAX),bb(NDIMMAX),bbb(NDIMMAX)

      DO 300 J=1,M
         DO 400 I=1,N
            FAUX1(I)=F(I,J)
 400     CONTINUE
         CALL DSPLIN(N,X,FAUX1,Y2,0.0,0,0.0,0)
         DO 500 I=1,N
            D2FDX(I,J)=Y2(I)
 500     CONTINUE
 300  CONTINUE
      DO 600 I=1,N
         DO 700 J=1,M
            FAUX2(J)=F(I,J)
            FAUX3(J)=D2FDX(I,J)
 700     CONTINUE
         CALL DSPLIN(M,Y,FAUX2,Y2P,0.0,0,0.0,0)
         CALL DSPLIN(M,Y,FAUX3,Y2PP,0.0,0,0.0,0)
         DO 800 J=1,M
            D2FDY(I,J)=Y2P(J)
            D4FDYDX(I,J)=Y2PP(J)
 800     CONTINUE
 600  CONTINUE
      RETURN
      END SUBROUTINE int_PES6CuSPLINE2
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************
!*********************************************************************************************







END MODULE

