(git:ed6f26b)
Loading...
Searching...
No Matches
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-2025 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
45#include "./base/base_uses.f90"
46
47 IMPLICIT NONE
48
49 PRIVATE
50
51 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'semi_empirical_integrals'
54
55CONTAINS
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
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.
Taper type use in semi-empirical calculations.