LCOV - code coverage report
Current view: top level - src - gw_integrals.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 96.3 % 191 184
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 1 1

            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 Utility method to build 3-center integrals for small cell GW
      10              : ! **************************************************************************************************
      11              : MODULE gw_integrals
      12              :    USE OMP_LIB,                         ONLY: omp_get_thread_num
      13              :    USE ai_contraction_sphi,             ONLY: abc_contract_xsmm
      14              :    USE atomic_kind_types,               ONLY: atomic_kind_type,&
      15              :                                               get_atomic_kind_set
      16              :    USE basis_set_types,                 ONLY: get_gto_basis_set,&
      17              :                                               gto_basis_set_p_type,&
      18              :                                               gto_basis_set_type
      19              :    USE cell_types,                      ONLY: cell_type,&
      20              :                                               get_cell,&
      21              :                                               pbc
      22              :    USE cp_array_utils,                  ONLY: cp_2d_r_p_type
      23              :    USE cp_control_types,                ONLY: dft_control_type
      24              :    USE cp_files,                        ONLY: close_file,&
      25              :                                               open_file
      26              :    USE gamma,                           ONLY: init_md_ftable
      27              :    USE input_constants,                 ONLY: do_potential_coulomb,&
      28              :                                               do_potential_id,&
      29              :                                               do_potential_short,&
      30              :                                               do_potential_truncated
      31              :    USE kinds,                           ONLY: dp
      32              :    USE libint_2c_3c,                    ONLY: cutoff_screen_factor,&
      33              :                                               eri_3center,&
      34              :                                               libint_potential_type
      35              :    USE libint_wrapper,                  ONLY: cp_libint_cleanup_3eri,&
      36              :                                               cp_libint_init_3eri,&
      37              :                                               cp_libint_set_contrdepth,&
      38              :                                               cp_libint_t
      39              :    USE message_passing,                 ONLY: mp_para_env_type
      40              :    USE orbital_pointers,                ONLY: ncoset
      41              :    USE particle_types,                  ONLY: particle_type
      42              :    USE qs_environment_types,            ONLY: get_qs_env,&
      43              :                                               qs_environment_type
      44              :    USE qs_kind_types,                   ONLY: qs_kind_type
      45              :    USE t_c_g0,                          ONLY: get_lmax_init,&
      46              :                                               init
      47              : 
      48              : !$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num
      49              : #include "./base/base_uses.f90"
      50              : 
      51              :    IMPLICIT NONE
      52              : 
      53              :    PRIVATE
      54              : 
      55              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'gw_integrals'
      56              : 
      57              :    PUBLIC :: build_3c_integral_block
      58              : 
      59              : CONTAINS
      60              : 
      61              : ! **************************************************************************************************
      62              : !> \brief ...
      63              : !> \param int_3c ...
      64              : !> \param qs_env ...
      65              : !> \param potential_parameter ...
      66              : !> \param basis_j ...
      67              : !> \param basis_k ...
      68              : !> \param basis_i ...
      69              : !> \param cell_j ...
      70              : !> \param cell_k ...
      71              : !> \param cell_i ...
      72              : !> \param atom_j ...
      73              : !> \param atom_k ...
      74              : !> \param atom_i ...
      75              : !> \param j_bf_start_from_atom ...
      76              : !> \param k_bf_start_from_atom ...
      77              : !> \param i_bf_start_from_atom ...
      78              : ! **************************************************************************************************
      79        11673 :    SUBROUTINE build_3c_integral_block(int_3c, qs_env, potential_parameter, &
      80         3891 :                                       basis_j, basis_k, basis_i, &
      81              :                                       cell_j, cell_k, cell_i, atom_j, atom_k, atom_i, &
      82         3891 :                                       j_bf_start_from_atom, k_bf_start_from_atom, &
      83         3891 :                                       i_bf_start_from_atom)
      84              : 
      85              :       REAL(KIND=dp), DIMENSION(:, :, :)                  :: int_3c
      86              :       TYPE(qs_environment_type), POINTER                 :: qs_env
      87              :       TYPE(libint_potential_type), INTENT(IN)            :: potential_parameter
      88              :       TYPE(gto_basis_set_p_type), DIMENSION(:)           :: basis_j, basis_k, basis_i
      89              :       INTEGER, DIMENSION(3), INTENT(IN), OPTIONAL        :: cell_j, cell_k, cell_i
      90              :       INTEGER, INTENT(IN), OPTIONAL                      :: atom_j, atom_k, atom_i
      91              :       INTEGER, DIMENSION(:), OPTIONAL                    :: j_bf_start_from_atom, &
      92              :                                                             k_bf_start_from_atom, &
      93              :                                                             i_bf_start_from_atom
      94              : 
      95              :       CHARACTER(LEN=*), PARAMETER :: routineN = 'build_3c_integral_block'
      96              : 
      97              :       INTEGER :: at_i, at_j, at_k, block_end_i, block_end_j, block_end_k, block_start_i, &
      98              :          block_start_j, block_start_k, egfi, handle, i, i_offset, ibasis, ikind, ilist, imax, is, &
      99              :          iset, j_offset, jkind, js, jset, k_offset, kkind, ks, kset, m_max, max_ncoi, max_ncoj, &
     100              :          max_ncok, max_nset, max_nsgfi, max_nsgfj, max_nsgfk, maxli, maxlj, maxlk, natom, nbasis, &
     101              :          ncoi, ncoj, ncok, nseti, nsetj, nsetk, op_ij, op_jk, sgfi, sgfj, sgfk, unit_id
     102         3891 :       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: kind_of
     103              :       INTEGER, DIMENSION(3)                              :: my_cell_i, my_cell_j, my_cell_k
     104         3891 :       INTEGER, DIMENSION(:), POINTER                     :: lmax_i, lmax_j, lmax_k, lmin_i, lmin_j, &
     105         3891 :                                                             lmin_k, npgfi, npgfj, npgfk, nsgfi, &
     106         3891 :                                                             nsgfj, nsgfk
     107         3891 :       INTEGER, DIMENSION(:, :), POINTER                  :: first_sgf_i, first_sgf_j, first_sgf_k
     108              :       REAL(KIND=dp)                                      :: dij, dik, djk, dr_ij, dr_ik, dr_jk, &
     109              :                                                             kind_radius_i, kind_radius_j, &
     110              :                                                             kind_radius_k, sijk_ext
     111         3891 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: ccp_buffer, cpp_buffer, &
     112         3891 :                                                             max_contraction_i, max_contraction_j, &
     113         3891 :                                                             max_contraction_k
     114         3891 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :)     :: sijk, sijk_contr
     115              :       REAL(KIND=dp), DIMENSION(3)                        :: ri, rij, rik, rj, rjk, rk
     116              :       REAL(KIND=dp), DIMENSION(3, 3)                     :: hmat
     117         3891 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: set_radius_i, set_radius_j, set_radius_k
     118         3891 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: rpgf_i, rpgf_j, rpgf_k, sphi_i, sphi_j, &
     119         3891 :                                                             sphi_k, zeti, zetj, zetk
     120         3891 :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
     121              :       TYPE(cell_type), POINTER                           :: cell
     122         3891 :       TYPE(cp_2d_r_p_type), DIMENSION(:, :), POINTER     :: spi, spk, tspj
     123              :       TYPE(cp_libint_t)                                  :: lib
     124              :       TYPE(dft_control_type), POINTER                    :: dft_control
     125              :       TYPE(gto_basis_set_type), POINTER                  :: basis_set
     126              :       TYPE(mp_para_env_type), POINTER                    :: para_env
     127         3891 :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     128         3891 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
     129              : 
     130         3891 :       CALL timeset(routineN, handle)
     131              : 
     132         3891 :       op_ij = potential_parameter%potential_type
     133         3891 :       op_jk = do_potential_id
     134              : 
     135         3891 :       dr_ij = 0.0_dp; dr_jk = 0.0_dp; dr_ik = 0.0_dp
     136              : 
     137         3891 :       IF (op_ij == do_potential_truncated .OR. op_ij == do_potential_short) THEN
     138         3891 :          dr_ij = potential_parameter%cutoff_radius*cutoff_screen_factor
     139         3891 :          dr_ik = potential_parameter%cutoff_radius*cutoff_screen_factor
     140            0 :       ELSEIF (op_ij == do_potential_coulomb) THEN
     141            0 :          dr_ij = 1000000.0_dp
     142            0 :          dr_ik = 1000000.0_dp
     143              :       END IF
     144              : 
     145         3891 :       NULLIFY (qs_kind_set, atomic_kind_set)
     146              : 
     147              :       ! get stuff
     148              :       CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, cell=cell, &
     149              :                       natom=natom, dft_control=dft_control, para_env=para_env, &
     150         3891 :                       particle_set=particle_set)
     151         3891 :       CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, kind_of=kind_of)
     152         3891 :       CALL get_cell(cell=cell, h=hmat)
     153              : 
     154              :       !Need the max l for each basis for libint and max nset, nco and nsgf for LIBXSMM contraction
     155         3891 :       nbasis = SIZE(basis_i)
     156         3891 :       max_nsgfi = 0
     157         3891 :       max_ncoi = 0
     158         3891 :       max_nset = 0
     159         3891 :       maxli = 0
     160        11649 :       DO ibasis = 1, nbasis
     161              :          CALL get_gto_basis_set(gto_basis_set=basis_i(ibasis)%gto_basis_set, maxl=imax, &
     162         7758 :                                 nset=iset, nsgf_set=nsgfi, npgf=npgfi)
     163         7758 :          maxli = MAX(maxli, imax)
     164         7758 :          max_nset = MAX(max_nset, iset)
     165        19479 :          max_nsgfi = MAX(max_nsgfi, MAXVAL(nsgfi))
     166        31128 :          max_ncoi = MAX(max_ncoi, MAXVAL(npgfi)*ncoset(maxli))
     167              :       END DO
     168              :       max_nsgfj = 0
     169              :       max_ncoj = 0
     170              :       maxlj = 0
     171        11649 :       DO ibasis = 1, nbasis
     172              :          CALL get_gto_basis_set(gto_basis_set=basis_j(ibasis)%gto_basis_set, maxl=imax, &
     173         7758 :                                 nset=jset, nsgf_set=nsgfj, npgf=npgfj)
     174         7758 :          maxlj = MAX(maxlj, imax)
     175         7758 :          max_nset = MAX(max_nset, jset)
     176        23250 :          max_nsgfj = MAX(max_nsgfj, MAXVAL(nsgfj))
     177        34899 :          max_ncoj = MAX(max_ncoj, MAXVAL(npgfj)*ncoset(maxlj))
     178              :       END DO
     179              :       max_nsgfk = 0
     180              :       max_ncok = 0
     181              :       maxlk = 0
     182        11649 :       DO ibasis = 1, nbasis
     183              :          CALL get_gto_basis_set(gto_basis_set=basis_k(ibasis)%gto_basis_set, maxl=imax, &
     184         7758 :                                 nset=kset, nsgf_set=nsgfk, npgf=npgfk)
     185         7758 :          maxlk = MAX(maxlk, imax)
     186         7758 :          max_nset = MAX(max_nset, kset)
     187        23250 :          max_nsgfk = MAX(max_nsgfk, MAXVAL(nsgfk))
     188        34899 :          max_ncok = MAX(max_ncok, MAXVAL(npgfk)*ncoset(maxlk))
     189              :       END DO
     190         3891 :       m_max = maxli + maxlj + maxlk
     191              : 
     192              :       !To minimize expensive memory opsand generally optimize contraction, pre-allocate
     193              :       !contiguous sphi arrays (and transposed in the cas of sphi_i)
     194              : 
     195         3891 :       NULLIFY (tspj, spi, spk)
     196       124368 :       ALLOCATE (spi(max_nset, nbasis), tspj(max_nset, nbasis), spk(max_nset, nbasis))
     197              : 
     198        11649 :       DO ibasis = 1, nbasis
     199        34971 :          DO iset = 1, max_nset
     200        23322 :             NULLIFY (spi(iset, ibasis)%array)
     201        23322 :             NULLIFY (tspj(iset, ibasis)%array)
     202              : 
     203        31080 :             NULLIFY (spk(iset, ibasis)%array)
     204              :          END DO
     205              :       END DO
     206              : 
     207        15564 :       DO ilist = 1, 3
     208        38838 :          DO ibasis = 1, nbasis
     209        23274 :             IF (ilist == 1) basis_set => basis_i(ibasis)%gto_basis_set
     210        23274 :             IF (ilist == 2) basis_set => basis_j(ibasis)%gto_basis_set
     211        23274 :             IF (ilist == 3) basis_set => basis_k(ibasis)%gto_basis_set
     212              : 
     213        77652 :             DO iset = 1, basis_set%nset
     214              : 
     215        42705 :                ncoi = basis_set%npgf(iset)*ncoset(basis_set%lmax(iset))
     216        42705 :                sgfi = basis_set%first_sgf(1, iset)
     217        42705 :                egfi = sgfi + basis_set%nsgf_set(iset) - 1
     218              : 
     219        65979 :                IF (ilist == 1) THEN
     220        46884 :                   ALLOCATE (spi(iset, ibasis)%array(ncoi, basis_set%nsgf_set(iset)))
     221       161019 :                   spi(iset, ibasis)%array(:, :) = basis_set%sphi(1:ncoi, sgfi:egfi)
     222              : 
     223        30984 :                ELSE IF (ilist == 2) THEN
     224        61968 :                   ALLOCATE (tspj(iset, ibasis)%array(basis_set%nsgf_set(iset), ncoi))
     225       975180 :                   tspj(iset, ibasis)%array(:, :) = TRANSPOSE(basis_set%sphi(1:ncoi, sgfi:egfi))
     226              : 
     227              :                ELSE
     228        61968 :                   ALLOCATE (spk(iset, ibasis)%array(ncoi, basis_set%nsgf_set(iset)))
     229       827946 :                   spk(iset, ibasis)%array(:, :) = basis_set%sphi(1:ncoi, sgfi:egfi)
     230              :                END IF
     231              : 
     232              :             END DO !iset
     233              :          END DO !ibasis
     234              :       END DO !ilist
     235              : 
     236              :       !Init the truncated Coulomb operator
     237         3891 :       IF (op_ij == do_potential_truncated .OR. op_jk == do_potential_truncated) THEN
     238              : 
     239         3891 :          IF (m_max > get_lmax_init()) THEN
     240            6 :             IF (para_env%mepos == 0) THEN
     241            3 :                CALL open_file(unit_number=unit_id, file_name=potential_parameter%filename)
     242              :             END IF
     243            6 :             CALL init(m_max, unit_id, para_env%mepos, para_env)
     244            6 :             IF (para_env%mepos == 0) THEN
     245            3 :                CALL close_file(unit_id)
     246              :             END IF
     247              :          END IF
     248              :       END IF
     249              : 
     250         3891 :       CALL init_md_ftable(nmax=m_max)
     251              : 
     252         3891 :       CALL cp_libint_init_3eri(lib, MAX(maxli, maxlj, maxlk))
     253         3891 :       CALL cp_libint_set_contrdepth(lib, 1)
     254              : 
     255              :       !pre-allocate contraction buffers
     256        19455 :       ALLOCATE (cpp_buffer(max_nsgfj*max_ncok), ccp_buffer(max_nsgfj*max_nsgfk*max_ncoi))
     257       207734 :       int_3c(:, :, :) = 0.0_dp
     258              : 
     259              :       ! loop over all RI atoms
     260        15255 :       DO at_i = 1, natom
     261              : 
     262              :          ! loop over all AO atoms
     263        48729 :          DO at_j = 1, natom
     264              : 
     265              :             ! loop over all AO atoms
     266       144024 :             DO at_k = 1, natom
     267              : 
     268        99186 :                IF (PRESENT(atom_i)) THEN
     269        98994 :                   IF (at_i .NE. atom_i) CYCLE
     270              :                END IF
     271        33570 :                IF (PRESENT(atom_j)) THEN
     272        33570 :                   IF (at_j .NE. atom_j) CYCLE
     273              :                END IF
     274        11412 :                IF (PRESENT(atom_k)) THEN
     275        11412 :                   IF (at_k .NE. atom_k) CYCLE
     276              :                END IF
     277              : 
     278         3915 :                my_cell_i(1:3) = 0
     279         3915 :                IF (PRESENT(cell_i)) my_cell_i(1:3) = cell_i(1:3)
     280         3915 :                my_cell_j(1:3) = 0
     281         3915 :                IF (PRESENT(cell_j)) my_cell_j(1:3) = cell_j(1:3)
     282         3915 :                my_cell_k(1:3) = 0
     283         3915 :                IF (PRESENT(cell_k)) my_cell_k(1:3) = cell_k(1:3)
     284              : 
     285        78300 :                ri = pbc(particle_set(at_i)%r(1:3), cell) + MATMUL(hmat, REAL(my_cell_i, dp))
     286        78300 :                rj = pbc(particle_set(at_j)%r(1:3), cell) + MATMUL(hmat, REAL(my_cell_j, dp))
     287        78300 :                rk = pbc(particle_set(at_k)%r(1:3), cell) + MATMUL(hmat, REAL(my_cell_k, dp))
     288              : 
     289        15660 :                rjk(1:3) = rk(1:3) - rj(1:3)
     290        15660 :                rij(1:3) = rj(1:3) - ri(1:3)
     291        15660 :                rik(1:3) = rk(1:3) - ri(1:3)
     292              : 
     293        15660 :                djk = NORM2(rjk)
     294        15660 :                dij = NORM2(rij)
     295        15660 :                dik = NORM2(rik)
     296              : 
     297         3915 :                ikind = kind_of(at_i)
     298         3915 :                jkind = kind_of(at_j)
     299         3915 :                kkind = kind_of(at_k)
     300              : 
     301              :                CALL get_gto_basis_set(basis_i(ikind)%gto_basis_set, first_sgf=first_sgf_i, &
     302              :                                       lmax=lmax_i, lmin=lmin_i, npgf=npgfi, nset=nseti, &
     303              :                                       nsgf_set=nsgfi, pgf_radius=rpgf_i, set_radius=set_radius_i, &
     304         3915 :                                       sphi=sphi_i, zet=zeti, kind_radius=kind_radius_i)
     305              : 
     306              :                CALL get_gto_basis_set(basis_j(jkind)%gto_basis_set, first_sgf=first_sgf_j, &
     307              :                                       lmax=lmax_j, lmin=lmin_j, npgf=npgfj, nset=nsetj, &
     308              :                                       nsgf_set=nsgfj, pgf_radius=rpgf_j, set_radius=set_radius_j, &
     309         3915 :                                       sphi=sphi_j, zet=zetj, kind_radius=kind_radius_j)
     310              : 
     311              :                CALL get_gto_basis_set(basis_k(kkind)%gto_basis_set, first_sgf=first_sgf_k, &
     312              :                                       lmax=lmax_k, lmin=lmin_k, npgf=npgfk, nset=nsetk, &
     313              :                                       nsgf_set=nsgfk, pgf_radius=rpgf_k, set_radius=set_radius_k, &
     314         3915 :                                       sphi=sphi_k, zet=zetk, kind_radius=kind_radius_k)
     315              : 
     316         3915 :                IF (kind_radius_j + kind_radius_i + dr_ij < dij) CYCLE
     317         3915 :                IF (kind_radius_j + kind_radius_k + dr_jk < djk) CYCLE
     318         3915 :                IF (kind_radius_k + kind_radius_i + dr_ik < dik) CYCLE
     319              : 
     320        11745 :                ALLOCATE (max_contraction_i(nseti))
     321         9280 :                max_contraction_i = 0.0_dp
     322         9280 :                DO iset = 1, nseti
     323         5365 :                   sgfi = first_sgf_i(1, iset)
     324              :                   max_contraction_i(iset) = MAXVAL((/(SUM(ABS(sphi_i(:, i))), i=sgfi, &
     325        55832 :                                                       sgfi + nsgfi(iset) - 1)/))
     326              :                END DO
     327              : 
     328        11745 :                ALLOCATE (max_contraction_j(nsetj))
     329        12262 :                max_contraction_j = 0.0_dp
     330        12262 :                DO jset = 1, nsetj
     331         8347 :                   sgfj = first_sgf_j(1, jset)
     332              :                   max_contraction_j(jset) = MAXVAL((/(SUM(ABS(sphi_j(:, i))), i=sgfj, &
     333       232809 :                                                       sgfj + nsgfj(jset) - 1)/))
     334              :                END DO
     335              : 
     336        11745 :                ALLOCATE (max_contraction_k(nsetk))
     337        12262 :                max_contraction_k = 0.0_dp
     338        12262 :                DO kset = 1, nsetk
     339         8347 :                   sgfk = first_sgf_k(1, kset)
     340              :                   max_contraction_k(kset) = MAXVAL((/(SUM(ABS(sphi_k(:, i))), i=sgfk, &
     341       232809 :                                                       sgfk + nsgfk(kset) - 1)/))
     342              :                END DO
     343              : 
     344         9280 :                DO iset = 1, nseti
     345              : 
     346        20507 :                   DO jset = 1, nsetj
     347              : 
     348        11227 :                      IF (set_radius_j(jset) + set_radius_i(iset) + dr_ij < dij) CYCLE
     349              : 
     350        37093 :                      DO kset = 1, nsetk
     351              : 
     352        21605 :                         IF (set_radius_j(jset) + set_radius_k(kset) + dr_jk < djk) CYCLE
     353        19265 :                         IF (set_radius_k(kset) + set_radius_i(iset) + dr_ik < dik) CYCLE
     354              : 
     355        17643 :                         ncoi = npgfi(iset)*ncoset(lmax_i(iset))
     356        17643 :                         ncoj = npgfj(jset)*ncoset(lmax_j(jset))
     357        17643 :                         ncok = npgfk(kset)*ncoset(lmax_k(kset))
     358              : 
     359        17643 :                         sgfi = first_sgf_i(1, iset)
     360        17643 :                         sgfj = first_sgf_j(1, jset)
     361        17643 :                         sgfk = first_sgf_k(1, kset)
     362              : 
     363        17643 :                         IF (ncoj*ncok*ncoi .LE. 0) CYCLE
     364        88215 :                         ALLOCATE (sijk(ncoj, ncok, ncoi))
     365      1624906 :                         sijk(:, :, :) = 0.0_dp
     366              : 
     367        17643 :                         is = iset
     368        17643 :                         js = jset
     369        17643 :                         ks = kset
     370              : 
     371              :                         CALL eri_3center(sijk, &
     372              :                                          lmin_j(js), lmax_j(js), npgfj(js), zetj(:, js), &
     373              :                                          rpgf_j(:, js), rj, &
     374              :                                          lmin_k(ks), lmax_k(ks), npgfk(ks), zetk(:, ks), &
     375              :                                          rpgf_k(:, ks), rk, &
     376              :                                          lmin_i(is), lmax_i(is), npgfi(is), zeti(:, is), &
     377              :                                          rpgf_i(:, is), ri, &
     378              :                                          djk, dij, dik, lib, potential_parameter, &
     379        17643 :                                          int_abc_ext=sijk_ext)
     380              : 
     381        88215 :                         ALLOCATE (sijk_contr(nsgfj(jset), nsgfk(kset), nsgfi(iset)))
     382              :                         CALL abc_contract_xsmm(sijk_contr, sijk, tspj(jset, jkind)%array, &
     383              :                                                spk(kset, kkind)%array, spi(iset, ikind)%array, &
     384              :                                                ncoj, ncok, ncoi, nsgfj(jset), nsgfk(kset), &
     385        17643 :                                                nsgfi(iset), cpp_buffer, ccp_buffer)
     386        17643 :                         DEALLOCATE (sijk)
     387              : 
     388        17643 :                         IF (PRESENT(atom_j)) THEN
     389              :                            j_offset = 0
     390              :                         ELSE
     391            0 :                            CPASSERT(PRESENT(j_bf_start_from_atom))
     392            0 :                            j_offset = j_bf_start_from_atom(at_j) - 1
     393              :                         END IF
     394        17643 :                         IF (PRESENT(atom_k)) THEN
     395              :                            k_offset = 0
     396              :                         ELSE
     397            0 :                            CPASSERT(PRESENT(k_bf_start_from_atom))
     398            0 :                            k_offset = k_bf_start_from_atom(at_k) - 1
     399              :                         END IF
     400        17643 :                         IF (PRESENT(atom_i)) THEN
     401              :                            i_offset = 0
     402              :                         ELSE
     403          240 :                            CPASSERT(PRESENT(i_bf_start_from_atom))
     404          240 :                            i_offset = i_bf_start_from_atom(at_i) - 1
     405              :                         END IF
     406              : 
     407        17643 :                         block_start_j = sgfj + j_offset
     408        17643 :                         block_end_j = sgfj + nsgfj(jset) - 1 + j_offset
     409        17643 :                         block_start_k = sgfk + k_offset
     410        17643 :                         block_end_k = sgfk + nsgfk(kset) - 1 + k_offset
     411        17643 :                         block_start_i = sgfi + i_offset
     412        17643 :                         block_end_i = sgfi + nsgfi(iset) - 1 + i_offset
     413              : 
     414              :                         int_3c(block_start_j:block_end_j, &
     415              :                                block_start_k:block_end_k, &
     416              :                                block_start_i:block_end_i) = &
     417              :                            int_3c(block_start_j:block_end_j, &
     418              :                                   block_start_k:block_end_k, &
     419              :                                   block_start_i:block_end_i) + &
     420       217098 :                            sijk_contr(:, :, :)
     421        32832 :                         DEALLOCATE (sijk_contr)
     422              : 
     423              :                      END DO
     424              : 
     425              :                   END DO
     426              : 
     427              :                END DO
     428              : 
     429        41304 :                DEALLOCATE (max_contraction_i, max_contraction_j, max_contraction_k)
     430              : 
     431              :             END DO ! atom_k (AO)
     432              :          END DO ! atom_j (AO)
     433              :       END DO ! atom_i (RI)
     434              : 
     435         3891 :       CALL cp_libint_cleanup_3eri(lib)
     436              : 
     437        15612 :       DO iset = 1, max_nset
     438        38934 :          DO ibasis = 1, nbasis
     439        23322 :             IF (ASSOCIATED(spi(iset, ibasis)%array)) DEALLOCATE (spi(iset, ibasis)%array)
     440        23322 :             IF (ASSOCIATED(tspj(iset, ibasis)%array)) DEALLOCATE (tspj(iset, ibasis)%array)
     441              : 
     442        35043 :             IF (ASSOCIATED(spk(iset, ibasis)%array)) DEALLOCATE (spk(iset, ibasis)%array)
     443              :          END DO
     444              :       END DO
     445         3891 :       DEALLOCATE (spi, tspj, spk)
     446              : 
     447         3891 :       CALL timestop(handle)
     448              : 
     449         7782 :    END SUBROUTINE build_3c_integral_block
     450              : 
     451              : END MODULE
     452              : 
        

Generated by: LCOV version 2.0-1