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