Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \par History
10 : !> - Refactoring (4.4.2007, JGH)
11 : !> - Revise virial components (16.10.2020, MK)
12 : ! **************************************************************************************************
13 : MODULE virial_types
14 :
15 : USE kinds, ONLY: dp
16 : #include "../base/base_uses.f90"
17 :
18 : IMPLICIT NONE
19 :
20 : PRIVATE
21 :
22 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'virial_types'
23 :
24 : PUBLIC :: virial_type, virial_p_type
25 :
26 : TYPE virial_type
27 : REAL(KIND=dp), DIMENSION(3, 3) :: pv_total = 0.0_dp, &
28 : pv_kinetic = 0.0_dp, &
29 : pv_virial = 0.0_dp, &
30 : pv_xc = 0.0_dp, &
31 : pv_fock_4c = 0.0_dp, &
32 : pv_constraint = 0.0_dp
33 : REAL(KIND=dp), DIMENSION(3, 3) :: pv_overlap = 0.0_dp, &
34 : pv_ekinetic = 0.0_dp, &
35 : pv_ppl = 0.0_dp, &
36 : pv_ppnl = 0.0_dp, &
37 : pv_ecore_overlap = 0.0_dp, &
38 : pv_ehartree = 0.0_dp, &
39 : pv_exc = 0.0_dp, &
40 : pv_exx = 0.0_dp, &
41 : pv_vdw = 0.0_dp, &
42 : pv_mp2 = 0.0_dp, &
43 : pv_nlcc = 0.0_dp, &
44 : pv_gapw = 0.0_dp, &
45 : pv_lrigpw = 0.0_dp
46 : LOGICAL :: pv_availability = .FALSE., &
47 : pv_calculate = .FALSE., &
48 : pv_numer = .FALSE., &
49 : pv_diagonal = .FALSE.
50 : END TYPE virial_type
51 :
52 : TYPE virial_p_type
53 : TYPE(virial_type), POINTER :: virial => NULL()
54 : END TYPE virial_p_type
55 :
56 : PUBLIC :: project_virial_to_periodic_subspace, &
57 : symmetrize_virial, virial_set, zero_virial
58 :
59 : CONTAINS
60 :
61 : ! **************************************************************************************************
62 : !> \brief Project a tensor to the periodic subspace of a low-dimensional cell.
63 : !> \param pv Tensor to be projected
64 : !> \param periodic Periodicity flags for x, y, and z
65 : ! **************************************************************************************************
66 304 : SUBROUTINE project_tensor_to_periodic_subspace(pv, periodic)
67 : REAL(KIND=dp), DIMENSION(3, 3), INTENT(INOUT) :: pv
68 : INTEGER, DIMENSION(3), INTENT(IN) :: periodic
69 :
70 : INTEGER :: i
71 :
72 1216 : DO i = 1, 3
73 1216 : IF (periodic(i) == 0) THEN
74 1216 : pv(i, :) = 0.0_dp
75 1216 : pv(:, i) = 0.0_dp
76 : END IF
77 : END DO
78 :
79 304 : END SUBROUTINE project_tensor_to_periodic_subspace
80 :
81 : ! **************************************************************************************************
82 : !> \brief Project all virial components to the periodic subspace of a low-dimensional cell.
83 : !> \param virial Virial object to be projected
84 : !> \param periodic Periodicity flags for x, y, and z
85 : ! **************************************************************************************************
86 16 : SUBROUTINE project_virial_to_periodic_subspace(virial, periodic)
87 : TYPE(virial_type), INTENT(INOUT) :: virial
88 : INTEGER, DIMENSION(3), INTENT(IN) :: periodic
89 :
90 16 : CALL project_tensor_to_periodic_subspace(virial%pv_total, periodic)
91 16 : CALL project_tensor_to_periodic_subspace(virial%pv_kinetic, periodic)
92 16 : CALL project_tensor_to_periodic_subspace(virial%pv_virial, periodic)
93 16 : CALL project_tensor_to_periodic_subspace(virial%pv_xc, periodic)
94 16 : CALL project_tensor_to_periodic_subspace(virial%pv_fock_4c, periodic)
95 16 : CALL project_tensor_to_periodic_subspace(virial%pv_constraint, periodic)
96 16 : CALL project_tensor_to_periodic_subspace(virial%pv_overlap, periodic)
97 16 : CALL project_tensor_to_periodic_subspace(virial%pv_ekinetic, periodic)
98 16 : CALL project_tensor_to_periodic_subspace(virial%pv_ppl, periodic)
99 16 : CALL project_tensor_to_periodic_subspace(virial%pv_ppnl, periodic)
100 16 : CALL project_tensor_to_periodic_subspace(virial%pv_ecore_overlap, periodic)
101 16 : CALL project_tensor_to_periodic_subspace(virial%pv_ehartree, periodic)
102 16 : CALL project_tensor_to_periodic_subspace(virial%pv_exc, periodic)
103 16 : CALL project_tensor_to_periodic_subspace(virial%pv_exx, periodic)
104 16 : CALL project_tensor_to_periodic_subspace(virial%pv_vdw, periodic)
105 16 : CALL project_tensor_to_periodic_subspace(virial%pv_mp2, periodic)
106 16 : CALL project_tensor_to_periodic_subspace(virial%pv_nlcc, periodic)
107 16 : CALL project_tensor_to_periodic_subspace(virial%pv_gapw, periodic)
108 16 : CALL project_tensor_to_periodic_subspace(virial%pv_lrigpw, periodic)
109 :
110 16 : END SUBROUTINE project_virial_to_periodic_subspace
111 :
112 : ! **************************************************************************************************
113 : !> \brief Symmetrize the virial components
114 : !> \param virial ...
115 : !> \version 1.0
116 : ! **************************************************************************************************
117 14836 : SUBROUTINE symmetrize_virial(virial)
118 : TYPE(virial_type), INTENT(INOUT) :: virial
119 :
120 : INTEGER :: i, j
121 :
122 59344 : DO i = 1, 3
123 103852 : DO j = 1, i - 1
124 44508 : virial%pv_total(j, i) = 0.5_dp*(virial%pv_total(i, j) + virial%pv_total(j, i))
125 44508 : virial%pv_total(i, j) = virial%pv_total(j, i)
126 44508 : virial%pv_kinetic(j, i) = 0.5_dp*(virial%pv_kinetic(i, j) + virial%pv_kinetic(j, i))
127 44508 : virial%pv_kinetic(i, j) = virial%pv_kinetic(j, i)
128 44508 : virial%pv_virial(j, i) = 0.5_dp*(virial%pv_virial(i, j) + virial%pv_virial(j, i))
129 44508 : virial%pv_virial(i, j) = virial%pv_virial(j, i)
130 44508 : virial%pv_xc(j, i) = 0.5_dp*(virial%pv_xc(i, j) + virial%pv_xc(j, i))
131 44508 : virial%pv_xc(i, j) = virial%pv_xc(j, i)
132 44508 : virial%pv_fock_4c(j, i) = 0.5_dp*(virial%pv_fock_4c(i, j) + virial%pv_fock_4c(j, i))
133 44508 : virial%pv_fock_4c(i, j) = virial%pv_fock_4c(j, i)
134 44508 : virial%pv_constraint(j, i) = 0.5_dp*(virial%pv_constraint(i, j) + virial%pv_constraint(j, i))
135 44508 : virial%pv_constraint(i, j) = virial%pv_constraint(j, i)
136 : ! Virial components
137 44508 : virial%pv_overlap(j, i) = 0.5_dp*(virial%pv_overlap(i, j) + virial%pv_overlap(j, i))
138 44508 : virial%pv_overlap(i, j) = virial%pv_overlap(j, i)
139 44508 : virial%pv_ekinetic(j, i) = 0.5_dp*(virial%pv_ekinetic(i, j) + virial%pv_ekinetic(j, i))
140 44508 : virial%pv_ekinetic(i, j) = virial%pv_ekinetic(j, i)
141 44508 : virial%pv_ppl(j, i) = 0.5_dp*(virial%pv_ppl(i, j) + virial%pv_ppl(j, i))
142 44508 : virial%pv_ppl(i, j) = virial%pv_ppl(j, i)
143 44508 : virial%pv_ppnl(j, i) = 0.5_dp*(virial%pv_ppnl(i, j) + virial%pv_ppnl(j, i))
144 44508 : virial%pv_ppnl(i, j) = virial%pv_ppnl(j, i)
145 44508 : virial%pv_ecore_overlap(j, i) = 0.5_dp*(virial%pv_ecore_overlap(i, j) + virial%pv_ecore_overlap(j, i))
146 44508 : virial%pv_ecore_overlap(i, j) = virial%pv_ecore_overlap(j, i)
147 44508 : virial%pv_ehartree(j, i) = 0.5_dp*(virial%pv_ehartree(i, j) + virial%pv_ehartree(j, i))
148 44508 : virial%pv_ehartree(i, j) = virial%pv_ehartree(j, i)
149 44508 : virial%pv_exc(j, i) = 0.5_dp*(virial%pv_exc(i, j) + virial%pv_exc(j, i))
150 44508 : virial%pv_exc(i, j) = virial%pv_exc(j, i)
151 44508 : virial%pv_exx(j, i) = 0.5_dp*(virial%pv_exx(i, j) + virial%pv_exx(j, i))
152 44508 : virial%pv_exx(i, j) = virial%pv_exx(j, i)
153 44508 : virial%pv_vdw(j, i) = 0.5_dp*(virial%pv_vdw(i, j) + virial%pv_vdw(j, i))
154 44508 : virial%pv_vdw(i, j) = virial%pv_vdw(j, i)
155 44508 : virial%pv_mp2(j, i) = 0.5_dp*(virial%pv_mp2(i, j) + virial%pv_mp2(j, i))
156 44508 : virial%pv_mp2(i, j) = virial%pv_mp2(j, i)
157 44508 : virial%pv_nlcc(j, i) = 0.5_dp*(virial%pv_nlcc(i, j) + virial%pv_nlcc(j, i))
158 44508 : virial%pv_nlcc(i, j) = virial%pv_nlcc(j, i)
159 44508 : virial%pv_gapw(j, i) = 0.5_dp*(virial%pv_gapw(i, j) + virial%pv_gapw(j, i))
160 44508 : virial%pv_gapw(i, j) = virial%pv_gapw(j, i)
161 44508 : virial%pv_lrigpw(j, i) = 0.5_dp*(virial%pv_lrigpw(i, j) + virial%pv_lrigpw(j, i))
162 89016 : virial%pv_lrigpw(i, j) = virial%pv_lrigpw(j, i)
163 : END DO
164 : END DO
165 :
166 14836 : END SUBROUTINE symmetrize_virial
167 :
168 : ! **************************************************************************************************
169 : !> \brief ...
170 : !> \param virial ...
171 : !> \param reset ...
172 : ! **************************************************************************************************
173 28722 : SUBROUTINE zero_virial(virial, reset)
174 : TYPE(virial_type), INTENT(INOUT) :: virial
175 : LOGICAL, INTENT(IN), OPTIONAL :: reset
176 :
177 : LOGICAL :: my_reset
178 :
179 28722 : my_reset = .TRUE.
180 28722 : IF (PRESENT(reset)) my_reset = reset
181 :
182 373386 : virial%pv_total = 0.0_dp
183 373386 : virial%pv_kinetic = 0.0_dp
184 373386 : virial%pv_virial = 0.0_dp
185 373386 : virial%pv_xc = 0.0_dp
186 373386 : virial%pv_fock_4c = 0.0_dp
187 373386 : virial%pv_constraint = 0.0_dp
188 :
189 373386 : virial%pv_overlap = 0.0_dp
190 373386 : virial%pv_ekinetic = 0.0_dp
191 373386 : virial%pv_ppl = 0.0_dp
192 373386 : virial%pv_ppnl = 0.0_dp
193 373386 : virial%pv_ecore_overlap = 0.0_dp
194 373386 : virial%pv_ehartree = 0.0_dp
195 373386 : virial%pv_exc = 0.0_dp
196 373386 : virial%pv_exx = 0.0_dp
197 373386 : virial%pv_vdw = 0.0_dp
198 373386 : virial%pv_mp2 = 0.0_dp
199 373386 : virial%pv_nlcc = 0.0_dp
200 373386 : virial%pv_gapw = 0.0_dp
201 373386 : virial%pv_lrigpw = 0.0_dp
202 :
203 28722 : IF (my_reset) THEN
204 0 : virial%pv_availability = .FALSE.
205 0 : virial%pv_calculate = .FALSE.
206 0 : virial%pv_numer = .FALSE.
207 0 : virial%pv_diagonal = .FALSE.
208 : END IF
209 :
210 28722 : END SUBROUTINE zero_virial
211 :
212 : ! **************************************************************************************************
213 : !> \brief ...
214 : !> \param virial ...
215 : !> \param pv_total ...
216 : !> \param pv_kinetic ...
217 : !> \param pv_virial ...
218 : !> \param pv_xc ...
219 : !> \param pv_fock_4c ...
220 : !> \param pv_constraint ...
221 : !> \param pv_overlap ...
222 : !> \param pv_ekinetic ...
223 : !> \param pv_ppl ...
224 : !> \param pv_ppnl ...
225 : !> \param pv_ecore_overlap ...
226 : !> \param pv_ehartree ...
227 : !> \param pv_exc ...
228 : !> \param pv_exx ...
229 : !> \param pv_vdw ...
230 : !> \param pv_mp2 ...
231 : !> \param pv_nlcc ...
232 : !> \param pv_gapw ...
233 : !> \param pv_lrigpw ...
234 : !> \param pv_availability ...
235 : !> \param pv_calculate ...
236 : !> \param pv_numer ...
237 : !> \param pv_diagonal ...
238 : ! **************************************************************************************************
239 11149 : SUBROUTINE virial_set(virial, pv_total, pv_kinetic, pv_virial, pv_xc, pv_fock_4c, pv_constraint, &
240 : pv_overlap, pv_ekinetic, pv_ppl, pv_ppnl, pv_ecore_overlap, pv_ehartree, &
241 : pv_exc, pv_exx, pv_vdw, pv_mp2, pv_nlcc, pv_gapw, pv_lrigpw, &
242 : pv_availability, pv_calculate, pv_numer, pv_diagonal)
243 :
244 : TYPE(virial_type), INTENT(INOUT) :: virial
245 : REAL(KIND=dp), DIMENSION(3, 3), OPTIONAL :: pv_total, pv_kinetic, pv_virial, pv_xc, &
246 : pv_fock_4c, pv_constraint, pv_overlap, pv_ekinetic, pv_ppl, pv_ppnl, pv_ecore_overlap, &
247 : pv_ehartree, pv_exc, pv_exx, pv_vdw, pv_mp2, pv_nlcc, pv_gapw, pv_lrigpw
248 : LOGICAL, OPTIONAL :: pv_availability, pv_calculate, pv_numer, &
249 : pv_diagonal
250 :
251 11149 : IF (PRESENT(pv_total)) virial%pv_total = pv_total
252 11149 : IF (PRESENT(pv_kinetic)) virial%pv_kinetic = pv_kinetic
253 11149 : IF (PRESENT(pv_virial)) virial%pv_virial = pv_virial
254 11149 : IF (PRESENT(pv_xc)) virial%pv_xc = pv_xc
255 11149 : IF (PRESENT(pv_fock_4c)) virial%pv_fock_4c = pv_fock_4c
256 11149 : IF (PRESENT(pv_constraint)) virial%pv_constraint = pv_constraint
257 :
258 11149 : IF (PRESENT(pv_overlap)) virial%pv_overlap = pv_overlap
259 11149 : IF (PRESENT(pv_ekinetic)) virial%pv_ekinetic = pv_ekinetic
260 11149 : IF (PRESENT(pv_ppl)) virial%pv_ppl = pv_ppl
261 11149 : IF (PRESENT(pv_ppnl)) virial%pv_ppnl = pv_ppnl
262 11149 : IF (PRESENT(pv_ecore_overlap)) virial%pv_ecore_overlap = pv_ecore_overlap
263 11149 : IF (PRESENT(pv_ehartree)) virial%pv_ehartree = pv_ehartree
264 11149 : IF (PRESENT(pv_exc)) virial%pv_exc = pv_exc
265 11149 : IF (PRESENT(pv_exx)) virial%pv_exx = pv_exx
266 11149 : IF (PRESENT(pv_vdw)) virial%pv_vdw = pv_vdw
267 11149 : IF (PRESENT(pv_mp2)) virial%pv_mp2 = pv_mp2
268 11149 : IF (PRESENT(pv_nlcc)) virial%pv_nlcc = pv_nlcc
269 11149 : IF (PRESENT(pv_gapw)) virial%pv_gapw = pv_gapw
270 11149 : IF (PRESENT(pv_lrigpw)) virial%pv_lrigpw = pv_lrigpw
271 :
272 11149 : IF (PRESENT(pv_availability)) virial%pv_availability = pv_availability
273 11149 : IF (PRESENT(pv_calculate)) virial%pv_calculate = pv_calculate
274 11149 : IF (PRESENT(pv_numer)) virial%pv_numer = pv_numer
275 11149 : IF (PRESENT(pv_diagonal)) virial%pv_diagonal = pv_diagonal
276 :
277 11149 : END SUBROUTINE virial_set
278 :
279 0 : END MODULE virial_types
|
