Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!!
4 : !!!! MIT License
5 : !!!!
6 : !!!! ParaMonte: plain powerful parallel Monte Carlo library.
7 : !!!!
8 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab
9 : !!!!
10 : !!!! This file is part of the ParaMonte library.
11 : !!!!
12 : !!!! Permission is hereby granted, free of charge, to any person obtaining a
13 : !!!! copy of this software and associated documentation files (the "Software"),
14 : !!!! to deal in the Software without restriction, including without limitation
15 : !!!! the rights to use, copy, modify, merge, publish, distribute, sublicense,
16 : !!!! and/or sell copies of the Software, and to permit persons to whom the
17 : !!!! Software is furnished to do so, subject to the following conditions:
18 : !!!!
19 : !!!! The above copyright notice and this permission notice shall be
20 : !!!! included in all copies or substantial portions of the Software.
21 : !!!!
22 : !!!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
23 : !!!! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
24 : !!!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
25 : !!!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
26 : !!!! DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
27 : !!!! OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
28 : !!!! OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 : !!!!
30 : !!!! ACKNOWLEDGMENT
31 : !!!!
32 : !!!! ParaMonte is an honor-ware and its currency is acknowledgment and citations.
33 : !!!! As per the ParaMonte library license agreement terms, if you use any parts of
34 : !!!! this library for any purposes, kindly acknowledge the use of ParaMonte in your
35 : !!!! work (education/research/industry/development/...) by citing the ParaMonte
36 : !!!! library as described on this page:
37 : !!!!
38 : !!!! https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
39 : !!!!
40 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
42 :
43 : !> \brief
44 : !> This module contains the classes and procedures for setting up the `proposalStartCorMat` attribute of samplers of class [ParaMCMC_type](@ref paramcmc_mod::paramcmc_type).
45 : !> For more information, see the description of this attribute in the body of the module.
46 : !> \author Amir Shahmoradi
47 :
48 : module SpecMCMC_ProposalStartCorMat_mod
49 :
50 : use Constants_mod, only: RK
51 : implicit none
52 :
53 : character(*), parameter :: MODULE_NAME = "@SpecMCMC_ProposalStartCorMat_mod"
54 :
55 : real(RK), allocatable :: proposalStartCorMat(:,:) ! namelist input
56 :
57 : type :: ProposalStartCorMat_type
58 : real(RK), allocatable :: val(:,:)
59 : real(RK), allocatable :: def(:,:)
60 : real(RK) :: null
61 : character(:), allocatable :: desc
62 : contains
63 : procedure, pass :: set => setProposalStartCorMat, checkForSanity, nullifyNameListVar
64 : end type ProposalStartCorMat_type
65 :
66 : interface ProposalStartCorMat_type
67 : module procedure :: constructProposalStartCorMat
68 : end interface ProposalStartCorMat_type
69 :
70 : private :: constructProposalStartCorMat, setProposalStartCorMat, checkForSanity, nullifyNameListVar
71 :
72 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
73 :
74 : contains
75 :
76 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77 :
78 1047 : function constructProposalStartCorMat(nd,methodName) result(self)
79 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
80 : !DEC$ ATTRIBUTES DLLEXPORT :: constructProposalStartCorMat
81 : #endif
82 : use Constants_mod, only: IK, NULL_RK
83 : use String_mod, only: num2str
84 : use Matrix_mod, only: getEye
85 : implicit none
86 : integer(IK), intent(in) :: nd
87 : character(*), intent(in) :: methodName
88 : type(ProposalStartCorMat_type) :: self
89 1047 : allocate( self%Def(nd,nd) )
90 6024 : self%Def = getEye(nd,nd)
91 1047 : self%null = NULL_RK
92 : self%desc = &
93 : "proposalStartCorMat is a real-valued positive-definite matrix of size (ndim,ndim), where ndim is the dimension of the &
94 : &sampling space. It serves as the best-guess starting correlation matrix of the proposal distribution used by " &
95 : // methodName // ". &
96 : &It is used (along with the input vector ProposalStartStdVec) to construct the covariance matrix of the proposal &
97 : &distribution when the input covariance matrix is missing in the input list of variables. &
98 : &If the covariance matrix is given as input to "//methodName//", any input values for proposalStartCorMat, &
99 : &as well as ProposalStartStdVec, will be automatically ignored by "//methodName//". As input to " // methodName // &
100 : ", the variable proposalStartCorMat along with ProposalStartStdVec is especially useful in situations where &
101 1047 : &obtaining the best-guess covariance matrix is not trivial. The default value of proposalStartCorMat is an ndim-by-ndim Identity matrix."
102 1047 : end function constructProposalStartCorMat
103 :
104 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
105 :
106 1047 : subroutine nullifyNameListVar(self,nd)
107 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
108 : !DEC$ ATTRIBUTES DLLEXPORT :: nullifyNameListVar
109 : #endif
110 1047 : use Constants_mod, only: IK
111 : implicit none
112 : class(ProposalStartCorMat_type), intent(in) :: self
113 : integer(IK), intent(in) :: nd
114 1044 : if (allocated(proposalStartCorMat)) deallocate(proposalStartCorMat)
115 1047 : allocate(proposalStartCorMat(nd,nd))
116 4977 : proposalStartCorMat = self%null
117 1047 : end subroutine nullifyNameListVar
118 :
119 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
120 :
121 2130 : subroutine setProposalStartCorMat(self,proposalStartCorMat)
122 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
123 : !DEC$ ATTRIBUTES DLLEXPORT :: setProposalStartCorMat
124 : #endif
125 1047 : use Constants_mod, only: RK
126 : implicit none
127 : class(ProposalStartCorMat_type), intent(inout) :: self
128 : real(RK), intent(in) :: proposalStartCorMat(:,:)
129 5097 : self%Val = proposalStartCorMat
130 5079 : where (self%Val==self%null)
131 1065 : self%Val = self%Def
132 : end where
133 1065 : end subroutine setProposalStartCorMat
134 :
135 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
136 :
137 : ! There is no need to check for eyeness of the input correlation matrix. Only positive definiteness is enough.
138 : ! If the input correlation matrix is problematic, it will eventually lead to a non-positive-definite covariance matrix.
139 1035 : subroutine checkForSanity(self,Err,methodName,nd)
140 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
141 : !DEC$ ATTRIBUTES DLLEXPORT :: checkForSanity
142 : #endif
143 1065 : use Constants_mod, only: IK, RK, SPR
144 : use Matrix_mod, only: isPosDef
145 : use String_mod, only: num2str
146 : use Err_mod, only: Err_type
147 : implicit none
148 : class(ProposalStartCorMat_type), intent(in) :: self
149 : integer(IK), intent(in) :: nd
150 : character(*), intent(in) :: methodName
151 : type(Err_type), intent(inout) :: Err
152 : character(*), parameter :: PROCEDURE_NAME = "@checkForSanity()"
153 : !integer(IK) :: i, j
154 1035 : if (.not.isPosDef(nd,self%Val)) then
155 6 : Err%occurred = .true.
156 : Err%msg = Err%msg // &
157 : MODULE_NAME // PROCEDURE_NAME // ": Error occurred. The input requested proposalStartCorMat &
158 6 : &for the proposal of " // methodName // " is not a positive-definite matrix.\n\n"
159 : end if
160 : !do j = 1, nd
161 : ! if (abs(proposalStartCorMat(j,j) - 1._RK) > 1.e-10_RK) then
162 : ! Err%occurred = .true.
163 : ! Err%msg = Err%msg // &
164 : ! MODULE_NAME // PROCEDURE_NAME // ": Error occurred. The input requested element &
165 : ! &proposalStartCorMat("//num2str(j)//","//num2str(j)//") = "//num2str(proposalStartCorMat(j,j))// &
166 : ! " must be, by definition, equal to one.\n\n"
167 : ! end if
168 : ! do i = 1, j-1
169 : ! if ( abs(proposalStartCorMat(i,j)) >= 1._RK ) then
170 : ! Err%occurred = .true.
171 : ! Err%msg = Err%msg // &
172 : ! MODULE_NAME // PROCEDURE_NAME // ": Error occurred. The input requested element &
173 : ! &proposalStartCorMat("//num2str(i)//","//num2str(j)//") = "//num2str(proposalStartCorMat(i,j))// &
174 : ! " must be, by definition, bounded within the open range (-1,1).\n\n"
175 : ! end if
176 : ! end do
177 : !end do
178 2070 : end subroutine checkForSanity
179 :
180 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
181 :
182 : end module SpecMCMC_ProposalStartCorMat_mod ! LCOV_EXCL_LINE
|
