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 Set of wrappers for semi-empirical analytical/numerical Integrals
10 : !> routines
11 : !> \author Teodoro Laino [tlaino] - University of Zurich
12 : !> \date 04.2008
13 : !> \par History
14 : !> 05.2008 Teodoro Laino [tlaino] - University of Zurich - In core integrals
15 : ! **************************************************************************************************
16 : MODULE semi_empirical_integrals
17 :
18 : USE hfx_compression_methods, ONLY: hfx_add_mult_cache_elements,&
19 : hfx_get_mult_cache_elements
20 : USE input_constants, ONLY: do_se_IS_slater
21 : USE kinds, ONLY: dp,&
22 : int_8
23 : USE memory_utilities, ONLY: reallocate
24 : USE semi_empirical_int_ana, ONLY: corecore_ana,&
25 : corecore_el_ana,&
26 : rotint_ana,&
27 : rotnuc_ana
28 : USE semi_empirical_int_gks, ONLY: corecore_gks,&
29 : drotint_gks,&
30 : drotnuc_gks,&
31 : rotint_gks,&
32 : rotnuc_gks
33 : USE semi_empirical_int_num, ONLY: corecore_el_num,&
34 : corecore_num,&
35 : dcorecore_el_num,&
36 : dcorecore_num,&
37 : drotint_num,&
38 : drotnuc_num,&
39 : rotint_num,&
40 : rotnuc_num
41 : USE semi_empirical_store_int_types, ONLY: semi_empirical_si_type
42 : USE semi_empirical_types, ONLY: se_int_control_type,&
43 : se_taper_type,&
44 : semi_empirical_type
45 : #include "./base/base_uses.f90"
46 :
47 : IMPLICIT NONE
48 :
49 : PRIVATE
50 :
51 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'semi_empirical_integrals'
52 : PUBLIC :: rotint, rotnuc, corecore, corecore_el, drotint, drotnuc, dcorecore, &
53 : dcorecore_el
54 :
55 : CONTAINS
56 :
57 : ! **************************************************************************************************
58 : !> \brief wrapper for numerical/analytical 2 center 2 electrons integrals
59 : !> routines with possibility of incore storage/compression
60 : !> \param sepi ...
61 : !> \param sepj ...
62 : !> \param rij ...
63 : !> \param w ...
64 : !> \param anag ...
65 : !> \param se_int_control ...
66 : !> \param se_taper ...
67 : !> \param store_int_env ...
68 : !> \date 05.2008
69 : !> \author Teodoro Laino [tlaino] - University of Zurich
70 : ! **************************************************************************************************
71 14965655 : SUBROUTINE rotint(sepi, sepj, rij, w, anag, se_int_control, se_taper, store_int_env)
72 : TYPE(semi_empirical_type), POINTER :: sepi, sepj
73 : REAL(dp), DIMENSION(3), INTENT(IN) :: rij
74 : REAL(dp), DIMENSION(2025), INTENT(OUT) :: w
75 : LOGICAL :: anag
76 : TYPE(se_int_control_type), INTENT(IN) :: se_int_control
77 : TYPE(se_taper_type), POINTER :: se_taper
78 : TYPE(semi_empirical_si_type), POINTER :: store_int_env
79 :
80 : INTEGER :: buffer_left, buffer_size, buffer_start, &
81 : cache_size, memory_usage, nbits, &
82 : new_size, nints
83 : INTEGER(KIND=int_8) :: mem_compression_counter
84 : LOGICAL :: buffer_overflow
85 : REAL(KIND=dp) :: eps_storage
86 :
87 14965655 : w(:) = 0.0_dp
88 14965655 : IF (.NOT. store_int_env%memory_parameter%do_all_on_the_fly) THEN
89 14965655 : nints = (sepi%natorb*(sepi%natorb + 1)/2)*(sepj%natorb*(sepj%natorb + 1)/2)
90 14965655 : cache_size = store_int_env%memory_parameter%cache_size
91 14965655 : eps_storage = store_int_env%memory_parameter%eps_storage_scaling
92 14965655 : IF (store_int_env%filling_containers) THEN
93 647291 : mem_compression_counter = store_int_env%memory_parameter%actual_memory_usage*cache_size
94 647291 : IF (mem_compression_counter > store_int_env%memory_parameter%max_compression_counter) THEN
95 0 : buffer_overflow = .TRUE.
96 0 : store_int_env%memory_parameter%ram_counter = store_int_env%nbuffer
97 : ELSE
98 647291 : store_int_env%nbuffer = store_int_env%nbuffer + 1
99 647291 : buffer_overflow = .FALSE.
100 : END IF
101 : ! Compute Integrals
102 647291 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
103 4754 : CALL rotint_gks(sepi, sepj, rij, w, se_int_control=se_int_control)
104 : ELSE
105 642537 : IF (anag) THEN
106 634819 : CALL rotint_ana(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
107 : ELSE
108 7718 : CALL rotint_num(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
109 : END IF
110 : END IF
111 : ! Store integrals if we did not go overflow
112 647291 : IF (.NOT. buffer_overflow) THEN
113 647291 : IF (store_int_env%compress) THEN
114 : ! Store integrals in the containers
115 4330 : IF (store_int_env%nbuffer > SIZE(store_int_env%max_val_buffer)) THEN
116 8 : new_size = store_int_env%nbuffer + 1000
117 8 : CALL reallocate(store_int_env%max_val_buffer, 1, new_size)
118 : END IF
119 267242 : store_int_env%max_val_buffer(store_int_env%nbuffer) = MAXVAL(ABS(w(1:nints)))
120 :
121 4330 : nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1
122 4330 : buffer_left = nints
123 4330 : buffer_start = 1
124 8700 : DO WHILE (buffer_left > 0)
125 4370 : buffer_size = MIN(buffer_left, cache_size)
126 : CALL hfx_add_mult_cache_elements(w(buffer_start:), &
127 : buffer_size, nbits, &
128 : store_int_env%integral_caches(nbits), &
129 : store_int_env%integral_containers(nbits), &
130 : eps_storage, 1.0_dp, &
131 : store_int_env%memory_parameter%actual_memory_usage, &
132 4370 : .FALSE.)
133 4370 : buffer_left = buffer_left - buffer_size
134 8700 : buffer_start = buffer_start + buffer_size
135 : END DO
136 : ELSE
137 : ! Skip compression
138 642961 : memory_usage = store_int_env%memory_parameter%actual_memory_usage
139 642961 : CPASSERT((nints/1.2_dp) <= HUGE(0) - memory_usage)
140 642961 : IF (memory_usage + nints > SIZE(store_int_env%uncompressed_container)) THEN
141 22541 : new_size = INT((memory_usage + nints)*1.2_dp)
142 22541 : CALL reallocate(store_int_env%uncompressed_container, 1, new_size)
143 : END IF
144 35710981 : store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) = w(1:nints)
145 642961 : store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints
146 : END IF
147 : END IF
148 : ELSE
149 : ! Get integrals from the containers
150 14318364 : IF (store_int_env%memory_parameter%ram_counter == store_int_env%nbuffer) THEN
151 : buffer_overflow = .TRUE.
152 : ELSE
153 14318364 : store_int_env%nbuffer = store_int_env%nbuffer + 1
154 : buffer_overflow = .FALSE.
155 : END IF
156 : ! Get integrals from cache unless we overflowed
157 : IF (.NOT. buffer_overflow) THEN
158 14318364 : IF (store_int_env%compress) THEN
159 : ! Get Integrals from containers
160 118982 : nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1
161 118982 : buffer_left = nints
162 118982 : buffer_start = 1
163 239064 : DO WHILE (buffer_left > 0)
164 120082 : buffer_size = MIN(buffer_left, cache_size)
165 : CALL hfx_get_mult_cache_elements(w(buffer_start:), &
166 : buffer_size, nbits, &
167 : store_int_env%integral_caches(nbits), &
168 : store_int_env%integral_containers(nbits), &
169 : eps_storage, 1.0_dp, &
170 : store_int_env%memory_parameter%actual_memory_usage, &
171 120082 : .FALSE.)
172 120082 : buffer_left = buffer_left - buffer_size
173 239064 : buffer_start = buffer_start + buffer_size
174 : END DO
175 : ELSE
176 : ! Skip compression
177 14199382 : memory_usage = store_int_env%memory_parameter%actual_memory_usage
178 811135142 : w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1)
179 14199382 : store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints
180 : END IF
181 : ELSE
182 0 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
183 0 : CALL rotint_gks(sepi, sepj, rij, w, se_int_control=se_int_control)
184 : ELSE
185 0 : IF (anag) THEN
186 0 : CALL rotint_ana(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
187 : ELSE
188 0 : CALL rotint_num(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
189 : END IF
190 : END IF
191 : END IF
192 : END IF
193 : ELSE
194 0 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
195 0 : CALL rotint_gks(sepi, sepj, rij, w, se_int_control=se_int_control)
196 : ELSE
197 0 : IF (anag) THEN
198 0 : CALL rotint_ana(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
199 : ELSE
200 0 : CALL rotint_num(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
201 : END IF
202 : END IF
203 : END IF
204 14965655 : END SUBROUTINE rotint
205 :
206 : ! **************************************************************************************************
207 : !> \brief wrapper for numerical/analytical 1 center 1 electron integrals
208 : !> \param sepi ...
209 : !> \param sepj ...
210 : !> \param rij ...
211 : !> \param e1b ...
212 : !> \param e2a ...
213 : !> \param itype ...
214 : !> \param anag ...
215 : !> \param se_int_control ...
216 : !> \param se_taper ...
217 : !> \param store_int_env ...
218 : !> \date 05.2008
219 : !> \author Teodoro Laino [tlaino] - University of Zurich
220 : ! **************************************************************************************************
221 19034187 : SUBROUTINE rotnuc(sepi, sepj, rij, e1b, e2a, itype, anag, se_int_control, se_taper, store_int_env)
222 : TYPE(semi_empirical_type), POINTER :: sepi, sepj
223 : REAL(dp), DIMENSION(3), INTENT(IN) :: rij
224 : REAL(dp), DIMENSION(45), INTENT(OUT), OPTIONAL :: e1b, e2a
225 : INTEGER, INTENT(IN) :: itype
226 : LOGICAL, INTENT(IN) :: anag
227 : TYPE(se_int_control_type), INTENT(IN) :: se_int_control
228 : TYPE(se_taper_type), POINTER :: se_taper
229 : TYPE(semi_empirical_si_type), OPTIONAL, POINTER :: store_int_env
230 :
231 : INTEGER :: buffer_left, buffer_size, buffer_start, &
232 : cache_size, memory_usage, nbits, &
233 : new_size, nints, nints_1, nints_2
234 : INTEGER(KIND=int_8) :: mem_compression_counter
235 : LOGICAL :: buffer_overflow, do_all_on_the_fly
236 : REAL(KIND=dp) :: eps_storage, w(90)
237 :
238 19034187 : do_all_on_the_fly = .TRUE.
239 19034187 : IF (PRESENT(e1b)) e1b(:) = 0.0_dp
240 19034187 : IF (PRESENT(e2a)) e2a(:) = 0.0_dp
241 19034187 : IF (PRESENT(store_int_env)) do_all_on_the_fly = store_int_env%memory_parameter%do_all_on_the_fly
242 11361739 : IF (.NOT. do_all_on_the_fly) THEN
243 11361739 : nints_1 = 0
244 11361739 : nints_2 = 0
245 11361739 : IF (PRESENT(e1b)) nints_1 = (sepi%natorb*(sepi%natorb + 1)/2)
246 11361739 : IF (PRESENT(e2a)) nints_2 = (sepj%natorb*(sepj%natorb + 1)/2)
247 11361739 : nints = nints_1 + nints_2
248 : ! This is the upper limit for an spd basis set
249 11361739 : CPASSERT(nints <= 90)
250 11361739 : cache_size = store_int_env%memory_parameter%cache_size
251 11361739 : eps_storage = store_int_env%memory_parameter%eps_storage_scaling
252 11361739 : IF (store_int_env%filling_containers) THEN
253 464551 : mem_compression_counter = store_int_env%memory_parameter%actual_memory_usage*cache_size
254 464551 : IF (mem_compression_counter > store_int_env%memory_parameter%max_compression_counter) THEN
255 0 : buffer_overflow = .TRUE.
256 0 : store_int_env%memory_parameter%ram_counter = store_int_env%nbuffer
257 : ELSE
258 464551 : store_int_env%nbuffer = store_int_env%nbuffer + 1
259 464551 : buffer_overflow = .FALSE.
260 : END IF
261 : ! Compute Integrals
262 464551 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
263 : CALL rotnuc_gks(sepi, sepj, rij, e1b=e1b, e2a=e2a, &
264 3813 : se_int_control=se_int_control)
265 : ELSE
266 460738 : IF (anag) THEN
267 : CALL rotnuc_ana(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
268 456879 : se_int_control=se_int_control, se_taper=se_taper)
269 : ELSE
270 : CALL rotnuc_num(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
271 3859 : se_int_control=se_int_control, se_taper=se_taper)
272 : END IF
273 : END IF
274 : ! Store integrals if we did not go overflow
275 464551 : IF (.NOT. buffer_overflow) THEN
276 3464973 : IF (PRESENT(e1b)) w(1:nints_1) = e1b(1:nints_1)
277 3450786 : IF (PRESENT(e2a)) w(nints_1 + 1:nints) = e2a(1:nints_2)
278 :
279 464551 : IF (store_int_env%compress) THEN
280 : ! Store integrals in the containers
281 2165 : IF (store_int_env%nbuffer > SIZE(store_int_env%max_val_buffer)) THEN
282 2 : new_size = store_int_env%nbuffer + 1000
283 2 : CALL reallocate(store_int_env%max_val_buffer, 1, new_size)
284 : END IF
285 38854 : store_int_env%max_val_buffer(store_int_env%nbuffer) = MAXVAL(ABS(w(1:nints)))
286 :
287 2165 : nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1
288 2165 : buffer_left = nints
289 2165 : buffer_start = 1
290 4330 : DO WHILE (buffer_left > 0)
291 2165 : buffer_size = MIN(buffer_left, cache_size)
292 : CALL hfx_add_mult_cache_elements(w(buffer_start:), &
293 : buffer_size, nbits, &
294 : store_int_env%integral_caches(nbits), &
295 : store_int_env%integral_containers(nbits), &
296 : eps_storage, 1.0_dp, &
297 : store_int_env%memory_parameter%actual_memory_usage, &
298 2165 : .FALSE.)
299 2165 : buffer_left = buffer_left - buffer_size
300 4330 : buffer_start = buffer_start + buffer_size
301 : END DO
302 : ELSE
303 : ! Skip compression
304 462386 : memory_usage = store_int_env%memory_parameter%actual_memory_usage
305 462386 : CPASSERT((nints/1.2_dp) <= HUGE(0) - memory_usage)
306 462386 : IF (memory_usage + nints > SIZE(store_int_env%uncompressed_container)) THEN
307 4918 : new_size = INT((memory_usage + nints)*1.2_dp)
308 4918 : CALL reallocate(store_int_env%uncompressed_container, 1, new_size)
309 : END IF
310 6414519 : store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) = w(1:nints)
311 462386 : store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints
312 : END IF
313 : END IF
314 : ELSE
315 : ! Get integrals from the containers
316 10897188 : IF (store_int_env%memory_parameter%ram_counter == store_int_env%nbuffer) THEN
317 : buffer_overflow = .TRUE.
318 : ELSE
319 10897188 : store_int_env%nbuffer = store_int_env%nbuffer + 1
320 : buffer_overflow = .FALSE.
321 : END IF
322 : ! Get integrals from cache unless we overflowed
323 : IF (.NOT. buffer_overflow) THEN
324 10897188 : IF (store_int_env%compress) THEN
325 : ! Get Integrals from containers
326 59491 : nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1
327 59491 : buffer_left = nints
328 59491 : buffer_start = 1
329 118982 : DO WHILE (buffer_left > 0)
330 59491 : buffer_size = MIN(buffer_left, cache_size)
331 : CALL hfx_get_mult_cache_elements(w(buffer_start:), &
332 : buffer_size, nbits, &
333 : store_int_env%integral_caches(nbits), &
334 : store_int_env%integral_containers(nbits), &
335 : eps_storage, 1.0_dp, &
336 : store_int_env%memory_parameter%actual_memory_usage, &
337 59491 : .FALSE.)
338 59491 : buffer_left = buffer_left - buffer_size
339 118982 : buffer_start = buffer_start + buffer_size
340 : END DO
341 : ELSE
342 : ! Skip compression
343 10837697 : memory_usage = store_int_env%memory_parameter%actual_memory_usage
344 166952634 : w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1)
345 10837697 : store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints
346 : END IF
347 89474419 : IF (PRESENT(e1b)) e1b(1:nints_1) = w(1:nints_1)
348 89383932 : IF (PRESENT(e2a)) e2a(1:nints_2) = w(nints_1 + 1:nints)
349 : ELSE
350 0 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
351 : CALL rotnuc_gks(sepi, sepj, rij, e1b=e1b, e2a=e2a, &
352 0 : se_int_control=se_int_control)
353 : ELSE
354 0 : IF (anag) THEN
355 : CALL rotnuc_ana(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
356 0 : se_int_control=se_int_control, se_taper=se_taper)
357 : ELSE
358 : CALL rotnuc_num(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
359 0 : se_int_control=se_int_control, se_taper=se_taper)
360 : END IF
361 : END IF
362 : END IF
363 : END IF
364 : ELSE
365 7672448 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
366 : CALL rotnuc_gks(sepi, sepj, rij, e1b=e1b, e2a=e2a, &
367 0 : se_int_control=se_int_control)
368 : ELSE
369 7672448 : IF (anag) THEN
370 : CALL rotnuc_ana(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
371 7672277 : se_int_control=se_int_control, se_taper=se_taper)
372 : ELSE
373 : CALL rotnuc_num(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
374 171 : se_int_control=se_int_control, se_taper=se_taper)
375 : END IF
376 : END IF
377 : END IF
378 :
379 19034187 : END SUBROUTINE rotnuc
380 :
381 : ! **************************************************************************************************
382 : !> \brief wrapper for numerical/analytical routines
383 : !> core-core integrals, since are evaluated only once do not need to be
384 : !> stored.
385 : !>
386 : !> \param sepi ...
387 : !> \param sepj ...
388 : !> \param rij ...
389 : !> \param enuc ...
390 : !> \param itype ...
391 : !> \param anag ...
392 : !> \param se_int_control ...
393 : !> \param se_taper ...
394 : !> \date 04.2008
395 : !> \author Teodoro Laino [tlaino] - University of Zurich
396 : ! **************************************************************************************************
397 15336568 : SUBROUTINE corecore(sepi, sepj, rij, enuc, itype, anag, se_int_control, se_taper)
398 : TYPE(semi_empirical_type), POINTER :: sepi, sepj
399 : REAL(dp), DIMENSION(3), INTENT(IN) :: rij
400 : REAL(dp), INTENT(OUT) :: enuc
401 : INTEGER, INTENT(IN) :: itype
402 : LOGICAL, INTENT(IN) :: anag
403 : TYPE(se_int_control_type), INTENT(IN) :: se_int_control
404 : TYPE(se_taper_type), POINTER :: se_taper
405 :
406 15336568 : enuc = 0.0_dp
407 15336568 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
408 3813 : CALL corecore_gks(sepi, sepj, rij, enuc=enuc, se_int_control=se_int_control)
409 : ELSE
410 15332755 : IF (anag) THEN
411 : CALL corecore_ana(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
412 15325254 : se_taper=se_taper)
413 : ELSE
414 : CALL corecore_num(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
415 7501 : se_taper=se_taper)
416 : END IF
417 : END IF
418 :
419 15336568 : END SUBROUTINE corecore
420 :
421 : ! **************************************************************************************************
422 : !> \brief wrapper for numerical/analytical routines
423 : !> core-core electrostatic (only) integrals
424 : !>
425 : !> \param sepi ...
426 : !> \param sepj ...
427 : !> \param rij ...
428 : !> \param enuc ...
429 : !> \param itype ...
430 : !> \param anag ...
431 : !> \param se_int_control ...
432 : !> \param se_taper ...
433 : !> \date 05.2009
434 : !> \author Teodoro Laino [tlaino] - University of Zurich
435 : ! **************************************************************************************************
436 1425973 : SUBROUTINE corecore_el(sepi, sepj, rij, enuc, itype, anag, se_int_control, se_taper)
437 : TYPE(semi_empirical_type), POINTER :: sepi, sepj
438 : REAL(dp), DIMENSION(3), INTENT(IN) :: rij
439 : REAL(dp), INTENT(OUT) :: enuc
440 : INTEGER, INTENT(IN) :: itype
441 : LOGICAL, INTENT(IN) :: anag
442 : TYPE(se_int_control_type), INTENT(IN) :: se_int_control
443 : TYPE(se_taper_type), POINTER :: se_taper
444 :
445 1425973 : enuc = 0.0_dp
446 1425973 : IF (anag) THEN
447 : CALL corecore_el_ana(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
448 1425973 : se_taper=se_taper)
449 : ELSE
450 : CALL corecore_el_num(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
451 0 : se_taper=se_taper)
452 : END IF
453 :
454 1425973 : END SUBROUTINE corecore_el
455 :
456 : ! **************************************************************************************************
457 : !> \brief wrapper for numerical/analytical routines
458 : !> \param sepi ...
459 : !> \param sepj ...
460 : !> \param rij ...
461 : !> \param dw ...
462 : !> \param delta ...
463 : !> \param anag ...
464 : !> \param se_int_control ...
465 : !> \param se_taper ...
466 : !> \date 04.2008
467 : !> \author Teodoro Laino [tlaino] - University of Zurich
468 : ! **************************************************************************************************
469 518624 : SUBROUTINE drotint(sepi, sepj, rij, dw, delta, anag, se_int_control, se_taper)
470 : TYPE(semi_empirical_type), POINTER :: sepi, sepj
471 : REAL(dp), DIMENSION(3), INTENT(IN) :: rij
472 : REAL(dp), DIMENSION(3, 2025), INTENT(OUT) :: dw
473 : REAL(dp), INTENT(IN) :: delta
474 : LOGICAL, INTENT(IN) :: anag
475 : TYPE(se_int_control_type), INTENT(IN) :: se_int_control
476 : TYPE(se_taper_type), POINTER :: se_taper
477 :
478 518624 : dw(:, :) = 0.0_dp
479 518624 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
480 0 : CALL drotint_gks(sepi, sepj, rij, dw=dw, se_int_control=se_int_control)
481 : ELSE
482 518624 : IF (anag) THEN
483 511306 : CALL rotint_ana(sepi, sepj, rij, dw=dw, se_int_control=se_int_control, se_taper=se_taper)
484 : ELSE
485 7318 : CALL drotint_num(sepi, sepj, rij, dw, delta, se_int_control=se_int_control, se_taper=se_taper)
486 : END IF
487 : END IF
488 :
489 518624 : END SUBROUTINE drotint
490 :
491 : ! **************************************************************************************************
492 : !> \brief wrapper for numerical/analytical routines
493 : !> \param sepi ...
494 : !> \param sepj ...
495 : !> \param rij ...
496 : !> \param de1b ...
497 : !> \param de2a ...
498 : !> \param itype ...
499 : !> \param delta ...
500 : !> \param anag ...
501 : !> \param se_int_control ...
502 : !> \param se_taper ...
503 : !> \date 04.2008
504 : !> \author Teodoro Laino [tlaino] - University of Zurich
505 : ! **************************************************************************************************
506 8017973 : SUBROUTINE drotnuc(sepi, sepj, rij, de1b, de2a, itype, delta, anag, se_int_control, se_taper)
507 : TYPE(semi_empirical_type), POINTER :: sepi, sepj
508 : REAL(dp), DIMENSION(3), INTENT(IN) :: rij
509 : REAL(dp), DIMENSION(3, 45), INTENT(OUT), OPTIONAL :: de1b, de2a
510 : INTEGER, INTENT(IN) :: itype
511 : REAL(dp), INTENT(IN) :: delta
512 : LOGICAL, INTENT(IN) :: anag
513 : TYPE(se_int_control_type), INTENT(IN) :: se_int_control
514 : TYPE(se_taper_type), POINTER :: se_taper
515 :
516 8017973 : IF (PRESENT(de1b)) de1b(:, :) = 0.0_dp
517 8017973 : IF (PRESENT(de2a)) de2a(:, :) = 0.0_dp
518 8017973 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
519 : CALL drotnuc_gks(sepi, sepj, rij, de1b=de1b, de2a=de2a, &
520 0 : se_int_control=se_int_control)
521 : ELSE
522 8017973 : IF (anag) THEN
523 : CALL rotnuc_ana(sepi, sepj, rij, de1b=de1b, de2a=de2a, itype=itype, &
524 8014152 : se_int_control=se_int_control, se_taper=se_taper)
525 : ELSE
526 : CALL drotnuc_num(sepi, sepj, rij, de1b=de1b, de2a=de2a, itype=itype, &
527 3821 : delta=delta, se_int_control=se_int_control, se_taper=se_taper)
528 : END IF
529 : END IF
530 :
531 8017973 : END SUBROUTINE drotnuc
532 :
533 : ! **************************************************************************************************
534 : !> \brief wrapper for numerical/analytical routines
535 : !> \param sepi ...
536 : !> \param sepj ...
537 : !> \param rij ...
538 : !> \param denuc ...
539 : !> \param itype ...
540 : !> \param delta ...
541 : !> \param anag ...
542 : !> \param se_int_control ...
543 : !> \param se_taper ...
544 : !> \date 04.2008
545 : !> \author Teodoro Laino [tlaino] - University of Zurich
546 : ! **************************************************************************************************
547 7973936 : SUBROUTINE dcorecore(sepi, sepj, rij, denuc, itype, delta, anag, se_int_control, se_taper)
548 : TYPE(semi_empirical_type), POINTER :: sepi, sepj
549 : REAL(dp), DIMENSION(3), INTENT(IN) :: rij
550 : REAL(dp), DIMENSION(3), INTENT(OUT) :: denuc
551 : INTEGER, INTENT(IN) :: itype
552 : REAL(dp), INTENT(IN) :: delta
553 : LOGICAL, INTENT(IN) :: anag
554 : TYPE(se_int_control_type), INTENT(IN) :: se_int_control
555 : TYPE(se_taper_type), POINTER :: se_taper
556 :
557 7973936 : denuc = 0.0_dp
558 7973936 : IF (se_int_control%integral_screening == do_se_IS_slater) THEN
559 0 : CALL corecore_gks(sepi, sepj, rij, denuc=denuc, se_int_control=se_int_control)
560 : ELSE
561 7973936 : IF (anag) THEN
562 : CALL corecore_ana(sepi, sepj, rij, denuc=denuc, itype=itype, se_int_control=se_int_control, &
563 7970204 : se_taper=se_taper)
564 : ELSE
565 : CALL dcorecore_num(sepi, sepj, rij, denuc=denuc, delta=delta, itype=itype, &
566 3732 : se_int_control=se_int_control, se_taper=se_taper)
567 : END IF
568 : END IF
569 :
570 7973936 : END SUBROUTINE dcorecore
571 :
572 : ! **************************************************************************************************
573 : !> \brief wrapper for numerical/analytical routines
574 : !> core-core electrostatic (only) integrals derivatives
575 : !>
576 : !> \param sepi ...
577 : !> \param sepj ...
578 : !> \param rij ...
579 : !> \param denuc ...
580 : !> \param itype ...
581 : !> \param delta ...
582 : !> \param anag ...
583 : !> \param se_int_control ...
584 : !> \param se_taper ...
585 : !> \date 05.2009
586 : !> \author Teodoro Laino [tlaino] - University of Zurich
587 : ! **************************************************************************************************
588 43876 : SUBROUTINE dcorecore_el(sepi, sepj, rij, denuc, itype, delta, anag, se_int_control, se_taper)
589 : TYPE(semi_empirical_type), POINTER :: sepi, sepj
590 : REAL(dp), DIMENSION(3), INTENT(IN) :: rij
591 : REAL(dp), DIMENSION(3), INTENT(OUT) :: denuc
592 : INTEGER, INTENT(IN) :: itype
593 : REAL(dp), INTENT(IN) :: delta
594 : LOGICAL, INTENT(IN) :: anag
595 : TYPE(se_int_control_type), INTENT(IN) :: se_int_control
596 : TYPE(se_taper_type), POINTER :: se_taper
597 :
598 43876 : denuc = 0.0_dp
599 43876 : IF (anag) THEN
600 : CALL corecore_el_ana(sepi, sepj, rij, denuc=denuc, itype=itype, se_int_control=se_int_control, &
601 43876 : se_taper=se_taper)
602 : ELSE
603 : CALL dcorecore_el_num(sepi, sepj, rij, denuc=denuc, delta=delta, itype=itype, &
604 0 : se_int_control=se_int_control, se_taper=se_taper)
605 : END IF
606 :
607 43876 : END SUBROUTINE dcorecore_el
608 :
609 : END MODULE semi_empirical_integrals
|
