1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6MODULE qs_fb_env_types 7 8 USE kinds, ONLY: dp 9 USE qs_fb_atomic_halo_types, ONLY: fb_atomic_halo_list_associate,& 10 fb_atomic_halo_list_has_data,& 11 fb_atomic_halo_list_nullify,& 12 fb_atomic_halo_list_obj,& 13 fb_atomic_halo_list_release,& 14 fb_atomic_halo_list_retain 15 USE qs_fb_trial_fns_types, ONLY: fb_trial_fns_associate,& 16 fb_trial_fns_has_data,& 17 fb_trial_fns_nullify,& 18 fb_trial_fns_obj,& 19 fb_trial_fns_release,& 20 fb_trial_fns_retain 21#include "./base/base_uses.f90" 22 23 IMPLICIT NONE 24 25 PRIVATE 26 27! public types 28 PUBLIC :: fb_env_obj 29 30! public methods 31 PUBLIC :: fb_env_release, & 32 fb_env_nullify, & 33 fb_env_has_data, & 34 fb_env_create, & 35 fb_env_get, & 36 fb_env_set 37 38 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fb_env_types' 39 INTEGER, PRIVATE, SAVE :: last_fb_env_id = 0 40 41! ********************************************************************** 42!> \brief wrapper to the simulation parameters used for filtered basis 43!> method 44!> \param rcut : cutoff for included filtered basis set centred at 45!> each atom. These defines the ranges of the atomic 46!> halos. rcut(ikind) gives the range for atom of 47!> global kind ikind 48!> \param atomic_halos : stores information on the neighbors of each 49!> atom ii, which are defined by rcut 50!> \param filter_temperature : parameter controlling the smoothness of 51!> the filter function during the construction 52!> of the filter matrix 53!> \param auto_cutoff_scale : scale multiplied to max atomic orbital 54!> radii used for automatic construction of 55!> rcut 56!> \param eps_default : anything less than it is regarded as zero 57!> \param collective_com : whether the MPI communications are 58!> to be done collectively together 59!> at the start and end of each 60!> filter matrix calculation. This makes 61!> communication more efficient in the 62!> expense of larger memory usage 63!> \param local_atoms : atoms corresponding to the 64!> atomic halos responsible by this processor 65!> \param id_nr : unique id of this object 66!> \param ref_count : reference counter of this object 67!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 68! ********************************************************************** 69 TYPE fb_env_data 70 INTEGER :: id_nr, ref_count 71 REAL(KIND=dp), DIMENSION(:), POINTER :: rcut 72 TYPE(fb_atomic_halo_list_obj) :: atomic_halos 73 TYPE(fb_trial_fns_obj) :: trial_fns 74 REAL(KIND=dp) :: filter_temperature 75 REAL(KIND=dp) :: auto_cutoff_scale 76 REAL(KIND=dp) :: eps_default 77 LOGICAL :: collective_com 78 INTEGER, DIMENSION(:), POINTER :: local_atoms 79 INTEGER :: nlocal_atoms 80 END TYPE fb_env_data 81 82! ************************************************************************************************** 83!> \brief the object container which allows for the creation of an array of 84!> pointers to fb_env 85!> \param obj : pointer to a filtered basis environment 86!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 87! ************************************************************************************************** 88 TYPE fb_env_obj 89 TYPE(fb_env_data), POINTER, PRIVATE :: obj 90 END TYPE fb_env_obj 91 92CONTAINS 93 94! ********************************************************************** 95!> \brief retains the given fb_env 96!> \param fb_env : the fb_env to retain 97!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 98! ************************************************************************************************** 99 SUBROUTINE fb_env_retain(fb_env) 100 TYPE(fb_env_obj), INTENT(IN) :: fb_env 101 102 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_retain', routineP = moduleN//':'//routineN 103 104 CPASSERT(ASSOCIATED(fb_env%obj)) 105 CPASSERT(fb_env%obj%ref_count > 0) 106 fb_env%obj%ref_count = fb_env%obj%ref_count + 1 107 END SUBROUTINE fb_env_retain 108 109! ********************************************************************** 110!> \brief releases a given fb_env 111!> \brief ... 112!> \param fb_env : the fb_env to release 113!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 114! ************************************************************************************************** 115 SUBROUTINE fb_env_release(fb_env) 116 TYPE(fb_env_obj), INTENT(INOUT) :: fb_env 117 118 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_release', routineP = moduleN//':'//routineN 119 120 IF (ASSOCIATED(fb_env%obj)) THEN 121 CPASSERT(fb_env%obj%ref_count > 0) 122 fb_env%obj%ref_count = fb_env%obj%ref_count - 1 123 IF (fb_env%obj%ref_count == 0) THEN 124 fb_env%obj%ref_count = 1 125 IF (ASSOCIATED(fb_env%obj%rcut)) THEN 126 DEALLOCATE (fb_env%obj%rcut) 127 END IF 128 IF (ASSOCIATED(fb_env%obj%local_atoms)) THEN 129 DEALLOCATE (fb_env%obj%local_atoms) 130 END IF 131 CALL fb_atomic_halo_list_release(fb_env%obj%atomic_halos) 132 CALL fb_trial_fns_release(fb_env%obj%trial_fns) 133 fb_env%obj%ref_count = 0 134 DEALLOCATE (fb_env%obj) 135 END IF 136 ELSE 137 NULLIFY (fb_env%obj) 138 END IF 139 END SUBROUTINE fb_env_release 140 141! ********************************************************************** 142!> \brief nullifies a fb_env object, note that this does not 143!> release the original object. This procedure is used mainly 144!> to nullify the pointer inside the object which is used to 145!> point to the actual data content of the object. 146!> \param fb_env : its content must be a NULL fb_env pointer on input, 147!> and the output returns an empty fb_env object 148!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 149! ************************************************************************************************** 150 SUBROUTINE fb_env_nullify(fb_env) 151 TYPE(fb_env_obj), INTENT(INOUT) :: fb_env 152 153 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_nullify', routineP = moduleN//':'//routineN 154 155 NULLIFY (fb_env%obj) 156 END SUBROUTINE fb_env_nullify 157 158! ********************************************************************** 159!> \brief Associates one fb_env object to another 160!> \param a the fb_env object to be associated 161!> \param b the fb_env object that a is to be associated to 162!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 163! ************************************************************************************************** 164 SUBROUTINE fb_env_associate(a, b) 165 TYPE(fb_env_obj), INTENT(OUT) :: a 166 TYPE(fb_env_obj), INTENT(IN) :: b 167 168 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_associate', & 169 routineP = moduleN//':'//routineN 170 171 a%obj => b%obj 172 END SUBROUTINE fb_env_associate 173 174! ********************************************************************** 175!> \brief Checks if a fb_env object is associated with an actual 176!> data content or not 177!> \param fb_env the fb_env object 178!> \return ... 179!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 180! ************************************************************************************************** 181 FUNCTION fb_env_has_data(fb_env) RESULT(res) 182 TYPE(fb_env_obj), INTENT(IN) :: fb_env 183 LOGICAL :: res 184 185 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_has_data', & 186 routineP = moduleN//':'//routineN 187 188 res = ASSOCIATED(fb_env%obj) 189 END FUNCTION fb_env_has_data 190 191! ********************************************************************** 192!> \brief creates an empty fb_env object 193!> \param fb_env : its content must be a NULL fb_env pointer on input, 194!> and the output returns an empty fb_env object 195!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 196! ************************************************************************************************** 197 SUBROUTINE fb_env_create(fb_env) 198 TYPE(fb_env_obj), INTENT(INOUT) :: fb_env 199 200 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_create', routineP = moduleN//':'//routineN 201 202 CPASSERT(.NOT. ASSOCIATED(fb_env%obj)) 203 ALLOCATE (fb_env%obj) 204 NULLIFY (fb_env%obj%rcut) 205 CALL fb_atomic_halo_list_nullify(fb_env%obj%atomic_halos) 206 CALL fb_trial_fns_nullify(fb_env%obj%trial_fns) 207 fb_env%obj%filter_temperature = 0.0_dp 208 fb_env%obj%auto_cutoff_scale = 1.0_dp 209 fb_env%obj%eps_default = 0.0_dp 210 fb_env%obj%collective_com = .TRUE. 211 NULLIFY (fb_env%obj%local_atoms) 212 fb_env%obj%nlocal_atoms = 0 213 fb_env%obj%ref_count = 1 214 fb_env%obj%id_nr = last_fb_env_id + 1 215 last_fb_env_id = fb_env%obj%id_nr 216 END SUBROUTINE fb_env_create 217 218! ********************************************************************** 219!> \brief initialises a fb_env object to become empty 220!> \brief ... 221!> \param fb_env : the fb_env object, which must not be NULL or 222!> UNDEFINED upon entry 223!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 224! ************************************************************************************************** 225 SUBROUTINE fb_env_init(fb_env) 226 TYPE(fb_env_obj), INTENT(INOUT) :: fb_env 227 228 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_init', routineP = moduleN//':'//routineN 229 230 CPASSERT(ASSOCIATED(fb_env%obj)) 231 IF (ASSOCIATED(fb_env%obj%rcut)) THEN 232 DEALLOCATE (fb_env%obj%rcut) 233 END IF 234 CALL fb_atomic_halo_list_release(fb_env%obj%atomic_halos) 235 CALL fb_trial_fns_release(fb_env%obj%trial_fns) 236 fb_env%obj%filter_temperature = 0.0_dp 237 fb_env%obj%auto_cutoff_scale = 1.0_dp 238 fb_env%obj%eps_default = 0.0_dp 239 fb_env%obj%collective_com = .TRUE. 240 IF (ASSOCIATED(fb_env%obj%local_atoms)) THEN 241 DEALLOCATE (fb_env%obj%local_atoms) 242 END IF 243 fb_env%obj%nlocal_atoms = 0 244 END SUBROUTINE fb_env_init 245 246! ********************************************************************** 247!> \brief method to get attributes from a given fb_env object 248!> \brief ... 249!> \param fb_env : the fb_env object in question 250!> \param rcut : outputs pointer to rcut attribute of fb_env (optional) 251!> \param filter_temperature : outputs filter_temperature attribute 252!> of fb_env (optional) 253!> \param auto_cutoff_scale : outputs auto_cutoff_scale attribute 254!> of fb_env (optional) 255!> \param eps_default : outputs eps_default attribute 256!> of fb_env (optional) 257!> \param atomic_halos : outputs pointer to atomic_halos 258!> attribute of fb_env (optional) 259!> \param trial_fns : outputs pointer to trial_fns 260!> attribute of fb_env (optional) 261!> \param collective_com : outputs pointer to trial_fns 262!> \param local_atoms : outputs pointer to local_atoms 263!> \param nlocal_atoms : outputs pointer to nlocal_atoms 264!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 265! ************************************************************************************************** 266 SUBROUTINE fb_env_get(fb_env, & 267 rcut, & 268 filter_temperature, & 269 auto_cutoff_scale, & 270 eps_default, & 271 atomic_halos, & 272 trial_fns, & 273 collective_com, & 274 local_atoms, & 275 nlocal_atoms) 276 TYPE(fb_env_obj), INTENT(IN) :: fb_env 277 REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: rcut 278 REAL(KIND=dp), INTENT(OUT), OPTIONAL :: filter_temperature, auto_cutoff_scale, & 279 eps_default 280 TYPE(fb_atomic_halo_list_obj), INTENT(OUT), & 281 OPTIONAL :: atomic_halos 282 TYPE(fb_trial_fns_obj), INTENT(OUT), OPTIONAL :: trial_fns 283 LOGICAL, INTENT(OUT), OPTIONAL :: collective_com 284 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: local_atoms 285 INTEGER, INTENT(OUT), OPTIONAL :: nlocal_atoms 286 287 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_get', routineP = moduleN//':'//routineN 288 289 CPASSERT(ASSOCIATED(fb_env%obj)) 290 CPASSERT(fb_env%obj%ref_count > 0) 291 IF (PRESENT(rcut)) & 292 rcut => fb_env%obj%rcut 293 IF (PRESENT(filter_temperature)) & 294 filter_temperature = fb_env%obj%filter_temperature 295 IF (PRESENT(auto_cutoff_scale)) & 296 auto_cutoff_scale = fb_env%obj%auto_cutoff_scale 297 IF (PRESENT(eps_default)) & 298 eps_default = fb_env%obj%eps_default 299 IF (PRESENT(atomic_halos)) & 300 CALL fb_atomic_halo_list_associate(atomic_halos, fb_env%obj%atomic_halos) 301 IF (PRESENT(trial_fns)) & 302 CALL fb_trial_fns_associate(trial_fns, fb_env%obj%trial_fns) 303 IF (PRESENT(collective_com)) & 304 collective_com = fb_env%obj%collective_com 305 IF (PRESENT(local_atoms)) & 306 local_atoms => fb_env%obj%local_atoms 307 IF (PRESENT(nlocal_atoms)) & 308 nlocal_atoms = fb_env%obj%nlocal_atoms 309 END SUBROUTINE fb_env_get 310 311! ********************************************************************** 312!> \brief method to set attributes from a given fb_env object 313!> \brief ... 314!> \param fb_env : the fb_env object in question 315!> \param rcut : sets rcut attribute of fb_env (optional) 316!> \param filter_temperature : sets filter_temperature attribute of fb_env (optional) 317!> \param auto_cutoff_scale : sets auto_cutoff_scale attribute of fb_env (optional) 318!> \param eps_default : sets eps_default attribute of fb_env (optional) 319!> \param atomic_halos : sets atomic_halos attribute of fb_env (optional) 320!> \param trial_fns : sets trial_fns attribute of fb_env (optional) 321!> \param collective_com : sets collective_com attribute of fb_env (optional) 322!> \param local_atoms : sets local_atoms attribute of fb_env (optional) 323!> \param nlocal_atoms : sets nlocal_atoms attribute of fb_env (optional) 324!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 325! ************************************************************************************************** 326 SUBROUTINE fb_env_set(fb_env, & 327 rcut, & 328 filter_temperature, & 329 auto_cutoff_scale, & 330 eps_default, & 331 atomic_halos, & 332 trial_fns, & 333 collective_com, & 334 local_atoms, & 335 nlocal_atoms) 336 TYPE(fb_env_obj), INTENT(INOUT) :: fb_env 337 REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: rcut 338 REAL(KIND=dp), INTENT(IN), OPTIONAL :: filter_temperature, auto_cutoff_scale, & 339 eps_default 340 TYPE(fb_atomic_halo_list_obj), INTENT(IN), & 341 OPTIONAL :: atomic_halos 342 TYPE(fb_trial_fns_obj), INTENT(IN), OPTIONAL :: trial_fns 343 LOGICAL, INTENT(IN), OPTIONAL :: collective_com 344 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: local_atoms 345 INTEGER, INTENT(IN), OPTIONAL :: nlocal_atoms 346 347 CHARACTER(len=*), PARAMETER :: routineN = 'fb_env_set', routineP = moduleN//':'//routineN 348 349 CPASSERT(ASSOCIATED(fb_env%obj)) 350 IF (PRESENT(rcut)) THEN 351 IF (ASSOCIATED(fb_env%obj%rcut)) THEN 352 DEALLOCATE (fb_env%obj%rcut) 353 END IF 354 fb_env%obj%rcut => rcut 355 END IF 356 IF (PRESENT(filter_temperature)) & 357 fb_env%obj%filter_temperature = filter_temperature 358 IF (PRESENT(auto_cutoff_scale)) & 359 fb_env%obj%auto_cutoff_scale = auto_cutoff_scale 360 IF (PRESENT(eps_default)) & 361 fb_env%obj%eps_default = eps_default 362 IF (PRESENT(atomic_halos)) THEN 363 IF (fb_atomic_halo_list_has_data(atomic_halos)) & 364 CALL fb_atomic_halo_list_retain(atomic_halos) 365 CALL fb_atomic_halo_list_release(fb_env%obj%atomic_halos) 366 CALL fb_atomic_halo_list_associate(fb_env%obj%atomic_halos, atomic_halos) 367 END IF 368 IF (PRESENT(trial_fns)) THEN 369 IF (fb_trial_fns_has_data(trial_fns)) & 370 CALL fb_trial_fns_retain(trial_fns) 371 CALL fb_trial_fns_release(fb_env%obj%trial_fns) 372 CALL fb_trial_fns_associate(fb_env%obj%trial_fns, trial_fns) 373 END IF 374 IF (PRESENT(collective_com)) & 375 fb_env%obj%collective_com = collective_com 376 IF (PRESENT(local_atoms)) THEN 377 IF (ASSOCIATED(fb_env%obj%local_atoms)) THEN 378 DEALLOCATE (fb_env%obj%local_atoms) 379 END IF 380 fb_env%obj%local_atoms => local_atoms 381 END IF 382 IF (PRESENT(nlocal_atoms)) & 383 fb_env%obj%nlocal_atoms = nlocal_atoms 384 END SUBROUTINE fb_env_set 385 386END MODULE qs_fb_env_types 387