(git:1f285aa)
semi_empirical_integrals.F
Go to the documentation of this file.
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 ! **************************************************************************************************
17 
21  USE kinds, ONLY: dp,&
22  int_8
23  USE memory_utilities, ONLY: reallocate
26  rotint_ana,&
29  drotint_gks,&
30  drotnuc_gks,&
31  rotint_gks,&
34  corecore_num,&
37  drotint_num,&
38  drotnuc_num,&
39  rotint_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'
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  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  w(:) = 0.0_dp
88  IF (.NOT. store_int_env%memory_parameter%do_all_on_the_fly) THEN
89  nints = (sepi%natorb*(sepi%natorb + 1)/2)*(sepj%natorb*(sepj%natorb + 1)/2)
90  cache_size = store_int_env%memory_parameter%cache_size
91  eps_storage = store_int_env%memory_parameter%eps_storage_scaling
92  IF (store_int_env%filling_containers) THEN
93  mem_compression_counter = store_int_env%memory_parameter%actual_memory_usage*cache_size
94  IF (mem_compression_counter > store_int_env%memory_parameter%max_compression_counter) THEN
95  buffer_overflow = .true.
96  store_int_env%memory_parameter%ram_counter = store_int_env%nbuffer
97  ELSE
98  store_int_env%nbuffer = store_int_env%nbuffer + 1
99  buffer_overflow = .false.
100  END IF
101  ! Compute Integrals
102  IF (se_int_control%integral_screening == do_se_is_slater) THEN
103  CALL rotint_gks(sepi, sepj, rij, w, se_int_control=se_int_control)
104  ELSE
105  IF (anag) THEN
106  CALL rotint_ana(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
107  ELSE
108  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  IF (.NOT. buffer_overflow) THEN
113  IF (store_int_env%compress) THEN
114  ! Store integrals in the containers
115  IF (store_int_env%nbuffer > SIZE(store_int_env%max_val_buffer)) THEN
116  new_size = store_int_env%nbuffer + 1000
117  CALL reallocate(store_int_env%max_val_buffer, 1, new_size)
118  END IF
119  store_int_env%max_val_buffer(store_int_env%nbuffer) = maxval(abs(w(1:nints)))
120 
121  nbits = exponent(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1
122  buffer_left = nints
123  buffer_start = 1
124  DO WHILE (buffer_left > 0)
125  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  .false.)
133  buffer_left = buffer_left - buffer_size
134  buffer_start = buffer_start + buffer_size
135  END DO
136  ELSE
137  ! Skip compression
138  memory_usage = store_int_env%memory_parameter%actual_memory_usage
139  cpassert((nints/1.2_dp) <= huge(0) - memory_usage)
140  IF (memory_usage + nints > SIZE(store_int_env%uncompressed_container)) THEN
141  new_size = int((memory_usage + nints)*1.2_dp)
142  CALL reallocate(store_int_env%uncompressed_container, 1, new_size)
143  END IF
144  store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) = w(1:nints)
145  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  IF (store_int_env%memory_parameter%ram_counter == store_int_env%nbuffer) THEN
151  buffer_overflow = .true.
152  ELSE
153  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  IF (store_int_env%compress) THEN
159  ! Get Integrals from containers
160  nbits = exponent(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1
161  buffer_left = nints
162  buffer_start = 1
163  DO WHILE (buffer_left > 0)
164  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  .false.)
172  buffer_left = buffer_left - buffer_size
173  buffer_start = buffer_start + buffer_size
174  END DO
175  ELSE
176  ! Skip compression
177  memory_usage = store_int_env%memory_parameter%actual_memory_usage
178  w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1)
179  store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints
180  END IF
181  ELSE
182  IF (se_int_control%integral_screening == do_se_is_slater) THEN
183  CALL rotint_gks(sepi, sepj, rij, w, se_int_control=se_int_control)
184  ELSE
185  IF (anag) THEN
186  CALL rotint_ana(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
187  ELSE
188  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  IF (se_int_control%integral_screening == do_se_is_slater) THEN
195  CALL rotint_gks(sepi, sepj, rij, w, se_int_control=se_int_control)
196  ELSE
197  IF (anag) THEN
198  CALL rotint_ana(sepi, sepj, rij, w, se_int_control=se_int_control, se_taper=se_taper)
199  ELSE
200  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  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  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  do_all_on_the_fly = .true.
239  IF (PRESENT(e1b)) e1b(:) = 0.0_dp
240  IF (PRESENT(e2a)) e2a(:) = 0.0_dp
241  IF (PRESENT(store_int_env)) do_all_on_the_fly = store_int_env%memory_parameter%do_all_on_the_fly
242  IF (.NOT. do_all_on_the_fly) THEN
243  nints_1 = 0
244  nints_2 = 0
245  IF (PRESENT(e1b)) nints_1 = (sepi%natorb*(sepi%natorb + 1)/2)
246  IF (PRESENT(e2a)) nints_2 = (sepj%natorb*(sepj%natorb + 1)/2)
247  nints = nints_1 + nints_2
248  ! This is the upper limit for an spd basis set
249  cpassert(nints <= 90)
250  cache_size = store_int_env%memory_parameter%cache_size
251  eps_storage = store_int_env%memory_parameter%eps_storage_scaling
252  IF (store_int_env%filling_containers) THEN
253  mem_compression_counter = store_int_env%memory_parameter%actual_memory_usage*cache_size
254  IF (mem_compression_counter > store_int_env%memory_parameter%max_compression_counter) THEN
255  buffer_overflow = .true.
256  store_int_env%memory_parameter%ram_counter = store_int_env%nbuffer
257  ELSE
258  store_int_env%nbuffer = store_int_env%nbuffer + 1
259  buffer_overflow = .false.
260  END IF
261  ! Compute Integrals
262  IF (se_int_control%integral_screening == do_se_is_slater) THEN
263  CALL rotnuc_gks(sepi, sepj, rij, e1b=e1b, e2a=e2a, &
264  se_int_control=se_int_control)
265  ELSE
266  IF (anag) THEN
267  CALL rotnuc_ana(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
268  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  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  IF (.NOT. buffer_overflow) THEN
276  IF (PRESENT(e1b)) w(1:nints_1) = e1b(1:nints_1)
277  IF (PRESENT(e2a)) w(nints_1 + 1:nints) = e2a(1:nints_2)
278 
279  IF (store_int_env%compress) THEN
280  ! Store integrals in the containers
281  IF (store_int_env%nbuffer > SIZE(store_int_env%max_val_buffer)) THEN
282  new_size = store_int_env%nbuffer + 1000
283  CALL reallocate(store_int_env%max_val_buffer, 1, new_size)
284  END IF
285  store_int_env%max_val_buffer(store_int_env%nbuffer) = maxval(abs(w(1:nints)))
286 
287  nbits = exponent(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1
288  buffer_left = nints
289  buffer_start = 1
290  DO WHILE (buffer_left > 0)
291  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  .false.)
299  buffer_left = buffer_left - buffer_size
300  buffer_start = buffer_start + buffer_size
301  END DO
302  ELSE
303  ! Skip compression
304  memory_usage = store_int_env%memory_parameter%actual_memory_usage
305  cpassert((nints/1.2_dp) <= huge(0) - memory_usage)
306  IF (memory_usage + nints > SIZE(store_int_env%uncompressed_container)) THEN
307  new_size = int((memory_usage + nints)*1.2_dp)
308  CALL reallocate(store_int_env%uncompressed_container, 1, new_size)
309  END IF
310  store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) = w(1:nints)
311  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  IF (store_int_env%memory_parameter%ram_counter == store_int_env%nbuffer) THEN
317  buffer_overflow = .true.
318  ELSE
319  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  IF (store_int_env%compress) THEN
325  ! Get Integrals from containers
326  nbits = exponent(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1
327  buffer_left = nints
328  buffer_start = 1
329  DO WHILE (buffer_left > 0)
330  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  .false.)
338  buffer_left = buffer_left - buffer_size
339  buffer_start = buffer_start + buffer_size
340  END DO
341  ELSE
342  ! Skip compression
343  memory_usage = store_int_env%memory_parameter%actual_memory_usage
344  w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1)
345  store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints
346  END IF
347  IF (PRESENT(e1b)) e1b(1:nints_1) = w(1:nints_1)
348  IF (PRESENT(e2a)) e2a(1:nints_2) = w(nints_1 + 1:nints)
349  ELSE
350  IF (se_int_control%integral_screening == do_se_is_slater) THEN
351  CALL rotnuc_gks(sepi, sepj, rij, e1b=e1b, e2a=e2a, &
352  se_int_control=se_int_control)
353  ELSE
354  IF (anag) THEN
355  CALL rotnuc_ana(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
356  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  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  IF (se_int_control%integral_screening == do_se_is_slater) THEN
366  CALL rotnuc_gks(sepi, sepj, rij, e1b=e1b, e2a=e2a, &
367  se_int_control=se_int_control)
368  ELSE
369  IF (anag) THEN
370  CALL rotnuc_ana(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
371  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  se_int_control=se_int_control, se_taper=se_taper)
375  END IF
376  END IF
377  END IF
378 
379  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  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  enuc = 0.0_dp
407  IF (se_int_control%integral_screening == do_se_is_slater) THEN
408  CALL corecore_gks(sepi, sepj, rij, enuc=enuc, se_int_control=se_int_control)
409  ELSE
410  IF (anag) THEN
411  CALL corecore_ana(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
412  se_taper=se_taper)
413  ELSE
414  CALL corecore_num(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
415  se_taper=se_taper)
416  END IF
417  END IF
418 
419  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  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  enuc = 0.0_dp
446  IF (anag) THEN
447  CALL corecore_el_ana(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
448  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  se_taper=se_taper)
452  END IF
453 
454  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  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  dw(:, :) = 0.0_dp
479  IF (se_int_control%integral_screening == do_se_is_slater) THEN
480  CALL drotint_gks(sepi, sepj, rij, dw=dw, se_int_control=se_int_control)
481  ELSE
482  IF (anag) THEN
483  CALL rotint_ana(sepi, sepj, rij, dw=dw, se_int_control=se_int_control, se_taper=se_taper)
484  ELSE
485  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  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  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  IF (PRESENT(de1b)) de1b(:, :) = 0.0_dp
517  IF (PRESENT(de2a)) de2a(:, :) = 0.0_dp
518  IF (se_int_control%integral_screening == do_se_is_slater) THEN
519  CALL drotnuc_gks(sepi, sepj, rij, de1b=de1b, de2a=de2a, &
520  se_int_control=se_int_control)
521  ELSE
522  IF (anag) THEN
523  CALL rotnuc_ana(sepi, sepj, rij, de1b=de1b, de2a=de2a, itype=itype, &
524  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  delta=delta, se_int_control=se_int_control, se_taper=se_taper)
528  END IF
529  END IF
530 
531  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  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  denuc = 0.0_dp
558  IF (se_int_control%integral_screening == do_se_is_slater) THEN
559  CALL corecore_gks(sepi, sepj, rij, denuc=denuc, se_int_control=se_int_control)
560  ELSE
561  IF (anag) THEN
562  CALL corecore_ana(sepi, sepj, rij, denuc=denuc, itype=itype, se_int_control=se_int_control, &
563  se_taper=se_taper)
564  ELSE
565  CALL dcorecore_num(sepi, sepj, rij, denuc=denuc, delta=delta, itype=itype, &
566  se_int_control=se_int_control, se_taper=se_taper)
567  END IF
568  END IF
569 
570  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  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  denuc = 0.0_dp
599  IF (anag) THEN
600  CALL corecore_el_ana(sepi, sepj, rij, denuc=denuc, itype=itype, se_int_control=se_int_control, &
601  se_taper=se_taper)
602  ELSE
603  CALL dcorecore_el_num(sepi, sepj, rij, denuc=denuc, delta=delta, itype=itype, &
604  se_int_control=se_int_control, se_taper=se_taper)
605  END IF
606 
607  END SUBROUTINE dcorecore_el
608 
609 END MODULE semi_empirical_integrals
routines and types for Hartree-Fock-Exchange
subroutine, public hfx_get_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, use_disk_storage)
This routine returns a bunch real values from a cache. If the cache is empty a decompression routine ...
subroutine, public hfx_add_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, use_disk_storage)
This routine adds an a few real values to a cache. If the cache is full a compression routine is invo...
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public do_se_is_slater
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public int_8
Definition: kinds.F:54
integer, parameter, public dp
Definition: kinds.F:34
Utility routines for the memory handling.
Analytical derivatives of Integrals for semi-empirical methods.
recursive subroutine, public rotint_ana(sepi, sepj, rijv, w, dw, se_int_control, se_taper)
calculates the derivative of the two-particle interactions
recursive subroutine, public corecore_el_ana(sepi, sepj, rijv, itype, enuc, denuc, se_int_control, se_taper)
Computes analytical gradients for semiempirical core-core electrostatic interaction only.
recursive subroutine, public corecore_ana(sepi, sepj, rijv, itype, enuc, denuc, se_int_control, se_taper)
Computes analytical gradients for semiempirical core-core interaction.
recursive subroutine, public rotnuc_ana(sepi, sepj, rijv, itype, e1b, e2a, de1b, de2a, se_int_control, se_taper)
Computes analytical gradients for semiempirical integrals.
Integral GKS scheme: The order of the integrals in makeCoul reflects the standard order by MOPAC.
subroutine, public drotnuc_gks(sepi, sepj, rij, de1b, de2a, se_int_control)
Computes the derivatives of the electron-nuclei integrals.
subroutine, public corecore_gks(sepi, sepj, rijv, enuc, denuc, se_int_control)
Computes nuclei-nuclei interactions.
subroutine, public drotint_gks(sepi, sepj, rij, dw, se_int_control)
Computes the derivatives of the electron-electron integrals.
subroutine, public rotnuc_gks(sepi, sepj, rij, e1b, e2a, se_int_control)
Computes the electron-nuclei integrals.
subroutine, public rotint_gks(sepi, sepj, rij, w, se_int_control)
Computes the electron-electron integrals.
Integrals for semi-empiric methods.
subroutine, public rotnuc_num(sepi, sepj, rijv, e1b, e2a, itype, se_int_control, se_taper)
Computes the two-particle interactions.
subroutine, public corecore_el_num(sepi, sepj, rijv, enuc, itype, se_int_control, se_taper)
Computes the electrostatic core-core interactions only.
subroutine, public rotint_num(sepi, sepj, rijv, w, se_int_control, se_taper)
Computes the two particle interactions in the lab frame.
subroutine, public drotint_num(sepi, sepj, r, dw, delta, se_int_control, se_taper)
Numerical Derivatives for rotint.
subroutine, public drotnuc_num(sepi, sepj, r, de1b, de2a, itype, delta, se_int_control, se_taper)
Numerical Derivatives for rotnuc.
subroutine, public dcorecore_num(sepi, sepj, r, denuc, itype, delta, se_int_control, se_taper)
Numerical Derivatives for corecore.
subroutine, public dcorecore_el_num(sepi, sepj, r, denuc, itype, delta, se_int_control, se_taper)
Numerical Derivatives for corecore.
subroutine, public corecore_num(sepi, sepj, rijv, enuc, itype, se_int_control, se_taper)
Computes the core-core interactions.
Set of wrappers for semi-empirical analytical/numerical Integrals routines.
subroutine, public dcorecore_el(sepi, sepj, rij, denuc, itype, delta, anag, se_int_control, se_taper)
wrapper for numerical/analytical routines core-core electrostatic (only) integrals derivatives
subroutine, public rotnuc(sepi, sepj, rij, e1b, e2a, itype, anag, se_int_control, se_taper, store_int_env)
wrapper for numerical/analytical 1 center 1 electron integrals
subroutine, public corecore_el(sepi, sepj, rij, enuc, itype, anag, se_int_control, se_taper)
wrapper for numerical/analytical routines core-core electrostatic (only) integrals
subroutine, public dcorecore(sepi, sepj, rij, denuc, itype, delta, anag, se_int_control, se_taper)
wrapper for numerical/analytical routines
subroutine, public corecore(sepi, sepj, rij, enuc, itype, anag, se_int_control, se_taper)
wrapper for numerical/analytical routines core-core integrals, since are evaluated only once do not n...
subroutine, public drotint(sepi, sepj, rij, dw, delta, anag, se_int_control, se_taper)
wrapper for numerical/analytical routines
subroutine, public rotint(sepi, sepj, rij, w, anag, se_int_control, se_taper, store_int_env)
wrapper for numerical/analytical 2 center 2 electrons integrals routines with possibility of incore s...
subroutine, public drotnuc(sepi, sepj, rij, de1b, de2a, itype, delta, anag, se_int_control, se_taper)
wrapper for numerical/analytical routines
Type to store integrals for semi-empirical calculations.
Definition of the semi empirical parameter types.