Fix various simple Valgrind issues

cp2k · Feb 1, 2023 · 45a2e79 · 45a2e79
1 parent 75bc0d2
commit 45a2e79
Show file tree

Hide file tree

Showing 15 changed files with 48 additions and 37 deletions.
diff --git a/src/almo_scf_env_methods.F b/src/almo_scf_env_methods.F
@@ -195,6 +195,8 @@ SUBROUTINE almo_scf_init_read_write_input(input, almo_scf_env)
                                 r_val=almo_scf_env%opt_block_diag_pcg%lin_search_eps_error)
       CALL section_vals_val_get(almo_opt_pcg_section, "LIN_SEARCH_STEP_SIZE_GUESS", &
                                 r_val=almo_scf_env%opt_block_diag_pcg%lin_search_step_size_guess)
+      CALL section_vals_val_get(almo_opt_pcg_section, "PRECOND_FILTER_THRESHOLD", &
+                                r_val=almo_scf_env%opt_block_diag_pcg%neglect_threshold)
       CALL section_vals_val_get(almo_opt_pcg_section, "CONJUGATOR", &
                                 i_val=almo_scf_env%opt_block_diag_pcg%conjugator)
       CALL section_vals_val_get(almo_opt_pcg_section, "PRECONDITIONER", &

diff --git a/src/constraint_clv.F b/src/constraint_clv.F
@@ -924,17 +924,22 @@ FUNCTION eval_Jac_colvar(colvar, colvar_old, roll, rmat, imass) RESULT(res)
       END IF
 
       res = 0.0_dp
-      DO i = 1, SIZE(colvar%i_atom)
-         iatom = colvar%i_atom(i)
-         tmp1 = colvar%dsdr(1:3, i)
-         IF (my_roll) THEN
+      IF (my_roll) THEN
+         DO i = 1, SIZE(colvar%i_atom)
+            iatom = colvar%i_atom(i)
+            tmp1 = colvar%dsdr(1:3, i)
             tmp3 = colvar_old%dsdr(1:3, i)
             tmp2 = MATMUL(rmat, tmp3)
-         ELSE
+            res = res + DOT_PRODUCT(tmp1, tmp2)*imass(iatom)
+         END DO
+      ELSE
+         DO i = 1, SIZE(colvar%i_atom)
+            iatom = colvar%i_atom(i)
+            tmp1 = colvar%dsdr(1:3, i)
             tmp2 = colvar_old%dsdr(1:3, i)
-         END IF
-         res = res + DOT_PRODUCT(tmp1, tmp2)*imass(iatom)
-      END DO
+            res = res + DOT_PRODUCT(tmp1, tmp2)*imass(iatom)
+         END DO
+      END IF
 
    END FUNCTION eval_Jac_colvar
 

diff --git a/src/cryssym.F b/src/cryssym.F
@@ -185,10 +185,11 @@ SUBROUTINE crys_sym_gen(csym, scoor, types, hmat, delta, iounit)
             tra_mat = 0
             ierr = spg_get_pointgroup(csym%pointgroup_symbol, tra_mat, &
                                       csym%rotations, csym%n_operations)
+
+            CALL strip_control_codes(csym%international_symbol)
+            CALL strip_control_codes(csym%schoenflies)
+            CALL strip_control_codes(csym%pointgroup_symbol)
          END IF
-         CALL strip_control_codes(csym%international_symbol)
-         CALL strip_control_codes(csym%schoenflies)
-         CALL strip_control_codes(csym%pointgroup_symbol)
       END IF
       csym%symlib = spglib
 

diff --git a/src/hfx_types.F b/src/hfx_types.F
@@ -1963,7 +1963,7 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread)
                          "Periodic Hartree Fock calculation requested without use "// &
                          "of a truncated or shortrange potential. This may lead to unphysical total energies. "// &
                          "Use a truncated  potential to avoid possible problems.")
