1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6MODULE qs_fb_trial_fns_types 7 8#include "./base/base_uses.f90" 9 IMPLICIT NONE 10 11 PRIVATE 12 13! public types 14 PUBLIC :: fb_trial_fns_obj 15 16! public methods 17!API 18 PUBLIC :: fb_trial_fns_retain, & 19 fb_trial_fns_release, & 20 fb_trial_fns_nullify, & 21 fb_trial_fns_associate, & 22 fb_trial_fns_has_data, & 23 fb_trial_fns_create, & 24 fb_trial_fns_get, & 25 fb_trial_fns_set 26 27 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fb_trial_fns_types' 28 INTEGER, PRIVATE, SAVE :: last_fb_trial_fns_id = 0 29 30! ************************************************************************************************** 31!> \brief data containing information on trial functions used by filter 32!> matrix diagonalisation method 33!> \param nfunctions : nfunctions(ikind) = number of trial functions for 34!> atomic kind ikind 35!> \param functions : functions(itrial,ikind) = the index of the 36!> GTO atomic orbital corresponding to itrial-th trial 37!> function for kind ikind 38!> \param id_nr : unique id for the object 39!> \param ref_count : reference counter for the object 40!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 41! ************************************************************************************************** 42 TYPE fb_trial_fns_data 43 INTEGER :: id_nr, ref_count 44 INTEGER, DIMENSION(:), POINTER :: nfunctions 45 INTEGER, DIMENSION(:, :), POINTER :: functions 46 END TYPE fb_trial_fns_data 47 48! ************************************************************************************************** 49!> \brief the object container which allows for the creation of an array 50!> of pointers to fb_trial_fns objects 51!> \param obj : pointer to the fb_trial_fns object 52!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 53! ************************************************************************************************** 54 TYPE fb_trial_fns_obj 55 TYPE(fb_trial_fns_data), POINTER, PRIVATE :: obj 56 END TYPE fb_trial_fns_obj 57 58CONTAINS 59 60! ************************************************************************************************** 61!> \brief retains given object 62!> \brief ... 63!> \param trial_fns : the fb_trial_fns object in question 64!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 65! ************************************************************************************************** 66 SUBROUTINE fb_trial_fns_retain(trial_fns) 67 ! note INTENT(IN) is okay because the obj pointer contained in the 68 ! obj type will not be changed 69 TYPE(fb_trial_fns_obj), INTENT(IN) :: trial_fns 70 71 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_retain', & 72 routineP = moduleN//':'//routineN 73 74 CPASSERT(ASSOCIATED(trial_fns%obj)) 75 CPASSERT(trial_fns%obj%ref_count > 0) 76 trial_fns%obj%ref_count = trial_fns%obj%ref_count + 1 77 END SUBROUTINE fb_trial_fns_retain 78 79! ************************************************************************************************** 80!> \brief releases given object 81!> \brief ... 82!> \param trial_fns : the fb_trial_fns object in question 83!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 84! ************************************************************************************************** 85 SUBROUTINE fb_trial_fns_release(trial_fns) 86 TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns 87 88 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_release', & 89 routineP = moduleN//':'//routineN 90 91 IF (ASSOCIATED(trial_fns%obj)) THEN 92 CPASSERT(trial_fns%obj%ref_count > 0) 93 trial_fns%obj%ref_count = trial_fns%obj%ref_count - 1 94 IF (trial_fns%obj%ref_count == 0) THEN 95 trial_fns%obj%ref_count = 1 96 IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN 97 DEALLOCATE (trial_fns%obj%nfunctions) 98 END IF 99 IF (ASSOCIATED(trial_fns%obj%functions)) THEN 100 DEALLOCATE (trial_fns%obj%functions) 101 END IF 102 trial_fns%obj%ref_count = 0 103 DEALLOCATE (trial_fns%obj) 104 END IF 105 ELSE 106 NULLIFY (trial_fns%obj) 107 END IF 108 END SUBROUTINE fb_trial_fns_release 109 110! ************************************************************************************************** 111!> \brief nullifies the content of given object 112!> \param trial_fns : the fb_trial_fns object in question 113!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 114! ************************************************************************************************** 115 SUBROUTINE fb_trial_fns_nullify(trial_fns) 116 TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns 117 118 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_nullify', & 119 routineP = moduleN//':'//routineN 120 121 NULLIFY (trial_fns%obj) 122 END SUBROUTINE fb_trial_fns_nullify 123 124! ************************************************************************************************** 125!> \brief associates the content of an object to that of another object 126!> of the same type 127!> \param a : the output object 128!> \param b : the input object 129!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 130! ************************************************************************************************** 131 SUBROUTINE fb_trial_fns_associate(a, b) 132 TYPE(fb_trial_fns_obj), INTENT(OUT) :: a 133 TYPE(fb_trial_fns_obj), INTENT(IN) :: b 134 135 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_associate', & 136 routineP = moduleN//':'//routineN 137 138 a%obj => b%obj 139 END SUBROUTINE fb_trial_fns_associate 140 141! ************************************************************************************************** 142!> \brief check if the object has data associated to it 143!> \param trial_fns : the fb_trial_fns object in question 144!> \return : true if trial_fns%obj is associated, false otherwise 145!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 146! ************************************************************************************************** 147 FUNCTION fb_trial_fns_has_data(trial_fns) RESULT(res) 148 TYPE(fb_trial_fns_obj), INTENT(IN) :: trial_fns 149 LOGICAL :: res 150 151 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_has_data', & 152 routineP = moduleN//':'//routineN 153 154 res = ASSOCIATED(trial_fns%obj) 155 END FUNCTION fb_trial_fns_has_data 156 157! ************************************************************************************************** 158!> \brief creates an fb_trial_fns object and initialises it 159!> \param trial_fns : the fb_trial_fns object in question 160!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 161! ************************************************************************************************** 162 SUBROUTINE fb_trial_fns_create(trial_fns) 163 TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns 164 165 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_create', & 166 routineP = moduleN//':'//routineN 167 168 CPASSERT(.NOT. ASSOCIATED(trial_fns%obj)) 169 ALLOCATE (trial_fns%obj) 170 NULLIFY (trial_fns%obj%nfunctions) 171 NULLIFY (trial_fns%obj%functions) 172 trial_fns%obj%ref_count = 1 173 trial_fns%obj%id_nr = last_fb_trial_fns_id + 1 174 last_fb_trial_fns_id = trial_fns%obj%id_nr 175 END SUBROUTINE fb_trial_fns_create 176 177! ************************************************************************************************** 178!> \brief initialises an fb_trial_fns object 179!> \param trial_fns : the fb_trial_fns object in question 180!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 181! ************************************************************************************************** 182 SUBROUTINE fb_trial_fns_init(trial_fns) 183 TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns 184 185 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_init', & 186 routineP = moduleN//':'//routineN 187 188 CPASSERT(ASSOCIATED(trial_fns%obj)) 189 ! if halo_atoms are associated, then deallocate and de-associate 190 IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN 191 DEALLOCATE (trial_fns%obj%nfunctions) 192 END IF 193 IF (ASSOCIATED(trial_fns%obj%functions)) THEN 194 DEALLOCATE (trial_fns%obj%functions) 195 END IF 196 END SUBROUTINE fb_trial_fns_init 197 198! ************************************************************************************************** 199!> \brief get values of the attributes of a fb_trial_fns object 200!> \param trial_fns : the fb_trial_fns object in question 201!> \param nfunctions : outputs pointer to trial_fns%obj%nfunctions 202!> \param functions : outputs pointer to trial_fns%obj%functions 203!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 204! ************************************************************************************************** 205 SUBROUTINE fb_trial_fns_get(trial_fns, & 206 nfunctions, & 207 functions) 208 TYPE(fb_trial_fns_obj), INTENT(IN) :: trial_fns 209 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nfunctions 210 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: functions 211 212 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_get', & 213 routineP = moduleN//':'//routineN 214 215 CPASSERT(ASSOCIATED(trial_fns%obj)) 216 IF (PRESENT(nfunctions)) nfunctions => trial_fns%obj%nfunctions 217 IF (PRESENT(functions)) functions => trial_fns%obj%functions 218 END SUBROUTINE fb_trial_fns_get 219 220! ************************************************************************************************** 221!> \brief sets the attributes of a fb_trial_fns object 222!> \param trial_fns : the fb_trial_fns object in question 223!> \param nfunctions : associates trial_fns%obj%nfunctions to this pointer 224!> \param functions : associates trial_fns%obj%nfunctions to this pointer 225!> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk 226! ************************************************************************************************** 227 SUBROUTINE fb_trial_fns_set(trial_fns, & 228 nfunctions, & 229 functions) 230 TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns 231 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nfunctions 232 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: functions 233 234 CHARACTER(len=*), PARAMETER :: routineN = 'fb_trial_fns_set', & 235 routineP = moduleN//':'//routineN 236 237 CPASSERT(ASSOCIATED(trial_fns%obj)) 238 IF (PRESENT(nfunctions)) THEN 239 IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN 240 DEALLOCATE (trial_fns%obj%nfunctions) 241 END IF 242 trial_fns%obj%nfunctions => nfunctions 243 END IF 244 IF (PRESENT(functions)) THEN 245 IF (ASSOCIATED(trial_fns%obj%functions)) THEN 246 DEALLOCATE (trial_fns%obj%functions) 247 END IF 248 trial_fns%obj%functions => functions 249 END IF 250 END SUBROUTINE fb_trial_fns_set 251 252END MODULE qs_fb_trial_fns_types 253