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 `domainUpperLimitVec` attribute of ParaMonte samplers.
45 : !> For more information, see the description of this attribute in the body of the module.
46 : !> \author Amir Shahmoradi
47 :
48 : module SpecBase_DomainUpperLimitVec_mod
49 :
50 : use Constants_mod, only: RK
51 : implicit none
52 :
53 : character(*), parameter :: MODULE_NAME = "@SpecBase_DomainUpperLimitVec_mod"
54 :
55 : real(RK), allocatable :: domainUpperLimitVec(:) ! namelist input
56 :
57 : type :: DomainUpperLimitVec_type
58 : real(RK), allocatable :: Val(:)
59 : real(RK) :: def
60 : real(RK) :: null
61 : character(:), allocatable :: desc
62 : contains
63 : procedure, pass :: set => setDomainUpperLimitVec, checkForSanity, nullifyNameListVar
64 : end type DomainUpperLimitVec_type
65 :
66 : interface DomainUpperLimitVec_type
67 : module procedure :: constructDomainUpperLimitVec
68 : end interface DomainUpperLimitVec_type
69 :
70 : private :: constructDomainUpperLimitVec, setDomainUpperLimitVec, checkForSanity, nullifyNameListVar
71 :
72 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
73 :
74 : contains
75 :
76 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77 :
78 1047 : function constructDomainUpperLimitVec(methodName) result(DomainUpperLimitVecObj)
79 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
80 : !DEC$ ATTRIBUTES DLLEXPORT :: constructDomainUpperLimitVec
81 : #endif
82 : use Decoration_mod, only: TAB
83 : use Constants_mod, only: NULL_RK, POSINF_RK
84 : use String_mod, only: num2str
85 : implicit none
86 : type(DomainUpperLimitVec_type) :: DomainUpperLimitVecObj
87 : character(*), intent(in) :: methodName
88 1047 : DomainUpperLimitVecObj%def = POSINF_RK
89 1047 : DomainUpperLimitVecObj%null = NULL_RK
90 : DomainUpperLimitVecObj%desc = &
91 : "domainUpperLimitVec represents the upper boundaries of the cubical domain of the objective function to be sampled. &
92 : &It is an ndim-dimensional vector of 64-bit real numbers, where ndim is the number of variables of the objective function. &
93 : &It is also possible to assign only select values of domainUpperLimitVec and leave the rest of the components to be assigned &
94 : &the default value. This is POSSIBLE ONLY when domainUpperLimitVec is defined inside the input file to "//methodName//". &
95 : &For example,\n\n&
96 : & domainUpperLimitVec(3:5) = 100\n\n&
97 : & will only set the upper limits of the third, fourth, and the fifth dimensions to 100, or,\n\n&
98 : & domainUpperLimitVec(1) = 100, domainUpperLimitVec(2) = 1.e6 \n\n&
99 : & will set the upper limit on the first dimension to 100, and 1.e6 on the second dimension, or,\n\n&
100 : & domainUpperLimitVec = 3*2.5e100\n\n&
101 : & will only set the upper limits on the first, second, and the third dimensions to 2.5*10^100, while the rest of &
102 : &the upper limits for the missing dimensions will be automatically set to the default value.\n\n&
103 1047 : &The default value for all elements of domainUpperLimitVec is: " // num2str(DomainUpperLimitVecObj%def) // "."
104 1047 : end function constructDomainUpperLimitVec
105 :
106 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
107 :
108 1047 : subroutine nullifyNameListVar(DomainUpperLimitVecObj,nd)
109 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
110 : !DEC$ ATTRIBUTES DLLEXPORT :: nullifyNameListVar
111 : #endif
112 1047 : use Constants_mod, only: IK
113 : implicit none
114 : class(DomainUpperLimitVec_type), intent(in) :: DomainUpperLimitVecObj
115 : integer(IK), intent(in) :: nd
116 1044 : if (allocated(domainUpperLimitVec)) deallocate(domainUpperLimitVec)
117 1047 : allocate(domainUpperLimitVec(nd))
118 2553 : domainUpperLimitVec(1:nd) = DomainUpperLimitVecObj%null
119 1047 : end subroutine nullifyNameListVar
120 :
121 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
122 :
123 2250 : subroutine setDomainUpperLimitVec(DomainUpperLimitVecObj,domainUpperLimitVec)
124 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
125 : !DEC$ ATTRIBUTES DLLEXPORT :: setDomainUpperLimitVec
126 : #endif
127 1047 : use Constants_mod, only: IK, RK
128 : implicit none
129 : class(DomainUpperLimitVec_type), intent(inout) :: DomainUpperLimitVecObj
130 : real(RK), intent(in) :: domainUpperLimitVec(:)
131 2811 : DomainUpperLimitVecObj%Val = domainUpperLimitVec
132 2733 : where ( DomainUpperLimitVecObj%Val == DomainUpperLimitVecObj%null )
133 1125 : DomainUpperLimitVecObj%Val = DomainUpperLimitVecObj%def
134 : end where
135 1125 : end subroutine setDomainUpperLimitVec
136 :
137 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138 :
139 1035 : subroutine checkForSanity(DomainUpperLimitVecObj,Err,domainLowerLimitVec)
140 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
141 : !DEC$ ATTRIBUTES DLLEXPORT :: checkForSanity
142 : #endif
143 1125 : use Err_mod, only: Err_type
144 : use Constants_mod, only: IK, POSINF_RK
145 : use String_mod, only: num2str
146 : implicit none
147 : class(DomainUpperLimitVec_type), intent(in) :: DomainUpperLimitVecObj
148 : real(RK), intent(in) :: domainLowerLimitVec(1:size(DomainUpperLimitVecObj%Val))
149 : type(Err_type), intent(inout) :: Err
150 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME//"@checkForSanity()"
151 : integer(IK) :: i
152 2529 : do i = 1,size(DomainUpperLimitVecObj%Val(:))
153 1494 : if ( DomainUpperLimitVecObj%Val(i) > POSINF_RK ) then
154 12 : Err%occurred = .true.
155 : Err%msg = Err%msg // &
156 : PROCEDURE_NAME // ": Error occurred. &
157 : &The upper limit of the component " // &
158 24 : num2str(i) // " of the variable domainUpperLimitVec (" // num2str(DomainUpperLimitVecObj%Val(i)) // ") &
159 : &cannot be larger than the largest positive real number representable in the simulation (" // &
160 12 : num2str(POSINF_RK) // ").\n\n"
161 : end if
162 2529 : if ( DomainUpperLimitVecObj%Val(i)<=domainLowerLimitVec(i) ) then
163 12 : Err%occurred = .true.
164 : Err%msg = Err%msg // &
165 : PROCEDURE_NAME // ": Error occurred. &
166 : &The input value for the upper limit of the component " // &
167 : num2str(i) // " of the variable domainUpperLimitVec cannot be smaller than or equal to the input value &
168 : &for the lower limit of the corresponding dimension as given by domainLowerLimitVec:\n" // &
169 12 : " domainLowerLimitVec(" // num2str(i) // ") = " // num2str(domainLowerLimitVec(i)) // "\n" // &
170 24 : " domainUpperLimitVec(" // num2str(i) // ") = " // num2str(DomainUpperLimitVecObj%Val(i)) // "\n\n"
171 : end if
172 : end do
173 1035 : end subroutine checkForSanity
174 :
175 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
176 :
177 : end module SpecBase_DomainUpperLimitVec_mod ! LCOV_EXCL_LINE
|
