1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief superstucture that hold various representations of the density and 8!> keeps track of which ones are valid 9!> \par History 10!> 08.2002 created [fawzi] 11!> 08.2014 kpoints [JGH] 12!> 11.2014 make qs_rho_type PRIVATE [Ole Schuett] 13!> 11.2014 unified k-point and gamma-point code [Ole Schuett] 14!> \author Fawzi Mohamed 15! ************************************************************************************************** 16MODULE qs_rho_types 17 USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set 18 USE dbcsr_api, ONLY: dbcsr_p_type 19 USE kinds, ONLY: dp 20 USE kpoint_transitional, ONLY: get_1d_pointer,& 21 get_2d_pointer,& 22 kpoint_transitional_release,& 23 kpoint_transitional_type,& 24 set_1d_pointer,& 25 set_2d_pointer 26 USE pw_types, ONLY: pw_p_type,& 27 pw_release 28#include "./base/base_uses.f90" 29 30 IMPLICIT NONE 31 PRIVATE 32 33 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE. 34 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_rho_types' 35 36 PUBLIC :: qs_rho_p_type, qs_rho_type 37 PUBLIC :: qs_rho_retain, qs_rho_release, & 38 qs_rho_get, qs_rho_set, qs_rho_clear, qs_rho_create 39 40! ************************************************************************************************** 41!> \brief keeps the density in various representations, keeping track of 42!> which ones are valid. 43!> \param most attributes are array with either lda or lsd_alpha,lsd_beta. 44!> \param rho_ao the filtered rho in the localized atom basis (to have rho(r) 45!> the filtered matrix is enough, but rho(r,r') is lost). 46!> \param rho_ao_kp the filtered rho in the localized atom basis (to have rho(r) 47!> the filtered matrix is enough, but rho(r,r') is lost). 48!> for kpoints, in real space index form 49!> \param rho_r grids with rho in the real space 50!> \param tau_r grids with the kinetic energy density in real space 51!> \param rho_g grids with rho in the g space 52!> \param tau_g grids with the kinetic energy density in g space 53!> \param rho_g_valid , rho_r_valid, tau_r_valid, tau_g_valid: if the 54!> corresponding component is valid 55!> \param ref_count the reference count, when it becomes 0 the type 56!> is deallocated. 57!> \param rebuild_each how often a rebuild should be done by default 58!> \param tot_rho_r the total charge in r space (valid only if rho_r is) 59!> \note 60!> If pw_p_type would implement retain/release it would be nice to 61!> store also the core charge and the qs_charges in this structure... 62!> \par History 63!> 08.2002 created [fawzi] 64!> \author Fawzi Mohamed 65! ************************************************************************************************** 66 TYPE qs_rho_type 67 PRIVATE 68 TYPE(kpoint_transitional_type) :: rho_ao 69 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im => Null() 70 TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_g => Null(), & 71 rho_r => Null(), & 72 drho_g => Null(), & 73 drho_r => Null(), & 74 tau_g => Null(), & 75 tau_r => Null() 76 ! Final rho_iter of last SCCS cycle (r-space) 77 TYPE(pw_p_type), POINTER :: rho_r_sccs => Null() 78 LOGICAL :: rho_g_valid = .FALSE., & 79 rho_r_valid = .FALSE., & 80 drho_r_valid = .FALSE., & 81 drho_g_valid = .FALSE., & 82 tau_r_valid = .FALSE., & 83 tau_g_valid = .FALSE., & 84 soft_valid = .FALSE. 85 INTEGER :: ref_count = -1, & 86 id_nr = -1, & 87 rebuild_each = -1 88 REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho_r => Null(), & 89 tot_rho_g => Null() 90 END TYPE qs_rho_type 91 92! ************************************************************************************************** 93 TYPE qs_rho_p_type 94 TYPE(qs_rho_type), POINTER :: rho 95 END TYPE qs_rho_p_type 96 97 INTEGER, PRIVATE, SAVE :: last_rho_id_nr = 0 98 99CONTAINS 100 101! ************************************************************************************************** 102!> \brief Allocates a new instance of rho. 103!> \param rho ... 104!> \author Ole Schuett 105! ************************************************************************************************** 106 SUBROUTINE qs_rho_create(rho) 107 TYPE(qs_rho_type), POINTER :: rho 108 109 CHARACTER(LEN=*), PARAMETER :: routineN = 'qs_rho_create', routineP = moduleN//':'//routineN 110 111 IF (ASSOCIATED(rho)) CPABORT("rho already associated") 112 113 ALLOCATE (rho) 114 last_rho_id_nr = last_rho_id_nr + 1 115 rho%id_nr = last_rho_id_nr 116 rho%rebuild_each = 5 117 rho%ref_count = 1 118 END SUBROUTINE qs_rho_create 119 120! ************************************************************************************************** 121!> \brief retains a rho_struct by increasing the reference count by one 122!> (to be called when you want to keep a shared copy) 123!> \param rho_struct the structure to retain 124!> \par History 125!> 08.2002 created [fawzi] 126!> \author Fawzi Mohamed 127! ************************************************************************************************** 128 SUBROUTINE qs_rho_retain(rho_struct) 129 TYPE(qs_rho_type), POINTER :: rho_struct 130 131 CHARACTER(len=*), PARAMETER :: routineN = 'qs_rho_retain', routineP = moduleN//':'//routineN 132 133 CPASSERT(ASSOCIATED(rho_struct)) 134 CPASSERT(rho_struct%ref_count > 0) 135 rho_struct%ref_count = rho_struct%ref_count + 1 136 END SUBROUTINE qs_rho_retain 137 138! ************************************************************************************************** 139!> \brief releases a rho_struct by decreasing the reference count by one 140!> and deallocating if it reaches 0 (to be called when you don't want 141!> anymore a shared copy) 142!> \param rho_struct the structure to retain 143!> \par History 144!> 08.2002 created [fawzi] 145!> \author Fawzi Mohamed 146! ************************************************************************************************** 147 SUBROUTINE qs_rho_release(rho_struct) 148 TYPE(qs_rho_type), POINTER :: rho_struct 149 150 CHARACTER(len=*), PARAMETER :: routineN = 'qs_rho_release', routineP = moduleN//':'//routineN 151 152 IF (ASSOCIATED(rho_struct)) THEN 153 CPASSERT(rho_struct%ref_count > 0) 154 rho_struct%ref_count = rho_struct%ref_count - 1 155 IF (rho_struct%ref_count < 1) THEN 156 CALL qs_rho_clear(rho_struct) 157 DEALLOCATE (rho_struct) 158 END IF 159 END IF 160 161 NULLIFY (rho_struct) 162 163 END SUBROUTINE qs_rho_release 164 165! ************************************************************************************************** 166!> \brief Deallocates all components, whithout deallocating rho_struct itself. 167!> \param rho_struct ... 168!> \author Ole Schuett 169! ************************************************************************************************** 170 SUBROUTINE qs_rho_clear(rho_struct) 171 TYPE(qs_rho_type), POINTER :: rho_struct 172 173 CHARACTER(len=*), PARAMETER :: routineN = 'qs_rho_clear', routineP = moduleN//':'//routineN 174 175 INTEGER :: i 176 177 IF (ASSOCIATED(rho_struct%rho_r)) THEN 178 DO i = 1, SIZE(rho_struct%rho_r) 179 CALL pw_release(rho_struct%rho_r(i)%pw) 180 END DO 181 DEALLOCATE (rho_struct%rho_r) 182 END IF 183 IF (ASSOCIATED(rho_struct%drho_r)) THEN 184 DO i = 1, SIZE(rho_struct%drho_r) 185 CALL pw_release(rho_struct%drho_r(i)%pw) 186 END DO 187 DEALLOCATE (rho_struct%drho_r) 188 END IF 189 IF (ASSOCIATED(rho_struct%drho_g)) THEN 190 DO i = 1, SIZE(rho_struct%drho_g) 191 CALL pw_release(rho_struct%drho_g(i)%pw) 192 END DO 193 DEALLOCATE (rho_struct%drho_g) 194 END IF 195 IF (ASSOCIATED(rho_struct%tau_r)) THEN 196 DO i = 1, SIZE(rho_struct%tau_r) 197 CALL pw_release(rho_struct%tau_r(i)%pw) 198 END DO 199 DEALLOCATE (rho_struct%tau_r) 200 END IF 201 IF (ASSOCIATED(rho_struct%rho_g)) THEN 202 DO i = 1, SIZE(rho_struct%rho_g) 203 CALL pw_release(rho_struct%rho_g(i)%pw) 204 END DO 205 DEALLOCATE (rho_struct%rho_g) 206 END IF 207 IF (ASSOCIATED(rho_struct%tau_g)) THEN 208 DO i = 1, SIZE(rho_struct%tau_g) 209 CALL pw_release(rho_struct%tau_g(i)%pw) 210 END DO 211 DEALLOCATE (rho_struct%tau_g) 212 END IF 213 IF (ASSOCIATED(rho_struct%rho_r_sccs)) THEN 214 CALL pw_release(rho_struct%rho_r_sccs%pw) 215 DEALLOCATE (rho_struct%rho_r_sccs) 216 END IF 217 218 CALL kpoint_transitional_release(rho_struct%rho_ao) 219 220 IF (ASSOCIATED(rho_struct%rho_ao_im)) & 221 CALL dbcsr_deallocate_matrix_set(rho_struct%rho_ao_im) 222 IF (ASSOCIATED(rho_struct%tot_rho_r)) & 223 DEALLOCATE (rho_struct%tot_rho_r) 224 IF (ASSOCIATED(rho_struct%tot_rho_g)) & 225 DEALLOCATE (rho_struct%tot_rho_g) 226 227 END SUBROUTINE qs_rho_clear 228 229! ************************************************************************************************** 230!> \brief returns info about the density described by this object. 231!> If some representation is not available an error is issued 232!> \param rho_struct ... 233!> \param rho_ao ... 234!> \param rho_ao_im ... 235!> \param rho_ao_kp ... 236!> \param rho_r ... 237!> \param drho_r ... 238!> \param rho_g ... 239!> \param drho_g ... 240!> \param tau_r ... 241!> \param tau_g ... 242!> \param rho_r_valid ... 243!> \param drho_r_valid ... 244!> \param rho_g_valid ... 245!> \param drho_g_valid ... 246!> \param tau_r_valid ... 247!> \param tau_g_valid ... 248!> \param rebuild_each ... 249!> \param tot_rho_r ... 250!> \param tot_rho_g ... 251!> \param rho_r_sccs ... 252!> \param soft_valid ... 253!> \par History 254!> 08.2002 created [fawzi] 255!> \author Fawzi Mohamed 256! ************************************************************************************************** 257 SUBROUTINE qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_r, drho_r, & 258 rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, & 259 drho_g_valid, tau_r_valid, tau_g_valid, rebuild_each, tot_rho_r, tot_rho_g, & 260 rho_r_sccs, soft_valid) 261 TYPE(qs_rho_type), POINTER :: rho_struct 262 TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & 263 POINTER :: rho_ao, rho_ao_im 264 TYPE(dbcsr_p_type), DIMENSION(:, :), OPTIONAL, & 265 POINTER :: rho_ao_kp 266 TYPE(pw_p_type), DIMENSION(:), OPTIONAL, POINTER :: rho_r, drho_r, rho_g, drho_g, tau_r, & 267 tau_g 268 LOGICAL, INTENT(out), OPTIONAL :: rho_r_valid, drho_r_valid, rho_g_valid, & 269 drho_g_valid, tau_r_valid, tau_g_valid 270 INTEGER, INTENT(out), OPTIONAL :: rebuild_each 271 REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: tot_rho_r, tot_rho_g 272 TYPE(pw_p_type), OPTIONAL, POINTER :: rho_r_sccs 273 LOGICAL, INTENT(out), OPTIONAL :: soft_valid 274 275 CHARACTER(len=*), PARAMETER :: routineN = 'qs_rho_get', routineP = moduleN//':'//routineN 276 277 CPASSERT(ASSOCIATED(rho_struct)) 278 CPASSERT(rho_struct%ref_count > 0) 279 280 IF (PRESENT(rho_ao)) rho_ao => get_1d_pointer(rho_struct%rho_ao) 281 IF (PRESENT(rho_ao_kp)) rho_ao_kp => get_2d_pointer(rho_struct%rho_ao) 282 283 IF (PRESENT(rho_ao_im)) rho_ao_im => rho_struct%rho_ao_im 284 IF (PRESENT(rho_r)) rho_r => rho_struct%rho_r 285 IF (PRESENT(drho_r)) drho_r => rho_struct%drho_r 286 IF (PRESENT(rho_g)) rho_g => rho_struct%rho_g 287 IF (PRESENT(drho_g)) drho_g => rho_struct%drho_g 288 IF (PRESENT(tau_r)) tau_r => rho_struct%tau_r 289 IF (PRESENT(tau_g)) tau_g => rho_struct%tau_g 290 IF (PRESENT(rho_r_valid)) rho_r_valid = rho_struct%rho_r_valid 291 IF (PRESENT(rho_g_valid)) rho_g_valid = rho_struct%rho_g_valid 292 IF (PRESENT(drho_r_valid)) drho_r_valid = rho_struct%drho_r_valid 293 IF (PRESENT(drho_g_valid)) drho_g_valid = rho_struct%drho_g_valid 294 IF (PRESENT(tau_r_valid)) tau_r_valid = rho_struct%tau_r_valid 295 IF (PRESENT(tau_g_valid)) tau_g_valid = rho_struct%tau_g_valid 296 IF (PRESENT(soft_valid)) soft_valid = rho_struct%soft_valid 297 IF (PRESENT(rebuild_each)) rebuild_each = rho_struct%rebuild_each 298 IF (PRESENT(tot_rho_r)) tot_rho_r => rho_struct%tot_rho_r 299 IF (PRESENT(tot_rho_g)) tot_rho_g => rho_struct%tot_rho_g 300 IF (PRESENT(rho_r_sccs)) rho_r_sccs => rho_struct%rho_r_sccs 301 302 END SUBROUTINE qs_rho_get 303 304! ************************************************************************************************** 305!> \brief ... 306!> \param rho_struct ... 307!> \param rho_ao ... 308!> \param rho_ao_im ... 309!> \param rho_ao_kp ... 310!> \param rho_r ... 311!> \param drho_r ... 312!> \param rho_g ... 313!> \param drho_g ... 314!> \param tau_r ... 315!> \param tau_g ... 316!> \param rho_r_valid ... 317!> \param drho_r_valid ... 318!> \param rho_g_valid ... 319!> \param drho_g_valid ... 320!> \param tau_r_valid ... 321!> \param tau_g_valid ... 322!> \param rebuild_each ... 323!> \param tot_rho_r ... 324!> \param tot_rho_g ... 325!> \param rho_r_sccs ... 326!> \param soft_valid ... 327!> \author Ole Schuett 328! ************************************************************************************************** 329 SUBROUTINE qs_rho_set(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_r, drho_r, & 330 rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, & 331 drho_g_valid, tau_r_valid, tau_g_valid, rebuild_each, tot_rho_r, tot_rho_g, & 332 rho_r_sccs, soft_valid) 333 TYPE(qs_rho_type), POINTER :: rho_struct 334 TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & 335 POINTER :: rho_ao, rho_ao_im 336 TYPE(dbcsr_p_type), DIMENSION(:, :), OPTIONAL, & 337 POINTER :: rho_ao_kp 338 TYPE(pw_p_type), DIMENSION(:), OPTIONAL, POINTER :: rho_r, drho_r, rho_g, drho_g, tau_r, & 339 tau_g 340 LOGICAL, INTENT(in), OPTIONAL :: rho_r_valid, drho_r_valid, rho_g_valid, & 341 drho_g_valid, tau_r_valid, tau_g_valid 342 INTEGER, INTENT(in), OPTIONAL :: rebuild_each 343 REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: tot_rho_r, tot_rho_g 344 TYPE(pw_p_type), OPTIONAL, POINTER :: rho_r_sccs 345 LOGICAL, INTENT(in), OPTIONAL :: soft_valid 346 347 CHARACTER(len=*), PARAMETER :: routineN = 'qs_rho_set', routineP = moduleN//':'//routineN 348 349 CPASSERT(ASSOCIATED(rho_struct)) 350 CPASSERT(rho_struct%ref_count > 0) 351 352 IF (PRESENT(rho_ao)) CALL set_1d_pointer(rho_struct%rho_ao, rho_ao) 353 IF (PRESENT(rho_ao_kp)) CALL set_2d_pointer(rho_struct%rho_ao, rho_ao_kp) 354 355 IF (PRESENT(rho_ao_im)) rho_struct%rho_ao_im => rho_ao_im 356 IF (PRESENT(rho_r)) rho_struct%rho_r => rho_r 357 IF (PRESENT(rho_g)) rho_struct%rho_g => rho_g 358 IF (PRESENT(drho_r)) rho_struct%drho_r => drho_r 359 IF (PRESENT(drho_g)) rho_struct%drho_g => drho_g 360 IF (PRESENT(tau_r)) rho_struct%tau_r => tau_r 361 IF (PRESENT(tau_g)) rho_struct%tau_g => tau_g 362 IF (PRESENT(rho_r_valid)) rho_struct%rho_r_valid = rho_r_valid 363 IF (PRESENT(rho_g_valid)) rho_struct%rho_g_valid = rho_g_valid 364 IF (PRESENT(drho_r_valid)) rho_struct%drho_r_valid = drho_r_valid 365 IF (PRESENT(drho_g_valid)) rho_struct%drho_g_valid = drho_g_valid 366 IF (PRESENT(tau_r_valid)) rho_struct%tau_r_valid = tau_r_valid 367 IF (PRESENT(tau_g_valid)) rho_struct%tau_g_valid = tau_g_valid 368 IF (PRESENT(soft_valid)) rho_struct%soft_valid = soft_valid 369 IF (PRESENT(rebuild_each)) rho_struct%rebuild_each = rebuild_each 370 IF (PRESENT(tot_rho_r)) rho_struct%tot_rho_r => tot_rho_r 371 IF (PRESENT(tot_rho_g)) rho_struct%tot_rho_g => tot_rho_g 372 IF (PRESENT(rho_r_sccs)) rho_struct%rho_r_sccs => rho_r_sccs 373 374 END SUBROUTINE qs_rho_set 375 376END MODULE qs_rho_types 377