Line data Source code
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 :
17 : !> \brief
18 : !> This include file contains procedure implementations of the tests of [pm_mathCumSum](@ref pm_mathCumSum).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, Tuesday 2:06 AM, September 21, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : integer(IK) :: itry
28 : #if getCumSum_ENABLED
29 : logical(LK), parameter :: isnew = .true.
30 : #elif setCumSum_ENABLED
31 : logical(LK) :: isnew
32 : #else
33 : #error "Unrecognized interface."
34 : #endif
35 : #if IK_ENABLED
36 : #define TYPE_KIND integer(TKC)
37 : integer(TKC), parameter :: TOL = 0_TKC
38 : integer(TKC), parameter :: LB = -1_TKC, UB = 1_TKC, ZERO = 0_TKC
39 : integer(TKC), allocatable :: cumSum_ref(:), cumSum(:), array(:), diff(:)
40 : #elif CK_ENABLED
41 : #define TYPE_KIND complex(TKC)
42 : complex(TKC), parameter :: TOL = epsilon(1._TKC) * 10._TKC * (1._TKC, 1._TKC)
43 : complex(TKC), parameter :: LB = (-1._TKC, -2._TKC), UB = (2._TKC, 1._TKC), ZERO = (0._TKC, 0._TKC)
44 : complex(TKC), allocatable :: cumSum_ref(:), cumSum(:), array(:), diff(:)
45 : #elif RK_ENABLED
46 : #define TYPE_KIND real(TKC)
47 : real(TKC), parameter :: TOL = epsilon(1._TKC) * 10._TKC
48 : real(TKC), parameter :: LB = -1._TKC, UB = 1._TKC, ZERO = 0._TKC
49 : real(TKC), allocatable :: cumSum_ref(:), cumSum(:), array(:), diff(:)
50 : #else
51 : #error "Unrecognized interface."
52 : #endif
53 : logical(LK) :: isbackward, isreverse
54 :
55 25 : assertion = .true._LK
56 :
57 7826 : do itry = 1, 300
58 :
59 : #if setCumSum_ENABLED
60 3900 : isnew = getUnifRand()
61 : #endif
62 7800 : isreverse = getUnifRand()
63 7800 : isbackward = getUnifRand()
64 58496 : array = getUnifRand(LB, UB, getUnifRand(1_IK, 10_IK))
65 7800 : call setResized(cumSum, size(array, 1, IK))
66 :
67 7800 : if (isbackward .and. isreverse) then
68 25402 : cumSum_ref = getCumSum_ref(array, backward, reverse)
69 : #if setCumSum_ENABLED
70 998 : if (isnew) then
71 484 : call setCumSum(cumSum, array, backward, reverse)
72 : else
73 3778 : cumSum = array
74 514 : call setCumSum(cumSum, array, backward, reverse)
75 : end if
76 : #elif getCumSum_ENABLED
77 12772 : cumSum = getCumSum(array, backward, reverse)
78 : #else
79 : #error "Unrecognized interface."
80 : #endif
81 5815 : elseif (isbackward) then
82 25116 : cumSum_ref = getCumSum_ref(array, backward, nothing)
83 : #if setCumSum_ENABLED
84 1002 : if (isnew) then
85 527 : call setCumSum(cumSum, array, backward, nothing)
86 : else
87 3466 : cumSum = array
88 475 : call setCumSum(cumSum, backward, nothing)
89 : end if
90 : #elif getCumSum_ENABLED
91 12378 : cumSum = getCumSum(array, backward, nothing)
92 : #endif
93 3876 : elseif (isreverse) then
94 25368 : cumSum_ref = getCumSum_ref(array, forward, reverse)
95 : #if setCumSum_ENABLED
96 930 : if (isnew) then
97 455 : call setCumSum(cumSum, array, forward, reverse)
98 : else
99 3663 : cumSum = array
100 475 : call setCumSum(cumSum, forward, reverse)
101 : end if
102 : #elif getCumSum_ENABLED
103 12936 : cumSum = getCumSum(array, forward, reverse)
104 : #endif
105 : else
106 25506 : cumSum_ref = getCumSum_ref(array, forward, nothing)
107 : #if setCumSum_ENABLED
108 970 : if (isnew) then
109 508 : call setCumSum(cumSum, array, forward, nothing)
110 : else
111 3514 : cumSum = array
112 462 : call setCumSum(cumSum, forward, nothing)
113 : end if
114 : #elif getCumSum_ENABLED
115 12832 : cumSum = getCumSum(array, forward, nothing)
116 : #endif
117 : end if
118 7813 : call report(__LINE__)
119 :
120 : #if getCumSum_ENABLED
121 3900 : if (isbackward .and. .not. isreverse) call runTestsWith(direction = backward)
122 3900 : if (isreverse .and. .not. isbackward) call runTestsWith(action = reverse)
123 3913 : if (.not. (isbackward .or. isreverse)) call runTestsWith()
124 : #endif
125 :
126 : end do
127 :
128 : contains
129 :
130 : #if getCumSum_ENABLED
131 2913 : subroutine runTestsWith(direction, action)
132 : class(action_type), intent(in), optional :: action
133 : class(direction_type), intent(in), optional :: direction
134 21986 : cumSum = getCumSum(array, direction, action)
135 2913 : call report(__LINE__)
136 2913 : end subroutine
137 : #endif
138 :
139 7800 : function getCumSum_ref(array, direction, action) result(cumSum)
140 : class(direction_type), intent(in), optional :: direction
141 : class(action_type), intent(in), optional :: action
142 23400 : class(direction_type), allocatable :: direction_def
143 15600 : class(action_type), allocatable :: action_def
144 : TYPE_KIND, intent(in) :: array(:)
145 : TYPE_KIND :: cumSum(size(array, 1, IK))
146 : integer(IK) :: i
147 7800 : action_def = nothing
148 7800 : direction_def = forward
149 7800 : if (present(action)) action_def = action
150 7800 : if (present(direction)) direction_def = direction
151 50696 : cumSum = array
152 7800 : if (same_type_as(direction_def, backward)) call setReversed(cumSum)
153 42896 : do i = 2, size(array, 1, IK)
154 42896 : cumSum(i) = cumSum(i) + cumSum(i - 1)
155 : end do
156 7800 : if (same_type_as(action_def, reverse)) call setReversed(cumSum)
157 7800 : end function
158 :
159 10713 : subroutine report(line)
160 : integer :: line
161 80482 : diff = cumSum - cumSum_ref
162 69769 : assertion = all(-TOL <= diff .and. diff <= TOL)
163 10713 : if (test%traceable .and. .not. assertion) then
164 : ! LCOV_EXCL_START
165 : call test%disp%skip
166 : call test%disp%show("isnew")
167 : call test%disp%show( isnew )
168 : call test%disp%show("isreverse")
169 : call test%disp%show( isreverse )
170 : call test%disp%show("isbackward")
171 : call test%disp%show( isbackward )
172 : call test%disp%show("cumSum_ref")
173 : call test%disp%show( cumSum_ref )
174 : call test%disp%show("cumSum")
175 : call test%disp%show( cumSum )
176 : call test%disp%show("array")
177 : call test%disp%show( array )
178 : call test%disp%show("diff")
179 : call test%disp%show( diff )
180 : call test%disp%show("TOL")
181 : call test%disp%show( TOL )
182 : call test%disp%skip
183 : ! LCOV_EXCL_STOP
184 : end if
185 10713 : call test%assert(assertion, SK_"The output `cumSum` must be correctly computed.", line)
186 10713 : end subroutine
187 : #undef TYPE_KIND
|