-         ELSE
+         ELSE IF (x_data%potential_parameter%potential_type /= do_potential_id) THEN
             l_min = MIN(plane_distance(1, 0, 0, cell), &
                         plane_distance(0, 1, 0, cell), &
                         plane_distance(0, 0, 1, cell))

diff --git a/src/input_cp2k_pwdft.F b/src/input_cp2k_pwdft.F
@@ -243,6 +243,7 @@ SUBROUTINE fill_in_section(section, section_name)
                CALL section_add_keyword(section, keyword)
                CALL keyword_release(keyword)
             CASE (SIRIUS_LOGICAL_TYPE)
+               dummy_l = .FALSE.
                CALL sirius_option_get(section_name, name, ctype, C_LOC(dummy_l))
                IF (dummy_l) THEN
                   CALL keyword_create(keyword, __LOCATION__, &

diff --git a/src/motion/helium_methods.F b/src/motion/helium_methods.F
@@ -524,6 +524,9 @@ SUBROUTINE helium_create(helium_env, input, solute)
             helium_env(k)%helium%hb2m = 1.0_dp/helium_env(k)%helium%he_mass_au
             helium_env(k)%helium%pweight = 0.0_dp
 
+            ! Default in case sampling_method is not helium_sampling_worm.
+            helium_env(k)%helium%worm_max_open_cycles = 0
+
             ! Choose sampling method:
             CALL section_vals_val_get(helium_section, "SAMPLING_METHOD", &
                                       i_val=helium_env(k)%helium%sampling_method)

diff --git a/src/mp2_optimize_ri_basis.F b/src/mp2_optimize_ri_basis.F
@@ -588,7 +588,8 @@ SUBROUTINE calc_energy_func_der(Emp2, Emp2_AA, Emp2_BB, Emp2_AB, DI_ref, &
       REAL(KIND=dp), INTENT(IN)                          :: Emp2
       REAL(KIND=dp), INTENT(INOUT)                       :: Emp2_AA, Emp2_BB, Emp2_AB
       REAL(KIND=dp), INTENT(IN)                          :: DI_ref
-      REAL(KIND=dp), DIMENSION(:, :, :, :), INTENT(IN)   :: Integ_MP2, Integ_MP2_AA, Integ_MP2_BB, &
+      REAL(KIND=dp), ALLOCATABLE, &
+         DIMENSION(:, :, :, :), INTENT(IN)               :: Integ_MP2, Integ_MP2_AA, Integ_MP2_BB, &
                                                             Integ_MP2_AB
       REAL(KIND=dp), INTENT(IN)                          :: eps
       TYPE(qs_environment_type), INTENT(IN), POINTER     :: qs_env
@@ -719,7 +720,8 @@ SUBROUTINE calc_energy_func(Emp2, Emp2_AA, Emp2_BB, Emp2_AB, Emp2_RI, DRI, DI, &
                                no_write)
       REAL(KIND=dp), INTENT(IN)                          :: Emp2, Emp2_AA, Emp2_BB, Emp2_AB
       REAL(KIND=dp), INTENT(OUT)                         :: Emp2_RI, DRI, DI
-      REAL(KIND=dp), DIMENSION(:, :, :, :), INTENT(IN)   :: Integ_MP2, Integ_MP2_AA, Integ_MP2_BB, &
+      REAL(KIND=dp), ALLOCATABLE, &
+         DIMENSION(:, :, :, :), INTENT(IN)               :: Integ_MP2, Integ_MP2_AA, Integ_MP2_BB, &
                                                             Integ_MP2_AB
       TYPE(qs_environment_type), INTENT(IN), POINTER     :: qs_env
       INTEGER, INTENT(IN)                                :: natom, dimen, dimen_RI, homo, virtual

diff --git a/src/mp2_ri_grad.F b/src/mp2_ri_grad.F
@@ -241,6 +241,9 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par
       NULLIFY (force, virial)
       CALL get_qs_env(qs_env=qs_env, force=force, virial=virial)
 
+      ! check if we want to calculate the virial
+      use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)
+
       ALLOCATE (natom_of_kind(SIZE(atomic_kind_set)))
       CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, natom_of_kind=natom_of_kind)
       NULLIFY (mp2_force)
