SUBROUTINE LGOBFUN_DV(n, x, y, wts, x0, y0, pp, ppd, hx, hy, ll, lld, cv&
& , fixrho, nbdirs)
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
REAL*8, DIMENSION(n), INTENT(IN) :: x
REAL*8, DIMENSION(n), INTENT(IN) :: y
REAL*8, DIMENSION(n), INTENT(IN) :: wts
REAL*8, INTENT(IN) :: x0
REAL*8, INTENT(IN) :: y0
REAL*8, DIMENSION(5), INTENT(IN) :: pp
REAL*8, DIMENSION(5, 5), INTENT(IN) :: ppd
REAL*8, INTENT(IN) :: hx
REAL*8, INTENT(IN) :: hy
LOGICAL, INTENT(IN) :: cv
REAL*8, INTENT(IN) :: fixrho
REAL*8, INTENT(OUT) :: ll
REAL*8, INTENT(OUT) :: lld(5)
REAL*8, DIMENSION(n) :: lgauss
REAL*8, DIMENSION(5, n) :: lgaussd
REAL*8, DIMENSION(5) :: pars2
REAL*8, DIMENSION(5, 5) :: pars2d
REAL*8, DIMENSION(1) :: xtmp, ytmp, restmp
REAL*8, DIMENSION(5, 1) :: xtmpd, ytmpd, restmpd
REAL*8, DIMENSION(5) :: pars
REAL*8, DIMENSION(5, 5) :: parsd
REAL*8, DIMENSION(n) :: arg1
REAL*8, DIMENSION(5, n) :: arg1d
REAL*8 :: arg10
REAL*8 :: arg10d(5)
INTEGER :: nd
INTEGER :: nbdirs
INTRINSIC EXP
INTRINSIC ABS
INTRINSIC SUM
REAL*8 :: abs2
REAL*8 :: abs1
INTRINSIC SQRT
REAL*8 :: result1
ll = 0.0_8
IF (cv) THEN
DO nd=1,nbdirs
parsd(nd, 1:2) = ppd(nd, 1:2)
parsd(nd, 3:4) = ppd(nd, 3:4)*EXP(pp(3:4))
END DO
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
DO nd=1,nbdirs
parsd(nd, 5) = 0.0_8
lld(nd) = -(0.5_8*2*pp(5)*ppd(nd, 5))
END DO
pars(5) = fixrho
ll = -(0.5_8*pp(5)**2)
ELSE
DO nd=1,nbdirs
parsd(nd, 5) = (2.0_8*ppd(nd, 5)*EXP(pp(5))*(1.0_8+EXP(pp(5)))-&
& 2.0_8*EXP(pp(5))**2*ppd(nd, 5))/(1.0_8+EXP(pp(5)))**2
END DO
pars(5) = -1.0_8 + 2.0_8*EXP(pp(5))/(1.0_8+EXP(pp(5)))
DO nd=1,nbdirs
lld(nd) = 0.0_8
END DO
END IF
ELSE
DO nd=1,nbdirs
parsd(nd, :) = ppd(nd, :)
END DO
pars = pp
IF (fixrho .GE. 0.) THEN
abs2 = fixrho
ELSE
abs2 = -fixrho
END IF
IF (abs2 .LT. 1.0_8) THEN
DO nd=1,nbdirs
parsd(nd, 5) = 0.0_8
END DO
pars(5) = fixrho
DO nd=1,nbdirs
lld(nd) = 0.0_8
END DO
ELSE
DO nd=1,nbdirs
lld(nd) = 0.0_8
END DO
END IF
END IF
CALL LOGGAUSSPDF_DV(n, x, y, pars, parsd, lgauss, lgaussd, nbdirs)
arg10 = pars(3)**2 + hx**2
DO nd=1,nbdirs
arg1d(nd, :) = wts*lgaussd(nd, :)
lld(nd) = lld(nd) + SUM(arg1d(nd, :))/(1.0_8*n)
pars2d(nd, 1:2) = parsd(nd, 1:2)
arg10d(nd) = 2*pars(3)*parsd(nd, 3)
IF (arg10 .EQ. 0.0) THEN
pars2d(nd, 3) = 0.0_8
ELSE
result1 = SQRT(arg10)
pars2d(nd, 3) = arg10d(nd)/(2.0*result1)
END IF
arg10d(nd) = 2*pars(4)*parsd(nd, 4)
xtmpd(nd, 1) = 0.0_8
ytmpd(nd, 1) = 0.0_8
END DO
arg1(:) = wts*lgauss
ll = ll + SUM(arg1(:))/(1.0_8*n)
pars2(1:2) = pars(1:2)
pars2(3) = SQRT(arg10)
arg10 = pars(4)**2 + hy**2
pars2(4) = SQRT(arg10)
DO nd=1,nbdirs
IF (arg10 .EQ. 0.0) THEN
pars2d(nd, 4) = 0.0_8
ELSE
result1 = SQRT(arg10)
pars2d(nd, 4) = arg10d(nd)/(2.0*result1)
END IF
pars2d(nd, 5) = (((parsd(nd, 5)*pars(3)+pars(5)*parsd(nd, 3))*pars(4&
& )+pars(5)*pars(3)*parsd(nd, 4))*pars2(3)*pars2(4)-pars(5)*pars(3)*&
& pars(4)*(pars2d(nd, 3)*pars2(4)+pars2(3)*pars2d(nd, 4)))/(pars2(3)&
& *pars2(4))**2
END DO
pars2(5) = pars(5)*pars(3)*pars(4)/(pars2(3)*pars2(4))
xtmp(1) = x0
ytmp(1) = y0
CALL LOGGAUSSPDF_DV(1, xtmp, ytmp, pars2, pars2d, restmp, restmpd, &
& nbdirs)
DO nd=1,nbdirs
lld(nd) = lld(nd) - restmpd(nd, 1)*EXP(restmp(1))
END DO
ll = ll - EXP(restmp(1))
END SUBROUTINE LGOBFUN_DV
SUBROUTINE LOGGAUSSPDF_DV(n, x, y, pars, parsd, res, resd, nbdirs)
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(5, 5), INTENT(IN) :: parsd
REAL*8, DIMENSION(n), INTENT(OUT) :: res
REAL*8, DIMENSION(5, n), INTENT(OUT) :: resd
REAL*8, DIMENSION(n) :: cen1, cen2
REAL*8, DIMENSION(5, n) :: cen1d, cen2d
REAL*8 :: t1, f1, f2, f12
REAL*8 :: t1d(5), f1d(5), f2d(5), f12d(5)
REAL*8 :: arg1
REAL*8 :: arg1d(5)
REAL*8 :: result1
REAL*8 :: result1d(5)
REAL*8 :: arg2
REAL*8 :: arg2d(5)
INTEGER :: nd
INTEGER :: nbdirs
INTRINSIC LOG
INTRINSIC SQRT
REAL*8 :: result10
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
DO nd=1,nbdirs
t1d(nd) = (-(0.5_8*2*pars(5)*parsd(nd, 5)))/(1.0_8-pars(5)**2)**2
f1d(nd) = (t1d(nd)*pars(3)**2-t1*2*pars(3)*parsd(nd, 3))/(pars(3)**2&
& )**2
f2d(nd) = (t1d(nd)*pars(4)**2-t1*2*pars(4)*parsd(nd, 4))/(pars(4)**2&
& )**2
f12d(nd) = -((2.0*(parsd(nd, 5)*t1+pars(5)*t1d(nd))*pars(3)*pars(4)-&
& 2.0*pars(5)*t1*(parsd(nd, 3)*pars(4)+pars(3)*parsd(nd, 4)))/(pars(&
& 3)*pars(4))**2)
cen1d(nd, :) = -parsd(nd, 1)
cen2d(nd, :) = -parsd(nd, 2)
arg1d(nd) = -(2*pars(5)*parsd(nd, 5))
IF (arg1 .EQ. 0.0) THEN
result1d(nd) = 0.0
ELSE
result10 = SQRT(arg1)
result1d(nd) = arg1d(nd)/(2.0*result10)
END IF
arg2d(nd) = twopi*((parsd(nd, 3)*result1+pars(3)*result1d(nd))*pars(&
& 4)+pars(3)*result1*parsd(nd, 4))
resd(nd, :) = f1d(nd)*cen1**2 - arg2d(nd)/arg2 + f1*2*cen1*cen1d(nd&
& , :) + f2d(nd)*cen2**2 + f2*2*cen2*cen2d(nd, :) + (f12d(nd)*cen1+&
& f12*cen1d(nd, :))*cen2 + f12*cen1*cen2d(nd, :)
END DO
res = -LOG(arg2) + f1*cen1**2 + f2*cen2**2 + f12*cen1*cen2
END SUBROUTINE LOGGAUSSPDF_DV