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 This module contains tests of the module [Sort_mod](@ref sort_mod).
44 : !> \author Amir Shahmoradi
45 :
46 : module Test_Sort_mod
47 :
48 : use Sort_mod
49 : use Test_mod, only: Test_type
50 : use Constants_mod, only: IK, RK
51 : implicit none
52 :
53 : private
54 : public :: test_Sort
55 :
56 : type(Test_type) :: Test
57 : integer, parameter :: ndata = 50
58 : integer(IK), parameter :: DataUnsorted_IK(ndata)= &
59 : [ 1201_IK &
60 : , 1187_IK &
61 : , 1188_IK &
62 : , 1193_IK &
63 : , 1177_IK &
64 : , 1153_IK &
65 : , 1134_IK &
66 : , 1146_IK &
67 : , 1172_IK &
68 : , 1181_IK &
69 : , 1197_IK &
70 : , 1172_IK &
71 : , 1141_IK &
72 : , 1216_IK &
73 : , 1158_IK &
74 : , 1174_IK &
75 : , 1189_IK &
76 : , 1211_IK &
77 : , 1157_IK &
78 : , 1184_IK &
79 : , 1177_IK &
80 : , 1157_IK &
81 : , 1191_IK &
82 : , 1176_IK &
83 : , 1196_IK &
84 : , 1150_IK &
85 : , 1185_IK &
86 : , 1190_IK &
87 : , 1172_IK &
88 : , 1161_IK &
89 : , 1179_IK &
90 : , 1189_IK &
91 : , 1136_IK &
92 : , 1148_IK &
93 : , 1176_IK &
94 : , 1142_IK &
95 : , 1146_IK &
96 : , 1202_IK &
97 : , 1156_IK &
98 : , 1170_IK &
99 : , 1146_IK &
100 : , 1170_IK &
101 : , 1169_IK &
102 : , 1211_IK &
103 : , 1168_IK &
104 : , 1189_IK &
105 : , 1170_IK &
106 : , 1162_IK &
107 : , 1167_IK &
108 : , 1180_IK ]
109 : real(RK), parameter :: DataUnsorted_RK(ndata) = &
110 : [ 5.28935260000000_RK &
111 : , 5.50145870000000_RK &
112 : , 5.89022390000000_RK &
113 : , 5.06549460000000_RK &
114 : , 5.62128260000000_RK &
115 : , 4.49246930000000_RK &
116 : , 3.54559920000000_RK &
117 : , 4.17171310000000_RK &
118 : , 5.34432780000000_RK &
119 : , 4.30855910000000_RK &
120 : , 6.12466330000000_RK &
121 : , 4.45103540000000_RK &
122 : , 4.08259680000000_RK &
123 : , 7.64761290000000_RK &
124 : , 6.53095480000000_RK &
125 : , 6.07550490000000_RK &
126 : , 7.32100850000000_RK &
127 : , 5.82501650000000_RK &
128 : , 4.19347540000000_RK &
129 : , 4.89687790000000_RK &
130 : , 5.61290890000000_RK &
131 : , 5.70994940000000_RK &
132 : , 5.00047920000000_RK &
133 : , 5.47741520000000_RK &
134 : , 4.99151560000000_RK &
135 : , 5.08172850000000_RK &
136 : , 5.98773500000000_RK &
137 : , 6.97849360000000_RK &
138 : , 6.91612860000000_RK &
139 : , 4.90595890000000_RK &
140 : , 5.71852950000000_RK &
141 : , 4.12146660000000_RK &
142 : , 5.51241440000000_RK &
143 : , 5.26293780000000_RK &
144 : , 5.14932990000000_RK &
145 : , 4.14738170000000_RK &
146 : , 5.55786790000000_RK &
147 : , 7.08800450000000_RK &
148 : , 6.08987380000000_RK &
149 : , 4.73697940000000_RK &
150 : , 3.80934450000000_RK &
151 : , 6.03942270000000_RK &
152 : , 5.96600840000000_RK &
153 : , 6.06674510000000_RK &
154 : , 5.84361600000000_RK &
155 : , 6.19013970000000_RK &
156 : , 4.43891700000000_RK &
157 : , 4.45833300000000_RK &
158 : , 5.47659170000000_RK &
159 : , 4.65761920000000_RK ]
160 :
161 : integer(IK) , parameter :: DataUnsorted2_IK(ndata) = DataUnsorted_IK
162 : real(RK) , parameter :: DataUnsorted2_RK(ndata) = DataUnsorted_RK
163 :
164 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
165 :
166 : contains
167 :
168 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
169 :
170 1 : subroutine test_Sort()
171 : implicit none
172 1 : Test = Test_type(moduleName=MODULE_NAME)
173 1 : call Test%run(test_sortArray_1, "test_sortArray_1")
174 1 : call Test%run(test_getMedian_RK_1, "test_getMedian_RK_1")
175 1 : call Test%run(test_getMedian_RK_2, "test_getMedian_RK_2")
176 1 : call Test%run(test_sortAscending_RK_1, "test_sortAscending_RK_1")
177 1 : call Test%run(test_sortAscendingWithRooter_IK_1, "test_sortAscendingWithRooter_IK_1")
178 1 : call Test%run(test_sortAscendingWithRooter_RK_1, "test_sortAscendingWithRooter_RK_1")
179 1 : call Test%finalize()
180 1 : end subroutine test_Sort
181 :
182 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
183 :
184 1 : function test_sortArray_1() result(assertion)
185 :
186 : implicit none
187 :
188 : integer(IK) :: i
189 : logical :: assertion
190 : real(RK), allocatable :: DataUnsorted(:)
191 :
192 1 : assertion = .true.
193 :
194 51 : DataUnsorted = DataUnsorted_RK
195 1 : call sortArray(DataUnsorted)
196 :
197 50 : do i = 2, ndata
198 50 : assertion = assertion .and. DataUnsorted(i-1) <= DataUnsorted(i)
199 : end do
200 :
201 : ! LCOV_EXCL_START
202 : if (Test%isDebugMode .and. .not. assertion) then
203 : write(Test%outputUnit,"(*(g0,:,', '))")
204 : write(Test%outputUnit,"(*(g0,:,', '))") "DataUnsorted, DataSorted"
205 : do i = 1, ndata
206 : write(Test%outputUnit,"(*(g0,:,', '))") DataUnsorted_RK(i), DataUnsorted(i)
207 : end do
208 : write(Test%outputUnit,"(*(g0,:,', '))")
209 : end if
210 : ! LCOV_EXCL_STOP
211 :
212 2 : end function test_sortArray_1
213 :
214 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
215 :
216 1 : function test_sortAscending_RK_1() result(assertion)
217 :
218 1 : use Err_mod, only: Err_type
219 : implicit none
220 :
221 : integer(IK) :: i
222 : logical :: assertion
223 : real(RK) , allocatable :: DataUnsorted(:)
224 1 : type(Err_type) :: Err
225 :
226 51 : DataUnsorted = DataUnsorted_RK
227 1 : call sortAscending(np = ndata, Point = DataUnsorted, Err = Err)
228 1 : assertion = .not. Err%occurred
229 1 : if (.not. assertion) return
230 :
231 50 : do i = 2, ndata
232 50 : assertion = assertion .and. DataUnsorted(i-1) <= DataUnsorted(i)
233 : end do
234 :
235 : ! LCOV_EXCL_START
236 : if (Test%isDebugMode .and. .not. assertion) then
237 : write(Test%outputUnit,"(*(g0,:,', '))")
238 : write(Test%outputUnit,"(*(g0,:,', '))") "DataUnsorted, DataSorted"
239 : do i = 1, ndata
240 : write(Test%outputUnit,"(*(g0,:,', '))") DataUnsorted_RK(i), DataUnsorted(i)
241 : end do
242 : write(Test%outputUnit,"(*(g0,:,', '))")
243 : end if
244 : ! LCOV_EXCL_STOP
245 :
246 1 : end function test_sortAscending_RK_1
247 :
248 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
249 :
250 1 : function test_sortAscendingWithRooter_IK_1() result(assertion)
251 :
252 1 : use Err_mod, only: Err_type
253 : implicit none
254 :
255 : integer(IK) :: i
256 : logical :: assertion
257 : integer(IK) , allocatable :: DataUnsorted(:)
258 : integer(IK) , allocatable :: DataUnsorted2(:)
259 1 : type(Err_type) :: Err
260 :
261 51 : DataUnsorted = DataUnsorted_IK
262 51 : DataUnsorted2 = DataUnsorted2_IK
263 1 : call sortAscendingWithRooter_IK(lenLeader = ndata, Leader = DataUnsorted, Rooter = DataUnsorted2, Err = Err)
264 1 : assertion = .not. Err%occurred
265 1 : if (.not. assertion) return
266 :
267 50 : do i = 2, ndata
268 50 : assertion = assertion .and. DataUnsorted(i-1) <= DataUnsorted(i)
269 : end do
270 :
271 : ! LCOV_EXCL_START
272 : if (Test%isDebugMode .and. .not. assertion) then
273 : write(Test%outputUnit,"(*(g0,:,', '))")
274 : write(Test%outputUnit,"(*(g0,:,', '))") "LeaderUnsorted, LeaderSorted"
275 : do i = 1, ndata
276 : write(Test%outputUnit,"(*(g0,:,', '))") DataUnsorted_IK(i), DataUnsorted(i)
277 : end do
278 : write(Test%outputUnit,"(*(g0,:,', '))")
279 : end if
280 : ! LCOV_EXCL_STOP
281 :
282 50 : do i = 2, ndata
283 50 : assertion = assertion .and. DataUnsorted2(i-1) <= DataUnsorted2(i)
284 : end do
285 :
286 : ! LCOV_EXCL_START
287 : if (Test%isDebugMode .and. .not. assertion) then
288 : write(Test%outputUnit,"(*(g0,:,', '))")
289 : write(Test%outputUnit,"(*(g0,:,', '))") "RooterUnsorted, RooterSorted"
290 : do i = 1, ndata
291 : write(Test%outputUnit,"(*(g0,:,', '))") DataUnsorted2_IK(i), DataUnsorted2(i)
292 : end do
293 : write(Test%outputUnit,"(*(g0,:,', '))")
294 : end if
295 : ! LCOV_EXCL_STOP
296 :
297 1 : end function test_sortAscendingWithRooter_IK_1
298 :
299 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
300 :
301 1 : function test_sortAscendingWithRooter_RK_1() result(assertion)
302 :
303 1 : use Err_mod, only: Err_type
304 : implicit none
305 :
306 : integer(IK) :: i
307 : logical :: assertion
308 : real(RK) , allocatable :: DataUnsorted(:)
309 : real(RK) , allocatable :: DataUnsorted2(:)
310 1 : type(Err_type) :: Err
311 :
312 51 : DataUnsorted = DataUnsorted_RK
313 51 : DataUnsorted2 = DataUnsorted2_RK
314 1 : call sortAscendingWithRooter_RK(lenLeader = ndata, Leader = DataUnsorted, Rooter = DataUnsorted2, Err = Err)
315 1 : assertion = .not. Err%occurred
316 1 : if (.not. assertion) return
317 :
318 50 : do i = 2, ndata
319 50 : assertion = assertion .and. DataUnsorted(i-1) <= DataUnsorted(i)
320 : end do
321 :
322 : ! LCOV_EXCL_START
323 : if (Test%isDebugMode .and. .not. assertion) then
324 : write(Test%outputUnit,"(*(g0,:,', '))")
325 : write(Test%outputUnit,"(*(g0,:,', '))") "LeaderUnsorted, LeaderSorted"
326 : do i = 1, ndata
327 : write(Test%outputUnit,"(*(g0,:,', '))") DataUnsorted_RK(i), DataUnsorted(i)
328 : end do
329 : write(Test%outputUnit,"(*(g0,:,', '))")
330 : end if
331 : ! LCOV_EXCL_STOP
332 :
333 50 : do i = 2, ndata
334 50 : assertion = assertion .and. DataUnsorted2(i-1) <= DataUnsorted2(i)
335 : end do
336 :
337 : ! LCOV_EXCL_START
338 : if (Test%isDebugMode .and. .not. assertion) then
339 : write(Test%outputUnit,"(*(g0,:,', '))")
340 : write(Test%outputUnit,"(*(g0,:,', '))") "RooterUnsorted, RooterSorted"
341 : do i = 1, ndata
342 : write(Test%outputUnit,"(*(g0,:,', '))") DataUnsorted2_RK(i), DataUnsorted2(i)
343 : end do
344 : write(Test%outputUnit,"(*(g0,:,', '))")
345 : end if
346 : ! LCOV_EXCL_STOP
347 :
348 1 : end function test_sortAscendingWithRooter_RK_1
349 :
350 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
351 :
352 1 : function test_getMedian_RK_1() result(assertion)
353 :
354 1 : use Err_mod, only: Err_type
355 : implicit none
356 :
357 : logical :: assertion
358 : real(RK) , parameter :: median_ref = 5.477003450000000_RK
359 1 : real(RK) :: median
360 1 : type(Err_type) :: Err
361 :
362 1 : call getMedian(lenArray = ndata, Array = DataUnsorted_RK, median = median, Err = Err)
363 1 : assertion = .not. Err%occurred
364 1 : if (.not. assertion) return
365 :
366 1 : assertion = median == median_ref
367 :
368 : ! LCOV_EXCL_START
369 : if (Test%isDebugMode .and. .not. assertion) then
370 : write(Test%outputUnit,"(*(g0,:,' '))")
371 : write(Test%outputUnit,"(*(g0,:,' '))") "median_ref =", median_ref
372 : write(Test%outputUnit,"(*(g0,:,' '))") "median =", median
373 : write(Test%outputUnit,"(*(g0,:,' '))")
374 : end if
375 : ! LCOV_EXCL_STOP
376 :
377 1 : end function test_getMedian_RK_1
378 :
379 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
380 :
381 1 : function test_getMedian_RK_2() result(assertion)
382 :
383 1 : use Err_mod, only: Err_type
384 : implicit none
385 :
386 : logical :: assertion
387 : real(RK) , parameter :: median_ref = 5.477415200000000_RK
388 1 : real(RK) :: median
389 1 : type(Err_type) :: Err
390 :
391 1 : call getMedian_RK(lenArray = ndata-1, Array = DataUnsorted_RK(1:ndata-1), median = median, Err = Err)
392 1 : assertion = .not. Err%occurred
393 1 : if (.not. assertion) return
394 :
395 1 : assertion = median == median_ref
396 :
397 : ! LCOV_EXCL_START
398 : if (Test%isDebugMode .and. .not. assertion) then
399 : write(Test%outputUnit,"(*(g0,:,' '))")
400 : write(Test%outputUnit,"(*(g0,:,' '))") "median_ref =", median_ref
401 : write(Test%outputUnit,"(*(g0,:,' '))") "median =", median
402 : write(Test%outputUnit,"(*(g0,:,' '))")
403 : end if
404 : ! LCOV_EXCL_STOP
405 :
406 1 : end function test_getMedian_RK_2
407 :
408 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
409 :
410 : end module Test_Sort_mod
|
