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 : ! **************************************************************************************************
9 : !> \brief Provides types for the management of the xc-functionals and
10 : !> their derivatives.
11 : ! **************************************************************************************************
12 : MODULE xc_derivative_types
13 :
14 : USE kinds, ONLY: dp
15 : USE pw_pool_types, ONLY: pw_pool_type
16 : USE xc_derivative_desc, ONLY: create_split_desc
17 : #include "../base/base_uses.f90"
18 :
19 : IMPLICIT NONE
20 :
21 : PRIVATE
22 :
23 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_derivative_types'
24 :
25 : PUBLIC :: xc_derivative_type, xc_derivative_p_type
26 : PUBLIC :: xc_derivative_create, xc_derivative_release, &
27 : xc_derivative_get
28 :
29 : ! **************************************************************************************************
30 : !> \brief represent a derivative of a functional
31 : ! **************************************************************************************************
32 : TYPE xc_derivative_type
33 : INTEGER, DIMENSION(:), POINTER :: split_desc => NULL()
34 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER, CONTIGUOUS :: deriv_data => NULL()
35 : END TYPE xc_derivative_type
36 :
37 : ! **************************************************************************************************
38 : !> \brief represent a pointer to a derivative (to have arrays of derivatives)
39 : !> \param deriv the pointer to the derivative
40 : !> \par History
41 : !> 11.2003 created [fawzi]
42 : !> \author fawzi
43 : ! **************************************************************************************************
44 : TYPE xc_derivative_p_type
45 : TYPE(xc_derivative_type), POINTER :: deriv => NULL()
46 : END TYPE xc_derivative_p_type
47 :
48 : CONTAINS
49 :
50 : ! **************************************************************************************************
51 : !> \brief allocates and initializes a derivative type
52 : !> \param derivative the object to create
53 : !> \param desc the derivative description
54 : !> \param r3d_ptr the data array (the ownership of it passes to the
55 : !> derivative type), the array is not zeroed
56 : ! **************************************************************************************************
57 572950 : SUBROUTINE xc_derivative_create(derivative, desc, r3d_ptr)
58 :
59 : TYPE(xc_derivative_type) :: derivative
60 : INTEGER, DIMENSION(:), INTENT(in) :: desc
61 : REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), &
62 : POINTER :: r3d_ptr
63 :
64 572950 : CALL create_split_desc(desc, derivative%split_desc)
65 572950 : derivative%deriv_data => r3d_ptr
66 :
67 572950 : END SUBROUTINE xc_derivative_create
68 :
69 : ! **************************************************************************************************
70 : !> \brief allocates and initializes a derivative type
71 : !> \param derivative the object to create
72 : !> \param pw_pool if given gives back the cr3d array %deriv_data back to it
73 : !> instead of deallocating it
74 : ! **************************************************************************************************
75 572950 : SUBROUTINE xc_derivative_release(derivative, pw_pool)
76 :
77 : TYPE(xc_derivative_type) :: derivative
78 : TYPE(pw_pool_type), OPTIONAL, POINTER :: pw_pool
79 :
80 572950 : IF (PRESENT(pw_pool)) THEN
81 572950 : IF (ASSOCIATED(pw_pool)) THEN
82 572950 : CALL pw_pool%give_back_cr3d(derivative%deriv_data)
83 : END IF
84 : END IF
85 572950 : IF (ASSOCIATED(derivative%deriv_data)) THEN
86 0 : DEALLOCATE (derivative%deriv_data)
87 : END IF
88 572950 : IF (ASSOCIATED(derivative%split_desc)) DEALLOCATE (derivative%split_desc)
89 :
90 572950 : END SUBROUTINE xc_derivative_release
91 :
92 : ! **************************************************************************************************
93 : !> \brief returns various information on the given derivative
94 : !> \param deriv the derivative you want information about
95 : !> \param split_desc an array that describes the derivative (each position represents a variable,
96 : !> see xc_derivative_desc.F)
97 : !> \param order the order of the derivative
98 : !> \param deriv_data the 3d real array with the derivative
99 : !> \param accept_null_data if deriv_data can be unassociated (defaults to no)
100 : ! **************************************************************************************************
101 2262720 : SUBROUTINE xc_derivative_get(deriv, split_desc, &
102 : order, deriv_data, accept_null_data)
103 : TYPE(xc_derivative_type), INTENT(IN) :: deriv
104 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: split_desc
105 : INTEGER, INTENT(out), OPTIONAL :: order
106 : REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
107 : POINTER :: deriv_data
108 : LOGICAL, INTENT(in), OPTIONAL :: accept_null_data
109 :
110 : LOGICAL :: my_accept_null_data
111 :
112 2262720 : my_accept_null_data = .FALSE.
113 2262720 : IF (PRESENT(accept_null_data)) my_accept_null_data = accept_null_data
114 :
115 2262720 : IF (PRESENT(split_desc)) split_desc => deriv%split_desc
116 2262720 : IF (PRESENT(deriv_data)) THEN
117 1291996 : deriv_data => deriv%deriv_data
118 1291996 : IF (.NOT. my_accept_null_data) THEN
119 1291996 : CPASSERT(ASSOCIATED(deriv_data))
120 : END IF
121 : END IF
122 2262720 : IF (PRESENT(order)) order = SIZE(deriv%split_desc)
123 2262720 : END SUBROUTINE xc_derivative_get
124 :
125 0 : END MODULE xc_derivative_types
126 :
|