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 tests of the procedures under the generic interface
19 : !> [setSplit](@ref pm_arraySplit::setSplit).
20 : !>
21 : !> \fintest
22 : !>
23 : !> \author
24 : !> \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
25 :
26 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
27 :
28 : #if LK_ENABLED
29 : #define IS_EQUAL .eqv.
30 : #else
31 : #define IS_EQUAL ==
32 : #endif
33 : character(*, SK), parameter :: PROCEDURE_NAME = "@setSplit()"
34 : #if SK_ENABLED && D1_D0_ENABLED
35 : #if CVXK_ENABLED
36 1 : type(cvs_type), allocatable :: field(:), field_ref(:)
37 : #elif PVXK_ENABLED
38 : type(cvs_pdt(SKC)), allocatable :: field(:), field_ref(:)
39 : #endif
40 : character(2,SKC), allocatable :: array(:)
41 : character(2,SKC) :: sep
42 : #elif IK_ENABLED && D1_D0_ENABLED
43 : #if CVXK_ENABLED
44 1 : type(cvi_type), allocatable :: field(:), field_ref(:)
45 : #elif PVXK_ENABLED
46 : type(cvi_pdt(IKC)), allocatable :: field(:), field_ref(:)
47 : #endif
48 : integer(IKC), allocatable :: array(:)
49 : integer(IKC) :: sep
50 : #elif LK_ENABLED && D1_D0_ENABLED
51 : #if CVXK_ENABLED
52 1 : type(cvl_type), allocatable :: field(:), field_ref(:)
53 : #elif PVXK_ENABLED
54 : type(cvl_pdt(LKC)), allocatable :: field(:), field_ref(:)
55 : #endif
56 : logical(LKC), allocatable :: array(:)
57 : logical(LKC) :: sep
58 : #elif CK_ENABLED && D1_D0_ENABLED
59 : #if CVXK_ENABLED
60 1 : type(cvc_type), allocatable :: field(:), field_ref(:)
61 : #elif PVXK_ENABLED
62 : type(cvc_pdt(CKC)), allocatable :: field(:), field_ref(:)
63 : #endif
64 : complex(CKC), allocatable :: array(:)
65 : complex(CKC) :: sep
66 : #elif RK_ENABLED && D1_D0_ENABLED
67 : #if CVXK_ENABLED
68 1 : type(cvr_type), allocatable :: field(:), field_ref(:)
69 : #elif PVXK_ENABLED
70 : type(cvr_pdt(RKC)), allocatable :: field(:), field_ref(:)
71 : #endif
72 : real(RKC), allocatable :: array(:)
73 : real(RKC) :: sep
74 : #else
75 : #error "Unrecognized interface."
76 : #endif
77 : integer(IK), allocatable :: sindex(:,:), sindex_ref(:,:)
78 : integer(IK), allocatable :: instance(:)
79 : integer(IK) :: i
80 :
81 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
82 :
83 24 : assertion = .true._LK
84 87 : do i = 1, 2 ! repeat for sindex splitting.
85 48 : call runTestsWith()
86 48 : call runTestsWith(iseq = iseq)
87 48 : call runTestsWith(keep = .true._LK)
88 48 : call runTestsWith(keep = .false._LK)
89 48 : call runTestsWith(iseq = iseq, keep = .true._LK)
90 72 : call runTestsWith(iseq = iseq, keep = .false._LK)
91 : end do
92 :
93 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
94 :
95 : contains
96 :
97 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
98 :
99 45240 : function iseq(segment, sep) result(equivalent)
100 : logical(LK) :: equivalent
101 : #if SK_ENABLED && D1_D0_ENABLED
102 : character(*,SKC), intent(in) :: sep, segment
103 : #elif IK_ENABLED && D1_D0_ENABLED
104 : integer(IKC) , intent(in) :: sep, segment
105 : #elif LK_ENABLED && D1_D0_ENABLED
106 : logical(LKC) , intent(in) :: sep, segment
107 : #elif CK_ENABLED && D1_D0_ENABLED
108 : complex(CKC) , intent(in) :: sep, segment
109 : #elif RK_ENABLED && D1_D0_ENABLED
110 : real(RKC) , intent(in) :: sep, segment
111 : #endif
112 45240 : equivalent = sep IS_EQUAL segment
113 45240 : end function
114 :
115 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
116 :
117 4608 : subroutine reset()
118 4608 : if (allocated(array)) deallocate(array)
119 4608 : if (allocated(sindex)) deallocate(sindex)
120 4608 : if (allocated(instance)) deallocate(instance)
121 4608 : if (allocated(sindex_ref)) deallocate(sindex_ref)
122 : #if CVXK_ENABLED || PVXK_ENABLED
123 3355 : if (allocated(field_ref)) deallocate(field_ref) ! \bug gfortran 11 will not even compile this line.
124 3355 : if (allocated(field)) deallocate(field) ! \bug gfortran 11 will not even compile this line.
125 : #endif
126 4608 : end subroutine reset
127 :
128 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
129 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
130 :
131 288 : subroutine runTestsWith(iseq, keep)
132 : logical(LK) , intent(in), optional :: keep
133 : logical(LK) , external , optional :: iseq
134 :
135 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
136 :
137 288 : call reset()
138 :
139 : #if SK_ENABLED && D1_D0_ENABLED
140 24 : sep = " "
141 : #elif IK_ENABLED && D1_D0_ENABLED
142 72 : sep = 1_IKC
143 : #elif LK_ENABLED && D1_D0_ENABLED
144 72 : sep = .false._LK
145 : #elif CK_ENABLED && D1_D0_ENABLED
146 60 : sep = 1._CKC
147 : #elif RK_ENABLED && D1_D0_ENABLED
148 60 : sep = 1._RKC
149 : #endif
150 288 : allocate(instance(0))
151 288 : allocate(array(0))
152 : #if CVXK_ENABLED || PVXK_ENABLED
153 132 : allocate(field_ref(1))
154 120 : field_ref(1)%val = array
155 : #endif
156 288 : allocate(sindex_ref(2,1))
157 288 : sindex_ref(1,1) = 1
158 288 : sindex_ref(2,1) = 0
159 :
160 288 : call report(iseq, keep)
161 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array.", int(__LINE__, IK))
162 :
163 288 : call report(iseq, keep, instance = instance)
164 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance`.", int(__LINE__, IK))
165 :
166 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
167 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance` with `sorted = .true.`.", int(__LINE__, IK))
168 :
169 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
170 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance` with `sorted = .false.`.", int(__LINE__, IK))
171 :
172 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
173 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance` with `unique = .true.`.", int(__LINE__, IK))
174 :
175 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
176 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance` with `unique = .false.`.", int(__LINE__, IK))
177 :
178 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
179 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance` with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
180 :
181 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .true._LK)
182 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance` with `sorted = .false._LK, unique = .true.`.", int(__LINE__, IK))
183 :
184 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
185 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance` with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
186 :
187 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
188 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": An empty array, has empty resulting array with `instance` with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
189 :
190 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
191 :
192 288 : call reset()
193 :
194 : #if CVXK_ENABLED || PVXK_ENABLED
195 60 : if (getOption(.false._LK, keep)) then
196 120 : allocate(field_ref(5))
197 : else
198 160 : allocate(field_ref(3))
199 : end if
200 : #endif
201 : #if SK_ENABLED && D1_D0_ENABLED
202 96 : array = ["AA", "AA"]
203 24 : sep = "AA"
204 : #if CVXK_ENABLED || PVXK_ENABLED
205 12 : if (getOption(.false._LK, keep)) then
206 4 : field_ref(1)%val = [character(2) ::]
207 12 : field_ref(2)%val = [sep]
208 4 : field_ref(3)%val = [character(2) ::]
209 12 : field_ref(4)%val = [sep]
210 4 : field_ref(5)%val = [character(2) ::]
211 : else
212 8 : field_ref(1)%val = [character(2) ::]
213 8 : field_ref(2)%val = [character(2) ::]
214 8 : field_ref(3)%val = [character(2) ::]
215 : end if
216 : #endif
217 : #elif IK_ENABLED && D1_D0_ENABLED
218 288 : array = [1_IKC, 1_IKC]
219 72 : sep = 1_IKC
220 : #if CVXK_ENABLED || PVXK_ENABLED
221 12 : if (getOption(.false._LK, keep)) then
222 4 : field_ref(1)%val = [integer(IKC) ::]
223 12 : field_ref(2)%val = [sep]
224 4 : field_ref(3)%val = [integer(IKC) ::]
225 12 : field_ref(4)%val = [sep]
226 4 : field_ref(5)%val = [integer(IKC) ::]
227 : else
228 8 : field_ref(1)%val = [integer(IKC) ::]
229 8 : field_ref(2)%val = [integer(IKC) ::]
230 8 : field_ref(3)%val = [integer(IKC) ::]
231 : end if
232 : #endif
233 : #elif LK_ENABLED && D1_D0_ENABLED
234 288 : array = [.false._LK, .false._LK]
235 72 : sep = .false._LK
236 : #if CVXK_ENABLED || PVXK_ENABLED
237 12 : if (getOption(.false._LK, keep)) then
238 4 : field_ref(1)%val = [logical(LKC) ::]
239 12 : field_ref(2)%val = [sep]
240 4 : field_ref(3)%val = [logical(LKC) ::]
241 12 : field_ref(4)%val = [sep]
242 4 : field_ref(5)%val = [logical(LKC) ::]
243 : else
244 8 : field_ref(1)%val = [logical(LKC) ::]
245 8 : field_ref(2)%val = [logical(LKC) ::]
246 8 : field_ref(3)%val = [logical(LKC) ::]
247 : end if
248 : #endif
249 : #elif CK_ENABLED && D1_D0_ENABLED
250 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
251 60 : sep = (1._CKC,-1._CKC)
252 : #if CVXK_ENABLED || PVXK_ENABLED
253 12 : if (getOption(.false._LK, keep)) then
254 4 : field_ref(1)%val = [complex(CKC) ::]
255 12 : field_ref(2)%val = [sep]
256 4 : field_ref(3)%val = [complex(CKC) ::]
257 12 : field_ref(4)%val = [sep]
258 4 : field_ref(5)%val = [complex(CKC) ::]
259 : else
260 8 : field_ref(1)%val = [complex(CKC) ::]
261 8 : field_ref(2)%val = [complex(CKC) ::]
262 8 : field_ref(3)%val = [complex(CKC) ::]
263 : end if
264 : #endif
265 : #elif RK_ENABLED && D1_D0_ENABLED
266 240 : array = [1._RKC, 1._RKC]
267 60 : sep = 1._RKC
268 : #if CVXK_ENABLED || PVXK_ENABLED
269 12 : if (getOption(.false._LK, keep)) then
270 4 : field_ref(1)%val = [real(RKC) ::]
271 12 : field_ref(2)%val = [sep]
272 4 : field_ref(3)%val = [real(RKC) ::]
273 12 : field_ref(4)%val = [sep]
274 4 : field_ref(5)%val = [real(RKC) ::]
275 : else
276 8 : field_ref(1)%val = [real(RKC) ::]
277 8 : field_ref(2)%val = [real(RKC) ::]
278 8 : field_ref(3)%val = [real(RKC) ::]
279 : end if
280 : #endif
281 : #endif
282 288 : if (getOption(.false._LK, keep)) then
283 96 : allocate(sindex_ref(2,5))
284 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
285 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
286 96 : sindex_ref(1,3) = 2; sindex_ref(2,3) = 1
287 96 : sindex_ref(1,4) = 2; sindex_ref(2,4) = 2
288 96 : sindex_ref(1,5) = 3; sindex_ref(2,5) = 2
289 : else
290 192 : allocate(sindex_ref(2,3))
291 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
292 192 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 1
293 192 : sindex_ref(1,3) = 3; sindex_ref(2,3) = 2
294 : end if
295 :
296 1152 : instance = [1_IK, 2_IK]
297 :
298 288 : call report(iseq, keep)
299 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty.", int(__LINE__, IK))
300 :
301 288 : call report(iseq, keep, instance = instance)
302 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty.", int(__LINE__, IK))
303 :
304 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
305 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty with `sorted = .true.`.", int(__LINE__, IK))
306 :
307 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
308 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty with `sorted = .false.`.", int(__LINE__, IK))
309 :
310 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
311 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty with `unique = .true.`.", int(__LINE__, IK))
312 :
313 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
314 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty with `unique = .false.`.", int(__LINE__, IK))
315 :
316 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
317 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
318 :
319 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .true._LK)
320 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty with `sorted = .false._LK, unique = .true.`.", int(__LINE__, IK))
321 :
322 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
323 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
324 :
325 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
326 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
327 :
328 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
329 :
330 288 : call reset()
331 :
332 : #if CVXK_ENABLED || PVXK_ENABLED
333 60 : if (getOption(.false._LK, keep)) then
334 120 : allocate(field_ref(5))
335 : else
336 160 : allocate(field_ref(3))
337 : end if
338 : #endif
339 : #if SK_ENABLED && D1_D0_ENABLED
340 96 : array = ["AA", "AA"]
341 24 : sep = "AA"
342 : #if CVXK_ENABLED || PVXK_ENABLED
343 12 : if (getOption(.false._LK, keep)) then
344 4 : field_ref(1)%val = [character(2) ::]
345 12 : field_ref(2)%val = [sep]
346 4 : field_ref(3)%val = [character(2) ::]
347 12 : field_ref(4)%val = [sep]
348 4 : field_ref(5)%val = [character(2) ::]
349 : else
350 8 : field_ref(1)%val = [character(2) ::]
351 8 : field_ref(2)%val = [character(2) ::]
352 8 : field_ref(3)%val = [character(2) ::]
353 : end if
354 : #endif
355 : #elif IK_ENABLED && D1_D0_ENABLED
356 288 : array = [1_IKC, 1_IKC]
357 72 : sep = 1_IKC
358 : #if CVXK_ENABLED || PVXK_ENABLED
359 12 : if (getOption(.false._LK, keep)) then
360 4 : field_ref(1)%val = [integer(IKC) ::]
361 12 : field_ref(2)%val = [sep]
362 4 : field_ref(3)%val = [integer(IKC) ::]
363 12 : field_ref(4)%val = [sep]
364 4 : field_ref(5)%val = [integer(IKC) ::]
365 : else
366 8 : field_ref(1)%val = [integer(IKC) ::]
367 8 : field_ref(2)%val = [integer(IKC) ::]
368 8 : field_ref(3)%val = [integer(IKC) ::]
369 : end if
370 : #endif
371 : #elif LK_ENABLED && D1_D0_ENABLED
372 288 : array = [.false._LK, .false._LK]
373 72 : sep = .false._LK
374 : #if CVXK_ENABLED || PVXK_ENABLED
375 12 : if (getOption(.false._LK, keep)) then
376 4 : field_ref(1)%val = [logical(LKC) ::]
377 12 : field_ref(2)%val = [sep]
378 4 : field_ref(3)%val = [logical(LKC) ::]
379 12 : field_ref(4)%val = [sep]
380 4 : field_ref(5)%val = [logical(LKC) ::]
381 : else
382 8 : field_ref(1)%val = [logical(LKC) ::]
383 8 : field_ref(2)%val = [logical(LKC) ::]
384 8 : field_ref(3)%val = [logical(LKC) ::]
385 : end if
386 : #endif
387 : #elif CK_ENABLED && D1_D0_ENABLED
388 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
389 60 : sep = (1._CKC,-1._CKC)
390 : #if CVXK_ENABLED || PVXK_ENABLED
391 12 : if (getOption(.false._LK, keep)) then
392 4 : field_ref(1)%val = [complex(CKC) ::]
393 12 : field_ref(2)%val = [sep]
394 4 : field_ref(3)%val = [complex(CKC) ::]
395 12 : field_ref(4)%val = [sep]
396 4 : field_ref(5)%val = [complex(CKC) ::]
397 : else
398 8 : field_ref(1)%val = [complex(CKC) ::]
399 8 : field_ref(2)%val = [complex(CKC) ::]
400 8 : field_ref(3)%val = [complex(CKC) ::]
401 : end if
402 : #endif
403 : #elif RK_ENABLED && D1_D0_ENABLED
404 240 : array = [1._RKC, 1._RKC]
405 60 : sep = 1._RKC
406 : #if CVXK_ENABLED || PVXK_ENABLED
407 12 : if (getOption(.false._LK, keep)) then
408 4 : field_ref(1)%val = [real(RKC) ::]
409 12 : field_ref(2)%val = [sep]
410 4 : field_ref(3)%val = [real(RKC) ::]
411 12 : field_ref(4)%val = [sep]
412 4 : field_ref(5)%val = [real(RKC) ::]
413 : else
414 8 : field_ref(1)%val = [real(RKC) ::]
415 8 : field_ref(2)%val = [real(RKC) ::]
416 8 : field_ref(3)%val = [real(RKC) ::]
417 : end if
418 : #endif
419 : #endif
420 288 : if (getOption(.false._LK, keep)) then
421 96 : allocate(sindex_ref(2,5))
422 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
423 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
424 96 : sindex_ref(1,3) = 2; sindex_ref(2,3) = 1
425 96 : sindex_ref(1,4) = 2; sindex_ref(2,4) = 2
426 96 : sindex_ref(1,5) = 3; sindex_ref(2,5) = 2
427 : else
428 192 : allocate(sindex_ref(2,3))
429 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
430 192 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 1
431 192 : sindex_ref(1,3) = 3; sindex_ref(2,3) = 2
432 : end if
433 :
434 1728 : instance = [0_IK, 1_IK, 2_IK, 3_IK]
435 :
436 288 : call report(iseq, keep)
437 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty.", int(__LINE__, IK))
438 :
439 288 : call report(iseq, keep, instance = instance)
440 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant.", int(__LINE__, IK))
441 :
442 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
443 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant with `sorted = .true.`.", int(__LINE__, IK))
444 :
445 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
446 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant with `sorted = .false.`.", int(__LINE__, IK))
447 :
448 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
449 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant with `unique = .true.`.", int(__LINE__, IK))
450 :
451 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
452 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant with `unique = .false.`.", int(__LINE__, IK))
453 :
454 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
455 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
456 :
457 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .true._LK)
458 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant with `sorted = .false._LK, unique = .true.`.", int(__LINE__, IK))
459 :
460 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
461 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
462 :
463 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
464 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and redundant with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
465 :
466 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
467 :
468 288 : call reset()
469 :
470 : #if CVXK_ENABLED || PVXK_ENABLED
471 60 : if (getOption(.false._LK, keep)) then
472 120 : allocate(field_ref(5))
473 : else
474 160 : allocate(field_ref(3))
475 : end if
476 : #endif
477 : #if SK_ENABLED && D1_D0_ENABLED
478 96 : array = ["AA", "AA"]
479 24 : sep = "AA"
480 : #if CVXK_ENABLED || PVXK_ENABLED
481 12 : if (getOption(.false._LK, keep)) then
482 4 : field_ref(1)%val = [character(2) ::]
483 12 : field_ref(2)%val = [sep]
484 4 : field_ref(3)%val = [character(2) ::]
485 12 : field_ref(4)%val = [sep]
486 4 : field_ref(5)%val = [character(2) ::]
487 : else
488 8 : field_ref(1)%val = [character(2) ::]
489 8 : field_ref(2)%val = [character(2) ::]
490 8 : field_ref(3)%val = [character(2) ::]
491 : end if
492 : #endif
493 : #elif IK_ENABLED && D1_D0_ENABLED
494 288 : array = [1_IKC, 1_IKC]
495 72 : sep = 1_IKC
496 : #if CVXK_ENABLED || PVXK_ENABLED
497 12 : if (getOption(.false._LK, keep)) then
498 4 : field_ref(1)%val = [integer(IKC) ::]
499 12 : field_ref(2)%val = [sep]
500 4 : field_ref(3)%val = [integer(IKC) ::]
501 12 : field_ref(4)%val = [sep]
502 4 : field_ref(5)%val = [integer(IKC) ::]
503 : else
504 8 : field_ref(1)%val = [integer(IKC) ::]
505 8 : field_ref(2)%val = [integer(IKC) ::]
506 8 : field_ref(3)%val = [integer(IKC) ::]
507 : end if
508 : #endif
509 : #elif LK_ENABLED && D1_D0_ENABLED
510 288 : array = [.false._LK, .false._LK]
511 72 : sep = .false._LK
512 : #if CVXK_ENABLED || PVXK_ENABLED
513 12 : if (getOption(.false._LK, keep)) then
514 4 : field_ref(1)%val = [logical(LKC) ::]
515 12 : field_ref(2)%val = [sep]
516 4 : field_ref(3)%val = [logical(LKC) ::]
517 12 : field_ref(4)%val = [sep]
518 4 : field_ref(5)%val = [logical(LKC) ::]
519 : else
520 8 : field_ref(1)%val = [logical(LKC) ::]
521 8 : field_ref(2)%val = [logical(LKC) ::]
522 8 : field_ref(3)%val = [logical(LKC) ::]
523 : end if
524 : #endif
525 : #elif CK_ENABLED && D1_D0_ENABLED
526 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
527 60 : sep = (1._CKC,-1._CKC)
528 : #if CVXK_ENABLED || PVXK_ENABLED
529 12 : if (getOption(.false._LK, keep)) then
530 4 : field_ref(1)%val = [complex(CKC) ::]
531 12 : field_ref(2)%val = [sep]
532 4 : field_ref(3)%val = [complex(CKC) ::]
533 12 : field_ref(4)%val = [sep]
534 4 : field_ref(5)%val = [complex(CKC) ::]
535 : else
536 8 : field_ref(1)%val = [complex(CKC) ::]
537 8 : field_ref(2)%val = [complex(CKC) ::]
538 8 : field_ref(3)%val = [complex(CKC) ::]
539 : end if
540 : #endif
541 : #elif RK_ENABLED && D1_D0_ENABLED
542 240 : array = [1._RKC, 1._RKC]
543 60 : sep = 1._RKC
544 : #if CVXK_ENABLED || PVXK_ENABLED
545 12 : if (getOption(.false._LK, keep)) then
546 4 : field_ref(1)%val = [real(RKC) ::]
547 12 : field_ref(2)%val = [sep]
548 4 : field_ref(3)%val = [real(RKC) ::]
549 12 : field_ref(4)%val = [sep]
550 4 : field_ref(5)%val = [real(RKC) ::]
551 : else
552 8 : field_ref(1)%val = [real(RKC) ::]
553 8 : field_ref(2)%val = [real(RKC) ::]
554 8 : field_ref(3)%val = [real(RKC) ::]
555 : end if
556 : #endif
557 : #endif
558 288 : if (getOption(.false._LK, keep)) then
559 96 : allocate(sindex_ref(2,5))
560 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
561 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
562 96 : sindex_ref(1,3) = 2; sindex_ref(2,3) = 1
563 96 : sindex_ref(1,4) = 2; sindex_ref(2,4) = 2
564 96 : sindex_ref(1,5) = 3; sindex_ref(2,5) = 2
565 : else
566 192 : allocate(sindex_ref(2,3))
567 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
568 192 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 1
569 192 : sindex_ref(1,3) = 3; sindex_ref(2,3) = 2
570 : end if
571 :
572 1152 : instance = [1_IK, -1_IK]
573 :
574 288 : call report(iseq, keep)
575 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty.", int(__LINE__, IK))
576 :
577 288 : call report(iseq, keep, instance = instance)
578 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed.", int(__LINE__, IK))
579 :
580 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
581 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed with `sorted = .true.`.", int(__LINE__, IK))
582 :
583 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
584 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed with `sorted = .false.`.", int(__LINE__, IK))
585 :
586 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
587 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed with `unique = .true.`.", int(__LINE__, IK))
588 :
589 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
590 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed with `unique = .false.`.", int(__LINE__, IK))
591 :
592 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
593 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
594 :
595 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .true._LK)
596 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed with `sorted = .false._LK, unique = .true.`.", int(__LINE__, IK))
597 :
598 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
599 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
600 :
601 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
602 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty and mixed with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
603 :
604 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
605 :
606 288 : call reset()
607 :
608 : #if CVXK_ENABLED || PVXK_ENABLED
609 60 : if (getOption(.false._LK, keep)) then
610 120 : allocate(field_ref(5))
611 : else
612 160 : allocate(field_ref(3))
613 : end if
614 : #endif
615 : #if SK_ENABLED && D1_D0_ENABLED
616 96 : array = ["AA", "AA"]
617 24 : sep = "AA"
618 : #if CVXK_ENABLED || PVXK_ENABLED
619 12 : if (getOption(.false._LK, keep)) then
620 4 : field_ref(1)%val = [character(2) ::]
621 12 : field_ref(2)%val = [sep]
622 4 : field_ref(3)%val = [character(2) ::]
623 12 : field_ref(4)%val = [sep]
624 4 : field_ref(5)%val = [character(2) ::]
625 : else
626 8 : field_ref(1)%val = [character(2) ::]
627 8 : field_ref(2)%val = [character(2) ::]
628 8 : field_ref(3)%val = [character(2) ::]
629 : end if
630 : #endif
631 : #elif IK_ENABLED && D1_D0_ENABLED
632 288 : array = [1_IKC, 1_IKC]
633 72 : sep = 1_IKC
634 : #if CVXK_ENABLED || PVXK_ENABLED
635 12 : if (getOption(.false._LK, keep)) then
636 4 : field_ref(1)%val = [integer(IKC) ::]
637 12 : field_ref(2)%val = [sep]
638 4 : field_ref(3)%val = [integer(IKC) ::]
639 12 : field_ref(4)%val = [sep]
640 4 : field_ref(5)%val = [integer(IKC) ::]
641 : else
642 8 : field_ref(1)%val = [integer(IKC) ::]
643 8 : field_ref(2)%val = [integer(IKC) ::]
644 8 : field_ref(3)%val = [integer(IKC) ::]
645 : end if
646 : #endif
647 : #elif LK_ENABLED && D1_D0_ENABLED
648 288 : array = [.false._LK, .false._LK]
649 72 : sep = .false._LK
650 : #if CVXK_ENABLED || PVXK_ENABLED
651 12 : if (getOption(.false._LK, keep)) then
652 4 : field_ref(1)%val = [logical(LKC) ::]
653 12 : field_ref(2)%val = [sep]
654 4 : field_ref(3)%val = [logical(LKC) ::]
655 12 : field_ref(4)%val = [sep]
656 4 : field_ref(5)%val = [logical(LKC) ::]
657 : else
658 8 : field_ref(1)%val = [logical(LKC) ::]
659 8 : field_ref(2)%val = [logical(LKC) ::]
660 8 : field_ref(3)%val = [logical(LKC) ::]
661 : end if
662 : #endif
663 : #elif CK_ENABLED && D1_D0_ENABLED
664 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
665 60 : sep = (1._CKC,-1._CKC)
666 : #if CVXK_ENABLED || PVXK_ENABLED
667 12 : if (getOption(.false._LK, keep)) then
668 4 : field_ref(1)%val = [complex(CKC) ::]
669 12 : field_ref(2)%val = [sep]
670 4 : field_ref(3)%val = [complex(CKC) ::]
671 12 : field_ref(4)%val = [sep]
672 4 : field_ref(5)%val = [complex(CKC) ::]
673 : else
674 8 : field_ref(1)%val = [complex(CKC) ::]
675 8 : field_ref(2)%val = [complex(CKC) ::]
676 8 : field_ref(3)%val = [complex(CKC) ::]
677 : end if
678 : #endif
679 : #elif RK_ENABLED && D1_D0_ENABLED
680 240 : array = [1._RKC, 1._RKC]
681 60 : sep = 1._RKC
682 : #if CVXK_ENABLED || PVXK_ENABLED
683 12 : if (getOption(.false._LK, keep)) then
684 4 : field_ref(1)%val = [real(RKC) ::]
685 12 : field_ref(2)%val = [sep]
686 4 : field_ref(3)%val = [real(RKC) ::]
687 12 : field_ref(4)%val = [sep]
688 4 : field_ref(5)%val = [real(RKC) ::]
689 : else
690 8 : field_ref(1)%val = [real(RKC) ::]
691 8 : field_ref(2)%val = [real(RKC) ::]
692 8 : field_ref(3)%val = [real(RKC) ::]
693 : end if
694 : #endif
695 : #endif
696 288 : if (getOption(.false._LK, keep)) then
697 96 : allocate(sindex_ref(2,5))
698 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
699 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
700 96 : sindex_ref(1,3) = 2; sindex_ref(2,3) = 1
701 96 : sindex_ref(1,4) = 2; sindex_ref(2,4) = 2
702 96 : sindex_ref(1,5) = 3; sindex_ref(2,5) = 2
703 : else
704 192 : allocate(sindex_ref(2,3))
705 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
706 192 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 1
707 192 : sindex_ref(1,3) = 3; sindex_ref(2,3) = 2
708 : end if
709 :
710 1440 : instance = [1_IK, -2_IK, -1_IK]
711 :
712 288 : call report(iseq, keep)
713 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty.", int(__LINE__, IK))
714 :
715 288 : call report(iseq, keep, instance = instance)
716 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, and mixed.", int(__LINE__, IK))
717 :
718 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
719 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, and mixed, with `sorted = .true.`.", int(__LINE__, IK))
720 :
721 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
722 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, and mixed, with `sorted = .false.`.", int(__LINE__, IK))
723 :
724 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
725 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, and mixed, with `unique = .false.`.", int(__LINE__, IK))
726 :
727 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
728 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, and mixed, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
729 :
730 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
731 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, and mixed, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
732 :
733 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
734 :
735 288 : call reset()
736 :
737 : #if CVXK_ENABLED || PVXK_ENABLED
738 60 : if (getOption(.false._LK, keep)) then
739 120 : allocate(field_ref(5))
740 : else
741 160 : allocate(field_ref(3))
742 : end if
743 : #endif
744 : #if SK_ENABLED && D1_D0_ENABLED
745 96 : array = ["AA", "AA"]
746 24 : sep = "AA"
747 : #if CVXK_ENABLED || PVXK_ENABLED
748 12 : if (getOption(.false._LK, keep)) then
749 4 : field_ref(1)%val = [character(2) ::]
750 12 : field_ref(2)%val = [sep]
751 4 : field_ref(3)%val = [character(2) ::]
752 12 : field_ref(4)%val = [sep]
753 4 : field_ref(5)%val = [character(2) ::]
754 : else
755 8 : field_ref(1)%val = [character(2) ::]
756 8 : field_ref(2)%val = [character(2) ::]
757 8 : field_ref(3)%val = [character(2) ::]
758 : end if
759 : #endif
760 : #elif IK_ENABLED && D1_D0_ENABLED
761 288 : array = [1_IKC, 1_IKC]
762 72 : sep = 1_IKC
763 : #if CVXK_ENABLED || PVXK_ENABLED
764 12 : if (getOption(.false._LK, keep)) then
765 4 : field_ref(1)%val = [integer(IKC) ::]
766 12 : field_ref(2)%val = [sep]
767 4 : field_ref(3)%val = [integer(IKC) ::]
768 12 : field_ref(4)%val = [sep]
769 4 : field_ref(5)%val = [integer(IKC) ::]
770 : else
771 8 : field_ref(1)%val = [integer(IKC) ::]
772 8 : field_ref(2)%val = [integer(IKC) ::]
773 8 : field_ref(3)%val = [integer(IKC) ::]
774 : end if
775 : #endif
776 : #elif LK_ENABLED && D1_D0_ENABLED
777 288 : array = [.false._LK, .false._LK]
778 72 : sep = .false._LK
779 : #if CVXK_ENABLED || PVXK_ENABLED
780 12 : if (getOption(.false._LK, keep)) then
781 4 : field_ref(1)%val = [logical(LKC) ::]
782 12 : field_ref(2)%val = [sep]
783 4 : field_ref(3)%val = [logical(LKC) ::]
784 12 : field_ref(4)%val = [sep]
785 4 : field_ref(5)%val = [logical(LKC) ::]
786 : else
787 8 : field_ref(1)%val = [logical(LKC) ::]
788 8 : field_ref(2)%val = [logical(LKC) ::]
789 8 : field_ref(3)%val = [logical(LKC) ::]
790 : end if
791 : #endif
792 : #elif CK_ENABLED && D1_D0_ENABLED
793 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
794 60 : sep = (1._CKC,-1._CKC)
795 : #if CVXK_ENABLED || PVXK_ENABLED
796 12 : if (getOption(.false._LK, keep)) then
797 4 : field_ref(1)%val = [complex(CKC) ::]
798 12 : field_ref(2)%val = [sep]
799 4 : field_ref(3)%val = [complex(CKC) ::]
800 12 : field_ref(4)%val = [sep]
801 4 : field_ref(5)%val = [complex(CKC) ::]
802 : else
803 8 : field_ref(1)%val = [complex(CKC) ::]
804 8 : field_ref(2)%val = [complex(CKC) ::]
805 8 : field_ref(3)%val = [complex(CKC) ::]
806 : end if
807 : #endif
808 : #elif RK_ENABLED && D1_D0_ENABLED
809 240 : array = [1._RKC, 1._RKC]
810 60 : sep = 1._RKC
811 : #if CVXK_ENABLED || PVXK_ENABLED
812 12 : if (getOption(.false._LK, keep)) then
813 4 : field_ref(1)%val = [real(RKC) ::]
814 12 : field_ref(2)%val = [sep]
815 4 : field_ref(3)%val = [real(RKC) ::]
816 12 : field_ref(4)%val = [sep]
817 4 : field_ref(5)%val = [real(RKC) ::]
818 : else
819 8 : field_ref(1)%val = [real(RKC) ::]
820 8 : field_ref(2)%val = [real(RKC) ::]
821 8 : field_ref(3)%val = [real(RKC) ::]
822 : end if
823 : #endif
824 : #endif
825 288 : if (getOption(.false._LK, keep)) then
826 96 : allocate(sindex_ref(2,5))
827 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
828 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
829 96 : sindex_ref(1,3) = 2; sindex_ref(2,3) = 1
830 96 : sindex_ref(1,4) = 2; sindex_ref(2,4) = 2
831 96 : sindex_ref(1,5) = 3; sindex_ref(2,5) = 2
832 : else
833 192 : allocate(sindex_ref(2,3))
834 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
835 192 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 1
836 192 : sindex_ref(1,3) = 3; sindex_ref(2,3) = 2
837 : end if
838 :
839 1728 : instance = [1_IK, -1_IK, -2_IK, 0_IK]
840 :
841 288 : call report(iseq, keep)
842 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty.", int(__LINE__, IK))
843 :
844 288 : call report(iseq, keep, instance = instance)
845 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, unsorted, and mixed.", int(__LINE__, IK))
846 :
847 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
848 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, unsorted, and mixed, with `sorted = .false.`.", int(__LINE__, IK))
849 :
850 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
851 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, unsorted, and mixed, with `unique = .false.`.", int(__LINE__, IK))
852 :
853 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
854 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size `size(array)/size(sep) + 1` whose components are all empty when `instance` is non-empty, redundant, non-unique, unsorted, and mixed, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
855 :
856 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
857 :
858 288 : call reset()
859 :
860 : #if CVXK_ENABLED || PVXK_ENABLED
861 60 : if (getOption(.false._LK, keep)) then
862 80 : allocate(field_ref(3))
863 : else
864 120 : allocate(field_ref(2))
865 : end if
866 : #endif
867 : #if SK_ENABLED && D1_D0_ENABLED
868 96 : array = ["AA", "AA"]
869 24 : sep = "AA"
870 : #if CVXK_ENABLED || PVXK_ENABLED
871 12 : if (getOption(.false._LK, keep)) then
872 4 : field_ref(1)%val = [character(2) ::]
873 12 : field_ref(2)%val = [sep]
874 12 : field_ref(3)%val = [sep]
875 : else
876 8 : field_ref(1)%val = [character(2) ::]
877 24 : field_ref(2)%val = ["AA"]
878 : end if
879 : #endif
880 : #elif IK_ENABLED && D1_D0_ENABLED
881 288 : array = [1_IKC, 1_IKC]
882 72 : sep = 1_IKC
883 : #if CVXK_ENABLED || PVXK_ENABLED
884 12 : if (getOption(.false._LK, keep)) then
885 4 : field_ref(1)%val = [integer(IKC) ::]
886 12 : field_ref(2)%val = [sep]
887 12 : field_ref(3)%val = [sep]
888 : else
889 8 : field_ref(1)%val = [integer(IKC) ::]
890 24 : field_ref(2)%val = [1_IKC]
891 : end if
892 : #endif
893 : #elif LK_ENABLED && D1_D0_ENABLED
894 288 : array = [.false._LK, .false._LK]
895 72 : sep = .false._LK
896 : #if CVXK_ENABLED || PVXK_ENABLED
897 12 : if (getOption(.false._LK, keep)) then
898 4 : field_ref(1)%val = [logical(LKC) ::]
899 12 : field_ref(2)%val = [sep]
900 12 : field_ref(3)%val = [sep]
901 : else
902 8 : field_ref(1)%val = [logical(LKC) ::]
903 24 : field_ref(2)%val = [.false._LK]
904 : end if
905 : #endif
906 : #elif CK_ENABLED && D1_D0_ENABLED
907 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
908 60 : sep = (1._CKC,-1._CKC)
909 : #if CVXK_ENABLED || PVXK_ENABLED
910 12 : if (getOption(.false._LK, keep)) then
911 4 : field_ref(1)%val = [complex(CKC) ::]
912 12 : field_ref(2)%val = [sep]
913 12 : field_ref(3)%val = [sep]
914 : else
915 8 : field_ref(1)%val = [complex(CKC) ::]
916 24 : field_ref(2)%val = [(1._CKC,-1._CKC)]
917 : end if
918 : #endif
919 : #elif RK_ENABLED && D1_D0_ENABLED
920 240 : array = [1._RKC, 1._RKC]
921 60 : sep = 1._RKC
922 : #if CVXK_ENABLED || PVXK_ENABLED
923 12 : if (getOption(.false._LK, keep)) then
924 4 : field_ref(1)%val = [real(RKC) ::]
925 12 : field_ref(2)%val = [sep]
926 12 : field_ref(3)%val = [sep]
927 : else
928 8 : field_ref(1)%val = [real(RKC) ::]
929 24 : field_ref(2)%val = [1._RKC]
930 : end if
931 : #endif
932 : #endif
933 288 : if (getOption(.false._LK, keep)) then
934 96 : allocate(sindex_ref(2,3))
935 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
936 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
937 96 : sindex_ref(1,3) = 2; sindex_ref(2,3) = 2
938 : else
939 192 : allocate(sindex_ref(2,2))
940 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
941 192 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 2
942 : end if
943 :
944 1152 : instance = [1_IK, -2_IK]
945 :
946 288 : call report(iseq, keep, instance = instance)
947 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed.", int(__LINE__, IK))
948 :
949 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
950 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .true.`.", int(__LINE__, IK))
951 :
952 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
953 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .false.`.", int(__LINE__, IK))
954 :
955 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
956 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `unique = .false.`.", int(__LINE__, IK))
957 :
958 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
959 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
960 :
961 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
962 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
963 :
964 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
965 :
966 288 : call reset()
967 :
968 : #if CVXK_ENABLED || PVXK_ENABLED
969 60 : if (getOption(.false._LK, keep)) then
970 80 : allocate(field_ref(3))
971 : else
972 120 : allocate(field_ref(2))
973 : end if
974 : #endif
975 : #if SK_ENABLED && D1_D0_ENABLED
976 96 : array = ["AA", "AA"]
977 24 : sep = "AA"
978 : #if CVXK_ENABLED || PVXK_ENABLED
979 12 : if (getOption(.false._LK, keep)) then
980 4 : field_ref(1)%val = [character(2) ::]
981 12 : field_ref(2)%val = [sep]
982 12 : field_ref(3)%val = [sep]
983 : else
984 8 : field_ref(1)%val = [character(2) ::]
985 24 : field_ref(2)%val = ["AA"]
986 : end if
987 : #endif
988 : #elif IK_ENABLED && D1_D0_ENABLED
989 288 : array = [1_IKC, 1_IKC]
990 72 : sep = 1_IKC
991 : #if CVXK_ENABLED || PVXK_ENABLED
992 12 : if (getOption(.false._LK, keep)) then
993 4 : field_ref(1)%val = [integer(IKC) ::]
994 12 : field_ref(2)%val = [sep]
995 12 : field_ref(3)%val = [sep]
996 : else
997 8 : field_ref(1)%val = [integer(IKC) ::]
998 24 : field_ref(2)%val = [1_IKC]
999 : end if
1000 : #endif
1001 : #elif LK_ENABLED && D1_D0_ENABLED
1002 288 : array = [.false._LK, .false._LK]
1003 72 : sep = .false._LK
1004 : #if CVXK_ENABLED || PVXK_ENABLED
1005 12 : if (getOption(.false._LK, keep)) then
1006 4 : field_ref(1)%val = [logical(LKC) ::]
1007 12 : field_ref(2)%val = [sep]
1008 12 : field_ref(3)%val = [sep]
1009 : else
1010 8 : field_ref(1)%val = [logical(LKC) ::]
1011 24 : field_ref(2)%val = [.false._LK]
1012 : end if
1013 : #endif
1014 : #elif CK_ENABLED && D1_D0_ENABLED
1015 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
1016 60 : sep = (1._CKC,-1._CKC)
1017 : #if CVXK_ENABLED || PVXK_ENABLED
1018 12 : if (getOption(.false._LK, keep)) then
1019 4 : field_ref(1)%val = [complex(CKC) ::]
1020 12 : field_ref(2)%val = [sep]
1021 12 : field_ref(3)%val = [sep]
1022 : else
1023 8 : field_ref(1)%val = [complex(CKC) ::]
1024 24 : field_ref(2)%val = [(1._CKC,-1._CKC)]
1025 : end if
1026 : #endif
1027 : #elif RK_ENABLED && D1_D0_ENABLED
1028 240 : array = [1._RKC, 1._RKC]
1029 60 : sep = 1._RKC
1030 : #if CVXK_ENABLED || PVXK_ENABLED
1031 12 : if (getOption(.false._LK, keep)) then
1032 4 : field_ref(1)%val = [real(RKC) ::]
1033 12 : field_ref(2)%val = [sep]
1034 12 : field_ref(3)%val = [sep]
1035 : else
1036 8 : field_ref(1)%val = [real(RKC) ::]
1037 24 : field_ref(2)%val = [1._RKC]
1038 : end if
1039 : #endif
1040 : #endif
1041 288 : if (getOption(.false._LK, keep)) then
1042 96 : allocate(sindex_ref(2,3))
1043 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
1044 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
1045 96 : sindex_ref(1,3) = 2; sindex_ref(2,3) = 2
1046 : else
1047 192 : allocate(sindex_ref(2,2))
1048 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
1049 192 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 2
1050 : end if
1051 :
1052 864 : instance = [-2_IK]
1053 :
1054 288 : call report(iseq, keep, instance = instance)
1055 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive and unique.", int(__LINE__, IK))
1056 :
1057 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1058 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive and unique, with `sorted = .true.`.", int(__LINE__, IK))
1059 :
1060 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1061 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive and unique, with `sorted = .false.`.", int(__LINE__, IK))
1062 :
1063 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1064 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive and unique, with `unique = .true.`.", int(__LINE__, IK))
1065 :
1066 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1067 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive and unique, with `unique = .false.`.", int(__LINE__, IK))
1068 :
1069 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1070 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive and unique, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1071 :
1072 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1073 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive and unique, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1074 :
1075 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1076 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose first component is empty but the last corresponds to the last element of `array` when `instance` is non-empty but incomprehensive and unique, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1077 :
1078 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1079 :
1080 288 : call reset()
1081 :
1082 : #if CVXK_ENABLED || PVXK_ENABLED
1083 60 : if (getOption(.false._LK, keep)) then
1084 80 : allocate(field_ref(3))
1085 : else
1086 120 : allocate(field_ref(2))
1087 : end if
1088 : #endif
1089 : #if SK_ENABLED && D1_D0_ENABLED
1090 96 : array = ["AA", "AA"]
1091 24 : sep = "AA"
1092 : #if CVXK_ENABLED || PVXK_ENABLED
1093 12 : if (getOption(.false._LK, keep)) then
1094 12 : field_ref(1)%val = ["AA"]
1095 12 : field_ref(2)%val = [sep]
1096 4 : field_ref(3)%val = [character(2) ::]
1097 : else
1098 24 : field_ref(1)%val = ["AA"]
1099 8 : field_ref(2)%val = [character(2) ::]
1100 : end if
1101 : #endif
1102 : #elif IK_ENABLED && D1_D0_ENABLED
1103 288 : array = [1_IKC, 1_IKC]
1104 72 : sep = 1_IKC
1105 : #if CVXK_ENABLED || PVXK_ENABLED
1106 12 : if (getOption(.false._LK, keep)) then
1107 12 : field_ref(1)%val = [1_IKC]
1108 12 : field_ref(2)%val = [sep]
1109 4 : field_ref(3)%val = [integer(IKC) ::]
1110 : else
1111 24 : field_ref(1)%val = [1_IKC]
1112 8 : field_ref(2)%val = [integer(IKC) ::]
1113 : end if
1114 : #endif
1115 : #elif LK_ENABLED && D1_D0_ENABLED
1116 288 : array = [.false._LK, .false._LK]
1117 72 : sep = .false._LK
1118 : #if CVXK_ENABLED || PVXK_ENABLED
1119 12 : if (getOption(.false._LK, keep)) then
1120 12 : field_ref(1)%val = [.false._LK]
1121 12 : field_ref(2)%val = [sep]
1122 4 : field_ref(3)%val = [logical(LKC) ::]
1123 : else
1124 24 : field_ref(1)%val = [.false._LK]
1125 8 : field_ref(2)%val = [logical(LKC) ::]
1126 : end if
1127 : #endif
1128 : #elif CK_ENABLED && D1_D0_ENABLED
1129 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
1130 60 : sep = (1._CKC,-1._CKC)
1131 : #if CVXK_ENABLED || PVXK_ENABLED
1132 12 : if (getOption(.false._LK, keep)) then
1133 12 : field_ref(1)%val = [(1._CKC,-1._CKC)]
1134 12 : field_ref(2)%val = [sep]
1135 4 : field_ref(3)%val = [complex(CKC) ::]
1136 : else
1137 24 : field_ref(1)%val = [(1._CKC,-1._CKC)]
1138 8 : field_ref(2)%val = [complex(CKC) ::]
1139 : end if
1140 : #endif
1141 : #elif RK_ENABLED && D1_D0_ENABLED
1142 240 : array = [1._RKC, 1._RKC]
1143 60 : sep = 1._RKC
1144 : #if CVXK_ENABLED || PVXK_ENABLED
1145 12 : if (getOption(.false._LK, keep)) then
1146 12 : field_ref(1)%val = [1._RKC]
1147 12 : field_ref(2)%val = [sep]
1148 4 : field_ref(3)%val = [real(RKC) ::]
1149 : else
1150 24 : field_ref(1)%val = [1._RKC]
1151 8 : field_ref(2)%val = [real(RKC) ::]
1152 : end if
1153 : #endif
1154 : #endif
1155 288 : if (getOption(.false._LK, keep)) then
1156 96 : allocate(sindex_ref(2,3))
1157 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 1
1158 96 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 2
1159 96 : sindex_ref(1,3) = 3; sindex_ref(2,3) = 2
1160 : else
1161 192 : allocate(sindex_ref(2,2))
1162 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 1
1163 192 : sindex_ref(1,2) = 3; sindex_ref(2,2) = 2
1164 : end if
1165 :
1166 1152 : instance = [-1_IK, 3_IK]
1167 :
1168 288 : call report(iseq, keep, instance = instance)
1169 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose last component is empty but the first corresponds to the first element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed.", int(__LINE__, IK))
1170 :
1171 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1172 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose last component is empty but the first corresponds to the first element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .true.`.", int(__LINE__, IK))
1173 :
1174 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1175 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose last component is empty but the first corresponds to the first element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .false.`.", int(__LINE__, IK))
1176 :
1177 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1178 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose last component is empty but the first corresponds to the first element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `unique = .true.`.", int(__LINE__, IK))
1179 :
1180 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1181 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose last component is empty but the first corresponds to the first element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `unique = .false.`.", int(__LINE__, IK))
1182 :
1183 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1184 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose last component is empty but the first corresponds to the first element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1185 :
1186 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1187 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose last component is empty but the first corresponds to the first element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1188 :
1189 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1190 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` of scalar `sep` must yield an `field` of size two whose last component is empty but the first corresponds to the first element of `array` when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1191 :
1192 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1193 :
1194 288 : call reset()
1195 :
1196 : #if CVXK_ENABLED || PVXK_ENABLED
1197 60 : if (getOption(.false._LK, keep)) then
1198 80 : allocate(field_ref(3))
1199 : else
1200 120 : allocate(field_ref(2))
1201 : end if
1202 : #endif
1203 : #if SK_ENABLED && D1_D0_ENABLED
1204 72 : array = ["AA"]
1205 24 : sep = array(1)
1206 : #if CVXK_ENABLED || PVXK_ENABLED
1207 12 : if (getOption(.false._LK, keep)) then
1208 4 : field_ref(1)%val = [character(2) ::]
1209 12 : field_ref(2)%val = [sep]
1210 4 : field_ref(3)%val = [character(2) ::]
1211 : else
1212 8 : field_ref(1)%val = [character(2) ::]
1213 8 : field_ref(2)%val = [character(2) ::]
1214 : end if
1215 : #endif
1216 : #elif IK_ENABLED && D1_D0_ENABLED
1217 216 : array = [1_IKC]
1218 72 : sep = array(1)
1219 : #if CVXK_ENABLED || PVXK_ENABLED
1220 12 : if (getOption(.false._LK, keep)) then
1221 4 : field_ref(1)%val = [integer(IKC) ::]
1222 12 : field_ref(2)%val = [sep]
1223 4 : field_ref(3)%val = [integer(IKC) ::]
1224 : else
1225 8 : field_ref(1)%val = [integer(IKC) ::]
1226 8 : field_ref(2)%val = [integer(IKC) ::]
1227 : end if
1228 : #endif
1229 : #elif LK_ENABLED && D1_D0_ENABLED
1230 216 : array = [.false._LK]
1231 72 : sep = array(1)
1232 : #if CVXK_ENABLED || PVXK_ENABLED
1233 12 : if (getOption(.false._LK, keep)) then
1234 4 : field_ref(1)%val = [logical(LKC) ::]
1235 12 : field_ref(2)%val = [sep]
1236 4 : field_ref(3)%val = [logical(LKC) ::]
1237 : else
1238 8 : field_ref(1)%val = [logical(LKC) ::]
1239 8 : field_ref(2)%val = [logical(LKC) ::]
1240 : end if
1241 : #endif
1242 : #elif CK_ENABLED && D1_D0_ENABLED
1243 180 : array = [(1._CKC,-1._CKC)]
1244 60 : sep = array(1)
1245 : #if CVXK_ENABLED || PVXK_ENABLED
1246 12 : if (getOption(.false._LK, keep)) then
1247 4 : field_ref(1)%val = [complex(CKC) ::]
1248 12 : field_ref(2)%val = [sep]
1249 4 : field_ref(3)%val = [complex(CKC) ::]
1250 : else
1251 8 : field_ref(1)%val = [complex(CKC) ::]
1252 8 : field_ref(2)%val = [complex(CKC) ::]
1253 : end if
1254 : #endif
1255 : #elif RK_ENABLED && D1_D0_ENABLED
1256 180 : array = [1._RKC]
1257 60 : sep = array(1)
1258 : #if CVXK_ENABLED || PVXK_ENABLED
1259 12 : if (getOption(.false._LK, keep)) then
1260 4 : field_ref(1)%val = [real(RKC) ::]
1261 12 : field_ref(2)%val = [sep]
1262 4 : field_ref(3)%val = [real(RKC) ::]
1263 : else
1264 8 : field_ref(1)%val = [real(RKC) ::]
1265 8 : field_ref(2)%val = [real(RKC) ::]
1266 : end if
1267 : #endif
1268 : #endif
1269 288 : if (getOption(.false._LK, keep)) then
1270 96 : allocate(sindex_ref(2,3))
1271 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
1272 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
1273 96 : sindex_ref(1,3) = 1; sindex_ref(2,3) = 0
1274 : else
1275 192 : allocate(sindex_ref(2,2))
1276 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
1277 192 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 0
1278 : end if
1279 :
1280 1152 : instance = [-1_IK, 3_IK]
1281 :
1282 288 : call report(iseq, keep, instance = instance)
1283 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed.", int(__LINE__, IK))
1284 :
1285 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1286 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .true.`.", int(__LINE__, IK))
1287 :
1288 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1289 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .false.`.", int(__LINE__, IK))
1290 :
1291 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1292 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `unique = .true.`.", int(__LINE__, IK))
1293 :
1294 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1295 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `unique = .false.`.", int(__LINE__, IK))
1296 :
1297 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1298 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1299 :
1300 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1301 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1302 :
1303 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1304 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is non-empty but incomprehensive, redundant, non-unique, and mixed, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1305 :
1306 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1307 :
1308 288 : call reset()
1309 : #if SK_ENABLED && D1_D0_ENABLED
1310 72 : array = ["AA"]
1311 : #elif IK_ENABLED && D1_D0_ENABLED
1312 216 : array = [1_IKC]
1313 : #elif LK_ENABLED && D1_D0_ENABLED
1314 216 : array = [.false._LK]
1315 : #elif CK_ENABLED && D1_D0_ENABLED
1316 180 : array = [(1._CKC,-1._CKC)]
1317 : #elif RK_ENABLED && D1_D0_ENABLED
1318 180 : array = [1._RKC]
1319 : #endif
1320 288 : sep = array(1)
1321 1152 : instance = [0_IK, 3_IK]
1322 :
1323 : #if CVXK_ENABLED || PVXK_ENABLED
1324 132 : allocate(field_ref(1))
1325 240 : field_ref(1)%val = array
1326 : #endif
1327 288 : allocate(sindex_ref(2,1))
1328 288 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 1
1329 :
1330 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1331 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true.`.", int(__LINE__, IK))
1332 :
1333 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1334 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false.`.", int(__LINE__, IK))
1335 :
1336 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1337 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .true.`.", int(__LINE__, IK))
1338 :
1339 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1340 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .false.`.", int(__LINE__, IK))
1341 :
1342 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1343 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1344 :
1345 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1346 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1347 :
1348 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1349 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` the same as the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1350 :
1351 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1352 :
1353 288 : call reset()
1354 :
1355 : #if SK_ENABLED && D1_D0_ENABLED
1356 24 : allocate(character(2) :: array(0))
1357 24 : sep = "AA"
1358 : #elif IK_ENABLED && D1_D0_ENABLED
1359 72 : allocate(array(0))
1360 72 : sep = 1_IKC
1361 : #elif LK_ENABLED && D1_D0_ENABLED
1362 72 : allocate(array(0))
1363 72 : sep = .false._LK
1364 : #elif CK_ENABLED && D1_D0_ENABLED
1365 60 : allocate(array(0))
1366 60 : sep = (1._CKC,-1._CKC)
1367 : #elif RK_ENABLED && D1_D0_ENABLED
1368 60 : allocate(array(0))
1369 60 : sep = 1._RKC
1370 : #endif
1371 1152 : instance = [0_IK, 3_IK]
1372 : #if CVXK_ENABLED || PVXK_ENABLED
1373 132 : allocate(field_ref(1))
1374 120 : field_ref(1)%val = array
1375 : #endif
1376 288 : allocate(sindex_ref(2,1))
1377 288 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
1378 :
1379 :
1380 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1381 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true.`.", int(__LINE__, IK))
1382 :
1383 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1384 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false.`.", int(__LINE__, IK))
1385 :
1386 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1387 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .true.`.", int(__LINE__, IK))
1388 :
1389 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1390 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .false.`.", int(__LINE__, IK))
1391 :
1392 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1393 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1394 :
1395 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1396 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1397 :
1398 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1399 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1400 :
1401 864 : instance = [1_IK]
1402 :
1403 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1404 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true.`.", int(__LINE__, IK))
1405 :
1406 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1407 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .false.`.", int(__LINE__, IK))
1408 :
1409 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1410 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty, and sensible, with `unique = .true.`.", int(__LINE__, IK))
1411 :
1412 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1413 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty, and sensible, with `unique = .false.`.", int(__LINE__, IK))
1414 :
1415 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1416 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1417 :
1418 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1419 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1420 :
1421 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1422 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` larger than the `array` must yield an `field` of size two whose components are all empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1423 :
1424 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1425 :
1426 288 : call reset()
1427 :
1428 : #if CVXK_ENABLED || PVXK_ENABLED
1429 60 : if (getOption(.false._LK, keep)) then
1430 120 : allocate(field_ref(5))
1431 : else
1432 160 : allocate(field_ref(3))
1433 : end if
1434 : #endif
1435 : #if SK_ENABLED && D1_D0_ENABLED
1436 192 : array = ["AA", "BB", "BB", "CC", "CC", "AA"]
1437 24 : sep = "AA"
1438 : #if CVXK_ENABLED || PVXK_ENABLED
1439 12 : if (getOption(.false._LK, keep)) then
1440 4 : field_ref(1)%val = [character(2) ::]
1441 12 : field_ref(2)%val = [sep]
1442 24 : field_ref(3)%val = ["BB", "BB", "CC", "CC"]
1443 12 : field_ref(4)%val = [sep]
1444 4 : field_ref(5)%val = [character(2) ::]
1445 : else
1446 8 : field_ref(1)%val = [character(2) ::]
1447 48 : field_ref(2)%val = ["BB", "BB", "CC", "CC"]
1448 8 : field_ref(3)%val = [character(2) ::]
1449 : end if
1450 : #endif
1451 : #elif IK_ENABLED && D1_D0_ENABLED
1452 576 : array = [1_IKC, 2_IKC, 2_IKC, 3_IKC, 3_IKC, 1_IKC]
1453 72 : sep = 1_IKC
1454 : #if CVXK_ENABLED || PVXK_ENABLED
1455 12 : if (getOption(.false._LK, keep)) then
1456 4 : field_ref(1)%val = [integer(IKC) ::]
1457 12 : field_ref(2)%val = [sep]
1458 24 : field_ref(3)%val = [2_IKC, 2_IKC, 3_IKC, 3_IKC]
1459 12 : field_ref(4)%val = [sep]
1460 4 : field_ref(5)%val = [integer(IKC) ::]
1461 : else
1462 8 : field_ref(1)%val = [integer(IKC) ::]
1463 48 : field_ref(2)%val = [2_IKC, 2_IKC, 3_IKC, 3_IKC]
1464 8 : field_ref(3)%val = [integer(IKC) ::]
1465 : end if
1466 : #endif
1467 : #elif LK_ENABLED && D1_D0_ENABLED
1468 576 : array = [.false._LK, .true._LK, .true._LK, .true._LK, .true._LK, .false._LK]
1469 72 : sep = .false._LK
1470 : #if CVXK_ENABLED || PVXK_ENABLED
1471 12 : if (getOption(.false._LK, keep)) then
1472 4 : field_ref(1)%val = [logical(LKC) ::]
1473 12 : field_ref(2)%val = [sep]
1474 24 : field_ref(3)%val = [.true._LK, .true._LK, .true._LK, .true._LK]
1475 12 : field_ref(4)%val = [sep]
1476 4 : field_ref(5)%val = [logical(LKC) ::]
1477 : else
1478 8 : field_ref(1)%val = [logical(LKC) ::]
1479 48 : field_ref(2)%val = [.true._LK, .true._LK, .true._LK, .true._LK]
1480 8 : field_ref(3)%val = [logical(LKC) ::]
1481 : end if
1482 : #endif
1483 : #elif CK_ENABLED && D1_D0_ENABLED
1484 480 : array = [(1._CKC,-1._CKC), (2._CKC,-2._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (3._CKC,-3._CKC), (1._CKC,-1._CKC)]
1485 60 : sep = (1._CKC,-1._CKC)
1486 : #if CVXK_ENABLED || PVXK_ENABLED
1487 12 : if (getOption(.false._LK, keep)) then
1488 4 : field_ref(1)%val = [complex(CKC) ::]
1489 12 : field_ref(2)%val = [sep]
1490 24 : field_ref(3)%val = [(2._CKC,-2._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (3._CKC,-3._CKC)]
1491 12 : field_ref(4)%val = [sep]
1492 4 : field_ref(5)%val = [complex(CKC) ::]
1493 : else
1494 8 : field_ref(1)%val = [complex(CKC) ::]
1495 48 : field_ref(2)%val = [(2._CKC,-2._CKC), (2._CKC,-2._CKC), (3._CKC,-3._CKC), (3._CKC,-3._CKC)]
1496 8 : field_ref(3)%val = [complex(CKC) ::]
1497 : end if
1498 : #endif
1499 : #elif RK_ENABLED && D1_D0_ENABLED
1500 480 : array = [1._RKC, 2._RKC, 2._RKC, 3._RKC, 3._RKC, 1._RKC]
1501 60 : sep = 1._RKC
1502 : #if CVXK_ENABLED || PVXK_ENABLED
1503 12 : if (getOption(.false._LK, keep)) then
1504 4 : field_ref(1)%val = [real(RKC) ::]
1505 12 : field_ref(2)%val = [sep]
1506 24 : field_ref(3)%val = [2._RKC, 2._RKC, 3._RKC, 3._RKC]
1507 12 : field_ref(4)%val = [sep]
1508 4 : field_ref(5)%val = [real(RKC) ::]
1509 : else
1510 8 : field_ref(1)%val = [real(RKC) ::]
1511 48 : field_ref(2)%val = [2._RKC, 2._RKC, 3._RKC, 3._RKC]
1512 8 : field_ref(3)%val = [real(RKC) ::]
1513 : end if
1514 : #endif
1515 : #endif
1516 288 : if (getOption(.false._LK, keep)) then
1517 96 : allocate(sindex_ref(2,5))
1518 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
1519 96 : sindex_ref(1,2) = 1; sindex_ref(2,2) = 1
1520 96 : sindex_ref(1,3) = 2; sindex_ref(2,3) = 5
1521 96 : sindex_ref(1,4) = 6; sindex_ref(2,4) = 6
1522 96 : sindex_ref(1,5) = 7; sindex_ref(2,5) = 6
1523 : else
1524 192 : allocate(sindex_ref(2,3))
1525 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 0
1526 192 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 5
1527 192 : sindex_ref(1,3) = 7; sindex_ref(2,3) = 6
1528 : end if
1529 :
1530 1152 : instance = [1_IK, -1_IK]
1531 :
1532 288 : call report(iseq, keep)
1533 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` occurrence at the beginning and the end of the `array` must yield an `field` of size three whose first and last elements are empty.", int(__LINE__, IK))
1534 :
1535 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1536 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` occurrence at the beginning and the end of the `array` must yield an `field` of size three whose first and last elements are empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true.`.", int(__LINE__, IK))
1537 :
1538 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1539 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` occurrence at the beginning and the end of the `array` must yield an `field` of size three whose first and last elements are empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .false.`.", int(__LINE__, IK))
1540 :
1541 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1542 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` occurrence at the beginning and the end of the `array` must yield an `field` of size three whose first and last elements are empty when `instance` is ordered, unique, non-empty, and sensible, with `unique = .true.`.", int(__LINE__, IK))
1543 :
1544 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1545 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` occurrence at the beginning and the end of the `array` must yield an `field` of size three whose first and last elements are empty when `instance` is ordered, unique, non-empty, and sensible, with `unique = .false.`.", int(__LINE__, IK))
1546 :
1547 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1548 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` occurrence at the beginning and the end of the `array` must yield an `field` of size three whose first and last elements are empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1549 :
1550 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1551 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` occurrence at the beginning and the end of the `array` must yield an `field` of size three whose first and last elements are empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1552 :
1553 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1554 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with `sep` occurrence at the beginning and the end of the `array` must yield an `field` of size three whose first and last elements are empty when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1555 :
1556 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1557 :
1558 288 : call reset()
1559 :
1560 : #if CVXK_ENABLED || PVXK_ENABLED
1561 132 : allocate(field_ref(1))
1562 : #endif
1563 : #if SK_ENABLED && D1_D0_ENABLED
1564 96 : array = ["AA", "AA"]
1565 24 : sep = "XX"
1566 : #elif LK_ENABLED && D1_D0_ENABLED
1567 288 : array = [.false._LK, .false._LK]
1568 72 : sep = .true._LK
1569 : #elif IK_ENABLED && D1_D0_ENABLED
1570 288 : array = [1_IKC, 1_IKC]
1571 72 : sep = 0_IKC
1572 : #elif CK_ENABLED && D1_D0_ENABLED
1573 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
1574 60 : sep = (0._CKC,0._CKC)
1575 : #elif RK_ENABLED && D1_D0_ENABLED
1576 240 : array = [1._RKC, 1._RKC]
1577 60 : sep = 0._RKC
1578 : #endif
1579 1152 : instance = [0_IK, 3_IK]
1580 : #if CVXK_ENABLED || PVXK_ENABLED
1581 300 : field_ref(1)%val = array
1582 : #endif
1583 288 : allocate(sindex_ref(2,1))
1584 288 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 2
1585 :
1586 :
1587 288 : call report(iseq, keep)
1588 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array`.", int(__LINE__, IK))
1589 :
1590 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1591 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true.`.", int(__LINE__, IK))
1592 :
1593 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1594 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false.`.", int(__LINE__, IK))
1595 :
1596 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1597 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .true.`.", int(__LINE__, IK))
1598 :
1599 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1600 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .false.`.", int(__LINE__, IK))
1601 :
1602 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1603 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1604 :
1605 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1606 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1607 :
1608 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1609 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1610 :
1611 864 : instance = [1_IK]
1612 :
1613 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1614 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true.`.", int(__LINE__, IK))
1615 :
1616 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1617 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .false.`.", int(__LINE__, IK))
1618 :
1619 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1620 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty, and sensible, with `unique = .true.`.", int(__LINE__, IK))
1621 :
1622 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1623 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty, and sensible, with `unique = .false.`.", int(__LINE__, IK))
1624 :
1625 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1626 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1627 :
1628 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1629 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1630 :
1631 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1632 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with non-matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty, and sensible, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1633 :
1634 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1635 :
1636 288 : call reset()
1637 :
1638 : #if CVXK_ENABLED || PVXK_ENABLED
1639 60 : if (getOption(.false._LK, keep)) then
1640 120 : allocate(field_ref(5))
1641 : else
1642 160 : allocate(field_ref(3))
1643 : end if
1644 : #endif
1645 : #if SK_ENABLED && D1_D0_ENABLED
1646 168 : array = ["AA", "XX", "AA", "XX", "AA"]
1647 24 : sep = "XX"
1648 : #elif IK_ENABLED && D1_D0_ENABLED
1649 504 : array = [1_IKC, 0_IKC, 1_IKC, 0_IKC, 1_IKC]
1650 72 : sep = 0_IKC
1651 : #elif LK_ENABLED && D1_D0_ENABLED
1652 504 : array = [.false._LK, .true._LK, .false._LK, .true._LK, .false._LK]
1653 72 : sep = .true._LK
1654 : #elif CK_ENABLED && D1_D0_ENABLED
1655 420 : array = [(1._CKC,-1._CKC), (0._CKC,0._CKC), (1._CKC,-1._CKC), (0._CKC,0._CKC), (1._CKC,-1._CKC)]
1656 60 : sep = (0._CKC,0._CKC)
1657 : #elif RK_ENABLED && D1_D0_ENABLED
1658 420 : array = [1._RKC, 0._RKC, 1._RKC, 0._RKC, 1._RKC]
1659 60 : sep = 0._RKC
1660 : #endif
1661 : #if CVXK_ENABLED || PVXK_ENABLED
1662 60 : if (getOption(.false._LK, keep)) then
1663 60 : field_ref(1)%val = array(1:1)
1664 60 : field_ref(2)%val = [sep]
1665 60 : field_ref(3)%val = array(3:3)
1666 60 : field_ref(4)%val = [sep]
1667 60 : field_ref(5)%val = array(5:5)
1668 : else
1669 120 : field_ref(1)%val = array(1:1)
1670 120 : field_ref(2)%val = array(3:3)
1671 120 : field_ref(3)%val = array(5:5)
1672 : end if
1673 : #endif
1674 288 : if (getOption(.false._LK, keep)) then
1675 96 : allocate(sindex_ref(2,5))
1676 96 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 1
1677 96 : sindex_ref(1,2) = 2; sindex_ref(2,2) = 2
1678 96 : sindex_ref(1,3) = 3; sindex_ref(2,3) = 3
1679 96 : sindex_ref(1,4) = 4; sindex_ref(2,4) = 4
1680 96 : sindex_ref(1,5) = 5; sindex_ref(2,5) = 5
1681 : else
1682 192 : allocate(sindex_ref(2,3))
1683 192 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 1
1684 192 : sindex_ref(1,2) = 3; sindex_ref(2,2) = 3
1685 192 : sindex_ref(1,3) = 5; sindex_ref(2,3) = 5
1686 : end if
1687 :
1688 1152 : instance = [1_IK, -1_IK]
1689 :
1690 288 : call report(iseq, keep)
1691 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with two `sep` occurrences must yield an `field` of size three whose three components are the non-matching elements of `array`.", int(__LINE__, IK))
1692 :
1693 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1694 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with two `sep` occurrences must yield an `field` of size three whose three components are the non-matching elements of `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true.`.", int(__LINE__, IK))
1695 :
1696 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1697 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with two `sep` occurrences must yield an `field` of size three whose three components are the non-matching elements of `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false.`.", int(__LINE__, IK))
1698 :
1699 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1700 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with two `sep` occurrences must yield an `field` of size three whose three components are the non-matching elements of `array` when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .true.`.", int(__LINE__, IK))
1701 :
1702 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1703 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with two `sep` occurrences must yield an `field` of size three whose three components are the non-matching elements of `array` when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .false.`.", int(__LINE__, IK))
1704 :
1705 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1706 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with two `sep` occurrences must yield an `field` of size three whose three components are the non-matching elements of `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1707 :
1708 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1709 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with two `sep` occurrences must yield an `field` of size three whose three components are the non-matching elements of `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1710 :
1711 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1712 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with two `sep` occurrences must yield an `field` of size three whose three components are the non-matching elements of `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1713 :
1714 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1715 :
1716 288 : call reset()
1717 :
1718 : #if CVXK_ENABLED || PVXK_ENABLED
1719 132 : allocate(field_ref(1))
1720 : #endif
1721 : #if SK_ENABLED && D1_D0_ENABLED
1722 96 : array = ["AA", "AA"]
1723 24 : sep = "AA"
1724 : #elif IK_ENABLED && D1_D0_ENABLED
1725 288 : array = [1_IKC, 1_IKC]
1726 72 : sep = 1_IKC
1727 : #elif LK_ENABLED && D1_D0_ENABLED
1728 288 : array = [.false._LK, .false._LK]
1729 72 : sep = .false._LK
1730 : #elif CK_ENABLED && D1_D0_ENABLED
1731 240 : array = [(1._CKC,-1._CKC), (1._CKC,-1._CKC)]
1732 60 : sep = (1._CKC,-1._CKC)
1733 : #elif RK_ENABLED && D1_D0_ENABLED
1734 240 : array = [1._RKC, 1._RKC]
1735 60 : sep = 1._RKC
1736 : #endif
1737 1152 : instance = [0_IK, 3_IK]
1738 : #if CVXK_ENABLED || PVXK_ENABLED
1739 300 : field_ref(1)%val = array
1740 : #endif
1741 288 : allocate(sindex_ref(2,1))
1742 288 : sindex_ref(1,1) = 1; sindex_ref(2,1) = 2
1743 :
1744 288 : call report(iseq, keep, instance = instance, sorted = .true._LK)
1745 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true.`.", int(__LINE__, IK))
1746 :
1747 288 : call report(iseq, keep, instance = instance, sorted = .false._LK)
1748 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false.`.", int(__LINE__, IK))
1749 :
1750 288 : call report(iseq, keep, instance = instance, unique = .true._LK)
1751 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .true.`.", int(__LINE__, IK))
1752 :
1753 288 : call report(iseq, keep, instance = instance, unique = .false._LK)
1754 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `unique = .false.`.", int(__LINE__, IK))
1755 :
1756 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .false._LK)
1757 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .false.`.", int(__LINE__, IK))
1758 :
1759 288 : call report(iseq, keep, instance = instance, sorted = .true._LK, unique = .true._LK)
1760 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .true._LK, unique = .true.`.", int(__LINE__, IK))
1761 :
1762 288 : call report(iseq, keep, instance = instance, sorted = .false._LK, unique = .false._LK)
1763 288 : call test%assert(assertion, PROCEDURE_NAME//SK_": A non-empty `array` with a matching `sep` must yield an `field` of size one whose sole component is `array` when `instance` is ordered, unique, non-empty but non-sensible, with `sorted = .false._LK, unique = .false.`.", int(__LINE__, IK))
1764 :
1765 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1766 :
1767 288 : end subroutine
1768 :
1769 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1770 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1771 :
1772 : subroutine report ( iseq & ! LCOV_EXCL_LINE
1773 : , keep & ! LCOV_EXCL_LINE
1774 : , instance & ! LCOV_EXCL_LINE
1775 : , sorted & ! LCOV_EXCL_LINE
1776 : , unique & ! LCOV_EXCL_LINE
1777 : )
1778 : use pm_io, only: display_type
1779 : logical(LK) , external , optional :: iseq
1780 : logical(LK) , intent(in), optional :: keep
1781 : integer(IK) , intent(in), optional, contiguous :: instance(:)
1782 : logical(LK) , intent(in), optional :: sorted
1783 : logical(LK) , intent(in), optional :: unique
1784 40608 : type(display_type) :: disp
1785 :
1786 40608 : disp = display_type()
1787 :
1788 40608 : if (present(iseq) .and. present(instance) .and. present(sorted) .and. present(unique)) then
1789 7776 : call setSplit(sindex, array, sep, iseq = iseq, instance = instance, sorted = sorted, unique = unique, keep = keep)
1790 : #if CVXK_ENABLED || PVXK_ENABLED
1791 5360 : call setSplit(field, array, sep, iseq = iseq, instance = instance, sorted = sorted, unique = unique, keep = keep)
1792 : #endif
1793 32832 : elseif (present(iseq) .and. present(instance) .and. present(sorted) .and. .not. present(unique)) then
1794 5040 : call setSplit(sindex, array, sep, iseq = iseq, instance = instance, sorted = sorted, keep = keep)
1795 : #if CVXK_ENABLED || PVXK_ENABLED
1796 3370 : call setSplit(field, array, sep, iseq = iseq, instance = instance, sorted = sorted, keep = keep)
1797 : #endif
1798 27792 : elseif (present(iseq) .and. present(instance) .and. .not. present(sorted) .and. present(unique)) then
1799 4752 : call setSplit(sindex, array, sep, iseq = iseq, instance = instance, unique = unique, keep = keep)
1800 : #if CVXK_ENABLED || PVXK_ENABLED
1801 3220 : call setSplit(field, array, sep, iseq = iseq, instance = instance, unique = unique, keep = keep)
1802 : #endif
1803 23040 : elseif (present(iseq) .and. present(instance) .and. .not. present(sorted) .and. .not. present(unique)) then
1804 1440 : call setSplit(sindex, array, sep, iseq = iseq, instance = instance, keep = keep)
1805 : #if CVXK_ENABLED || PVXK_ENABLED
1806 880 : call setSplit(field, array, sep, iseq = iseq, instance = instance, keep = keep)
1807 : #endif
1808 22896 : elseif (present(iseq) .and. .not. present(instance) .and. .not. present(sorted) .and. .not. present(unique)) then
1809 1296 : call setSplit(sindex, array, sep, iseq = iseq, keep = keep)
1810 : #if CVXK_ENABLED || PVXK_ENABLED
1811 270 : call setSplit(field, array, sep, iseq = iseq, keep = keep)
1812 : #endif
1813 20304 : elseif (.not. present(iseq) .and. present(instance) .and. present(sorted) .and. present(unique)) then
1814 7776 : call setSplit(sindex, array, sep, instance = instance, sorted = sorted, unique = unique, keep = keep)
1815 : #if CVXK_ENABLED || PVXK_ENABLED
1816 5360 : call setSplit(field, array, sep, instance = instance, sorted = sorted, unique = unique, keep = keep)
1817 : #endif
1818 12528 : elseif (.not. present(iseq) .and. present(instance) .and. present(sorted) .and. .not. present(unique)) then
1819 5040 : call setSplit(sindex, array, sep, instance = instance, sorted = sorted, keep = keep)
1820 : #if CVXK_ENABLED || PVXK_ENABLED
1821 3370 : call setSplit(field, array, sep, instance = instance, sorted = sorted, keep = keep)
1822 : #endif
1823 7488 : elseif (.not. present(iseq) .and. present(instance) .and. .not. present(sorted) .and. present(unique)) then
1824 4752 : call setSplit(sindex, array, sep, instance = instance, unique = unique, keep = keep)
1825 : #if CVXK_ENABLED || PVXK_ENABLED
1826 3220 : call setSplit(field, array, sep, instance = instance, unique = unique, keep = keep)
1827 : #endif
1828 2736 : elseif (.not. present(iseq) .and. present(instance) .and. .not. present(sorted) .and. .not. present(unique)) then
1829 1440 : call setSplit(sindex, array, sep, instance = instance, keep = keep)
1830 : #if CVXK_ENABLED || PVXK_ENABLED
1831 880 : call setSplit(field, array, sep, instance = instance, keep = keep)
1832 : #endif
1833 2592 : elseif (.not. present(iseq) .and. .not. present(instance) .and. .not. present(sorted) .and. .not. present(unique)) then
1834 1296 : call setSplit(sindex, array, sep, keep = keep)
1835 : #if CVXK_ENABLED || PVXK_ENABLED
1836 270 : call setSplit(field, array, sep, keep = keep)
1837 : #endif
1838 : else
1839 : error stop PROCEDURE_NAME//SK_": Unrecognized interface in testing." ! LCOV_EXCL_LINE
1840 : end if
1841 :
1842 : !block
1843 : !use pm_io, only: display_type
1844 : !type(display_type) :: disp
1845 : !call disp%show("present(keep)")
1846 : !call disp%show( present(keep) )
1847 : !call disp%show("getOption(.false._LK, keep)")
1848 : !call disp%show( getOption(.false._LK, keep) )
1849 : !call disp%show("field")
1850 : !call disp%show( field )
1851 : !call disp%show("field_ref")
1852 : !call disp%show( field_ref )
1853 : !end block
1854 :
1855 : ! Report test results if needed.
1856 :
1857 : #if CVXK_ENABLED || PVXK_ENABLED
1858 : block
1859 : integer(IK) :: isplit
1860 28600 : do isplit = 1_IK, size(field_ref, kind = IK)
1861 39260 : assertion = assertion .and. ALL(field(isplit)%val IS_EQUAL field_ref(isplit)%val) ! fpp
1862 : end do
1863 : end block
1864 : #endif
1865 330624 : assertion = assertion .and. all(sindex == sindex_ref)
1866 40608 : if (test%traceable .and. .not. assertion) then
1867 :
1868 : ! LCOV_EXCL_START
1869 : write(test%disp%unit,"(*(g0,:,', '))")
1870 :
1871 : call disp%show("sep")
1872 : call disp%show( sep )
1873 : call disp%show("array")
1874 : call disp%show( array )
1875 : #if CVXK_ENABLED || PVXK_ENABLED
1876 : call disp%show("field")
1877 : call disp%show( field )
1878 : call disp%show("field_ref")
1879 : call disp%show( field_ref )
1880 : #endif
1881 : call disp%show("sindex")
1882 : call disp%show( sindex )
1883 : call disp%show("sindex_ref")
1884 : call disp%show( sindex_ref )
1885 : write(test%disp%unit,"(*(g0,:,', '))") "present(instance) ", present(instance)
1886 : write(test%disp%unit,"(*(g0,:,', '))") "present(unique) ", present(unique)
1887 : write(test%disp%unit,"(*(g0,:,', '))") "present(sorted) ", present(sorted)
1888 : write(test%disp%unit,"(*(g0,:,', '))") "present(iseq) ", present(iseq)
1889 :
1890 : if (present(instance)) then
1891 : write(test%disp%unit,"(*(g0,:,', '))") "instance ", instance
1892 : end if
1893 :
1894 : if (present(sorted)) then
1895 : write(test%disp%unit,"(*(g0,:,', '))") "sorted ", sorted
1896 : end if
1897 :
1898 : if (present(unique)) then
1899 : write(test%disp%unit,"(*(g0,:,', '))") "unique ", unique
1900 : end if
1901 :
1902 : write(test%disp%unit,"(*(g0,:,', '))")
1903 : ! LCOV_EXCL_STOP
1904 :
1905 : end if
1906 :
1907 40608 : end subroutine
1908 :
1909 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1910 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1911 :
1912 : #undef IS_EQUAL
1913 : #undef ALL
|
