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