Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This include file contains procedure implementation of [pm_arrayVerbose](@ref pm_arrayVerbose).
19 : !>
20 : !> \finmain
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, Saturday 1:30 AM, August 20, 2016, Institute for Computational Engineering and Sciences, UT Austin, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : #if CHECK_ENABLED
28 : #define CHECK_SUM_WEIGHT(LINE) \
29 : CHECK_ASSERTION(LINE, weisum == sum(weight, mask = weight > 0_IK), \
30 : SK_"The condition `weisum == sum(weight, mask = weight > 0_IK)` must hold: "//\
31 : getStr([weisum, sum(weight, mask = weight > 0_IK)]))
32 : #else
33 : #define CHECK_SUM_WEIGHT(LINE)
34 : #endif
35 : ! Define indexing style.
36 : #if D0_ENABLED && SK_ENABLED
37 : #define GET_INDEX(i) i:i
38 : #define GET_SIZE len
39 : #elif D1_ENABLED || D2_ENABLED
40 : #define GET_INDEX(i) i
41 : #define GET_SIZE size
42 : #else
43 : #error "Unrecognized interface."
44 : #endif
45 : !%%%%%%%%%%%%%%%%%
46 : #if getVerbose_ENABLED
47 : !%%%%%%%%%%%%%%%%%
48 :
49 : integer(IK) :: ipnt, iweight, counter
50 : #if D0_ENABLED || D1_ENABLED
51 4633 : CHECK_SUM_WEIGHT(__LINE__) ! fpp
52 1155 : CHECK_ASSERTION(__LINE__, size(weight) == GET_SIZE(array), \
53 : SK_"@getVerbose(): The size of `weight` must equal the size of `array`. size(array), size(weight) = "//\
54 : getStr([GET_SIZE(array), size(weight)])) ! fpp
55 : counter = 0_IK
56 2124 : do ipnt = 1_IK, GET_SIZE(array, kind = IK)
57 9499 : do iweight = 1_IK, weight(ipnt)
58 7375 : counter = counter + 1_IK
59 9114 : verbose(GET_INDEX(counter)) = array(GET_INDEX(ipnt))
60 : end do
61 : end do
62 : #elif D2_ENABLED
63 : integer(IK) :: ndim, npnt
64 3101 : CHECK_SUM_WEIGHT(__LINE__) ! fpp
65 349 : CHECK_ASSERTION(__LINE__, dim == 1_IK .or. dim == 2_IK, SK_"@getVerbose(): The input `dim` must be either 1 or 2. dim = "//getStr(dim)) ! fpp
66 1396 : CHECK_ASSERTION(__LINE__, size(weight) == size(array, dim), SK_"@getVerbose(): The size of `weight` must equal the size of `array` along dimension `dim`. dim, size(array, dim), size(weight) = "//\
67 : getStr([dim, size(array, dim, IK), size(weight, 1, IK)])) ! fpp
68 349 : ndim = size(array, 3 - dim, IK)
69 349 : npnt = size(array, dim, IK)
70 349 : if (dim == 2_IK) then
71 : counter = 0_IK
72 980 : do ipnt = 1_IK, npnt
73 3892 : do iweight = 1_IK, weight(ipnt)
74 2912 : counter = counter + 1_IK
75 10085 : verbose(1:ndim, counter) = array(1:ndim,ipnt)
76 : end do
77 : end do
78 122 : elseif (dim == 1_IK) then
79 : ! \todo The memory access pattern can be improved by iterating over 1:ndim.
80 : counter = 0_IK
81 396 : do ipnt = 1_IK, npnt
82 1238 : do iweight = 1_IK, weight(ipnt)
83 842 : counter = counter + 1_IK
84 3685 : verbose(counter, 1:ndim) = array(ipnt, 1:ndim)
85 : end do
86 : end do
87 : end if
88 : #endif
89 : #else
90 : !%%%%%%%%%%%%%%%%%%%%%%%%
91 : #error "Unrecognized interface."
92 : !%%%%%%%%%%%%%%%%%%%%%%%%
93 : #endif
94 : #undef CHECK_SUM_WEIGHT
95 : #undef GET_INDEX
96 : #undef GET_SIZE
|