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 module contains implementations of the procedures of [test_pm_arrayInit](@ref test_pm_arrayInit).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \FatemehBagheri, Wednesday 12:20 AM, October 13, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : ! Define the `logical` operators.
28 : #if LK_ENABLED
29 : #define IS_EQUAL .eqv.
30 : #else
31 : #define IS_EQUAL ==
32 : #endif
33 : ! Define the indexing rules.
34 : #if D0_ENABLED
35 : #define ALL
36 : #elif D1_ENABLED
37 : #define SET_ADIM(X) X(:)
38 : #elif D2_ENABLED
39 : #define SET_ADIM(X) X(:,:)
40 : #elif D3_ENABLED
41 : #define SET_ADIM(X) X(:,:,:)
42 : #else
43 : #error "Unrecognized interface."
44 : #endif
45 : ! Set the dimension of `Core`.
46 : #if Arr_ENABLED
47 : #define SET_CDIM(X) SET_ADIM(X)
48 : #elif Sca_ENABLED
49 : #define SET_CDIM(X) X
50 : #else
51 : #error "Unrecognized interface."
52 : #endif
53 : integer :: itest
54 : ! Declare objects.
55 : #if D0_ENABLED
56 : character(1,SKC) :: halo
57 3 : character(:,SKC), allocatable :: Array, array_ref, Core
58 : #else
59 : #if SK_ENABLED
60 : character(2,SKC) :: halo
61 : character(2,SKC), allocatable :: &
62 : #elif IK_ENABLED
63 : integer(IKC) :: halo
64 : integer(IKC) , allocatable :: &
65 : #elif LK_ENABLED
66 : logical(LKC) :: halo
67 : logical(LKC) , allocatable :: &
68 : #elif CK_ENABLED
69 : complex(CKC) :: halo
70 : complex(CKC) , allocatable :: &
71 : #elif RK_ENABLED
72 : real(RKC) :: halo
73 : real(RKC) , allocatable :: &
74 : #else
75 : #error "Unrecognized interface."
76 : #endif
77 57 : SET_ADIM(Array), SET_ADIM(array_ref), SET_CDIM(Core)
78 : #endif
79 : ! Define indexing objects.
80 : #if D0_ENABLED || D1_ENABLED
81 : integer(IK) :: Asize, Coffset, Csize
82 : #else
83 : integer(IK) :: Asize(rank(Array)), Coffset(rank(Array)), Csize(rank(Array))
84 : #endif
85 174 : assertion = .true._LK
86 17634 : do itest = 1, 100
87 :
88 17400 : if (allocated(Core)) deallocate(Core)
89 17400 : if (allocated(Array)) deallocate(Array)
90 17400 : if (allocated(array_ref)) deallocate(array_ref)
91 :
92 17400 : call setUnifRand(halo)
93 45900 : call setUnifRand(Asize, 0_IK, int(50. / max(1,rank(Array))))
94 45900 : call setUnifRand(Csize, 0_IK, Asize)
95 : ! Allocate `Array`.
96 : #if D0_ENABLED
97 300 : allocate(character(Asize,SKC) :: array_ref, Array)
98 7701 : array_ref(:) = repeat(halo, Asize)
99 : #elif D1_ENABLED
100 291113 : allocate(array_ref(Asize), Array(Asize), source = halo)
101 : #elif D2_ENABLED
102 1965268 : allocate(array_ref(Asize(1), Asize(2)), Array(Asize(1), Asize(2)), source = halo)
103 : #elif D3_ENABLED
104 6641214 : allocate(array_ref(Asize(1), Asize(2), Asize(3)), Array(Asize(1), Asize(2), Asize(3)), source = halo)
105 : #else
106 : #error "Unrecognized interface."
107 : #endif
108 : ! Allocate `Core`.
109 : #if Arr_ENABLED && D0_ENABLED
110 200 : allocate(character(Csize,SKC) :: Core)
111 : #elif Arr_ENABLED && D1_ENABLED
112 4164 : allocate(Core(Csize))
113 : #elif Arr_ENABLED && D2_ENABLED
114 6296 : allocate(Core(Csize(1), Csize(2)))
115 : #elif Arr_ENABLED && D3_ENABLED
116 9793 : allocate(Core(Csize(1), Csize(2), Csize(3)))
117 : #else
118 5800 : allocate(Core, source = halo)
119 : #endif
120 560648 : call setUnifRand(Core)
121 45900 : call setUnifRand(Coffset, 0_IK, Asize - Csize)
122 : #if getCoreHalo_ENABLED && Arr_ENABLED
123 1477717 : Array = getCoreHalo(Asize, Core, halo, Coffset)
124 : #elif setCoreHalo_ENABLED && Arr_ENABLED
125 5800 : call setCoreHalo(Array, Core, halo, Coffset)
126 : #elif getCoreHalo_ENABLED && Sca_ENABLED
127 : Array = getCoreHalo(Asize, Core, halo, Coffset, Csize)
128 : #elif setCoreHalo_ENABLED && Sca_ENABLED
129 5800 : call setCoreHalo(Array, Core, halo, Coffset, Csize)
130 : #else
131 : #error "Unrecognized interface."
132 : #endif
133 15500 : call setCoreHalo_ref()
134 17400 : call report()
135 :
136 17400 : if (allocated(Core)) deallocate(Core)
137 17400 : if (allocated(Array)) deallocate(Array)
138 17400 : if (allocated(array_ref)) deallocate(array_ref)
139 :
140 17400 : call setUnifRand(halo)
141 45900 : call setUnifRand(Asize, 0_IK, int(50. / max(1,rank(Array))))
142 45900 : call setUnifRand(Csize, 0_IK, Asize)
143 : ! Allocate `Array`.
144 : #if D0_ENABLED
145 300 : allocate(character(Asize,SKC) :: array_ref, Array)
146 7787 : array_ref(:) = repeat(halo, Asize)
147 : #elif D1_ENABLED
148 293159 : allocate(array_ref(Asize), Array(Asize), source = halo)
149 : #elif D2_ENABLED
150 1959724 : allocate(array_ref(Asize(1), Asize(2)), Array(Asize(1), Asize(2)), source = halo)
151 : #elif D3_ENABLED
152 6739625 : allocate(array_ref(Asize(1), Asize(2), Asize(3)), Array(Asize(1), Asize(2), Asize(3)), source = halo)
153 : #else
154 : #error "Unrecognized interface."
155 : #endif
156 : ! Allocate `Core`.
157 : #if Arr_ENABLED && D0_ENABLED
158 200 : allocate(character(Csize,SKC) :: Core)
159 : #elif Arr_ENABLED && D1_ENABLED
160 4156 : allocate(Core(Csize))
161 : #elif Arr_ENABLED && D2_ENABLED
162 6300 : allocate(Core(Csize(1), Csize(2)))
163 : #elif Arr_ENABLED && D3_ENABLED
164 9854 : allocate(Core(Csize(1), Csize(2), Csize(3)))
165 : #else
166 5800 : allocate(Core, source = halo)
167 : #endif
168 584120 : call setUnifRand(Core)
169 45900 : call setUnifRand(Coffset, 0_IK, Asize - Csize)
170 : #if getCoreHalo_ENABLED && Arr_ENABLED
171 1518972 : Array = getCoreHalo(Asize, Core, halo, Coffset)
172 : #elif setCoreHalo_ENABLED && Arr_ENABLED
173 5800 : call setCoreHalo(Array, Core, halo, Coffset)
174 : #elif getCoreHalo_ENABLED && Sca_ENABLED
175 : Array = getCoreHalo(Asize, Core, halo, Coffset, Csize)
176 : #elif setCoreHalo_ENABLED && Sca_ENABLED
177 5800 : call setCoreHalo(Array, Core, halo, Coffset, Csize)
178 : #else
179 : #error "Unrecognized interface."
180 : #endif
181 15500 : call setCoreHalo_ref()
182 17574 : call report()
183 :
184 : end do
185 :
186 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
187 :
188 : contains
189 :
190 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
191 :
192 31000 : subroutine setCoreHalo_ref()
193 : #if D0_ENABLED
194 600 : if (len(Core) == 1) then
195 2816 : array_ref(coffset + 1 : coffset + csize) = repeat(Core, csize)
196 : else
197 372 : array_ref(coffset + 1 : coffset + csize) = Core
198 : end if
199 : #elif D1_ENABLED
200 154534 : array_ref(coffset + 1_IK : coffset + csize) = Core
201 : #elif D2_ENABLED
202 537002 : array_ref(Coffset(1) + 1_IK : Coffset(1) + Csize(1), Coffset(2) + 1_IK : Coffset(2) + Csize(2)) = Core
203 : #elif D3_ENABLED
204 988823 : array_ref(Coffset(1) + 1_IK : Coffset(1) + Csize(1), Coffset(2) + 1_IK : Coffset(2) + Csize(2), Coffset(3) + 1_IK : Coffset(3) + Csize(3)) = Core
205 : #else
206 : #error "Unrecognized interface."
207 : #endif
208 31000 : end subroutine
209 :
210 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
211 :
212 34800 : subroutine report()
213 8935365 : assertion = assertion .and. logical(ALL(Array IS_EQUAL array_ref), LK)
214 34800 : if (test%traceable .and. .not. assertion) then
215 : ! LCOV_EXCL_START
216 : call test%disp%skip()
217 : call test%disp%show("Coffset")
218 : call test%disp%show( Coffset )
219 : call test%disp%show("Csize")
220 : call test%disp%show( Csize )
221 : call test%disp%show("halo")
222 : call test%disp%show( halo )
223 : call test%disp%show("Core")
224 : call test%disp%show( Core )
225 : call test%disp%show("Array")
226 : call test%disp%show( Array )
227 : call test%disp%show("array_ref")
228 : call test%disp%show( array_ref )
229 : call test%disp%skip()
230 : ! LCOV_EXCL_STOP
231 : end if
232 34800 : call test%assert(assertion, SK_"The output `array` must be constructed correctly.", int(__LINE__, IK))
233 34800 : end subroutine
234 :
235 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
236 :
237 : #undef SET_ADIM
238 : #undef SET_CDIM
239 : #undef IS_EQUAL
240 : #undef ALL
|
