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 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_api, ONLY: dbcsr_p_type
21 : USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set
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 1487213 : FUNCTION get_1d_pointer(this) RESULT(res)
46 : TYPE(kpoint_transitional_type) :: this
47 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: res
48 :
49 1487213 : IF (ASSOCIATED(this%ptr_1d)) THEN
50 1309133 : IF (SIZE(this%ptr_2d, 2) /= 1) &
51 0 : CPABORT("Method not implemented for k-points")
52 : END IF
53 :
54 1487213 : res => this%ptr_1d
55 1487213 : 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 2732684 : FUNCTION get_2d_pointer(this) RESULT(res)
64 : TYPE(kpoint_transitional_type) :: this
65 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: res
66 :
67 2732684 : res => this%ptr_2d
68 2732684 : 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 33669 : 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 33669 : IF (ASSOCIATED(ptr_1d)) THEN
83 33669 : n = SIZE(ptr_1d)
84 33669 : this%ptr_1d => ptr_1d
85 33669 : this%ptr_2d(1:n, 1:1) => ptr_1d
86 33669 : this%set_as_1d = .TRUE.
87 : ELSE
88 0 : this%ptr_1d => Null()
89 0 : this%ptr_2d => Null()
90 : END IF
91 33669 : 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 152504 : SUBROUTINE set_2d_pointer(this, ptr_2d)
100 : TYPE(kpoint_transitional_type) :: this
101 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ptr_2d
102 :
103 152504 : IF (ASSOCIATED(ptr_2d)) THEN
104 141895 : this%ptr_1d => ptr_2d(:, 1)
105 141895 : this%ptr_2d => ptr_2d
106 141895 : this%set_as_1d = .FALSE.
107 : ELSE
108 10609 : this%ptr_1d => Null()
109 10609 : this%ptr_2d => Null()
110 : END IF
111 152504 : 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 191941 : SUBROUTINE kpoint_transitional_release(this)
119 : TYPE(kpoint_transitional_type) :: this
120 :
121 191941 : IF (ASSOCIATED(this%ptr_1d)) THEN
122 70804 : IF (this%set_as_1d) THEN
123 16022 : CALL dbcsr_deallocate_matrix_set(this%ptr_1d)
124 : ELSE
125 54782 : CALL dbcsr_deallocate_matrix_set(this%ptr_2d)
126 : END IF
127 : END IF
128 191941 : NULLIFY (this%ptr_1d, this%ptr_2d)
129 191941 : END SUBROUTINE kpoint_transitional_release
130 :
131 0 : END MODULE kpoint_transitional
|
