SUBROUTINE
LGOBFUN
(n
, x
, y
, wts
, x0
, y0
, pp
, hx
, hy
, ll
, cv
, fixrho
)
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, INTENT(IN)
:: hx
REAL*8, INTENT(IN)
:: hy
LOGICAL, INTENT(IN)
:: cv
REAL*8, INTENT(IN)
:: fixrho
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) 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
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
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
CALL
LOGGAUSSPDF
(n, x, y, pars, lgauss)
arg1(:) = wts*lgauss
ll = ll + SUM
(arg1(:))/(1.0_8
*n)
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)
ll = ll - EXP
(restmp(1
))
END
SUBROUTINE
LGOBFUN
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