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 Provides types for the management of the xc-functionals and 10 : !> their derivatives. 11 : ! ************************************************************************************************** 12 : MODULE xc_derivative_types 13 : 14 : USE kinds, ONLY: dp 15 : USE pw_pool_types, ONLY: pw_pool_type 16 : USE xc_derivative_desc, ONLY: create_split_desc 17 : #include "../base/base_uses.f90" 18 : 19 : IMPLICIT NONE 20 : 21 : PRIVATE 22 : 23 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_derivative_types' 24 : 25 : PUBLIC :: xc_derivative_type, xc_derivative_p_type 26 : PUBLIC :: xc_derivative_create, xc_derivative_release, & 27 : xc_derivative_get 28 : 29 : ! ************************************************************************************************** 30 : !> \brief represent a derivative of a functional 31 : ! ************************************************************************************************** 32 : TYPE xc_derivative_type 33 : INTEGER, DIMENSION(:), POINTER :: split_desc => NULL() 34 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER, CONTIGUOUS :: deriv_data => NULL() 35 : END TYPE xc_derivative_type 36 : 37 : ! ************************************************************************************************** 38 : !> \brief represent a pointer to a derivative (to have arrays of derivatives) 39 : !> \param deriv the pointer to the derivative 40 : !> \par History 41 : !> 11.2003 created [fawzi] 42 : !> \author fawzi 43 : ! ************************************************************************************************** 44 : TYPE xc_derivative_p_type 45 : TYPE(xc_derivative_type), POINTER :: deriv => NULL() 46 : END TYPE xc_derivative_p_type 47 : 48 : CONTAINS 49 : 50 : ! ************************************************************************************************** 51 : !> \brief allocates and initializes a derivative type 52 : !> \param derivative the object to create 53 : !> \param desc the derivative description 54 : !> \param r3d_ptr the data array (the ownership of it passes to the 55 : !> derivative type), the array is not zeroed 56 : ! ************************************************************************************************** 57 559262 : SUBROUTINE xc_derivative_create(derivative, desc, r3d_ptr) 58 : 59 : TYPE(xc_derivative_type) :: derivative 60 : INTEGER, DIMENSION(:), INTENT(in) :: desc 61 : REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), & 62 : POINTER :: r3d_ptr 63 : 64 559262 : CALL create_split_desc(desc, derivative%split_desc) 65 559262 : derivative%deriv_data => r3d_ptr 66 : 67 559262 : END SUBROUTINE xc_derivative_create 68 : 69 : ! ************************************************************************************************** 70 : !> \brief allocates and initializes a derivative type 71 : !> \param derivative the object to create 72 : !> \param pw_pool if given gives back the cr3d array %deriv_data back to it 73 : !> instead of deallocating it 74 : ! ************************************************************************************************** 75 559262 : SUBROUTINE xc_derivative_release(derivative, pw_pool) 76 : 77 : TYPE(xc_derivative_type) :: derivative 78 : TYPE(pw_pool_type), OPTIONAL, POINTER :: pw_pool 79 : 80 559262 : IF (PRESENT(pw_pool)) THEN 81 559262 : IF (ASSOCIATED(pw_pool)) THEN 82 559262 : CALL pw_pool%give_back_cr3d(derivative%deriv_data) 83 : END IF 84 : END IF 85 559262 : IF (ASSOCIATED(derivative%deriv_data)) THEN 86 0 : DEALLOCATE (derivative%deriv_data) 87 : END IF 88 559262 : IF (ASSOCIATED(derivative%split_desc)) DEALLOCATE (derivative%split_desc) 89 : 90 559262 : END SUBROUTINE xc_derivative_release 91 : 92 : ! ************************************************************************************************** 93 : !> \brief returns various information on the given derivative 94 : !> \param deriv the derivative you want information about 95 : !> \param split_desc an array that describes the derivative (each position represents a variable, 96 : !> see xc_derivative_desc.F) 97 : !> \param order the order of the derivative 98 : !> \param deriv_data the 3d real array with the derivative 99 : !> \param accept_null_data if deriv_data can be unassociated (defaults to no) 100 : ! ************************************************************************************************** 101 2210205 : SUBROUTINE xc_derivative_get(deriv, split_desc, & 102 : order, deriv_data, accept_null_data) 103 : TYPE(xc_derivative_type), INTENT(IN) :: deriv 104 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: split_desc 105 : INTEGER, INTENT(out), OPTIONAL :: order 106 : REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, & 107 : POINTER :: deriv_data 108 : LOGICAL, INTENT(in), OPTIONAL :: accept_null_data 109 : 110 : LOGICAL :: my_accept_null_data 111 : 112 2210205 : my_accept_null_data = .FALSE. 113 2210205 : IF (PRESENT(accept_null_data)) my_accept_null_data = accept_null_data 114 : 115 2210205 : IF (PRESENT(split_desc)) split_desc => deriv%split_desc 116 2210205 : IF (PRESENT(deriv_data)) THEN 117 1251894 : deriv_data => deriv%deriv_data 118 1251894 : IF (.NOT. my_accept_null_data) THEN 119 1251894 : CPASSERT(ASSOCIATED(deriv_data)) 120 : END IF 121 : END IF 122 2210205 : IF (PRESENT(order)) order = SIZE(deriv%split_desc) 123 2210205 : END SUBROUTINE xc_derivative_get 124 : 125 0 : END MODULE xc_derivative_types 126 :