Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : MODULE qs_fb_trial_fns_types
9 :
10 : #include "./base/base_uses.f90"
11 : IMPLICIT NONE
12 :
13 : PRIVATE
14 :
15 : ! public types
16 : PUBLIC :: fb_trial_fns_obj
17 :
18 : ! public methods
19 : !API
20 : PUBLIC :: fb_trial_fns_retain, &
21 : fb_trial_fns_release, &
22 : fb_trial_fns_nullify, &
23 : fb_trial_fns_associate, &
24 : fb_trial_fns_has_data, &
25 : fb_trial_fns_create, &
26 : fb_trial_fns_get, &
27 : fb_trial_fns_set
28 :
29 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fb_trial_fns_types'
30 :
31 : ! **************************************************************************************************
32 : !> \brief data containing information on trial functions used by filter
33 : !> matrix diagonalisation method
34 : !> \param nfunctions : nfunctions(ikind) = number of trial functions for
35 : !> atomic kind ikind
36 : !> \param functions : functions(itrial,ikind) = the index of the
37 : !> GTO atomic orbital corresponding to itrial-th trial
38 : !> function for kind ikind
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 :: ref_count = -1
44 : INTEGER, DIMENSION(:), POINTER :: nfunctions => NULL()
45 : INTEGER, DIMENSION(:, :), POINTER :: functions => NULL()
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 => NULL()
56 : END TYPE fb_trial_fns_obj
57 :
58 : CONTAINS
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 80 : 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 80 : CPASSERT(ASSOCIATED(trial_fns%obj))
72 80 : CPASSERT(trial_fns%obj%ref_count > 0)
73 80 : trial_fns%obj%ref_count = trial_fns%obj%ref_count + 1
74 80 : END SUBROUTINE fb_trial_fns_retain
75 :
76 : ! **************************************************************************************************
77 : !> \brief releases given object
78 : !> \brief ...
79 : !> \param trial_fns : the fb_trial_fns object in question
80 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
81 : ! **************************************************************************************************
82 170 : SUBROUTINE fb_trial_fns_release(trial_fns)
83 : TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns
84 :
85 170 : IF (ASSOCIATED(trial_fns%obj)) THEN
86 160 : CPASSERT(trial_fns%obj%ref_count > 0)
87 160 : trial_fns%obj%ref_count = trial_fns%obj%ref_count - 1
88 160 : IF (trial_fns%obj%ref_count == 0) THEN
89 80 : trial_fns%obj%ref_count = 1
90 80 : IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN
91 80 : DEALLOCATE (trial_fns%obj%nfunctions)
92 : END IF
93 80 : IF (ASSOCIATED(trial_fns%obj%functions)) THEN
94 80 : DEALLOCATE (trial_fns%obj%functions)
95 : END IF
96 80 : trial_fns%obj%ref_count = 0
97 80 : DEALLOCATE (trial_fns%obj)
98 : END IF
99 : ELSE
100 10 : NULLIFY (trial_fns%obj)
101 : END IF
102 170 : END SUBROUTINE fb_trial_fns_release
103 :
104 : ! **************************************************************************************************
105 : !> \brief nullifies the content of given object
106 : !> \param trial_fns : the fb_trial_fns object in question
107 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
108 : ! **************************************************************************************************
109 170 : SUBROUTINE fb_trial_fns_nullify(trial_fns)
110 : TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns
111 :
112 170 : NULLIFY (trial_fns%obj)
113 170 : END SUBROUTINE fb_trial_fns_nullify
114 :
115 : ! **************************************************************************************************
116 : !> \brief associates the content of an object to that of another object
117 : !> of the same type
118 : !> \param a : the output object
119 : !> \param b : the input object
120 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
121 : ! **************************************************************************************************
122 160 : SUBROUTINE fb_trial_fns_associate(a, b)
123 : TYPE(fb_trial_fns_obj), INTENT(OUT) :: a
124 : TYPE(fb_trial_fns_obj), INTENT(IN) :: b
125 :
126 160 : a%obj => b%obj
127 160 : END SUBROUTINE fb_trial_fns_associate
128 :
129 : ! **************************************************************************************************
130 : !> \brief check if the object has data associated to it
131 : !> \param trial_fns : the fb_trial_fns object in question
132 : !> \return : true if trial_fns%obj is associated, false otherwise
133 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
134 : ! **************************************************************************************************
135 80 : FUNCTION fb_trial_fns_has_data(trial_fns) RESULT(res)
136 : TYPE(fb_trial_fns_obj), INTENT(IN) :: trial_fns
137 : LOGICAL :: res
138 :
139 80 : res = ASSOCIATED(trial_fns%obj)
140 80 : END FUNCTION fb_trial_fns_has_data
141 :
142 : ! **************************************************************************************************
143 : !> \brief creates an fb_trial_fns object and initialises it
144 : !> \param trial_fns : the fb_trial_fns object in question
145 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
146 : ! **************************************************************************************************
147 80 : SUBROUTINE fb_trial_fns_create(trial_fns)
148 : TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns
149 :
150 80 : CPASSERT(.NOT. ASSOCIATED(trial_fns%obj))
151 80 : ALLOCATE (trial_fns%obj)
152 : NULLIFY (trial_fns%obj%nfunctions)
153 : NULLIFY (trial_fns%obj%functions)
154 80 : trial_fns%obj%ref_count = 1
155 80 : END SUBROUTINE fb_trial_fns_create
156 :
157 : ! **************************************************************************************************
158 : !> \brief initialises an fb_trial_fns object
159 : !> \param trial_fns : the fb_trial_fns object in question
160 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
161 : ! **************************************************************************************************
162 0 : SUBROUTINE fb_trial_fns_init(trial_fns)
163 : TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns
164 :
165 0 : CPASSERT(ASSOCIATED(trial_fns%obj))
166 : ! if halo_atoms are associated, then deallocate and de-associate
167 0 : IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN
168 0 : DEALLOCATE (trial_fns%obj%nfunctions)
169 : END IF
170 0 : IF (ASSOCIATED(trial_fns%obj%functions)) THEN
171 0 : DEALLOCATE (trial_fns%obj%functions)
172 : END IF
173 0 : END SUBROUTINE fb_trial_fns_init
174 :
175 : ! **************************************************************************************************
176 : !> \brief get values of the attributes of a fb_trial_fns object
177 : !> \param trial_fns : the fb_trial_fns object in question
178 : !> \param nfunctions : outputs pointer to trial_fns%obj%nfunctions
179 : !> \param functions : outputs pointer to trial_fns%obj%functions
180 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
181 : ! **************************************************************************************************
182 400 : SUBROUTINE fb_trial_fns_get(trial_fns, &
183 : nfunctions, &
184 : functions)
185 : TYPE(fb_trial_fns_obj), INTENT(IN) :: trial_fns
186 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nfunctions
187 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: functions
188 :
189 400 : CPASSERT(ASSOCIATED(trial_fns%obj))
190 400 : IF (PRESENT(nfunctions)) nfunctions => trial_fns%obj%nfunctions
191 400 : IF (PRESENT(functions)) functions => trial_fns%obj%functions
192 400 : END SUBROUTINE fb_trial_fns_get
193 :
194 : ! **************************************************************************************************
195 : !> \brief sets the attributes of a fb_trial_fns object
196 : !> \param trial_fns : the fb_trial_fns object in question
197 : !> \param nfunctions : associates trial_fns%obj%nfunctions to this pointer
198 : !> \param functions : associates trial_fns%obj%nfunctions to this pointer
199 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
200 : ! **************************************************************************************************
201 80 : SUBROUTINE fb_trial_fns_set(trial_fns, &
202 : nfunctions, &
203 : functions)
204 : TYPE(fb_trial_fns_obj), INTENT(INOUT) :: trial_fns
205 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nfunctions
206 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: functions
207 :
208 80 : CPASSERT(ASSOCIATED(trial_fns%obj))
209 80 : IF (PRESENT(nfunctions)) THEN
210 80 : IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN
211 0 : DEALLOCATE (trial_fns%obj%nfunctions)
212 : END IF
213 80 : trial_fns%obj%nfunctions => nfunctions
214 : END IF
215 80 : IF (PRESENT(functions)) THEN
216 80 : IF (ASSOCIATED(trial_fns%obj%functions)) THEN
217 0 : DEALLOCATE (trial_fns%obj%functions)
218 : END IF
219 80 : trial_fns%obj%functions => functions
220 : END IF
221 80 : END SUBROUTINE fb_trial_fns_set
222 :
223 0 : END MODULE qs_fb_trial_fns_types
|
