Skip to content

Commit

Permalink
Setting up MCMC structure
Browse files Browse the repository at this point in the history
  • Loading branch information
jchristopherson committed Feb 12, 2025
1 parent 3b959ef commit f4236bc
Show file tree
Hide file tree
Showing 3 changed files with 457 additions and 0 deletions.
1 change: 1 addition & 0 deletions src/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -18,5 +18,6 @@ set(FSTATS_SOURCES
${dir}/fstats_sampling.f90
${dir}/fstats_smoothing.f90
${dir}/fstats_types.f90
${dir}/fstats_mcmc.f90
)
set(FSTATS_SOURCES ${FSTATS_SOURCES} PARENT_SCOPE)
45 changes: 45 additions & 0 deletions src/fstats_distributions.f90
Original file line number Diff line number Diff line change
Expand Up @@ -182,6 +182,7 @@ pure function multivariate_distribution_function(this, x) result(rst)
contains
procedure, public :: initialize => mvnd_init
procedure, public :: pdf => mvnd_pdf
procedure, public :: set_means => mvnd_update_mean
end type

contains
Expand Down Expand Up @@ -802,6 +803,50 @@ pure function mvnd_pdf(this, x) result(rst)
rst = exp(-0.5d0 * arg) / sqrt((2.0d0 * pi)**n * this%m_covDet)
end function

! ------------------------------------------------------------------------------
subroutine mvnd_update_mean(this, x, err)
!! Updates the mean value array.
class(multivariate_normal_distribution), intent(inout) :: this
!! The multivariate_normal_distribution object.
real(real64), intent(in), dimension(:) :: x
!! The N-element array of new mean values.
class(errors), intent(inout), optional, target :: err
!! The error handling object. This is referenced only in the event that
!! the size of x is not compatible with the existing state.

! Local Variables
integer(int32) :: n, nc, flag
class(errors), pointer :: errmgr
type(errors), target :: deferr

! Initialization
if (present(err)) then
errmgr => err
else
errmgr => deferr
end if
n = size(x)
nc = size(this%m_means)

! Process
if (.not.allocated(this%m_means)) then
! This is an initial set-up - just store the values and be done
allocate(this%m_means(n), stat = flag, source = x)
if (flag /= 0) then
call report_memory_error(errmgr, "mvnd_update_mean", flag)
return
end if
return
end if

! Else, ensure the array is of the correct size before updating
if (n /= nc) then
call report_array_size_error(errmgr, "mvnd_update_mean", "x", nc, n)
return
end if
this%m_means = x
end subroutine

! ******************************************************************************
! SUPPORTING ROUTINES
! ------------------------------------------------------------------------------
Expand Down
Loading

0 comments on commit f4236bc

Please sign in to comment.