Generated by TAPENADE

    !        Generated by TAPENADE     (INRIA, Tropics team)
    !  Tapenade 3.2 (r3024) - 06/17/2009 13:03
    !
    ! This is the objective function
    SUBROUTINE LGOBFUN(n, x, y, wts, x0, y0, pp, hx, hy, ll, cv, fixrho)
      IMPLICIT NONE
    ! number of data points
      INTEGER, INTENT(IN) :: n
    ! x-data points
      REAL*8, DIMENSION(n), INTENT(IN) :: x
    ! y-data points
      REAL*8, DIMENSION(n), INTENT(IN) :: y
    ! kernel weights of each data point
      REAL*8, DIMENSION(n), INTENT(IN) :: wts
    ! x-coordinate where local parameters are computed
      REAL*8, INTENT(IN) :: x0
    ! y-coordinate where local parameters are computed
      REAL*8, INTENT(IN) :: y0
    ! transformed parameters used by optimizer
      REAL*8, DIMENSION(5), INTENT(IN) :: pp
    ! x-dir bandwidth
      REAL*8, INTENT(IN) :: hx
    ! y-dir bandwidth
      REAL*8, INTENT(IN) :: hy
    ! should the input parameters be transformed?
      LOGICAL, INTENT(IN) :: cv
    ! fixed rho?
      REAL*8, INTENT(IN) :: fixrho
    ! objective function out
      REAL*8, INTENT(OUT) :: ll
      REAL*8, DIMENSION(n) :: lgauss
      REAL*8, DIMENSION(5) :: pars2
      REAL*8, DIMENSION(1) :: xtmp, ytmp, restmp
      REAL*8, DIMENSION(5) :: pars
      REAL*8, DIMENSION(n) :: arg1
      REAL*8 :: arg10
      INTRINSIC EXP
      INTRINSIC ABS
      INTRINSIC SUM
      REAL*8 :: abs2
      REAL*8 :: abs1
      INTRINSIC SQRT
      ll = 0.0_8
    ! if cv=TRUE; Transform parameters
      IF (cv) THEN
        pars(1:2) = pp(1:2)
        pars(3:4) = EXP(pp(3:4))
        IF (fixrho .GE. 0.) THEN
          abs1 = fixrho
        ELSE
          abs1 = -fixrho
        END IF
        IF (abs1 .LT. 1.0_8) THEN
          pars(5) = fixrho
    ! add this to make optimizer work
    ! if rho is fixed
          ll = -(0.5_8*pp(5)**2)
        ELSE
          pars(5) = -1.0_8 + 2.0_8*EXP(pp(5))/(1.0_8+EXP(pp(5)))
        END IF
      ELSE
    ! otherwise, pass parameters as they are
        pars = pp
        IF (fixrho .GE. 0.) THEN
          abs2 = fixrho
        ELSE
          abs2 = -fixrho
        END IF
        IF (abs2 .LT. 1.0_8) pars(5) = fixrho
      END IF
    ! compute logdensites for the weighted log-likelihood
      CALL LOGGAUSSPDF(n, x, y, pars, lgauss)
    ! weighted log-likelihood
      arg1(:) = wts*lgauss
      ll = ll + SUM(arg1(:))/(1.0_8*n)
    ! work out parameters for the penalty term
      pars2(1:2) = pars(1:2)
      arg10 = pars(3)**2 + hx**2
      pars2(3) = SQRT(arg10)
      arg10 = pars(4)**2 + hy**2
      pars2(4) = SQRT(arg10)
      pars2(5) = pars(5)*pars(3)*pars(4)/(pars2(3)*pars2(4))
      xtmp(1) = x0
      ytmp(1) = y0
      CALL LOGGAUSSPDF(1, xtmp, ytmp, pars2, restmp)
    ! add penalty term to objective
      ll = ll - EXP(restmp(1))
    END SUBROUTINE LGOBFUN

    !----------------------------------------------------------------------
    ! This file defines the objective function for local gaussian correlation
    !----------------------------------------------------------------------
    ! Throughout, we use the convetion for parameters of a bivariate gaussian
    ! pars(1) = mu_x
    ! pars(2) = mu_y
    ! pars(3) = sigma_x
    ! pars(4) = sigma_y
    ! pars(5) = rho
    !-------------------------------------------------------------------------
    ! log-density of a bivariate Gaussian, vectorized in the data
    ! with parameters fixed
    SUBROUTINE LOGGAUSSPDF(n, x, y, pars, res)
      IMPLICIT NONE
      REAL*8, PARAMETER :: twopi=6.283185307179586e+00_8
      INTEGER, INTENT(IN) :: n
      REAL*8, DIMENSION(n), INTENT(IN) :: x
      REAL*8, DIMENSION(n), INTENT(IN) :: y
      REAL*8, DIMENSION(5), INTENT(IN) :: pars
      REAL*8, DIMENSION(n), INTENT(OUT) :: res
      REAL*8, DIMENSION(n) :: cen1, cen2
      REAL*8 :: t1, f1, f2, f12
      REAL(8) :: arg1
      REAL :: result1
      REAL*8 :: arg2
      INTRINSIC LOG
      INTRINSIC SQRT
      t1 = -(0.5_8/(1.0_8-pars(5)**2))
      f1 = t1/pars(3)**2
      f2 = t1/pars(4)**2
      f12 = -(2.0*pars(5)*t1/(pars(3)*pars(4)))
      cen1 = x - pars(1)
      cen2 = y - pars(2)
      arg1 = 1.0_8 - pars(5)**2
      result1 = SQRT(arg1)
      arg2 = twopi*pars(3)*pars(4)*result1
      res = -LOG(arg2) + f1*cen1**2 + f2*cen2**2 + f12*cen1*cen2
    END SUBROUTINE LOGGAUSSPDF