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 file contains procedure implementations of [test_pm_arrayShuffle](@ref test_pm_arrayShuffle).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : #if LK_ENABLED
28 : #define IS_NOT_EQUAL .neqv.
29 : #else
30 : #define IS_NOT_EQUAL /=
31 : #endif
32 :
33 : #if SK_ENABLED && D0_ENABLED
34 : #define GET_SIZE len
35 : #else
36 : #define GET_SIZE size
37 : #endif
38 : character(*, SK), parameter :: PROCEDURE_NAME = "@setShuffled()"
39 : #if SK_ENABLED && D0_ENABLED
40 : #define ANY
41 2 : character(:,SKC), allocatable :: Array, arrayNew
42 : #elif SK_ENABLED && D1_ENABLED
43 : character(2,SKC), dimension(:), allocatable :: Array, arrayNew
44 : #elif IK_ENABLED && D1_ENABLED
45 : integer(IKC) , dimension(:), allocatable :: Array, arrayNew
46 : #elif LK_ENABLED && D1_ENABLED
47 : logical(LKC) , dimension(:), allocatable :: Array, arrayNew
48 : #elif CK_ENABLED && D1_ENABLED
49 : complex(CKC) , dimension(:), allocatable :: Array, arrayNew
50 : #elif RK_ENABLED && D1_ENABLED
51 : real(RKC) , dimension(:), allocatable :: Array, arrayNew
52 : #else
53 : #error "Unrecognized interface."
54 : #endif
55 : integer(IK) :: count
56 :
57 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
58 :
59 40 : assertion = .true._LK
60 40 : call runTests(count)
61 40 : call runTests()
62 :
63 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64 :
65 : contains
66 :
67 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
68 :
69 80 : subroutine runTests(count)
70 : integer(IK), intent(inout), optional :: count
71 :
72 : if (allocated(Array)) deallocate(Array) ! LCOV_EXCL_LINE
73 :
74 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
75 :
76 : #if SK_ENABLED && D0_ENABLED
77 4 : Array = ""
78 : #elif SK_ENABLED && D1_ENABLED
79 4 : allocate(character(2,SKC) :: Array(0))
80 : #elif IK_ENABLED && D1_ENABLED
81 20 : allocate(Array(0))
82 : #elif CK_ENABLED && D1_ENABLED
83 16 : allocate(Array(0))
84 : #elif RK_ENABLED && D1_ENABLED
85 16 : allocate(Array(0))
86 : #elif LK_ENABLED && D1_ENABLED
87 20 : allocate(Array(0))
88 : #endif
89 80 : if (present(count)) count = 0_IK
90 80 : call report(count)
91 80 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array has a shuffled array of length zero.", int(__LINE__, IK))
92 :
93 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
94 :
95 : #if SK_ENABLED && D0_ENABLED
96 4 : Array = " "
97 : #elif SK_ENABLED && D1_ENABLED
98 12 : Array = [" "]
99 : #elif IK_ENABLED && D1_ENABLED
100 60 : Array = [1_IKC]
101 : #elif CK_ENABLED && D1_ENABLED
102 48 : Array = [(+1._CKC, -1._CKC)]
103 : #elif RK_ENABLED && D1_ENABLED
104 48 : Array = [1._RKC]
105 : #elif LK_ENABLED && D1_ENABLED
106 60 : Array = [.true._LKC]
107 : #endif
108 80 : if (present(count)) call setUnifRand(count, 0_IK, GET_SIZE(Array, kind = IK))
109 80 : call report(count)
110 80 : call test%assert(assertion, PROCEDURE_NAME//SK_": An array of length 1 has a shuffled array of length 1.", int(__LINE__, IK))
111 :
112 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
113 :
114 : #if SK_ENABLED && D0_ENABLED
115 4 : Array = "ABCDEFGHIJK "
116 : #elif SK_ENABLED && D1_ENABLED
117 56 : Array = ["AA", "BB", "CC", "DD", "EE", "FF", "GG", "HH", "II", "JJ", "KK", " "]
118 : #elif IK_ENABLED && D1_ENABLED
119 220 : Array = [1_IKC, 2_IKC, 3_IKC, 4_IKC, 5_IKC, 6_IKC, 7_IKC, 8_IKC, 9_IKC]
120 : #elif CK_ENABLED && D1_ENABLED
121 176 : Array = [(+1._CKC, -1._CKC), (+2._CKC, -2._CKC), (+3._CKC, -3._CKC), (+4._CKC, -4._CKC), (+5._CKC, -5._CKC), (+6._CKC, -6._CKC), (+7._CKC, -7._CKC), (+8._CKC, -8._CKC), (+9._CKC, -9._CKC)]
122 : #elif RK_ENABLED && D1_ENABLED
123 176 : Array = [1._RKC, 2._RKC, 3._RKC, 4._RKC, 5._RKC, 6._RKC, 7._RKC, 8._RKC, 9._RKC]
124 : #elif LK_ENABLED && D1_ENABLED
125 280 : Array = [.false._LKC, .true._LKC, .false._LKC, .true._LKC, .false._LKC, .true._LKC, .false._LKC, .true._LKC, .false._LKC, .true._LKC, .false._LKC, .true._LKC]
126 : #endif
127 80 : if (present(count)) call setUnifRand(count, 0_IK, GET_SIZE(Array, kind = IK))
128 80 : call report(count)
129 80 : call test%assert(assertion, PROCEDURE_NAME//SK_": An array of arbitrary length must be shuffled properly.", int(__LINE__, IK))
130 :
131 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
132 :
133 80 : end subroutine
134 :
135 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
136 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
137 :
138 240 : subroutine report(count)
139 : integer(IK), intent(in), optional :: count
140 : integer(IK) :: itry, count_def
141 : #if getShuffled_ENABLED
142 120 : itry = 0
143 551 : arrayNew = getShuffled(Array, count)
144 : #elif setShuffled_ENABLED
145 : type(xoshiro256ssw_type) :: rngx
146 120 : rngx = xoshiro256ssw_type()
147 480 : do itry = 1, 3
148 2026 : arrayNew = Array
149 360 : if (itry == 1) then
150 120 : call setShuffled(arrayNew, count)
151 240 : elseif (itry == 2) then
152 120 : call setShuffled(rngf_type(), arrayNew, count)
153 120 : elseif (itry == 3) then
154 120 : call setShuffled(rngx, arrayNew, count)
155 : end if
156 : #else
157 : #error "Unrecognized interface."
158 : #endif
159 480 : count_def = getOption(GET_SIZE(Array, kind = IK), count)
160 480 : assertion = assertion .and. (GET_SIZE(arrayNew) <= 1_IK .or. (arrayNew(1:count_def) .allin. Array))
161 600 : if (test%traceable .and. .not. assertion) then
162 : ! LCOV_EXCL_START
163 : write(test%disp%unit,"(*(g0,:,', '))")
164 : write(test%disp%unit,"(*(g0,:,', '))") "itry ", itry
165 : write(test%disp%unit,"(*(g0,:,', '))") "Array ", Array
166 : write(test%disp%unit,"(*(g0,:,', '))") "arrayNew ", arrayNew
167 : write(test%disp%unit,"(*(g0,:,', '))")
168 : ! LCOV_EXCL_STOP
169 : end if
170 : #if setShuffled_ENABLED
171 : end do
172 : #endif
173 720 : end subroutine
174 :
175 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
176 :
177 : #undef IS_NOT_EQUAL
178 : #undef GET_SIZE
179 : #undef ANY
|
