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 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    15819014 :       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    15819014 :          IF (PRESENT(shape_spec)) THEN
      54    15612040 :             IF (PRESENT(order)) THEN
      55           0 :                shape_prv(order) = shape_spec
      56             :             ELSE
      57    15612040 :                shape_prv = shape_spec
      58             :             END IF
      59      206974 :          ELSEIF (PRESENT(source)) THEN
      60      206974 :             IF (PRESENT(order)) THEN
      61         326 :                shape_prv(order) = SHAPE(source)
      62             :             ELSE
      63      206894 :                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    15819014 :          IF (PRESENT(source)) THEN
      70      206974 :             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   135325510 :                ALLOCATE (array(${arrlist("shape_prv", nmax=dim)}$), source=source)
      75             :             END IF
      76             :          ELSE
      77    75612733 :             ALLOCATE (array(${arrlist("shape_prv", nmax=dim)}$))
      78             :          END IF
      79             : 
      80    15819014 :       END SUBROUTINE
      81             :    #:endfor
      82             : END MODULE