Line data Source code
1 : !--------------------------------------------------------------------------------------------------! 2 : ! CP2K: A general program to perform molecular dynamics simulations ! 3 : ! Copyright 2000-2024 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 1337272 : FUNCTION get_1d_pointer(this) RESULT(res) 46 : TYPE(kpoint_transitional_type) :: this 47 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: res 48 : 49 1337272 : IF (ASSOCIATED(this%ptr_1d)) THEN 50 1169890 : IF (SIZE(this%ptr_2d, 2) /= 1) & 51 0 : CPABORT("Method not implemented for k-points") 52 : END IF 53 : 54 1337272 : res => this%ptr_1d 55 1337272 : 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 2500777 : FUNCTION get_2d_pointer(this) RESULT(res) 64 : TYPE(kpoint_transitional_type) :: this 65 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: res 66 : 67 2500777 : res => this%ptr_2d 68 2500777 : 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 33537 : 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 33537 : IF (ASSOCIATED(ptr_1d)) THEN 83 33537 : n = SIZE(ptr_1d) 84 33537 : this%ptr_1d => ptr_1d 85 33537 : this%ptr_2d(1:n, 1:1) => ptr_1d 86 33537 : this%set_as_1d = .TRUE. 87 : ELSE 88 0 : this%ptr_1d => Null() 89 0 : this%ptr_2d => Null() 90 : END IF 91 33537 : 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 139756 : SUBROUTINE set_2d_pointer(this, ptr_2d) 100 : TYPE(kpoint_transitional_type) :: this 101 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ptr_2d 102 : 103 139756 : IF (ASSOCIATED(ptr_2d)) THEN 104 129521 : this%ptr_1d => ptr_2d(:, 1) 105 129521 : this%ptr_2d => ptr_2d 106 129521 : this%set_as_1d = .FALSE. 107 : ELSE 108 10235 : this%ptr_1d => Null() 109 10235 : this%ptr_2d => Null() 110 : END IF 111 139756 : 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 176873 : SUBROUTINE kpoint_transitional_release(this) 119 : TYPE(kpoint_transitional_type) :: this 120 : 121 176873 : IF (ASSOCIATED(this%ptr_1d)) THEN 122 65030 : IF (this%set_as_1d) THEN 123 15750 : CALL dbcsr_deallocate_matrix_set(this%ptr_1d) 124 : ELSE 125 49280 : CALL dbcsr_deallocate_matrix_set(this%ptr_2d) 126 : END IF 127 : END IF 128 176873 : NULLIFY (this%ptr_1d, this%ptr_2d) 129 176873 : END SUBROUTINE kpoint_transitional_release 130 : 131 0 : END MODULE kpoint_transitional