Avoid integer overflow in hash calculation (#812)

* Set laplace array in libxc * Avoid integer overflow in hash calculation
cp2k · Mar 10, 2020 · 1736ca2 · 1736ca2
1 parent e22ab4c
commit 1736ca2
Show file tree

Hide file tree

Showing 6 changed files with 46 additions and 18 deletions.
diff --git a/src/core_ae.F b/src/core_ae.F
@@ -21,7 +21,8 @@ MODULE core_ae
    USE external_potential_types,        ONLY: all_potential_type,&
                                               get_potential,&
                                               sgp_potential_type
-   USE kinds,                           ONLY: dp
+   USE kinds,                           ONLY: dp,&
+                                              int_8
    USE orbital_pointers,                ONLY: coset,&
                                               indco,&
                                               init_orbital_pointers,&
@@ -124,8 +125,11 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us
 !$    INTEGER(kind=omp_lock_kind), &
 !$       ALLOCATABLE, DIMENSION(:) :: locks
 !$    INTEGER                                            :: lock_num, hash, hash1, hash2
+!$    INTEGER(KIND=int_8)                                :: iatom8
 !$    INTEGER, PARAMETER                                 :: nlock = 501
 
+      MARK_USED(int_8)
+
       IF (calculate_forces) THEN
          CALL timeset(routineN//"_forces", handle)
       ELSE
@@ -190,7 +194,7 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us
 !$OMP          rac, dac, rbc, rab2, rac2, rbc2, dbc, na_plus, nb_plus, verf, vnuc, &
 !$OMP          set_radius_a,  core_radius, rpgfa, force_a, force_b, mepos, &
 !$OMP          habd, f0, katom, cellind, img, nij, ff, &
-!$OMP          sgp_potential, all_potential, hash, hash1, hash2) &
+!$OMP          sgp_potential, all_potential, hash, hash1, hash2, iatom8) &
 !$OMP REDUCTION (+ : pv_thread, force_thread )
 
 !$OMP SINGLE
@@ -226,7 +230,8 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us
          IF (.NOT. ASSOCIATED(basis_set_a)) CYCLE
          basis_set_b => basis_set_list(jkind)%gto_basis_set
          IF (.NOT. ASSOCIATED(basis_set_b)) CYCLE
-!$       hash1 = MOD((iatom - 1)*natom + jatom, nlock) + 1
+!$       iatom8 = (iatom - 1)*natom + jatom
+!$       hash1 = INT(MOD(iatom8, INT(nlock, int_8)) + 1)
          ! basis ikind
          first_sgfa => basis_set_a%first_sgf
          la_max => basis_set_a%lmax

diff --git a/src/core_ppl.F b/src/core_ppl.F
@@ -26,7 +26,8 @@ MODULE core_ppl
    USE external_potential_types,        ONLY: get_potential,&
                                               gth_potential_type,&
                                               sgp_potential_type
-   USE kinds,                           ONLY: dp
+   USE kinds,                           ONLY: dp,&
+                                              int_8
    USE lri_environment_types,           ONLY: lri_kind_type
    USE orbital_pointers,                ONLY: init_orbital_pointers,&
                                               ncoset
@@ -138,8 +139,11 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u
 !$    INTEGER(kind=omp_lock_kind), &
 !$       ALLOCATABLE, DIMENSION(:) :: locks
 !$    INTEGER                                            :: lock_num, hash, hash1, hash2
+!$    INTEGER(KIND=int_8)                                :: iatom8
 !$    INTEGER, PARAMETER                                 :: nlock = 501
 
