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 : !> \brief This routine calculates the maximum density matrix element, when
10 : !> screening on an initial density matrix is applied. Due to symmetry of
11 : !> the ERI's, there are always 4 matrix elements to be considered.
12 : !> CASE 0-15 belong to an energy calculation (linear screening)
13 : !> CASE 16-31 belong to a force calculation (square screening)
14 : !> \param ptr_p_1 Pointers to atomic density matrices
15 : !> \param ptr_p_2 Pointers to atomic density matrices
16 : !> \param ptr_p_3 Pointers to atomic density matrices
17 : !> \param ptr_p_4 Pointers to atomic density matrices
18 : !> \param iset Current set
19 : !> \param jset Current set
20 : !> \param kset Current set
21 : !> \param lset Current set
22 : !> \param pmax_val value to be calculated
23 : !> \param swap_id Defines how the matrices are accessed
24 : !> \par History
25 : !> 06.2009 created [Manuel Guidon]
26 : !> \author Manuel Guidon
27 : ! **************************************************************************************************
28 2263176 : PURE SUBROUTINE get_pmax_val(ptr_p_1, ptr_p_2, ptr_p_3, ptr_p_4, iset, jset, kset, lset, pmax_val, swap_id)
29 :
30 : REAL(dp), DIMENSION(:, :), POINTER :: ptr_p_1, ptr_p_2, ptr_p_3, ptr_p_4
31 : INTEGER, INTENT(IN) :: iset, jset, kset, lset
32 :
33 : REAL(dp), INTENT(OUT) :: pmax_val
34 : INTEGER, INTENT(IN) :: swap_id
35 :
36 : REAL(dp) :: pmax_1, pmax_2, pmax_3, pmax_4
37 :
38 2843182 : SELECT CASE (swap_id)
39 : CASE (0)
40 580006 : pmax_1 = ptr_p_1(kset, iset)
41 580006 : pmax_2 = ptr_p_2(lset, jset)
42 580006 : pmax_3 = ptr_p_3(lset, iset)
43 580006 : pmax_4 = ptr_p_4(kset, jset)
44 580006 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
45 : CASE (1)
46 0 : pmax_1 = ptr_p_1(iset, kset)
47 0 : pmax_2 = ptr_p_2(lset, jset)
48 0 : pmax_3 = ptr_p_3(lset, iset)
49 0 : pmax_4 = ptr_p_4(kset, jset)
50 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
51 : CASE (2)
52 0 : pmax_1 = ptr_p_1(kset, iset)
53 0 : pmax_2 = ptr_p_2(jset, lset)
54 0 : pmax_3 = ptr_p_3(lset, iset)
55 0 : pmax_4 = ptr_p_4(kset, jset)
56 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
57 : CASE (3)
58 0 : pmax_1 = ptr_p_1(iset, kset)
59 0 : pmax_2 = ptr_p_2(jset, lset)
60 0 : pmax_3 = ptr_p_3(lset, iset)
61 0 : pmax_4 = ptr_p_4(kset, jset)
62 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
63 : CASE (4)
64 154970 : pmax_1 = ptr_p_1(kset, iset)
65 154970 : pmax_2 = ptr_p_2(lset, jset)
66 154970 : pmax_3 = ptr_p_3(iset, lset)
67 154970 : pmax_4 = ptr_p_4(kset, jset)
68 154970 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
69 : CASE (5)
70 35872 : pmax_1 = ptr_p_1(iset, kset)
71 35872 : pmax_2 = ptr_p_2(lset, jset)
72 35872 : pmax_3 = ptr_p_3(iset, lset)
73 35872 : pmax_4 = ptr_p_4(kset, jset)
74 35872 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
75 : CASE (6)
76 53676 : pmax_1 = ptr_p_1(kset, iset)
77 53676 : pmax_2 = ptr_p_2(jset, lset)
78 53676 : pmax_3 = ptr_p_3(iset, lset)
79 53676 : pmax_4 = ptr_p_4(kset, jset)
80 53676 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
81 : CASE (7)
82 0 : pmax_1 = ptr_p_1(iset, kset)
83 0 : pmax_2 = ptr_p_2(jset, lset)
84 0 : pmax_3 = ptr_p_3(iset, lset)
85 0 : pmax_4 = ptr_p_4(kset, jset)
86 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
87 : CASE (8)
88 0 : pmax_1 = ptr_p_1(kset, iset)
89 0 : pmax_2 = ptr_p_2(lset, jset)
90 0 : pmax_3 = ptr_p_3(lset, iset)
91 0 : pmax_4 = ptr_p_4(jset, kset)
92 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
93 : CASE (9)
94 0 : pmax_1 = ptr_p_1(iset, kset)
95 0 : pmax_2 = ptr_p_2(lset, jset)
96 0 : pmax_3 = ptr_p_3(lset, iset)
97 0 : pmax_4 = ptr_p_4(jset, kset)
98 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
99 : CASE (10)
100 0 : pmax_1 = ptr_p_1(kset, iset)
101 0 : pmax_2 = ptr_p_2(jset, lset)
102 0 : pmax_3 = ptr_p_3(lset, iset)
103 0 : pmax_4 = ptr_p_4(jset, kset)
104 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
105 : CASE (11)
106 0 : pmax_1 = ptr_p_1(iset, kset)
107 0 : pmax_2 = ptr_p_2(jset, lset)
108 0 : pmax_3 = ptr_p_3(lset, iset)
109 0 : pmax_4 = ptr_p_4(jset, kset)
110 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
111 : CASE (12)
112 0 : pmax_1 = ptr_p_1(kset, iset)
113 0 : pmax_2 = ptr_p_2(lset, jset)
114 0 : pmax_3 = ptr_p_3(iset, lset)
115 0 : pmax_4 = ptr_p_4(jset, kset)
116 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
117 : CASE (13)
118 0 : pmax_1 = ptr_p_1(iset, kset)
119 0 : pmax_2 = ptr_p_2(lset, jset)
120 0 : pmax_3 = ptr_p_3(iset, lset)
121 0 : pmax_4 = ptr_p_4(jset, kset)
122 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
123 : CASE (14)
124 0 : pmax_1 = ptr_p_1(kset, iset)
125 0 : pmax_2 = ptr_p_2(jset, lset)
126 0 : pmax_3 = ptr_p_3(iset, lset)
127 0 : pmax_4 = ptr_p_4(jset, kset)
128 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
129 : CASE (15)
130 0 : pmax_1 = ptr_p_1(iset, kset)
131 0 : pmax_2 = ptr_p_2(jset, lset)
132 0 : pmax_3 = ptr_p_3(iset, lset)
133 0 : pmax_4 = ptr_p_4(jset, kset)
134 0 : pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
135 : CASE (16)
136 1136905 : pmax_1 = ptr_p_1(kset, iset)
137 1136905 : pmax_2 = ptr_p_2(lset, jset)
138 1136905 : pmax_3 = ptr_p_3(lset, iset)
139 1136905 : pmax_4 = ptr_p_4(kset, jset)
140 1136905 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
141 : CASE (17)
142 0 : pmax_1 = ptr_p_1(iset, kset)
143 0 : pmax_2 = ptr_p_2(lset, jset)
144 0 : pmax_3 = ptr_p_3(lset, iset)
145 0 : pmax_4 = ptr_p_4(kset, jset)
146 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
147 : CASE (18)
148 0 : pmax_1 = ptr_p_1(kset, iset)
149 0 : pmax_2 = ptr_p_2(jset, lset)
150 0 : pmax_3 = ptr_p_3(lset, iset)
151 0 : pmax_4 = ptr_p_4(kset, jset)
152 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
153 : CASE (19)
154 0 : pmax_1 = ptr_p_1(iset, kset)
155 0 : pmax_2 = ptr_p_2(jset, lset)
156 0 : pmax_3 = ptr_p_3(lset, iset)
157 0 : pmax_4 = ptr_p_4(kset, jset)
158 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
159 : CASE (20)
160 257401 : pmax_1 = ptr_p_1(kset, iset)
161 257401 : pmax_2 = ptr_p_2(lset, jset)
162 257401 : pmax_3 = ptr_p_3(iset, lset)
163 257401 : pmax_4 = ptr_p_4(kset, jset)
164 257401 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
165 : CASE (21)
166 44346 : pmax_1 = ptr_p_1(iset, kset)
167 44346 : pmax_2 = ptr_p_2(lset, jset)
168 44346 : pmax_3 = ptr_p_3(iset, lset)
169 44346 : pmax_4 = ptr_p_4(kset, jset)
170 44346 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
171 : CASE (22)
172 0 : pmax_1 = ptr_p_1(kset, iset)
173 0 : pmax_2 = ptr_p_2(jset, lset)
174 0 : pmax_3 = ptr_p_3(iset, lset)
175 0 : pmax_4 = ptr_p_4(kset, jset)
176 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
177 : CASE (23)
178 0 : pmax_1 = ptr_p_1(iset, kset)
179 0 : pmax_2 = ptr_p_2(jset, lset)
180 0 : pmax_3 = ptr_p_3(iset, lset)
181 0 : pmax_4 = ptr_p_4(kset, jset)
182 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
183 : CASE (24)
184 0 : pmax_1 = ptr_p_1(kset, iset)
185 0 : pmax_2 = ptr_p_2(lset, jset)
186 0 : pmax_3 = ptr_p_3(lset, iset)
187 0 : pmax_4 = ptr_p_4(jset, kset)
188 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
189 : CASE (25)
190 0 : pmax_1 = ptr_p_1(iset, kset)
191 0 : pmax_2 = ptr_p_2(lset, jset)
192 0 : pmax_3 = ptr_p_3(lset, iset)
193 0 : pmax_4 = ptr_p_4(jset, kset)
194 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
195 : CASE (26)
196 0 : pmax_1 = ptr_p_1(kset, iset)
197 0 : pmax_2 = ptr_p_2(jset, lset)
198 0 : pmax_3 = ptr_p_3(lset, iset)
199 0 : pmax_4 = ptr_p_4(jset, kset)
200 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
201 : CASE (27)
202 0 : pmax_1 = ptr_p_1(iset, kset)
203 0 : pmax_2 = ptr_p_2(jset, lset)
204 0 : pmax_3 = ptr_p_3(lset, iset)
205 0 : pmax_4 = ptr_p_4(jset, kset)
206 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
207 : CASE (28)
208 0 : pmax_1 = ptr_p_1(kset, iset)
209 0 : pmax_2 = ptr_p_2(lset, jset)
210 0 : pmax_3 = ptr_p_3(iset, lset)
211 0 : pmax_4 = ptr_p_4(jset, kset)
212 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
213 : CASE (29)
214 0 : pmax_1 = ptr_p_1(iset, kset)
215 0 : pmax_2 = ptr_p_2(lset, jset)
216 0 : pmax_3 = ptr_p_3(iset, lset)
217 0 : pmax_4 = ptr_p_4(jset, kset)
218 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
219 : CASE (30)
220 0 : pmax_1 = ptr_p_1(kset, iset)
221 0 : pmax_2 = ptr_p_2(jset, lset)
222 0 : pmax_3 = ptr_p_3(iset, lset)
223 0 : pmax_4 = ptr_p_4(jset, kset)
224 0 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
225 : CASE (31)
226 0 : pmax_1 = ptr_p_1(iset, kset)
227 0 : pmax_2 = ptr_p_2(jset, lset)
228 0 : pmax_3 = ptr_p_3(iset, lset)
229 0 : pmax_4 = ptr_p_4(jset, kset)
230 2263176 : pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
231 : END SELECT
232 :
233 2263176 : END SUBROUTINE get_pmax_val
234 :
|
