Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : #:include 'cp_array_utils.fypp'
9 :
10 : ! **************************************************************************************************
11 : !> \brief various utilities that regard array of different kinds:
12 : !> output, allocation,...
13 : !> maybe it is not a good idea mixing output and memeory utils...
14 : !> \par History
15 : !> 12.2001 first version [fawzi]
16 : !> 3.2002 templatized [fawzi]
17 : !> \author Fawzi Mohamed
18 : ! **************************************************************************************************
19 : MODULE cp_array_utils
20 : USE machine, ONLY: m_flush
21 : USE cp_log_handling, ONLY: cp_to_string
22 :
23 : USE kinds, ONLY: ${uselist(usekinds)}$
24 :
25 : #include "../base/base_uses.f90"
26 : IMPLICIT NONE
27 : PRIVATE
28 :
29 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
30 : CHARACTER(len=*), PRIVATE, PARAMETER :: moduleN = 'cp_array_utils'
31 :
32 : #:for nametype in nametype1
33 : PUBLIC :: cp_1d_${nametype}$_p_type, &
34 : cp_2d_${nametype}$_p_type, &
35 : cp_3d_${nametype}$_p_type, &
36 : cp_1d_${nametype}$_cp_type, &
37 : cp_2d_${nametype}$_cp_type, &
38 : cp_3d_${nametype}$_cp_type, &
39 : cp_1d_${nametype}$_guarantee_size, &
40 : cp_1d_${nametype}$_write, &
41 : cp_2d_${nametype}$_write, &
42 : cp_2d_${nametype}$_guarantee_size, &
43 : cp_1d_${nametype}$_bsearch
44 : #:endfor
45 :
46 : ! generic interfaces
47 : PUBLIC :: cp_guarantee_size
48 :
49 : INTERFACE cp_guarantee_size
50 : #:for nametype in nametype1
51 : MODULE PROCEDURE cp_1d_${nametype}$_guarantee_size, &
52 : cp_2d_${nametype}$_guarantee_size
53 : #:endfor
54 : END INTERFACE
55 :
56 : !***
57 :
58 : #:for nametype1, type1, defaultFormatType1, lessQ in inst_params
59 :
60 : ! **************************************************************************************************
61 : !> \brief represent a pointer to a 1d array
62 : !> \par History
63 : !> 02.2003 created [fawzi]
64 : !> \author fawzi
65 : ! **************************************************************************************************
66 : type cp_1d_${nametype1}$_p_type
67 : ${type1}$, dimension(:), pointer :: array => NULL()
68 : end type cp_1d_${nametype1}$_p_type
69 :
70 : ! **************************************************************************************************
71 : !> \brief represent a pointer to a 2d array
72 : !> \par History
73 : !> 02.2003 created [fawzi]
74 : !> \author fawzi
75 : ! **************************************************************************************************
76 : type cp_2d_${nametype1}$_p_type
77 : ${type1}$, dimension(:, :), pointer :: array => NULL()
78 : end type cp_2d_${nametype1}$_p_type
79 :
80 : ! **************************************************************************************************
81 : !> \brief represent a pointer to a 3d array
82 : !> \par History
83 : !> 02.2003 created [fawzi]
84 : !> \author fawzi
85 : ! **************************************************************************************************
86 : type cp_3d_${nametype1}$_p_type
87 : ${type1}$, dimension(:, :, :), pointer :: array => NULL()
88 : end type cp_3d_${nametype1}$_p_type
89 :
90 : ! **************************************************************************************************
91 : !> \brief represent a pointer to a contiguous 1d array
92 : !> \par History
93 : !> 02.2003 created [fawzi]
94 : !> \author fawzi
95 : ! **************************************************************************************************
96 : type cp_1d_${nametype1}$_cp_type
97 : ${type1}$, dimension(:), contiguous, pointer :: array => NULL()
98 : end type cp_1d_${nametype1}$_cp_type
99 :
100 : ! **************************************************************************************************
101 : !> \brief represent a pointer to a contiguous 2d array
102 : !> \par History
103 : !> 02.2003 created [fawzi]
104 : !> \author fawzi
105 : ! **************************************************************************************************
106 : type cp_2d_${nametype1}$_cp_type
107 : ${type1}$, dimension(:, :), contiguous, pointer :: array => NULL()
108 : end type cp_2d_${nametype1}$_cp_type
109 :
110 : ! **************************************************************************************************
111 : !> \brief represent a pointer to a contiguous 3d array
112 : !> \par History
113 : !> 02.2003 created [fawzi]
114 : !> \author fawzi
115 : ! **************************************************************************************************
116 : type cp_3d_${nametype1}$_cp_type
117 : ${type1}$, dimension(:, :, :), contiguous, pointer :: array => NULL()
118 : end type cp_3d_${nametype1}$_cp_type
119 :
120 : #:endfor
121 :
122 : CONTAINS
123 :
124 : #:for nametype1, type1, defaultFormatType1, lessQ in inst_params
125 : ! **************************************************************************************************
126 : !> \brief writes an array to the given unit
127 : !> \param array the array to write
128 : !> \param unit_nr the unit to write to (defaults to the standard out)
129 : !> \param el_format the format of a single element
130 : !> \par History
131 : !> 4.2002 created [fawzi]
132 : !> \author Fawzi Mohamed
133 : !> \note
134 : !> maybe I will move to a comma separated paretized list
135 : ! **************************************************************************************************
136 348 : SUBROUTINE cp_1d_${nametype1}$_write(array, unit_nr, el_format)
137 : ${type1}$, INTENT(in) :: array(:)
138 : INTEGER, INTENT(in) :: unit_nr
139 : CHARACTER(len=*), INTENT(in), OPTIONAL :: el_format
140 :
141 : INTEGER :: iostat, i
142 : CHARACTER(len=*), PARAMETER :: defaultFormat = ${defaultFormatType1}$
143 :
144 348 : WRITE (unit=unit_nr, fmt="('( ')", advance="no", iostat=iostat)
145 348 : CPASSERT(iostat == 0)
146 348 : IF (PRESENT(el_format)) THEN
147 0 : DO i = 1, SIZE(array) - 1
148 0 : WRITE (unit=unit_nr, fmt=el_format, advance="no") array(i)
149 0 : IF (MOD(i, 5) == 0) THEN ! only a few elements per line
150 0 : WRITE (unit=unit_nr, fmt="(',')")
151 : ELSE
152 0 : WRITE (unit=unit_nr, fmt="(',')", advance="no")
153 : END IF
154 : END DO
155 0 : IF (SIZE(array) > 0) THEN
156 0 : WRITE (unit=unit_nr, fmt=el_format, advance="no") array(SIZE(array))
157 : END IF
158 : ELSE
159 1044 : DO i = 1, SIZE(array) - 1
160 696 : WRITE (unit=unit_nr, fmt=defaultFormat, advance="no") array(i)
161 1044 : IF (MOD(i, 5) == 0) THEN ! only a few elements per line
162 96 : WRITE (unit=unit_nr, fmt="(',')")
163 : ELSE
164 600 : WRITE (unit=unit_nr, fmt="(',')", advance="no")
165 : END IF
166 : END DO
167 348 : IF (SIZE(array) > 0) THEN
168 298 : WRITE (unit=unit_nr, fmt=defaultFormat, advance="no") array(SIZE(array))
169 : END IF
170 : END IF
171 348 : WRITE (unit=unit_nr, fmt="(' )')")
172 348 : call m_flush(unit_nr)
173 :
174 348 : END SUBROUTINE cp_1d_${nametype1}$_write
175 :
176 : ! **************************************************************************************************
177 : !> \brief writes an array to the given unit
178 : !> \param array the array to write
179 : !> \param unit_nr the unit to write to (defaults to the standard out)
180 : !> \param el_format the format of a single element
181 : !> \par History
182 : !> 4.2002 created [fawzi]
183 : !> \author Fawzi Mohamed
184 : !> \note
185 : !> maybe I will move to a comma separated parentized list
186 : ! **************************************************************************************************
187 98 : SUBROUTINE cp_2d_${nametype1}$_write(array, unit_nr, el_format)
188 : ${type1}$, INTENT(in) :: array(:, :)
189 : INTEGER, INTENT(in) :: unit_nr
190 : CHARACTER(len=*), INTENT(in), OPTIONAL :: el_format
191 :
192 : INTEGER :: iostat, i
193 : CHARACTER(len=*), PARAMETER :: defaultFormat = ${defaultFormatType1}$
194 : CHARACTER(len=200) :: fmtstr
195 : CHARACTER(len=25) :: nRiga
196 :
197 98 : nRiga = cp_to_string(SIZE(array, 2))
198 290 : DO i = 1, SIZE(array, 1)
199 192 : IF (PRESENT(el_format)) THEN
200 0 : fmtstr = '(" ",'//nRiga//el_format//')'
201 0 : WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
202 : ELSE
203 192 : fmtstr = '(" ",'//nRiga//defaultFormat//')'
204 192 : WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
205 : END IF
206 290 : CPASSERT(iostat == 0)
207 : END DO
208 98 : call m_flush(unit_nr)
209 98 : END SUBROUTINE cp_2d_${nametype1}$_write
210 :
211 : ! **************************************************************************************************
212 : !> \brief If the size of the array is changes reallocate it.
213 : !> Issues a warning when the size changes (but not on allocation
214 : !> and deallocation).
215 : !>
216 : !> The data is NOT preserved (if you want to preserve the data see
217 : !> the realloc in the module memory_utilities)
218 : !> \param array the array to reallocate if necessary
219 : !> \param n the wanted size
220 : !> \par History
221 : !> 12.2001 first version [fawzi]
222 : !> 3.2002 templatized [fawzi]
223 : !> \author Fawzi Mohamed
224 : !> \note
225 : !> this is a different behaviour than the realloc in the module
226 : !> memory_utilities. It is quite low level
227 : ! **************************************************************************************************
228 0 : SUBROUTINE cp_1d_${nametype1}$_guarantee_size(array, n)
229 : ${type1}$, POINTER :: array(:)
230 : INTEGER, INTENT(in) :: n
231 :
232 0 : CPASSERT(n >= 0)
233 0 : IF (ASSOCIATED(array)) THEN
234 0 : IF (SIZE(array) /= n) THEN
235 0 : CPWARN('size has changed')
236 0 : DEALLOCATE (array)
237 : END IF
238 : END IF
239 0 : IF (.NOT. ASSOCIATED(array)) THEN
240 0 : ALLOCATE (array(n))
241 : END IF
242 0 : END SUBROUTINE cp_1d_${nametype1}$_guarantee_size
243 :
244 : ! **************************************************************************************************
245 : !> \brief If the size of the array is changes reallocate it.
246 : !> Issues a warning when the size changes (but not on allocation
247 : !> and deallocation).
248 : !>
249 : !> The data is NOT preserved (if you want to preserve the data see
250 : !> the realloc in the module memory_utilities)
251 : !> \param array the array to reallocate if necessary
252 : !> \param n_rows the wanted number of rows
253 : !> \param n_cols the wanted number of cols
254 : !> \par History
255 : !> 5.2001 first version [fawzi]
256 : !> \author Fawzi Mohamed
257 : !> \note
258 : !> this is a different behaviour than the realloc in the module
259 : !> memory_utilities. It is quite low level
260 : ! **************************************************************************************************
261 0 : SUBROUTINE cp_2d_${nametype1}$_guarantee_size(array, n_rows, n_cols)
262 : ${type1}$, POINTER :: array(:, :)
263 : INTEGER, INTENT(in) :: n_rows, n_cols
264 :
265 0 : CPASSERT(n_cols >= 0)
266 0 : CPASSERT(n_rows >= 0)
267 0 : IF (ASSOCIATED(array)) THEN
268 0 : IF (SIZE(array, 1) /= n_rows .OR. SIZE(array, 2) /= n_cols) THEN
269 0 : CPWARN('size has changed')
270 0 : DEALLOCATE (array)
271 : END IF
272 : END IF
273 0 : IF (.NOT. ASSOCIATED(array)) THEN
274 0 : ALLOCATE (array(n_rows, n_cols))
275 : END IF
276 0 : END SUBROUTINE cp_2d_${nametype1}$_guarantee_size
277 :
278 : ! **************************************************************************************************
279 : !> \brief returns the index at which the element el should be inserted in the
280 : !> array to keep it ordered (array(i)>=el).
281 : !> If the element is bigger than all the elements in the array returns
282 : !> the last index+1.
283 : !> \param array the array to search
284 : !> \param el the element to look for
285 : !> \param l_index the lower index for binary search (defaults to 1)
286 : !> \param u_index the upper index for binary search (defaults to size(array))
287 : !> \return ...
288 : !> \par History
289 : !> 06.2003 created [fawzi]
290 : !> \author Fawzi Mohamed
291 : !> \note
292 : !> the array should be ordered in growing order
293 : ! **************************************************************************************************
294 0 : FUNCTION cp_1d_${nametype1}$_bsearch(array, el, l_index, u_index) result(res)
295 : ${type1}$, intent(in) :: array(:)
296 : ${type1}$, intent(in) :: el
297 : INTEGER, INTENT(in), OPTIONAL :: l_index, u_index
298 : integer :: res
299 :
300 : INTEGER :: lindex, uindex, aindex
301 :
302 0 : lindex = 1
303 0 : uindex = size(array)
304 0 : if (present(l_index)) lindex = l_index
305 0 : if (present(u_index)) uindex = u_index
306 0 : DO WHILE (lindex <= uindex)
307 0 : aindex = (lindex + uindex)/2
308 0 : IF (@{lessQ(array(aindex),el)}@) THEN
309 0 : lindex = aindex + 1
310 : ELSE
311 0 : uindex = aindex - 1
312 : END IF
313 : END DO
314 0 : res = lindex
315 0 : END FUNCTION cp_1d_${nametype1}$_bsearch
316 : #:endfor
317 :
318 0 : END MODULE cp_array_utils
|