+      MARK_USED(int_8)
+
       IF (calculate_forces) THEN
          CALL timeset(routineN//"_forces", handle)
       ELSE
@@ -213,7 +217,7 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u
 !$OMP          nct_lpot, cval_ppl, cval_lpot, rac, dac, rbc, dbc, &
 !$OMP          set_radius_a,  rpgfa, force_a, force_b, ppl_fwork, mepos, &
 !$OMP          slot, f0, katom, ppl_work, cellind, img, ecp_local, &
-!$OMP          nloc, nrloc, aloc, bloc, n_local, a_local, c_local, ldai, hash, hash1, hash2) &
+!$OMP          nloc, nrloc, aloc, bloc, n_local, a_local, c_local, ldai, hash, hash1, hash2, iatom8) &
 !$OMP REDUCTION (+ : pv_thread, force_thread )
 
 !$OMP SINGLE
@@ -253,7 +257,8 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u
          basis_set_b => basis_set_list(jkind)%gto_basis_set
          IF (.NOT. ASSOCIATED(basis_set_b)) CYCLE
 
-!$       hash1 = MOD((iatom - 1)*natom + jatom, nlock) + 1
+!$       iatom8 = (iatom - 1)*natom + jatom
+!$       hash1 = INT(MOD(iatom8, INT(nlock, int_8)) + 1)
 
          ! basis ikind
          first_sgfa => basis_set_a%first_sgf

diff --git a/src/core_ppnl.F b/src/core_ppnl.F
@@ -22,7 +22,8 @@ MODULE core_ppnl
                                               gth_potential_type,&
                                               sgp_potential_p_type,&
                                               sgp_potential_type
-   USE kinds,                           ONLY: dp
+   USE kinds,                           ONLY: dp,&
+                                              int_8
    USE orbital_pointers,                ONLY: init_orbital_pointers,&
                                               nco,&
                                               ncoset
@@ -134,9 +135,12 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces,
 
 !$    INTEGER(kind=omp_lock_kind), &
 !$       ALLOCATABLE, DIMENSION(:) :: locks
+!$    INTEGER(KIND=int_8)                                :: iatom8
 !$    INTEGER                                            :: lock_num, hash
 !$    INTEGER, PARAMETER                                 :: nlock = 501
 
+      MARK_USED(int_8)
+
       IF (calculate_forces) THEN
          CALL timeset(routineN//"_forces", handle)
       ELSE
@@ -435,7 +439,7 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces,
 !$OMP          slot, iab, atom_a, f0, irow, icol, h_block, &
 !$OMP          found,p_block, iac, ibc, alist_ac, alist_bc, acint, bcint, &
 !$OMP          achint, bchint, na, np, nb, katom, j, fa, fb, rbc, rac, &
-!$OMP          kkind, kac, kbc, i, img, hash, natom) &
+!$OMP          kkind, kac, kbc, i, img, hash, iatom8, natom) &
 !$OMP REDUCTION (+ : pv_thread, force_thread )
 
 !$OMP SINGLE
@@ -514,7 +518,8 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces,
                            na = SIZE(acint, 1)
                            np = SIZE(acint, 2)
                            nb = SIZE(bcint, 1)
-!$                         hash = MOD((iatom - 1)*natom + jatom, nlock) + 1
+!$                         iatom8 = (iatom - 1)*natom + jatom
+!$                         hash = INT(MOD(iatom8, INT(nlock, int_8)) + 1)
 !$                         CALL omp_set_lock(locks(hash))
                            IF (iatom <= jatom) THEN
                               h_block(1:na, 1:nb) = h_block(1:na, 1:nb) + &

diff --git a/src/qs_kinetic.F b/src/qs_kinetic.F
@@ -27,7 +27,8 @@ MODULE qs_kinetic
                                               dbcsr_get_block_p,&
                                               dbcsr_p_type,&
                                               dbcsr_type
-   USE kinds,                           ONLY: dp
+   USE kinds,                           ONLY: dp,&
+                                              int_8
    USE kpoint_types,                    ONLY: get_kpoint_info,&
                                               kpoint_type
    USE orbital_pointers,                ONLY: ncoset
