(git:0de0cc2)
kpoint_transitional.F
Go to the documentation of this file.
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 ! **************************************************************************************************
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
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  FUNCTION get_1d_pointer(this) RESULT(res)
46  TYPE(kpoint_transitional_type) :: this
47  TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: res
48 
49  IF (ASSOCIATED(this%ptr_1d)) THEN
50  IF (SIZE(this%ptr_2d, 2) /= 1) &
51  cpabort("Method not implemented for k-points")
52  END IF
53 
54  res => this%ptr_1d
55  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  FUNCTION get_2d_pointer(this) RESULT(res)
64  TYPE(kpoint_transitional_type) :: this
65  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: res
66 
67  res => this%ptr_2d
68  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  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  IF (ASSOCIATED(ptr_1d)) THEN
83  n = SIZE(ptr_1d)
84  this%ptr_1d => ptr_1d
85  this%ptr_2d(1:n, 1:1) => ptr_1d
86  this%set_as_1d = .true.
87  ELSE
88  this%ptr_1d => null()
89  this%ptr_2d => null()
90  END IF
91  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  SUBROUTINE set_2d_pointer(this, ptr_2d)
100  TYPE(kpoint_transitional_type) :: this
101  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ptr_2d
102 
103  IF (ASSOCIATED(ptr_2d)) THEN
104  this%ptr_1d => ptr_2d(:, 1)
105  this%ptr_2d => ptr_2d
106  this%set_as_1d = .false.
107  ELSE
108  this%ptr_1d => null()
109  this%ptr_2d => null()
110  END IF
111  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 ! **************************************************************************************************
119  TYPE(kpoint_transitional_type) :: this
120 
121  IF (ASSOCIATED(this%ptr_1d)) THEN
122  IF (this%set_as_1d) THEN
123  CALL dbcsr_deallocate_matrix_set(this%ptr_1d)
124  ELSE
125  CALL dbcsr_deallocate_matrix_set(this%ptr_2d)
126  END IF
127  END IF
128  NULLIFY (this%ptr_1d, this%ptr_2d)
129  END SUBROUTINE kpoint_transitional_release
130 
131 END MODULE kpoint_transitional
DBCSR operations in CP2K.
Datatype to translate between k-points (2d) and gamma-point (1d) code.
type(dbcsr_p_type) function, dimension(:), pointer, public get_1d_pointer(this)
Smart getter, raises an error when called during a k-point calculation.
type(dbcsr_p_type) function, dimension(:, :), pointer, public get_2d_pointer(this)
Simple getter, needed because of PRIVATE.
subroutine, public kpoint_transitional_release(this)
Release the matrix set, using the right pointer.
subroutine, public set_1d_pointer(this, ptr_1d)
Assigns a 1D pointer.
subroutine, public set_2d_pointer(this, ptr_2d)
Assigns a 2D pointer.