Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This file contains procedure implementations of [pm_matrixIndex](@ref pm_matrixIndex).
19 : !>
20 : !> \finmain
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : #if !getMatIndex_ENABLED
28 : #error "Unrecognized interface."
29 : #endif
30 :
31 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
32 : #if AIO_ENABLED && (UXD_ENABLED || XLD_ENABLED) && (LFP_RDP_ENABLED || RDP_LFP_ENABLED)
33 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
34 :
35 : integer(IK) :: ndim, doffAbs
36 19779 : CHECK_ASSERTION(__LINE__, all(0_IK <= shape), \
37 : SK_"@getMatIndex(): The condition `all(0_IK <= shape)` must hold. shape, doff = "//getStr(shape))
38 19761 : CHECK_ASSERTION(__LINE__, all([0_IK < sindex]), SK_"@getMatIndex(): The condition `all([0 < sindex])` must hold. sindex = "//getStr(sindex))
39 6593 : if (present(doff)) then
40 : #if UXD_ENABLED
41 7 : doffAbs = -doff
42 42 : CHECK_ASSERTION(__LINE__, 0_IK <= shape(1) + doff .and. doff <= 0_IK, \
43 : SK_"@getMatIndex(): The condition `0 <= shape(1) + doff .and. doff <= 0` must hold. shape, doff = "//getStr([shape, doff]))
44 : #elif XLD_ENABLED
45 9 : doffAbs = doff
46 54 : CHECK_ASSERTION(__LINE__, 0_IK <= shape(2) - doff .and. 0_IK <= doff, \
47 : SK_"@getMatIndex(): The condition `0 <= shape(2) - doff .and. 0 <= doff` must hold. shape, doff = "//getStr([shape, doff]))
48 : #else
49 : #error "Unrecognized interface."
50 : #endif
51 : else
52 : doffAbs = 0_IK
53 : end if
54 : #if LFP_RDP_ENABLED && UXD_ENABLED
55 3283 : ndim = min(sindex(2), shape(1) - doffAbs) ! the effective triangle rank.
56 19698 : CHECK_ASSERTION(__LINE__, sindex(1) <= sindex(2) + doffAbs, \
57 : SK_"@getMatIndex(): The condition `sindex(1) <= sindex(2) - doff` must hold. sindex, doff = "//getStr([sindex, -doffAbs]))
58 39396 : CHECK_ASSERTION(__LINE__, all(sindex <= shape), \
59 : SK_"@getMatIndex(): The condition `all(sindex <= shape)` must hold. sindex, shape = "//getStr([sindex, shape]))
60 : dindex & ! LCOV_EXCL_LINE
61 : = sindex(2) * doffAbs & ! The top rectangle ! LCOV_EXCL_LINE
62 : + ndim * (ndim - 1_IK) / 2_IK & ! the bottom upper triangle ! LCOV_EXCL_LINE
63 : + (sindex(2) - ndim) * ndim & ! The rightmost rectangle. ! LCOV_EXCL_LINE
64 3283 : + sindex(1) - doffAbs ! last column.
65 : #elif LFP_RDP_ENABLED && XLD_ENABLED
66 : ndim = shape(2) - doffAbs ! empty triangle rank.
67 19806 : CHECK_ASSERTION(__LINE__, sindex(2) <= sindex(1) + doffAbs, \
68 : SK_"@getMatIndex(): The condition `sindex(2) <= sindex(1) + doff` must hold. sindex, doff = "//getStr([sindex, doffAbs]))
69 39612 : CHECK_ASSERTION(__LINE__, all(sindex <= shape), \
70 : SK_"@getMatIndex(): The condition `all(sindex <= shape)` must hold. sindex, shape = "//getStr([sindex, shape]))
71 : block
72 : integer(IK) :: jcol
73 3301 : jcol = max(0_IK, sindex(2) - doffAbs - 1_IK)
74 : dindex & ! LCOV_EXCL_LINE
75 : = shape(1) * max(0_IK, sindex(2) - 1_IK) & ! The leftmost full rectangle. ! LCOV_EXCL_LINE
76 : - jcol * (jcol - 1_IK) / 2_IK & ! The empty upper triangle. ! LCOV_EXCL_LINE
77 3301 : + sindex(1) - jcol
78 : end block
79 : #elif RDP_LFP_ENABLED && UXD_ENABLED
80 : #define NDIM min(shape(2), shape(1) - doffAbs)
81 36 : CHECK_ASSERTION(__LINE__, sindex <= product(shape) - NDIM * (NDIM - 1_IK) / 2_IK, \
82 : SK_"@getMatIndex(): The condition `sindex <= product(shape) - NDIM * (NDIM - 1) / 2` must hold. sindex, shape, NDIM = "\
83 : //getStr([sindex, shape, NDIM]))
84 : #undef NDIM
85 4 : dindex(1) = sindex
86 4 : dindex(2) = 1_IK
87 10 : do
88 14 : ndim = min(shape(1), dindex(2) + doffAbs)
89 14 : if (dindex(1) - ndim <= 0_IK) exit
90 10 : dindex(1) = dindex(1) - ndim
91 10 : dindex(2) = dindex(2) + 1_IK
92 : end do
93 : #elif RDP_LFP_ENABLED && XLD_ENABLED
94 5 : ndim = shape(2) - doffAbs
95 45 : CHECK_ASSERTION(__LINE__, sindex <= product(shape) - ndim * (ndim - 1_IK) / 2_IK, \
96 : SK_"@getMatIndex(): The condition `sindex <= product(shape) - ndim * (ndim - 1) / 2` must hold. sindex, shape, ndim = "\
97 : //getStr([sindex, shape, ndim]))
98 5 : dindex(1) = sindex
99 5 : dindex(2) = 1_IK
100 8 : do
101 13 : if (doffAbs < dindex(2)) exit
102 9 : if (dindex(1) - shape(1) <= 0_IK) exit
103 8 : dindex(1) = dindex(1) - shape(1)
104 9 : dindex(2) = dindex(2) + 1_IK
105 : end do
106 5 : ndim = shape(1)
107 5 : do
108 10 : if (dindex(1) - ndim <= 0_IK) then
109 5 : dindex(1) = dindex(1) + shape(1) - ndim
110 : exit
111 : end if
112 5 : dindex(1) = dindex(1) - ndim
113 5 : dindex(2) = dindex(2) + 1_IK
114 5 : ndim = ndim - 1_IK
115 5 : CHECK_ASSERTION(__LINE__, \
116 : 0_IK <= ndim, SK_"@getMatIndex(): Internal error occurred. The condition `0 <= ndim` must hold. ndim = "//getStr(ndim))
117 : end do
118 : #else
119 : #error "Unrecognized interface."
120 : #endif
121 :
122 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
123 : #elif AIO_ENABLED && UXD_ENABLED && RFP_RDP_ENABLED
124 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
125 :
126 : integer(IK) :: ndim, ndimHalf
127 24 : CHECK_ASSERTION(__LINE__, all(0_IK <= shape), \
128 : SK_"@getMatIndex(): The condition `all(0_IK <= shape)` must hold. shape, doff = "//getStr(shape))
129 8 : ndim = shape(1)
130 8 : ndimHalf = ndim / 2_IK
131 8 : CHECK_ASSERTION(__LINE__, shape(1) == shape(2), \
132 : SK_"@getMatIndex(): The condition `shape(1) == shape(2)` must hold. shape = "//getStr(shape))
133 8 : CHECK_ASSERTION(__LINE__, 1_IK <= sindex(1) .and. sindex(1) <= sindex(2), \
134 : SK_"@getMatIndex(): The condition `1 <= sindex(1) .and. sindex(1) <= sindex(2)` must hold. sindex = "//getStr(sindex))
135 120 : CHECK_ASSERTION(__LINE__, all(0_IK < sindex) .and. all(sindex <= shape), \
136 : SK_"@getMatIndex(): The condition `all(0_IK < sindex) .and. all(sindex <= shape)` must hold. sindex, shape = "//getStr([sindex, shape]))
137 8 : if (sindex(2) <= ndimHalf) then
138 2 : dindex(1) = sindex(2) + ndimHalf + 1_IK
139 2 : dindex(2) = sindex(1)
140 : else
141 6 : dindex(1) = sindex(1)
142 6 : dindex(2) = sindex(2) - ndimHalf
143 : end if
144 :
145 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
146 : #elif AIO_ENABLED && UXD_ENABLED && RDP_RFP_ENABLED
147 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
148 :
149 : integer(IK) :: ndim, ndimHalf, remainder
150 24 : CHECK_ASSERTION(__LINE__, all(0_IK <= shape), \
151 : SK_"@getMatIndex(): The condition `all(0_IK <= shape)` must hold. shape, doff = "//getStr(shape))
152 8 : ndim = shape(1)
153 8 : ndimHalf = ndim / 2_IK
154 : remainder = ndim - ndimHalf * 2_IK
155 8 : CHECK_ASSERTION(__LINE__, shape(1) == shape(2), \
156 : SK_"@getMatIndex(): The condition `shape(1) == shape(2)` must hold. shape = "//getStr(shape))
157 8 : CHECK_ASSERTION(__LINE__, 1_IK <= sindex(2) .and. sindex(2) <= ndim + 1_IK - remainder, \
158 : SK_"@getMatIndex(): The condition `1 <= sindex(1) .and. sindex(1) <= ndim + 1 - mod(ndim, 2)` must hold. sindex = "//getStr(sindex))
159 8 : CHECK_ASSERTION(__LINE__, 1_IK <= sindex(1) .and. sindex(2) <= ndimHalf + remainder, \
160 : SK_"@getMatIndex(): The condition `1 <= sindex(2) .and. sindex(2) <= ndimHalf + mod(ndim, 2)` must hold. sindex = "//getStr(sindex))
161 8 : if (sindex(1) - sindex(2) <= ndimHalf) then
162 6 : dindex(1) = sindex(1)
163 6 : dindex(2) = sindex(2) + ndimHalf
164 : else
165 2 : dindex(1) = sindex(2)
166 2 : dindex(2) = sindex(1) - ndimHalf - 1_IK
167 : end if
168 :
169 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
170 : #elif AIO_ENABLED && XLD_ENABLED && RFP_RDP_ENABLED
171 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
172 :
173 : integer(IK) :: ndim, ndimHalf
174 8 : ndim = shape(1)
175 8 : ndimHalf = (ndim + 1_IK) / 2_IK
176 24 : CHECK_ASSERTION(__LINE__, all(0_IK <= shape), \
177 : SK_"@getMatIndex(): The condition `all(0_IK <= shape)` must hold. shape, doff = "//getStr(shape))
178 8 : CHECK_ASSERTION(__LINE__, shape(1) == shape(2), \
179 : SK_"@getMatIndex(): The condition `shape(1) == shape(2)` must hold. shape = "//getStr(shape))
180 8 : CHECK_ASSERTION(__LINE__, 1_IK <= sindex(2) .and. sindex(2) <= sindex(1), \
181 : SK_"@getMatIndex(): The condition `1 <= sindex(2) .and. sindex(2) <= sindex(1)` must hold. sindex = "//getStr(sindex))
182 120 : CHECK_ASSERTION(__LINE__, all(0_IK < sindex) .and. all(sindex <= shape), \
183 : SK_"@getMatIndex(): The condition `all(0_IK < sindex) .and. all(sindex <= shape)` must hold. sindex, shape = "//getStr([sindex, shape]))
184 8 : if (sindex(2) <= ndimHalf) then
185 4 : if (ndim < ndimHalf * 2_IK) then ! odd `ndim`.
186 2 : dindex(1) = sindex(1)
187 : else ! even
188 2 : dindex(1) = sindex(1) + 1_IK
189 : end if
190 4 : dindex(2) = sindex(2)
191 : else
192 4 : if (ndim < ndimHalf * 2_IK) then ! odd `ndim`.
193 2 : dindex(1) = sindex(2) - ndimHalf
194 2 : dindex(2) = sindex(1) - ndimHalf + 1_IK
195 : else ! even
196 2 : dindex(1) = sindex(2) - ndimHalf
197 2 : dindex(2) = sindex(1) - ndimHalf
198 : end if
199 : end if
200 :
201 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
202 : #elif AIO_ENABLED && XLD_ENABLED && RDP_RFP_ENABLED
203 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
204 :
205 : integer(IK) :: ndim, ndimHalf, remainder
206 24 : CHECK_ASSERTION(__LINE__, all(0_IK <= shape), \
207 : SK_"@getMatIndex(): The condition `all(0_IK <= shape)` must hold. shape, doff = "//getStr(shape))
208 8 : ndim = shape(1)
209 8 : ndimHalf = ndim / 2_IK
210 : remainder = ndim - ndimHalf * 2_IK
211 8 : CHECK_ASSERTION(__LINE__, shape(1) == shape(2), \
212 : SK_"@getMatIndex(): The condition `shape(1) == shape(2)` must hold. shape = "//getStr(shape))
213 8 : CHECK_ASSERTION(__LINE__, 1_IK <= sindex(2) .and. sindex(2) <= ndim + 1_IK - remainder, \
214 : SK_"@getMatIndex(): The condition `1 <= sindex(1) .and. sindex(1) <= ndim + 1 - mod(ndim, 2)` must hold. sindex = "//getStr(sindex))
215 8 : CHECK_ASSERTION(__LINE__, 1_IK <= sindex(1) .and. sindex(2) <= ndimHalf + remainder, \
216 : SK_"@getMatIndex(): The condition `1 <= sindex(2) .and. sindex(2) <= ndimHalf + mod(ndim, 2)` must hold. sindex = "//getStr(sindex))
217 8 : if (sindex(2) - sindex(1) < remainder) then
218 4 : dindex(1) = sindex(1) + remainder - 1_IK
219 4 : dindex(2) = sindex(2)
220 : else
221 4 : dindex(1) = sindex(2) + ndimHalf
222 4 : dindex(2) = sindex(1) + ndimHalf + remainder
223 : end if
224 :
225 : #else
226 : !%%%%%%%%%%%%%%%%%%%%%%%%
227 : #error "Unrecognized interface."
228 : !%%%%%%%%%%%%%%%%%%%%%%%%
229 : #endif
|