@@ -181,8 +182,11 @@ SUBROUTINE build_kinetic_matrix_low(ks_env, matrix_t, matrixkp_t, matrix_name, b
 !$    INTEGER(kind=omp_lock_kind), &
 !$       ALLOCATABLE, DIMENSION(:) :: locks
 !$    INTEGER                                            :: lock_num, hash, hash1, hash2
+!$    INTEGER(KIND=int_8)                                :: iatom8
 !$    INTEGER, PARAMETER                                 :: nlock = 501
 
+      MARK_USED(int_8)
+
       CALL timeset(routineN, handle)
 
       ! test for matrices (kpoints or standard gamma point)
@@ -254,7 +258,7 @@ SUBROUTINE build_kinetic_matrix_low(ks_env, matrix_t, matrixkp_t, matrix_name, b
 !$OMP          first_sgfa, la_max, la_min, npgfa, nsgfa, nseta, rpgfa, set_radius_a, ncoa, ncob, force_a, &
 !$OMP          zeta, first_sgfb, lb_max, lb_min, npgfb, nsetb, rpgfb, set_radius_b, nsgfb, p_block, dab, tab, &
 !$OMP          slot, zetb, scon_a, scon_b, ic, irow, icol, f0, ff, found, trans, rab2, sgfa, sgfb, iset, jset, &
-!$OMP          hash, hash1, hash2) &
+!$OMP          hash, hash1, hash2, iatom8) &
 !$OMP REDUCTION (+ : pv_thread, force_thread )
 
 !$OMP SINGLE
