LCOV - code coverage report
Current view: top level - src - semi_empirical_integrals.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 86.3 % 183 158
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 8 8

            Line data    Source code
       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              : ! **************************************************************************************************
      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     15967956 :    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     15967956 :       w(:) = 0.0_dp
      88     15967956 :       IF (.NOT. store_int_env%memory_parameter%do_all_on_the_fly) THEN
      89     15967956 :          nints = (sepi%natorb*(sepi%natorb + 1)/2)*(sepj%natorb*(sepj%natorb + 1)/2)
      90     15967956 :          cache_size = store_int_env%memory_parameter%cache_size
      91     15967956 :          eps_storage = store_int_env%memory_parameter%eps_storage_scaling
      92     15967956 :          IF (store_int_env%filling_containers) THEN
      93       645275 :             mem_compression_counter = store_int_env%memory_parameter%actual_memory_usage*cache_size
      94       645275 :             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       645275 :                store_int_env%nbuffer = store_int_env%nbuffer + 1
      99       645275 :                buffer_overflow = .FALSE.
     100              :             END IF
     101              :             ! Compute Integrals
     102       645275 :             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       640521 :                IF (anag) THEN
     106       632803 :                   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       645275 :             IF (.NOT. buffer_overflow) THEN
     113       645275 :                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       640945 :                   memory_usage = store_int_env%memory_parameter%actual_memory_usage
     139       640945 :                   CPASSERT((nints/1.2_dp) <= HUGE(0) - memory_usage)
     140       640945 :                   IF (memory_usage + nints > SIZE(store_int_env%uncompressed_container)) THEN
     141        22073 :                      new_size = INT((memory_usage + nints)*1.2_dp)
     142        22073 :                      CALL reallocate(store_int_env%uncompressed_container, 1, new_size)
     143              :                   END IF
     144     35612845 :                   store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) = w(1:nints)
     145       640945 :                   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     15322681 :             IF (store_int_env%memory_parameter%ram_counter == store_int_env%nbuffer) THEN
     151              :                buffer_overflow = .TRUE.
     152              :             ELSE
     153     15322681 :                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     15322681 :                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     15203699 :                   memory_usage = store_int_env%memory_parameter%actual_memory_usage
     178    870839967 :                   w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1)
     179     15203699 :                   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     15967956 :    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     20026111 :    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     20026111 :       do_all_on_the_fly = .TRUE.
     239     20026111 :       IF (PRESENT(e1b)) e1b(:) = 0.0_dp
     240     20026111 :       IF (PRESENT(e2a)) e2a(:) = 0.0_dp
     241     20026111 :       IF (PRESENT(store_int_env)) do_all_on_the_fly = store_int_env%memory_parameter%do_all_on_the_fly
     242     12353663 :       IF (.NOT. do_all_on_the_fly) THEN
     243     12353663 :          nints_1 = 0
     244     12353663 :          nints_2 = 0
     245     12353663 :          IF (PRESENT(e1b)) nints_1 = (sepi%natorb*(sepi%natorb + 1)/2)
     246     12353663 :          IF (PRESENT(e2a)) nints_2 = (sepj%natorb*(sepj%natorb + 1)/2)
     247     12353663 :          nints = nints_1 + nints_2
     248              :          ! This is the upper limit for an spd basis set
     249     12353663 :          CPASSERT(nints <= 90)
     250     12353663 :          cache_size = store_int_env%memory_parameter%cache_size
     251     12353663 :          eps_storage = store_int_env%memory_parameter%eps_storage_scaling
     252     12353663 :          IF (store_int_env%filling_containers) THEN
     253       463543 :             mem_compression_counter = store_int_env%memory_parameter%actual_memory_usage*cache_size
     254       463543 :             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       463543 :                store_int_env%nbuffer = store_int_env%nbuffer + 1
     259       463543 :                buffer_overflow = .FALSE.
     260              :             END IF
     261              :             ! Compute Integrals
     262       463543 :             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       459730 :                IF (anag) THEN
     267              :                   CALL rotnuc_ana(sepi, sepj, rij, e1b=e1b, e2a=e2a, itype=itype, &
     268       455871 :                                   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       463543 :             IF (.NOT. buffer_overflow) THEN
     276      3454353 :                IF (PRESENT(e1b)) w(1:nints_1) = e1b(1:nints_1)
     277      3441750 :                IF (PRESENT(e2a)) w(nints_1 + 1:nints) = e2a(1:nints_2)
     278              : 
     279       463543 :                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       461378 :                   memory_usage = store_int_env%memory_parameter%actual_memory_usage
     305       461378 :                   CPASSERT((nints/1.2_dp) <= HUGE(0) - memory_usage)
     306       461378 :                   IF (memory_usage + nints > SIZE(store_int_env%uncompressed_container)) THEN
     307         4882 :                      new_size = INT((memory_usage + nints)*1.2_dp)
     308         4882 :                      CALL reallocate(store_int_env%uncompressed_container, 1, new_size)
     309              :                   END IF
     310      6395871 :                   store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) = w(1:nints)
     311       461378 :                   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     11890120 :             IF (store_int_env%memory_parameter%ram_counter == store_int_env%nbuffer) THEN
     317              :                buffer_overflow = .TRUE.
     318              :             ELSE
     319     11890120 :                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     11890120 :                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     11830629 :                   memory_usage = store_int_env%memory_parameter%actual_memory_usage
     344    182360236 :                   w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1)
     345     11830629 :                   store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints
     346              :                END IF
     347     97677316 :                IF (PRESENT(e1b)) e1b(1:nints_1) = w(1:nints_1)
     348     97581569 :                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     20026111 :    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     15335560 :    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     15335560 :       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     15331747 :          IF (anag) THEN
     411              :             CALL corecore_ana(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
     412     15324246 :                               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     15335560 :    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      1523155 :    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      1523155 :       IF (anag) THEN
     447              :          CALL corecore_el_ana(sepi, sepj, rij, enuc=enuc, itype=itype, se_int_control=se_int_control, &
     448      1523155 :                               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      1523155 :    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
        

Generated by: LCOV version 2.0-1