@@ -343,9 +346,6 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par
          CALL prepare_gpw(qs_env, dft_control, e_cutoff_old, cutoff_old, relative_cutoff_old, para_env_sub, pw_env_sub, &
                           auxbas_pw_pool, poisson_env, task_list_sub, rho_r, rho_g, pot_g, psi_L, sab_orb_sub)
 
-         ! check if we want to calculate the virial
-         use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)
-
          ! in case virial is required we need auxiliary pw
          ! for calculate the MP2-volume contribution to the virial
          ! (hartree potential derivatives)

diff --git a/src/qs_dos.F b/src/qs_dos.F
@@ -101,6 +101,8 @@ SUBROUTINE calculate_dos(mos, dft_section)
       emin = 1.e10_dp
       emax = -1.e10_dp
       nspins = SIZE(mos)
+      nmo(:) = 0
+
       DO ispin = 1, nspins
          mo_set => mos(ispin)
          CALL get_mo_set(mo_set=mo_set, nmo=nmo(ispin), mu=e_fermi(ispin))

diff --git a/src/qs_fb_com_tasks_types.F b/src/qs_fb_com_tasks_types.F
@@ -844,8 +844,6 @@ END SUBROUTINE fb_com_atom_pairs_decode
 !>                               location in atom_pairs array for
 !>                               all the pairs to be sent to or recv
 !>                               from process ipe
-!> \param row_map : optional blk row map for the DBCSR blocks
-!> \param col_map : optional blk col map for the DBCSR blocks
 !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
 ! **************************************************************************************************
    SUBROUTINE fb_com_atom_pairs_calc_buffer_sizes(atom_pairs, &
@@ -855,16 +853,13 @@ SUBROUTINE fb_com_atom_pairs_calc_buffer_sizes(atom_pairs, &
                                                   sendrecv_sizes, &
                                                   sendrecv_disps, &
                                                   sendrecv_pair_counts, &
-                                                  sendrecv_pair_disps, &
-                                                  row_map, &
-                                                  col_map)
+                                                  sendrecv_pair_disps)
       TYPE(fb_com_atom_pairs_obj), INTENT(IN)            :: atom_pairs
       INTEGER, INTENT(IN)                                :: nprocs
       INTEGER, DIMENSION(:), INTENT(IN)                  :: row_blk_sizes, col_blk_sizes
       INTEGER, DIMENSION(:), INTENT(OUT)                 :: sendrecv_sizes, sendrecv_disps, &
                                                             sendrecv_pair_counts, &
                                                             sendrecv_pair_disps
-      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: row_map, col_map
 
       INTEGER                                            :: iatom, ipair, ipe, jatom, natoms_encode, &
                                                             ncols_blk, npairs, nrows_blk, pe
