1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2020  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief Provides types for the management of the xc-functionals and
8!>      their derivatives.
9! **************************************************************************************************
10MODULE xc_derivative_types
11
12   USE kinds,                           ONLY: dp
13   USE pw_pool_types,                   ONLY: pw_pool_give_back_cr3d,&
14                                              pw_pool_type
15   USE xc_derivative_desc,              ONLY: MAX_DERIVATIVE_DESC_LENGTH,&
16                                              MAX_LABEL_LENGTH,&
17                                              create_split_derivative_desc,&
18                                              standardize_derivative_desc
19#include "../base/base_uses.f90"
20
21   IMPLICIT NONE
22
23   PRIVATE
24
25   INTEGER, SAVE :: derivative_id_nr = 1
26
27   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_derivative_types'
28
29   PUBLIC :: xc_derivative_type, xc_derivative_p_type
30   PUBLIC :: xc_derivative_create, xc_derivative_release, &
31             xc_derivative_get
32
33! **************************************************************************************************
34!> \brief represent a derivative of a functional
35! **************************************************************************************************
36   TYPE xc_derivative_type
37      INTEGER                                   :: ref_count, id_nr
38      CHARACTER(len=MAX_DERIVATIVE_DESC_LENGTH) :: desc
39      CHARACTER(len=MAX_LABEL_LENGTH), DIMENSION(:), POINTER :: split_desc
40      REAL(KIND=dp), DIMENSION(:, :, :), POINTER    :: deriv_data
41   END TYPE xc_derivative_type
42
43! **************************************************************************************************
44!> \brief represent a pointer to a derivative (to have arrays of derivatives)
45!> \param deriv the pointer to the derivative
46!> \par History
47!>      11.2003 created [fawzi]
48!> \author fawzi
49! **************************************************************************************************
50   TYPE xc_derivative_p_type
51      TYPE(xc_derivative_type), POINTER :: deriv
52   END TYPE xc_derivative_p_type
53
54CONTAINS
55
56! **************************************************************************************************
57!> \brief allocates and initializes a derivative type
58!> \param derivative the object to create
59!> \param desc the derivative description
60!> \param cr3d_ptr the data array (the ownership of it passes to the
61!>                      derivative type), the array is not zeroed
62! **************************************************************************************************
63   SUBROUTINE xc_derivative_create(derivative, desc, cr3d_ptr)
64
65      TYPE(xc_derivative_type), POINTER                  :: derivative
66      CHARACTER(len=*), INTENT(in)                       :: desc
67      REAL(kind=dp), DIMENSION(:, :, :), POINTER         :: cr3d_ptr
68
69      CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_create', &
70         routineP = moduleN//':'//routineN
71
72      CHARACTER(len=MAX_DERIVATIVE_DESC_LENGTH)          :: my_desc
73
74      ALLOCATE (derivative)
75
76      derivative%ref_count = 1
77      derivative%id_nr = derivative_id_nr
78      derivative_id_nr = derivative_id_nr + 1
79      CALL standardize_derivative_desc(desc, my_desc)
80      CALL create_split_derivative_desc(my_desc, derivative%split_desc)
81      derivative%desc = my_desc
82      derivative%deriv_data => cr3d_ptr
83
84   END SUBROUTINE xc_derivative_create
85
86! **************************************************************************************************
87!> \brief retains the given derivative (see doc/ReferenceCounting.html)
88!> \param deriv the object you want to retain
89!> \par History
90!>      11.2003 created [fawzi]
91!> \author fawzi
92! **************************************************************************************************
93   SUBROUTINE xc_derivative_retain(deriv)
94      TYPE(xc_derivative_type), POINTER                  :: deriv
95
96      CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_retain', &
97         routineP = moduleN//':'//routineN
98
99      CPASSERT(ASSOCIATED(deriv))
100      CPASSERT(deriv%ref_count > 0)
101      deriv%ref_count = deriv%ref_count + 1
102   END SUBROUTINE xc_derivative_retain
103
104! **************************************************************************************************
105!> \brief allocates and initializes a derivative type
106!> \param derivative the object to create
107!> \param pw_pool if given gives back the cr3d array %deriv_data back to it
108!>                      instead of deallocating it
109! **************************************************************************************************
110   SUBROUTINE xc_derivative_release(derivative, pw_pool)
111
112      TYPE(xc_derivative_type), POINTER                  :: derivative
113      TYPE(pw_pool_type), OPTIONAL, POINTER              :: pw_pool
114
115      CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_release', &
116         routineP = moduleN//':'//routineN
117
118      CPASSERT(ASSOCIATED(derivative))
119      CPASSERT(derivative%ref_count >= 1)
120
121      derivative%ref_count = derivative%ref_count - 1
122      IF (derivative%ref_count == 0) THEN
123         IF (PRESENT(pw_pool)) THEN
124            IF (ASSOCIATED(pw_pool)) THEN
125               CALL pw_pool_give_back_cr3d(pw_pool, derivative%deriv_data, &
126                                           accept_non_compatible=.TRUE.)
127            END IF
128         END IF
129         IF (ASSOCIATED(derivative%deriv_data)) THEN
130            DEALLOCATE (derivative%deriv_data)
131         END IF
132         DEALLOCATE (derivative%split_desc)
133
134         DEALLOCATE (derivative)
135      END IF
136      NULLIFY (derivative)
137
138   END SUBROUTINE xc_derivative_release
139
140! **************************************************************************************************
141!> \brief returns various information on the given derivative
142!> \param deriv the derivative you want information about
143!> \param desc a string that describes the derivative (empty string
144!>        for the function itself, otherwise a string of the form
145!>        "(rho)(rho)(norm_drhoa)")
146!> \param split_desc the same as desc but with an array of strings,
147!>        and a derivative coordinate in each string (the previous
148!>        example would become (/"rho","rho","norm_drhoa"/)
149!> \param order the order of the derivative
150!> \param deriv_data the 3d real array with the derivative
151!> \param accept_null_data if deriv_data can be unassociated (defaults to no)
152! **************************************************************************************************
153   SUBROUTINE xc_derivative_get(deriv, desc, split_desc, &
154                                order, deriv_data, accept_null_data)
155      TYPE(xc_derivative_type), POINTER                  :: deriv
156      CHARACTER(len=MAX_DERIVATIVE_DESC_LENGTH), &
157         INTENT(out), OPTIONAL                           :: desc
158      CHARACTER(len=MAX_LABEL_LENGTH), DIMENSION(:), &
159         OPTIONAL, POINTER                               :: split_desc
160      INTEGER, INTENT(out), OPTIONAL                     :: order
161      REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
162         POINTER                                         :: deriv_data
163      LOGICAL, INTENT(in), OPTIONAL                      :: accept_null_data
164
165      CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_get', &
166         routineP = moduleN//':'//routineN
167
168      LOGICAL                                            :: my_accept_null_data
169
170      my_accept_null_data = .FALSE.
171      IF (PRESENT(accept_null_data)) my_accept_null_data = accept_null_data
172
173      CPASSERT(ASSOCIATED(deriv))
174      CPASSERT(deriv%ref_count > 0)
175      IF (PRESENT(desc)) desc = deriv%desc
176      IF (PRESENT(split_desc)) split_desc => deriv%split_desc
177      IF (PRESENT(deriv_data)) THEN
178         deriv_data => deriv%deriv_data
179         IF (.NOT. my_accept_null_data) THEN
180            CPASSERT(ASSOCIATED(deriv_data))
181         END IF
182      END IF
183      IF (PRESENT(order)) order = SIZE(deriv%split_desc)
184   END SUBROUTINE xc_derivative_get
185
186END MODULE xc_derivative_types
187
188