SUBROUTINE
LGOBFUN_DV_CD
(n
, x
, y
, wts
, x0
, y0
, pp
, ppd
, hx
, hy
, ll
, lld
&
&
, nbdirs
)
USE
DIFFSIZES_DV
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(
nbdirsmax, 5
)
, INTENT(IN)
:: ppd
REAL*8
, INTENT(IN)
:: hx
REAL*8
, INTENT(IN)
:: hy
REAL*8
, INTENT(OUT)
:: ll
REAL*8
, DIMENSION(
nbdirsmax)
, INTENT(OUT)
:: lld
REAL*8
, DIMENSION(
n)
:: lgauss
REAL*8
, DIMENSION(
nbdirsmax, n)
:: lgaussd
REAL*8
, DIMENSION(
5
)
:: pars2
REAL*8
, DIMENSION(
nbdirsmax, 5
)
:: pars2d
REAL*8
, DIMENSION(
1
)
:: xtmp
, ytmp
, restmp
REAL*8
, DIMENSION(
nbdirsmax, 1
)
:: xtmpd
, ytmpd
, restmpd
REAL*8
, DIMENSION(
5
)
:: pars
REAL*8
, DIMENSION(
nbdirsmax, 5
)
:: parsd
REAL*8
, DIMENSION(
n)
:: arg1
REAL*8
, DIMENSION(
nbdirsmax, n)
:: arg1d
REAL*8
:: arg10
REAL*8
, DIMENSION(
nbdirsmax)
:: arg10d
INTEGER
:: nd
INTEGER
:: nbdirs
INTRINSIC
EXP
INTRINSIC
SUM
INTRINSIC
SQRT
REAL*8
:: result1
pars(1
:2
) = pp(1
:2
)
pars(3
:4
) = EXP
(pp(3
:4
))
pars(5
) = -1.0_8
+ 2.0_8
*EXP
(pp(5
))/(1.0_8
+EXP
(pp(5
)))
arg10 = pars(3
)**2
+ hx**2
DO
nd=1
,nbdirs
parsd(nd, 1
:2
) = ppd(nd, 1
:2
)
parsd(nd, 3
:4
) = ppd(nd, 3
:4
)*EXP
(pp(3
:4
))
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
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
CALL
LOGGAUSSPDF_DV_CD
(n, x, y, pars, parsd, lgauss, lgaussd, nbdirs)
pars2(1
:2
) = pars(1
:2
)
pars2(3
) = SQRT
(arg10)
arg10 = pars(4
)**2
+ hy**2
pars2(4
) = SQRT
(arg10)
DO
nd=1
,nbdirs
arg1d(nd, :) = wts*lgaussd(nd, :)
lld(nd) = SUM
(arg1d(nd, :))/(1.0_8
*n)
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
arg1(:) = wts*lgauss
ll = SUM
(arg1(:))/(1.0_8
*n)
pars2(5
) = pars(5
)*pars(3
)*pars(4
)/(pars2(3
)*pars2(4
))
xtmp(1
) = x0
ytmp(1
) = y0
CALL
LOGGAUSSPDF_DV_CD
(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_CD