(git:374b731)
Loading...
Searching...
No Matches
dbt_allocate_wrap.F
Go to the documentation of this file.
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! **************************************************************************************************
9!> \brief Wrapper for allocating, copying and reshaping arrays.
10!> \todo with fortran 2008 support, this should be replaced by plain ALLOCATE
11!> \note in particular ALLOCATE(..., SOURCE=...) does not work in gcc 5.4.0, see also
12!> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=44672
13!> \author Patrick Seewald
14! **************************************************************************************************
15MODULE dbt_allocate_wrap
16
17
18 USE kinds, ONLY: dp
19
20#include "../base/base_uses.f90"
21 IMPLICIT NONE
22 PRIVATE
23
24 PUBLIC :: allocate_any
25
26 INTERFACE allocate_any
27 MODULE PROCEDURE allocate_1d
28 MODULE PROCEDURE allocate_2d
29 MODULE PROCEDURE allocate_3d
30 MODULE PROCEDURE allocate_4d
31 MODULE PROCEDURE allocate_5d
32 MODULE PROCEDURE allocate_6d
33 MODULE PROCEDURE allocate_7d
34 END INTERFACE
35
36CONTAINS
37
38! **************************************************************************************************
39!> \brief Allocate array according to shape_spec. Possibly assign array from source.
40!> \note this does not fully replace Fortran RESHAPE intrinsic since source and target array must
41!> have same rank
42!> \param array target array.
43!> \param shape_spec shape of array to be allocated. If not specified, it is derived from source.
44!> \param source source array to be copied to target array, must have same rank as target array.
45!> \param order in which order to copy source to array (same convention as RESHAPE intrinsic).
46!> \author Patrick Seewald
47! **************************************************************************************************
48 SUBROUTINE allocate_1d(array, shape_spec, source, order)
49 REAL(dp), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: array
50 INTEGER, DIMENSION(1), INTENT(IN), OPTIONAL :: shape_spec
51 REAL(dp), DIMENSION(:), INTENT(IN), OPTIONAL :: source
52 INTEGER, DIMENSION(1), INTENT(IN), OPTIONAL :: order
53 INTEGER, DIMENSION(1) :: shape_prv
54
55 IF (PRESENT(shape_spec)) THEN
56 IF (PRESENT(order)) THEN
57 shape_prv(order) = shape_spec
58 ELSE
59 shape_prv = shape_spec
60 END IF
61 ELSEIF (PRESENT(source)) THEN
62 IF (PRESENT(order)) THEN
63 shape_prv(order) = shape(source)
64 ELSE
65 shape_prv = shape(source)
66 END IF
67 ELSE
68 cpabort("either source or shape_spec must be present")
69 END IF
70
71 IF (PRESENT(source)) THEN
72 IF (PRESENT(order)) THEN
73 ALLOCATE (array(shape_prv(1)))
74 array(:) = reshape(source, shape_prv, order=order)
75 ELSE
76 ALLOCATE (array(shape_prv(1)), source=source)
77 END IF
78 ELSE
79 ALLOCATE (array(shape_prv(1)))
80 END IF
81
82 END SUBROUTINE
83! **************************************************************************************************
84!> \brief Allocate array according to shape_spec. Possibly assign array from source.
85!> \note this does not fully replace Fortran RESHAPE intrinsic since source and target array must
86!> have same rank
87!> \param array target array.
88!> \param shape_spec shape of array to be allocated. If not specified, it is derived from source.
89!> \param source source array to be copied to target array, must have same rank as target array.
90!> \param order in which order to copy source to array (same convention as RESHAPE intrinsic).
91!> \author Patrick Seewald
92! **************************************************************************************************
93 SUBROUTINE allocate_2d(array, shape_spec, source, order)
94 REAL(dp), DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) :: array
95 INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: shape_spec
96 REAL(dp), DIMENSION(:,:), INTENT(IN), OPTIONAL :: source
97 INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: order
98 INTEGER, DIMENSION(2) :: shape_prv
99
100 IF (PRESENT(shape_spec)) THEN
101 IF (PRESENT(order)) THEN
102 shape_prv(order) = shape_spec
103 ELSE
104 shape_prv = shape_spec
105 END IF
106 ELSEIF (PRESENT(source)) THEN
107 IF (PRESENT(order)) THEN
108 shape_prv(order) = shape(source)
109 ELSE
110 shape_prv = shape(source)
111 END IF
112 ELSE
113 cpabort("either source or shape_spec must be present")
114 END IF
115
116 IF (PRESENT(source)) THEN
117 IF (PRESENT(order)) THEN
118 ALLOCATE (array(shape_prv(1), shape_prv(2)))
119 array(:,:) = reshape(source, shape_prv, order=order)
120 ELSE
121 ALLOCATE (array(shape_prv(1), shape_prv(2)), source=source)
122 END IF
123 ELSE
124 ALLOCATE (array(shape_prv(1), shape_prv(2)))
125 END IF
126
127 END SUBROUTINE
128! **************************************************************************************************
129!> \brief Allocate array according to shape_spec. Possibly assign array from source.
130!> \note this does not fully replace Fortran RESHAPE intrinsic since source and target array must
131!> have same rank
132!> \param array target array.
133!> \param shape_spec shape of array to be allocated. If not specified, it is derived from source.
134!> \param source source array to be copied to target array, must have same rank as target array.
135!> \param order in which order to copy source to array (same convention as RESHAPE intrinsic).
136!> \author Patrick Seewald
137! **************************************************************************************************
138 SUBROUTINE allocate_3d(array, shape_spec, source, order)
139 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(OUT) :: array
140 INTEGER, DIMENSION(3), INTENT(IN), OPTIONAL :: shape_spec
141 REAL(dp), DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: source
142 INTEGER, DIMENSION(3), INTENT(IN), OPTIONAL :: order
143 INTEGER, DIMENSION(3) :: shape_prv
144
145 IF (PRESENT(shape_spec)) THEN
146 IF (PRESENT(order)) THEN
147 shape_prv(order) = shape_spec
148 ELSE
149 shape_prv = shape_spec
150 END IF
151 ELSEIF (PRESENT(source)) THEN
152 IF (PRESENT(order)) THEN
153 shape_prv(order) = shape(source)
154 ELSE
155 shape_prv = shape(source)
156 END IF
157 ELSE
158 cpabort("either source or shape_spec must be present")
159 END IF
160
161 IF (PRESENT(source)) THEN
162 IF (PRESENT(order)) THEN
163 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3)))
164 array(:,:,:) = reshape(source, shape_prv, order=order)
165 ELSE
166 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3)), source=source)
167 END IF
168 ELSE
169 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3)))
170 END IF
171
172 END SUBROUTINE
173! **************************************************************************************************
174!> \brief Allocate array according to shape_spec. Possibly assign array from source.
175!> \note this does not fully replace Fortran RESHAPE intrinsic since source and target array must
176!> have same rank
177!> \param array target array.
178!> \param shape_spec shape of array to be allocated. If not specified, it is derived from source.
179!> \param source source array to be copied to target array, must have same rank as target array.
180!> \param order in which order to copy source to array (same convention as RESHAPE intrinsic).
181!> \author Patrick Seewald
182! **************************************************************************************************
183 SUBROUTINE allocate_4d(array, shape_spec, source, order)
184 REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(OUT) :: array
185 INTEGER, DIMENSION(4), INTENT(IN), OPTIONAL :: shape_spec
186 REAL(dp), DIMENSION(:,:,:,:), INTENT(IN), OPTIONAL :: source
187 INTEGER, DIMENSION(4), INTENT(IN), OPTIONAL :: order
188 INTEGER, DIMENSION(4) :: shape_prv
189
190 IF (PRESENT(shape_spec)) THEN
191 IF (PRESENT(order)) THEN
192 shape_prv(order) = shape_spec
193 ELSE
194 shape_prv = shape_spec
195 END IF
196 ELSEIF (PRESENT(source)) THEN
197 IF (PRESENT(order)) THEN
198 shape_prv(order) = shape(source)
199 ELSE
200 shape_prv = shape(source)
201 END IF
202 ELSE
203 cpabort("either source or shape_spec must be present")
204 END IF
205
206 IF (PRESENT(source)) THEN
207 IF (PRESENT(order)) THEN
208 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4)))
209 array(:,:,:,:) = reshape(source, shape_prv, order=order)
210 ELSE
211 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4)), source=source)
212 END IF
213 ELSE
214 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4)))
215 END IF
216
217 END SUBROUTINE
218! **************************************************************************************************
219!> \brief Allocate array according to shape_spec. Possibly assign array from source.
220!> \note this does not fully replace Fortran RESHAPE intrinsic since source and target array must
221!> have same rank
222!> \param array target array.
223!> \param shape_spec shape of array to be allocated. If not specified, it is derived from source.
224!> \param source source array to be copied to target array, must have same rank as target array.
225!> \param order in which order to copy source to array (same convention as RESHAPE intrinsic).
226!> \author Patrick Seewald
227! **************************************************************************************************
228 SUBROUTINE allocate_5d(array, shape_spec, source, order)
229 REAL(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(OUT) :: array
230 INTEGER, DIMENSION(5), INTENT(IN), OPTIONAL :: shape_spec
231 REAL(dp), DIMENSION(:,:,:,:,:), INTENT(IN), OPTIONAL :: source
232 INTEGER, DIMENSION(5), INTENT(IN), OPTIONAL :: order
233 INTEGER, DIMENSION(5) :: shape_prv
234
235 IF (PRESENT(shape_spec)) THEN
236 IF (PRESENT(order)) THEN
237 shape_prv(order) = shape_spec
238 ELSE
239 shape_prv = shape_spec
240 END IF
241 ELSEIF (PRESENT(source)) THEN
242 IF (PRESENT(order)) THEN
243 shape_prv(order) = shape(source)
244 ELSE
245 shape_prv = shape(source)
246 END IF
247 ELSE
248 cpabort("either source or shape_spec must be present")
249 END IF
250
251 IF (PRESENT(source)) THEN
252 IF (PRESENT(order)) THEN
253 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5)))
254 array(:,:,:,:,:) = reshape(source, shape_prv, order=order)
255 ELSE
256 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5)), source=source)
257 END IF
258 ELSE
259 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5)))
260 END IF
261
262 END SUBROUTINE
263! **************************************************************************************************
264!> \brief Allocate array according to shape_spec. Possibly assign array from source.
265!> \note this does not fully replace Fortran RESHAPE intrinsic since source and target array must
266!> have same rank
267!> \param array target array.
268!> \param shape_spec shape of array to be allocated. If not specified, it is derived from source.
269!> \param source source array to be copied to target array, must have same rank as target array.
270!> \param order in which order to copy source to array (same convention as RESHAPE intrinsic).
271!> \author Patrick Seewald
272! **************************************************************************************************
273 SUBROUTINE allocate_6d(array, shape_spec, source, order)
274 REAL(dp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE, INTENT(OUT) :: array
275 INTEGER, DIMENSION(6), INTENT(IN), OPTIONAL :: shape_spec
276 REAL(dp), DIMENSION(:,:,:,:,:,:), INTENT(IN), OPTIONAL :: source
277 INTEGER, DIMENSION(6), INTENT(IN), OPTIONAL :: order
278 INTEGER, DIMENSION(6) :: shape_prv
279
280 IF (PRESENT(shape_spec)) THEN
281 IF (PRESENT(order)) THEN
282 shape_prv(order) = shape_spec
283 ELSE
284 shape_prv = shape_spec
285 END IF
286 ELSEIF (PRESENT(source)) THEN
287 IF (PRESENT(order)) THEN
288 shape_prv(order) = shape(source)
289 ELSE
290 shape_prv = shape(source)
291 END IF
292 ELSE
293 cpabort("either source or shape_spec must be present")
294 END IF
295
296 IF (PRESENT(source)) THEN
297 IF (PRESENT(order)) THEN
298 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5), shape_prv(6)))
299 array(:,:,:,:,:,:) = reshape(source, shape_prv, order=order)
300 ELSE
301 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5), shape_prv(6)), source=source)
302 END IF
303 ELSE
304 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5), shape_prv(6)))
305 END IF
306
307 END SUBROUTINE
308! **************************************************************************************************
309!> \brief Allocate array according to shape_spec. Possibly assign array from source.
310!> \note this does not fully replace Fortran RESHAPE intrinsic since source and target array must
311!> have same rank
312!> \param array target array.
313!> \param shape_spec shape of array to be allocated. If not specified, it is derived from source.
314!> \param source source array to be copied to target array, must have same rank as target array.
315!> \param order in which order to copy source to array (same convention as RESHAPE intrinsic).
316!> \author Patrick Seewald
317! **************************************************************************************************
318 SUBROUTINE allocate_7d(array, shape_spec, source, order)
319 REAL(dp), DIMENSION(:,:,:,:,:,:,:), ALLOCATABLE, INTENT(OUT) :: array
320 INTEGER, DIMENSION(7), INTENT(IN), OPTIONAL :: shape_spec
321 REAL(dp), DIMENSION(:,:,:,:,:,:,:), INTENT(IN), OPTIONAL :: source
322 INTEGER, DIMENSION(7), INTENT(IN), OPTIONAL :: order
323 INTEGER, DIMENSION(7) :: shape_prv
324
325 IF (PRESENT(shape_spec)) THEN
326 IF (PRESENT(order)) THEN
327 shape_prv(order) = shape_spec
328 ELSE
329 shape_prv = shape_spec
330 END IF
331 ELSEIF (PRESENT(source)) THEN
332 IF (PRESENT(order)) THEN
333 shape_prv(order) = shape(source)
334 ELSE
335 shape_prv = shape(source)
336 END IF
337 ELSE
338 cpabort("either source or shape_spec must be present")
339 END IF
340
341 IF (PRESENT(source)) THEN
342 IF (PRESENT(order)) THEN
343 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5), shape_prv(6), shape_prv(7)))
344 array(:,:,:,:,:,:,:) = reshape(source, shape_prv, order=order)
345 ELSE
346 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5), shape_prv(6), shape_prv(7)),&
347 & source=source)
348 END IF
349 ELSE
350 ALLOCATE (array(shape_prv(1), shape_prv(2), shape_prv(3), shape_prv(4), shape_prv(5), shape_prv(6), shape_prv(7)))
351 END IF
352
353 END SUBROUTINE
354END MODULE
dbt_allocate_wrap::allocate_any
Definition dbt_allocate_wrap.F:26
dbt_allocate_wrap
Wrapper for allocating, copying and reshaping arrays.
Definition dbt_allocate_wrap.F:15
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34