@@ -287,7 +291,8 @@ SUBROUTINE build_kinetic_matrix_low(ks_env, matrix_t, matrixkp_t, matrix_name, b
          basis_set_b => basis_set_list(jkind)%gto_basis_set
          IF (.NOT. ASSOCIATED(basis_set_b)) CYCLE
 
-!$       hash1 = MOD((iatom - 1)*natom + jatom, nlock) + 1
+!$       iatom8 = (iatom - 1)*natom + jatom
+!$       hash1 = INT(MOD(iatom8, INT(nlock, int_8)) + 1)
 
          ! basis ikind
          first_sgfa => basis_set_a%first_sgf

diff --git a/src/qs_overlap.F b/src/qs_overlap.F
@@ -34,7 +34,8 @@ MODULE qs_overlap
         dbcsr_p_type, dbcsr_type, dbcsr_type_antisymmetric, dbcsr_type_no_symmetry, &
         dbcsr_type_symmetric
    USE kinds,                           ONLY: default_string_length,&
-                                              dp
+                                              dp,&
+                                              int_8
    USE kpoint_types,                    ONLY: get_kpoint_info,&
                                               kpoint_type
    USE orbital_pointers,                ONLY: indco,&
@@ -132,6 +133,8 @@ SUBROUTINE build_overlap_matrix(ks_env, matrix_s, matrixkp_s, matrix_name, &
 
       INTEGER                                            :: natom
 
+      MARK_USED(int_8)
+
       CALL get_ks_env(ks_env, natom=natom)
 
       CALL build_overlap_matrix_low(ks_env, matrix_s, matrixkp_s, matrix_name, nderivative, &
@@ -210,6 +213,7 @@ SUBROUTINE build_overlap_matrix_low(ks_env, matrix_s, matrixkp_s, matrix_name, n
 !$    INTEGER(kind=omp_lock_kind), &
 !$       ALLOCATABLE, DIMENSION(:) :: locks
 !$    INTEGER                                            :: lock_num, hash, hash1, hash2
+!$    INTEGER(KIND=int_8)                                :: iatom8
 !$    INTEGER, PARAMETER                                 :: nlock = 501
 
       CALL timeset(routineN, handle)
@@ -303,7 +307,7 @@ SUBROUTINE build_overlap_matrix_low(ks_env, matrix_s, matrixkp_s, matrix_name, n
 !$OMP          first_sgfa, la_max, la_min, npgfa, nsgfa, nseta, rpgfa, set_radius_a, ncoa, ncob, force_a, &
 !$OMP          zeta, first_sgfb, lb_max, lb_min, npgfb, nsetb, rpgfb, set_radius_b, nsgfb, p_block, dab, f,  &
 !$OMP          zetb, scon_a, scon_b, ic, irow, icol, f0, ff, found, trans, rab2, n1, n2, sgfa, sgfb, iset, jset, &
-!$OMP          hash, hash1, hash2, slot ) &
+!$OMP          hash, hash1, hash2, iatom8, slot ) &
 !$OMP REDUCTION (+ : pv_thread, force_thread )
 
 !$OMP SINGLE
@@ -339,7 +343,8 @@ SUBROUTINE build_overlap_matrix_low(ks_env, matrix_s, matrixkp_s, matrix_name, n
          basis_set_b => basis_set_list_b(jkind)%gto_basis_set
          IF (.NOT. ASSOCIATED(basis_set_b)) CYCLE
 
-!$       hash1 = MOD((iatom - 1)*natom + jatom, nlock) + 1
+!$       iatom8 = (iatom - 1)*natom + jatom
+!$       hash1 = INT(MOD(iatom8, INT(nlock, int_8)) + 1)
 
          ! basis ikind
          first_sgfa => basis_set_a%first_sgf
@@ -584,6 +589,7 @@ SUBROUTINE build_overlap_matrix_simple(ks_env, matrix_s, &
 !$    INTEGER(kind=omp_lock_kind), &
 !$       ALLOCATABLE, DIMENSION(:) :: locks
 !$    INTEGER                                            :: lock_num, hash, hash1, hash2
+!$    INTEGER(KIND=int_8)                                :: iatom8
 !$    INTEGER, PARAMETER                                 :: nlock = 501
 
       NULLIFY (dft_control)
@@ -624,7 +630,7 @@ SUBROUTINE build_overlap_matrix_simple(ks_env, matrix_s, &
 !$OMP          first_sgfa, la_max, la_min, npgfa, nsgfa, nseta, rpgfa, set_radius_a, ncoa, ncob, &
 !$OMP          zeta, first_sgfb, lb_max, lb_min, npgfb, nsetb, rpgfb, set_radius_b, nsgfb, dab, &
 !$OMP          zetb, scon_a, scon_b, irow, icol, found, trans, rab2, n1, n2, sgfa, sgfb, iset, jset, &
-!$OMP          slot, lock_num, hash, hash1, hash2 )
+!$OMP          slot, lock_num, hash, hash1, hash2, iatom8 )
 
 !$OMP SINGLE
 !$    ALLOCATE (locks(nlock))
@@ -647,7 +653,8 @@ SUBROUTINE build_overlap_matrix_simple(ks_env, matrix_s, &
          iatom = sab_nl(1)%nlist_task(slot)%iatom
          jatom = sab_nl(1)%nlist_task(slot)%jatom
          rab(1:3) = sab_nl(1)%nlist_task(slot)%r(1:3)
-!$       hash1 = MOD((iatom - 1)*natom + jatom, nlock) + 1
+!$       iatom8 = (iatom - 1)*natom + jatom
+!$       hash1 = INT(MOD(iatom8, INT(nlock, int_8)) + 1)
 
          basis_set_a => basis_set_list_a(ikind)%gto_basis_set
          IF (.NOT. ASSOCIATED(basis_set_a)) CYCLE

diff --git a/src/xc/xc_libxc.F b/src/xc/xc_libxc.F
@@ -1633,7 +1633,8 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, &
       TYPE(xc_f03_func_info_t)                           :: xc_info
       TYPE(xc_f03_func_t)                                :: xc_func
 
-! these are just dummy variables, you need to use the correct size if working
+      vlapl(1, 1) = 0.0_dp
+      vlapl(2, 1) = 0.0_dp
 
       func_id = xc_libxc_wrap_functional_get_number(func_name)
 !$OMP CRITICAL(libxc_init)