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 hartree_local_types
9 :
10 : USE kinds, ONLY: dp
11 : USE qs_rho_atom_types, ONLY: rho_atom_coeff
12 : #include "./base/base_uses.f90"
13 :
14 : IMPLICIT NONE
15 :
16 : PRIVATE
17 :
18 : ! *** Global parameters (only in this module)
19 :
20 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hartree_local_types'
21 :
22 : ! *** Define the ecoul_1center_type ***
23 :
24 : ! **************************************************************************************************
25 : TYPE ecoul_1center_type
26 : TYPE(rho_atom_coeff), POINTER :: Vh1_h => NULL(), Vh1_s => NULL()
27 : REAL(dp) :: ecoul_1_h = 0.0_dp, &
28 : ecoul_1_s = 0.0_dp, &
29 : ecoul_1_z = 0.0_dp, &
30 : ecoul_1_0 = 0.0_dp
31 : END TYPE ecoul_1center_type
32 :
33 : ! **************************************************************************************************
34 : TYPE hartree_local_type
35 : TYPE(ecoul_1center_type), &
36 : DIMENSION(:), POINTER :: ecoul_1c => NULL()
37 : END TYPE hartree_local_type
38 :
39 : ! *** Public subroutines ***
40 :
41 : PUBLIC :: allocate_ecoul_1center, &
42 : get_hartree_local, hartree_local_create, &
43 : hartree_local_release, set_ecoul_1c, &
44 : set_hartree_local
45 :
46 : ! *** Public data types ***
47 :
48 : PUBLIC :: ecoul_1center_type, hartree_local_type
49 :
50 : CONTAINS
51 :
52 : ! **************************************************************************************************
53 : !> \brief ...
54 : !> \param ecoul_1c ...
55 : !> \param natom ...
56 : ! **************************************************************************************************
57 1892 : SUBROUTINE allocate_ecoul_1center(ecoul_1c, natom)
58 :
59 : TYPE(ecoul_1center_type), DIMENSION(:), POINTER :: ecoul_1c
60 : INTEGER, INTENT(IN) :: natom
61 :
62 : INTEGER :: iat
63 :
64 1892 : IF (ASSOCIATED(ecoul_1c)) THEN
65 0 : CALL deallocate_ecoul_1center(ecoul_1c)
66 : END IF
67 :
68 11908 : ALLOCATE (ecoul_1c(natom))
69 :
70 8124 : DO iat = 1, natom
71 6232 : ALLOCATE (ecoul_1c(iat)%Vh1_h)
72 6232 : NULLIFY (ecoul_1c(iat)%Vh1_h%r_coef)
73 6232 : ALLOCATE (ecoul_1c(iat)%Vh1_s)
74 8124 : NULLIFY (ecoul_1c(iat)%Vh1_s%r_coef)
75 : END DO
76 :
77 1892 : END SUBROUTINE allocate_ecoul_1center
78 :
79 : ! **************************************************************************************************
80 : !> \brief ...
81 : !> \param ecoul_1c ...
82 : ! **************************************************************************************************
83 1892 : SUBROUTINE deallocate_ecoul_1center(ecoul_1c)
84 :
85 : TYPE(ecoul_1center_type), DIMENSION(:), POINTER :: ecoul_1c
86 :
87 : INTEGER :: iat, natom
88 :
89 1892 : natom = SIZE(ecoul_1c, 1)
90 :
91 8124 : DO iat = 1, natom
92 6232 : IF (ASSOCIATED(ecoul_1c(iat)%Vh1_h%r_coef)) THEN
93 0 : DEALLOCATE (ecoul_1c(iat)%Vh1_h%r_coef)
94 : END IF
95 6232 : DEALLOCATE (ecoul_1c(iat)%Vh1_h)
96 :
97 6232 : IF (ASSOCIATED(ecoul_1c(iat)%Vh1_s%r_coef)) THEN
98 0 : DEALLOCATE (ecoul_1c(iat)%Vh1_s%r_coef)
99 : END IF
100 8124 : DEALLOCATE (ecoul_1c(iat)%Vh1_s)
101 :
102 : END DO
103 :
104 1892 : DEALLOCATE (ecoul_1c)
105 :
106 1892 : END SUBROUTINE deallocate_ecoul_1center
107 :
108 : ! **************************************************************************************************
109 : !> \brief ...
110 : !> \param hartree_local ...
111 : !> \param ecoul_1c ...
112 : ! **************************************************************************************************
113 14634 : SUBROUTINE get_hartree_local(hartree_local, ecoul_1c)
114 :
115 : TYPE(hartree_local_type), POINTER :: hartree_local
116 : TYPE(ecoul_1center_type), DIMENSION(:), OPTIONAL, &
117 : POINTER :: ecoul_1c
118 :
119 14634 : IF (PRESENT(ecoul_1c)) ecoul_1c => hartree_local%ecoul_1c
120 :
121 14634 : END SUBROUTINE get_hartree_local
122 :
123 : ! **************************************************************************************************
124 : !> \brief ...
125 : !> \param hartree_local ...
126 : ! **************************************************************************************************
127 8464 : SUBROUTINE hartree_local_create(hartree_local)
128 :
129 : TYPE(hartree_local_type), POINTER :: hartree_local
130 :
131 8464 : ALLOCATE (hartree_local)
132 :
133 : NULLIFY (hartree_local%ecoul_1c)
134 :
135 8464 : END SUBROUTINE hartree_local_create
136 :
137 : ! **************************************************************************************************
138 : !> \brief ...
139 : !> \param hartree_local ...
140 : ! **************************************************************************************************
141 8520 : SUBROUTINE hartree_local_release(hartree_local)
142 :
143 : TYPE(hartree_local_type), POINTER :: hartree_local
144 :
145 8520 : IF (ASSOCIATED(hartree_local)) THEN
146 8464 : IF (ASSOCIATED(hartree_local%ecoul_1c)) THEN
147 1892 : CALL deallocate_ecoul_1center(hartree_local%ecoul_1c)
148 : END IF
149 :
150 8464 : DEALLOCATE (hartree_local)
151 : END IF
152 :
153 8520 : END SUBROUTINE hartree_local_release
154 :
155 : ! **************************************************************************************************
156 : !> \brief ...
157 : !> \param ecoul_1c ...
158 : !> \param iatom ...
159 : !> \param ecoul_1_h ...
160 : !> \param ecoul_1_s ...
161 : !> \param ecoul_1_z ...
162 : !> \param ecoul_1_0 ...
163 : ! **************************************************************************************************
164 51822 : SUBROUTINE set_ecoul_1c(ecoul_1c, iatom, ecoul_1_h, ecoul_1_s, ecoul_1_z, ecoul_1_0)
165 :
166 : TYPE(ecoul_1center_type), DIMENSION(:), POINTER :: ecoul_1c
167 : INTEGER, INTENT(IN), OPTIONAL :: iatom
168 : REAL(dp), INTENT(IN), OPTIONAL :: ecoul_1_h, ecoul_1_s, ecoul_1_z, &
169 : ecoul_1_0
170 :
171 51822 : IF (PRESENT(iatom)) THEN
172 51822 : IF (PRESENT(ecoul_1_h)) ecoul_1c(iatom)%ecoul_1_h = ecoul_1_h
173 51822 : IF (PRESENT(ecoul_1_s)) ecoul_1c(iatom)%ecoul_1_s = ecoul_1_s
174 51822 : IF (PRESENT(ecoul_1_0)) ecoul_1c(iatom)%ecoul_1_0 = ecoul_1_0
175 51822 : IF (PRESENT(ecoul_1_z)) ecoul_1c(iatom)%ecoul_1_z = ecoul_1_z
176 : END IF
177 :
178 51822 : END SUBROUTINE set_ecoul_1c
179 :
180 : ! **************************************************************************************************
181 : !> \brief ...
182 : !> \param hartree_local ...
183 : !> \param ecoul_1c ...
184 : ! **************************************************************************************************
185 0 : SUBROUTINE set_hartree_local(hartree_local, ecoul_1c)
186 :
187 : TYPE(hartree_local_type), POINTER :: hartree_local
188 : TYPE(ecoul_1center_type), DIMENSION(:), OPTIONAL, &
189 : POINTER :: ecoul_1c
190 :
191 0 : IF (PRESENT(ecoul_1c)) hartree_local%ecoul_1c => ecoul_1c
192 :
193 0 : END SUBROUTINE set_hartree_local
194 :
195 0 : END MODULE hartree_local_types
196 :
|
