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