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 Datatype to translate between k-points (2d) and gamma-point (1d) code.
      10             : !> \note  In principle storing just the 2d pointer would be sufficient.
      11             : !>        However due to a bug in ifort with the deallocation of
      12             : !>        bounds-remapped pointers, we also have to store the original
      13             : !>        1d pointer used for allocation.
      14             : !>
      15             : !> \par History
      16             : !>      11.2014 created [Ole Schuett]
      17             : !> \author Ole Schuett
      18             : ! **************************************************************************************************
      19             : MODULE kpoint_transitional
      20             :    USE cp_dbcsr_operations,             ONLY: dbcsr_deallocate_matrix_set
      21             :    USE dbcsr_api,                       ONLY: dbcsr_p_type
      22             : #include "./base/base_uses.f90"
      23             : 
      24             :    IMPLICIT NONE
      25             :    PRIVATE
      26             : 
      27             :    PUBLIC :: kpoint_transitional_type, kpoint_transitional_release
      28             :    PUBLIC :: get_1d_pointer, get_2d_pointer, set_1d_pointer, set_2d_pointer
      29             : 
      30             :    TYPE kpoint_transitional_type
      31             :       PRIVATE
      32             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: ptr_1d => Null()
      33             :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER        :: ptr_2d => Null()
      34             :       LOGICAL                                               :: set_as_1d = .FALSE.
      35             :    END TYPE kpoint_transitional_type
      36             : 
      37             : CONTAINS
      38             : 
      39             : ! **************************************************************************************************
      40             : !> \brief Smart getter, raises an error when called during a k-point calculation
      41             : !> \param this ...
      42             : !> \return ...
      43             : !> \author Ole Schuett
      44             : ! **************************************************************************************************
      45     1339732 :    FUNCTION get_1d_pointer(this) RESULT(res)
      46             :       TYPE(kpoint_transitional_type)                     :: this
      47             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: res
      48             : 
      49     1339732 :       IF (ASSOCIATED(this%ptr_1d)) THEN
      50     1172890 :          IF (SIZE(this%ptr_2d, 2) /= 1) &
      51           0 :             CPABORT("Method not implemented for k-points")
      52             :       END IF
      53             : 
      54     1339732 :       res => this%ptr_1d
      55     1339732 :    END FUNCTION get_1d_pointer
      56             : 
      57             : ! **************************************************************************************************
      58             : !> \brief Simple getter, needed because of PRIVATE
      59             : !> \param this ...
      60             : !> \return ...
      61             : !> \author Ole Schuett
      62             : ! **************************************************************************************************
      63     2501687 :    FUNCTION get_2d_pointer(this) RESULT(res)
      64             :       TYPE(kpoint_transitional_type)                     :: this
      65             :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: res
      66             : 
      67     2501687 :       res => this%ptr_2d
      68     2501687 :    END FUNCTION get_2d_pointer
      69             : 
      70             : ! **************************************************************************************************
      71             : !> \brief Assigns a 1D pointer
      72             : !> \param this ...
      73             : !> \param ptr_1d ...
      74             : !> \author Ole Schuett
      75             : ! **************************************************************************************************
      76       33537 :    SUBROUTINE set_1d_pointer(this, ptr_1d)
      77             :       TYPE(kpoint_transitional_type)                     :: this
      78             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: ptr_1d
      79             : 
      80             :       INTEGER                                            :: n
      81             : 
      82       33537 :       IF (ASSOCIATED(ptr_1d)) THEN
      83       33537 :          n = SIZE(ptr_1d)
      84       33537 :          this%ptr_1d => ptr_1d
      85       33537 :          this%ptr_2d(1:n, 1:1) => ptr_1d
      86       33537 :          this%set_as_1d = .TRUE.
      87             :       ELSE
      88           0 :          this%ptr_1d => Null()
      89           0 :          this%ptr_2d => Null()
      90             :       END IF
      91       33537 :    END SUBROUTINE set_1d_pointer
      92             : 
      93             : ! **************************************************************************************************
      94             : !> \brief Assigns a 2D pointer
      95             : !> \param this ...
      96             : !> \param ptr_2d ...
      97             : !> \author Ole Schuett
      98             : ! **************************************************************************************************
      99      139516 :    SUBROUTINE set_2d_pointer(this, ptr_2d)
     100             :       TYPE(kpoint_transitional_type)                     :: this
     101             :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: ptr_2d
     102             : 
     103      139516 :       IF (ASSOCIATED(ptr_2d)) THEN
     104      129285 :          this%ptr_1d => ptr_2d(:, 1)
     105      129285 :          this%ptr_2d => ptr_2d
     106      129285 :          this%set_as_1d = .FALSE.
     107             :       ELSE
     108       10231 :          this%ptr_1d => Null()
     109       10231 :          this%ptr_2d => Null()
     110             :       END IF
     111      139516 :    END SUBROUTINE set_2d_pointer
     112             : 
     113             : ! **************************************************************************************************
     114             : !> \brief Release the matrix set, using the right pointer
     115             : !> \param this ...
     116             : !> \author Ole Schuett
     117             : ! **************************************************************************************************
     118      176341 :    SUBROUTINE kpoint_transitional_release(this)
     119             :       TYPE(kpoint_transitional_type)                     :: this
     120             : 
     121      176341 :       IF (ASSOCIATED(this%ptr_1d)) THEN
     122       64850 :          IF (this%set_as_1d) THEN
     123       15750 :             CALL dbcsr_deallocate_matrix_set(this%ptr_1d)
     124             :          ELSE
     125       49100 :             CALL dbcsr_deallocate_matrix_set(this%ptr_2d)
     126             :          END IF
     127             :       END IF
     128      176341 :       NULLIFY (this%ptr_1d, this%ptr_2d)
     129      176341 :    END SUBROUTINE kpoint_transitional_release
     130             : 
     131           0 : END MODULE kpoint_transitional