@@ -894,8 +889,6 @@ SUBROUTINE fb_com_atom_pairs_calc_buffer_sizes(atom_pairs, &
          CALL fb_com_atom_pairs_decode(pairs(ipair), &
                                        pe, iatom, jatom, natoms_encode)
          pe = pe + 1 ! we need proc to count from 1
-         IF (PRESENT(row_map)) iatom = row_map(iatom)
-         IF (PRESENT(col_map)) jatom = row_map(jatom)
          nrows_blk = row_blk_sizes(iatom)
          ncols_blk = col_blk_sizes(jatom)
          sendrecv_sizes(pe) = sendrecv_sizes(pe) + nrows_blk*ncols_blk

diff --git a/src/qs_scf_post_se.F b/src/qs_scf_post_se.F
@@ -461,8 +461,7 @@ SUBROUTINE qs_scf_post_charges(input, logger, qs_env, rho, para_env)
       TYPE(qs_rho_type), POINTER                         :: rho
       TYPE(cp_para_env_type), POINTER                    :: para_env
 
-      CHARACTER(LEN=2)                                   :: ana
-      CHARACTER(LEN=default_string_length)               :: aname
+      CHARACTER(LEN=2)                                   :: aname
       INTEGER                                            :: i, iat, iatom, ikind, j, nat, natom, &
                                                             natorb, nkind, nspin, unit_nr
       LOGICAL                                            :: found
@@ -528,12 +527,11 @@ SUBROUTINE qs_scf_post_charges(input, logger, qs_env, rho, para_env)
                DO ikind = 1, nkind
                   CALL get_atomic_kind(atomic_kind_set(ikind), natom=nat)
                   CALL get_qs_kind(qs_kind_set(ikind), se_parameter=se_kind, element_symbol=aname)
-                  ana = ADJUSTR(TRIM(ADJUSTL(aname)))
                   DO iatom = 1, nat
                      iat = atomic_kind_set(ikind)%atom_list(iatom)
                      WRITE (UNIT=unit_nr, &
                             FMT="(T2,I7,6X,A2,3X,I6,T39,F12.6,T69,F12.6)") &
-                        iat, ana, ikind, charges(iat, 1), mcharge(iat)
+                        iat, aname, ikind, charges(iat, 1), mcharge(iat)
                   END DO
                END DO
                WRITE (UNIT=unit_nr, &
@@ -545,12 +543,11 @@ SUBROUTINE qs_scf_post_charges(input, logger, qs_env, rho, para_env)
                DO ikind = 1, nkind
                   CALL get_atomic_kind(atomic_kind_set(ikind), natom=nat)
                   CALL get_qs_kind(qs_kind_set(ikind), se_parameter=se_kind, element_symbol=aname)
-                  ana = ADJUSTR(TRIM(ADJUSTL(aname)))
                   DO iatom = 1, nat
                      iat = atomic_kind_set(ikind)%atom_list(iatom)
                      WRITE (UNIT=unit_nr, &
                             FMT="(T2,I6,5X,A2,2X,I6,T29,4(1X,F12.6))") &
-                        iat, ana, ikind, charges(iat, 1:2), mcharge(iat), charges(iat, 1) - charges(iat, 2)
+                        iat, aname, ikind, charges(iat, 1:2), mcharge(iat), charges(iat, 1) - charges(iat, 2)
                   END DO
                END DO
                WRITE (UNIT=unit_nr, &

diff --git a/src/rpa_grad.F b/src/rpa_grad.F
@@ -1309,7 +1309,8 @@ SUBROUTINE calc_P_rpa_a(P_ab, mat_S, mat_work, dot_blksize, buffer_1D, local_gem
       REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT)      :: P_ab
       REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: mat_S, mat_work
       INTEGER, INTENT(IN)                                :: dot_blksize
-      REAL(KIND=dp), DIMENSION(:), INTENT(INOUT), TARGET :: buffer_1D
+      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:), &
+         INTENT(INOUT), TARGET                           :: buffer_1D
       TYPE(C_PTR), INTENT(INOUT)                         :: local_gemm_ctx
       REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: my_eval_virt, my_eval_occ, recv_eval_virt
       REAL(KIND=dp), INTENT(IN)                          :: omega, weight
@@ -1402,7 +1403,8 @@ SUBROUTINE calc_P_rpa_i(P_ij, mat_S, mat_work, dot_blksize, buffer_1D, local_gem
       REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT)      :: P_ij
       REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: mat_S, mat_work
       INTEGER, INTENT(IN)                                :: dot_blksize
-      REAL(KIND=dp), DIMENSION(:), INTENT(INOUT), TARGET :: buffer_1D
+      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:), &
+         INTENT(INOUT), TARGET                           :: buffer_1D
       TYPE(C_PTR), INTENT(INOUT)                         :: local_gemm_ctx
       REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: my_eval_virt, my_eval_occ, recv_eval_occ
       REAL(KIND=dp), INTENT(IN)                          :: omega, weight

diff --git a/src/rpa_gw.F b/src/rpa_gw.F
@@ -1239,7 +1239,8 @@ SUBROUTINE compute_QP_energies(vec_Sigma_c_gw, count_ev_sc_GW, gw_corr_lev_occ,
       TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: fm_mo_coeff_occ, fm_mo_coeff_virt
       TYPE(cp_fm_type), INTENT(IN)                       :: fm_scaled_dm_occ_tau, &
                                                             fm_scaled_dm_virt_tau, mo_coeff
-      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: fm_mat_W
+      TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
+         INTENT(IN)                                      :: fm_mat_W
       TYPE(cp_para_env_type), POINTER                    :: para_env, para_env_RPA
       TYPE(dbcsr_p_type), INTENT(IN)                     :: mat_dm, mat_MinvVMinv
       TYPE(dbt_type), ALLOCATABLE, DIMENSION(:, :)       :: t_3c_O

diff --git a/src/rpa_im_time.F b/src/rpa_im_time.F
@@ -167,7 +167,7 @@ SUBROUTINE compute_mat_P_omega(mat_P_omega, fm_scaled_dm_occ_tau, &
       TYPE(cp_para_env_type), INTENT(IN)                 :: para_env
       TYPE(qs_environment_type), POINTER                 :: qs_env
       LOGICAL, INTENT(IN)                                :: do_kpoints_from_Gamma
-      INTEGER, DIMENSION(:, :), INTENT(IN)               :: index_to_cell_3c
+      INTEGER, ALLOCATABLE, DIMENSION(:, :), INTENT(IN)  :: index_to_cell_3c
       INTEGER, ALLOCATABLE, DIMENSION(:, :, :), &
          INTENT(IN)                                      :: cell_to_index_3c
       LOGICAL, DIMENSION(:, :, :, :, :), INTENT(INOUT)   :: has_mat_P_blocks
@@ -1550,10 +1550,10 @@ SUBROUTINE get_diff_index_3c(i_cell_R, i_cell_S, i_cell_R_minus_S, index_to_cell
 
       INTEGER, INTENT(IN)                                :: i_cell_R, i_cell_S
       INTEGER, INTENT(OUT)                               :: i_cell_R_minus_S
-      INTEGER, DIMENSION(:, :), INTENT(IN)               :: index_to_cell_3c
+      INTEGER, ALLOCATABLE, DIMENSION(:, :), INTENT(IN)  :: index_to_cell_3c
       INTEGER, ALLOCATABLE, DIMENSION(:, :, :), &
          INTENT(IN)                                      :: cell_to_index_3c
-      INTEGER, DIMENSION(:, :), INTENT(IN)               :: index_to_cell_dm
+      INTEGER, DIMENSION(:, :), INTENT(IN), POINTER      :: index_to_cell_dm
       LOGICAL, INTENT(OUT)                               :: R_minus_S_needed
       LOGICAL, INTENT(IN)                                :: do_kpoints_cubic_RPA
 

diff --git a/src/rpa_im_time_force_methods.F b/src/rpa_im_time_force_methods.F
@@ -2911,6 +2911,8 @@ SUBROUTINE get_2c_mme_forces(G_PQ, force, mp2_env, qs_env)
       ALLOCATE (basis_set_ri_aux(nkind))
       CALL basis_set_list_setup(basis_set_ri_aux, "RI_AUX", qs_kind_set)
 
+      G_count = 0; R_count = 0
+
       CALL dbcsr_iterator_start(iter, G_PQ)
       DO WHILE (dbcsr_iterator_blocks_left(iter))