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             : ! **************************************************************************************************
       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  1279888388 :    $: reallocate(suffix="i",  rank=1, type="INTEGER", zero="0")
     103    16603028 :    $: 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  1041344934 :    $: reallocate(suffix="r",  rank=1, type="REAL(KIND=dp)", zero="0.0_dp")
     109   119207550 :    $: reallocate(suffix="r",  rank=2, type="REAL(KIND=dp)", zero="0.0_dp")
     110  1043236827 :    $: reallocate(suffix="r",  rank=3, type="REAL(KIND=dp)", zero="0.0_dp")
     111  1859673446 :    $: 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     7413515 :    $: reallocate(suffix="l",  rank=1, type="LOGICAL", zero=".FALSE.")
     114   248241423 :    $: reallocate(suffix="s",  rank=1, type="CHARACTER(LEN=*)", zero='""', worktype="CHARACTER(LEN=LEN(p))")
     115             : 
     116             : END MODULE memory_utilities