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 1724175 : FUNCTION get_1d_pointer(this) RESULT(res)
46 : TYPE(kpoint_transitional_type) :: this
47 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: res
48 :
49 1724175 : IF (ASSOCIATED(this%ptr_1d)) THEN
50 1508747 : 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 1724175 : res => this%ptr_1d
56 1724175 : 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 4123824 : FUNCTION get_2d_pointer(this) RESULT(res)
65 : TYPE(kpoint_transitional_type) :: this
66 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: res
67 :
68 4123824 : res => this%ptr_2d
69 4123824 : 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 39631 : 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 39631 : IF (ASSOCIATED(ptr_1d)) THEN
84 39631 : n = SIZE(ptr_1d)
85 39631 : this%ptr_1d => ptr_1d
86 39631 : this%ptr_2d(1:n, 1:1) => ptr_1d
87 39631 : this%set_as_1d = .TRUE.
88 : ELSE
89 0 : this%ptr_1d => Null()
90 0 : this%ptr_2d => Null()
91 : END IF
92 39631 : 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 190290 : SUBROUTINE set_2d_pointer(this, ptr_2d)
101 : TYPE(kpoint_transitional_type) :: this
102 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ptr_2d
103 :
104 190290 : IF (ASSOCIATED(ptr_2d)) THEN
105 178883 : this%ptr_1d => ptr_2d(:, 1)
106 178883 : this%ptr_2d => ptr_2d
107 178883 : this%set_as_1d = .FALSE.
108 : ELSE
109 11407 : this%ptr_1d => Null()
110 11407 : this%ptr_2d => Null()
111 : END IF
112 190290 : 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 242043 : SUBROUTINE kpoint_transitional_release(this)
120 : TYPE(kpoint_transitional_type) :: this
121 :
122 242043 : IF (ASSOCIATED(this%ptr_1d)) THEN
123 90256 : IF (this%set_as_1d) THEN
124 21128 : CALL dbcsr_deallocate_matrix_set(this%ptr_1d)
125 : ELSE
126 69128 : CALL dbcsr_deallocate_matrix_set(this%ptr_2d)
127 : END IF
128 : END IF
129 242043 : NULLIFY (this%ptr_1d, this%ptr_2d)
130 242043 : END SUBROUTINE kpoint_transitional_release
131 :
132 0 : END MODULE kpoint_transitional
|
