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 Utility routines for the memory handling.
10 : !> \par History
11 : !> (12.2017) remove stop_memory
12 : !> \author Matthias Krack (25.06.1999)
13 : ! **************************************************************************************************
14 : MODULE memory_utilities
15 :
16 : USE kinds, ONLY: dp, int_8
17 : #include "../base/base_uses.f90"
18 :
19 : IMPLICIT NONE
20 :
21 : PRIVATE
22 :
23 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'memory_utilities'
24 :
25 : PUBLIC :: reallocate
26 :
27 : INTERFACE reallocate
28 : MODULE PROCEDURE reallocate_c1, reallocate_c2, reallocate_c3, reallocate_c4, &
29 : reallocate_i1, reallocate_i2, reallocate_i3, reallocate_i4, &
30 : reallocate_r1, reallocate_r2, reallocate_r3, reallocate_r4, &
31 : reallocate_r5, reallocate_s1, reallocate_l1, reallocate_8i1, &
32 : reallocate_8i2
33 : END INTERFACE
34 :
35 : CONTAINS
36 :
37 : #! *************************************************************************************************
38 : #!> \brief Fypp macro for common subroutine body
39 : #!> \author Ole Schuett
40 : #!> \author Tiziano Müller
41 : #! *************************************************************************************************
42 : #:def reallocate(suffix, rank, type, zero, worktype=None)
43 : #:set bounds_vars = ','.join("lb{0}_new,ub{0}_new".format(i+1) for i in range(rank))
44 : #:set old_bounds = ','.join(['lb{0}:ub{0}'.format(i+1) for i in range(rank)])
45 : #:set new_bounds = ','.join(['lb{0}_new:ub{0}_new'.format(i+1) for i in range(rank)])
46 : #:set arr_exp = ','.join(':'*rank)
47 : ! **************************************************************************************************
48 : !> \brief (Re)Allocate a ${rank}$D vector of type ${type}$ with new dimensions (but same shape)
49 : !> \param p pointer to the existing data, if NULL() calling this is equivalent to an ALLOCATE(...)
50 : #:for i in range(1, rank+1)
51 : !> \param lb${i}$_new new lower bound for dimension ${i}$
52 : !> \param ub${i}$_new new upper bound for dimension ${i}$
53 : #:endfor
54 : ! **************************************************************************************************
55 : SUBROUTINE reallocate_${suffix}$${rank}$ (p, ${bounds_vars}$)
56 : ${type}$, &
57 : DIMENSION(${arr_exp}$), &
58 : POINTER, INTENT(INOUT) :: p
59 :
60 : INTEGER, INTENT(IN) :: &
61 : ${bounds_vars}$
62 :
63 : #:for i in range(1, rank+1)
64 : INTEGER :: lb${i}$, lb${i}$_old, ub${i}$, ub${i}$_old
65 : #:endfor
66 :
67 : #:if worktype
68 : ${worktype}$, &
69 : #:else
70 : ${type}$, &
71 : #:endif
72 : DIMENSION(${arr_exp}$), &
73 : POINTER :: work
74 :
75 : NULLIFY (work)
76 :
77 : IF (ASSOCIATED(p)) THEN
78 : #:for i in range(1, rank+1)
79 : lb${i}$_old = LBOUND(p, ${i}$)
80 : ub${i}$_old = UBOUND(p, ${i}$)
81 : lb${i}$ = MAX(lb${i}$_new, lb${i}$_old)
82 : ub${i}$ = MIN(ub${i}$_new, ub${i}$_old)
83 : #:endfor
84 : work => p
85 : END IF
86 :
87 : ALLOCATE (p(${new_bounds}$))
88 : p = ${zero}$
89 :
90 : IF (ASSOCIATED(work)) THEN
91 : p(${old_bounds}$) = work(${old_bounds}$)
92 : DEALLOCATE (work)
93 : END IF
94 :
95 : END SUBROUTINE reallocate_${suffix}$${rank}$
96 : #:enddef
97 :
98 235296 : $: reallocate(suffix="c", rank=1, type="COMPLEX(KIND=dp)", zero="(0.0_dp, 0.0_dp)")
99 0 : $: reallocate(suffix="c", rank=2, type="COMPLEX(KIND=dp)", zero="(0.0_dp, 0.0_dp)")
100 0 : $: reallocate(suffix="c", rank=3, type="COMPLEX(KIND=dp)", zero="(0.0_dp, 0.0_dp)")
101 804336 : $: reallocate(suffix="c", rank=4, type="COMPLEX(KIND=dp)", zero="(0.0_dp, 0.0_dp)")
102 1281098524 : $: reallocate(suffix="i", rank=1, type="INTEGER", zero="0")
103 16780714 : $: reallocate(suffix="i", rank=2, type="INTEGER", zero="0")
104 242712 : $: reallocate(suffix="i", rank=3, type="INTEGER", zero="0")
105 0 : $: reallocate(suffix="i", rank=4, type="INTEGER", zero="0")
106 142656 : $: reallocate(suffix="8i", rank=1, type="INTEGER(KIND=int_8)", zero="0")
107 0 : $: reallocate(suffix="8i", rank=2, type="INTEGER(KIND=int_8)", zero="0")
108 1042159515 : $: reallocate(suffix="r", rank=1, type="REAL(KIND=dp)", zero="0.0_dp")
109 129708966 : $: reallocate(suffix="r", rank=2, type="REAL(KIND=dp)", zero="0.0_dp")
110 1126014247 : $: reallocate(suffix="r", rank=3, type="REAL(KIND=dp)", zero="0.0_dp")
111 2056247248 : $: reallocate(suffix="r", rank=4, type="REAL(KIND=dp)", zero="0.0_dp")
112 0 : $: reallocate(suffix="r", rank=5, type="REAL(KIND=dp)", zero="0.0_dp")
113 7442677 : $: reallocate(suffix="l", rank=1, type="LOGICAL", zero=".FALSE.")
114 248473475 : $: reallocate(suffix="s", rank=1, type="CHARACTER(LEN=*)", zero='""', worktype="CHARACTER(LEN=LEN(p))")
115 :
116 : END MODULE memory_utilities
|
