Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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 :: virial_set, &
57 : symmetrize_virial, zero_virial
58 :
59 : CONTAINS
60 :
61 : ! **************************************************************************************************
62 : !> \brief Symmetrize the virial components
63 : !> \param virial ...
64 : !> \version 1.0
65 : ! **************************************************************************************************
66 18130 : SUBROUTINE symmetrize_virial(virial)
67 : TYPE(virial_type), INTENT(INOUT) :: virial
68 :
69 : INTEGER :: i, j
70 :
71 72520 : DO i = 1, 3
72 126910 : DO j = 1, i - 1
73 54390 : virial%pv_total(j, i) = 0.5_dp*(virial%pv_total(i, j) + virial%pv_total(j, i))
74 54390 : virial%pv_total(i, j) = virial%pv_total(j, i)
75 54390 : virial%pv_kinetic(j, i) = 0.5_dp*(virial%pv_kinetic(i, j) + virial%pv_kinetic(j, i))
76 54390 : virial%pv_kinetic(i, j) = virial%pv_kinetic(j, i)
77 54390 : virial%pv_virial(j, i) = 0.5_dp*(virial%pv_virial(i, j) + virial%pv_virial(j, i))
78 54390 : virial%pv_virial(i, j) = virial%pv_virial(j, i)
79 54390 : virial%pv_xc(j, i) = 0.5_dp*(virial%pv_xc(i, j) + virial%pv_xc(j, i))
80 54390 : virial%pv_xc(i, j) = virial%pv_xc(j, i)
81 54390 : virial%pv_fock_4c(j, i) = 0.5_dp*(virial%pv_fock_4c(i, j) + virial%pv_fock_4c(j, i))
82 54390 : virial%pv_fock_4c(i, j) = virial%pv_fock_4c(j, i)
83 54390 : virial%pv_constraint(j, i) = 0.5_dp*(virial%pv_constraint(i, j) + virial%pv_constraint(j, i))
84 54390 : virial%pv_constraint(i, j) = virial%pv_constraint(j, i)
85 : ! Virial components
86 54390 : virial%pv_overlap(j, i) = 0.5_dp*(virial%pv_overlap(i, j) + virial%pv_overlap(j, i))
87 54390 : virial%pv_overlap(i, j) = virial%pv_overlap(j, i)
88 54390 : virial%pv_ekinetic(j, i) = 0.5_dp*(virial%pv_ekinetic(i, j) + virial%pv_ekinetic(j, i))
89 54390 : virial%pv_ekinetic(i, j) = virial%pv_ekinetic(j, i)
90 54390 : virial%pv_ppl(j, i) = 0.5_dp*(virial%pv_ppl(i, j) + virial%pv_ppl(j, i))
91 54390 : virial%pv_ppl(i, j) = virial%pv_ppl(j, i)
92 54390 : virial%pv_ppnl(j, i) = 0.5_dp*(virial%pv_ppnl(i, j) + virial%pv_ppnl(j, i))
93 54390 : virial%pv_ppnl(i, j) = virial%pv_ppnl(j, i)
94 54390 : virial%pv_ecore_overlap(j, i) = 0.5_dp*(virial%pv_ecore_overlap(i, j) + virial%pv_ecore_overlap(j, i))
95 54390 : virial%pv_ecore_overlap(i, j) = virial%pv_ecore_overlap(j, i)
96 54390 : virial%pv_ehartree(j, i) = 0.5_dp*(virial%pv_ehartree(i, j) + virial%pv_ehartree(j, i))
97 54390 : virial%pv_ehartree(i, j) = virial%pv_ehartree(j, i)
98 54390 : virial%pv_exc(j, i) = 0.5_dp*(virial%pv_exc(i, j) + virial%pv_exc(j, i))
99 54390 : virial%pv_exc(i, j) = virial%pv_exc(j, i)
100 54390 : virial%pv_exx(j, i) = 0.5_dp*(virial%pv_exx(i, j) + virial%pv_exx(j, i))
101 54390 : virial%pv_exx(i, j) = virial%pv_exx(j, i)
102 54390 : virial%pv_vdw(j, i) = 0.5_dp*(virial%pv_vdw(i, j) + virial%pv_vdw(j, i))
103 54390 : virial%pv_vdw(i, j) = virial%pv_vdw(j, i)
104 54390 : virial%pv_mp2(j, i) = 0.5_dp*(virial%pv_mp2(i, j) + virial%pv_mp2(j, i))
105 54390 : virial%pv_mp2(i, j) = virial%pv_mp2(j, i)
106 54390 : virial%pv_nlcc(j, i) = 0.5_dp*(virial%pv_nlcc(i, j) + virial%pv_nlcc(j, i))
107 54390 : virial%pv_nlcc(i, j) = virial%pv_nlcc(j, i)
108 54390 : virial%pv_gapw(j, i) = 0.5_dp*(virial%pv_gapw(i, j) + virial%pv_gapw(j, i))
109 54390 : virial%pv_gapw(i, j) = virial%pv_gapw(j, i)
110 54390 : virial%pv_lrigpw(j, i) = 0.5_dp*(virial%pv_lrigpw(i, j) + virial%pv_lrigpw(j, i))
111 108780 : virial%pv_lrigpw(i, j) = virial%pv_lrigpw(j, i)
112 : END DO
113 : END DO
114 :
115 18130 : END SUBROUTINE symmetrize_virial
116 :
117 : ! **************************************************************************************************
118 : !> \brief ...
119 : !> \param virial ...
120 : !> \param reset ...
121 : ! **************************************************************************************************
122 23654 : SUBROUTINE zero_virial(virial, reset)
123 : TYPE(virial_type), INTENT(INOUT) :: virial
124 : LOGICAL, INTENT(IN), OPTIONAL :: reset
125 :
126 : LOGICAL :: my_reset
127 :
128 23654 : my_reset = .TRUE.
129 23654 : IF (PRESENT(reset)) my_reset = reset
130 :
131 307502 : virial%pv_total = 0.0_dp
132 307502 : virial%pv_kinetic = 0.0_dp
133 307502 : virial%pv_virial = 0.0_dp
134 307502 : virial%pv_xc = 0.0_dp
135 307502 : virial%pv_fock_4c = 0.0_dp
136 307502 : virial%pv_constraint = 0.0_dp
137 :
138 307502 : virial%pv_overlap = 0.0_dp
139 307502 : virial%pv_ekinetic = 0.0_dp
140 307502 : virial%pv_ppl = 0.0_dp
141 307502 : virial%pv_ppnl = 0.0_dp
142 307502 : virial%pv_ecore_overlap = 0.0_dp
143 307502 : virial%pv_ehartree = 0.0_dp
144 307502 : virial%pv_exc = 0.0_dp
145 307502 : virial%pv_exx = 0.0_dp
146 307502 : virial%pv_vdw = 0.0_dp
147 307502 : virial%pv_mp2 = 0.0_dp
148 307502 : virial%pv_nlcc = 0.0_dp
149 307502 : virial%pv_gapw = 0.0_dp
150 307502 : virial%pv_lrigpw = 0.0_dp
151 :
152 23654 : IF (my_reset) THEN
153 0 : virial%pv_availability = .FALSE.
154 0 : virial%pv_calculate = .FALSE.
155 0 : virial%pv_numer = .FALSE.
156 0 : virial%pv_diagonal = .FALSE.
157 : END IF
158 :
159 23654 : END SUBROUTINE zero_virial
160 :
161 : ! **************************************************************************************************
162 : !> \brief ...
163 : !> \param virial ...
164 : !> \param pv_total ...
165 : !> \param pv_kinetic ...
166 : !> \param pv_virial ...
167 : !> \param pv_xc ...
168 : !> \param pv_fock_4c ...
169 : !> \param pv_constraint ...
170 : !> \param pv_overlap ...
171 : !> \param pv_ekinetic ...
172 : !> \param pv_ppl ...
173 : !> \param pv_ppnl ...
174 : !> \param pv_ecore_overlap ...
175 : !> \param pv_ehartree ...
176 : !> \param pv_exc ...
177 : !> \param pv_exx ...
178 : !> \param pv_vdw ...
179 : !> \param pv_mp2 ...
180 : !> \param pv_nlcc ...
181 : !> \param pv_gapw ...
182 : !> \param pv_lrigpw ...
183 : !> \param pv_availability ...
184 : !> \param pv_calculate ...
185 : !> \param pv_numer ...
186 : !> \param pv_diagonal ...
187 : ! **************************************************************************************************
188 9093 : SUBROUTINE virial_set(virial, pv_total, pv_kinetic, pv_virial, pv_xc, pv_fock_4c, pv_constraint, &
189 : pv_overlap, pv_ekinetic, pv_ppl, pv_ppnl, pv_ecore_overlap, pv_ehartree, &
190 : pv_exc, pv_exx, pv_vdw, pv_mp2, pv_nlcc, pv_gapw, pv_lrigpw, &
191 : pv_availability, pv_calculate, pv_numer, pv_diagonal)
192 :
193 : TYPE(virial_type), INTENT(INOUT) :: virial
194 : REAL(KIND=dp), DIMENSION(3, 3), OPTIONAL :: pv_total, pv_kinetic, pv_virial, pv_xc, &
195 : pv_fock_4c, pv_constraint, pv_overlap, pv_ekinetic, pv_ppl, pv_ppnl, pv_ecore_overlap, &
196 : pv_ehartree, pv_exc, pv_exx, pv_vdw, pv_mp2, pv_nlcc, pv_gapw, pv_lrigpw
197 : LOGICAL, OPTIONAL :: pv_availability, pv_calculate, pv_numer, &
198 : pv_diagonal
199 :
200 9093 : IF (PRESENT(pv_total)) virial%pv_total = pv_total
201 9093 : IF (PRESENT(pv_kinetic)) virial%pv_kinetic = pv_kinetic
202 9093 : IF (PRESENT(pv_virial)) virial%pv_virial = pv_virial
203 9093 : IF (PRESENT(pv_xc)) virial%pv_xc = pv_xc
204 9093 : IF (PRESENT(pv_fock_4c)) virial%pv_fock_4c = pv_fock_4c
205 9093 : IF (PRESENT(pv_constraint)) virial%pv_constraint = pv_constraint
206 :
207 9093 : IF (PRESENT(pv_overlap)) virial%pv_overlap = pv_overlap
208 9093 : IF (PRESENT(pv_ekinetic)) virial%pv_ekinetic = pv_ekinetic
209 9093 : IF (PRESENT(pv_ppl)) virial%pv_ppl = pv_ppl
210 9093 : IF (PRESENT(pv_ppnl)) virial%pv_ppnl = pv_ppnl
211 9093 : IF (PRESENT(pv_ecore_overlap)) virial%pv_ecore_overlap = pv_ecore_overlap
212 9093 : IF (PRESENT(pv_ehartree)) virial%pv_ehartree = pv_ehartree
213 9093 : IF (PRESENT(pv_exc)) virial%pv_exc = pv_exc
214 9093 : IF (PRESENT(pv_exx)) virial%pv_exx = pv_exx
215 9093 : IF (PRESENT(pv_vdw)) virial%pv_vdw = pv_vdw
216 9093 : IF (PRESENT(pv_mp2)) virial%pv_mp2 = pv_mp2
217 9093 : IF (PRESENT(pv_nlcc)) virial%pv_nlcc = pv_nlcc
218 9093 : IF (PRESENT(pv_gapw)) virial%pv_gapw = pv_gapw
219 9093 : IF (PRESENT(pv_lrigpw)) virial%pv_lrigpw = pv_lrigpw
220 :
221 9093 : IF (PRESENT(pv_availability)) virial%pv_availability = pv_availability
222 9093 : IF (PRESENT(pv_calculate)) virial%pv_calculate = pv_calculate
223 9093 : IF (PRESENT(pv_numer)) virial%pv_numer = pv_numer
224 9093 : IF (PRESENT(pv_diagonal)) virial%pv_diagonal = pv_diagonal
225 :
226 9093 : END SUBROUTINE virial_set
227 :
228 0 : END MODULE virial_types
|
