source: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_interpolation.f90 @ 5122

! $Id$
module lmdz_interpolation

  ! From Press et al., 1996, version 2.10a
  ! B3 Interpolation and Extrapolation

  IMPLICIT NONE; PRIVATE
  PUBLIC locate, hunt

CONTAINS

  pure FUNCTION locate(xx, x)

    REAL, DIMENSION(:), INTENT(IN) :: xx
    REAL, INTENT(IN) :: x
    INTEGER  locate

    ! Given an array xx(1:N), and given a value x, returns a value j,
    ! between 0 and N, such that x is between xx(j) and xx(j + 1). xx
    ! must be monotonic, either increasing or decreasing. j = 0 or j =
    ! N is returned to indicate that x is out of range. This
    ! procedure should not be called with a zero-sized array argument.
    ! See notes.

    INTEGER  n, jl, jm, ju
    LOGICAL  ascnd

    !----------------------------

    n = size(xx)
    ascnd = (xx(n) >= xx(1))
    ! (True if ascending order of table, false otherwise.)
    ! Initialize lower and upper limits:
    jl = 0
    ju = n + 1
    do while (ju - jl > 1)
      jm = (ju + jl) / 2 ! Compute a midpoint,
      IF (ascnd .eqv. (x >= xx(jm))) THEN
        jl = jm ! and replace either the lower limit
      else
        ju = jm ! or the upper limit, as appropriate.
      end if
    END DO
    ! {ju == jl + 1}

    ! {(ascnd .AND. xx(jl) <= x < xx(jl+1))
    !  .neqv. 
    !  (.NOT. ascnd .AND. xx(jl+1) <= x < xx(jl))}

    ! Then set the output, being careful with the endpoints:
    IF (x == xx(1)) THEN
      locate = 1
    ELSE IF (x == xx(n)) THEN
      locate = n - 1
    else
      locate = jl
    end if

  END FUNCTION locate

  !***************************

  pure SUBROUTINE hunt(xx, x, jlo)

    ! Given an array xx(1:N ), and given a value x, returns a value
    ! jlo such that x is between xx(jlo) and xx(jlo+1). xx must be
    ! monotonic, either increasing or decreasing. jlo = 0 or jlo = N is
    ! returned to indicate that x is out of range. jlo on input is taken as
    ! the initial guess for jlo on output.
    ! Modified so that it uses the information "jlo = 0" on input.

    INTEGER, INTENT(INOUT) :: jlo
    REAL, INTENT(IN) :: x
    REAL, DIMENSION(:), INTENT(IN) :: xx
    INTEGER  n, inc, jhi, jm
    LOGICAL  ascnd, hunt_up

    !-----------------------------------------------------

    n = size(xx)
    ascnd = (xx(n) >= xx(1))
    ! (True if ascending order of table, false otherwise.)
    IF (jlo < 0 .OR. jlo > n) THEN
      ! Input guess not useful. Go immediately to bisection.
      jlo = 0
      jhi = n + 1
    else
      inc = 1 ! Set the hunting increment.
      IF (jlo == 0) THEN
        hunt_up = .TRUE.
      else
        hunt_up = x >= xx(jlo) .eqv. ascnd
      end if
      IF (hunt_up) then ! Hunt up:
        DO
          jhi = jlo + inc
          IF (jhi > n) then ! Done hunting, since off end of table.
            jhi = n + 1
            exit
          else
            IF (x < xx(jhi) .eqv. ascnd) exit
            jlo = jhi ! Not done hunting,
            inc = inc + inc ! so double the increment
          end if
        END DO ! and try again.
      else ! Hunt down:
        jhi = jlo
        DO
          jlo = jhi - inc
          IF (jlo < 1) then ! Done hunting, since off end of table.
            jlo = 0
            exit
          else
            IF (x >= xx(jlo) .eqv. ascnd) exit
            jhi = jlo ! Not done hunting,
            inc = inc + inc ! so double the increment
          end if
        END DO ! and try again.
      end if
    end if ! Done hunting, value bracketed.

    do ! Hunt is done, so begin the final bisection phase:
      IF (jhi - jlo <= 1) THEN
        IF (x == xx(n)) jlo = n - 1
        IF (x == xx(1)) jlo = 1
        exit
      else
        jm = (jhi + jlo) / 2
        IF (x >= xx(jm) .eqv. ascnd) THEN
          jlo = jm
        else
          jhi = jm
        end if
      end if
    END DO

  END SUBROUTINE hunt

END MODULE lmdz_interpolation