Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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 216 : 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 216 : WRITE (unit=unit_nr, fmt="('( ')", advance="no", iostat=iostat)
145 216 : CPASSERT(iostat == 0)
146 216 : 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) .EQ. 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) &
156 0 : WRITE (unit=unit_nr, fmt=el_format, advance="no") array(SIZE(array))
157 : ELSE
158 807 : DO i = 1, SIZE(array) - 1
159 591 : WRITE (unit=unit_nr, fmt=defaultFormat, advance="no") array(i)
160 807 : IF (MOD(i, 5) .EQ. 0) THEN ! only a few elements per line
161 88 : WRITE (unit=unit_nr, fmt="(',')")
162 : ELSE
163 503 : WRITE (unit=unit_nr, fmt="(',')", advance="no")
164 : END IF
165 : END DO
166 216 : IF (SIZE(array) > 0) &
167 190 : WRITE (unit=unit_nr, fmt=defaultFormat, advance="no") array(SIZE(array))
168 : END IF
169 216 : WRITE (unit=unit_nr, fmt="(' )')")
170 216 : call m_flush(unit_nr)
171 :
172 216 : END SUBROUTINE cp_1d_${nametype1}$_write
173 :
174 : ! **************************************************************************************************
175 : !> \brief writes an array to the given unit
176 : !> \param array the array to write
177 : !> \param unit_nr the unit to write to (defaults to the standard out)
178 : !> \param el_format the format of a single element
179 : !> \par History
180 : !> 4.2002 created [fawzi]
181 : !> \author Fawzi Mohamed
182 : !> \note
183 : !> maybe I will move to a comma separated parentized list
184 : ! **************************************************************************************************
185 70 : SUBROUTINE cp_2d_${nametype1}$_write(array, unit_nr, el_format)
186 : ${type1}$, INTENT(in) :: array(:, :)
187 : INTEGER, INTENT(in) :: unit_nr
188 : CHARACTER(len=*), INTENT(in), OPTIONAL :: el_format
189 :
190 : INTEGER :: iostat, i
191 : CHARACTER(len=*), PARAMETER :: defaultFormat = ${defaultFormatType1}$
192 : CHARACTER(len=200) :: fmtstr
193 : CHARACTER(len=10) :: nRiga
194 :
195 70 : nRiga = cp_to_string(SIZE(array, 2))
196 206 : DO i = 1, SIZE(array, 1)
197 136 : IF (PRESENT(el_format)) THEN
198 0 : fmtstr = '(" ",'//nRiga//el_format//')'
199 0 : WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
200 : ELSE
201 136 : fmtstr = '(" ",'//nRiga//defaultFormat//')'
202 136 : WRITE (unit=unit_nr, fmt=fmtstr, iostat=iostat) array(i, :)
203 : END IF
204 206 : CPASSERT(iostat == 0)
205 : END DO
206 70 : call m_flush(unit_nr)
207 70 : END SUBROUTINE cp_2d_${nametype1}$_write
208 :
209 : ! **************************************************************************************************
210 : !> \brief If the size of the array is changes reallocate it.
211 : !> Issues a warning when the size changes (but not on allocation
212 : !> and deallocation).
213 : !>
214 : !> The data is NOT preserved (if you want to preserve the data see
215 : !> the realloc in the module memory_utilities)
216 : !> \param array the array to reallocate if necessary
217 : !> \param n the wanted size
218 : !> \par History
219 : !> 12.2001 first version [fawzi]
220 : !> 3.2002 templatized [fawzi]
221 : !> \author Fawzi Mohamed
222 : !> \note
223 : !> this is a different behaviour than the realloc in the module
224 : !> memory_utilities. It is quite low level
225 : ! **************************************************************************************************
226 0 : SUBROUTINE cp_1d_${nametype1}$_guarantee_size(array, n)
227 : ${type1}$, POINTER :: array(:)
228 : INTEGER, INTENT(in) :: n
229 :
230 0 : CPASSERT(n >= 0)
231 0 : IF (ASSOCIATED(array)) THEN
232 0 : IF (SIZE(array) /= n) THEN
233 0 : CPWARN('size has changed')
234 0 : DEALLOCATE (array)
235 : END IF
236 : END IF
237 0 : IF (.NOT. ASSOCIATED(array)) THEN
238 0 : ALLOCATE (array(n))
239 : END IF
240 0 : END SUBROUTINE cp_1d_${nametype1}$_guarantee_size
241 :
242 : ! **************************************************************************************************
243 : !> \brief If the size of the array is changes reallocate it.
244 : !> Issues a warning when the size changes (but not on allocation
245 : !> and deallocation).
246 : !>
247 : !> The data is NOT preserved (if you want to preserve the data see
248 : !> the realloc in the module memory_utilities)
249 : !> \param array the array to reallocate if necessary
250 : !> \param n_rows the wanted number of rows
251 : !> \param n_cols the wanted number of cols
252 : !> \par History
253 : !> 5.2001 first version [fawzi]
254 : !> \author Fawzi Mohamed
255 : !> \note
256 : !> this is a different behaviour than the realloc in the module
257 : !> memory_utilities. It is quite low level
258 : ! **************************************************************************************************
259 0 : SUBROUTINE cp_2d_${nametype1}$_guarantee_size(array, n_rows, n_cols)
260 : ${type1}$, POINTER :: array(:, :)
261 : INTEGER, INTENT(in) :: n_rows, n_cols
262 :
263 0 : CPASSERT(n_cols >= 0)
264 0 : CPASSERT(n_rows >= 0)
265 0 : IF (ASSOCIATED(array)) THEN
266 0 : IF (SIZE(array, 1) /= n_rows .OR. SIZE(array, 2) /= n_cols) THEN
267 0 : CPWARN('size has changed')
268 0 : DEALLOCATE (array)
269 : END IF
270 : END IF
271 0 : IF (.NOT. ASSOCIATED(array)) THEN
272 0 : ALLOCATE (array(n_rows, n_cols))
273 : END IF
274 0 : END SUBROUTINE cp_2d_${nametype1}$_guarantee_size
275 :
276 : ! **************************************************************************************************
277 : !> \brief returns the index at which the element el should be inserted in the
278 : !> array to keep it ordered (array(i)>=el).
279 : !> If the element is bigger than all the elements in the array returns
280 : !> the last index+1.
281 : !> \param array the array to search
282 : !> \param el the element to look for
283 : !> \param l_index the lower index for binary search (defaults to 1)
284 : !> \param u_index the upper index for binary search (defaults to size(array))
285 : !> \return ...
286 : !> \par History
287 : !> 06.2003 created [fawzi]
288 : !> \author Fawzi Mohamed
289 : !> \note
290 : !> the array should be ordered in growing order
291 : ! **************************************************************************************************
292 0 : FUNCTION cp_1d_${nametype1}$_bsearch(array, el, l_index, u_index) &
293 : result(res)
294 : ${type1}$, intent(in) :: array(:)
295 : ${type1}$, intent(in) :: el
296 : INTEGER, INTENT(in), OPTIONAL :: l_index, u_index
297 : integer :: res
298 :
299 : INTEGER :: lindex, uindex, aindex
300 :
301 0 : lindex = 1
302 0 : uindex = size(array)
303 0 : if (present(l_index)) lindex = l_index
304 0 : if (present(u_index)) uindex = u_index
305 0 : DO WHILE (lindex <= uindex)
306 0 : aindex = (lindex + uindex)/2
307 0 : IF (@{lessQ(array(aindex),el)}@) THEN
308 0 : lindex = aindex + 1
309 : ELSE
310 0 : uindex = aindex - 1
311 : END IF
312 : END DO
313 0 : res = lindex
314 0 : END FUNCTION cp_1d_${nametype1}$_bsearch
315 : #:endfor
316 :
317 0 : END MODULE cp_array_utils
|
