ParaMonte Fortran 2.0.0
Parallel Monte Carlo and Machine Learning Library
See the latest version documentation.
test_pm_mathLogSumExp.F90
Go to the documentation of this file.
1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3!!!! !!!!
4!!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5!!!! !!!!
6!!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7!!!! !!!!
8!!!! This file is part of the ParaMonte library. !!!!
9!!!! !!!!
10!!!! LICENSE !!!!
11!!!! !!!!
12!!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13!!!! !!!!
14!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16
19
20module test_pm_mathLogSumExp
21
22 use pm_mathLogSumExp
23 use pm_err, only: err_type
24 use pm_test, only: test_type, LK
25 use pm_kind, only: LK
26 implicit none
27
28 private
29 public :: setTest
30 type(test_type) :: test
31
32!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
33
34 interface
35
36 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
37
38#if CK3_ENABLED
39 module function test_getLogSumExp_CK3_1() result(assertion); logical(LK) :: assertion; end function
40#endif
41#if CK2_ENABLED
42 module function test_getLogSumExp_CK2_1() result(assertion); logical(LK) :: assertion; end function
43#endif
44#if CK1_ENABLED
45 module function test_getLogSumExp_CK1_1() result(assertion); logical(LK) :: assertion; end function
46#endif
47
48 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
49
50#if RK3_ENABLED
51 module function test_getLogSumExp_RK3_1() result(assertion); logical(LK) :: assertion; end function
52#endif
53#if RK2_ENABLED
54 module function test_getLogSumExp_RK2_1() result(assertion); logical(LK) :: assertion; end function
55#endif
56#if RK1_ENABLED
57 module function test_getLogSumExp_RK1_1() result(assertion); logical(LK) :: assertion; end function
58#endif
59
60 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
61
62 end interface
63
64!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
65
66contains
67
68!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
69
70 subroutine setTest()
71
72 test = test_type(MODULE_NAME)
73
74 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
75
76#if CK3_ENABLED
77 call test%run(test_getLogSumExp_CK3_1, SK_"test_getLogSumExp_CK3_1")
78#endif
79#if CK2_ENABLED
80 call test%run(test_getLogSumExp_CK2_1, SK_"test_getLogSumExp_CK2_1")
81#endif
82#if CK1_ENABLED
83 call test%run(test_getLogSumExp_CK1_1, SK_"test_getLogSumExp_CK1_1")
84#endif
85
86 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
87
88#if RK3_ENABLED
89 call test%run(test_getLogSumExp_RK3_1, SK_"test_getLogSumExp_RK3_1")
90#endif
91#if RK2_ENABLED
92 call test%run(test_getLogSumExp_RK2_1, SK_"test_getLogSumExp_RK2_1")
93#endif
94#if RK1_ENABLED
95 call test%run(test_getLogSumExp_RK1_1, SK_"test_getLogSumExp_RK1_1")
96#endif
97
98 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
99
100 call test%summarize()
101
102 end subroutine setTest
103
104!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
105
106 function test_getLogSumExp_RK_1() result(assertion)
107 use pm_kind, only: RK, IK
108 implicit none
109 logical(LK) :: assertion
110 real(RK), parameter :: LogValue(*) = [ log(0.5*huge(1._RK)), log(0.9*huge(1._RK)), log(0.1*huge(1._RK)) ]
111 real(RK), parameter :: tolerance = 1.e-10_RK
112 real(RK), parameter :: logSumExp_ref = 710.1881779865910_RK
113 real(RK) :: logSumExp
114 real(RK) :: difference
115 logSumExp = getLogSumExp(LogValue, maxval(LogValue))
116 difference = abs(logSumExp - logSumExp_ref)
117 assertion = difference < tolerance
118 if (test%traceable .and. .not. assertion) then
119 ! LCOV_EXCL_START
120 write(test%disp%unit,"(*(g0,:,' '))")
121 write(test%disp%unit,"(*(g0,:,' '))") "logSumExp_ref = ", logSumExp_ref
122 write(test%disp%unit,"(*(g0,:,' '))") "logSumExp = ", logSumExp
123 write(test%disp%unit,"(*(g0,:,' '))") "difference = ", difference
124 write(test%disp%unit,"(*(g0,:,' '))")
125 end if
126 ! LCOV_EXCL_STOP
127 end function test_getLogSumExp_RK_1
128
129!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
130
131 function test_getLogSumExp_RK_2() result(assertion)
132 use pm_kind, only: RK, IK
133 implicit none
134 logical(LK) :: assertion
135 real(RK), parameter :: LogValue(*) = [ log(0.5*huge(1._RK)), log(0.9*huge(1._RK)), log(0.1*huge(1._RK)) ]
136 real(RK), parameter :: tolerance = 1.e-10_RK
137 real(RK), parameter :: logSumExp_ref = 710.1881779865910_RK
138 real(RK) :: logSumExp
139 real(RK) :: difference
140 logSumExp = getLogSumExp(LogValue, maxval(LogValue))
141 difference = abs(logSumExp - logSumExp_ref)
142 assertion = difference < tolerance
143 if (test%traceable .and. .not. assertion) then
144 ! LCOV_EXCL_START
145 write(test%disp%unit,"(*(g0,:,' '))")
146 write(test%disp%unit,"(*(g0,:,' '))") "logSumExp_ref = ", logSumExp_ref
147 write(test%disp%unit,"(*(g0,:,' '))") "logSumExp = ", logSumExp
148 write(test%disp%unit,"(*(g0,:,' '))") "difference = ", difference
149 write(test%disp%unit,"(*(g0,:,' '))")
150 end if
151 ! LCOV_EXCL_STOP
152 end function test_getLogSumExp_RK_2
153
154!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
155
156 function test_getLogSumExp_CK_1() result(assertion)
157 use pm_kind, only: RK, IK
158 implicit none
159 logical(LK) :: assertion
160 complex(RK), parameter :: LogValue(*) = [ cmplx( log(0.5*huge(1._RK)), 0._RK, kind = RK ) &
161 , cmplx( log(0.9*huge(1._RK)), 0._RK, kind = RK ) &
162 , cmplx( log(0.1*huge(1._RK)), 0._RK, kind = RK ) &
163 ]
164 real(RK), parameter :: logSumExp_ref = cmplx(710.1881779865910_RK, 0._RK, RK)
165 complex(RK), parameter :: tolerance = cmplx(1.e-10_RK, 0._RK, RK)
166 complex(RK) :: logSumExp
167 complex(RK) :: difference
168 logSumExp = getLogSumExp(LogValue, cmplx( maxval(real(LogValue,kind=RK)), kind = RK ))
169 difference = abs(logSumExp - logSumExp_ref)
170 assertion = real(difference,RK) < real(tolerance,RK)
171 if (test%traceable .and. .not. assertion) then
172 ! LCOV_EXCL_START
173 write(test%disp%unit,"(*(g0,:,' '))")
174 write(test%disp%unit,"(*(g0,:,' '))") "logSumExp_ref = ", logSumExp_ref
175 write(test%disp%unit,"(*(g0,:,' '))") "logSumExp = ", logSumExp
176 write(test%disp%unit,"(*(g0,:,' '))") "difference = ", difference
177 write(test%disp%unit,"(*(g0,:,' '))")
178 end if
179 ! LCOV_EXCL_STOP
180 end function test_getLogSumExp_CK_1
181
182!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
183
184 function test_getLogSumExp_CK_2() result(assertion)
185 use pm_kind, only: RK, IK
186 implicit none
187 logical(LK) :: assertion
188 complex(RK), parameter :: LogValue(*) = [ cmplx( log(0.5*huge(1._RK)), 0._RK, kind = RK ) &
189 , cmplx( log(0.9*huge(1._RK)), 0._RK, kind = RK ) &
190 , cmplx( log(0.1*huge(1._RK)), 0._RK, kind = RK ) &
191 ]
192 real(RK), parameter :: logSumExp_ref = cmplx(710.1881779865910_RK, 0._RK, RK)
193 complex(RK), parameter :: tolerance = cmplx(1.e-10_RK, 0._RK, RK)
194 complex(RK) :: logSumExp
195 complex(RK) :: difference
196 logSumExp = getLogSumExp(LogValue, cmplx( maxval(real(LogValue,kind=RK)), kind = RK ))
197 difference = abs(logSumExp - logSumExp_ref)
198 assertion = real(difference,RK) < real(tolerance,RK)
199 if (test%traceable .and. .not. assertion) then
200 ! LCOV_EXCL_START
201 write(test%disp%unit,"(*(g0,:,' '))")
202 write(test%disp%unit,"(*(g0,:,' '))") "logSumExp_ref = ", logSumExp_ref
203 write(test%disp%unit,"(*(g0,:,' '))") "logSumExp = ", logSumExp
204 write(test%disp%unit,"(*(g0,:,' '))") "difference = ", difference
205 write(test%disp%unit,"(*(g0,:,' '))")
206 end if
207 ! LCOV_EXCL_STOP
208 end function test_getLogSumExp_CK_2
209
210!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
211
212end module test_pm_mathLogSumExp ! LCOV_EXCL_LINE
pm_mathLogSumExp::getLogSumExp
Generate and return the natural logarithm of the sum of the exponential of the input array robustly (...
Definition: pm_mathLogSumExp.F90:147
pm_err
This module contains classes and procedures for reporting and handling errors.
Definition: pm_err.F90:52
pm_err::MODULE_NAME
character(*, SK), parameter MODULE_NAME
Definition: pm_err.F90:58
pm_kind
This module defines the relevant Fortran kind type-parameters frequently used in the ParaMonte librar...
Definition: pm_kind.F90:268
pm_kind::RK
integer, parameter RK
The default real kind in the ParaMonte library: real64 in Fortran, c_double in C-Fortran Interoperati...
Definition: pm_kind.F90:543
pm_kind::LK
integer, parameter LK
The default logical kind in the ParaMonte library: kind(.true.) in Fortran, kind(....
Definition: pm_kind.F90:541
pm_kind::IK
integer, parameter IK
The default integer kind in the ParaMonte library: int32 in Fortran, c_int32_t in C-Fortran Interoper...
Definition: pm_kind.F90:540
pm_mathLogSumExp
This module contains the procedures and interfaces for computing the natural logarithm of the sum of ...
Definition: pm_mathLogSumExp.F90:39
pm_test
This module contains a simple unit-testing framework for the Fortran libraries, including the ParaMon...
Definition: pm_test.F90:42
test_pm_mathLogSumExp
This module contains tests of the module pm_mathLogSumExp.
Definition: test_pm_mathLogSumExp.F90:20
test_pm_mathLogSumExp::test_getLogSumExp_CK_1
logical(LK) function test_getLogSumExp_CK_1()
Definition: test_pm_mathLogSumExp.F90:157
test_pm_mathLogSumExp::test_getLogSumExp_RK_1
logical(LK) function test_getLogSumExp_RK_1()
Definition: test_pm_mathLogSumExp.F90:107
test_pm_mathLogSumExp::test_getLogSumExp_RK_2
logical(LK) function test_getLogSumExp_RK_2()
Definition: test_pm_mathLogSumExp.F90:132
test_pm_mathLogSumExp::test_getLogSumExp_CK_2
logical(LK) function test_getLogSumExp_CK_2()
Definition: test_pm_mathLogSumExp.F90:185
test_pm_mathLogSumExp::test
type(test_type) test
Definition: test_pm_mathLogSumExp.F90:30
test_pm_mathLogSumExp::setTest
subroutine setTest()
Definition: test_pm_mathLogSumExp.F90:71
pm_err::err_type
This is the derived type for generating objects to gracefully and verbosely handle runtime unexpected...
Definition: pm_err.F90:157
pm_test::test_type
This is the derived type test_type for generating objects that facilitate testing of a series of proc...
Definition: pm_test.F90:209