Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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 1699841 : FUNCTION get_1d_pointer(this) RESULT(res)
46 : TYPE(kpoint_transitional_type) :: this
47 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: res
48 :
49 1699841 : IF (ASSOCIATED(this%ptr_1d)) THEN
50 1489839 : IF (SIZE(this%ptr_2d, 2) /= 1) THEN
51 0 : CPABORT("Method not implemented for k-points")
52 : END IF
53 : END IF
54 :
55 1699841 : res => this%ptr_1d
56 1699841 : END FUNCTION get_1d_pointer
57 :
58 : ! **************************************************************************************************
59 : !> \brief Simple getter, needed because of PRIVATE
60 : !> \param this ...
61 : !> \return ...
62 : !> \author Ole Schuett
63 : ! **************************************************************************************************
64 4026541 : FUNCTION get_2d_pointer(this) RESULT(res)
65 : TYPE(kpoint_transitional_type) :: this
66 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: res
67 :
68 4026541 : res => this%ptr_2d
69 4026541 : END FUNCTION get_2d_pointer
70 :
71 : ! **************************************************************************************************
72 : !> \brief Assigns a 1D pointer
73 : !> \param this ...
74 : !> \param ptr_1d ...
75 : !> \author Ole Schuett
76 : ! **************************************************************************************************
77 38073 : SUBROUTINE set_1d_pointer(this, ptr_1d)
78 : TYPE(kpoint_transitional_type) :: this
79 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ptr_1d
80 :
81 : INTEGER :: n
82 :
83 38073 : IF (ASSOCIATED(ptr_1d)) THEN
84 38073 : n = SIZE(ptr_1d)
85 38073 : this%ptr_1d => ptr_1d
86 38073 : this%ptr_2d(1:n, 1:1) => ptr_1d
87 38073 : this%set_as_1d = .TRUE.
88 : ELSE
89 0 : this%ptr_1d => Null()
90 0 : this%ptr_2d => Null()
91 : END IF
92 38073 : END SUBROUTINE set_1d_pointer
93 :
94 : ! **************************************************************************************************
95 : !> \brief Assigns a 2D pointer
96 : !> \param this ...
97 : !> \param ptr_2d ...
98 : !> \author Ole Schuett
99 : ! **************************************************************************************************
100 188754 : SUBROUTINE set_2d_pointer(this, ptr_2d)
101 : TYPE(kpoint_transitional_type) :: this
102 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ptr_2d
103 :
104 188754 : IF (ASSOCIATED(ptr_2d)) THEN
105 177325 : this%ptr_1d => ptr_2d(:, 1)
106 177325 : this%ptr_2d => ptr_2d
107 177325 : this%set_as_1d = .FALSE.
108 : ELSE
109 11429 : this%ptr_1d => Null()
110 11429 : this%ptr_2d => Null()
111 : END IF
112 188754 : END SUBROUTINE set_2d_pointer
113 :
114 : ! **************************************************************************************************
115 : !> \brief Release the matrix set, using the right pointer
116 : !> \param this ...
117 : !> \author Ole Schuett
118 : ! **************************************************************************************************
119 232045 : SUBROUTINE kpoint_transitional_release(this)
120 : TYPE(kpoint_transitional_type) :: this
121 :
122 232045 : IF (ASSOCIATED(this%ptr_1d)) THEN
123 87370 : IF (this%set_as_1d) THEN
124 19624 : CALL dbcsr_deallocate_matrix_set(this%ptr_1d)
125 : ELSE
126 67746 : CALL dbcsr_deallocate_matrix_set(this%ptr_2d)
127 : END IF
128 : END IF
129 232045 : NULLIFY (this%ptr_1d, this%ptr_2d)
130 232045 : END SUBROUTINE kpoint_transitional_release
131 :
132 0 : END MODULE kpoint_transitional
|
