1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2020 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief Provides types for the management of the xc-functionals and 8!> their derivatives. 9! ************************************************************************************************** 10MODULE xc_derivative_types 11 12 USE kinds, ONLY: dp 13 USE pw_pool_types, ONLY: pw_pool_give_back_cr3d,& 14 pw_pool_type 15 USE xc_derivative_desc, ONLY: MAX_DERIVATIVE_DESC_LENGTH,& 16 MAX_LABEL_LENGTH,& 17 create_split_derivative_desc,& 18 standardize_derivative_desc 19#include "../base/base_uses.f90" 20 21 IMPLICIT NONE 22 23 PRIVATE 24 25 INTEGER, SAVE :: derivative_id_nr = 1 26 27 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_derivative_types' 28 29 PUBLIC :: xc_derivative_type, xc_derivative_p_type 30 PUBLIC :: xc_derivative_create, xc_derivative_release, & 31 xc_derivative_get 32 33! ************************************************************************************************** 34!> \brief represent a derivative of a functional 35! ************************************************************************************************** 36 TYPE xc_derivative_type 37 INTEGER :: ref_count, id_nr 38 CHARACTER(len=MAX_DERIVATIVE_DESC_LENGTH) :: desc 39 CHARACTER(len=MAX_LABEL_LENGTH), DIMENSION(:), POINTER :: split_desc 40 REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: deriv_data 41 END TYPE xc_derivative_type 42 43! ************************************************************************************************** 44!> \brief represent a pointer to a derivative (to have arrays of derivatives) 45!> \param deriv the pointer to the derivative 46!> \par History 47!> 11.2003 created [fawzi] 48!> \author fawzi 49! ************************************************************************************************** 50 TYPE xc_derivative_p_type 51 TYPE(xc_derivative_type), POINTER :: deriv 52 END TYPE xc_derivative_p_type 53 54CONTAINS 55 56! ************************************************************************************************** 57!> \brief allocates and initializes a derivative type 58!> \param derivative the object to create 59!> \param desc the derivative description 60!> \param cr3d_ptr the data array (the ownership of it passes to the 61!> derivative type), the array is not zeroed 62! ************************************************************************************************** 63 SUBROUTINE xc_derivative_create(derivative, desc, cr3d_ptr) 64 65 TYPE(xc_derivative_type), POINTER :: derivative 66 CHARACTER(len=*), INTENT(in) :: desc 67 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: cr3d_ptr 68 69 CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_create', & 70 routineP = moduleN//':'//routineN 71 72 CHARACTER(len=MAX_DERIVATIVE_DESC_LENGTH) :: my_desc 73 74 ALLOCATE (derivative) 75 76 derivative%ref_count = 1 77 derivative%id_nr = derivative_id_nr 78 derivative_id_nr = derivative_id_nr + 1 79 CALL standardize_derivative_desc(desc, my_desc) 80 CALL create_split_derivative_desc(my_desc, derivative%split_desc) 81 derivative%desc = my_desc 82 derivative%deriv_data => cr3d_ptr 83 84 END SUBROUTINE xc_derivative_create 85 86! ************************************************************************************************** 87!> \brief retains the given derivative (see doc/ReferenceCounting.html) 88!> \param deriv the object you want to retain 89!> \par History 90!> 11.2003 created [fawzi] 91!> \author fawzi 92! ************************************************************************************************** 93 SUBROUTINE xc_derivative_retain(deriv) 94 TYPE(xc_derivative_type), POINTER :: deriv 95 96 CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_retain', & 97 routineP = moduleN//':'//routineN 98 99 CPASSERT(ASSOCIATED(deriv)) 100 CPASSERT(deriv%ref_count > 0) 101 deriv%ref_count = deriv%ref_count + 1 102 END SUBROUTINE xc_derivative_retain 103 104! ************************************************************************************************** 105!> \brief allocates and initializes a derivative type 106!> \param derivative the object to create 107!> \param pw_pool if given gives back the cr3d array %deriv_data back to it 108!> instead of deallocating it 109! ************************************************************************************************** 110 SUBROUTINE xc_derivative_release(derivative, pw_pool) 111 112 TYPE(xc_derivative_type), POINTER :: derivative 113 TYPE(pw_pool_type), OPTIONAL, POINTER :: pw_pool 114 115 CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_release', & 116 routineP = moduleN//':'//routineN 117 118 CPASSERT(ASSOCIATED(derivative)) 119 CPASSERT(derivative%ref_count >= 1) 120 121 derivative%ref_count = derivative%ref_count - 1 122 IF (derivative%ref_count == 0) THEN 123 IF (PRESENT(pw_pool)) THEN 124 IF (ASSOCIATED(pw_pool)) THEN 125 CALL pw_pool_give_back_cr3d(pw_pool, derivative%deriv_data, & 126 accept_non_compatible=.TRUE.) 127 END IF 128 END IF 129 IF (ASSOCIATED(derivative%deriv_data)) THEN 130 DEALLOCATE (derivative%deriv_data) 131 END IF 132 DEALLOCATE (derivative%split_desc) 133 134 DEALLOCATE (derivative) 135 END IF 136 NULLIFY (derivative) 137 138 END SUBROUTINE xc_derivative_release 139 140! ************************************************************************************************** 141!> \brief returns various information on the given derivative 142!> \param deriv the derivative you want information about 143!> \param desc a string that describes the derivative (empty string 144!> for the function itself, otherwise a string of the form 145!> "(rho)(rho)(norm_drhoa)") 146!> \param split_desc the same as desc but with an array of strings, 147!> and a derivative coordinate in each string (the previous 148!> example would become (/"rho","rho","norm_drhoa"/) 149!> \param order the order of the derivative 150!> \param deriv_data the 3d real array with the derivative 151!> \param accept_null_data if deriv_data can be unassociated (defaults to no) 152! ************************************************************************************************** 153 SUBROUTINE xc_derivative_get(deriv, desc, split_desc, & 154 order, deriv_data, accept_null_data) 155 TYPE(xc_derivative_type), POINTER :: deriv 156 CHARACTER(len=MAX_DERIVATIVE_DESC_LENGTH), & 157 INTENT(out), OPTIONAL :: desc 158 CHARACTER(len=MAX_LABEL_LENGTH), DIMENSION(:), & 159 OPTIONAL, POINTER :: split_desc 160 INTEGER, INTENT(out), OPTIONAL :: order 161 REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, & 162 POINTER :: deriv_data 163 LOGICAL, INTENT(in), OPTIONAL :: accept_null_data 164 165 CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_get', & 166 routineP = moduleN//':'//routineN 167 168 LOGICAL :: my_accept_null_data 169 170 my_accept_null_data = .FALSE. 171 IF (PRESENT(accept_null_data)) my_accept_null_data = accept_null_data 172 173 CPASSERT(ASSOCIATED(deriv)) 174 CPASSERT(deriv%ref_count > 0) 175 IF (PRESENT(desc)) desc = deriv%desc 176 IF (PRESENT(split_desc)) split_desc => deriv%split_desc 177 IF (PRESENT(deriv_data)) THEN 178 deriv_data => deriv%deriv_data 179 IF (.NOT. my_accept_null_data) THEN 180 CPASSERT(ASSOCIATED(deriv_data)) 181 END IF 182 END IF 183 IF (PRESENT(order)) order = SIZE(deriv%split_desc) 184 END SUBROUTINE xc_derivative_get 185 186END MODULE xc_derivative_types 187 188