Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 : ! **************************************************************************************************
15 : MODULE dbt_allocate_wrap
16 : #:include "dbt_macros.fypp"
17 : #:set maxdim = fortran_max_ndim
18 :
19 : USE kinds, ONLY: dp
20 :
21 : #include "../base/base_uses.f90"
22 : IMPLICIT NONE
23 : PRIVATE
24 :
25 : PUBLIC :: allocate_any
26 :
27 : INTERFACE allocate_any
28 : #:for dim in range(1, maxdim+1)
29 : MODULE PROCEDURE allocate_${dim}$d
30 : #:endfor
31 : END INTERFACE
32 :
33 : CONTAINS
34 :
35 : #:for dim in range(1, maxdim+1)
36 : ! **************************************************************************************************
37 : !> \brief Allocate array according to shape_spec. Possibly assign array from source.
38 : !> \note this does not fully replace Fortran RESHAPE intrinsic since source and target array must
39 : !> have same rank
40 : !> \param array target array.
41 : !> \param shape_spec shape of array to be allocated. If not specified, it is derived from source.
42 : !> \param source source array to be copied to target array, must have same rank as target array.
43 : !> \param order in which order to copy source to array (same convention as RESHAPE intrinsic).
44 : !> \author Patrick Seewald
45 : ! **************************************************************************************************
46 19332812 : SUBROUTINE allocate_${dim}$d(array, shape_spec, source, order)
47 : REAL(dp), DIMENSION(${shape_colon(dim)}$), ALLOCATABLE, INTENT(OUT) :: array
48 : INTEGER, DIMENSION(${dim}$), INTENT(IN), OPTIONAL :: shape_spec
49 : REAL(dp), DIMENSION(${shape_colon(dim)}$), INTENT(IN), OPTIONAL :: source
50 : INTEGER, DIMENSION(${dim}$), INTENT(IN), OPTIONAL :: order
51 : INTEGER, DIMENSION(${dim}$) :: shape_prv
52 :
53 19332812 : IF (PRESENT(shape_spec)) THEN
54 19078235 : IF (PRESENT(order)) THEN
55 0 : shape_prv(order) = shape_spec
56 : ELSE
57 19078235 : shape_prv = shape_spec
58 : END IF
59 254577 : ELSEIF (PRESENT(source)) THEN
60 254577 : IF (PRESENT(order)) THEN
61 326 : shape_prv(order) = SHAPE(source)
62 : ELSE
63 763491 : shape_prv = SHAPE(source)
64 : END IF
65 : ELSE
66 0 : CPABORT("either source or shape_spec must be present")
67 : END IF
68 :
69 19332812 : IF (PRESENT(source)) THEN
70 254577 : IF (PRESENT(order)) THEN
71 406 : ALLOCATE (array(${arrlist("shape_prv", nmax=dim)}$))
72 572 : array(${shape_colon(dim)}$) = RESHAPE(source, shape_prv, order=order)
73 : ELSE
74 140649824 : ALLOCATE (array(${arrlist("shape_prv", nmax=dim)}$), source=source)
75 : END IF
76 : ELSE
77 92400305 : ALLOCATE (array(${arrlist("shape_prv", nmax=dim)}$))
78 : END IF
79 :
80 19332812 : END SUBROUTINE
81 : #:endfor
82 : END MODULE
|