diff --git a/src/common/bibliography.F b/src/common/bibliography.F index 175fbe94a2..c5c1c025bd 100644 --- a/src/common/bibliography.F +++ b/src/common/bibliography.F @@ -78,7 +78,8 @@ MODULE bibliography Ceriotti2010, Walewski2014, Monkhorst1976, MacDonald1978, & Gilbert2008, Schonherr2014, Ceriotti2014, BaniHashemian2016, & Kapil2016, Heinzmann1976, Ehrhardt1985, Rybkin2016, West2006, & - Bates2013, Andermatt2016, Zhu2016, Schuett2016, Lu2004 + Bates2013, Andermatt2016, Zhu2016, Schuett2016, Lu2004, & + Becke1988b, Migliore2009, Mavros2015, Holmberg2017 CONTAINS @@ -3574,6 +3575,52 @@ CONTAINS "EP 2637", & "PY 2004"), & DOI="10.1063/1.1638731") + CALL add_reference(key=Migliore2009, ISI_record=s2a( & + "AU Migliore, A", & + "TI Full-electron calculation of effective electronic couplings and", & + " excitation energies of charge transfer states: Application to hole", & + " transfer in DNA pi-stacks", & + "SO The Journal of Chemical Physics", & + "PY 2009", & + "VL 131", & + "IS 11", & + "ER"), & + DOI="10.1063/1.3232007") + + CALL add_reference(key=Mavros2015, ISI_record=s2a( & + "AU Mavros, MG", & + " Van Voorhis, T", & + "TI Communication: CDFT-CI couplings can be unreliable when there is fractional charge transfer", & + "SO The Journal of Chemical Physics", & + "PY 2015", & + "VL 143", & + "IS 23", & + "ER"), & + DOI="10.1063/1.4938103") + + CALL add_reference(key=Becke1988b, ISI_record=s2a( & + "AU Becke, AD", & + "TI A multicenter numerical integration scheme for polyatomic molecules", & + "SO JOURNAL OF CHEMICAL PHYSICS", & + "PY 1988", & + "BP 2547", & + "EP 2553", & + "VL 88", & + "IS 4", & + "ER"), & + DOI="10.1063/1.454033") + + CALL add_reference(key=Holmberg2017, ISI_record=s2a( & + "AU Holmberg, N", & + " Laasonen, K", & + "TI Efficient Constrained Density Functional Theory Implementation for Simulation of", & + " Condensed Phase Electron Transfer Reactions", & + "SO Journal of Chemical Theory and Computation", & + "PY 2017", & + "VL 0", & + "IS 0", & + "ER"), & + DOI="10.1021/acs.jctc.6b01085") END SUBROUTINE add_all_references diff --git a/src/common/kahan_sum.F b/src/common/kahan_sum.F index 921ff81393..9910a6a250 100644 --- a/src/common/kahan_sum.F +++ b/src/common/kahan_sum.F @@ -28,7 +28,7 @@ MODULE kahan_sum IMPLICIT NONE PRIVATE - PUBLIC :: accurate_sum + PUBLIC :: accurate_sum, accurate_sum_arrays_product INTEGER, PARAMETER :: sp = KIND(0.0), dp = KIND(0.0D0) REAL(KIND=sp), PARAMETER :: szero = 0.0_sp REAL(KIND=dp), PARAMETER :: dzero = 0.0_dp @@ -44,6 +44,9 @@ MODULE kahan_sum kahan_sum_s6, kahan_sum_d6, kahan_sum_c6, kahan_sum_z6, & kahan_sum_s7, kahan_sum_d7, kahan_sum_c7, kahan_sum_z7 END INTERFACE accurate_sum + INTERFACE accurate_sum_arrays_product + MODULE PROCEDURE kahan_sum_arrays_product_masked_d3 + END INTERFACE CONTAINS ! ************************************************************************************************** !> \brief ... @@ -427,6 +430,42 @@ CONTAINS ENDIF END FUNCTION kahan_sum_d3 +! ************************************************************************************************** +!> \brief computes the accurate sum of an array that is the element wise product of two input arrays. +!> a mask array determines which product array points to include in the sum +!> \param array1 the first input array to compute the product array +!> \param array2 the second input array to compute the product array +!> \param mask the mask array +!> \param th screening threshold: only array points where the value of mask is greater than th are +!> included in the sum +!> \retval ks the result of the summation +! ************************************************************************************************** + FUNCTION kahan_sum_arrays_product_masked_d3(array1, array2, mask, th) RESULT(ks) + REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN), & + POINTER :: array1, array2, mask + REAL(KIND=dp), INTENT(in) :: th + REAL(KIND=dp) :: ks + + INTEGER :: i1, i2, i3, nflops + REAL(KIND=dp) :: c, t, y + + ks = dzero; t = dzero; y = dzero; c = dzero + DO i3 = LBOUND(mask, 3), UBOUND(mask, 3) + DO i2 = LBOUND(mask, 2), UBOUND(mask, 2) + DO i1 = LBOUND(mask, 1), UBOUND(mask, 1) + IF (mask(i1, i2, i3) .GT. th) THEN + y = array1(i1, i2, i3)*array2(i1, i2, i3)-c + t = ks+y + c = (t-ks)-y + ks = t + nflops = nflops+1 + END IF + ENDDO + ENDDO + ENDDO + + END FUNCTION kahan_sum_arrays_product_masked_d3 + ! ************************************************************************************************** !> \brief ... !> \param array ... diff --git a/src/cp_control_types.F b/src/cp_control_types.F index f2e898aa4c..237b286a9e 100644 --- a/src/cp_control_types.F +++ b/src/cp_control_types.F @@ -10,7 +10,16 @@ MODULE cp_control_types USE cp_fm_types, ONLY: cp_fm_p_type,& cp_fm_release - USE input_constants, ONLY: do_full_density + USE dbcsr_api, ONLY: dbcsr_p_type + USE hirshfeld_types, ONLY: hirshfeld_type,& + release_hirshfeld_type + USE input_constants, ONLY: becke_cutoff_global,& + becke_none_conf,& + cdft_combined_all,& + cdft_density_constraint,& + do_full_density,& + outer_scf_none,& + radius_single USE kinds, ONLY: default_path_length,& default_string_length,& dp @@ -27,10 +36,10 @@ MODULE cp_control_types ! \brief Control parameters for pw grids ! ************************************************************************************************** TYPE pw_grid_option - LOGICAL :: spherical - LOGICAL :: fullspace - INTEGER, DIMENSION(2) :: distribution_layout - INTEGER :: blocked + LOGICAL :: spherical + LOGICAL :: fullspace + INTEGER, DIMENSION(2) :: distribution_layout + INTEGER :: blocked END TYPE pw_grid_option ! ************************************************************************************************** @@ -188,70 +197,257 @@ MODULE cp_control_types ! \brief some parameters useful for ddapc_restraints ! ************************************************************************************************** TYPE ddapc_restraint_type - INTEGER :: ref_count - REAL(KIND=dp) :: strength - REAL(KIND=dp) :: TARGET - REAL(KIND=dp) :: ddapc_order_p - INTEGER :: functional_form - INTEGER :: natoms - INTEGER, POINTER, DIMENSION(:) :: atoms - REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff - INTEGER :: density_type + INTEGER :: ref_count + REAL(KIND=dp) :: strength + REAL(KIND=dp) :: TARGET + REAL(KIND=dp) :: ddapc_order_p + INTEGER :: functional_form + INTEGER :: natoms + INTEGER, POINTER, DIMENSION(:) :: atoms + REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff + INTEGER :: density_type END TYPE ddapc_restraint_type ! ************************************************************************************************** ! \brief provides a vector of pointers to ddapc_restraint_type ! ************************************************************************************************** TYPE ddapc_restraint_p_type - TYPE(ddapc_restraint_type), POINTER:: ddapc_restraint_control + TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control END TYPE ddapc_restraint_p_type ! ************************************************************************************************** -! \brief some parameters useful for becke_restraints +!> \brief some parameters useful for becke_restraints +!> \param fragment_a_fname filename of cube file holding the isolated electron density of fragment a +!> \param fragment_b_fname filename of cube file holding the isolated electron density of fragment b +!> \param ref_count the ref count +!> \param rglobal global cutoff to use for building the constraint +!> \param target target values of the constraints +!> \param strength Lagrangian multipliers of the constraints +!> \param becke_order_p integrated values of the constraints +!> \param natoms number of constraint atoms +!> \param confine_method the confine method id +!> \param cavity_shape the confinement cavity shape id +!> \param constraint_type the constraint type to use +!> \param cutoff_type the cutoff type to use for building the constraint +!> \param combined_type for combined density+spin constraint, determines which atoms to apply the spin +!> constraint to +!> \param atoms list of constraint atoms +!> \param becke_pot the Becke real space potential +!> \param cavity the Gaussian confinement cavity: the constraint is nonzero outside this cavity +!> \param combined_weight the Becke real space potential for the spin constraint when using combined +!> density+spin constraint +!> \param charge atomic Becke real space potentials needed to calculate atomic Becke charges +!> \param fragments container for isolated fragment densities read from cube files +!> \param need_pot logical which determines if the Becke potential needs to be built +!> \param save_pot logical which determines if the Becke potential should be saved until forces +!> have been evaluated +!> \param in_memory logical which determines if the gradients of the Becke potential should be +!> computed simultaneously with the potential instead of separately +!> \param adjust logical which determines if the Becke potential is adjusted with atomic radii +!> \param atomic_charges logical which determines if atomic Becke charges should be computed +!> \param confine logical which determines if static confinement is active +!> \param dynamic_confine logical which determines if dynamic confinement is active +!> \param cavity_confine logical which determines if cavity confinement is active +!> \param should_skip logical which determines is grid points should be skipped if all constraint +!> atoms are found to reside beyond the cutoff distance from it +!> \param print_cavity logical to print the Gaussian confinement cavity +!> \param external_control logical which determines if the constraint has already been built +!> in a mixed_env that holds multiple CDFT states +!> \param first_iteration a flag to mark the first iteration for printing of additional data +!> \param fragment_density use isolated fragment densities as a reference for the constraint +!> \param fragments_integrated logical to determine if the fragment densities have been integrated +!> \param use_bohr decides whether to use angstrom or bohr units for the confinement cavity radius +!> \param coeff determines how to sum up the constraint atoms to form the value of the constraint +!> \param cutoffs element specific cutoffs +!> \param cutoffs_tmp same as cutoffs but a temporary read during parsing of this type +!> \param charges_fragment the values of the integrated isolated fragment densities +!> \param radii_tmp temporary list of element specific atomic radii used to adjust the Becke cells +!> \param radii permanent copy of radii_tmp +!> \param confine_dir for dynamic/mixed/static confinement determines the direction of confinement +!> \param confine_bounds_int grid point indices outside which the constraint vanishes along confine_dir +!> \param confine_bounds same as confine_bounds_int, but in distance units +!> \param dynamic_radius the radius parameter used for creating the dynamic confinement bounds +!> \param rcavity an optional global radius parameter used to define the Gaussian confinement cavity +!> \param eps_cavity threshold used screen small values of the Gaussian cavity density +!> \param cavity_env the structure used to build the Gaussian cavity +!> \param aij pairwise parameters used to adjust the Becke cell boundaries built from atomic radii +!> \param skip_list a list of grid points skipped my keyword should_skip +!> \param cavity_mat a compacted version of cavity +!> \param combined_mat a compated version of combined_weight +!> \param gradients atomic gradients of the weight function ! ************************************************************************************************** TYPE becke_restraint_type + CHARACTER(LEN=default_path_length) :: fragment_a_fname, & + fragment_b_fname INTEGER :: ref_count - REAL(KIND=dp) :: strength - REAL(KIND=dp) :: TARGET - REAL(KIND=dp) :: becke_order_p - INTEGER :: functional_form + REAL(KIND=dp) :: rglobal + REAL(KIND=dp), DIMENSION(:), POINTER :: TARGET, strength, & + becke_order_p INTEGER :: natoms + INTEGER :: confine_method, cavity_shape, cutoff_type, & + constraint_type, combined_type INTEGER, POINTER, DIMENSION(:) :: atoms - TYPE(pw_p_type) :: becke_pot - LOGICAL :: need_pot - REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff - INTEGER :: density_type + TYPE(pw_p_type) :: becke_pot, cavity, combined_weight + TYPE(pw_p_type), POINTER, & + DIMENSION(:) :: charge, fragments + LOGICAL :: need_pot, save_pot, in_memory, & + adjust, atomic_charges, confine, & + dynamic_confine, cavity_confine, & + should_skip, print_cavity, & + external_control, first_iteration, & + fragment_density, fragments_integrated, & + use_bohr + REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff, cutoffs, cutoffs_tmp, & + charges_fragment, radii_tmp, & + radii + INTEGER :: confine_dir, confine_bounds_int(2) + REAL(KIND=dp) :: confine_bounds(2), dynamic_radius, & + rcavity, eps_cavity + TYPE(hirshfeld_type), POINTER :: cavity_env + REAL(KIND=dp), POINTER, & + DIMENSION(:, :) :: aij + LOGICAL, POINTER, DIMENSION(:, :, :) :: skip_list + REAL(KIND=dp), POINTER, & + DIMENSION(:, :, :) :: cavity_mat, combined_mat + REAL(KIND=dp), POINTER, & + DIMENSION(:, :, :, :) :: gradients END TYPE becke_restraint_type +! ************************************************************************************************** +! \brief control parameters for hirshfeld constraint +!> \param hirshfeld_env holds the information needed to build the Gaussian Hirshfeld weight +!> \param natoms the number of constraint atoms +!> \param constraint_type the constraint type to use +!> \param combined_type for combined density+spin constraint, determines which atoms to apply the spin +!> constraint to +!> \param atoms list of constraint atoms +!> \param coeff determines how to sum up the constraint atoms to form the value of the constraint +! ************************************************************************************************** + TYPE hirshfeld_constraint_type + TYPE(hirshfeld_type), POINTER :: hirshfeld_env + INTEGER :: natoms, constraint_type, & + combined_type + INTEGER, POINTER, DIMENSION(:) :: atoms + REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff + END TYPE hirshfeld_constraint_type + +! ************************************************************************************************** +! \brief control parameters for CDFT with OT +! TODO: make cdft_control parent section for Becke restraint type +!> \param ref_count the ref count +!> \param total_steps counter to keep track of the total number of SCF steps +!> \param type type of CDFT constraint +!> \param precond_freq preconditioner can be used if SCF converged in less than precond_freq steps +!> \param nreused determines how many times the current OT preconditioner has been reused +!> \param max_reuse the same preconditioner can be used a maximum of max_reuse times +!> \param purge_freq determines how large nbad_conv can grow before purging the wfn/constraint history +!> \param nbad_conv a running counter keeping track of the number of CDFT SCF loops when the first +!> CDFT SCF iteration required more than 1 outer SCF loop. Reset when convergence is +!> smooth +!> \param purge_offset purging is only allowed when more than purge_offset steps have passed since +!> last purge +!> \param istep a counter to keep track of how many steps have passed since the last purge +!> \param constraint_type the constraint type to use +!> \param combined_type for combined density+spin constraint, determines which atoms to apply the spin +!> constraint to +!> \param constraints holds information about the CDFT SCF loop +!> \param constraint_control the outer_scf_control_type for the constraint +!> \param ot_control the outer_scf_control_type for OT where data is stashed when outside the OT +!> outer loop +!> \param hirshfeld_control control parameters for a Hirshfeld constraint +!> \param strength Lagrangian multipliers of the constraints +!> \param target target values of the constraints +!> \param value integrated values of the constraints +!> \param weight the constraint potential +!> \param need_pot logical which determines if the constraint potential needs to be built +!> \param save_pot logical which determines if the constraint potential should be saved until forces +!> have been evaluated +!> \param do_et logical which determines if a ET coupling calculation was requested +!> \param reuse_precond logical which determines if a preconditioner can be reused +!> \param purge_history logical which determines if the wfn/constraint history can be purged +!> \param should_purge logical which determines if purging should take place after this CDFT SCF loop +!> \param calculate_metric logical which determines is the ET coupling reliablity metric is computed +!> \param mo_coeff save the MO coeffs (for do_et) +!> \param wmat matrix representation of the weight (for do_et) +!> \param matrix_s save the overlap matrix (for do_et) +!> \param matrix_s save the density matrix (for calculate_metric) +! ************************************************************************************************** + ! Copied from qs_scf_types to avoid circular dependency + TYPE qs_outer_scf_type + INTEGER :: iter_count + REAL(KIND=dp), DIMENSION(:), POINTER :: energy + REAL(KIND=dp), DIMENSION(:, :), & + POINTER :: variables + REAL(KIND=dp), DIMENSION(:, :), & + POINTER :: gradient + INTEGER, DIMENSION(:), POINTER :: count + END TYPE qs_outer_scf_type + + ! Copied from scf_control_types to avoid circular dependency + TYPE outer_scf_control_type + LOGICAL :: have_scf + LOGICAL :: build_jacobian + INTEGER :: max_scf + REAL(KIND=dp) :: eps_scf, step_size, & + jacobian_step + INTEGER :: TYPE + INTEGER :: optimizer + INTEGER :: diis_buffer_length + INTEGER :: extrapolation_order + INTEGER :: bisect_trust_count + INTEGER :: jacobian_type + END TYPE outer_scf_control_type + + TYPE cdft_control_type + INTEGER :: ref_count, total_steps, TYPE, & + precond_freq, nreused, max_reuse, & + purge_freq, nbad_conv, purge_offset, & + istep, constraint_type, combined_type + TYPE(qs_outer_scf_type) :: constraint + TYPE(outer_scf_control_type) :: constraint_control, ot_control + TYPE(hirshfeld_constraint_type), & + POINTER :: hirshfeld_control + REAL(KIND=dp), DIMENSION(:), POINTER :: strength, TARGET, value + TYPE(pw_p_type) :: weight + LOGICAL :: need_pot, save_pot, do_et, & + reuse_precond, purge_history, & + should_purge, calculate_metric + TYPE(cp_fm_p_type), DIMENSION(:), & + POINTER :: mo_coeff + TYPE(dbcsr_p_type) :: wmat, matrix_s + TYPE(dbcsr_p_type), DIMENSION(:), & + POINTER :: matrix_p + END TYPE cdft_control_type + ! ************************************************************************************************** ! \brief some parameters useful for s2_restraints ! ************************************************************************************************** TYPE s2_restraint_type - INTEGER :: ref_count - REAL(KIND=dp) :: strength - REAL(KIND=dp) :: TARGET - REAL(KIND=dp) :: s2_order_p - INTEGER :: functional_form + INTEGER :: ref_count + REAL(KIND=dp) :: strength + REAL(KIND=dp) :: TARGET + REAL(KIND=dp) :: s2_order_p + INTEGER :: functional_form END TYPE s2_restraint_type ! ************************************************************************************************** ! \brief some parameters useful for auxiliary density matrix method ! ************************************************************************************************** TYPE admm_block_type - INTEGER, DIMENSION(:), ALLOCATABLE :: list + INTEGER, DIMENSION(:), ALLOCATABLE :: list END TYPE admm_block_type TYPE admm_control_type - REAL(KIND=dp) :: eps_filter - INTEGER :: purification_method - INTEGER :: method - LOGICAL :: charge_constrain - INTEGER :: scaling_model - INTEGER :: aux_exch_func - LOGICAL :: aux_exch_func_param - REAL(KIND=dp), DIMENSION(3) :: aux_x_param + REAL(KIND=dp) :: eps_filter + INTEGER :: purification_method + INTEGER :: method + LOGICAL :: charge_constrain + INTEGER :: scaling_model + INTEGER :: aux_exch_func + LOGICAL :: aux_exch_func_param + REAL(KIND=dp), DIMENSION(3) :: aux_x_param TYPE(admm_block_type), DIMENSION(:), & - ALLOCATABLE :: blocks + ALLOCATABLE :: blocks END TYPE admm_control_type ! ************************************************************************************************** @@ -260,78 +456,82 @@ MODULE cp_control_types ! Gaussian-type functions (primitive basis functions). ! ************************************************************************************************** TYPE qs_control_type - CHARACTER(LEN=10) :: method - INTEGER :: method_id - REAL(KIND=dp) :: eps_core_charge, & - eps_kg_orb, & - eps_pgf_orb, & - eps_ppl, & - eps_ppnl, & - eps_rho_gspace, & - eps_rho_rspace, & - eps_filter_matrix, & - eps_gvg_rspace, & - progression_factor, & - relative_cutoff - LOGICAL :: do_almo_scf - LOGICAL :: do_ls_scf - LOGICAL :: do_kg - LOGICAL :: commensurate_mgrids - LOGICAL :: realspace_mgrids - LOGICAL :: map_consistent - LOGICAL :: gapw, gapw_xc, gpw, pao - LOGICAL :: lrigpw - LOGICAL :: lri_optbas - LOGICAL :: ofgpw - LOGICAL :: dftb - LOGICAL :: scptb - LOGICAL :: semi_empirical - LOGICAL :: mulliken_restraint - LOGICAL :: ddapc_restraint - LOGICAL :: ddapc_restraint_is_spin - LOGICAL :: ddapc_explicit_potential - LOGICAL :: becke_restraint - LOGICAL :: et_coupling_calc - LOGICAL :: s2_restraint - INTEGER :: do_ppl_method - INTEGER :: wf_interpolation_method_nr - INTEGER :: wf_extrapolation_order - REAL(KIND=dp) :: cutoff - REAL(KIND=dp), DIMENSION(:), POINTER :: e_cutoff - TYPE(mulliken_restraint_type), POINTER :: mulliken_restraint_control - TYPE(ddapc_restraint_p_type), DIMENSION(:), & - POINTER :: ddapc_restraint_control - TYPE(becke_restraint_type), POINTER :: becke_control - TYPE(s2_restraint_type), POINTER :: s2_restraint_control - TYPE(dftb_control_type), POINTER :: dftb_control - TYPE(scptb_control_type), POINTER :: scptb_control - TYPE(semi_empirical_control_type), POINTER :: se_control - TYPE(gapw_control_type), POINTER :: gapw_control - TYPE(pw_grid_option) :: pw_grid_opt - LOGICAL :: skip_load_balance_distributed + CHARACTER(LEN=10) :: method + INTEGER :: method_id + REAL(KIND=dp) :: eps_core_charge, & + eps_kg_orb, & + eps_pgf_orb, & + eps_ppl, & + eps_ppnl, & + eps_rho_gspace, & + eps_rho_rspace, & + eps_filter_matrix, & + eps_gvg_rspace, & + progression_factor, & + relative_cutoff + LOGICAL :: do_almo_scf + LOGICAL :: do_ls_scf + LOGICAL :: do_kg + LOGICAL :: commensurate_mgrids + LOGICAL :: realspace_mgrids + LOGICAL :: map_consistent + LOGICAL :: gapw, gapw_xc, gpw, pao + LOGICAL :: lrigpw + LOGICAL :: lri_optbas + LOGICAL :: ofgpw + LOGICAL :: dftb + LOGICAL :: scptb + LOGICAL :: semi_empirical + LOGICAL :: mulliken_restraint + LOGICAL :: ddapc_restraint + LOGICAL :: ddapc_restraint_is_spin + LOGICAL :: ddapc_explicit_potential + LOGICAL :: becke_restraint + LOGICAL :: cdft + LOGICAL :: et_coupling_calc + LOGICAL :: s2_restraint + INTEGER :: do_ppl_method + INTEGER :: wf_interpolation_method_nr + INTEGER :: wf_extrapolation_order + REAL(KIND=dp) :: cutoff + REAL(KIND=dp), DIMENSION(:), POINTER :: e_cutoff + TYPE(mulliken_restraint_type), & + POINTER :: mulliken_restraint_control + TYPE(ddapc_restraint_p_type), & + DIMENSION(:), POINTER :: ddapc_restraint_control + TYPE(becke_restraint_type), POINTER :: becke_control + TYPE(cdft_control_type), POINTER :: cdft_control + TYPE(s2_restraint_type), POINTER :: s2_restraint_control + TYPE(dftb_control_type), POINTER :: dftb_control + TYPE(scptb_control_type), POINTER :: scptb_control + TYPE(semi_empirical_control_type), & + POINTER :: se_control + TYPE(gapw_control_type), POINTER :: gapw_control + TYPE(pw_grid_option) :: pw_grid_opt + LOGICAL :: skip_load_balance_distributed END TYPE qs_control_type ! ************************************************************************************************** ! \brief Control parameters for the SCCS models ! ************************************************************************************************** TYPE sccs_control_type - LOGICAL :: sccs_activated - INTEGER :: derivative_method, & - max_iter, & - method_id, & - ref_count - REAL(KIND=dp) :: alpha_solvent, & - beta, & - beta_solvent, & - delta_rho, & - eps_sccs, & - eps_scf, & - epsilon_solvent, & - gamma_solvent, & - mixing, & - rho_zero, & - rho_max, & - rho_min + LOGICAL :: sccs_activated + INTEGER :: derivative_method, & + max_iter, & + method_id, & + ref_count + REAL(KIND=dp) :: alpha_solvent, & + beta, & + beta_solvent, & + delta_rho, & + eps_sccs, & + eps_scf, & + epsilon_solvent, & + gamma_solvent, & + mixing, & + rho_zero, & + rho_max, & + rho_min END TYPE sccs_control_type ! ************************************************************************************************** @@ -350,25 +550,27 @@ MODULE cp_control_types ! TDDFPT operator without the perturbation kernel. ! ************************************************************************************************** TYPE tddfpt_control_type - TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: lumos - REAL(KIND=dp) :: tolerance - INTEGER :: n_ev - INTEGER :: max_kv - INTEGER :: n_restarts - INTEGER :: n_reortho - LOGICAL :: do_kernel - LOGICAL :: lsd_singlets - LOGICAL :: invert_S - LOGICAL :: precond - LOGICAL :: drho_by_collocation - LOGICAL :: use_kinetic_energy_density - INTEGER :: res_etype - INTEGER :: diag_method - INTEGER :: oe_corr - INTEGER :: sic_method_id - INTEGER :: sic_list_id - REAL(KIND=dp) :: sic_scaling_a, sic_scaling_b - REAL(KIND=dp), DIMENSION(:, :), POINTER :: lumos_eigenvalues + TYPE(cp_fm_p_type), DIMENSION(:), & + POINTER :: lumos + REAL(KIND=dp) :: tolerance + INTEGER :: n_ev + INTEGER :: max_kv + INTEGER :: n_restarts + INTEGER :: n_reortho + LOGICAL :: do_kernel + LOGICAL :: lsd_singlets + LOGICAL :: invert_S + LOGICAL :: precond + LOGICAL :: drho_by_collocation + LOGICAL :: use_kinetic_energy_density + INTEGER :: res_etype + INTEGER :: diag_method + INTEGER :: oe_corr + INTEGER :: sic_method_id + INTEGER :: sic_list_id + REAL(KIND=dp) :: sic_scaling_a, sic_scaling_b + REAL(KIND=dp), DIMENSION(:, :), & + POINTER :: lumos_eigenvalues END TYPE tddfpt_control_type ! ************************************************************************************************** @@ -376,121 +578,122 @@ MODULE cp_control_types ! ************************************************************************************************** TYPE tddfpt2_control_type !> compute TDDFPT excitation energies and oscillator strengths - LOGICAL :: enabled + LOGICAL :: enabled !> number of excited states to converge - INTEGER :: nstates + INTEGER :: nstates !> number of additional excited states in the active space - INTEGER :: added_states + INTEGER :: added_states !> maximal number of iterations to be performed - INTEGER :: niters + INTEGER :: niters !> maximal number of Krylov space vectors - INTEGER :: nkvs + INTEGER :: nkvs !> minimal number of MPI processes to be used per excited state - INTEGER :: nprocs + INTEGER :: nprocs !> maximal number of orthogonalisation iterations - INTEGER :: nreortho + INTEGER :: nreortho !> target accuracy - REAL(kind=dp) :: conv + REAL(kind=dp) :: conv !> energy threshold which controls when excited states are considered to be degenerate - REAL(kind=dp) :: degenerate_eps + REAL(kind=dp) :: degenerate_eps !> the smallest excitation amplitude to print - REAL(kind=dp) :: min_excitation_amplitude + REAL(kind=dp) :: min_excitation_amplitude !> threshold which controls when two wave functions considered to be orthogonal: !> maxabs(Ci^T * S * Cj) <= orthogonal_eps - REAL(kind=dp) :: orthogonal_eps + REAL(kind=dp) :: orthogonal_eps !> should all degenerate excited states be automatically added to the active space - LOGICAL :: add_degenerate + LOGICAL :: add_degenerate !> read guess wave functions from restart file if exists - LOGICAL :: is_restart + LOGICAL :: is_restart !> compute triplet excited states using spin-unpolarised molecular orbitals - LOGICAL :: rks_triplets + LOGICAL :: rks_triplets ! ! DIPOLE_MOMENTS subsection ! ! form of the dipole operator used to compute oscillator strengths - INTEGER :: dipole_form + INTEGER :: dipole_form !> type of the reference point used for calculation of electrostatic dipole moments - INTEGER :: dipole_reference + INTEGER :: dipole_reference !> user-defined reference point - REAL(kind=dp), DIMENSION(:), POINTER :: dipole_ref_point + REAL(kind=dp), DIMENSION(:), POINTER :: dipole_ref_point ! ! MGRID subsection ! !> number of plain-wave grids - INTEGER :: mgrid_ngrids + INTEGER :: mgrid_ngrids !> create commensurate grids (progression factor and cutoff values of sub-grids will be ignored) - LOGICAL :: mgrid_commensurate_mgrids + LOGICAL :: mgrid_commensurate_mgrids !> signals that MGRID section has been explicitly given. Other mgrid_* variables !> are not initialised when it is equal to .FALSE. as in this case the default !> set of plain-wave grids will be used - LOGICAL :: mgrid_is_explicit + LOGICAL :: mgrid_is_explicit !> same as qs_control%realspace_mgrids - LOGICAL :: mgrid_realspace_mgrids + LOGICAL :: mgrid_realspace_mgrids !> do not perform load balancing - LOGICAL :: mgrid_skip_load_balance + LOGICAL :: mgrid_skip_load_balance !> cutoff value at the finest grid level - REAL(kind=dp) :: mgrid_cutoff + REAL(kind=dp) :: mgrid_cutoff !> cutoff at the next grid level will be smaller then the cutoff !> at the current grid by this number of times - REAL(kind=dp) :: mgrid_progression_factor + REAL(kind=dp) :: mgrid_progression_factor !> cutoff that determines to which grid a particular Gaussian function will be mapped - REAL(kind=dp) :: mgrid_relative_cutoff + REAL(kind=dp) :: mgrid_relative_cutoff !> manually provided the list of cutoff values for each grid level !> (when it is null(), the cutoff values will be assigned automatically) - REAL(kind=dp), DIMENSION(:), POINTER :: mgrid_e_cutoff + REAL(kind=dp), DIMENSION(:), POINTER :: mgrid_e_cutoff END TYPE tddfpt2_control_type ! ************************************************************************************************** ! \brief Control parameters for a DFT calculation ! ************************************************************************************************** TYPE dft_control_type - TYPE(admm_control_type), POINTER :: admm_control - TYPE(period_efield_type), POINTER :: period_efield - TYPE(qs_control_type), POINTER :: qs_control - TYPE(rtp_control_type), POINTER :: rtp_control - TYPE(sccs_control_type), POINTER :: sccs_control - TYPE(tddfpt_control_type), POINTER :: tddfpt_control - TYPE(tddfpt2_control_type), POINTER :: tddfpt2_control - TYPE(xas_control_type), POINTER :: xas_control - TYPE(efield_p_type), POINTER, DIMENSION(:) :: efield_fields - INTEGER :: nspins, & - charge, & - multiplicity, & - sic_method_id, & - ref_count, & - id_nr, & - plus_u_method_id, & - dir_surf_dip, & - nimages = 1 - INTEGER :: sic_list_id - REAL(KIND=dp) :: relax_multiplicity, & - sic_scaling_a, & - sic_scaling_b - LOGICAL :: do_tddfpt_calculation, & - do_xas_calculation, & - drho_by_collocation, & - use_kinetic_energy_density, & - restricted, & - roks, & - uks, & - lsd, & - dft_plus_u, & - apply_efield, & - apply_efield_field, & - apply_period_efield, & - apply_external_potential, & - eval_external_potential, & - do_admm, & - do_admm_dm, & - do_admm_mo, & - smear, & - low_spin_roks, & - apply_external_density, & - read_external_density, & - apply_external_vxc, & - read_external_vxc, & - correct_surf_dip, & - do_sccs + TYPE(admm_control_type), POINTER :: admm_control + TYPE(period_efield_type), POINTER :: period_efield + TYPE(qs_control_type), POINTER :: qs_control + TYPE(rtp_control_type), POINTER :: rtp_control + TYPE(sccs_control_type), POINTER :: sccs_control + TYPE(tddfpt_control_type), POINTER :: tddfpt_control + TYPE(tddfpt2_control_type), POINTER :: tddfpt2_control + TYPE(xas_control_type), POINTER :: xas_control + TYPE(efield_p_type), POINTER, & + DIMENSION(:) :: efield_fields + INTEGER :: nspins, & + charge, & + multiplicity, & + sic_method_id, & + ref_count, & + id_nr, & + plus_u_method_id, & + dir_surf_dip, & + nimages = 1 + INTEGER :: sic_list_id + REAL(KIND=dp) :: relax_multiplicity, & + sic_scaling_a, & + sic_scaling_b + LOGICAL :: do_tddfpt_calculation, & + do_xas_calculation, & + drho_by_collocation, & + use_kinetic_energy_density, & + restricted, & + roks, & + uks, & + lsd, & + dft_plus_u, & + apply_efield, & + apply_efield_field, & + apply_period_efield, & + apply_external_potential, & + eval_external_potential, & + do_admm, & + do_admm_dm, & + do_admm_mo, & + smear, & + low_spin_roks, & + apply_external_density, & + read_external_density, & + apply_external_vxc, & + read_external_vxc, & + correct_surf_dip, & + do_sccs END TYPE dft_control_type CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_control_types' @@ -513,7 +716,8 @@ MODULE cp_control_types s2_restraint_type, & admm_control_type, & rtp_control_type, & - sccs_control_type + sccs_control_type, & + cdft_control_type ! Public subroutines @@ -523,7 +727,9 @@ MODULE cp_control_types tddfpt_control_create, & admm_control_create, & ddapc_control_create, & - sccs_control_create + sccs_control_create, & + becke_control_create, & + becke_control_release CONTAINS @@ -666,7 +872,7 @@ CONTAINS ! ************************************************************************************************** !> \brief create the becke_restraint_type -!> \param becke_control ... +!> \param becke_control the structure to create !> \par History !> 02.2007 created [Florian Schiffmann] ! ************************************************************************************************** @@ -680,20 +886,57 @@ CONTAINS ALLOCATE (becke_control) becke_control%ref_count = 1 - becke_control%density_type = do_full_density - becke_control%strength = 0.1_dp - becke_control%becke_order_p = 0.0_dp - becke_control%functional_form = -1 - becke_control%target = 1.0_dp becke_control%natoms = 0 becke_control%need_pot = .TRUE. + becke_control%save_pot = .FALSE. + becke_control%adjust = .FALSE. + becke_control%atomic_charges = .FALSE. + becke_control%confine_method = becke_none_conf + becke_control%cutoff_type = becke_cutoff_global + becke_control%confine = .FALSE. + becke_control%dynamic_confine = .FALSE. + becke_control%cavity_confine = .FALSE. + becke_control%should_skip = .FALSE. + becke_control%print_cavity = .FALSE. + becke_control%in_memory = .FALSE. + becke_control%first_iteration = .TRUE. + becke_control%fragment_density = .FALSE. + becke_control%fragments_integrated = .FALSE. + becke_control%use_bohr = .FALSE. + becke_control%confine_dir = 3 + becke_control%confine_bounds = 0.0_dp + becke_control%confine_bounds_int = 0 + becke_control%dynamic_radius = 6.0_dp + becke_control%rcavity = 3.0_dp + becke_control%rglobal = 6.0_dp + becke_control%eps_cavity = 1.0e-5_dp + becke_control%cavity_shape = radius_single + becke_control%external_control = .FALSE. + becke_control%constraint_type = cdft_density_constraint + becke_control%combined_type = cdft_combined_all + NULLIFY (becke_control%strength) + NULLIFY (becke_control%target) + NULLIFY (becke_control%becke_order_p) NULLIFY (becke_control%atoms) NULLIFY (becke_control%coeff) + NULLIFY (becke_control%charge) + NULLIFY (becke_control%aij) + NULLIFY (becke_control%gradients) + NULLIFY (becke_control%cavity_mat) + NULLIFY (becke_control%combined_mat) + NULLIFY (becke_control%cavity_env) + NULLIFY (becke_control%skip_list) + NULLIFY (becke_control%cutoffs) + NULLIFY (becke_control%cutoffs_tmp) + NULLIFY (becke_control%charges_fragment) + NULLIFY (becke_control%fragments) + NULLIFY (becke_control%radii) + NULLIFY (becke_control%radii_tmp) END SUBROUTINE becke_control_create ! ************************************************************************************************** !> \brief release the becke_restraint_type -!> \param becke_control ... +!> \param becke_control the structure to release !> \par History !> 02.2007 created [Florian Schiffmann] ! ************************************************************************************************** @@ -709,11 +952,41 @@ CONTAINS IF (becke_control%ref_count == 0) THEN IF (ASSOCIATED(becke_control%atoms)) & DEALLOCATE (becke_control%atoms) + IF (ASSOCIATED(becke_control%cutoffs)) & + DEALLOCATE (becke_control%cutoffs) + IF (ASSOCIATED(becke_control%cutoffs_tmp)) & + DEALLOCATE (becke_control%cutoffs_tmp) + IF (ASSOCIATED(becke_control%radii_tmp)) & + DEALLOCATE (becke_control%radii_tmp) + IF (ASSOCIATED(becke_control%radii)) & + DEALLOCATE (becke_control%radii) + IF (ASSOCIATED(becke_control%charges_fragment)) & + DEALLOCATE (becke_control%charges_fragment) + IF (ASSOCIATED(becke_control%fragments)) & + DEALLOCATE (becke_control%fragments) IF (ASSOCIATED(becke_control%coeff)) & DEALLOCATE (becke_control%coeff) + IF (ASSOCIATED(becke_control%charge)) & + DEALLOCATE (becke_control%charge) + IF (ASSOCIATED(becke_control%aij)) & + DEALLOCATE (becke_control%aij) + IF (ASSOCIATED(becke_control%gradients)) & + DEALLOCATE (becke_control%gradients) + IF (ASSOCIATED(becke_control%cavity_mat)) & + DEALLOCATE (becke_control%cavity_mat) + IF (ASSOCIATED(becke_control%skip_list)) & + DEALLOCATE (becke_control%skip_list) + IF (ASSOCIATED(becke_control%target)) & + DEALLOCATE (becke_control%target) + IF (ASSOCIATED(becke_control%strength)) & + DEALLOCATE (becke_control%strength) + IF (ASSOCIATED(becke_control%becke_order_p)) & + DEALLOCATE (becke_control%becke_order_p) + IF (ASSOCIATED(becke_control%combined_mat)) & + DEALLOCATE (becke_control%combined_mat) + IF (becke_control%cavity_confine) & + CALL release_hirshfeld_type(becke_control%cavity_env) becke_control%ref_count = 0 - becke_control%strength = 0.0_dp - becke_control%target = 0.0_dp becke_control%natoms = 0 DEALLOCATE (becke_control) ENDIF @@ -721,7 +994,7 @@ CONTAINS ! ************************************************************************************************** !> \brief retain the becke_restraint_type -!> \param becke_control ... +!> \param becke_control the structure to retain !> \par History !> 02.2007 created [Florian Schiffmann] ! ************************************************************************************************** @@ -734,6 +1007,134 @@ CONTAINS CPASSERT(ASSOCIATED(becke_control)) becke_control%ref_count = becke_control%ref_count+1 END SUBROUTINE becke_control_retain +! ***************************************************************************** +!> \brief create the cdft_control_type +!> \param cdft_control the structure to create +!> \par History +!> 12.2015 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE cdft_control_create(cdft_control) + TYPE(cdft_control_type), POINTER :: cdft_control + + CHARACTER(len=*), PARAMETER :: routineN = 'cdft_control_create', & + routineP = moduleN//':'//routineN + + CPASSERT(.NOT. ASSOCIATED(cdft_control)) + ALLOCATE (cdft_control) + cdft_control%ref_count = 1 + cdft_control%total_steps = 0 + NULLIFY (cdft_control%strength) + NULLIFY (cdft_control%target) + NULLIFY (cdft_control%value) + cdft_control%type = outer_scf_none + cdft_control%need_pot = .TRUE. + cdft_control%save_pot = .FALSE. + cdft_control%do_et = .FALSE. + cdft_control%reuse_precond = .FALSE. + cdft_control%nreused = 0 + cdft_control%precond_freq = 0 + cdft_control%max_reuse = 0 + cdft_control%should_purge = .FALSE. + cdft_control%purge_history = .FALSE. + cdft_control%calculate_metric = .FALSE. + cdft_control%purge_freq = 0 + cdft_control%nbad_conv = 0 + cdft_control%purge_offset = 0 + cdft_control%istep = 0 + cdft_control%constraint_type = cdft_density_constraint + cdft_control%combined_type = cdft_combined_all + NULLIFY (cdft_control%hirshfeld_control) + NULLIFY (cdft_control%weight%pw) + NULLIFY (cdft_control%wmat%matrix) + NULLIFY (cdft_control%matrix_s%matrix) + NULLIFY (cdft_control%mo_coeff) + NULLIFY (cdft_control%matrix_p) + ! Outer SCF default settings + cdft_control%ot_control%have_scf = .FALSE. + cdft_control%ot_control%max_scf = 0 + cdft_control%ot_control%eps_scf = 0.0_dp + cdft_control%ot_control%step_size = 0.0_dp + cdft_control%ot_control%type = -1 + cdft_control%ot_control%optimizer = -1 + cdft_control%ot_control%diis_buffer_length = -1 + cdft_control%ot_control%jacobian_type = -1 + cdft_control%ot_control%jacobian_step = 0.0_dp + cdft_control%constraint_control%have_scf = .FALSE. + cdft_control%constraint_control%max_scf = 0 + cdft_control%constraint_control%eps_scf = 0.0_dp + cdft_control%constraint_control%step_size = 0.0_dp + cdft_control%constraint_control%type = -1 + cdft_control%constraint_control%optimizer = -1 + cdft_control%constraint_control%diis_buffer_length = -1 + cdft_control%constraint_control%jacobian_type = -1 + cdft_control%constraint_control%jacobian_step = 0.0_dp + cdft_control%constraint%iter_count = 0 + NULLIFY (cdft_control%constraint%variables) + NULLIFY (cdft_control%constraint%gradient) + NULLIFY (cdft_control%constraint%energy) + NULLIFY (cdft_control%constraint%count) + END SUBROUTINE cdft_control_create + +! ***************************************************************************** +!> \brief release the cdft_control_type +!> \param cdft_control the structure to release +!> \par History +!> 12.2015 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE cdft_control_release(cdft_control) + TYPE(cdft_control_type), POINTER :: cdft_control + + CHARACTER(len=*), PARAMETER :: routineN = 'cdft_control_release', & + routineP = moduleN//':'//routineN + + CPASSERT(ASSOCIATED(cdft_control)) + CPASSERT(cdft_control%ref_count > 0) + cdft_control%ref_count = cdft_control%ref_count-1 + IF (cdft_control%ref_count == 0) THEN + IF (ASSOCIATED(cdft_control%strength)) & + DEALLOCATE (cdft_control%strength) + IF (ASSOCIATED(cdft_control%target)) & + DEALLOCATE (cdft_control%target) + IF (ASSOCIATED(cdft_control%value)) & + DEALLOCATE (cdft_control%value) + cdft_control%type = outer_scf_none + NULLIFY (cdft_control%weight%pw) + IF (ASSOCIATED(cdft_control%hirshfeld_control)) THEN + CALL release_hirshfeld_type(cdft_control%hirshfeld_control%hirshfeld_env) + cdft_control%hirshfeld_control%natoms = 0 + IF (ASSOCIATED(cdft_control%hirshfeld_control%atoms)) & + DEALLOCATE (cdft_control%hirshfeld_control%atoms) + IF (ASSOCIATED(cdft_control%hirshfeld_control%coeff)) & + DEALLOCATE (cdft_control%hirshfeld_control%coeff) + DEALLOCATE (cdft_control%hirshfeld_control) + END IF + IF (ASSOCIATED(cdft_control%constraint%variables)) & + DEALLOCATE (cdft_control%constraint%variables) + IF (ASSOCIATED(cdft_control%constraint%count)) & + DEALLOCATE (cdft_control%constraint%count) + IF (ASSOCIATED(cdft_control%constraint%gradient)) & + DEALLOCATE (cdft_control%constraint%gradient) + IF (ASSOCIATED(cdft_control%constraint%energy)) & + DEALLOCATE (cdft_control%constraint%energy) + DEALLOCATE (cdft_control) + END IF + END SUBROUTINE cdft_control_release + +! ***************************************************************************** +!> \brief retain the cdft_control_type +!> \param cdft_control the structure to retain +!> \par History +!> created 12.2015 [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE cdft_control_retain(cdft_control) + TYPE(cdft_control_type), POINTER :: cdft_control + + CHARACTER(len=*), PARAMETER :: routineN = 'cdft_control_retain', & + routineP = moduleN//':'//routineN + + CPASSERT(ASSOCIATED(cdft_control)) + cdft_control%ref_count = cdft_control%ref_count+1 + END SUBROUTINE cdft_control_retain ! ************************************************************************************************** !> \brief create the s2_restraint_type @@ -918,6 +1319,7 @@ CONTAINS NULLIFY (qs_control%dftb_control) NULLIFY (qs_control%scptb_control) NULLIFY (qs_control%becke_control) + NULLIFY (qs_control%cdft_control) NULLIFY (qs_control%ddapc_restraint_control) CALL mulliken_control_create(qs_control%mulliken_restraint_control) @@ -927,6 +1329,7 @@ CONTAINS CALL se_control_create(qs_control%se_control) CALL dftb_control_create(qs_control%dftb_control) CALL scptb_control_create(qs_control%scptb_control) + CALL cdft_control_create(qs_control%cdft_control) END SUBROUTINE qs_control_create ! ************************************************************************************************** @@ -948,6 +1351,7 @@ CONTAINS CALL dftb_control_release(qs_control%dftb_control) CALL scptb_control_release(qs_control%scptb_control) CALL becke_control_release(qs_control%becke_control) + CALL cdft_control_release(qs_control%cdft_control) IF (ASSOCIATED(qs_control%e_cutoff)) THEN DEALLOCATE (qs_control%e_cutoff) diff --git a/src/cp_control_utils.F b/src/cp_control_utils.F index b33a05ede0..d7a405023d 100644 --- a/src/cp_control_utils.F +++ b/src/cp_control_utils.F @@ -8,10 +8,10 @@ ! ************************************************************************************************** MODULE cp_control_utils USE bibliography, ONLY: & - Andreussi2012, Dewar1977, Dewar1985, Elstner1998, Fattebert2002, Hu2007, Krack2000, & - Lippert1997, Lippert1999, Porezag1995, Repasky2002, Rocha2006, Schenter2008, Seifert1996, & - Souza2002, Stengel2009, Stewart1989, Stewart2007, Thiel1992, Umari2002, VandeVondele2005a, & - VandeVondele2005b, Zhechkov2005, cite_reference + Andreussi2012, Becke1988b, Dewar1977, Dewar1985, Elstner1998, Fattebert2002, Holmberg2017, & + Hu2007, Krack2000, Lippert1997, Lippert1999, Porezag1995, Repasky2002, Rocha2006, & + Schenter2008, Seifert1996, Souza2002, Stengel2009, Stewart1989, Stewart2007, Thiel1992, & + Umari2002, VandeVondele2005a, VandeVondele2005b, Zhechkov2005, cite_reference USE cp_control_types, ONLY: & admm_control_create, admm_control_type, ddapc_control_create, ddapc_restraint_type, & dft_control_create, dft_control_type, efield_type, qs_control_type, sccs_control_create, & @@ -24,21 +24,28 @@ MODULE cp_control_utils cp_print_key_unit_nr USE cp_units, ONLY: cp_unit_from_cp2k,& cp_unit_to_cp2k + USE hirshfeld_types, ONLY: create_hirshfeld_type,& + set_hirshfeld_info USE input_constants, ONLY: & - constant_env, custom_env, do_admm_basis_projection, do_admm_blocked_projection, & - do_admm_blocking_purify_full, do_admm_charge_constrained_projection, & - do_admm_exch_scaling_merlot, do_admm_purify_mcweeny, do_admm_purify_mo_diag, & - do_admm_purify_mo_no_diag, do_admm_purify_none, do_admm_purify_none_dm, & - do_ddapc_constraint, do_ddapc_restraint, do_method_am1, do_method_dftb, do_method_gapw, & - do_method_gapw_xc, do_method_gpw, do_method_lrigpw, do_method_mndo, do_method_mndod, & - do_method_ofgpw, do_method_pdg, do_method_pm3, do_method_pm6, do_method_pnnl, & - do_method_rm1, do_method_scptb, do_pwgrid_ns_fullspace, do_pwgrid_ns_halfspace, & - do_pwgrid_spherical, do_s2_constraint, do_s2_restraint, do_se_is_kdso, do_se_is_kdso_d, & - do_se_is_slater, do_se_lr_ewald, do_se_lr_ewald_gks, do_se_lr_ewald_r3, do_se_lr_none, & - gaussian_env, numerical, ramp_env, real_time_propagation, sccs_andreussi, & - sccs_derivative_cd3, sccs_derivative_cd5, sccs_derivative_cd7, sccs_derivative_fft, & - sccs_fattebert_gygi, sic_ad, sic_eo, sic_list_all, sic_list_unpaired, sic_mauri_spz, & - sic_mauri_us, sic_none, slater, tddfpt_excitations, use_mom_ref_user, xas_dip_len + becke_cavity_conf, becke_cutoff_element, becke_cutoff_global, becke_dynamic_conf, & + becke_mixed_conf, becke_none_conf, becke_static_conf, cdft_combined_constraint, & + cdft_density_constraint, cdft_magnetization_constraint, constant_env, custom_env, & + do_admm_basis_projection, do_admm_blocked_projection, do_admm_blocking_purify_full, & + do_admm_charge_constrained_projection, do_admm_exch_scaling_merlot, & + do_admm_purify_mcweeny, do_admm_purify_mo_diag, do_admm_purify_mo_no_diag, & + do_admm_purify_none, do_admm_purify_none_dm, do_ddapc_constraint, do_ddapc_restraint, & + do_method_am1, do_method_dftb, do_method_gapw, do_method_gapw_xc, do_method_gpw, & + do_method_lrigpw, do_method_mndo, do_method_mndod, do_method_ofgpw, do_method_pdg, & + do_method_pm3, do_method_pm6, do_method_pnnl, do_method_rm1, do_method_scptb, & + do_pwgrid_ns_fullspace, do_pwgrid_ns_halfspace, do_pwgrid_spherical, do_s2_constraint, & + do_s2_restraint, do_se_is_kdso, do_se_is_kdso_d, do_se_is_slater, do_se_lr_ewald, & + do_se_lr_ewald_gks, do_se_lr_ewald_r3, do_se_lr_none, gaussian_env, numerical, & + outer_scf_becke_constraint, outer_scf_cdft_constraint, outer_scf_hirshfeld_constraint, & + outer_scf_none, radius_covalent, radius_user, ramp_env, real_time_propagation, & + sccs_andreussi, sccs_derivative_cd3, sccs_derivative_cd5, sccs_derivative_cd7, & + sccs_derivative_fft, sccs_fattebert_gygi, shape_function_gaussian, sic_ad, sic_eo, & + sic_list_all, sic_list_unpaired, sic_mauri_spz, sic_mauri_us, sic_none, slater, & + tddfpt_excitations, use_mom_ref_user, xas_dip_len USE input_cp2k_dft, ONLY: create_dft_section,& create_qs_section USE input_enumeration_types, ONLY: enum_i2c,& @@ -557,14 +564,16 @@ CONTAINS TYPE(enumeration_type), POINTER :: enum TYPE(keyword_type), POINTER :: keyword TYPE(section_type), POINTER :: section - TYPE(section_vals_type), POINTER :: becke_restraint_section, ddapc_restraint_section, & - dftb_parameter, dftb_section, lri_optbas_section, mull_section, s2_restraint_section, & - scptb_section, se_section + TYPE(section_vals_type), POINTER :: becke_restraint_section, cdft_control_section, & + ddapc_restraint_section, dftb_parameter, dftb_section, lri_optbas_section, mull_section, & + s2_restraint_section, scptb_section, se_section CALL timeset(routineN, handle) was_present = .FALSE. - NULLIFY (mull_section, se_section, dftb_section, scptb_section, lri_optbas_section) + NULLIFY (mull_section, ddapc_restraint_section, s2_restraint_section, becke_restraint_section, & + se_section, dftb_section, dftb_parameter, scptb_section, lri_optbas_section, & + cdft_control_section) mull_section => section_vals_get_subs_vals(qs_section, "MULLIKEN_RESTRAINT") ddapc_restraint_section => section_vals_get_subs_vals(qs_section, "DDAPC_RESTRAINT") @@ -575,6 +584,7 @@ CONTAINS dftb_parameter => section_vals_get_subs_vals(dftb_section, "PARAMETER") scptb_section => section_vals_get_subs_vals(qs_section, "SCPTB") lri_optbas_section => section_vals_get_subs_vals(qs_section, "OPTIMIZE_LRI_BASIS") + cdft_control_section => section_vals_get_subs_vals(qs_section, "CDFT") ! Setup all defaults values and overwrite input parameters ! EPS_DEFAULT should set the target accuracy in the total energy (~per electron) or a closely related value @@ -809,6 +819,11 @@ CONTAINS CALL read_becke_section(qs_control, becke_restraint_section) ENDIF + CALL section_vals_get(cdft_control_section, explicit=qs_control%cdft) + IF (qs_control%cdft) THEN + CALL read_cdft_control_section(qs_control, cdft_control_section) + ENDIF + ! Semi-empirical code IF (qs_control%semi_empirical) THEN CALL section_vals_val_get(se_section, "ORTHOGONAL_BASIS", & @@ -1697,8 +1712,8 @@ CONTAINS ! ************************************************************************************************** !> \brief reads the input parameters needed for evaluating a becke weight population constraint -!> \param qs_control ... -!> \param becke_section ... +!> \param qs_control the qs_control which holds the Becke control type +!> \param becke_section the input section containing Becke constraint information !> \author fschiff ! ************************************************************************************************** SUBROUTINE read_becke_section(qs_control, becke_section) @@ -1709,16 +1724,97 @@ CONTAINS CHARACTER(len=*), PARAMETER :: routineN = 'read_becke_section', & routineP = moduleN//':'//routineN - INTEGER :: j, jj, k, n_rep + INTEGER :: j, jj, k, n_rep, nvar INTEGER, DIMENSION(:), POINTER :: tmplist + LOGICAL :: exists REAL(KIND=dp), DIMENSION(:), POINTER :: rtmplist - CALL section_vals_val_get(becke_section, "STRENGTH", & - r_val=qs_control%becke_control%strength) - CALL section_vals_val_get(becke_section, "TARGET", & - r_val=qs_control%becke_control%target) - CALL section_vals_val_get(becke_section, "TYPE_OF_DENSITY", & - i_val=qs_control%becke_control%density_type) + NULLIFY (tmplist, rtmplist) + CALL section_vals_val_get(becke_section, "CONSTRAINT_TYPE", & + i_val=qs_control%becke_control%constraint_type) + + SELECT CASE (qs_control%becke_control%constraint_type) + CASE (cdft_density_constraint, cdft_magnetization_constraint) + nvar = 1 + CASE (cdft_combined_constraint) + nvar = 2 + CALL section_vals_val_get(becke_section, "COMBINED_TYPE", & + i_val=qs_control%becke_control%combined_type) + END SELECT + + ALLOCATE (qs_control%becke_control%strength(nvar)) + ALLOCATE (qs_control%becke_control%becke_order_p(nvar)) + ALLOCATE (qs_control%becke_control%target(nvar)) + CALL section_vals_val_get(becke_section, "STRENGTH", r_vals=rtmplist) + DO j = 1, nvar + qs_control%becke_control%strength(j) = rtmplist(j) + END DO + CALL section_vals_val_get(becke_section, "TARGET", r_vals=rtmplist) + DO j = 1, nvar + qs_control%becke_control%target(j) = rtmplist(j) + END DO + + CALL section_vals_val_get(becke_section, "ADJUST_SIZE", & + l_val=qs_control%becke_control%adjust) + + IF (qs_control%becke_control%adjust) THEN + CALL section_vals_val_get(becke_section, "ATOMIC_RADII", explicit=exists) + IF (.NOT. exists) CPABORT("Keyword ATOMIC_RADII is missing.") + CALL section_vals_val_get(becke_section, "ATOMIC_RADII", r_vals=rtmplist) + CPASSERT(SIZE(rtmplist) > 0) + ALLOCATE (qs_control%becke_control%radii_tmp(SIZE(rtmplist))) + DO j = 1, SIZE(rtmplist) + qs_control%becke_control%radii_tmp(j) = rtmplist(j) + END DO + END IF + + CALL section_vals_val_get(becke_section, "ATOMIC_CHARGES", & + l_val=qs_control%becke_control%atomic_charges) + CALL section_vals_val_get(becke_section, "SHOULD_SKIP", & + l_val=qs_control%becke_control%should_skip) + CALL section_vals_val_get(becke_section, "CONFINE", & + i_val=qs_control%becke_control%confine_method) + CALL section_vals_val_get(becke_section, "CUTOFF_TYPE", & + i_val=qs_control%becke_control%cutoff_type) + + SELECT CASE (qs_control%becke_control%cutoff_type) + CASE (becke_cutoff_global) + CALL section_vals_val_get(becke_section, "GLOBAL_CUTOFF", & + r_val=qs_control%becke_control%rglobal) + CASE (becke_cutoff_element) + CALL section_vals_val_get(becke_section, "ELEMENT_CUTOFF", r_vals=rtmplist) + CPASSERT(SIZE(rtmplist) > 0) + ALLOCATE (qs_control%becke_control%cutoffs_tmp(SIZE(rtmplist))) + DO j = 1, SIZE(rtmplist) + qs_control%becke_control%cutoffs_tmp(j) = rtmplist(j) + END DO + END SELECT + + SELECT CASE (qs_control%becke_control%confine_method) + CASE (becke_none_conf) + qs_control%becke_control%confine = .FALSE. + qs_control%becke_control%dynamic_confine = .FALSE. + qs_control%becke_control%cavity_confine = .FALSE. + CASE (becke_static_conf) + qs_control%becke_control%confine = .TRUE. + qs_control%becke_control%dynamic_confine = .FALSE. + qs_control%becke_control%cavity_confine = .FALSE. + CASE (becke_dynamic_conf) + qs_control%becke_control%confine = .FALSE. + qs_control%becke_control%dynamic_confine = .TRUE. + qs_control%becke_control%cavity_confine = .FALSE. + CASE (becke_cavity_conf) + qs_control%becke_control%confine = .FALSE. + qs_control%becke_control%dynamic_confine = .FALSE. + qs_control%becke_control%cavity_confine = .TRUE. + CASE (becke_mixed_conf) + qs_control%becke_control%confine = .FALSE. + qs_control%becke_control%dynamic_confine = .TRUE. + qs_control%becke_control%cavity_confine = .TRUE. + END SELECT + + CALL section_vals_val_get(becke_section, "IN_MEMORY", & + l_val=qs_control%becke_control%in_memory) CALL section_vals_val_get(becke_section, "ATOMS", & n_rep_val=n_rep) jj = 0 @@ -1728,7 +1824,8 @@ CONTAINS jj = jj+1 END DO END DO - IF (jj < 1) CPABORT("Need at least 1 atom to use ddapc contraints.") + IF (jj < 1) CPABORT("Need at least 1 atom to use Becke constraints.") + qs_control%becke_control%natoms = jj IF (ASSOCIATED(qs_control%becke_control%atoms)) DEALLOCATE (qs_control%becke_control%atoms) ALLOCATE (qs_control%becke_control%atoms(qs_control%becke_control%natoms)) @@ -1746,8 +1843,52 @@ CONTAINS ALLOCATE (qs_control%becke_control%coeff(qs_control%becke_control%natoms)) qs_control%becke_control%coeff = 1.0_dp - CALL section_vals_val_get(becke_section, "COEFF", & - n_rep_val=n_rep) + IF (qs_control%becke_control%atomic_charges) THEN + IF (ASSOCIATED(qs_control%becke_control%charge)) & + DEALLOCATE (qs_control%becke_control%charge) + ALLOCATE (qs_control%becke_control%charge(qs_control%becke_control%natoms)) + END IF + + IF (qs_control%becke_control%confine) THEN + CALL section_vals_val_get(becke_section, "CONFINE_DIR", & + i_val=qs_control%becke_control%confine_dir) + jj = 0 + CALL section_vals_val_get(becke_section, "CONFINE_BOUNDS", r_vals=rtmplist) + DO j = 1, SIZE(rtmplist) + jj = jj+1 + IF (jj .GT. 2) CPABORT("Need exactly two values to define confinement.") + qs_control%becke_control%confine_bounds(jj) = rtmplist(j) + END DO + IF (jj .LT. 2) CPABORT("Need exactly two values to define confinement.") + END IF + + IF (qs_control%becke_control%dynamic_confine) THEN + CALL section_vals_val_get(becke_section, "CONFINE_DIR", & + i_val=qs_control%becke_control%confine_dir) + jj = 0 + CALL section_vals_val_get(becke_section, "DYNAMIC_RADIUS", & + r_val=qs_control%becke_control%dynamic_radius) + END IF + + IF (qs_control%becke_control%cavity_confine) THEN + CALL section_vals_val_get(becke_section, "CAVITY_SHAPE", & + i_val=qs_control%becke_control%cavity_shape) + CALL section_vals_val_get(becke_section, "CAVITY_RADIUS", & + r_val=qs_control%becke_control%rcavity) + CALL section_vals_val_get(becke_section, "EPS_CAVITY", & + r_val=qs_control%becke_control%eps_cavity) + CALL section_vals_val_get(becke_section, "CAVITY_PRINT", & + l_val=qs_control%becke_control%print_cavity) + CALL section_vals_val_get(becke_section, "CAVITY_USE_BOHR", & + l_val=qs_control%becke_control%use_bohr) + CALL create_hirshfeld_type(qs_control%becke_control%cavity_env) + CALL set_hirshfeld_info(qs_control%becke_control%cavity_env, & + shape_function_type=shape_function_gaussian, iterative=.FALSE., & + radius_type=qs_control%becke_control%cavity_shape, & + use_bohr=qs_control%becke_control%use_bohr) + END IF + + CALL section_vals_val_get(becke_section, "COEFF", n_rep_val=n_rep) jj = 0 DO k = 1, n_rep CALL section_vals_val_get(becke_section, "COEFF", i_rep_val=k, r_vals=rtmplist) @@ -1760,8 +1901,222 @@ CONTAINS END DO IF (jj < qs_control%becke_control%natoms .AND. jj .NE. 0) & CPABORT("Need no or the same number of coeff as there are atoms.") + + IF (qs_control%becke_control%confine) THEN + IF (qs_control%becke_control%confine_bounds(1) /= qs_control%becke_control%confine_bounds(2)) & + CPABORT("Static confinement was requested but the bounds were not defined.") + END IF + + CALL section_vals_val_get(becke_section, "FRAGMENT_DENSITIES", & + l_val=qs_control%becke_control%fragment_density) + + IF (qs_control%becke_control%fragment_density) THEN + CALL section_vals_val_get(becke_section, "FRAGMENT_A_FILE_NAME", & + c_val=qs_control%becke_control%fragment_a_fname) + CALL section_vals_val_get(becke_section, "FRAGMENT_B_FILE_NAME", & + c_val=qs_control%becke_control%fragment_b_fname) + END IF + + CALL cite_reference(Becke1988b) + END SUBROUTINE read_becke_section +! ************************************************************************************************** +!> \brief reads the input parameters needed for CDFT with OT +!> \param qs_control the qs_control which holds the CDFT control type +!> \param cdft_control_section the input section for CDFT +!> \author Nico Holmberg [12.2015] +! ************************************************************************************************** + SUBROUTINE read_cdft_control_section(qs_control, cdft_control_section) + TYPE(qs_control_type), INTENT(INOUT) :: qs_control + TYPE(section_vals_type), POINTER :: cdft_control_section + + CHARACTER(len=*), PARAMETER :: routineN = 'read_cdft_control_section', & + routineP = moduleN//':'//routineN + + LOGICAL :: exists + TYPE(section_vals_type), POINTER :: hirshfeld_constraint_section, & + outer_scf_section + + NULLIFY (outer_scf_section, hirshfeld_constraint_section) + CALL section_vals_val_get(cdft_control_section, "TYPE_OF_CONSTRAINT", & + i_val=qs_control%cdft_control%type) + IF (qs_control%cdft_control%type /= outer_scf_none) THEN + CALL section_vals_val_get(cdft_control_section, "REUSE_PRECOND", & + l_val=qs_control%cdft_control%reuse_precond) + CALL section_vals_val_get(cdft_control_section, "PRECOND_FREQ", & + i_val=qs_control%cdft_control%precond_freq) + CALL section_vals_val_get(cdft_control_section, "MAX_REUSE", & + i_val=qs_control%cdft_control%max_reuse) + CALL section_vals_val_get(cdft_control_section, "PURGE_HISTORY", & + l_val=qs_control%cdft_control%purge_history) + CALL section_vals_val_get(cdft_control_section, "PURGE_FREQ", & + i_val=qs_control%cdft_control%purge_freq) + CALL section_vals_val_get(cdft_control_section, "PURGE_OFFSET", & + i_val=qs_control%cdft_control%purge_offset) + outer_scf_section => section_vals_get_subs_vals(cdft_control_section, "OUTER_SCF") + CALL section_vals_val_get(outer_scf_section, "_SECTION_PARAMETERS_", & + l_val=qs_control%cdft_control%constraint_control%have_scf) + IF (qs_control%cdft_control%constraint_control%have_scf) THEN + CALL section_vals_val_get(outer_scf_section, "TYPE", & + i_val=qs_control%cdft_control%constraint_control%type) + + IF (qs_control%cdft_control%constraint_control%type /= outer_scf_becke_constraint .AND. & + qs_control%cdft_control%constraint_control%type /= outer_scf_cdft_constraint) & + CPABORT("Unsupported CDFT constraint.") + + CALL section_vals_val_get(outer_scf_section, "EPS_SCF", & + r_val=qs_control%cdft_control%constraint_control%eps_scf) + CALL section_vals_val_get(outer_scf_section, "STEP_SIZE", & + r_val=qs_control%cdft_control%constraint_control%step_size) + CALL section_vals_val_get(outer_scf_section, "DIIS_BUFFER_LENGTH", & + i_val=qs_control%cdft_control%constraint_control%diis_buffer_length) + CALL section_vals_val_get(outer_scf_section, "BISECT_TRUST_COUNT", & + i_val=qs_control%cdft_control%constraint_control%bisect_trust_count) + CALL section_vals_val_get(outer_scf_section, "OPTIMIZER", & + i_val=qs_control%cdft_control%constraint_control%optimizer) + CALL section_vals_val_get(outer_scf_section, "MAX_SCF", & + i_val=qs_control%cdft_control%constraint_control%max_scf) + CALL section_vals_val_get(outer_scf_section, "EXTRAPOLATION_ORDER", & + i_val=qs_control%cdft_control%constraint_control%extrapolation_order) + CALL section_vals_val_get(outer_scf_section, "JACOBIAN_TYPE", & + i_val=qs_control%cdft_control%constraint_control%jacobian_type) + CALL section_vals_val_get(outer_scf_section, "JACOBIAN_STEP", & + r_val=qs_control%cdft_control%constraint_control%jacobian_step) + SELECT CASE (qs_control%cdft_control%type) + CASE (outer_scf_hirshfeld_constraint) + IF (qs_control%cdft_control%constraint_control%type == outer_scf_cdft_constraint) THEN + hirshfeld_constraint_section => section_vals_get_subs_vals(cdft_control_section, "HIRSHFELD_CONSTRAINT") + CALL section_vals_get(hirshfeld_constraint_section, explicit=exists) + IF (exists) THEN + CALL read_hirshfeld_constraint_section(qs_control, hirshfeld_constraint_section) + qs_control%cdft_control%constraint_type = qs_control%cdft_control%hirshfeld_control%constraint_type + qs_control%cdft_control%combined_type = qs_control%cdft_control%hirshfeld_control%combined_type + ELSE + CPABORT("HIRSHFELD_CONSTRAINT section is missing.") + END IF + ELSE + CPABORT("Mismatch in defining constraint.") + END IF + CASE (outer_scf_becke_constraint) + ! Do nothing, yet. For now, constraint is defined QS%BECKE_RESTRAINT + END SELECT + + CALL cite_reference(Holmberg2017) + ELSE + qs_control%cdft = .FALSE. + END IF + ELSE + qs_control%cdft = .FALSE. + END IF + + END SUBROUTINE read_cdft_control_section + +! ************************************************************************************************** +!> \brief reads the input parameters needed for Hirshfeld constraint +!> \param qs_control the qs_control which holds the Hirshfeld constraint +!> \param hirshfeld_constraint_section the input section for a Hirshfeld constraint +!> \author Nico Holmberg [12.2015] +! ************************************************************************************************** + SUBROUTINE read_hirshfeld_constraint_section(qs_control, hirshfeld_constraint_section) + TYPE(qs_control_type), INTENT(INOUT) :: qs_control + TYPE(section_vals_type), POINTER :: hirshfeld_constraint_section + + CHARACTER(len=*), PARAMETER :: routineN = 'read_hirshfeld_constraint_section', & + routineP = moduleN//':'//routineN + + INTEGER :: j, jj, k, n_rep, nvar, radius_type, & + refc, shapef + INTEGER, DIMENSION(:), POINTER :: tmplist + LOGICAL :: do_radius, do_sc + REAL(KIND=dp), DIMENSION(:), POINTER :: rtmplist + + NULLIFY (tmplist, rtmplist) + CPASSERT(.NOT. ASSOCIATED(qs_control%cdft_control%hirshfeld_control)) + ALLOCATE (qs_control%cdft_control%hirshfeld_control) + + CALL section_vals_val_get(hirshfeld_constraint_section, "ATOMS", n_rep_val=n_rep) + jj = 0 + DO k = 1, n_rep + CALL section_vals_val_get(hirshfeld_constraint_section, "ATOMS", i_rep_val=k, i_vals=tmplist) + DO j = 1, SIZE(tmplist) + jj = jj+1 + END DO + END DO + IF (jj < 1) CPABORT("Need at least 1 atom to use Hirshfeld constraints.") + qs_control%cdft_control%hirshfeld_control%natoms = jj + ALLOCATE (qs_control%cdft_control%hirshfeld_control%atoms( & + qs_control%cdft_control%hirshfeld_control%natoms)) + jj = 0 + DO k = 1, n_rep + CALL section_vals_val_get(hirshfeld_constraint_section, "ATOMS", i_rep_val=k, i_vals=tmplist) + DO j = 1, SIZE(tmplist) + jj = jj+1 + qs_control%cdft_control%hirshfeld_control%atoms(jj) = tmplist(j) + END DO + END DO + + ALLOCATE (qs_control%cdft_control%hirshfeld_control%coeff(qs_control%cdft_control%hirshfeld_control%natoms)) + qs_control%cdft_control%hirshfeld_control%coeff = 1.0_dp + + CALL section_vals_val_get(hirshfeld_constraint_section, "COEFF", n_rep_val=n_rep) + jj = 0 + DO k = 1, n_rep + CALL section_vals_val_get(hirshfeld_constraint_section, "COEFF", i_rep_val=k, r_vals=rtmplist) + DO j = 1, SIZE(rtmplist) + jj = jj+1 + IF (jj > qs_control%cdft_control%hirshfeld_control%natoms) & + CPABORT("Need the same number of coeff as there are atoms.") + qs_control%cdft_control%hirshfeld_control%coeff(jj) = rtmplist(j) + IF (ABS(rtmplist(j)) /= 1.0_dp) & + CPABORT("Illegal coefficient. Only -1.0 or 1.0 allowed.") + END DO + END DO + IF (jj < qs_control%cdft_control%hirshfeld_control%natoms .AND. jj .NE. 0) & + CPABORT("Need no or the same number of coeff as there are atoms.") + + CALL section_vals_val_get(hirshfeld_constraint_section, "CONSTRAINT_TYPE", & + i_val=qs_control%cdft_control%hirshfeld_control%constraint_type) + SELECT CASE (qs_control%cdft_control%hirshfeld_control%constraint_type) + CASE (cdft_density_constraint, cdft_magnetization_constraint) + nvar = 1 + CASE (cdft_combined_constraint) + nvar = 1 + CALL section_vals_val_get(hirshfeld_constraint_section, "COMBINED_TYPE", & + i_val=qs_control%cdft_control%hirshfeld_control%constraint_type) + END SELECT + + IF (qs_control%cdft_control%hirshfeld_control%constraint_type /= cdft_density_constraint) & + CPABORT("Hirshfeld magnetization density/combined constraint NYI.") + + ALLOCATE (qs_control%cdft_control%target(nvar)) + ALLOCATE (qs_control%cdft_control%strength(nvar)) + ALLOCATE (qs_control%cdft_control%value(nvar)) + CALL section_vals_val_get(hirshfeld_constraint_section, "STRENGTH", r_vals=rtmplist) + DO j = 1, nvar + qs_control%cdft_control%strength(j) = rtmplist(j) + END DO + CALL section_vals_val_get(hirshfeld_constraint_section, "TARGET", r_vals=rtmplist) + DO j = 1, nvar + qs_control%cdft_control%target(j) = rtmplist(j) + END DO + + NULLIFY (qs_control%cdft_control%hirshfeld_control%hirshfeld_env) + CALL create_hirshfeld_type(qs_control%cdft_control%hirshfeld_control%hirshfeld_env) + CALL section_vals_val_get(hirshfeld_constraint_section, "SELF_CONSISTENT", l_val=do_sc) + CALL section_vals_val_get(hirshfeld_constraint_section, "USER_RADIUS", l_val=do_radius) + CALL section_vals_val_get(hirshfeld_constraint_section, "SHAPE_FUNCTION", i_val=shapef) + CALL section_vals_val_get(hirshfeld_constraint_section, "REFERENCE_CHARGE", i_val=refc) + IF (do_radius) THEN + radius_type = radius_user + ELSE + radius_type = radius_covalent + END IF + CALL set_hirshfeld_info(qs_control%cdft_control%hirshfeld_control%hirshfeld_env, & + shape_function_type=shapef, iterative=do_sc, ref_charge=refc, radius_type=radius_type) + + END SUBROUTINE read_hirshfeld_constraint_section + ! ************************************************************************************************** !> \brief ... !> \param dft_control ... diff --git a/src/et_coupling.F b/src/et_coupling.F index 5029e5f34c..7216d9578a 100644 --- a/src/et_coupling.F +++ b/src/et_coupling.F @@ -10,9 +10,12 @@ ! ************************************************************************************************** MODULE et_coupling USE atomic_kind_types, ONLY: atomic_kind_type,& + get_atomic_kind,& get_atomic_kind_set - USE cell_types, ONLY: cell_type - USE cp_control_types, ONLY: dft_control_type + USE cell_types, ONLY: cell_type,& + pbc + USE cp_control_types, ONLY: cdft_control_type,& + dft_control_type USE cp_dbcsr_operations, ONLY: cp_dbcsr_sm_fm_multiply USE cp_fm_basic_linalg, ONLY: cp_fm_invert,& cp_fm_transpose @@ -31,28 +34,65 @@ MODULE et_coupling USE cp_output_handling, ONLY: cp_print_key_finished_output,& cp_print_key_unit_nr USE cp_para_types, ONLY: cp_para_env_type + USE cp_realspace_grid_cube, ONLY: cp_pw_to_cube + USE cp_units, ONLY: cp_unit_from_cp2k + USE cube_utils, ONLY: cube_info_type USE dbcsr_api, ONLY: dbcsr_deallocate_matrix_set,& dbcsr_p_type - USE input_constants, ONLY: do_spin_density + USE hirshfeld_methods, ONLY: create_shape_function + USE hirshfeld_types, ONLY: get_hirshfeld_info,& + hirshfeld_type,& + set_hirshfeld_info + USE input_constants, ONLY: & + becke_cutoff_element, becke_cutoff_global, cdft_combined_acceptor, cdft_combined_all, & + cdft_combined_constraint, cdft_combined_donor, cdft_density_constraint, & + cdft_magnetization_constraint, ref_charge_atomic, ref_charge_mulliken USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type - USE kahan_sum, ONLY: accurate_sum + USE kahan_sum, ONLY: accurate_sum,& + accurate_sum_arrays_product USE kinds, ONLY: dp,& - dp_size,& - int_size + int_8 USE mathlib, ONLY: diamat_all USE message_passing, ONLY: mp_sum + USE particle_list_types, ONLY: particle_list_type USE particle_types, ONLY: particle_type - USE pw_types, ONLY: pw_p_type + USE pw_env_types, ONLY: pw_env_get,& + pw_env_type + USE pw_methods, ONLY: pw_axpy,& + pw_copy,& + pw_integrate_function,& + pw_scale,& + pw_set + USE pw_pool_types, ONLY: pw_pool_create_pw,& + pw_pool_give_back_pw,& + pw_pool_type + USE pw_types, ONLY: REALDATA3D,& + REALSPACE,& + pw_p_type,& + pw_release + USE qs_collocate_density, ONLY: collocate_pgf_product_rspace USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type USE qs_force_types, ONLY: qs_force_type + USE qs_integrate_potential, ONLY: integrate_pgf_product_rspace + USE qs_kind_types, ONLY: get_qs_kind,& + qs_kind_type USE qs_matrix_pools, ONLY: mpools_get USE qs_mo_types, ONLY: get_mo_set + USE qs_modify_pab_block, ONLY: FUNC_AB + USE qs_rho0_types, ONLY: get_rho0_mpole,& + mpole_rho_atom,& + rho0_mpole_type USE qs_rho_types, ONLY: qs_rho_get,& qs_rho_type - USE termination, ONLY: stop_memory + USE qs_subsys_types, ONLY: qs_subsys_get,& + qs_subsys_type + USE realspace_grid_cube, ONLY: cube_to_pw + USE realspace_grid_types, ONLY: & + pw2rs, realspace_grid_desc_type, realspace_grid_type, rs2pw, rs_grid_create, & + rs_grid_release, rs_grid_retain, rs_grid_zero, rs_pw_transfer #include "./base/base_uses.f90" IMPLICIT NONE @@ -60,10 +100,12 @@ MODULE et_coupling PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'et_coupling' + INTEGER, PARAMETER, PRIVATE :: divide = 1, multiply = 2 + LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE. ! *** Public subroutines *** - PUBLIC :: calc_et_coupling, becke_restraint + PUBLIC :: calc_et_coupling, becke_restraint, hirshfeld_constraint CONTAINS ! ************************************************************************************************** @@ -77,8 +119,8 @@ CONTAINS CHARACTER(len=*), PARAMETER :: routineN = 'calc_et_coupling', & routineP = moduleN//':'//routineN - INTEGER :: handle, i, iw, j, k, my_id, nao, & - ncol_local, nmo, nrow_local + INTEGER :: handle, i, iw, j, k, nao, ncol_local, & + nmo, nrow_local INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices REAL(KIND=dp) :: Sda, strength, Waa, Wbb, Wda REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: a, b, S_det @@ -104,7 +146,6 @@ CONTAINS "PROPERTIES%ET_COUPLING") CALL get_qs_env(qs_env, dft_control=dft_control, para_env=para_env) - my_id = dft_control%qs_control%becke_control%density_type iw = cp_print_key_unit_nr(logger, et_coupling_section, "PROGRAM_RUN_INFO", & extension=".log") @@ -190,7 +231,8 @@ CONTAINS a(i) = a(i)+rest_MO(1)%matrix%local_data(k, j)*Tinverse%local_data(k, j) END DO END DO - IF ((my_id == do_spin_density) .AND. i == 2) THEN + IF (dft_control%qs_control%becke_control%constraint_type == & + cdft_magnetization_constraint .AND. i == 2) THEN a(i) = -a(i) b(i) = -b(i) END IF @@ -224,8 +266,8 @@ CONTAINS END IF IF (dft_control%qs_control%becke_restraint) THEN Waa = qs_env%et_coupling%order_p - Wbb = dft_control%qs_control%becke_control%becke_order_p - strength = dft_control%qs_control%becke_control%strength + Wbb = dft_control%qs_control%becke_control%becke_order_p(1) + strength = dft_control%qs_control%becke_control%strength(1) END IF !! construct S and W !!! @@ -283,68 +325,217 @@ CONTAINS END SUBROUTINE calc_et_coupling ! ************************************************************************************************** -!> \brief calculates a becke contraint -!> \param qs_env ... -!> \param becke_const ... -!> \param calc_pot logical if potential has to be calculated or only_energy -!> \param calculate_forces ... -!> \author fschiff (01.2007) +!> \brief calculates a Becke contraint +!> \param qs_env the qs_env where to build the constraint +!> \param becke_const the Becke real space potential +!> \param charge atomic Becke real space potentials defined on the constraint atoms +!> \param calc_pot if the potential needs to be recalculated or just integrated +!> \param calculate_forces logical if potential has to be calculated or only_energy +!> \par History +!> Created 01.2007 [fschiff] +!> Extended functionality 12/15-12/16 [Nico Holmberg] ! ************************************************************************************************** - SUBROUTINE becke_restraint(qs_env, becke_const, calc_pot, calculate_forces) + SUBROUTINE becke_restraint(qs_env, becke_const, charge, calc_pot, calculate_forces) TYPE(qs_environment_type), POINTER :: qs_env TYPE(pw_p_type) :: becke_const + TYPE(pw_p_type), DIMENSION(:), POINTER :: charge LOGICAL :: calc_pot, calculate_forces CHARACTER(len=*), PARAMETER :: routineN = 'becke_restraint', & routineP = moduleN//':'//routineN - INTEGER :: handle, i, iatom, ip, istat, j, jatom, & - k, np(3) + CHARACTER(len=2) :: element_symbol + INTEGER :: atom_a, bounds(2), dir, handle, i, iatom, iex, ikind, ind(3), ip, ithread, ivar, & + iw, j, jatom, k, katom, lb_index, natom, nelectron_total, ngrad, nkind, np(3), npme, & + nskipped, nthread, numexp, nvar, tmp_index(2), ub_index, unit_nr INTEGER, ALLOCATABLE, DIMENSION(:) :: catom - INTEGER, DIMENSION(2, 3) :: bo - REAL(kind=dp) :: dE, dist1, dist2, dvol, my1, myexp, & - strength, sum_cell_f_all, & - sum_cell_f_constr, target_val - REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: cell_functions - REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: R12 - REAL(kind=dp), DIMENSION(3) :: cell_v, dist_vec, dr, grid_p, r, r1, & - shift - REAL(kind=dp), DIMENSION(:), POINTER :: coeff + INTEGER, DIMENSION(2, 3) :: bo, bo_conf + INTEGER, DIMENSION(:), POINTER :: atom_list, cores, stride + LOGICAL :: build, in_memory, paw_atom, store_vectors + LOGICAL, ALLOCATABLE, DIMENSION(:) :: is_combined, is_constraint, skip_me + REAL(kind=dp) :: alpha, chi, coef, dist1, dist2, dmyexp, dvol, dynamic_radius, eps_cavity, & + ircov, jrcov, lb, my1, my1_homo, myexp, nelectron_frag, sign, sum_cell_f_all, & + sum_cell_f_combined, sum_cell_f_constr, tc, th, tmp_const, ub, uij, zeff + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: cell_functions, coefficients, dE, & + distances, ds_dR_i, ds_dR_j, & + gapw_offset, strength, target_val + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: d_sum_const_dR, d_sum_Pm_dR, & + distance_vecs, dP_i_dRi, & + electronic_charge, position_vecs, R12 + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dP_i_dRj, pair_dist_vecs + REAL(kind=dp), DIMENSION(3) :: cell_v, dist_vec, dmy_dR_i, dmy_dR_j, & + dr, dr1_r2, dr_i_dR, dr_ij_dR, & + dr_j_dR, grid_p, r, r1, ra, shift + REAL(KIND=dp), DIMENSION(:), POINTER :: cutoffs + REAL(KIND=dp), DIMENSION(:, :), POINTER :: pab + REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: gradients + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(cell_type), POINTER :: cell + TYPE(cp_logger_type), POINTER :: logger TYPE(cp_para_env_type), POINTER :: para_env TYPE(dft_control_type), POINTER :: dft_control + TYPE(hirshfeld_type), POINTER :: cavity_env + TYPE(mpole_rho_atom), DIMENSION(:), POINTER :: mp_rho + TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_env_type), POINTER :: pw_env + TYPE(pw_p_type) :: rho_frag TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_r + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(qs_energy_type), POINTER :: energy + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_rho_type), POINTER :: rho + TYPE(qs_subsys_type), POINTER :: subsys + TYPE(realspace_grid_type), POINTER :: rs_cavity + TYPE(rho0_mpole_type), POINTER :: rho0_mpole + TYPE(section_vals_type), POINTER :: becke_restraint_section - NULLIFY (cell, particle_set, coeff, energy, rho, dft_control, para_env, rho_r) + store_vectors = .TRUE. ! Reuse vectors as much as possible + NULLIFY (cores, stride, atom_list, cutoffs, cell, para_env, & + dft_control, particle_set, rho_r, energy, rho, logger, & + becke_restraint_section, qs_kind_set, gradients, particles, & + subsys, pab, pw_env, rs_cavity, cavity_env, auxbas_pw_pool, & + atomic_kind_set, mp_rho, rho0_mpole) CALL timeset(routineN, handle) CALL get_qs_env(qs_env, & cell=cell, & particle_set=particle_set, & rho=rho, & + natom=natom, & dft_control=dft_control, & - para_env=para_env) + para_env=para_env, & + qs_kind_set=qs_kind_set) + + logger => cp_get_default_logger() + CPASSERT(ASSOCIATED(qs_kind_set)) + + becke_restraint_section => section_vals_get_subs_vals(qs_env%input, & + "DFT%QS%BECKE_RESTRAINT") + iw = cp_print_key_unit_nr(logger, becke_restraint_section, "PROGRAM_RUN_INFO", & + extension=".cdftLog") CALL qs_rho_get(rho, rho_r=rho_r) IF (dft_control%qs_control%becke_restraint) THEN - target_val = dft_control%qs_control%becke_control%target - strength = dft_control%qs_control%becke_control%strength + SELECT CASE (dft_control%qs_control%becke_control%constraint_type) + CASE (cdft_density_constraint) + nvar = 1 + ngrad = 1 + CASE (cdft_magnetization_constraint) + nvar = 1 + ngrad = 1 + IF (dft_control%nspins == 1) & + CALL cp_abort(__LOCATION__, & + "Becke magnetization density constraint requires UKS calculation.") + CASE (cdft_combined_constraint) + nvar = 2 + IF (dft_control%nspins == 1) & + CALL cp_abort(__LOCATION__, & + "Becke combined charge+spin constraint requires UKS calculation.") + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ngrad = 1 + CASE (cdft_combined_acceptor, cdft_combined_donor) + ngrad = 2 + END SELECT + END SELECT + ALLOCATE (strength(nvar)) + ALLOCATE (target_val(nvar)) + ALLOCATE (dE(nvar)) + strength(:) = dft_control%qs_control%becke_control%strength(:) + target_val(:) = dft_control%qs_control%becke_control%target(:) + dE = 0.0_dp dvol = becke_const%pw%pw_grid%dvol + eps_cavity = dft_control%qs_control%becke_control%eps_cavity + IF (calc_pot) THEN becke_const%pw%cr3d = 0.0_dp - ALLOCATE (catom(dft_control%qs_control%becke_control%natoms), STAT=istat) - IF (istat /= 0) CALL stop_memory(routineN, moduleN, __LINE__, & - "catom", int_size* & - dft_control%qs_control%becke_control%natoms) + ! Setup atomic radii for adjusting cell boundaries + IF (dft_control%qs_control%becke_control%adjust) THEN + IF (.NOT. ASSOCIATED(dft_control%qs_control%becke_control%radii)) THEN + CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set) + IF (.NOT. SIZE(atomic_kind_set) == SIZE(dft_control%qs_control%becke_control%radii_tmp)) & + CALL cp_abort(__LOCATION__, & + "Length of keyword BECKE_RESTRAINT\ATOMIC_RADII does not "// & + "match number of atomic kinds in the input coordinate file.") + ALLOCATE (dft_control%qs_control%becke_control%radii(SIZE(atomic_kind_set))) + dft_control%qs_control%becke_control%radii(:) = dft_control%qs_control%becke_control%radii_tmp(:) + DEALLOCATE (dft_control%qs_control%becke_control%radii_tmp) + END IF + END IF + + ! Setup cutoff scheme + IF (.NOT. ASSOCIATED(dft_control%qs_control%becke_control%cutoffs)) THEN + CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set) + ALLOCATE (dft_control%qs_control%becke_control%cutoffs(natom)) + SELECT CASE (dft_control%qs_control%becke_control%cutoff_type) + CASE (becke_cutoff_global) + dft_control%qs_control%becke_control%cutoffs(:) = dft_control%qs_control%becke_control%rglobal + CASE (becke_cutoff_element) + IF (.NOT. SIZE(atomic_kind_set) == SIZE(dft_control%qs_control%becke_control%cutoffs_tmp)) & + CALL cp_abort(__LOCATION__, & + "Length of keyword BECKE_RESTRAINT\ELEMENT_CUTOFFS does not "// & + "match number of atomic kinds in the input coordinate file.") + DO ikind = 1, SIZE(atomic_kind_set) + CALL get_atomic_kind(atomic_kind_set(ikind), natom=katom, atom_list=atom_list) + DO iatom = 1, katom + atom_a = atom_list(iatom) + dft_control%qs_control%becke_control%cutoffs(atom_a) = & + dft_control%qs_control%becke_control%cutoffs_tmp(ikind) + END DO + END DO + DEALLOCATE (dft_control%qs_control%becke_control%cutoffs_tmp) + END SELECT + END IF + cutoffs => dft_control%qs_control%becke_control%cutoffs + + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + DO iatom = 1, dft_control%qs_control%becke_control%natoms + charge(iatom)%pw%cr3d = 0.0_dp + END DO + END IF + + build = .FALSE. + IF (dft_control%qs_control%becke_control%adjust .AND. & + .NOT. ASSOCIATED(dft_control%qs_control%becke_control%aij)) THEN + ALLOCATE (dft_control%qs_control%becke_control%aij(natom, natom)) + build = .TRUE. + END IF + ALLOCATE (catom(dft_control%qs_control%becke_control%natoms)) + + IF (dft_control%qs_control%becke_control%dynamic_confine .OR. & + dft_control%qs_control%becke_control%save_pot .OR. & + dft_control%qs_control%becke_control%cavity_confine .OR. & + dft_control%qs_control%becke_control%should_skip .OR. & + dft_control%qs_control%becke_control%first_iteration) THEN + ALLOCATE (is_constraint(natom)) + is_constraint = .FALSE. + END IF + ! This boolean is needed to prevent calculation of atom pairs ji when the pair ij has + ! already been calculated (data for pair ji is set using symmetry) + ! With gradient precomputation, symmetry exploited for both weight function and gradients + ALLOCATE (skip_me(natom)) + in_memory = .FALSE. + IF (dft_control%qs_control%becke_control%save_pot) THEN + in_memory = dft_control%qs_control%becke_control%in_memory + END IF + IF (in_memory .OR. dft_control%qs_control%becke_control%first_iteration) & + ALLOCATE (coefficients(natom)) + DO i = 1, dft_control%qs_control%becke_control%natoms catom(i) = dft_control%qs_control%becke_control%atoms(i) + IF (dft_control%qs_control%becke_control%dynamic_confine .OR. & + dft_control%qs_control%becke_control%save_pot .OR. & + dft_control%qs_control%becke_control%cavity_confine .OR. & + dft_control%qs_control%becke_control%should_skip .OR. & + dft_control%qs_control%becke_control%first_iteration) & + is_constraint(catom(i)) = .TRUE. + IF (in_memory .OR. dft_control%qs_control%becke_control%first_iteration) & + coefficients(catom(i)) = dft_control%qs_control%becke_control%coeff(i) ENDDO bo = becke_const%pw%pw_grid%bounds_local @@ -353,18 +544,44 @@ CONTAINS dr = becke_const%pw%pw_grid%dr np = becke_const%pw%pw_grid%npts shift = -REAL(MODULO(np, 2), dp)*dr/2.0_dp - coeff => dft_control%qs_control%becke_control%coeff - ALLOCATE (cell_functions(SIZE(particle_set))) - !calculate distances from target atom (only implemented for a diatomic system) + ALLOCATE (cell_functions(natom)) + IF (store_vectors) THEN + ALLOCATE (distances(natom)) + ALLOCATE (distance_vecs(3, natom)) + IF (in_memory) ALLOCATE (pair_dist_vecs(3, natom, natom)) + ALLOCATE (position_vecs(3, natom)) + END IF + ! Setup static/dynamic confinement + IF (dft_control%qs_control%becke_control%confine) THEN + dir = dft_control%qs_control%becke_control%confine_dir + lb = dft_control%qs_control%becke_control%confine_bounds(1) + ub = dft_control%qs_control%becke_control%confine_bounds(2) + ! Convert [0,L] to [-L/2, L/2] + lb = lb-cell%hmat(dir, dir)/2._dp + ub = ub-cell%hmat(dir, dir)/2._dp + ELSE IF (dft_control%qs_control%becke_control%dynamic_confine) THEN + dir = dft_control%qs_control%becke_control%confine_dir + lb = HUGE(0.0_dp) + ub = -HUGE(0.0_dp) + dynamic_radius = dft_control%qs_control%becke_control%dynamic_radius + END IF + ALLOCATE (R12(natom, natom)) + IF (in_memory) THEN + ALLOCATE (ds_dR_j(3)) + ALLOCATE (ds_dR_i(3)) + ALLOCATE (d_sum_Pm_dR(3, natom)) + ALLOCATE (d_sum_const_dR(3*ngrad, natom)) + ALLOCATE (dP_i_dRj(3, natom, natom)) + ALLOCATE (dP_i_dRi(3, natom)) + th = 1.0e-8_dp + END IF + !calculate distances from target atom (only implemented for a diatomic system) DO i = 1, 3 cell_v(i) = cell%hmat(i, i) END DO - - ALLOCATE (R12(SIZE(particle_set), SIZE(particle_set))) - - DO iatom = 1, SIZE(particle_set)-1 - DO jatom = iatom+1, SIZE(particle_set) + DO iatom = 1, natom-1 + DO jatom = iatom+1, natom r = particle_set(iatom)%r r1 = particle_set(jatom)%r DO i = 1, 3 @@ -372,92 +589,960 @@ CONTAINS r1(i) = MODULO(r1(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp END DO dist_vec = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + ! Store pbc corrected position and pairwise distance vectors for later reuse + IF (store_vectors) THEN + position_vecs(:, iatom) = r(:) + IF (iatom == 1 .AND. jatom == natom) position_vecs(:, jatom) = r1(:) + IF (in_memory) THEN + pair_dist_vecs(:, iatom, jatom) = dist_vec(:) + pair_dist_vecs(:, jatom, iatom) = -dist_vec(:) + END IF + END IF R12(iatom, jatom) = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) R12(jatom, iatom) = R12(iatom, jatom) + IF (dft_control%qs_control%becke_control%dynamic_confine) THEN + IF (is_constraint(iatom) .AND. is_constraint(jatom)) THEN + ! ub = max(r(dir)+dynamic_radius), lb = min(r(dir)-dynamic_radius) + IF ((r(dir)+dynamic_radius) .GT. ub) ub = r(dir)+dynamic_radius + IF ((r1(dir)+dynamic_radius) .GT. ub) ub = r1(dir)+dynamic_radius + IF ((r(dir)-dynamic_radius) .LT. lb) lb = r(dir)-dynamic_radius + IF ((r1(dir)-dynamic_radius) .LT. lb) lb = r1(dir)-dynamic_radius + END IF + END IF + ! Set up heteronuclear cell partitioning using user defined radii + IF (build) THEN + CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, & + kind_number=ikind) + ircov = dft_control%qs_control%becke_control%radii(ikind) + CALL get_atomic_kind(atomic_kind=particle_set(jatom)%atomic_kind, & + kind_number=ikind) + jrcov = dft_control%qs_control%becke_control%radii(ikind) + IF (ircov .NE. jrcov) THEN + chi = ircov/jrcov + uij = (chi-1.0_dp)/(chi+1.0_dp) + dft_control%qs_control%becke_control%aij(iatom, jatom) = uij/(uij**2-1.0_dp) + IF (dft_control%qs_control%becke_control%aij(iatom, jatom) .GT. 0.5_dp) THEN + dft_control%qs_control%becke_control%aij(iatom, jatom) = 0.5_dp + ELSE IF (dft_control%qs_control%becke_control%aij(iatom, jatom) .LT. -0.5_dp) THEN + dft_control%qs_control%becke_control%aij(iatom, jatom) = -0.5_dp + END IF + ELSE + dft_control%qs_control%becke_control%aij(iatom, jatom) = 0.0_dp + END IF + dft_control%qs_control%becke_control%aij(jatom, iatom) = & + -dft_control%qs_control%becke_control%aij(iatom, jatom) ! Note change of sign + END IF END DO END DO + ! Dump some additional information about the calculation + IF (dft_control%qs_control%becke_control%first_iteration) THEN + IF (iw > 0) THEN + WRITE (iw, '(/,T3,A,T60)') & + '----------------------------- Becke atomic parameters -----------------------------' + IF (dft_control%qs_control%becke_control%adjust) THEN + WRITE (iw, '(/,T3,A,A)') & + 'Atom Element Coefficient', ' Cutoff (angstrom) CDFT Radius (angstrom)' + DO iatom = 1, natom + CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, & + element_symbol=element_symbol, & + kind_number=ikind) + ircov = cp_unit_from_cp2k(dft_control%qs_control%becke_control%radii(ikind), & + "angstrom") + IF (is_constraint(iatom)) THEN + coef = coefficients(iatom) + ELSE + coef = 0.0_dp + END IF + WRITE (iw, "(i7,T15,A2,T23,F8.3,T39,F8.3,T61,F8.3,T75,F8.3)") & + iatom, element_symbol, coef, & + cp_unit_from_cp2k(dft_control%qs_control%becke_control%cutoffs(iatom), "angstrom"), & + ircov + END DO + ELSE + WRITE (iw, '(/,T3,A,A)') & + 'Atom Element Coefficient', ' Cutoff (angstrom)' + DO iatom = 1, natom + CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, & + element_symbol=element_symbol) + IF (is_constraint(iatom)) THEN + coef = coefficients(iatom) + ELSE + coef = 0.0_dp + END IF + WRITE (iw, "(i7,T15,A2,T23,F8.3,T39,F8.3,T61,F8.3,T75)") & + iatom, element_symbol, coef, & + cp_unit_from_cp2k(dft_control%qs_control%becke_control%cutoffs(iatom), "angstrom") + END DO + END IF + WRITE (iw, '(/,T3,A)') & + '-----------------------------------------------------------------------------------' + END IF + dft_control%qs_control%becke_control%first_iteration = .FALSE. + END IF + ! Convert confinement bounds to RS grid indices + IF (dft_control%qs_control%becke_control%dynamic_confine .OR. & + dft_control%qs_control%becke_control%confine) THEN + tmp_const = (ub-shift(dir))/dr(dir) + IF (tmp_const .GE. 0.0_dp) THEN + ub_index = CEILING(tmp_const) + ELSE + ub_index = FLOOR(tmp_const) + END IF + tmp_const = (lb-shift(dir))/dr(dir) + IF (tmp_const .GE. 0.0_dp) THEN + lb_index = CEILING(tmp_const) + ELSE + lb_index = FLOOR(tmp_const) + END IF + ! Store confinement bound indices for use in force calculation + dft_control%qs_control%becke_control%confine_bounds_int(1) = lb_index + dft_control%qs_control%becke_control%confine_bounds_int(2) = ub_index + END IF + ! Setup cavity confinement using spherical Gaussians + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + cavity_env => dft_control%qs_control%becke_control%cavity_env + CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, pw_env=pw_env) + nkind = SIZE(qs_kind_set) + ! Setup Gaussian shape function + IF (.NOT. ASSOCIATED(cavity_env%kind_shape_fn)) & + CALL create_shape_function(cavity_env, qs_kind_set, atomic_kind_set, & + radius=dft_control%qs_control%becke_control%rcavity, & + radii_list=dft_control%qs_control%becke_control%radii) + ! Form cavity by summing isolated Gaussian densities over constraint atoms + NULLIFY (rs_cavity) + CALL pw_env_get(pw_env, auxbas_rs_grid=rs_cavity, & + auxbas_pw_pool=auxbas_pw_pool) + CALL rs_grid_retain(rs_cavity) + CALL rs_grid_zero(rs_cavity) + ALLOCATE (pab(1, 1)) + nthread = 1 + ithread = 0 + DO ikind = 1, SIZE(atomic_kind_set) + numexp = cavity_env%kind_shape_fn(ikind)%numexp + IF (numexp <= 0) CYCLE + CALL get_atomic_kind(atomic_kind_set(ikind), natom=katom, atom_list=atom_list) + ALLOCATE (cores(katom)) + DO iex = 1, numexp + alpha = cavity_env%kind_shape_fn(ikind)%zet(iex) + coef = cavity_env%kind_shape_fn(ikind)%coef(iex) + npme = 0 + cores = 0 + DO iatom = 1, katom + IF (rs_cavity%desc%parallel .AND. .NOT. rs_cavity%desc%distributed) THEN + ! replicated realspace grid, split the atoms up between procs + IF (MODULO(iatom, rs_cavity%desc%group_size) == rs_cavity%desc%my_pos) THEN + npme = npme+1 + cores(npme) = iatom + ENDIF + ELSE + npme = npme+1 + cores(npme) = iatom + ENDIF + END DO + DO j = 1, npme + iatom = cores(j) + atom_a = atom_list(iatom) + pab(1, 1) = coef + IF (store_vectors) THEN + ra(:) = position_vecs(:, atom_a)+cell_v(:)/2._dp + ELSE + ra(:) = pbc(particle_set(atom_a)%r, cell) + END IF + IF (is_constraint(atom_a)) & + CALL collocate_pgf_product_rspace(0, alpha, 0, 0, 0.0_dp, 0, ra, & + (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, 1.0_dp, & + pab, 0, 0, rs_cavity, cell, pw_env%cube_info(1), & + dft_control%qs_control%eps_rho_rspace, & + ga_gb_function=FUNC_AB, ithread=ithread, & + use_subpatch=.TRUE., subpatch_pattern=0_int_8, & + lmax_global=0) + END DO + END DO + DEALLOCATE (cores) + END DO + DEALLOCATE (pab) + + CALL pw_pool_create_pw(auxbas_pw_pool, dft_control%qs_control%becke_control%cavity%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + CALL rs_pw_transfer(rs_cavity, dft_control%qs_control%becke_control%cavity%pw, rs2pw) + CALL rs_grid_release(rs_cavity) + ! Ignore grid points where the Gaussian density falls below eps_cavity + IF ((in_memory .OR. dft_control%qs_control%becke_control%save_pot) .AND. & + .NOT. dft_control%qs_control%becke_control%dynamic_confine) THEN + CALL hfun_zero(dft_control%qs_control%becke_control%cavity%pw%cr3d, & + eps_cavity, just_bounds=.TRUE., bounds=bounds) + dft_control%qs_control%becke_control%confine_bounds_int(1) = bounds(1) + dft_control%qs_control%becke_control%confine_bounds_int(2) = bounds(2) + END IF + ! Optional printing of cavity (meant for testing, so options currently hardcoded...) + IF (dft_control%qs_control%becke_control%print_cavity) THEN + CALL hfun_zero(dft_control%qs_control%becke_control%cavity%pw%cr3d, & + eps_cavity, just_bounds=.FALSE.) + NULLIFY (stride, subsys, particles) + ALLOCATE (stride(3)) + stride = (/2, 2, 2/) + ! Note PROGRAM_RUN_INFO section neeeds to be active! + unit_nr = cp_print_key_unit_nr(logger, becke_restraint_section, "PROGRAM_RUN_INFO", & + middle_name="BECKE_CAVITY", & + extension=".cube", file_position="REWIND", & + log_filename=.FALSE.) + IF (para_env%mepos == para_env%source .AND. unit_nr .LT. 1) & + CALL cp_abort(__LOCATION__, & + "Please turn on PROGRAM_RUN_INFO to print cavity") + CALL get_qs_env(qs_env, subsys=subsys) + CALL qs_subsys_get(subsys, particles=particles) + CALL cp_pw_to_cube(dft_control%qs_control%becke_control%cavity%pw, & + unit_nr, "CAVITY", particles=particles, & + stride=stride) + DEALLOCATE (stride) + END IF + END IF + ! If requested, allocate storage for gradients + IF (in_memory) THEN + bo_conf = bo + ! With confinement active, we dont need to store gradients outside + ! the confinement bounds since they vanish for all particles + IF (dft_control%qs_control%becke_control%dynamic_confine .OR. & + dft_control%qs_control%becke_control%confine) THEN + ! Ensure bounds are within local grid bounds + IF (ub_index .GT. bo(2, dir)) THEN + tmp_index(2) = bo(2, dir)-1 + ELSE + tmp_index(2) = ub_index-1 + END IF + IF (lb_index .LT. bo(1, dir)) THEN + tmp_index(1) = bo(1, dir)+1 + ELSE + tmp_index(1) = lb_index+1 + END IF + bo_conf(2, dir) = tmp_index(2) + bo_conf(1, dir) = tmp_index(1) + ELSE IF (dft_control%qs_control%becke_control%cavity_confine) THEN + IF (bounds(2) .LT. bo(2, 3)) bo_conf(2, 3) = bounds(2)-1 + IF (bounds(1) .GT. bo(1, 3)) bo_conf(1, 3) = bounds(1)+1 + END IF + ALLOCATE (dft_control%qs_control%becke_control%gradients(3*natom*ngrad, bo_conf(1, 1):bo_conf(2, 1), & + bo_conf(1, 2):bo_conf(2, 2), & + bo_conf(1, 3):bo_conf(2, 3))) + gradients => dft_control%qs_control%becke_control%gradients + gradients = 0.0_dp + ! If requested, store skipped grid points that were not handled by confinement + IF (dft_control%qs_control%becke_control%should_skip .AND. .NOT. & + dft_control%qs_control%becke_control%cavity_confine) THEN + ! With cavity confine, we use the cavity to store these values and dont need this array + ALLOCATE (dft_control%qs_control%becke_control%skip_list(bo_conf(1, 1):bo_conf(2, 1), & + bo_conf(1, 2):bo_conf(2, 2)+1, & + bo_conf(1, 3):bo_conf(2, 3))) + dft_control%qs_control%becke_control%skip_list = .FALSE. + END IF + END IF + ! Combined weight: allocate storage for the spin weight function + IF (dft_control%qs_control%becke_control%constraint_type == cdft_combined_constraint) THEN + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ! Pass. Charge and spin constraints share same weight + CASE (cdft_combined_acceptor, cdft_combined_donor) + ALLOCATE (is_combined(natom)) + is_combined = .FALSE. + NULLIFY (pw_env, auxbas_pw_pool) + CALL get_qs_env(qs_env, pw_env=pw_env) + CALL pw_env_get(pw_env, auxbas_rs_grid=rs_cavity, & + auxbas_pw_pool=auxbas_pw_pool) + CALL pw_pool_create_pw(auxbas_pw_pool, dft_control%qs_control%becke_control%combined_weight%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + dft_control%qs_control%becke_control%combined_weight%pw%cr3d = 0.0_dp + DO iatom = 1, dft_control%qs_control%becke_control%natoms + IF (dft_control%qs_control%becke_control%combined_type == cdft_combined_acceptor .AND. & + dft_control%qs_control%becke_control%coeff(iatom) == -1.0_dp) THEN + is_combined(catom(iatom)) = .TRUE. + ELSE IF (dft_control%qs_control%becke_control%combined_type == cdft_combined_donor .AND. & + dft_control%qs_control%becke_control%coeff(iatom) == +1.0_dp) THEN + is_combined(catom(iatom)) = .TRUE. + END IF + END DO + END SELECT + END IF + ! Calculate weight and possibly the gradient DO k = bo(1, 1), bo(2, 1) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 3), bo(2, 3) + ! If the grid point is too far from all constraint atoms and any confinement method is active, + ! we can skip this grid point as it does not contribute to the weight or gradients + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + IF (dft_control%qs_control%becke_control%cavity%pw%cr3d(k, j, i) < eps_cavity) CYCLE + END IF + ind = (/k, j, i/) + IF (dft_control%qs_control%becke_control%confine .OR. & + dft_control%qs_control%becke_control%dynamic_confine) THEN + IF (ind(dir) .LE. lb_index .OR. ind(dir) .GE. ub_index) CYCLE + END IF grid_p(1) = k*dr(1)+shift(1) grid_p(2) = j*dr(2)+shift(2) grid_p(3) = i*dr(3)+shift(3) - + nskipped = 0 cell_functions = 1.0_dp - DO iatom = 1, SIZE(particle_set) - r = particle_set(iatom)%r - DO ip = 1, 3 - r(ip) = MODULO(r(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp - END DO - dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v - dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) - IF (dist1 .LE. 6.0_dp) THEN - DO jatom = 1, SIZE(particle_set) - IF (jatom .NE. iatom) THEN - r1 = particle_set(jatom)%r - DO ip = 1, 3 - r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp - END DO - dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v - dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) - my1 = (dist1-dist2)/R12(iatom, jatom) - myexp = 1.5_dp*my1-0.5_dp*my1**3 - myexp = 1.5_dp*myexp-0.5_dp*myexp**3 - myexp = 1.5_dp*myexp-0.5_dp*myexp**3 - cell_functions(iatom) = cell_functions(iatom)*0.5_dp*(1-myexp) + skip_me = .FALSE. + IF (store_vectors) distances = 0.0_dp + IF (in_memory) THEN + d_sum_Pm_dR = 0.0_dp + d_sum_const_dR = 0.0_dp + dP_i_dRi = 0.0_dp + END IF + ! Iterate over all atoms in the system + DO iatom = 1, natom + IF (skip_me(iatom)) THEN + cell_functions(iatom) = 0.0_dp + IF (dft_control%qs_control%becke_control%should_skip) THEN + IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (nskipped == dft_control%qs_control%becke_control%natoms) THEN + IF (in_memory) THEN + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + dft_control%qs_control%becke_control%cavity%pw%cr3d(k, j, i) = 0.0_dp + ELSE + dft_control%qs_control%becke_control%skip_list(k, j, i) = .TRUE. + END IF + END IF + EXIT + END IF + END IF + CYCLE + END IF + IF (store_vectors) THEN + IF (distances(iatom) .EQ. 0.0_dp) THEN + r = position_vecs(:, iatom) + dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + distance_vecs(:, iatom) = dist_vec + distances(iatom) = dist1 + ELSE + dist_vec = distance_vecs(:, iatom) + dist1 = distances(iatom) END IF - END DO ELSE - cell_functions(iatom) = 0.0_dp + r = particle_set(iatom)%r + DO ip = 1, 3 + r(ip) = MODULO(r(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + END DO + dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + END IF + IF (dist1 .LE. cutoffs(iatom)) THEN + IF (in_memory) THEN + IF (dist1 .LE. th) dist1 = th + dr_i_dR(:) = dist_vec(:)/dist1 + END IF + DO jatom = 1, natom + IF (jatom .NE. iatom) THEN + ! Using pairwise symmetry, execute block only for such jjatom + IF (jatom < iatom) THEN + IF (.NOT. skip_me(jatom)) CYCLE + END IF + IF (store_vectors) THEN + IF (distances(jatom) .EQ. 0.0_dp) THEN + r1 = position_vecs(:, jatom) + dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + distance_vecs(:, jatom) = dist_vec + distances(jatom) = dist2 + ELSE + dist_vec = distance_vecs(:, jatom) + dist2 = distances(jatom) + END IF + ELSE + r1 = particle_set(jatom)%r + DO ip = 1, 3 + r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + END DO + dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + END IF + IF (in_memory) THEN + IF (store_vectors) THEN + dr1_r2 = pair_dist_vecs(:, iatom, jatom) + ELSE + dr1_r2 = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + END IF + IF (dist2 .LE. th) dist2 = th + tmp_const = (R12(iatom, jatom)**3) + dr_ij_dR(:) = dr1_r2(:)/tmp_const + + !derivative w.r.t. Rj + dr_j_dR = dist_vec(:)/dist2 + + dmy_dR_j(:) = -(dr_j_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:)) + + !derivative w.r.t. Ri + dmy_dR_i(:) = dr_i_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:) + END IF + + my1 = (dist1-dist2)/R12(iatom, jatom) + + IF (dft_control%qs_control%becke_control%adjust) THEN + my1_homo = my1 ! Homonuclear quantity needed for gradient + my1 = my1+ & + dft_control%qs_control%becke_control%aij(iatom, jatom)*(1.0_dp-my1**2) + END IF + myexp = 1.5_dp*my1-0.5_dp*my1**3 + + IF (in_memory) THEN + dmyexp = 1.5_dp-1.5_dp*my1**2 + tmp_const = (1.5_dp**2)*dmyexp*(1-myexp**2)* & + (1.0_dp-((1.5_dp*myexp-0.5_dp*(myexp**3))**2)) + + ds_dR_i(:) = -0.5_dp*tmp_const*dmy_dR_i(:) ! d s(myij)/d R_i + ds_dR_j(:) = -0.5_dp*tmp_const*dmy_dR_j(:) ! d s(myij)/d R_j + + IF (dft_control%qs_control%becke_control%adjust) THEN + tmp_const = 1.0_dp-2.0_dp*my1_homo* & + dft_control%qs_control%becke_control%aij(iatom, jatom) + ds_dR_i(:) = ds_dR_i(:)*tmp_const + ! tmp_const is same for both since aij=-aji and myij=-myji + ds_dR_j(:) = ds_dR_j(:)*tmp_const + END IF + END IF + + myexp = 1.5_dp*myexp-0.5_dp*myexp**3 + myexp = 1.5_dp*myexp-0.5_dp*myexp**3 + tmp_const = 0.5_dp*(1.0_dp-myexp) ! s(myij) + cell_functions(iatom) = cell_functions(iatom)*tmp_const + IF (in_memory) THEN + IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const+th + ! P_i independent part of dP_i/dR_i + dP_i_dRi(:, iatom) = dP_i_dRi(:, iatom)+ds_dR_i(:)/tmp_const + ! P_i independent part of dP_i/dR_j + dP_i_dRj(:, iatom, jatom) = ds_dR_j(:)/tmp_const + END IF + + IF (dist2 .LE. cutoffs(jatom)) THEN + tmp_const = 0.5_dp*(1.0_dp+myexp) ! s(myji) + cell_functions(jatom) = cell_functions(jatom)*tmp_const + IF (in_memory) THEN + IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const+th + ! P_j independent part of dP_j/dR_i + ! d s(myji)/d R_i = -d s(myij)/d R_i + dP_i_dRj(:, jatom, iatom) = -ds_dR_i(:)/tmp_const + ! P_j independent part of dP_j/dR_j + ! d s(myji)/d R_j = -d s(myij)/d R_j + dP_i_dRi(:, jatom) = dP_i_dRi(:, jatom)-ds_dR_j(:)/tmp_const + END IF + ELSE + skip_me(jatom) = .TRUE. + END IF + END IF + END DO ! jatom + IF (in_memory) THEN + dP_i_dRi(:, iatom) = cell_functions(iatom)*dP_i_dRi(:, iatom) + d_sum_Pm_dR(:, iatom) = d_sum_Pm_dR(:, iatom)+dP_i_dRi(:, iatom) + IF (is_constraint(iatom)) & + d_sum_const_dR(1:3, iatom) = d_sum_const_dR(1:3, iatom)+dP_i_dRi(:, iatom)* & + coefficients(iatom) + IF (ngrad == 2) THEN + IF (is_combined(iatom)) d_sum_const_dR(4:6, iatom) = d_sum_const_dR(4:6, iatom) & + +dP_i_dRi(:, iatom) + END IF + DO jatom = 1, natom + IF (jatom .NE. iatom) THEN + IF (jatom < iatom) THEN + IF (.NOT. skip_me(jatom)) THEN + dP_i_dRj(:, iatom, jatom) = cell_functions(iatom)*dP_i_dRj(:, iatom, jatom) + d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) + IF (is_constraint(iatom)) & + d_sum_const_dR(1:3, jatom) = d_sum_const_dR(1:3, jatom)+ & + dP_i_dRj(:, iatom, jatom)* & + coefficients(iatom) + IF (ngrad == 2) THEN + IF (is_combined(iatom)) d_sum_const_dR(4:6, jatom) = & + d_sum_const_dR(4:6, jatom) & + +dP_i_dRj(:, iatom, jatom) + END IF + CYCLE + END IF + END IF + dP_i_dRj(:, iatom, jatom) = cell_functions(iatom)*dP_i_dRj(:, iatom, jatom) + d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) + IF (is_constraint(iatom)) & + d_sum_const_dR(1:3, jatom) = d_sum_const_dR(1:3, jatom)+ & + dP_i_dRj(:, iatom, jatom)* & + coefficients(iatom) + IF (ngrad == 2) THEN + IF (is_combined(iatom)) d_sum_const_dR(4:6, jatom) = d_sum_const_dR(4:6, jatom) & + +dP_i_dRj(:, iatom, jatom) + END IF + END IF + END DO + END IF + ELSE + cell_functions(iatom) = 0.0_dp + skip_me(iatom) = .TRUE. + IF (dft_control%qs_control%becke_control%should_skip) THEN + IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (nskipped == dft_control%qs_control%becke_control%natoms) THEN + IF (in_memory) THEN + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + dft_control%qs_control%becke_control%cavity%pw%cr3d(k, j, i) = 0.0_dp + ELSE + dft_control%qs_control%becke_control%skip_list(k, j, i) = .TRUE. + END IF + END IF + EXIT + END IF + END IF + END IF + END DO !iatom + IF (nskipped == dft_control%qs_control%becke_control%natoms) CYCLE + sum_cell_f_constr = 0.0_dp + sum_cell_f_combined = 0.0_dp + DO ip = 1, dft_control%qs_control%becke_control%natoms + sum_cell_f_constr = sum_cell_f_constr+cell_functions(catom(ip))* & + dft_control%qs_control%becke_control%coeff(ip) + IF (ngrad == 2) THEN + ! The coeff is implicitly 1.0 + IF (is_combined(catom(ip))) & + sum_cell_f_combined = sum_cell_f_combined+cell_functions(catom(ip)) END IF END DO - sum_cell_f_constr = 0.0_dp - DO ip = 1, dft_control%qs_control%becke_control%natoms - sum_cell_f_constr = sum_cell_f_constr+cell_functions(catom(ip))*coeff(ip) - END DO - sum_cell_f_all = 0.0_dp - DO ip = 1, SIZE(particle_set) + DO ip = 1, natom sum_cell_f_all = sum_cell_f_all+cell_functions(ip) END DO - IF (ABS(sum_cell_f_all) .LE. 0.000001) THEN - becke_const%pw%cr3d(k, j, i) = 0.0_dp - ELSE - becke_const%pw%cr3d(k, j, i) = sum_cell_f_constr/sum_cell_f_all + ! Gradients at (k,j,i) + IF (in_memory .AND. ABS(sum_cell_f_all) .GT. 0.0_dp) THEN + DO iatom = 1, natom + gradients(3*(iatom-1)+1:3*(iatom-1)+3, k, j, i) = & + d_sum_const_dR(1:3, iatom)/sum_cell_f_all-sum_cell_f_constr* & + d_sum_Pm_dR(1:3, iatom)/(sum_cell_f_all**2) + IF (ngrad == 2) THEN + gradients(3*(iatom-1)+1+natom:3*(iatom-1)+3+natom, k, j, i) = & + d_sum_const_dR(4:6, iatom)/sum_cell_f_all-sum_cell_f_constr* & + d_sum_Pm_dR(1:3, iatom)/(sum_cell_f_all**2) + END IF + END DO + END IF + ! Weight function at (k,j,i) + IF (ABS(sum_cell_f_all) .GT. 0.000001) THEN + becke_const%pw%cr3d(k, j, i) = sum_cell_f_constr/sum_cell_f_all + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + DO iatom = 1, dft_control%qs_control%becke_control%natoms + charge(iatom)%pw%cr3d(k, j, i) = cell_functions(catom(iatom))/sum_cell_f_all + END DO + END IF + IF (ngrad == 2) THEN + dft_control%qs_control%becke_control%combined_weight%pw%cr3d(k, j, i) = sum_cell_f_combined/ & + sum_cell_f_all + END IF END IF - END DO END DO END DO - + ! Release storage + IF (ALLOCATED(coefficients)) & + DEALLOCATE (coefficients) + IF (in_memory) THEN + DEALLOCATE (ds_dR_j) + DEALLOCATE (ds_dR_i) + DEALLOCATE (d_sum_Pm_dR) + DEALLOCATE (d_sum_const_dR) + DEALLOCATE (dP_i_dRj) + DEALLOCATE (dP_i_dRi) + NULLIFY (gradients) + IF (store_vectors) THEN + DEALLOCATE (pair_dist_vecs) + END IF + END IF + NULLIFY (cutoffs) + IF (ALLOCATED(is_constraint)) & + DEALLOCATE (is_constraint) DEALLOCATE (catom) DEALLOCATE (R12) DEALLOCATE (cell_functions) - + DEALLOCATE (skip_me) + IF (store_vectors) THEN + DEALLOCATE (distances) + DEALLOCATE (distance_vecs) + DEALLOCATE (position_vecs) + END IF + IF (ALLOCATED(is_combined)) DEALLOCATE (is_combined) END IF - - dE = 0.0_dp + bo = becke_const%pw%pw_grid%bounds_local + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + ALLOCATE (electronic_charge(dft_control%qs_control%becke_control%natoms, dft_control%nspins)) + electronic_charge = 0.0_dp + END IF + ! Calculate value of constraint i.e. int ( rho(r) w(r) dr) DO i = 1, dft_control%nspins - dE = dE+accurate_sum(becke_const%pw%cr3d*rho_r(i)%pw%cr3d)*dvol + DO ivar = 1, nvar + ! With external control, we can use cavity_mat as a mask to kahan sum + IF (dft_control%qs_control%becke_control%external_control .AND. & + dft_control%qs_control%becke_control%cavity_confine) THEN + IF (ivar == 2) THEN + sign = 1.0_dp + IF (i == 2) sign = -1.0_dp + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + dE(ivar) = dE(ivar)+ & + sign*accurate_sum_arrays_product(becke_const%pw%cr3d, rho_r(i)%pw%cr3d, & + dft_control%qs_control%becke_control%cavity_mat, & + eps_cavity)*dvol + CASE (cdft_combined_donor, cdft_combined_acceptor) + ! Transfer spin constraint weight truncated real-3D matrix -> pw%cr3d + IF (ASSOCIATED(dft_control%qs_control%becke_control%combined_mat)) THEN + NULLIFY (pw_env, auxbas_pw_pool) + CALL get_qs_env(qs_env, pw_env=pw_env) + CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) + CALL pw_pool_create_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%combined_weight%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + dft_control%qs_control%becke_control%combined_weight%pw%cr3d = 0.0_dp + CALL pw_set(dft_control%qs_control%becke_control%combined_weight%pw, & + dft_control%qs_control%becke_control%combined_mat) + DEALLOCATE (dft_control%qs_control%becke_control%combined_mat) + END IF + dE(ivar) = dE(ivar)+sign* & + accurate_sum_arrays_product(dft_control%qs_control%becke_control% & + combined_weight%pw%cr3d, & + rho_r(i)%pw%cr3d, & + dft_control%qs_control%becke_control%cavity_mat, & + eps_cavity)*dvol + END SELECT + ELSE + sign = 1.0_dp + ! Note the negative sign for beta spin if spin constraint is active + IF (dft_control%qs_control%becke_control%constraint_type == & + cdft_magnetization_constraint .AND. i == 2) sign = -1.0_dp + dE(ivar) = dE(ivar)+sign* & + accurate_sum_arrays_product(becke_const%pw%cr3d, rho_r(i)%pw%cr3d, & + dft_control%qs_control%becke_control%cavity_mat, & + eps_cavity)*dvol + END IF + ELSE + IF (ivar == 2) THEN + sign = 1.0_dp + IF (i == 2) sign = -1.0_dp + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + dE(ivar) = dE(ivar)+sign*accurate_sum(becke_const%pw%cr3d*rho_r(i)%pw%cr3d)*dvol + CASE (cdft_combined_donor, cdft_combined_acceptor) + dE(ivar) = dE(ivar)+sign* & + accurate_sum(dft_control%qs_control%becke_control%combined_weight%pw%cr3d* & + rho_r(i)%pw%cr3d)*dvol + END SELECT + ELSE + sign = 1.0_dp + ! Note the negative sign for beta spin if spin constraint is active + IF (dft_control%qs_control%becke_control%constraint_type == & + cdft_magnetization_constraint .AND. i == 2) sign = -1.0_dp + dE(ivar) = dE(ivar)+sign*accurate_sum(becke_const%pw%cr3d*rho_r(i)%pw%cr3d)*dvol + END IF + END IF + END DO + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + DO iatom = 1, dft_control%qs_control%becke_control%natoms + electronic_charge(iatom, i) = accurate_sum(charge(iatom)%pw%cr3d*rho_r(i)%pw%cr3d)*dvol + END DO + END IF END DO CALL get_qs_env(qs_env, energy=energy) CALL mp_sum(dE, para_env%group) - dft_control%qs_control%becke_control%becke_order_p = dE - energy%becke = (dE-target_val)*strength + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + CALL mp_sum(electronic_charge, para_env%group) + END IF + ! Use fragment densities as reference value (= Becke deformation density) + IF (dft_control%qs_control%becke_control%fragment_density) THEN + ! Fragment densities are meaningful only for some calculation types + IF (.NOT. qs_env%single_point_run) & + CALL cp_abort(__LOCATION__, & + "Becke deformation density only compatible with single "// & + "point calculations (run_type ENERGY or ENERGY_FORCE).") + IF (dft_control%qs_control%gapw) & + CALL cp_abort(__LOCATION__, & + "Becke deformation density not compatible with GAPW.") + SELECT CASE (dft_control%qs_control%becke_control%constraint_type) + CASE (cdft_density_constraint) + ! Pass + CASE (cdft_magnetization_constraint) + CALL cp_abort(__LOCATION__, & + "Becke deformation density not yet compatible with magnetization density constraint.") + CASE (cdft_combined_constraint) + CALL cp_abort(__LOCATION__, & + "Becke deformation density not yet compatible with combined charge+spin constraint.") + END SELECT + IF (.NOT. dft_control%qs_control%becke_control%fragments_integrated) THEN + ALLOCATE (dft_control%qs_control%becke_control%fragments(2)) + CALL get_qs_env(qs_env, pw_env=pw_env) + CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) + ! Read fragment reference densities (total density => no spin density data) + ! This step can be very slow if the rs_grid is dense + CALL pw_pool_create_pw(auxbas_pw_pool, dft_control%qs_control%becke_control%fragments(1)%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + CALL cube_to_pw(dft_control%qs_control%becke_control%fragments(1)%pw, & + dft_control%qs_control%becke_control%fragment_a_fname, 1.0_dp) + CALL pw_pool_create_pw(auxbas_pw_pool, dft_control%qs_control%becke_control%fragments(2)%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + CALL cube_to_pw(dft_control%qs_control%becke_control%fragments(2)%pw, & + dft_control%qs_control%becke_control%fragment_b_fname, 1.0_dp) + ! Sum up fragments + CALL pw_pool_create_pw(auxbas_pw_pool, rho_frag%pw, use_data=REALDATA3D, & + in_space=REALSPACE) + CALL pw_copy(dft_control%qs_control%becke_control%fragments(1)%pw, rho_frag%pw) + CALL pw_axpy(dft_control%qs_control%becke_control%fragments(2)%pw, rho_frag%pw, 1.0_dp) + CALL pw_pool_give_back_pw(auxbas_pw_pool, dft_control%qs_control%becke_control%fragments(1)%pw) + CALL pw_pool_give_back_pw(auxbas_pw_pool, dft_control%qs_control%becke_control%fragments(2)%pw) + DEALLOCATE (dft_control%qs_control%becke_control%fragments) + ! Check that the number of electrons is consistent + CALL get_qs_env(qs_env, subsys=subsys) + CALL qs_subsys_get(subsys, nelectron_total=nelectron_total) + nelectron_frag = pw_integrate_function(rho_frag%pw) + IF (NINT(nelectron_frag) /= nelectron_total) & + CALL cp_abort(__LOCATION__, & + "The number of electrons in the reference and interacting "// & + " configurations does not match. Check your fragment cube files.") + ! Update constraint target value i.e. perform integration w*rho_frag*dr + ! Note, we assume the weight w is defined only on one of the fragments + dft_control%qs_control%becke_control%target = 0.0_dp + IF (ANY(dft_control%qs_control%becke_control%coeff .NE. 1.0_dp)) & + CALL cp_abort(__LOCATION__, & + "Absolute weight required for Becke deformation density.") + IF (dft_control%qs_control%becke_control%external_control .AND. & + dft_control%qs_control%becke_control%cavity_confine) THEN + dft_control%qs_control%becke_control%target(1) = & + dft_control%qs_control%becke_control%target(1)+ & + accurate_sum_arrays_product(becke_const%pw%cr3d, rho_frag%pw%cr3d, & + dft_control%qs_control%becke_control%cavity_mat, eps_cavity)*dvol + ELSE + dft_control%qs_control%becke_control%target(1) = & + dft_control%qs_control%becke_control%target(1)+ & + accurate_sum(becke_const%pw%cr3d*rho_frag%pw%cr3d)*dvol + END IF + CALL mp_sum(dft_control%qs_control%becke_control%target, para_env%group) + IF (debug_this_module) THEN + ALLOCATE (stride(3)) + stride = (/1, 1, 1/) + unit_nr = cp_print_key_unit_nr(logger, becke_restraint_section, "PROGRAM_RUN_INFO", & + middle_name="BECKE_WEIGHT", & + extension=".cube", file_position="REWIND", & + log_filename=.FALSE.) + CALL get_qs_env(qs_env, subsys=subsys) + CALL qs_subsys_get(subsys, particles=particles) + CALL cp_pw_to_cube(becke_const%pw, & + unit_nr, "BECKE_WEIGHT", particles=particles, & + stride=stride) + unit_nr = cp_print_key_unit_nr(logger, becke_restraint_section, "PROGRAM_RUN_INFO", & + middle_name="FRAG_DENS", & + extension=".cube", file_position="REWIND", & + log_filename=.FALSE.) + CALL cp_pw_to_cube(rho_frag%pw, & + unit_nr, "FRAG_DENS", particles=particles, & + stride=stride) + DEALLOCATE (stride) + END IF + ! Calculate reference atomic charges int( w_i * rho_frag * dr ) + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + ALLOCATE (dft_control%qs_control%becke_control% & + charges_fragment(dft_control%qs_control%becke_control%natoms)) + DO iatom = 1, dft_control%qs_control%becke_control%natoms + dft_control%qs_control%becke_control%charges_fragment(iatom) = & + accurate_sum(charge(iatom)%pw%cr3d*rho_frag%pw%cr3d)*dvol + END DO + CALL mp_sum(dft_control%qs_control%becke_control%charges_fragment, para_env%group) + END IF + CALL pw_pool_give_back_pw(auxbas_pw_pool, rho_frag%pw) + target_val(:) = dft_control%qs_control%becke_control%target(:) + IF (dft_control%qs_control%cdft) dft_control%qs_control%cdft_control%target = target_val + dft_control%qs_control%becke_control%fragments_integrated = .TRUE. + END IF + END IF + IF (dft_control%qs_control%gapw) THEN + ! GAPW: add core charges (rho_hard - rho_soft) + IF (dft_control%nspins == 2 .AND. nvar == 2) THEN + ALLOCATE (gapw_offset(dft_control%nspins+nvar)) + ELSE + ALLOCATE (gapw_offset(dft_control%nspins)) + END IF + gapw_offset = 0.0_dp + CALL get_qs_env(qs_env, rho0_mpole=rho0_mpole) + CALL get_rho0_mpole(rho0_mpole, mp_rho=mp_rho) + DO iatom = 1, dft_control%qs_control%becke_control%natoms + jatom = dft_control%qs_control%becke_control%atoms(iatom) + CALL get_atomic_kind(particle_set(jatom)%atomic_kind, kind_number=ikind) + CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom) + IF (paw_atom) THEN + DO i = 1, dft_control%nspins + gapw_offset(i) = gapw_offset(i)+ & + dft_control%qs_control%becke_control%coeff(iatom)*mp_rho(jatom)%q0(i) + IF (nvar == 2 .AND. is_combined(jatom)) THEN + sign = 1.0_dp + IF (i == 2) sign = -1.0_dp + gapw_offset(i+nvar) = gapw_offset(i+nvar)+sign*mp_rho(jatom)%q0(i) + END IF + IF (dft_control%qs_control%becke_control%atomic_charges) & + electronic_charge(iatom, i) = electronic_charge(iatom, i)+mp_rho(jatom)%q0(i) + END DO + END IF + END DO + DO i = 1, dft_control%nspins + DO ivar = 1, nvar + IF (dft_control%qs_control%becke_control%constraint_type == & + cdft_magnetization_constraint .AND. i == 2) THEN + dE(ivar) = dE(ivar)-gapw_offset(i) + ELSE IF (ivar == 2) THEN + dE(ivar) = dE(ivar)+gapw_offset(i+nvar) + ELSE + dE(ivar) = dE(ivar)+gapw_offset(i) + END IF + END DO + END DO + DEALLOCATE (gapw_offset) + END IF + + dft_control%qs_control%becke_control%becke_order_p(:) = dE(:) + energy%becke = 0.0_dp + DO ivar = 1, nvar + energy%becke = energy%becke+(dE(ivar)-target_val(ivar))*strength(ivar) + END DO + + IF (dft_control%qs_control%cdft) & + dft_control%qs_control%cdft_control%value(:) = dE(:) + + IF (iw > 0) THEN + WRITE (iw, '(/,T3,A,T60)') & + '--------------------- Becke constraint information ---------------------' + SELECT CASE (dft_control%qs_control%becke_control%constraint_type) + CASE (cdft_density_constraint, cdft_magnetization_constraint) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Target value of constraint :', target_val(1) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Current value of constraint :', dE(1) + WRITE (iw, '(T3,A,T59,(3X,ES13.3))') & + 'Deviation from target :', ABS(dE(1)-target_val(1)) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Strength of constraint :', strength(1) + CASE (cdft_combined_constraint) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Target value of charge constraint :', target_val(1) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Target value of spin constraint :', target_val(2) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Current value of charge constraint:', dE(1) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Current value of spin constraint :', dE(2) + WRITE (iw, '(T3,A,T59,(3X,ES13.3))') & + 'Deviation from target (charge) :', ABS(dE(1)-target_val(1)) + WRITE (iw, '(T3,A,T59,(3X,ES13.3))') & + 'Deviation from target (spin) :', ABS(dE(2)-target_val(2)) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Strength of constraint (charge) :', strength(1) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Strength of constraint (spin) :', strength(2) + END SELECT + WRITE (iw, '(T3,A)') & + '------------------------------------------------------------------------' + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + WRITE (iw, '(/,T3,A,T60)') & + '-------------------------------- Becke atomic charges -------------------------------' + IF (.NOT. dft_control%qs_control%becke_control%fragment_density) THEN + IF (dft_control%nspins == 1) THEN + WRITE (iw, '(/,T3,A,A)') & + '#Atom Element Coefficient', ' Core charge Population (total)'// & + ' Net charge' + tc = 0.0_dp + DO iatom = 1, dft_control%qs_control%becke_control%natoms + jatom = dft_control%qs_control%becke_control%atoms(iatom) + CALL get_atomic_kind(atomic_kind=particle_set(jatom)%atomic_kind, & + element_symbol=element_symbol, & + kind_number=ikind) + CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff) + WRITE (iw, "(i7,T15,A2,T23,F8.3,T39,F8.3,T61,F8.3,T75,F8.3)") & + jatom, element_symbol, & + dft_control%qs_control%becke_control%coeff(iatom), & + zeff, electronic_charge(iatom, 1), & + (zeff-electronic_charge(iatom, 1)) + tc = tc+(zeff-electronic_charge(iatom, 1)) + END DO + WRITE (iw, '(/,T3,A,T75,F8.3,/)') "Total Charge: ", tc + ELSE + WRITE (iw, '(/,T3,A,A)') & + '#Atom Element Coefficient', ' Core charge Population (alpha, beta)'// & + ' Net charge' + tc = 0.0_dp + DO iatom = 1, dft_control%qs_control%becke_control%natoms + jatom = dft_control%qs_control%becke_control%atoms(iatom) + CALL get_atomic_kind(atomic_kind=particle_set(jatom)%atomic_kind, & + element_symbol=element_symbol, & + kind_number=ikind) + CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff) + WRITE (iw, "(i7,T15,A2,T23,F8.3,T39,F8.3,T53,F8.3,T63,F8.3,T81,F8.3)") & + jatom, element_symbol, & + dft_control%qs_control%becke_control%coeff(iatom), & + zeff, electronic_charge(iatom, 1), electronic_charge(iatom, 2), & + (zeff-electronic_charge(iatom, 1)-electronic_charge(iatom, 2)) + tc = tc+(zeff-electronic_charge(iatom, 1)-electronic_charge(iatom, 2)) + END DO + WRITE (iw, '(/,T3,A,T81,F8.3,/)') "Total Charge: ", tc + END IF + ELSE + WRITE (iw, '(/,T3,A,A)') & + '#Atom Element Coefficient', ' Fragment charge Population (total)'// & + ' Net charge' + tc = 0.0_dp + DO iatom = 1, dft_control%qs_control%becke_control%natoms + jatom = dft_control%qs_control%becke_control%atoms(iatom) + CALL get_atomic_kind(atomic_kind=particle_set(jatom)%atomic_kind, & + element_symbol=element_symbol, & + kind_number=ikind) + IF (dft_control%nspins == 1) THEN + WRITE (iw, "(i7,T15,A2,T23,F8.3,T39,F8.3,T61,F8.3,T75,F8.3)") & + jatom, element_symbol, & + dft_control%qs_control%becke_control%coeff(iatom), & + dft_control%qs_control%becke_control%charges_fragment(iatom), & + electronic_charge(iatom, 1), & + (electronic_charge(iatom, 1)- & + dft_control%qs_control%becke_control%charges_fragment(iatom)) + tc = tc+(electronic_charge(iatom, 1)- & + dft_control%qs_control%becke_control%charges_fragment(iatom)) + ELSE + WRITE (iw, "(i7,T15,A2,T23,F8.3,T39,F8.3,T61,F8.3,T75,F8.3)") & + jatom, element_symbol, & + dft_control%qs_control%becke_control%coeff(iatom), & + dft_control%qs_control%becke_control%charges_fragment(iatom), & + electronic_charge(iatom, 1)+electronic_charge(iatom, 2), & + (electronic_charge(iatom, 1)+electronic_charge(iatom, 2)- & + dft_control%qs_control%becke_control%charges_fragment(iatom)) + tc = tc+(electronic_charge(iatom, 1)+electronic_charge(iatom, 2)- & + dft_control%qs_control%becke_control%charges_fragment(iatom)) + END IF + END DO + WRITE (iw, '(/,T3,A,T75,F8.3,/)') "Total Charge: ", tc + END IF + END IF + END IF + DEALLOCATE (dE, strength, target_val) + + IF (dft_control%qs_control%becke_control%atomic_charges) & + DEALLOCATE (electronic_charge) + + CALL cp_print_key_finished_output(iw, logger, becke_restraint_section, & + "PROGRAM_RUN_INFO") IF (calculate_forces) CALL becke_force(qs_env, becke_const) END IF CALL timestop(handle) + END SUBROUTINE becke_restraint ! ************************************************************************************************** -!> \brief calculates a becke contraint forces -!> \param qs_env ... -!> \param becke_const ... -!> \author fschiff (01.2007) +!> \brief calculates Becke constraint gradients +!> \param qs_env the qs_env where to build the gradients +!> \param becke_const the Becke real space potential +!> \par History +!> Created 01.2007 [fschiff] +!> Extended functionality 12/15-12/16 [Nico Holmberg] ! ************************************************************************************************** SUBROUTINE becke_force(qs_env, becke_const) @@ -466,15 +1551,14 @@ CONTAINS CHARACTER(len=*), PARAMETER :: routineN = 'becke_force', routineP = moduleN//':'//routineN - INTEGER :: handle, i, iatom, ikind, ip, ispin, & - istat, j, jatom, k, natom, np(3) + INTEGER :: dir, handle, i, iatom, ikind, ind(3), ip, ispin, ivar, j, jatom, k, lb_index, & + natom, ngrad, np(3), nskipped, nvar, tmp_index(2), ub_index INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_of_kind, catom, kind_of - INTEGER, DIMENSION(2, 3) :: bo - LOGICAL, ALLOCATABLE, DIMENSION(:) :: is_constraint - REAL(kind=dp) :: dist1, dist2, dpolyn, dvol, f_3, my1, & - polyn, strength, sum_cell_f_constr, & - sum_Pm, target_val, th, tmp_const - REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: coefficients, P_i + INTEGER, DIMENSION(2, 3) :: bo, bo_conf + LOGICAL, ALLOCATABLE, DIMENSION(:) :: is_combined, is_constraint + REAL(kind=dp) :: dist1, dist2, dpolyn, dvol, eps_cavity, f_3, my1, my1_homo, polyn, sign, & + sum_cell_f_combined, sum_cell_f_constr, sum_Pm, th, tmp_const + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: coefficients, P_i, strength REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: d_sum_const_dR, d_sum_Pm_dR, dP_i_dRi, & dw_dR, integrated, R12, s_my_ij REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dP_i_dRj, ds_dR @@ -482,6 +1566,8 @@ CONTAINS dmy_dR_i, dmy_dR_j, dr, dr1_r2, & dr_i_dR, dr_ij_dR, dr_j_dR, grid_p, r, & r1, shift + REAL(KIND=dp), DIMENSION(:), POINTER :: cutoffs + REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: gradients TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(cell_type), POINTER :: cell TYPE(cp_para_env_type), POINTER :: para_env @@ -492,7 +1578,8 @@ CONTAINS TYPE(qs_rho_type), POINTER :: rho CALL timeset(routineN, handle) - NULLIFY (dft_control, cell, particle_set, para_env, rho_r) + NULLIFY (atomic_kind_set, cell, para_env, dft_control, particle_set, & + rho, rho_r, force, cutoffs) CALL get_qs_env(qs_env, & atomic_kind_set=atomic_kind_set, & @@ -503,35 +1590,29 @@ CONTAINS force=force, & dft_control=dft_control, & para_env=para_env) - CALL qs_rho_get(rho, rho_r=rho_r) th = 1.0e-8_dp IF (dft_control%qs_control%becke_restraint) THEN - - target_val = dft_control%qs_control%becke_control%TARGET - strength = dft_control%qs_control%becke_control%strength - - ALLOCATE (catom(dft_control%qs_control%becke_control%natoms), STAT=istat) - IF (istat /= 0) CALL stop_memory(routineN, moduleN, __LINE__, & - "catom", dp_size*dft_control%qs_control%becke_control%natoms) - ALLOCATE (is_constraint(natom)) - ALLOCATE (coefficients(natom)) - - is_constraint = .FALSE. - DO i = 1, dft_control%qs_control%becke_control%natoms - catom(i) = dft_control%qs_control%becke_control%atoms(i) - is_constraint(dft_control%qs_control%becke_control%atoms(i)) = .TRUE. - coefficients(catom(i)) = dft_control%qs_control%becke_control%coeff(i) - ENDDO - - ALLOCATE (atom_of_kind(natom), STAT=istat) - IF (istat /= 0) CALL stop_memory(routineN, moduleN, __LINE__, & - "atom_of_kind", natom*int_size) - - ALLOCATE (kind_of(natom), STAT=istat) - IF (istat /= 0) CALL stop_memory(routineN, moduleN, __LINE__, & - "kind_of", natom*int_size) + SELECT CASE (dft_control%qs_control%becke_control%constraint_type) + CASE (cdft_density_constraint, cdft_magnetization_constraint) + nvar = 1 + ngrad = 1 + CASE (cdft_combined_constraint) + nvar = 2 + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ngrad = 1 + CASE (cdft_combined_acceptor, cdft_combined_donor) + ngrad = 2 + END SELECT + END SELECT + ALLOCATE (strength(nvar)) + strength(:) = dft_control%qs_control%becke_control%strength(:) + cutoffs => dft_control%qs_control%becke_control%cutoffs + eps_cavity = dft_control%qs_control%becke_control%eps_cavity + ALLOCATE (atom_of_kind(natom)) + ALLOCATE (kind_of(natom)) CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & atom_of_kind=atom_of_kind, & @@ -543,188 +1624,1024 @@ CONTAINS dr = becke_const%pw%pw_grid%dr np = becke_const%pw%pw_grid%npts shift = -REAL(MODULO(np, 2), dp)*dr/2.0_dp - !calculate distances from target atom (only implemented for a diatomic system) + ALLOCATE (integrated(3*ngrad, natom)) - DO i = 1, 3 - cell_v(i) = cell%hmat(i, i) - END DO + IF (dft_control%qs_control%becke_control%confine .OR. & + dft_control%qs_control%becke_control%dynamic_confine) THEN + dir = dft_control%qs_control%becke_control%confine_dir + lb_index = dft_control%qs_control%becke_control%confine_bounds_int(1) + ub_index = dft_control%qs_control%becke_control%confine_bounds_int(2) + END IF - ALLOCATE (R12(natom, natom)) - ALLOCATE (s_my_ij(natom, natom)) - ALLOCATE (ds_dR(3, natom, natom)) - ALLOCATE (P_i(natom)) - ALLOCATE (dw_dR(3, natom)) - ALLOCATE (integrated(3, natom)) - ALLOCATE (d_sum_Pm_dR(3, natom)) - ALLOCATE (d_sum_const_dR(3, natom)) - ALLOCATE (dP_i_dRj(3, natom, natom)) - ALLOCATE (dP_i_dRi(3, natom)) - - DO iatom = 1, natom-1 - DO jatom = iatom+1, natom - r = particle_set(iatom)%r - r1 = particle_set(jatom)%r - DO i = 1, 3 - r(i) = MODULO(r(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp - r1(i) = MODULO(r1(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp - END DO - dist_vec_i = (r-r1)-ANINT((r-r1)/cell_v)*cell_v - R12(iatom, jatom) = SQRT(DOT_PRODUCT(dist_vec_i, dist_vec_i)) - R12(jatom, iatom) = R12(iatom, jatom) - END DO - END DO + IF (dft_control%qs_control%becke_control%in_memory) THEN + gradients => dft_control%qs_control%becke_control%gradients + bo_conf = bo + IF (dft_control%qs_control%becke_control%dynamic_confine .OR. & + dft_control%qs_control%becke_control%confine) THEN + IF (ub_index .GT. bo(2, dir)) THEN + tmp_index(2) = bo(2, dir)-1 + ELSE + tmp_index(2) = ub_index-1 + END IF + IF (lb_index .LT. bo(1, dir)) THEN + tmp_index(1) = bo(1, dir)+1 + ELSE + tmp_index(1) = lb_index+1 + END IF + bo_conf(2, dir) = tmp_index(2) + bo_conf(1, dir) = tmp_index(1) + ELSE IF (dft_control%qs_control%becke_control%cavity_confine) THEN + IF (dft_control%qs_control%becke_control%confine_bounds_int(2) .LT. bo(2, 3)) & + bo_conf(2, 3) = dft_control%qs_control%becke_control%confine_bounds_int(2)-1 + IF (dft_control%qs_control%becke_control%confine_bounds_int(1) .GT. bo(1, 3)) & + bo_conf(1, 3) = dft_control%qs_control%becke_control%confine_bounds_int(1)+1 + END IF + END IF integrated = 0.0_dp - DO k = bo(1, 1), bo(2, 1) - DO j = bo(1, 2), bo(2, 2) - DO i = bo(1, 3), bo(2, 3) - grid_p(1) = k*dr(1)+shift(1) - grid_p(2) = j*dr(2)+shift(2) - grid_p(3) = i*dr(3)+shift(3) - - d_sum_Pm_dR = 0.0_dp - d_sum_const_dR = 0.0_dp - P_i = 1.0_dp - dP_i_dRi = 0.0_dp - DO iatom = 1, natom - r = particle_set(iatom)%r - DO ip = 1, 3 - r(ip) = MODULO(r(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp - END DO - dist_vec_i = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v - dist1 = SQRT(DOT_PRODUCT(dist_vec_i, dist_vec_i)) - IF (dist1 .LE. 5.0_dp) THEN - IF (dist1 .LE. th) dist1 = th - dr_i_dR(:) = dist_vec_i(:)/dist1 -! IF(dist1.le.0.00001)dr_i_dR=0.0_dp - DO jatom = 1, natom - IF (jatom .NE. iatom) THEN - r1 = particle_set(jatom)%r - DO ip = 1, 3 - r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + IF (dft_control%qs_control%becke_control%in_memory) THEN + ! Gradients have been precomputed, so we can just integrate + IF (.NOT. ASSOCIATED(dft_control%qs_control%becke_control%cavity_mat)) THEN + ! No external control + DO k = bo(1, 1), bo(2, 1) + DO j = bo(1, 2), bo(2, 2) + DO i = bo(1, 3), bo(2, 3) + ! First check if this grid point should be skipped + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + IF (dft_control%qs_control%becke_control%cavity%pw%cr3d(k, j, i) < eps_cavity) CYCLE + END IF + ind = (/k, j, i/) + IF (dft_control%qs_control%becke_control%confine .OR. & + dft_control%qs_control%becke_control%dynamic_confine) THEN + IF (ind(dir) .LE. lb_index .OR. ind(dir) .GE. ub_index) CYCLE + END IF + IF (dft_control%qs_control%becke_control%should_skip .AND. .NOT. & + dft_control%qs_control%becke_control%cavity_confine) THEN + IF (dft_control%qs_control%becke_control%skip_list(k, j, i)) CYCLE + END IF + DO iatom = 1, natom + DO ispin = 1, dft_control%nspins + DO ivar = 1, nvar + sign = 1.0_dp + IF (ivar == 2) THEN + IF (ispin == 2) sign = -1.0_dp + integrated(1+3*(ngrad-1):3+3*(ngrad-1), iatom) = & + integrated(1+3*(ngrad-1):3+3*(ngrad-1), iatom)+sign* & + gradients(3*(iatom-1)+1+natom*(ngrad-1):3*(iatom-1)+3+natom*(ngrad-1), k, j, i)* & + rho_r(ispin)%pw%cr3d(k, j, i)*dvol + ELSE + IF (dft_control%qs_control%becke_control%constraint_type == & + cdft_magnetization_constraint .AND. ispin == 2) sign = -1.0_dp + integrated(1:3, iatom) = integrated(1:3, iatom)+sign* & + gradients(3*(iatom-1)+1:3*(iatom-1)+3, k, j, i)* & + rho_r(ispin)%pw%cr3d(k, j, i)*dvol + END IF END DO - dist_vec_j = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v - dr1_r2 = (r-r1)-ANINT((r-r1)/cell_v)*cell_v - dist2 = SQRT(DOT_PRODUCT(dist_vec_j, dist_vec_j)) - IF (dist2 .LE. th) dist2 = th - tmp_const = (R12(iatom, jatom)**3) - dr_ij_dR(:) = dr1_r2(:)/tmp_const - - !derivativ w.r.t. Rj - dr_j_dR = dist_vec_j(:)/dist2 - - dmy_dR_j(:) = -(dr_j_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:)) - - !derivativ w.r.t. Ri - dmy_dR_i(:) = dr_i_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:) - - my1 = (dist1-dist2)/R12(iatom, jatom) - polyn = 1.5_dp*my1-0.5_dp*my1**3 - - dpolyn = 1.5_dp-1.5_dp*my1**2 - - tmp_const = (1.5_dp**2)*(dpolyn-dpolyn*(polyn**2))- & - (1.5_dp)*((1.5_dp*polyn-0.5*(polyn**3))**2)* & - (1.5_dp*dpolyn-1.5_dp*dpolyn*(polyn**2)) - - ds_dR(:, iatom, jatom) = -0.5_dp*tmp_const*dmy_dR_i(:) - ds_dR(:, jatom, iatom) = -0.5_dp*tmp_const*dmy_dR_j(:) - f_3 = 1.5_dp*polyn-0.5_dp*polyn**3 - f_3 = 1.5_dp*f_3-0.5_dp*f_3**3 - s_my_ij(iatom, jatom) = 0.5_dp*(1-f_3) - P_i(iatom) = P_i(iatom)*s_my_ij(iatom, jatom) - - END IF + END DO END DO - - DO jatom = 1, natom - IF (iatom .NE. jatom) THEN - IF (ABS(s_my_ij(iatom, jatom)) .LE. th) s_my_ij(iatom, jatom) = s_my_ij(iatom, jatom)+th - - dP_i_dRi(:, iatom) = dP_i_dRi(:, iatom)+ & - P_i(iatom)/s_my_ij(iatom, jatom)*ds_dR(:, iatom, jatom) - dP_i_dRj(:, iatom, jatom) = P_i(iatom)/s_my_ij(iatom, jatom)*ds_dR(:, jatom, iatom) - - END IF - END DO - d_sum_Pm_dR(:, iatom) = d_sum_Pm_dR(:, iatom)+dP_i_dRi(:, iatom) - - IF (is_constraint(iatom)) d_sum_const_dR(:, iatom) = d_sum_const_dR(:, iatom)+dP_i_dRi(:, iatom)* & - coefficients(iatom) - DO jatom = 1, natom - IF (iatom .NE. jatom) THEN - d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) - - IF (is_constraint(iatom)) d_sum_const_dR(:, jatom) = & - d_sum_const_dR(:, jatom)+dP_i_dRj(:, iatom, jatom)*coefficients(iatom) - END IF - END DO - ELSE - P_i(iatom) = 0.0_dp - - END IF - - END DO - - sum_Pm = 0.0_dp - DO ip = 1, natom - sum_Pm = sum_Pm+P_i(ip) - END DO - - sum_cell_f_constr = 0.0_dp - DO ip = 1, dft_control%qs_control%becke_control%natoms - sum_cell_f_constr = sum_cell_f_constr+P_i(catom(ip))*dft_control%qs_control%becke_control%coeff(ip) - END DO - - DO iatom = 1, natom - IF (ABS(sum_Pm) .EQ. 0.0_dp) THEN - dw_dR(:, iatom) = 0.0_dp - ELSE - dw_dR(:, iatom) = d_sum_const_dR(:, iatom)/sum_Pm- & - sum_cell_f_constr*d_sum_Pm_dR(:, iatom)/(sum_Pm**2) - END IF - END DO - - DO iatom = 1, natom - DO ispin = 1, dft_control%nspins - integrated(:, iatom) = integrated(:, iatom)+dw_dR(:, iatom)*rho_r(ispin)%pw%cr3d(k, j, i)*dvol END DO END DO END DO - END DO - END DO + ELSE + DO k = LBOUND(dft_control%qs_control%becke_control%cavity_mat, 1), & + UBOUND(dft_control%qs_control%becke_control%cavity_mat, 1) + DO j = LBOUND(dft_control%qs_control%becke_control%cavity_mat, 2), & + UBOUND(dft_control%qs_control%becke_control%cavity_mat, 2) + DO i = LBOUND(dft_control%qs_control%becke_control%cavity_mat, 3), & + UBOUND(dft_control%qs_control%becke_control%cavity_mat, 3) + ! First check if this grid point should be skipped + IF (dft_control%qs_control%becke_control%cavity_mat(k, j, i) < eps_cavity) CYCLE + DO iatom = 1, natom + DO ispin = 1, dft_control%nspins + DO ivar = 1, nvar + sign = 1.0_dp + IF (ivar == 2) THEN + IF (ispin == 2) sign = -1.0_dp + integrated(1+3*(ngrad-1):3+3*(ngrad-1), iatom) = & + integrated(1+3*(ngrad-1):3+3*(ngrad-1), iatom)+sign* & + gradients(3*(iatom-1)+1+natom*(ngrad-1):3*(iatom-1)+3+natom*(ngrad-1), k, j, i)* & + rho_r(ispin)%pw%cr3d(k, j, i)*dvol + ELSE + IF (dft_control%qs_control%becke_control%constraint_type == & + cdft_magnetization_constraint .AND. ispin == 2) sign = -1.0_dp + integrated(1:3, iatom) = integrated(1:3, iatom)+sign* & + gradients(3*(iatom-1)+1:3*(iatom-1)+3, k, j, i)* & + rho_r(ispin)%pw%cr3d(k, j, i)*dvol + END IF + END DO + END DO + END DO + END DO + END DO + END DO + END IF + NULLIFY (gradients) + DEALLOCATE (dft_control%qs_control%becke_control%gradients) + IF (dft_control%qs_control%becke_control%should_skip .AND. .NOT. & + dft_control%qs_control%becke_control%cavity_confine) & + DEALLOCATE (dft_control%qs_control%becke_control%skip_list) + ELSE + ! Construct gradients and then integrate + ALLOCATE (catom(dft_control%qs_control%becke_control%natoms)) + ALLOCATE (is_constraint(natom)) + ALLOCATE (coefficients(natom)) + + is_constraint = .FALSE. + DO i = 1, dft_control%qs_control%becke_control%natoms + catom(i) = dft_control%qs_control%becke_control%atoms(i) + is_constraint(dft_control%qs_control%becke_control%atoms(i)) = .TRUE. + coefficients(catom(i)) = dft_control%qs_control%becke_control%coeff(i) + ENDDO + IF (dft_control%qs_control%becke_control%constraint_type == cdft_combined_constraint) THEN + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ! Do nothing + CASE (cdft_combined_acceptor, cdft_combined_donor) + ALLOCATE (is_combined(natom)) + is_combined = .FALSE. + DO i = 1, dft_control%qs_control%becke_control%natoms + IF (dft_control%qs_control%becke_control%combined_type == cdft_combined_acceptor .AND. & + dft_control%qs_control%becke_control%coeff(i) == -1.0_dp) THEN + is_combined(catom(i)) = .TRUE. + ELSE IF (dft_control%qs_control%becke_control%combined_type == cdft_combined_donor .AND. & + dft_control%qs_control%becke_control%coeff(i) == +1.0_dp) THEN + is_combined(catom(i)) = .TRUE. + END IF + END DO + END SELECT + END IF + ! calculate distances from target atom (only implemented for a diatomic system) + DO i = 1, 3 + cell_v(i) = cell%hmat(i, i) + END DO + + ALLOCATE (R12(natom, natom)) + ALLOCATE (s_my_ij(natom, natom)) + ALLOCATE (ds_dR(3, natom, natom)) + ALLOCATE (P_i(natom)) + ALLOCATE (dw_dR(3*ngrad, natom)) + ALLOCATE (d_sum_Pm_dR(3, natom)) + ALLOCATE (d_sum_const_dR(3*ngrad, natom)) + ALLOCATE (dP_i_dRj(3, natom, natom)) + ALLOCATE (dP_i_dRi(3, natom)) + + DO iatom = 1, natom-1 + DO jatom = iatom+1, natom + r = particle_set(iatom)%r + r1 = particle_set(jatom)%r + DO i = 1, 3 + r(i) = MODULO(r(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp + r1(i) = MODULO(r1(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp + END DO + dist_vec_i = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + R12(iatom, jatom) = SQRT(DOT_PRODUCT(dist_vec_i, dist_vec_i)) + R12(jatom, iatom) = R12(iatom, jatom) + END DO + END DO + + DO k = bo(1, 1), bo(2, 1) + DO j = bo(1, 2), bo(2, 2) + DO i = bo(1, 3), bo(2, 3) + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + IF (dft_control%qs_control%becke_control%cavity%pw%cr3d(k, j, i) < eps_cavity) CYCLE + END IF + grid_p(1) = k*dr(1)+shift(1) + grid_p(2) = j*dr(2)+shift(2) + grid_p(3) = i*dr(3)+shift(3) + ind = (/k, j, i/) + IF (dft_control%qs_control%becke_control%confine .OR. & + dft_control%qs_control%becke_control%dynamic_confine) THEN + IF (ind(dir) .LE. lb_index .OR. ind(dir) .GE. ub_index) CYCLE + END IF + nskipped = 0 + d_sum_Pm_dR = 0.0_dp + d_sum_const_dR = 0.0_dp + P_i = 1.0_dp + dP_i_dRi = 0.0_dp + DO iatom = 1, natom + r = particle_set(iatom)%r + DO ip = 1, 3 + r(ip) = MODULO(r(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + END DO + dist_vec_i = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist1 = SQRT(DOT_PRODUCT(dist_vec_i, dist_vec_i)) + IF (dist1 .LE. cutoffs(iatom)) THEN + IF (dist1 .LE. th) dist1 = th + dr_i_dR(:) = dist_vec_i(:)/dist1 + DO jatom = 1, natom + IF (jatom .NE. iatom) THEN + r1 = particle_set(jatom)%r + DO ip = 1, 3 + r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + END DO + dist_vec_j = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dr1_r2 = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + dist2 = SQRT(DOT_PRODUCT(dist_vec_j, dist_vec_j)) + IF (dist2 .LE. th) dist2 = th + tmp_const = (R12(iatom, jatom)**3) + dr_ij_dR(:) = dr1_r2(:)/tmp_const + + !derivativ w.r.t. Rj + dr_j_dR = dist_vec_j(:)/dist2 + + dmy_dR_j(:) = -(dr_j_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:)) + + !derivativ w.r.t. Ri + dmy_dR_i(:) = dr_i_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:) + + my1 = (dist1-dist2)/R12(iatom, jatom) + + IF (dft_control%qs_control%becke_control%adjust) THEN + my1_homo = my1 + my1 = my1+ & + dft_control%qs_control%becke_control%aij(iatom, jatom)*(1.0_dp-my1**2) + END IF + + polyn = 1.5_dp*my1-0.5_dp*my1**3 + + dpolyn = 1.5_dp-1.5_dp*my1**2 + + tmp_const = (1.5_dp**2)*(dpolyn-dpolyn*(polyn**2))- & + (1.5_dp)*((1.5_dp*polyn-0.5*(polyn**3))**2)* & + (1.5_dp*dpolyn-1.5_dp*dpolyn*(polyn**2)) + + ds_dR(:, iatom, jatom) = -0.5_dp*tmp_const*dmy_dR_i(:) + ds_dR(:, jatom, iatom) = -0.5_dp*tmp_const*dmy_dR_j(:) + IF (dft_control%qs_control%becke_control%adjust) THEN + tmp_const = 1.0_dp-2.0_dp*my1_homo* & + dft_control%qs_control%becke_control%aij(iatom, jatom) + ds_dR(:, iatom, jatom) = ds_dR(:, iatom, jatom)*tmp_const + ds_dR(:, jatom, iatom) = ds_dR(:, jatom, iatom)*tmp_const + END IF + f_3 = 1.5_dp*polyn-0.5_dp*polyn**3 + f_3 = 1.5_dp*f_3-0.5_dp*f_3**3 + s_my_ij(iatom, jatom) = 0.5_dp*(1-f_3) + P_i(iatom) = P_i(iatom)*s_my_ij(iatom, jatom) + IF (ABS(s_my_ij(iatom, jatom)) .LE. th) & + s_my_ij(iatom, jatom) = s_my_ij(iatom, jatom)+th + END IF + END DO + + DO jatom = 1, natom + IF (iatom .NE. jatom) THEN + IF (ABS(s_my_ij(iatom, jatom)) .LE. th) & + s_my_ij(iatom, jatom) = s_my_ij(iatom, jatom)+th + dP_i_dRi(:, iatom) = dP_i_dRi(:, iatom)+ & + P_i(iatom)/s_my_ij(iatom, jatom)*ds_dR(:, iatom, jatom) + dP_i_dRj(:, iatom, jatom) = P_i(iatom)/s_my_ij(iatom, jatom)*ds_dR(:, jatom, iatom) + END IF + END DO + + d_sum_Pm_dR(:, iatom) = d_sum_Pm_dR(:, iatom)+dP_i_dRi(:, iatom) + + IF (is_constraint(iatom)) & + d_sum_const_dR(1:3, iatom) = d_sum_const_dR(1:3, iatom)+dP_i_dRi(:, iatom)* & + coefficients(iatom) + IF (ngrad == 2) THEN + IF (is_combined(iatom)) & + d_sum_const_dR(4:6, iatom) = d_sum_const_dR(4:6, iatom)+dP_i_dRi(:, iatom) + END IF + DO jatom = 1, natom + IF (iatom .NE. jatom) THEN + d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) + + IF (is_constraint(iatom)) & + d_sum_const_dR(:, jatom) = d_sum_const_dR(:, jatom)+dP_i_dRj(:, iatom, jatom)* & + coefficients(iatom) + IF (ngrad == 2) THEN + IF (is_combined(iatom)) & + d_sum_const_dR(4:6, jatom) = d_sum_const_dR(4:6, jatom)+ & + dP_i_dRj(:, iatom, jatom) + END IF + END IF + END DO + + ELSE + P_i(iatom) = 0.0_dp + IF (dft_control%qs_control%becke_control%should_skip) THEN + IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (nskipped == dft_control%qs_control%becke_control%natoms) EXIT + END IF + END IF + END DO !iatom + IF (nskipped == dft_control%qs_control%becke_control%natoms) CYCLE + + sum_Pm = 0.0_dp + DO ip = 1, natom + sum_Pm = sum_Pm+P_i(ip) + END DO + + sum_cell_f_constr = 0.0_dp + sum_cell_f_combined = 0.0_dp + DO ip = 1, dft_control%qs_control%becke_control%natoms + sum_cell_f_constr = sum_cell_f_constr+P_i(catom(ip))* & + dft_control%qs_control%becke_control%coeff(ip) + IF (ngrad == 2) THEN + IF (is_combined(catom(ip))) & + sum_cell_f_combined = sum_cell_f_combined+P_i(catom(ip)) + END IF + END DO + + DO iatom = 1, natom + IF (ABS(sum_Pm) .EQ. 0.0_dp) THEN + dw_dR(:, iatom) = 0.0_dp + ELSE + dw_dR(1:3, iatom) = d_sum_const_dR(1:3, iatom)/sum_Pm- & + sum_cell_f_constr*d_sum_Pm_dR(1:3, iatom)/(sum_Pm**2) + IF (ngrad == 2) THEN + dw_dR(4:6, iatom) = d_sum_const_dR(4:6, iatom)/sum_Pm- & + sum_cell_f_combined*d_sum_Pm_dR(1:3, iatom)/(sum_Pm**2) + END IF + END IF + END DO + + DO iatom = 1, natom + DO ispin = 1, dft_control%nspins + DO ivar = 1, nvar + sign = 1.0_dp + IF (ivar == 2) THEN + IF (ispin == 2) sign = -1.0_dp + integrated(1+3*(ngrad-1):3+3*(ngrad-1), iatom) = & + integrated(1+3*(ngrad-1):3+3*(ngrad-1), iatom)+ & + sign*dw_dR(1+3*(ngrad-1):3+3*(ngrad-1), iatom)*rho_r(ispin)%pw%cr3d(k, j, i)*dvol + ELSE + IF (dft_control%qs_control%becke_control%constraint_type == & + cdft_magnetization_constraint .AND. ispin == 2) sign = -1.0_dp + integrated(1:3, iatom) = integrated(1:3, iatom)+ & + sign*dw_dR(1:3, iatom)*rho_r(ispin)%pw%cr3d(k, j, i)*dvol + END IF + END DO ! ivar + END DO ! ispin + END DO ! iatom + END DO ! i + END DO ! j + END DO ! k + DEALLOCATE (catom) + DEALLOCATE (R12) + DEALLOCATE (s_my_ij) + DEALLOCATE (ds_dR) + DEALLOCATE (P_i) + DEALLOCATE (dw_dR) + DEALLOCATE (is_constraint) + DEALLOCATE (d_sum_Pm_dR) + DEALLOCATE (d_sum_const_dR) + DEALLOCATE (dP_i_dRi) + DEALLOCATE (dP_i_dRj) + DEALLOCATE (coefficients) + IF (ALLOCATED(is_combined)) DEALLOCATE (is_combined) + END IF ! Gradient integration - DEALLOCATE (catom) - DEALLOCATE (R12) - DEALLOCATE (s_my_ij) - DEALLOCATE (ds_dR) - DEALLOCATE (P_i) - DEALLOCATE (dw_dR) - DEALLOCATE (is_constraint) - DEALLOCATE (d_sum_Pm_dR) - DEALLOCATE (d_sum_const_dR) - DEALLOCATE (dP_i_dRi) - DEALLOCATE (dP_i_dRj) - DEALLOCATE (coefficients) CALL mp_sum(integrated, para_env%group) - DO iatom = 1, natom - ikind = kind_of(iatom) - i = atom_of_kind(iatom) - force(ikind)%rho_elec(:, i) = & - force(ikind)%rho_elec(:, i)+integrated(:, iatom)*strength - END DO - + ! Update force only on master process. Otherwise force due to constraint becomes multiplied + ! by the number of processes when final force%rho_elec is constructed in qs_force + ! by mp_summing [the final integrated(:,:) is distributed on all processors] + IF (para_env%mepos == para_env%source) THEN + DO iatom = 1, natom + ikind = kind_of(iatom) + i = atom_of_kind(iatom) + IF (ngrad == 2) THEN + ! With combined constraint donor/acceptor, gradient due to charge constraint is in integrated(1:3,:) + ! and due to spin constraint in integrated(4:6,:) + force(ikind)%rho_elec(:, i) = force(ikind)%rho_elec(:, i) & + +integrated(1:3, iatom)*strength(1) + force(ikind)%rho_elec(:, i) = & + force(ikind)%rho_elec(:, i)+ & + integrated(4:6, iatom)*strength(2) + ELSE + ! With combined constraint all, sum of gradients from both constraints are in integrated(1:3,:) + force(ikind)%rho_elec(:, i) = force(ikind)%rho_elec(:, i) & + +integrated(1:3, iatom)*SUM(strength) + END IF + END DO + END IF + DEALLOCATE (strength) DEALLOCATE (integrated) DEALLOCATE (atom_of_kind) DEALLOCATE (kind_of) - END IF CALL timestop(handle) END SUBROUTINE becke_force +! ************************************************************************************************** +!> \brief calculates a Gaussian Hirshfeld constraint +!> \param qs_env the qs_env where to build the constraint +!> \param cdft_control the container for constraint related structures +!> \param calc_pot if the constraint potential should be rebuilt or just integrated +!> \param calculate_forces logical if potential has to be calculated or only_energy +!> \author Nico Holmberg (01.2016) +! ************************************************************************************************** + SUBROUTINE hirshfeld_constraint(qs_env, cdft_control, calc_pot, calculate_forces) + + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(cdft_control_type) :: cdft_control + LOGICAL :: calc_pot, calculate_forces + + CHARACTER(len=*), PARAMETER :: routineN = 'hirshfeld_constraint', & + routineP = moduleN//':'//routineN + + INTEGER :: atom_a, handle, i, iat, iatom, iex, & + ikind, ithread, iw, j, natom, nkind, & + npme, nthread, numexp, unit_nr + INTEGER(KIND=int_8) :: subpatch_pattern + INTEGER, ALLOCATABLE, DIMENSION(:) :: catom + INTEGER, DIMENSION(:), POINTER :: atom_list, cores, stride + LOGICAL, ALLOCATABLE, DIMENSION(:) :: is_constraint + REAL(kind=dp) :: alpha, coef, dE, dvol, eps_rho_rspace, & + ra(3), tnfun, tnfun2, zeff + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: coefficients + REAL(KIND=dp), DIMENSION(:, :), POINTER :: pab + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(atomic_kind_type), POINTER :: atomic_kind + TYPE(cell_type), POINTER :: cell + TYPE(cp_logger_type), POINTER :: logger + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(cube_info_type) :: cube_info + TYPE(dft_control_type), POINTER :: dft_control + TYPE(hirshfeld_type), POINTER :: hirshfeld_env + TYPE(particle_list_type), POINTER :: particles + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_env_type), POINTER :: pw_env + TYPE(pw_p_type) :: tmp + TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_r + TYPE(pw_p_type), POINTER :: fnorm + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool + TYPE(qs_energy_type), POINTER :: energy + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + TYPE(qs_rho_type), POINTER :: rho + TYPE(qs_subsys_type), POINTER :: subsys + TYPE(realspace_grid_desc_type), POINTER :: auxbas_rs_desc + TYPE(realspace_grid_type), POINTER :: rs_rho_all, rs_rho_constr + TYPE(section_vals_type), POINTER :: print_section + + NULLIFY (atom_list, cores, stride, pab, atomic_kind, atomic_kind_set, cell, & + logger, para_env, dft_control, hirshfeld_env, particles, particle_set, & + pw_env, fnorm, rho_r, auxbas_pw_pool, energy, rho, qs_kind_set, & + subsys, auxbas_rs_desc, rs_rho_all, rs_rho_constr, print_section) + CALL timeset(routineN, handle) + + CALL get_qs_env(qs_env, & + cell=cell, & + particle_set=particle_set, & + rho=rho, & + natom=natom, & + dft_control=dft_control, & + para_env=para_env, & + qs_kind_set=qs_kind_set, & + subsys=subsys) + + logger => cp_get_default_logger() + CPASSERT(ASSOCIATED(qs_kind_set)) + + print_section => section_vals_get_subs_vals(qs_env%input, & + "DFT%QS%CDFT%HIRSHFELD_CONSTRAINT") + iw = cp_print_key_unit_nr(logger, print_section, "PROGRAM_RUN_INFO", & + extension=".cdftLog") + unit_nr = cp_print_key_unit_nr(logger, print_section, "PROGRAM_RUN_INFO", & + extension=".cube", log_filename=.FALSE.) + CALL qs_rho_get(rho, rho_r=rho_r) + + IF (dft_control%qs_control%cdft) THEN + dvol = cdft_control%weight%pw%pw_grid%dvol + ! Build weight function + IF (calc_pot) THEN + cdft_control%weight%pw%cr3d = 0.0_dp + + ALLOCATE (catom(cdft_control%hirshfeld_control%natoms)) + ALLOCATE (coefficients(natom)) + ALLOCATE (is_constraint(natom)) + is_constraint = .FALSE. + coefficients(:) = 0.0_dp + + DO i = 1, cdft_control%hirshfeld_control%natoms + catom(i) = cdft_control%hirshfeld_control%atoms(i) + is_constraint(catom(i)) = .TRUE. + coefficients(catom(i)) = cdft_control%hirshfeld_control%coeff(i) + END DO + + hirshfeld_env => cdft_control%hirshfeld_control%hirshfeld_env + CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, pw_env=pw_env) + nkind = SIZE(qs_kind_set) + + ! Setup Hirshfeld + IF (.NOT. ASSOCIATED(hirshfeld_env%kind_shape_fn)) THEN + CALL create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set) + CPASSERT(.NOT. ASSOCIATED(hirshfeld_env%charges)) + ALLOCATE (hirshfeld_env%charges(natom)) + SELECT CASE (hirshfeld_env%ref_charge) + CASE (ref_charge_atomic) + DO ikind = 1, nkind + CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff) + atomic_kind => atomic_kind_set(ikind) + CALL get_atomic_kind(atomic_kind, atom_list=atom_list) + DO iat = 1, SIZE(atom_list) + i = atom_list(iat) + hirshfeld_env%charges(i) = zeff + END DO + END DO + CASE (ref_charge_mulliken) + CALL cp_abort(__LOCATION__, & + "Mulliken reference charge NYI for Hirshfeld partitioning.") + CASE DEFAULT + CALL cp_abort(__LOCATION__, & + "Unknown type of reference charge for Hirshfeld partitioning.") + END SELECT + END IF + ! Calculate densities + ! rs_rho_all: Promolecular density i.e. superposition of isolated Gaussian densities + ! rs_rho_constr: Sum of isolated Gaussian densities over constraint atoms multiplied by coeff + CALL pw_env_get(pw_env, auxbas_rs_desc=auxbas_rs_desc, auxbas_rs_grid=rs_rho_all, & + auxbas_pw_pool=auxbas_pw_pool) + cube_info = pw_env%cube_info(1) + CALL rs_grid_retain(rs_rho_all) + CALL rs_grid_zero(rs_rho_all) + CALL rs_grid_create(rs_rho_constr, auxbas_rs_desc) + CALL rs_grid_zero(rs_rho_constr) + eps_rho_rspace = dft_control%qs_control%eps_rho_rspace + ALLOCATE (pab(1, 1)) + nthread = 1 + ithread = 0 + + DO ikind = 1, SIZE(atomic_kind_set) + numexp = hirshfeld_env%kind_shape_fn(ikind)%numexp + IF (numexp <= 0) CYCLE + CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list) + ALLOCATE (cores(natom)) + + DO iex = 1, numexp + alpha = hirshfeld_env%kind_shape_fn(ikind)%zet(iex) + coef = hirshfeld_env%kind_shape_fn(ikind)%coef(iex) + IF (debug_this_module) & + PRINT*, 'Atomic kind and exp', ikind, iex, alpha, coef + npme = 0 + cores = 0 + DO iatom = 1, natom + atom_a = atom_list(iatom) + ra(:) = pbc(particle_set(atom_a)%r, cell) + IF (rs_rho_all%desc%parallel .AND. .NOT. rs_rho_all%desc%distributed) THEN + ! replicated realspace grid, split the atoms up between procs + IF (MODULO(iatom, rs_rho_all%desc%group_size) == rs_rho_all%desc%my_pos) THEN + npme = npme+1 + cores(npme) = iatom + ENDIF + ELSE + npme = npme+1 + cores(npme) = iatom + ENDIF + END DO + DO j = 1, npme + iatom = cores(j) + atom_a = atom_list(iatom) + pab(1, 1) = hirshfeld_env%charges(atom_a)*coef + ra(:) = pbc(particle_set(atom_a)%r, cell) + subpatch_pattern = 0 + CALL collocate_pgf_product_rspace(0, alpha, 0, 0, 0.0_dp, 0, ra, & + (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, 1.0_dp, pab, 0, 0, & + rs_rho_all, cell, cube_info, eps_rho_rspace, & + ga_gb_function=FUNC_AB, ithread=ithread, use_subpatch=.TRUE., & + subpatch_pattern=subpatch_pattern, lmax_global=0) + IF (debug_this_module .AND. is_constraint(atom_a)) & + PRINT*, 'Integrating', iatom, atom_a, coefficients(atom_a) + IF (is_constraint(atom_a)) & + CALL collocate_pgf_product_rspace(0, alpha, 0, 0, 0.0_dp, 0, ra, & + (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, coefficients(atom_a), & + pab, 0, 0, rs_rho_constr, cell, cube_info, eps_rho_rspace, & + ga_gb_function=FUNC_AB, ithread=ithread, use_subpatch=.TRUE., & + subpatch_pattern=subpatch_pattern, lmax_global=0) + END DO + END DO + DEALLOCATE (cores) + END DO + DEALLOCATE (pab) + DEALLOCATE (catom) + DEALLOCATE (is_constraint) + DEALLOCATE (coefficients) + CALL get_hirshfeld_info(hirshfeld_env, fnorm=fnorm) + IF (ASSOCIATED(fnorm)) THEN + CALL pw_release(fnorm%pw) + DEALLOCATE (fnorm) + ENDIF + ALLOCATE (fnorm) + + CALL pw_pool_create_pw(auxbas_pw_pool, fnorm%pw, use_data=REALDATA3D, & + in_space=REALSPACE) + CALL pw_pool_create_pw(auxbas_pw_pool, tmp%pw, use_data=REALDATA3D, & + in_space=REALSPACE) + CALL set_hirshfeld_info(hirshfeld_env, fnorm=fnorm) + CALL rs_pw_transfer(rs_rho_all, fnorm%pw, rs2pw) + CALL rs_pw_transfer(rs_rho_constr, tmp%pw, rs2pw) + IF (debug_this_module) THEN + ALLOCATE (stride(3)) + stride = (/2, 2, 2/) + CALL qs_subsys_get(subsys, particles=particles) + CALL cp_pw_to_cube(tmp%pw, unit_nr, "RHO_CONSTR", & + particles=particles, & + stride=stride) + DEALLOCATE (stride) + END IF + tnfun2 = pw_integrate_function(tmp%pw) + CALL rs_grid_release(rs_rho_constr) + CALL hfun_scale(cdft_control%weight%pw%cr3d, tmp%pw%cr3d, & + hirshfeld_env%fnorm%pw%cr3d, divide) + CALL pw_pool_give_back_pw(auxbas_pw_pool, tmp%pw) + CALL rs_grid_release(rs_rho_all) + tnfun = pw_integrate_function(hirshfeld_env%fnorm%pw) + IF (debug_this_module) PRINT*, tnfun, tnfun2, SUM(hirshfeld_env%charges) + END IF + + dE = 0.0_dp + DO i = 1, dft_control%nspins + dE = dE+accurate_sum(cdft_control%weight%pw%cr3d*rho_r(i)%pw%cr3d)*dvol + END DO + + CALL get_qs_env(qs_env, energy=energy) + CALL mp_sum(dE, para_env%group) + + cdft_control%value = dE + energy%cdft = (cdft_control%value(1)-cdft_control%target(1))*cdft_control%strength(1) + + IF (iw > 0) THEN + WRITE (iw, '(/,T3,A,T60)') & + '------------------- Hirshfeld constraint information -------------------' + WRITE (iw, '(T3,A,T60,(3X,F18.12))') & + 'Target value of constraint :', cdft_control%target + WRITE (iw, '(T3,A,T60,(3X,F18.12))') & + 'Current value of constraint :', cdft_control%value + WRITE (iw, '(T3,A,T60,(3X,ES12.2))') & + 'Deviation from target :', ABS(cdft_control%value-cdft_control%target) + WRITE (iw, '(T3,A,T54,(3X,F18.12))') & + 'Strength of constraint :', cdft_control%strength + WRITE (iw, '(T3,A)') & + '------------------------------------------------------------------------' + END IF + CALL cp_print_key_finished_output(iw, logger, print_section, "PROGRAM_RUN_INFO") + CALL cp_print_key_finished_output(unit_nr, logger, print_section, "PROGRAM_RUN_INFO") + + IF (calculate_forces) & + CPABORT("Forces with Hirshfeld constraint NYI.") + !CALL hirshfeld_force(qs_env,cdft_control) + END IF + CALL timestop(handle) + + END SUBROUTINE hirshfeld_constraint + +! ************************************************************************************************** +!> \brief calculates forces due to a Gaussian Hirshfeld constraint +!> \param qs_env the qs_env where to build the constraint +!> \param cdft_control the container for constraint related structures +!> \author Nico Holmberg (01.2016) +! ************************************************************************************************** + SUBROUTINE hirshfeld_force(qs_env, cdft_control) + + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(cdft_control_type) :: cdft_control + + CHARACTER(len=*), PARAMETER :: routineN = 'hirshfeld_force', & + routineP = moduleN//':'//routineN + + INTEGER :: atom_a, handle, i, iatom, iex, ikind, & + is, ithread, j, katom, natom, npme, & + nthread, numexp + INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_of_kind, catom, kind_of + INTEGER, DIMENSION(:), POINTER :: atom_list, cores + LOGICAL :: rho_r_valid + LOGICAL, ALLOCATABLE, DIMENSION(:) :: is_acceptor, is_donor + REAL(kind=dp) :: alpha, coef, dvol, eps_rho_rspace, & + force_a(3), force_b(3), ra(3) + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: coefficients + REAL(KIND=dp), DIMENSION(:, :), POINTER :: fderiv, fval, hab, pab + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(cell_type), POINTER :: cell + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(dft_control_type), POINTER :: dft_control + TYPE(hirshfeld_type), POINTER :: hirshfeld_env + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_env_type), POINTER :: pw_env + TYPE(pw_p_type) :: acceptor_weight, donor_weight, rhonorm, & + tmp, weight + TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_r + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool + TYPE(qs_force_type), DIMENSION(:), POINTER :: force + TYPE(qs_rho_type), POINTER :: rho + TYPE(realspace_grid_desc_type), POINTER :: auxbas_rs_desc + TYPE(realspace_grid_type), POINTER :: acceptor_weight_rs, donor_weight_rs, & + weight_rs + + NULLIFY (atom_list, cores, pab, hab, fderiv, fval, atomic_kind_set, & + cell, para_env, dft_control, hirshfeld_env, particle_set, & + pw_env, rho_r, auxbas_pw_pool, force, rho, auxbas_rs_desc, & + weight_rs, acceptor_weight_rs, donor_weight_rs) + CALL timeset(routineN, handle) + + CALL get_qs_env(qs_env, & + cell=cell, & + particle_set=particle_set, & + rho=rho, & + force=force, & + natom=natom, & + dft_control=dft_control, & + para_env=para_env, & + atomic_kind_set=atomic_kind_set, & + pw_env=pw_env) + + IF (dft_control%qs_control%cdft) THEN + dvol = cdft_control%weight%pw%pw_grid%dvol + ALLOCATE (catom(cdft_control%hirshfeld_control%natoms)) + ALLOCATE (coefficients(natom)) + ALLOCATE (is_acceptor(natom)) + ALLOCATE (is_donor(natom)) + is_acceptor = .FALSE. + is_donor = .FALSE. + coefficients(:) = 0.0_dp + + DO i = 1, cdft_control%hirshfeld_control%natoms + catom(i) = cdft_control%hirshfeld_control%atoms(i) + coefficients(catom(i)) = cdft_control%hirshfeld_control%coeff(i) + IF (coefficients(catom(i)) < 0.0_dp) THEN + is_donor(catom(i)) = .TRUE. + ELSE + is_acceptor(catom(i)) = .TRUE. + END IF + END DO + + hirshfeld_env => cdft_control%hirshfeld_control%hirshfeld_env + ! Initialize working arrays + CALL qs_rho_get(rho, rho_r=rho_r, rho_r_valid=rho_r_valid) + CALL pw_env_get(pw_env=pw_env, auxbas_pw_pool=auxbas_pw_pool, & + auxbas_rs_desc=auxbas_rs_desc, auxbas_rs_grid=weight_rs) + CALL rs_grid_retain(weight_rs) + CALL pw_pool_create_pw(auxbas_pw_pool, weight%pw, use_data=REALDATA3D) + CALL pw_pool_create_pw(auxbas_pw_pool, donor_weight%pw, use_data=REALDATA3D) + CALL pw_pool_create_pw(auxbas_pw_pool, acceptor_weight%pw, use_data=REALDATA3D) + CALL pw_pool_create_pw(auxbas_pw_pool, tmp%pw, use_data=REALDATA3D) + ! Here, we assume that all donor atoms have coeff +1 and acceptors -1 + tmp%pw%cr3d = 1.0_dp + CALL pw_copy(cdft_control%weight%pw, weight%pw) + CALL pw_scale(weight%pw, -1.0_dp) + CALL pw_copy(weight%pw, donor_weight%pw) + CALL pw_copy(weight%pw, acceptor_weight%pw) + CALL pw_axpy(tmp%pw, donor_weight%pw, 1.0_dp) + CALL pw_axpy(tmp%pw, acceptor_weight%pw, -1.0_dp) + + CALL rs_grid_create(donor_weight_rs, auxbas_rs_desc) + CALL rs_grid_create(acceptor_weight_rs, auxbas_rs_desc) + CALL pw_pool_create_pw(auxbas_pw_pool, rhonorm%pw, use_data=REALDATA3D) + ALLOCATE (fderiv(3, natom)) + fderiv = 0.0_dp + ALLOCATE (fval(3, natom)) + fval = 0.0_dp + eps_rho_rspace = dft_control%qs_control%eps_rho_rspace + nthread = 1 + ithread = 0 + ALLOCATE (hab(1, 1), pab(1, 1)) + ! loop over spins + DO is = 1, SIZE(rho_r) + IF (rho_r_valid) THEN + CALL hfun_scale(rhonorm%pw%cr3d, rho_r(is)%pw%cr3d, & + hirshfeld_env%fnorm%pw%cr3d, divide) + ELSE + CPABORT("We need rho in real space") + END IF + ! Weight for non-constraint atoms + CALL hfun_scale(tmp%pw%cr3d, rhonorm%pw%cr3d, weight%pw%cr3d, multiply) + CALL rs_pw_transfer(weight_rs, tmp%pw, pw2rs) + ! Weight for donor atoms + CALL hfun_scale(tmp%pw%cr3d, rhonorm%pw%cr3d, donor_weight%pw%cr3d, multiply) + CALL rs_pw_transfer(donor_weight_rs, tmp%pw, pw2rs) + ! Weight for acceptor atoms + CALL hfun_scale(tmp%pw%cr3d, rhonorm%pw%cr3d, acceptor_weight%pw%cr3d, multiply) + CALL rs_pw_transfer(acceptor_weight_rs, tmp%pw, pw2rs) + ! Calculate gradients + DO ikind = 1, SIZE(atomic_kind_set) + numexp = hirshfeld_env%kind_shape_fn(ikind)%numexp + IF (numexp <= 0) CYCLE + CALL get_atomic_kind(atomic_kind_set(ikind), natom=katom, atom_list=atom_list) + ALLOCATE (cores(katom)) + + DO iex = 1, numexp + alpha = hirshfeld_env%kind_shape_fn(ikind)%zet(iex) + coef = hirshfeld_env%kind_shape_fn(ikind)%coef(iex) + npme = 0 + cores = 0 + DO iatom = 1, katom + atom_a = atom_list(iatom) + ra(:) = pbc(particle_set(atom_a)%r, cell) + IF (weight_rs%desc%parallel .AND. .NOT. weight_rs%desc%distributed) THEN + ! replicated realspace grid, split the atoms up between procs + IF (MODULO(iatom, weight_rs%desc%group_size) == weight_rs%desc%my_pos) THEN + npme = npme+1 + cores(npme) = iatom + ENDIF + ELSE + npme = npme+1 + cores(npme) = iatom + ENDIF + END DO + + DO j = 1, npme + iatom = cores(j) + atom_a = atom_list(iatom) + ra(:) = pbc(particle_set(atom_a)%r, cell) + pab(1, 1) = coef*hirshfeld_env%charges(atom_a) + hab(1, 1) = 0.0_dp + force_a(:) = 0.0_dp + force_b(:) = 0.0_dp + IF (is_donor(atom_a)) THEN + CALL integrate_pgf_product_rspace(0, alpha, 0, & + 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, & + donor_weight_rs, cell, pw_env%cube_info(1), hab, pab=pab, & + o1=0, o2=0, eps_gvg_rspace=eps_rho_rspace, & + calculate_forces=.TRUE., force_a=force_a, force_b=force_b, & + use_virial=.FALSE., use_subpatch=.TRUE., & + subpatch_pattern=0_int_8) + ELSE IF (is_acceptor(atom_a)) THEN + CALL integrate_pgf_product_rspace(0, alpha, 0, & + 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, & + acceptor_weight_rs, cell, pw_env%cube_info(1), hab, pab=pab, & + o1=0, o2=0, eps_gvg_rspace=eps_rho_rspace, & + calculate_forces=.TRUE., force_a=force_a, force_b=force_b, & + use_virial=.FALSE., use_subpatch=.TRUE., & + subpatch_pattern=0_int_8) + ELSE + CALL integrate_pgf_product_rspace(0, alpha, 0, & + 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, & + weight_rs, cell, pw_env%cube_info(1), hab, pab=pab, & + o1=0, o2=0, eps_gvg_rspace=eps_rho_rspace, & + calculate_forces=.TRUE., force_a=force_a, force_b=force_b, & + use_virial=.FALSE., use_subpatch=.TRUE., & + subpatch_pattern=0_int_8) + END IF + fderiv(:, atom_a) = fderiv(:, atom_a)+force_a(:)*dvol + fval(:, atom_a) = fval(:, atom_a)+hab(1, 1)*dvol*coef*hirshfeld_env%charges(atom_a) + END DO + END DO + DEALLOCATE (cores) + END DO + END DO + ! Cleanup working arrays + CALL pw_pool_give_back_pw(auxbas_pw_pool, weight%pw) + CALL pw_pool_give_back_pw(auxbas_pw_pool, rhonorm%pw) + CALL pw_pool_give_back_pw(auxbas_pw_pool, tmp%pw) + CALL pw_pool_give_back_pw(auxbas_pw_pool, acceptor_weight%pw) + CALL pw_pool_give_back_pw(auxbas_pw_pool, donor_weight%pw) + CALL rs_grid_release(weight_rs) + CALL rs_grid_release(donor_weight_rs) + CALL rs_grid_release(acceptor_weight_rs) + DEALLOCATE (hab, pab) + DEALLOCATE (catom) + DEALLOCATE (is_acceptor, is_donor) + DEALLOCATE (coefficients) + ! Update forces. This is actually the gradient, so the sign needs to be positive! + CALL mp_sum(fderiv, para_env%group) + CALL mp_sum(fval, para_env%group) + ALLOCATE (atom_of_kind(natom)) + ALLOCATE (kind_of(natom)) + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + atom_of_kind=atom_of_kind, & + kind_of=kind_of) + ! Update only on master proc, see becke_force + IF (para_env%mepos == para_env%source) THEN + DO iatom = 1, natom + ikind = kind_of(iatom) + i = atom_of_kind(iatom) + force(ikind)%rho_elec(:, i) = & + force(ikind)%rho_elec(:, i)+fderiv(:, iatom)*cdft_control%strength + IF (debug_this_module) THEN + PRINT*, 'Force due to constraint', iatom, fderiv(:, iatom)*cdft_control%strength + PRINT*, '"charge" on atom', iatom, fval(:, iatom) + END IF + END DO + END IF + DEALLOCATE (fderiv) + DEALLOCATE (kind_of) + DEALLOCATE (atom_of_kind) + END IF + CALL timestop(handle) + + END SUBROUTINE hirshfeld_force + +! ************************************************************************************************** +!> \brief Calculate fout = fun1/fun2 or fout = fun1*fun2 +!> \param fout the output 3D potential +!> \param fun1 the first input 3D potential +!> \param fun2 the second input 3D potential +!> \param mode decides whether to divide or multiply the input potentials +! ************************************************************************************************** + SUBROUTINE hfun_scale(fout, fun1, fun2, mode) + REAL(KIND=dp), DIMENSION(:, :, :), INTENT(OUT) :: fout + REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN) :: fun1, fun2 + INTEGER, INTENT(IN) :: mode + + CHARACTER(len=*), PARAMETER :: routineN = 'hfun_scale', routineP = moduleN//':'//routineN + REAL(KIND=dp), PARAMETER :: small = 1.0e-12_dp + + INTEGER :: i1, i2, i3, n1, n2, n3 + + n1 = SIZE(fout, 1) + n2 = SIZE(fout, 2) + n3 = SIZE(fout, 3) + CPASSERT(n1 == SIZE(fun1, 1)) + CPASSERT(n2 == SIZE(fun1, 2)) + CPASSERT(n3 == SIZE(fun1, 3)) + CPASSERT(n1 == SIZE(fun2, 1)) + CPASSERT(n2 == SIZE(fun2, 2)) + CPASSERT(n3 == SIZE(fun2, 3)) + + SELECT CASE (mode) + CASE (divide) + DO i3 = 1, n3 + DO i2 = 1, n2 + DO i1 = 1, n1 + IF (fun2(i1, i2, i3) > small) THEN + fout(i1, i2, i3) = fun1(i1, i2, i3)/fun2(i1, i2, i3) + ELSE + fout(i1, i2, i3) = 0.0_dp + END IF + END DO + END DO + END DO + CASE (multiply) + DO i3 = 1, n3 + DO i2 = 1, n2 + DO i1 = 1, n1 + fout(i1, i2, i3) = fun1(i1, i2, i3)*fun2(i1, i2, i3) + END DO + END DO + END DO + END SELECT + + END SUBROUTINE hfun_scale + +! ************************************************************************************************** +!> \brief Determine confinement bounds along confinement dir (hardcoded to be z) +!> and optionally zero entries below a given threshold +!> \param fun input 3D potential (real space) +!> \param th threshold for screening values +!> \param just_bounds if the bounds should be computed without zeroing values +!> \param bounds the confinement bounds: fun is nonzero only between these values along 3rd dimension +! ************************************************************************************************** + SUBROUTINE hfun_zero(fun, th, just_bounds, bounds) + REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT) :: fun + REAL(KIND=dp), INTENT(IN) :: th + LOGICAL :: just_bounds + INTEGER, OPTIONAL :: bounds(2) + + CHARACTER(len=*), PARAMETER :: routineN = 'hfun_zero', routineP = moduleN//':'//routineN + + INTEGER :: i1, i2, i3, lb, n1, n2, n3, nzeroed, ub + LOGICAL :: lb_final, ub_final + + n1 = SIZE(fun, 1) + n2 = SIZE(fun, 2) + n3 = SIZE(fun, 3) + IF (just_bounds) THEN + CPASSERT(PRESENT(bounds)) + lb = 1 + lb_final = .FALSE. + ub_final = .FALSE. + END IF + + DO i3 = 1, n3 + IF (just_bounds) nzeroed = 0 + DO i2 = 1, n2 + DO i1 = 1, n1 + IF (fun(i1, i2, i3) < th) THEN + IF (just_bounds) THEN + nzeroed = nzeroed+1 + ELSE + fun(i1, i2, i3) = 0.0_dp + END IF + ELSE + IF (just_bounds) EXIT + END IF + END DO + IF (just_bounds .AND. nzeroed < n1) EXIT + END DO + IF (just_bounds) THEN + IF (nzeroed == (n2*n1)) THEN + IF (.NOT. lb_final) THEN + lb = i3 + ELSE IF (.NOT. ub_final) THEN + ub = i3 + ub_final = .TRUE. + END IF + ELSE + IF (.NOT. lb_final) lb_final = .TRUE. + IF (ub_final) ub_final = .FALSE. ! Safeguard against "holes" + END IF + END IF + END DO + IF (just_bounds) THEN + IF (.NOT. ub_final) ub = n3 + bounds(1) = lb + bounds(2) = ub + bounds = bounds-(n3/2)-1 + END IF + + END SUBROUTINE hfun_zero + END MODULE et_coupling diff --git a/src/fm/cp_fm_basic_linalg.F b/src/fm/cp_fm_basic_linalg.F index 9916ccccae..5e5db806d3 100644 --- a/src/fm/cp_fm_basic_linalg.F +++ b/src/fm/cp_fm_basic_linalg.F @@ -14,7 +14,8 @@ MODULE cp_fm_basic_linalg USE cp_fm_struct, ONLY: cp_fm_struct_equivalent USE cp_fm_types, ONLY: & cp_fm_create, cp_fm_get_element, cp_fm_get_info, cp_fm_get_submatrix, cp_fm_p_type, & - cp_fm_release, cp_fm_set_all, cp_fm_set_submatrix, cp_fm_to_fm, cp_fm_type + cp_fm_release, cp_fm_set_all, cp_fm_set_element, cp_fm_set_submatrix, cp_fm_to_fm, & + cp_fm_type USE cp_log_handling, ONLY: cp_to_string USE kahan_sum, ONLY: accurate_sum USE kinds, ONLY: dp,& @@ -1205,116 +1206,168 @@ CONTAINS END SUBROUTINE cp_fm_column_scale ! ************************************************************************************************** -!> \brief ... -!> \param matrix_a ... -!> \param matrix_inverse ... -!> \param det_a ... -!> \author Florian Schiffmann(02.2007) -!> \note of Jan Wilhelm (12.2015) +!> \brief Inverts a cp_fm_type matrix, optionally returning the determinant of the input matrix +!> \param matrix_a the matrix to invert +!> \param matrix_inverse the inverse of matrix_a +!> \param det_a the determinant of matrix_a +!> \param eps_svd optional parameter to active SVD based inversion, singular values below eps_svd +!> are screened +!> \par History +!> note of Jan Wilhelm (12.2015) !> - computation of determinant corrected !> - determinant only computed if det_a is present +!> 12.2016 added option to use SVD instead of LU [Nico Holmberg] +!> \author Florian Schiffmann(02.2007) ! ************************************************************************************************** - SUBROUTINE cp_fm_invert(matrix_a, matrix_inverse, det_a) + SUBROUTINE cp_fm_invert(matrix_a, matrix_inverse, det_a, eps_svd) TYPE(cp_fm_type), POINTER :: matrix_a, matrix_inverse REAL(KIND=dp), INTENT(OUT), OPTIONAL :: det_a + REAL(KIND=dp), INTENT(IN), OPTIONAL :: eps_svd CHARACTER(LEN=*), PARAMETER :: routineN = 'cp_fm_invert', & routineP = moduleN//':'//routineN INTEGER :: n INTEGER, ALLOCATABLE, DIMENSION(:) :: ipivot - REAL(KIND=dp) :: determinant + REAL(KIND=dp) :: determinant, my_eps_svd REAL(KIND=dp), DIMENSION(:, :), POINTER :: a - TYPE(cp_fm_type), POINTER :: matrix_B, matrix_lu + TYPE(cp_fm_type), POINTER :: matrix_lu, & + u, vt, sigma, inv_sigma_ut #if defined(__SCALAPACK) INTEGER :: i, info, liwork, lwork, group, exponent_of_minus_one INTEGER, DIMENSION(9) :: desca - INTEGER, ALLOCATABLE, DIMENSION(:) :: iwork REAL(KIND=dp) :: alpha, beta REAL(KIND=dp), DIMENSION(:), POINTER :: diag - REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: berr, ferr, work + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: work #else LOGICAL :: sign REAL(KIND=dp) :: eps1 #endif + my_eps_svd = 0.0_dp + IF (PRESENT(eps_svd)) my_eps_svd = eps_svd + CALL cp_fm_create(matrix=matrix_lu, & matrix_struct=matrix_a%matrix_struct, & name="A_lu"//TRIM(ADJUSTL(cp_to_string(1)))//"MATRIX") CALL cp_fm_to_fm(matrix_a, matrix_lu) - CALL cp_fm_create(matrix=matrix_B, & - matrix_struct=matrix_a%matrix_struct, & - name="B_mat"//TRIM(ADJUSTL(cp_to_string(1)))//"MATRIX") a => matrix_lu%local_data n = matrix_lu%matrix_struct%nrow_global ALLOCATE (ipivot(n+matrix_a%matrix_struct%nrow_block)) ipivot(:) = 0 #if defined(__SCALAPACK) - ALLOCATE (ferr(n)) - ALLOCATE (berr(n)) - ALLOCATE (work(3*n)) - ALLOCATE (iwork(3*N)) - lwork = 3*n - liwork = 3*n - desca(:) = matrix_lu%matrix_struct%descriptor(:) - CALL pdgetrf(n, n, a(1, 1), 1, 1, desca, ipivot, info) + IF (my_eps_svd .EQ. 0.0_dp) THEN + ! Use LU decomposition + lwork = 3*n + liwork = 3*n + desca(:) = matrix_lu%matrix_struct%descriptor(:) + CALL pdgetrf(n, n, a(1, 1), 1, 1, desca, ipivot, info) - IF (PRESENT(det_a)) THEN + IF (PRESENT(det_a)) THEN + ALLOCATE (diag(n)) + diag(:) = 0.0_dp + DO i = 1, n + CALL cp_fm_get_element(matrix_lu, i, i, diag(i)) ! not completely optimal in speed i would say + ENDDO + + exponent_of_minus_one = 0 + determinant = 1.0_dp + DO i = 1, n + determinant = determinant*diag(i) + IF (ipivot(i) .NE. i) THEN + exponent_of_minus_one = exponent_of_minus_one+1 + END IF + ENDDO + DEALLOCATE (diag) + + group = matrix_lu%matrix_struct%para_env%group + CALL mp_sum(exponent_of_minus_one, group) + + determinant = determinant*(-1.0_dp)**exponent_of_minus_one + + END IF + + alpha = 0.0_dp + beta = 1.0_dp + CALL cp_fm_set_all(matrix_inverse, alpha, beta) + CALL pdgetrs('N', n, n, matrix_lu%local_data, 1, 1, desca, ipivot, matrix_inverse%local_data, 1, 1, desca, info) + ELSE + ! Use singular value decomposition + CALL cp_fm_create(matrix=u, & + matrix_struct=matrix_a%matrix_struct, & + name="LEFT_SINGULAR_MATRIX") + CALL cp_fm_set_all(u, alpha=0.0_dp) + CALL cp_fm_create(matrix=vt, & + matrix_struct=matrix_a%matrix_struct, & + name="RIGHT_SINGULAR_MATRIX") + CALL cp_fm_set_all(vt, alpha=0.0_dp) ALLOCATE (diag(n)) diag(:) = 0.0_dp - DO i = 1, n - CALL cp_fm_get_element(matrix_lu, i, i, diag(i)) ! not completely optimal in speed i would say - ENDDO - - exponent_of_minus_one = 0 + desca(:) = matrix_lu%matrix_struct%descriptor(:) + ALLOCATE (work(1)) + ! Workspace query + lwork = -1 + CALL pdgesvd('V', 'V', n, n, matrix_lu%local_data, 1, 1, desca, diag, u%local_data, & + 1, 1, desca, vt%local_data, 1, 1, desca, work, lwork, info) + lwork = INT(work(1)) + DEALLOCATE (work) + ALLOCATE (work(lwork)) + ! SVD + CALL pdgesvd('V', 'V', n, n, matrix_lu%local_data, 1, 1, desca, diag, u%local_data, & + 1, 1, desca, vt%local_data, 1, 1, desca, work, lwork, info) + ! info == n+1 implies homogeneity error when the number of procs is large + ! this likely isnt a problem, but maybe we should handle it separately + IF (info /= 0 .AND. info /= n+1) & + CPABORT("Singular value decomposition of matrix failed.") + ! (Pseudo)inverse and (pseudo)determinant + CALL cp_fm_create(matrix=sigma, & + matrix_struct=matrix_a%matrix_struct, & + name="SINGULAR_VALUE_MATRIX") + CALL cp_fm_set_all(sigma, alpha=0.0_dp) determinant = 1.0_dp + ! TODO: Notify if some singular values fall below my_eps_svd DO i = 1, n - determinant = determinant*diag(i) - IF (ipivot(i) .NE. i) THEN - exponent_of_minus_one = exponent_of_minus_one+1 - END IF - ENDDO + IF (diag(i) < my_eps_svd) THEN + diag(i) = 0.0_dp + ELSE + determinant = determinant*diag(i) + diag(i) = 1.0_dp/diag(i) + ENDIF + CALL cp_fm_set_element(sigma, i, i, diag(i)) + END DO DEALLOCATE (diag) - - group = matrix_lu%matrix_struct%para_env%group - CALL mp_sum(exponent_of_minus_one, group) - - determinant = determinant*(-1.0_dp)**exponent_of_minus_one - + ! Sigma^-1 * U^T + CALL cp_fm_create(matrix=inv_sigma_ut, & + matrix_struct=matrix_a%matrix_struct, & + name="SINGULAR_VALUE_MATRIX") + CALL cp_fm_set_all(inv_sigma_ut, alpha=0.0_dp) + CALL pdgemm('N', 'T', n, n, n, 1.0_dp, sigma%local_data, 1, 1, desca, & + u%local_data, 1, 1, desca, 0.0_dp, inv_sigma_ut%local_data, 1, 1, desca) + ! A^-1 = V * (Sigma^-1 * U^T) + CALL cp_fm_set_all(matrix_inverse, alpha=0.0_dp) + CALL pdgemm('T', 'N', n, n, n, 1.0_dp, vt%local_data, 1, 1, desca, & + inv_sigma_ut%local_data, 1, 1, desca, 0.0_dp, matrix_inverse%local_data, 1, 1, desca) + ! Clean up + DEALLOCATE (work) + CALL cp_fm_release(u) + CALL cp_fm_release(vt) + CALL cp_fm_release(sigma) + CALL cp_fm_release(inv_sigma_ut) END IF - - alpha = 0.0_dp - beta = 1.0_dp - CALL cp_fm_set_all(matrix_inverse, alpha, beta) - CALL pdgetrs('N', n, n, matrix_lu%local_data, 1, 1, desca, ipivot, matrix_inverse%local_data, 1, 1, desca, info) -! CALL cp_fm_set_all(matrix_B,alpha,beta) -! DO iter=1,10 -! CALL pdgerfs('N',n,n,matrix_a%local_data,1,1,desca,matrix_lu%local_data,& -! 1,1,desca,ipivot,matrix_B%local_data,& -! 1,1,desca,matrix_inverse%local_data,1,1,& -! desca,ferr,berr,work,lwork,iwork,liwork,info) -! eps1=eps2 -! eps2=MAXVAL(ferr) -! IF (ABS( eps2 - eps1) <= EPSILON(1.0_dp))THEN -! EXIT -! END IF -! END DO - DEALLOCATE (ferr) - DEALLOCATE (berr) - DEALLOCATE (work) - DEALLOCATE (iwork) - #else - sign = .TRUE. - CALL invert_matrix(matrix_a%local_data, matrix_inverse%local_data, & - eval_error=eps1) - CALL cp_fm_lu_decompose(matrix_lu, determinant, correct_sign=sign) + IF (my_eps_svd .EQ. 0.0_dp) THEN + sign = .TRUE. + CALL invert_matrix(matrix_a%local_data, matrix_inverse%local_data, & + eval_error=eps1) + CALL cp_fm_lu_decompose(matrix_lu, determinant, correct_sign=sign) + ELSE + CPABORT("Matrix inversion using SVD NYI without SCALAPACK.") + END IF #endif CALL cp_fm_release(matrix_lu) - CALL cp_fm_release(matrix_B) DEALLOCATE (ipivot) IF (PRESENT(det_a)) det_a = determinant END SUBROUTINE cp_fm_invert diff --git a/src/force_env_methods.F b/src/force_env_methods.F index d4f0bfd8ef..b3a8331f0b 100644 --- a/src/force_env_methods.F +++ b/src/force_env_methods.F @@ -24,6 +24,7 @@ MODULE force_env_methods scaled_to_real USE constraint_fxd, ONLY: fix_atom_control USE constraint_vsite, ONLY: vsite_force_control + USE cp_control_types, ONLY: dft_control_type USE cp_iter_types, ONLY: cp_iteration_info_copy_iter USE cp_log_handling, ONLY: cp_add_default_logger,& cp_get_default_logger,& @@ -81,7 +82,8 @@ MODULE force_env_methods mix_restrained,& use_bazant_eip,& use_lenosky_eip - USE input_section_types, ONLY: section_vals_get_subs_vals,& + USE input_section_types, ONLY: section_vals_get,& + section_vals_get_subs_vals,& section_vals_retain,& section_vals_type,& section_vals_val_get @@ -95,6 +97,9 @@ MODULE force_env_methods mp_sync USE metadynamics_types, ONLY: meta_env_retain,& meta_env_type + USE mixed_cdft_methods, ONLY: mixed_cdft_build_weight,& + mixed_cdft_calculate_coupling,& + mixed_cdft_init USE mixed_energy_types, ONLY: mixed_energy_type,& mixed_force_type USE mixed_environment_types, ONLY: get_mixed_env,& @@ -108,10 +113,12 @@ MODULE force_env_methods USE qmmm_force, ONLY: qmmm_calc_energy_force USE qmmm_types, ONLY: qmmm_env_retain,& qmmm_env_type + USE qmmm_util, ONLY: apply_qmmm_translate USE qmmmx_force, ONLY: qmmmx_calc_energy_force USE qmmmx_types, ONLY: qmmmx_env_retain,& qmmmx_env_type - USE qs_environment_types, ONLY: qs_env_retain,& + USE qs_environment_types, ONLY: get_qs_env,& + qs_env_retain,& qs_environment_type USE qs_force, ONLY: qs_calc_energy_force USE restraint, ONLY: restraint_control @@ -747,14 +754,15 @@ CONTAINS !> \brief ****f* force_env_methods/mixed_energy_forces [1.0] !> !> Computes energy and forces for a mixed force_env type -!> \param force_env ... -!> \param calculate_forces ... +!> \param force_env the force_env that holds the mixed_env type +!> \param calculate_forces decides if forces should be calculated !> \par History !> 11.06 created [fschiff] !> 04.07 generalization to an illimited number of force_eval [tlaino] !> 04.07 further generalization to force_eval with different geometrical !> structures [tlaino] !> 04.08 reorganizing the genmix structure (collecting common code) +!> 01.16 added CDFT [Nico Holmberg] !> \author Florian Schiffmann ! ************************************************************************************************** SUBROUTINE mixed_energy_forces(force_env, calculate_forces) @@ -767,11 +775,11 @@ CONTAINS CHARACTER(LEN=default_path_length) :: coupling_function CHARACTER(LEN=default_string_length) :: def_error, description, this_error - INTEGER :: iforce_eval, iparticle, jparticle, & - mixing_type, my_group, natom, & - nforce_eval, source, unit_nr + INTEGER :: et_freq, iforce_eval, iparticle, & + jparticle, mixing_type, my_group, & + natom, nforce_eval, source, unit_nr INTEGER, DIMENSION(:), POINTER :: glob_natoms, map_index - LOGICAL :: dip_exists + LOGICAL :: dip_exists, do_mixed_cdft, explicit REAL(KIND=dp) :: coupling_parameter, dedf, der_1, der_2, & dx, energy, err, lambda, lerr, & restraint_strength, restraint_target, & @@ -784,10 +792,12 @@ CONTAINS TYPE(cp_result_type), POINTER :: loc_results, results_mix TYPE(cp_subsys_p_type), DIMENSION(:), POINTER :: subsystems TYPE(cp_subsys_type), POINTER :: subsys_mix + TYPE(dft_control_type), POINTER :: dft_control TYPE(mixed_energy_type), POINTER :: mixed_energy TYPE(mixed_force_type), DIMENSION(:), POINTER :: global_forces TYPE(particle_list_p_type), DIMENSION(:), POINTER :: particles TYPE(particle_list_type), POINTER :: particles_mix + TYPE(qs_environment_type), POINTER :: qs_env TYPE(section_vals_type), POINTER :: force_env_section, gen_section, & mapping_section, mixed_section, & root_section @@ -806,7 +816,7 @@ CONTAINS particles=particles_mix, & virial=virial_mix, & results=results_mix) - NULLIFY (map_index, glob_natoms, global_forces) + NULLIFY (map_index, glob_natoms, global_forces, qs_env, dft_control) nforce_eval = SIZE(force_env%sub_force_env) mixed_section => section_vals_get_subs_vals(force_env_section, "MIXED") @@ -822,66 +832,189 @@ CONTAINS ALLOCATE (results(nforce_eval)) energies = 0.0_dp glob_natoms = 0 - DO iforce_eval = 1, nforce_eval - NULLIFY (subsystems(iforce_eval)%subsys, particles(iforce_eval)%list) - NULLIFY (results(iforce_eval)%results, virials(iforce_eval)%virial) - CALL virial_create(virials(iforce_eval)%virial) - CALL cp_result_create(results(iforce_eval)%results) - IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE - ! From this point on the error is the sub_error - my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos) - my_logger => force_env%mixed_env%sub_logger(my_group+1)%p - ! Copy iterations info (they are updated only in the main mixed_env) - CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info) - CALL cp_add_default_logger(my_logger) + ! Check if mixed CDFT calculation is requested and initialize + CALL section_vals_val_get(mixed_section, "MIXING_TYPE", i_val=mixing_type) + IF (mixing_type == mix_linear_combination .AND. & + .NOT. ASSOCIATED(force_env%mixed_env%cdft_control)) THEN + CALL section_vals_val_get(mixed_section, "LINEAR%MIXED_CDFT", l_val=do_mixed_cdft) + force_env%mixed_env%do_mixed_cdft = do_mixed_cdft + IF (force_env%mixed_env%do_mixed_cdft) THEN + ! Enforce some limitations + CPASSERT(force_env%mixed_env%ngroups == 2) + CPASSERT(nforce_eval == 2) + CALL section_vals_get(mapping_section, explicit=explicit) + ! The sub_force_envs must share the same geometrical structure + CPASSERT(.NOT. explicit) + CALL section_vals_val_get(mixed_section, "LINEAR%MIXED_CDFT_COUPLING", i_val=et_freq) + IF (et_freq .LT. 0) THEN + force_env%mixed_env%do_mixed_et = .FALSE. + ELSE + force_env%mixed_env%do_mixed_et = .TRUE. + IF (et_freq == 0) THEN + force_env%mixed_env%et_freq = 1 + ELSE + force_env%mixed_env%et_freq = et_freq + END IF + END IF + CALL mixed_cdft_init(force_env, calculate_forces) + END IF + END IF + IF (.NOT. force_env%mixed_env%do_mixed_cdft) THEN + DO iforce_eval = 1, nforce_eval + NULLIFY (subsystems(iforce_eval)%subsys, particles(iforce_eval)%list) + NULLIFY (results(iforce_eval)%results, virials(iforce_eval)%virial) + CALL virial_create(virials(iforce_eval)%virial) + CALL cp_result_create(results(iforce_eval)%results) + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + ! From this point on the error is the sub_error + my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos) + my_logger => force_env%mixed_env%sub_logger(my_group+1)%p + ! Copy iterations info (they are updated only in the main mixed_env) + CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info) + CALL cp_add_default_logger(my_logger) - ! Get all available subsys - CALL force_env_get(force_env=force_env%sub_force_env(iforce_eval)%force_env, & - subsys=subsystems(iforce_eval)%subsys) + ! Get all available subsys + CALL force_env_get(force_env=force_env%sub_force_env(iforce_eval)%force_env, & + subsys=subsystems(iforce_eval)%subsys) - ! all force_env share the same cell - CALL cp_subsys_set(subsystems(iforce_eval)%subsys, cell=cell_mix) + ! all force_env share the same cell + CALL cp_subsys_set(subsystems(iforce_eval)%subsys, cell=cell_mix) - ! Get available particles - CALL cp_subsys_get(subsys=subsystems(iforce_eval)%subsys, & - particles=particles(iforce_eval)%list) + ! Get available particles + CALL cp_subsys_get(subsys=subsystems(iforce_eval)%subsys, & + particles=particles(iforce_eval)%list) - ! Get Mapping index array - natom = SIZE(particles(iforce_eval)%list%els) - CALL get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval, & - map_index) + ! Get Mapping index array + natom = SIZE(particles(iforce_eval)%list%els) - ! Mapping particles from iforce_eval environment to the mixed env - DO iparticle = 1, natom - jparticle = map_index(iparticle) - particles(iforce_eval)%list%els(iparticle)%r = particles_mix%els(jparticle)%r + CALL get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval, & + map_index) + + ! Mapping particles from iforce_eval environment to the mixed env + DO iparticle = 1, natom + jparticle = map_index(iparticle) + particles(iforce_eval)%list%els(iparticle)%r = particles_mix%els(jparticle)%r + END DO + + ! Calculate energy and forces for each sub_force_env + CALL force_env_calc_energy_force(force_env%sub_force_env(iforce_eval)%force_env, & + calc_force=calculate_forces, & + skip_external_control=.TRUE.) + ! Only the rank 0 process collect info for each computation + IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%mepos == & + force_env%sub_force_env(iforce_eval)%force_env%para_env%source) THEN + CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, & + potential_energy=energy) + CALL cp_subsys_get(subsystems(iforce_eval)%subsys, & + virial=loc_virial, results=loc_results) + energies(iforce_eval) = energy + glob_natoms(iforce_eval) = natom + CALL cp_virial(loc_virial, virials(iforce_eval)%virial) + CALL cp_result_copy(loc_results, results(iforce_eval)%results) + END IF + ! Deallocate map_index array + IF (ASSOCIATED(map_index)) THEN + DEALLOCATE (map_index) + END IF + CALL cp_rm_default_logger() + END DO + ELSE + DO iforce_eval = 1, nforce_eval + NULLIFY (subsystems(iforce_eval)%subsys, particles(iforce_eval)%list) + NULLIFY (results(iforce_eval)%results, virials(iforce_eval)%virial) + CALL virial_create(virials(iforce_eval)%virial) + CALL cp_result_create(results(iforce_eval)%results) + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + ! From this point on the error is the sub_error + my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos) + my_logger => force_env%mixed_env%sub_logger(my_group+1)%p + ! Copy iterations info (they are updated only in the main mixed_env) + CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info) + + ! Get all available subsys + CALL force_env_get(force_env=force_env%sub_force_env(iforce_eval)%force_env, & + subsys=subsystems(iforce_eval)%subsys) + + ! all force_env share the same cell + CALL cp_subsys_set(subsystems(iforce_eval)%subsys, cell=cell_mix) + + ! Get available particles + CALL cp_subsys_get(subsys=subsystems(iforce_eval)%subsys, & + particles=particles(iforce_eval)%list) + + ! Get Mapping index array + natom = SIZE(particles(iforce_eval)%list%els) + + CALL get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval, & + map_index) + + ! Mapping particles from iforce_eval environment to the mixed env + DO iparticle = 1, natom + jparticle = map_index(iparticle) + particles(iforce_eval)%list%els(iparticle)%r = particles_mix%els(jparticle)%r + END DO + ! Mixed CDFT + QMMM: Need to translate now + IF (force_env%mixed_env%do_mixed_qmmm_cdft) & + CALL apply_qmmm_translate(force_env%sub_force_env(iforce_eval)%force_env%qmmm_env) END DO - ! Calculate energy and forces for each sub_force_env - CALL force_env_calc_energy_force(force_env%sub_force_env(iforce_eval)%force_env, & - calc_force=calculate_forces, & - skip_external_control=.TRUE.) - ! Only the rank 0 process collect info for each computation - IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%mepos == & - force_env%sub_force_env(iforce_eval)%force_env%para_env%source) THEN - CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, & - potential_energy=energy) - CALL cp_subsys_get(subsystems(iforce_eval)%subsys, & - virial=loc_virial, results=loc_results) - energies(iforce_eval) = energy - glob_natoms(iforce_eval) = natom - CALL cp_virial(loc_virial, virials(iforce_eval)%virial) - CALL cp_result_copy(loc_results, results(iforce_eval)%results) + ! For mixed CDFT, build weight and gradient on all processors before splitting into groups and + ! starting energy calculation + IF (force_env%mixed_env%do_mixed_cdft) THEN + CALL mixed_cdft_build_weight(force_env, calculate_forces) END IF - ! Deallocate map_index array - IF (ASSOCIATED(map_index)) THEN - DEALLOCATE (map_index) - END IF - CALL cp_rm_default_logger() - END DO - + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + CALL cp_add_default_logger(my_logger) + ! Calculate energy and forces for each sub_force_env + CALL force_env_calc_energy_force(force_env%sub_force_env(iforce_eval)%force_env, & + calc_force=calculate_forces, & + skip_external_control=.TRUE.) + ! Only the rank 0 process collect info for each computation + IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%mepos == & + force_env%sub_force_env(iforce_eval)%force_env%para_env%source) THEN + CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, & + potential_energy=energy) + CALL cp_subsys_get(subsystems(iforce_eval)%subsys, & + virial=loc_virial, results=loc_results) + energies(iforce_eval) = energy + glob_natoms(iforce_eval) = natom + CALL cp_virial(loc_virial, virials(iforce_eval)%virial) + CALL cp_result_copy(loc_results, results(iforce_eval)%results) + END IF + ! Deallocate map_index array + IF (ASSOCIATED(map_index)) THEN + DEALLOCATE (map_index) + END IF + CALL cp_rm_default_logger() + END DO + END IF ! Handling Parallel execution CALL mp_sync(force_env%para_env%group) + ! Transfer cdft strengths for writing restart + IF (force_env%mixed_env%do_mixed_cdft) THEN + IF (.NOT. ASSOCIATED(force_env%mixed_env%strength)) & + ALLOCATE (force_env%mixed_env%strength(2)) + force_env%mixed_env%strength = 0.0_dp + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + IF (force_env%mixed_env%do_mixed_qmmm_cdft) THEN + qs_env => force_env%sub_force_env(iforce_eval)%force_env%qmmm_env%qs_env + ELSE + CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, qs_env=qs_env) + END IF + CALL get_qs_env(qs_env, dft_control=dft_control) + IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%mepos == & + force_env%sub_force_env(iforce_eval)%force_env%para_env%source) & + force_env%mixed_env%strength(iforce_eval) = dft_control%qs_control%cdft_control%strength(1) + END DO + CALL mp_sum(force_env%mixed_env%strength, force_env%para_env%group) + END IF + ! Mixed CDFT: calculate ET coupling + IF (force_env%mixed_env%do_mixed_et) THEN + IF (MODULO(force_env%mixed_env%cdft_control%sim_step, force_env%mixed_env%et_freq) == 0) & + CALL mixed_cdft_calculate_coupling(force_env) + END IF ! Let's transfer energy, natom, forces, virials CALL mp_sum(energies, force_env%para_env%group) CALL mp_sum(glob_natoms, force_env%para_env%group) diff --git a/src/hirshfeld_methods.F b/src/hirshfeld_methods.F index cfb5a4bdfa..1d7a91064e 100644 --- a/src/hirshfeld_methods.F +++ b/src/hirshfeld_methods.F @@ -17,11 +17,17 @@ MODULE hirshfeld_methods pbc USE cp_control_types, ONLY: dft_control_type USE cp_para_types, ONLY: cp_para_env_type + USE cp_units, ONLY: cp_unit_to_cp2k USE cube_utils, ONLY: cube_info_type USE hirshfeld_types, ONLY: get_hirshfeld_info,& hirshfeld_type,& set_hirshfeld_info - USE input_constants, ONLY: shape_function_density,& + USE input_constants, ONLY: radius_covalent,& + radius_default,& + radius_single,& + radius_user,& + radius_vdw,& + shape_function_density,& shape_function_gaussian USE kinds, ONLY: dp,& int_8 @@ -126,15 +132,19 @@ CONTAINS END SUBROUTINE write_hirshfeld_charges ! ************************************************************************************************** -!> \brief ... -!> \param hirshfeld_env ... -!> \param qs_kind_set ... -!> \param atomic_kind_set ... +!> \brief creates kind specific shape functions for Hirshfeld charges +!> \param hirshfeld_env the env that holds information about Hirshfeld +!> \param qs_kind_set the qs_kind_set +!> \param atomic_kind_set the atomic_kind_set +!> \param radius optional radius parameter to use for all atomic kinds +!> \param radii_list optional list of radii to use for different atomic kinds ! ************************************************************************************************** - SUBROUTINE create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set) + SUBROUTINE create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set, radius, radii_list) TYPE(hirshfeld_type), POINTER :: hirshfeld_env TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + REAL(KIND=dp), OPTIONAL :: radius + REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: radii_list CHARACTER(len=*), PARAMETER :: routineN = 'create_shape_function', & routineP = moduleN//':'//routineN @@ -161,8 +171,36 @@ CONTAINS ALLOCATE (hirshfeld_env%kind_shape_fn(ikind)%coef(1)) CALL get_qs_kind(qs_kind_set(ikind), element_symbol=esym) rco = 2.0_dp - CALL get_ptable_info(symbol=esym, covalent_radius=rco, found=found) - rco = MAX(rco, 1.0_dp) + SELECT CASE (hirshfeld_env%radius_type) + CASE (radius_default) + CALL get_ptable_info(symbol=esym, covalent_radius=rco, found=found) + rco = MAX(rco, 1.0_dp) + CASE (radius_user) + CPASSERT(PRESENT(radii_list)) + CPASSERT(ASSOCIATED(radii_list)) + CPASSERT(SIZE(radii_list) == nkind) + ! Note we assume that radii_list is correctly ordered + rco = radii_list(ikind) + CASE (radius_vdw) + CALL get_ptable_info(symbol=esym, vdw_radius=rco, found=found) + IF (.NOT. found) THEN + rco = MAX(rco, 1.0_dp) + ELSE + IF (hirshfeld_env%use_bohr) & + rco = cp_unit_to_cp2k(rco, "angstrom") + END IF + CASE (radius_covalent) + CALL get_ptable_info(symbol=esym, covalent_radius=rco, found=found) + IF (.NOT. found) THEN + rco = MAX(rco, 1.0_dp) + ELSE + IF (hirshfeld_env%use_bohr) & + rco = cp_unit_to_cp2k(rco, "angstrom") + END IF + CASE (radius_single) + CPASSERT(PRESENT(radius)) + rco = radius + END SELECT al = 0.5_dp/rco**2 hirshfeld_env%kind_shape_fn(ikind)%zet(1) = al hirshfeld_env%kind_shape_fn(ikind)%coef(1) = (al/pi)**1.5_dp diff --git a/src/hirshfeld_types.F b/src/hirshfeld_types.F index 29b14d1998..c6dc1ee162 100644 --- a/src/hirshfeld_types.F +++ b/src/hirshfeld_types.F @@ -12,7 +12,8 @@ ! ************************************************************************************************** MODULE hirshfeld_types - USE input_constants, ONLY: shape_function_gaussian + USE input_constants, ONLY: radius_default,& + shape_function_gaussian USE kinds, ONLY: dp USE pw_types, ONLY: pw_p_type,& pw_release @@ -28,13 +29,15 @@ MODULE hirshfeld_types PUBLIC :: get_hirshfeld_info, set_hirshfeld_info ! ************************************************************************************************** -!> \brief quantities needed for a Hischfeld based partitioning of real space +!> \brief quantities needed for a Hirshfeld based partitioning of real space !> \author JGH ! ************************************************************************************************** TYPE hirshfeld_type - LOGICAL :: iterative + LOGICAL :: iterative, & + use_bohr INTEGER :: shape_function_type - INTEGER :: ref_charge + INTEGER :: ref_charge, & + radius_type TYPE(shape_fn), DIMENSION(:), & POINTER :: kind_shape_fn REAL(KIND=dp), DIMENSION(:), & @@ -71,7 +74,9 @@ CONTAINS ALLOCATE (hirshfeld_env) hirshfeld_env%iterative = .FALSE. + hirshfeld_env%use_bohr = .FALSE. hirshfeld_env%shape_function_type = shape_function_gaussian + hirshfeld_env%radius_type = radius_default NULLIFY (hirshfeld_env%kind_shape_fn) NULLIFY (hirshfeld_env%charges) NULLIFY (hirshfeld_env%fnorm) @@ -122,20 +127,25 @@ CONTAINS END SUBROUTINE release_hirshfeld_type ! ************************************************************************************************** -!> \brief ... -!> \param hirshfeld_env ... -!> \param shape_function_type ... -!> \param iterative ... -!> \param ref_charge ... -!> \param fnorm ... +!> \brief Get information from a Hirshfeld env +!> \param hirshfeld_env the env that holds the information +!> \param shape_function_type the type of shape function used +!> \param iterative logical which determins if iterative Hirshfeld charges should be computed +!> \param ref_charge the reference charge type (core charge or mulliken) +!> \param fnorm normalization of the shape function +!> \param radius_type the type of radius used for building the shape functions +!> \param use_bohr logical which determines if angstrom or bohr units are used to build the +!> shape functions ! ************************************************************************************************** SUBROUTINE get_hirshfeld_info(hirshfeld_env, shape_function_type, iterative, & - ref_charge, fnorm) + ref_charge, fnorm, radius_type, use_bohr) TYPE(hirshfeld_type), POINTER :: hirshfeld_env INTEGER, INTENT(OUT), OPTIONAL :: shape_function_type LOGICAL, INTENT(OUT), OPTIONAL :: iterative INTEGER, INTENT(OUT), OPTIONAL :: ref_charge TYPE(pw_p_type), OPTIONAL, POINTER :: fnorm + INTEGER, INTENT(OUT), OPTIONAL :: radius_type + LOGICAL, INTENT(OUT), OPTIONAL :: use_bohr CHARACTER(len=*), PARAMETER :: routineN = 'get_hirshfeld_info', & routineP = moduleN//':'//routineN @@ -148,6 +158,12 @@ CONTAINS IF (PRESENT(iterative)) THEN iterative = hirshfeld_env%iterative END IF + IF (PRESENT(use_bohr)) THEN + use_bohr = hirshfeld_env%use_bohr + END IF + IF (PRESENT(radius_type)) THEN + radius_type = hirshfeld_env%radius_type + END IF IF (PRESENT(ref_charge)) THEN ref_charge = hirshfeld_env%ref_charge END IF @@ -158,20 +174,25 @@ CONTAINS END SUBROUTINE get_hirshfeld_info ! ************************************************************************************************** -!> \brief ... -!> \param hirshfeld_env ... -!> \param shape_function_type ... -!> \param iterative ... -!> \param ref_charge ... -!> \param fnorm ... +!> \brief Set values of a Hirshfeld env +!> \param hirshfeld_env the env that holds the information +!> \param shape_function_type the type of shape function used +!> \param iterative logical which determins if iterative Hirshfeld charges should be computed +!> \param ref_charge the reference charge type (core charge or mulliken) +!> \param fnorm normalization of the shape function +!> \param radius_type the type of radius used for building the shape functions +!> \param use_bohr logical which determines if angstrom or bohr units are used to build the +!> shape functions ! ************************************************************************************************** SUBROUTINE set_hirshfeld_info(hirshfeld_env, shape_function_type, iterative, & - ref_charge, fnorm) + ref_charge, fnorm, radius_type, use_bohr) TYPE(hirshfeld_type), POINTER :: hirshfeld_env INTEGER, INTENT(IN), OPTIONAL :: shape_function_type LOGICAL, INTENT(IN), OPTIONAL :: iterative INTEGER, INTENT(IN), OPTIONAL :: ref_charge TYPE(pw_p_type), OPTIONAL, POINTER :: fnorm + INTEGER, INTENT(IN), OPTIONAL :: radius_type + LOGICAL, INTENT(IN), OPTIONAL :: use_bohr CHARACTER(len=*), PARAMETER :: routineN = 'set_hirshfeld_info', & routineP = moduleN//':'//routineN @@ -184,6 +205,12 @@ CONTAINS IF (PRESENT(iterative)) THEN hirshfeld_env%iterative = iterative END IF + IF (PRESENT(use_bohr)) THEN + hirshfeld_env%use_bohr = use_bohr + END IF + IF (PRESENT(radius_type)) THEN + hirshfeld_env%radius_type = radius_type + END IF IF (PRESENT(ref_charge)) THEN hirshfeld_env%ref_charge = ref_charge END IF diff --git a/src/input_constants.F b/src/input_constants.F index a5b307a5e6..20669e0690 100644 --- a/src/input_constants.F +++ b/src/input_constants.F @@ -583,6 +583,11 @@ MODULE input_constants shape_function_density = 2 INTEGER, PARAMETER, PUBLIC :: ref_charge_atomic = 100, & ref_charge_mulliken = 200 + INTEGER, PARAMETER, PUBLIC :: radius_covalent = 10, & + radius_user = 11, & + radius_single = 12, & + radius_vdw = 13, & + radius_default = 14 ! MAO INTEGER, PARAMETER, PUBLIC :: mao_basis_orb = 2000, & @@ -632,18 +637,54 @@ MODULE input_constants outer_scf_s2_constraint = 124, & outer_scf_becke_constraint = 125, & outer_scf_none = 126, & - outer_scf_basis_center_opt = 127 + outer_scf_basis_center_opt = 127, & + outer_scf_cdft_constraint = 128, & + outer_scf_hirshfeld_constraint = 129 ! outer scf optimizers INTEGER, PARAMETER, PUBLIC :: outer_scf_optimizer_sd = 1001, & outer_scf_optimizer_diis = 1002, & outer_scf_optimizer_none = 1003, & - outer_scf_optimizer_bisect = 1004 + outer_scf_optimizer_bisect = 1004, & + outer_scf_optimizer_broyden = 1005, & + outer_scf_optimizer_newton = 1006 + + ! outer scf broyden optimizer types + INTEGER, PARAMETER, PUBLIC :: broyden_type_1 = 1101, & + broyden_type_2 = 1102, & + broyden_type_3 = 1103, & + broyden_type_4 = 1104 + + ! finite difference types for calculation of inverse jacobian + INTEGER, PARAMETER, PUBLIC :: jacobian_fd1 = 1, & + jacobian_fd1_backward = 2, & + jacobian_fd2 = 3, & + jacobian_fd2_backward = 4, & + jacobian_fd1_central = 5 ! s2 restraint forms INTEGER, PARAMETER, PUBLIC :: do_s2_restraint = 872, & do_s2_constraint = 873 + ! Becke cutoff and confinement methods + INTEGER, PARAMETER, PUBLIC :: becke_none_conf = 776, & + becke_static_conf = 777, & + becke_dynamic_conf = 778, & + becke_cavity_conf = 779, & + becke_mixed_conf = 780, & + becke_cutoff_global = 790, & + becke_cutoff_element = 791 + + ! CDFT constraint and control types + INTEGER, PARAMETER, PUBLIC :: cdft_density_constraint = 1, & + cdft_magnetization_constraint = 2, & + cdft_combined_constraint = 3, & + cdft_combined_all = 10, & + cdft_combined_donor = 11, & + cdft_combined_acceptor = 12, & + ot2cdft = 101, & + cdft2ot = 102 + ! ROKS schemes INTEGER, PARAMETER, PUBLIC :: general_roks = 1, & high_spin_roks = 2 diff --git a/src/input_cp2k_dft.F b/src/input_cp2k_dft.F index 1863bba7dc..8cae1b5d64 100644 --- a/src/input_cp2k_dft.F +++ b/src/input_cp2k_dft.F @@ -11,14 +11,14 @@ ! ************************************************************************************************** MODULE input_cp2k_dft USE bibliography, ONLY: & - Andermatt2016, Andreussi2012, Avezac2005, BaniHashemian2016, Bengtsson1999, Blochl1995, & - Brelaz1979, Dewar1977, Dewar1985, Dudarev1997, Dudarev1998, Ehrhardt1985, Elstner1998, & - Fattebert2002, Guidon2010, Heinzmann1976, Hu2007, Hunt2003, Iannuzzi2005, Iannuzzi2006, & - Iannuzzi2007, Kolafa2004, Krack2000, Krack2002, Kunert2003, Lippert1997, Lippert1999, & - Lu2004, Perdew1981, Porezag1995, Repasky2002, Rocha2006, Schenter2008, Schiffmann2015, & - Seifert1996, Souza2002, Stengel2009, Stewart1982, Stewart1989, Stewart2007, Thiel1992, & - Tozer1996, Umari2002, VandeVondele2003, VandeVondele2005a, VandeVondele2005b, & - VandeVondele2006, Weber2008, Zhao1994, Zhechkov2005 + Andermatt2016, Andreussi2012, Avezac2005, BaniHashemian2016, Becke1988b, Bengtsson1999, & + Blochl1995, Brelaz1979, Dewar1977, Dewar1985, Dudarev1997, Dudarev1998, Ehrhardt1985, & + Elstner1998, Fattebert2002, Guidon2010, Heinzmann1976, Holmberg2017, Hu2007, Hunt2003, & + Iannuzzi2005, Iannuzzi2006, Iannuzzi2007, Kolafa2004, Krack2000, Krack2002, Kunert2003, & + Lippert1997, Lippert1999, Lu2004, Perdew1981, Porezag1995, Repasky2002, Rocha2006, & + Schenter2008, Schiffmann2015, Seifert1996, Souza2002, Stengel2009, Stewart1982, & + Stewart1989, Stewart2007, Thiel1992, Tozer1996, Umari2002, VandeVondele2003, & + VandeVondele2005a, VandeVondele2005b, VandeVondele2006, Weber2008, Zhao1994, Zhechkov2005 USE cp_output_handling, ONLY: add_last_numeric,& cp_print_key_section_create,& debug_print_level,& @@ -26,10 +26,14 @@ MODULE input_cp2k_dft low_print_level,& medium_print_level,& silent_print_level - USE cp_units, ONLY: cp_unit_to_cp2k + USE cp_units, ONLY: cp_unit_from_cp2k,& + cp_unit_to_cp2k USE input_constants, ONLY: & - atomic_guess, casci_canonical, cholesky_dbcsr, cholesky_inverse, cholesky_off, & - cholesky_reduce, cholesky_restore, constant_env, core_guess, custom_env, & + atomic_guess, becke_cavity_conf, becke_cutoff_element, becke_cutoff_global, & + becke_dynamic_conf, becke_mixed_conf, becke_none_conf, becke_static_conf, casci_canonical, & + cdft_combined_acceptor, cdft_combined_all, cdft_combined_constraint, cdft_combined_donor, & + cdft_density_constraint, cdft_magnetization_constraint, cholesky_dbcsr, cholesky_inverse, & + cholesky_off, cholesky_reduce, cholesky_restore, constant_env, core_guess, custom_env, & diag_block_davidson, diag_block_krylov, diag_filter_matrix, diag_ot, diag_standard, & dispersion_d3, dispersion_uff, dmft_model, do_admm_aux_exch_func_bee, & do_admm_aux_exch_func_default, do_admm_aux_exch_func_none, do_admm_aux_exch_func_opt, & @@ -51,37 +55,40 @@ MODULE input_cp2k_dft do_se_lr_ewald, do_se_lr_ewald_gks, do_se_lr_ewald_r3, do_se_lr_none, do_spin_density, & do_taylor, ehrenfest, eri_method_full_gpw, eri_method_gpw_ht, eri_operator_coulomb, & eri_operator_erf, eri_operator_erfc, eri_operator_gaussian, eri_operator_yukawa, gaussian, & - gaussian_env, general_roks, hf_model, high_spin_roks, history_guess, kg_cholesky, & - kg_color_dsatur, kg_color_greedy, kg_ec_diagonalization, kg_ec_functional_harris, & - kg_tnadd_atomic, kg_tnadd_embed, ls_2pnt, ls_3pnt, ls_gold, ls_none, mao_basis_ext, & - mao_basis_orb, mao_basis_prim, mao_projection, mopac_guess, no_excitations, no_guess, & - numerical, oe_gllb, oe_lb, oe_none, oe_saop, oe_sic, op_loc_berry, op_loc_boys, & - op_loc_pipek, orb_dx2, orb_dxy, orb_dy2, orb_dyz, orb_dz2, orb_dzx, orb_px, orb_py, & - orb_pz, orb_s, ot_algo_irac, ot_algo_taylor_or_diag, ot_chol_irac, ot_lwdn_irac, & - ot_mini_broyden, ot_mini_cg, ot_mini_diis, ot_mini_sd, ot_poly_irac, ot_precond_full_all, & - ot_precond_full_kinetic, ot_precond_full_single, ot_precond_full_single_inverse, & - ot_precond_none, ot_precond_s_inverse, ot_precond_solver_default, & - ot_precond_solver_direct, ot_precond_solver_inv_chol, ot_precond_solver_update, & - outer_scf_basis_center_opt, outer_scf_becke_constraint, outer_scf_ddapc_constraint, & - outer_scf_none, outer_scf_optimizer_bisect, outer_scf_optimizer_diis, & - outer_scf_optimizer_none, outer_scf_optimizer_sd, outer_scf_s2_constraint, plus_u_lowdin, & - plus_u_mulliken, plus_u_mulliken_charges, pw_interp, ramp_env, random_guess, & - real_time_propagation, ref_charge_atomic, ref_charge_mulliken, rel_dkh, rel_none, & - rel_pot_erfc, rel_pot_full, rel_sczora_mp, rel_trans_atom, rel_trans_full, & - rel_trans_molecule, rel_zora, rel_zora_full, rel_zora_mp, restart_guess, rsdft_model, & - sccs_andreussi, sccs_derivative_cd3, sccs_derivative_cd5, sccs_derivative_cd7, & - sccs_derivative_fft, sccs_fattebert_gygi, shape_function_density, shape_function_gaussian, & - sic_ad, sic_eo, sic_list_all, sic_list_unpaired, sic_mauri_spz, sic_mauri_us, sic_none, & - slater, smear_energy_window, smear_fermi_dirac, smear_list, sparse_guess, & - spline3_nopbc_interp, spline3_pbc_interp, tddfpt_davidson, tddfpt_excitations, & - tddfpt_lanczos, tddfpt_singlet, tddfpt_triplet, use_coulomb, use_diff, use_no, & - use_restart_wfn, use_rt_restart, use_scf_wfn, wannier_projection, weight_type_mass, & - weight_type_unit, wfi_aspc_nr, wfi_frozen_method_nr, wfi_linear_p_method_nr, & - wfi_linear_ps_method_nr, wfi_linear_wf_method_nr, wfi_ps_method_nr, & - wfi_use_guess_method_nr, wfi_use_prev_p_method_nr, wfi_use_prev_rho_r_method_nr, & - wfi_use_prev_wf_method_nr, xas_1s_type, xas_2p_type, xas_2s_type, xas_dip_len, & - xas_dip_vel, xas_dscf, xas_none, xas_tp_fh, xas_tp_flex, xas_tp_hh, xas_tp_xfh, & - xas_tp_xhh, xes_tp_val + gaussian_env, general_roks, hf_model, high_spin_roks, history_guess, jacobian_fd1, & + jacobian_fd1_backward, jacobian_fd1_central, jacobian_fd2, jacobian_fd2_backward, & + kg_cholesky, kg_color_dsatur, kg_color_greedy, kg_ec_diagonalization, & + kg_ec_functional_harris, kg_tnadd_atomic, kg_tnadd_embed, ls_2pnt, ls_3pnt, ls_gold, & + ls_none, mao_basis_ext, mao_basis_orb, mao_basis_prim, mao_projection, mopac_guess, & + no_excitations, no_guess, numerical, oe_gllb, oe_lb, oe_none, oe_saop, oe_sic, & + op_loc_berry, op_loc_boys, op_loc_pipek, orb_dx2, orb_dxy, orb_dy2, orb_dyz, orb_dz2, & + orb_dzx, orb_px, orb_py, orb_pz, orb_s, ot_algo_irac, ot_algo_taylor_or_diag, & + ot_chol_irac, ot_lwdn_irac, ot_mini_broyden, ot_mini_cg, ot_mini_diis, ot_mini_sd, & + ot_poly_irac, ot_precond_full_all, ot_precond_full_kinetic, ot_precond_full_single, & + ot_precond_full_single_inverse, ot_precond_none, ot_precond_s_inverse, & + ot_precond_solver_default, ot_precond_solver_direct, ot_precond_solver_inv_chol, & + ot_precond_solver_update, outer_scf_basis_center_opt, outer_scf_becke_constraint, & + outer_scf_cdft_constraint, outer_scf_ddapc_constraint, outer_scf_hirshfeld_constraint, & + outer_scf_none, outer_scf_optimizer_bisect, outer_scf_optimizer_broyden, & + outer_scf_optimizer_diis, outer_scf_optimizer_newton, outer_scf_optimizer_none, & + outer_scf_optimizer_sd, outer_scf_s2_constraint, plus_u_lowdin, plus_u_mulliken, & + plus_u_mulliken_charges, pw_interp, radius_covalent, radius_default, radius_single, & + radius_user, radius_vdw, ramp_env, random_guess, real_time_propagation, ref_charge_atomic, & + ref_charge_mulliken, rel_dkh, rel_none, rel_pot_erfc, rel_pot_full, rel_sczora_mp, & + rel_trans_atom, rel_trans_full, rel_trans_molecule, rel_zora, rel_zora_full, rel_zora_mp, & + restart_guess, rsdft_model, sccs_andreussi, sccs_derivative_cd3, sccs_derivative_cd5, & + sccs_derivative_cd7, sccs_derivative_fft, sccs_fattebert_gygi, shape_function_density, & + shape_function_gaussian, sic_ad, sic_eo, sic_list_all, sic_list_unpaired, sic_mauri_spz, & + sic_mauri_us, sic_none, slater, smear_energy_window, smear_fermi_dirac, smear_list, & + sparse_guess, spline3_nopbc_interp, spline3_pbc_interp, tddfpt_davidson, & + tddfpt_excitations, tddfpt_lanczos, tddfpt_singlet, tddfpt_triplet, use_coulomb, use_diff, & + use_no, use_restart_wfn, use_rt_restart, use_scf_wfn, wannier_projection, & + weight_type_mass, weight_type_unit, wfi_aspc_nr, wfi_frozen_method_nr, & + wfi_linear_p_method_nr, wfi_linear_ps_method_nr, wfi_linear_wf_method_nr, & + wfi_ps_method_nr, wfi_use_guess_method_nr, wfi_use_prev_p_method_nr, & + wfi_use_prev_rho_r_method_nr, wfi_use_prev_wf_method_nr, xas_1s_type, xas_2p_type, & + xas_2s_type, xas_dip_len, xas_dip_vel, xas_dscf, xas_none, xas_tp_fh, xas_tp_flex, & + xas_tp_hh, xas_tp_xfh, xas_tp_xhh, xes_tp_val USE input_cp2k_almo, ONLY: create_almo_scf_section USE input_cp2k_distribution, ONLY: create_distribution_section USE input_cp2k_kpoints, ONLY: create_kpoints_section @@ -132,6 +139,7 @@ MODULE input_cp2k_dft PUBLIC :: create_bsse_section, create_qs_section PUBLIC :: create_scf_section PUBLIC :: create_interp_section, create_localize_section + PUBLIC :: create_becke_restraint_section, create_ddapc_restraint_section PUBLIC :: create_mgrid_section CONTAINS @@ -1616,6 +1624,20 @@ CONTAINS enum_i_vals=(/ref_charge_atomic, ref_charge_mulliken/)) CALL section_add_keyword(print_key, keyword) CALL keyword_release(keyword) + CALL keyword_create(keyword, name="USER_RADIUS", & + description="Use user defined radii to generate Gaussians."// & + " These radii are defined by the keyword ATOMIC_RADII", & + usage="USER_RADIUS yes", repeats=.FALSE., n_var=1, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(print_key, keyword) + CALL keyword_release(keyword) + CALL keyword_create(keyword, name="ATOMIC_RADII", & + description="Defines custom radii to setup the spherical Gaussians.", & + usage="ATOMIC_RADII {real} {real} {real}", repeats=.FALSE., & + unit_str="angstrom", & + type_of_var=real_t, n_var=-1) + CALL section_add_keyword(print_key, keyword) + CALL keyword_release(keyword) CALL section_add_subsection(section, print_key) CALL section_release(print_key) @@ -2969,11 +2991,15 @@ CONTAINS CALL section_add_subsection(section, subsection) CALL section_release(subsection) - CALL create_ddapc_restraint_section(subsection) + CALL create_ddapc_restraint_section(subsection, "DDAPC_RESTRAINT") CALL section_add_subsection(section, subsection) CALL section_release(subsection) - CALL create_becke_restraint_section(subsection) + CALL create_becke_restraint_section(subsection, "BECKE_RESTRAINT") + CALL section_add_subsection(section, subsection) + CALL section_release(subsection) + + CALL create_cdft_control_section(subsection) CALL section_add_subsection(section, subsection) CALL section_release(subsection) @@ -3926,9 +3952,11 @@ CONTAINS ! ************************************************************************************************** !> \brief ... !> \param section ... +!> \param section_name ... ! ************************************************************************************************** - SUBROUTINE create_ddapc_restraint_section(section) + SUBROUTINE create_ddapc_restraint_section(section, section_name) TYPE(section_type), POINTER :: section + CHARACTER(len=*), INTENT(in) :: section_name CHARACTER(len=*), PARAMETER :: routineN = 'create_ddapc_restraint_section', & routineP = moduleN//':'//routineN @@ -3938,7 +3966,7 @@ CONTAINS NULLIFY (keyword, print_key) CPASSERT(.NOT. ASSOCIATED(section)) - CALL section_create(section, "DDAPC_RESTRAINT", & + CALL section_create(section, TRIM(ADJUSTL(section_name)), & description="Use DDAPC charges in a restraint (check code for details)", & n_keywords=7, n_subsections=0, repeats=.TRUE.) @@ -3999,9 +4027,11 @@ CONTAINS ! ************************************************************************************************** !> \brief ... !> \param section ... +!> \param section_name ... ! ************************************************************************************************** - SUBROUTINE create_becke_restraint_section(section) + SUBROUTINE create_becke_restraint_section(section, section_name) TYPE(section_type), POINTER :: section + CHARACTER(len=*), INTENT(in) :: section_name CHARACTER(len=*), PARAMETER :: routineN = 'create_becke_restraint_section', & routineP = moduleN//':'//routineN @@ -4011,64 +4041,507 @@ CONTAINS NULLIFY (keyword, print_key) CPASSERT(.NOT. ASSOCIATED(section)) - CALL section_create(section, "BECKE_RESTRAINT", & - description="Use Becke weight population in a restraint/constraint ", & - n_keywords=7, n_subsections=0, repeats=.FALSE.) + CALL section_create(section, TRIM(ADJUSTL(section_name)), & + description="Use Becke weight population in a constraint ", & + n_keywords=26, n_subsections=0, repeats=.FALSE., & + citations=(/Becke1988b/)) CALL keyword_create(keyword, name="STRENGTH", & - description="force constant of the restraint", & - usage="STRENGTH {real} ", default_r_val=0.1_dp) + description="Force constants of the constraints. "// & + "Second value is for combined constraint and is optional.", & + usage="STRENGTH {real} {real}", repeats=.FALSE., & + type_of_var=real_t, n_var=-1, & + default_r_val=0.0_dp) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) CALL keyword_create(keyword, name="TARGET", & - description="target value of the restraint", & - usage="TARGET {real} ", default_r_val=1._dp) + description="Target values of the constraints. "// & + "Second value is for combined constraint and is optional.", & + usage="TARGET {real}", repeats=.FALSE., & + type_of_var=real_t, n_var=-1, & + default_r_val=0.0_dp) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) CALL keyword_create(keyword, name="ATOMS", & - description="Specifies the list of atoms that is summed in the restraint", & + description="Specifies the list of atoms that are included in the constraint", & usage="ATOMS {integer} {integer} .. {integer}", & n_var=-1, type_of_var=integer_t) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) CALL keyword_create(keyword, name="COEFF", & - description="Defines the the coefficient of the atom in the atom list (default is one)", & - usage="COEFF 1.0 -1.0", & + description="Defines coefficients for atoms in the atom list (default is one).", & + usage="COEFF 1.0 -1.0", repeats=.TRUE., & type_of_var=real_t, n_var=-1) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - CALL keyword_create(keyword, name="FUNCTIONAL_FORM", & - description="Specifies the functional form of the term added", & - usage="FUNCTIONAL_FORM RESTRAINT", & - enum_c_vals=s2a("RESTRAINT", "CONSTRAINT"), & - enum_i_vals=(/do_ddapc_restraint, do_ddapc_constraint/), & - enum_desc=s2a("Harmonic potential: s*(q-t)**2", "Constraint form: s*(q-t)"), & - default_i_val=do_ddapc_restraint) + CALL keyword_create(keyword, name="CONSTRAINT_TYPE", & + description="Specifies the type of constraint used.", & + usage="CONSTRAINT_TYPE (TOTAL|MAGNETIZATION|COMBINED)", & + enum_c_vals=s2a("TOTAL", "MAGNETIZATION", "COMBINED"), & + enum_i_vals=(/cdft_density_constraint, cdft_magnetization_constraint, & + cdft_combined_constraint/), & + enum_desc=s2a("Constrain the total density (rho_alpha + rho_beta).", & + "Constrain the magnetization density (rho_alpha - rho_beta).", & + "Constrain both densities. The magnetization density constraint "// & + " is applied to atoms defined in COMBINED_TYPE."), & + default_i_val=cdft_density_constraint) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - CALL keyword_create(keyword, name="TYPE_OF_DENSITY", & - description="Specifies the type of density used for the fitting", & - usage="TYPE_OF_DENSITY (FULL|SPIN)", & - enum_c_vals=s2a("FULL", "SPIN"), & - enum_i_vals=(/do_full_density, do_spin_density/), & - enum_desc=s2a("Full density", "Spin density"), & - default_i_val=do_full_density) + CALL keyword_create(keyword, name="COMBINED_TYPE", & + description="Specifies which atoms to apply the magnetization density constraint"// & + "when using CONSTRAINT_TYPE COMBINED.", & + usage="COMBINED_TYPE (ALL|ACCEPTOR|DONOR)", & + enum_c_vals=s2a("TOTAL", "ACCEPTOR", "DONOR"), & + enum_i_vals=(/cdft_combined_all, cdft_combined_acceptor, cdft_combined_donor/), & + enum_desc=s2a("Use all atoms defined with keywords ATOMS and COEFF.", & + "Use all acceptor atoms i.e. atoms with a COEFF of -1.0.", & + "Use all donor atoms i.e. atoms with a COEFF of +1.0."), & + default_i_val=cdft_combined_all) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - CALL cp_print_key_section_create(print_key, "program_run_info", & - description="Controls the printing basic info about the method", & + CALL keyword_create(keyword, name="ADJUST_SIZE", & + description="Adjust cell boundaries with covalent atomic"// & + " radii to generate a heteronuclear cutoff profile. These"// & + " radii are defined in the keyword ATOMIC_RADII.", & + usage="ADJUST_SIZE", & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="ATOMIC_RADII", & + description="Defines atomic radii to generate a heteronuclear cutoff profile."// & + " Give one value per element in the same order as they"// & + " appear in the input coordinates.", & + usage="ATOMIC_RADII {real} {real} {real}", repeats=.FALSE., & + unit_str="angstrom", & + type_of_var=real_t, n_var=-1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="SHOULD_SKIP", & + description="If grid point is farther than GLOBAL_CUTOFF from all constraint atoms, "// & + " move directly to next grid point, thus saving computational resources.", & + usage="SHOULD_SKIP", & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="ATOMIC_CHARGES", & + description="Calculate atomic Becke charges. Note:"// & + " If the number of atoms is greater than the default"// & + " pw_pool max cache, calculation of atomic charges"// & + " will prompt a warning during deallocation of atomic grids.", & + usage="ATOMIC_CHARGES", & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CONFINE", & + description="Specifies the type of confinement used", & + usage="CONFINE (NONE|STATIC|DYNAMIC|CAVITY|MIXED)", & + enum_c_vals=s2a("NONE", "STATIC", "DYNAMIC", "CAVITY", "MIXED"), & + enum_i_vals=(/becke_none_conf, becke_static_conf, becke_dynamic_conf, & + becke_cavity_conf, becke_mixed_conf/), & + enum_desc=s2a("No confinement", & + "Confine Becke partitioning to a region of space"// & + " along CONFINE_DIR axis. Does not honor PBC: ATOMS must be far"// & + " away from cell boundary along CONFINE_DIR for meaningful results.", & + "Dynamically confine Becke partitioning to a region of space"// & + " along CONFINE_DIR axis. Confinement bounds are (re)generated "// & + " each step so that only points within DYNAMIC_RADIUS are included in"// & + " the partitioning. Does not honor PBC: ATOMS must be far"// & + " away from cell boundary along CONFINE_DIR for meaningful results.", & + "Form a cavity using constraint atom centered spherical Gaussians", & + "Mixed dynamic and cavity confinement"), & + default_i_val=becke_none_conf) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CAVITY_SHAPE", & + description="Specifies the type of Gaussian cavity used", & + usage="CAVITY_SHAPE (SINGLE|VDW|COVALENT|USER)", & + enum_c_vals=s2a("DEFAULT", "SINGLE", "VDW", "COVALENT", "USER"), & + enum_i_vals=(/radius_default, radius_single, radius_vdw, radius_covalent, radius_user/), & + enum_desc=s2a("Use covalent radii (in angstrom) to construct Gaussians, but fixed"// & + " 1.0_dp radius for elements with a radius smaller than this value.", & + "Single Gaussian for all atom types with radius given by CAVITY_RADIUS", & + "Use van der Waals radii to construct Gaussians", & + "Use covalent radii to construct Gaussians", & + "Use user defined radii (keyword ATOMIC_RADII) to construct Gaussians"), & + default_i_val=radius_default) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CAVITY_USE_BOHR", & + description="Convert the cavity radius from angstrom to bohr. This results in a larger"// & + "confinement cavity than without unit conversion.", & + usage="CAVITY_USE_BOHR (SINGLE|VDW|COVALENT|USER)", & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CAVITY_PRINT", & + description="Print cavity in Gaussian cube file format. Currently, printing options"// & + " are hardcoded.", & + usage="CAVITY_PRINT", & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CONFINE_DIR", & + description="Confinement direction.", & + usage="CONFINE_DIR (X|Y|Z)", & + enum_c_vals=s2a("X", "Y", "Z"), & + enum_i_vals=(/1, 2, 3/), & + enum_desc=s2a("Along x", "Along y", "Along z"), & + n_var=1, default_i_val=3) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CONFINE_BOUNDS", & + description="Confinement bounds.", & + usage="CONFINE_BOUNDS ", & + unit_str="angstrom", & + default_r_vals=(/cp_unit_to_cp2k(0.0_dp, "angstrom"), & + cp_unit_to_cp2k(0.0_dp, "angstrom")/), & + type_of_var=real_t, n_var=2) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="DYNAMIC_RADIUS", & + description="Parameter controlling the creation of dynamic confinement"// & + " bounds.", & + usage="DYNAMIC_RADIUS ", & + unit_str="angstrom", & + default_r_val=cp_unit_to_cp2k(6.0_dp, "angstrom"), & + type_of_var=real_t, n_var=1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CAVITY_RADIUS", & + description="Parameter controlling the creation of Gaussian cavity confinement", & + usage="CAVITY_RADIUS ", & + unit_str="angstrom", & + default_r_val=cp_unit_to_cp2k(3.0_dp, "angstrom"), & + type_of_var=real_t, n_var=1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="EPS_CAVITY", & + description="Density threshold for cavity creation. Grid points where the Gaussian"// & + " density falls below the threshold are ignored.", & + usage="EPS_CAVITY {real} ", default_r_val=1.0e-6_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CUTOFF_TYPE", & + description="Specifies the type of cutoff used", & + usage="CUTOFF_TYPE (GLOBAL|ELEMENT)", & + enum_c_vals=s2a("GLOBAL", "ELEMENT"), & + enum_i_vals=(/becke_cutoff_global, becke_cutoff_element/), & + enum_desc=s2a("Use a single value for all elements. Read from GLOBAL_CUTOFF.", & + "Use a different value for all elements. Values read from ELEMENT_CUTOFF"), & + default_i_val=becke_cutoff_global) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="GLOBAL_CUTOFF", & + description="Parameter used to select which atoms contribute to the"// & + " weight function at each real space grid point.", & + usage="GLOBAL_CUTOFF ", & + unit_str="angstrom", & + default_r_val=cp_unit_from_cp2k(6.0_dp, "angstrom"), & + type_of_var=real_t, n_var=1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="ELEMENT_CUTOFF", & + description="Defines element specific cutoffs to elect which atoms contribute to the"// & + " weight function at each real space grid point. Give one value per element in the same "// & + " order as they appear in the coordinates.", & + usage="ELEMENT_CUTOFF {real} {real} {real}", repeats=.FALSE., & + unit_str="angstrom", & + type_of_var=real_t, n_var=-1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="IN_MEMORY", & + description="Precompute gradients due to Becke constraint during"// & + " initial formation of constraint and store them in memory. Useful"// & + " in combination with confinement, memory intensive otherwise. Does"// & + " nothing if forces are not calculated.", & + usage="IN_MEMORY", & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="FRAGMENT_DENSITIES", & + description="Use fragment densities as the target value of the constraint."// & + " Takes as input the electron densities of two isolated fragments in the "// & + " same geometry that they have in the full system."// & + " The isolated fragment densities are read from cube files defined in FRAGMENT_{A,B}_FILE."// & + " With this keyword active, the constraint enforces that the number of electrons for both"// & + " fragments is the same as they would have in the superposition of the isolated fragments."// & + " Supports only static calculations. Weight must be defined for one fragment only!", & + usage="IN_MEMORY", & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="FRAGMENT_A_FILE_NAME", & + description="Name of the reference electron density cube file for fragment A."// & + " May include a path. The reference electron density needs to be outputted"// & + " on the same grid as the full system (same cutoff and cell, output stride 1).", & + usage="FRAGMENT_A_FILE_NAME ", & + default_lc_val="fragment_a.cube") + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="FRAGMENT_B_FILE_NAME", & + description="Name of the reference electron density cube file for fragment A."// & + " May include a path. The reference electron density needs to be outputted"// & + " on the same grid as the full system (same cutoff and cell, output stride 1).", & + default_lc_val="fragment_b.cube") + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL cp_print_key_section_create(print_key, "PROGRAM_RUN_INFO", & + description="Controls the printing of basic info about the method", & print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__") CALL section_add_subsection(section, print_key) CALL section_release(print_key) END SUBROUTINE create_becke_restraint_section +! ***************************************************************************** +!> \brief ... +!> \param section ... +! ************************************************************************************************** + SUBROUTINE create_cdft_control_section(section) + TYPE(section_type), POINTER :: section + + CHARACTER(len=*), PARAMETER :: routineN = 'create_cdft_control_section', & + routineP = moduleN//':'//routineN + + TYPE(keyword_type), POINTER :: keyword + TYPE(section_type), POINTER :: subsection + + NULLIFY (keyword, subsection) + + CPASSERT(.NOT. ASSOCIATED(section)) + CALL section_create(section, "CDFT", & + description="Parameters needed to set up a CDFT calculation with OT."// & + " Constraint is converged in a separate external SCF loop with settings"// & + " read from the OUTER_SCF section. Supported constraints: Gaussian Hirshfeld (partial)"// & + " Becke.", n_keywords=7, n_subsections=2, & + repeats=.FALSE., citations=(/Holmberg2017/)) + + NULLIFY (subsection, keyword) + CALL create_outer_scf_section(subsection) + CALL section_add_subsection(section, subsection) + CALL section_release(subsection) + + CALL create_hirshfeld_constraint_section(subsection) + CALL section_add_subsection(section, subsection) + CALL section_release(subsection) + + CALL keyword_create(keyword, name="TYPE_OF_CONSTRAINT", & + description="Specifies the type of constraint used", & + usage="TYPE_OF_CONSTRAINT (NONE|HIRSHFELD|BECKE)", & + enum_c_vals=s2a("NONE", "HIRSHFELD", "BECKE"), & + enum_i_vals=(/outer_scf_none, outer_scf_hirshfeld_constraint, & + outer_scf_becke_constraint/), & + enum_desc=s2a("No constraint (disables section)", & + "Hirshfeld-type constraint defined by constraint atom centered spherical Gaussians"// & + " Partial implementation: no forces or coupling. Requires corresponding section.", & + "Becke constraint. Requires corresponding section in &QS)"), & + default_i_val=outer_scf_none) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="REUSE_PRECOND", & + description="Reuse previously built OT preconditioner if SCF converged in PRECOND_FREQ steps or less.", & + usage="REUSE_PRECOND yes", repeats=.FALSE., n_var=1, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="PRECOND_FREQ", & + description="See REUSE_PRECOND.", & + usage="PRECOND_FREQ {int} ", default_i_val=0) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="MAX_REUSE", & + description="Determines how many times a previously built preconditioner can be reused.", & + usage="MAX_REUSE {int} ", default_i_val=0) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="PURGE_HISTORY", & + description="Purge wavefunction and constraint history to improve SCF convergence during MD."// & + "Counts how often the convergence of the first CDFT SCF iteration takes 2 or more outer SCF"// & + " iterations and purges the history if the counter exceeds PURGE_FREQ and PURGE_OFFSET "// & + " MD steps have passed since the last purge."// & + " The counter is zeroed after each purge.", & + usage="PURGE_HISTORY yes", repeats=.FALSE., n_var=1, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="PURGE_FREQ", & + description="See PURGE_HISTORY.", & + usage="PURGE_FREQ {int} ", default_i_val=1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="PURGE_OFFSET", & + description="See PURGE_HISTORY.", & + usage="PURGE_OFFSET {int} ", default_i_val=1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + END SUBROUTINE create_cdft_control_section + +! ***************************************************************************** +!> \brief ... +!> \param section ... +! ************************************************************************************************** + SUBROUTINE create_hirshfeld_constraint_section(section) + TYPE(section_type), POINTER :: section + + CHARACTER(len=*), PARAMETER :: routineN = 'create_hirshfeld_constraint_section', & + routineP = moduleN//':'//routineN + + TYPE(keyword_type), POINTER :: keyword + TYPE(section_type), POINTER :: print_key + + NULLIFY (keyword, print_key) + + CPASSERT(.NOT. ASSOCIATED(section)) + CALL section_create(section, "HIRSHFELD_CONSTRAINT", & + description="Parameters for CDFT with Hirshfeld constraint", & + n_keywords=11, n_subsections=0, repeats=.FALSE.) + + CALL keyword_create(keyword, name="STRENGTH", & + description="Force constants of the constraints. "// & + "Second value is for combined constraint and is optional.", & + usage="STRENGTH {real} {real}", repeats=.FALSE., & + type_of_var=real_t, n_var=-1, & + default_r_val=0.0_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="TARGET", & + description="Target values of the constraints. "// & + "Second value is for combined constraint and is optional.", & + usage="TARGET {real}", repeats=.FALSE., & + type_of_var=real_t, n_var=-1, & + default_r_val=0.0_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="ATOMS", & + description="Specifies the list of atoms that are included in the constraint", & + usage="ATOMS {integer} {integer} .. {integer}", & + n_var=-1, type_of_var=integer_t) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="COEFF", & + description="Defines coefficients for atoms included in the constraint (default is one)"// & + " Use +1.0 for donor atoms and -1.0 for acceptor atoms.", & + usage="COEFF 1.0 -1.0", repeats=.TRUE., & + type_of_var=real_t, n_var=-1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CONSTRAINT_TYPE", & + description="Specifies the type of constraint used.", & + usage="CONSTRAINT_TYPE (TOTAL|MAGNETIZATION|COMBINED)", & + enum_c_vals=s2a("TOTAL", "MAGNETIZATION", "COMBINED"), & + enum_i_vals=(/cdft_density_constraint, cdft_magnetization_constraint, & + cdft_combined_constraint/), & + enum_desc=s2a("Constrain the total density (rho_alpha + rho_beta).", & + "Constrain the magnetization density (rho_alpha - rho_beta). NYI", & + "Constrain both densities. The magnetization density constraint is applied "// & + " to atoms defined in COMBINED_TYPE. NYI"), & + default_i_val=cdft_density_constraint) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="COMBINED_TYPE", & + description="Specifies which atoms to apply the magnetization density constraint "// & + "when using CONSTRAINT_TYPE COMBINED.", & + usage="COMBINED_TYPE (ALL|ACCEPTOR|DONOR)", & + enum_c_vals=s2a("TOTAL", "ACCEPTOR", "DONOR"), & + enum_i_vals=(/cdft_combined_all, cdft_combined_acceptor, cdft_combined_donor/), & + enum_desc=s2a("Use all atoms defined with keywords ATOMS and COEFF.", & + "Use all acceptor atoms i.e. atoms with a COEFF of -1.0.", & + "Use all donor atoms i.e. atoms with a COEFF of +1.0."), & + default_i_val=cdft_combined_all) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="SELF_CONSISTENT", & + description="Calculate charges from the Hirsheld-I (self_consistent) method."// & + " This scales only the full shape function, not the added charge as in the original scheme. NYI.", & + usage="SELF_CONSISTENT yes", repeats=.FALSE., n_var=1, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="SHAPE_FUNCTION", & + description="Type of shape function used for Hirshfeld partitioning.", & + usage="SHAPE_FUNCTION {Gaussian,Density}", repeats=.FALSE., n_var=1, & + default_i_val=shape_function_gaussian, & + enum_c_vals=s2a("GAUSSIAN", "DENSITY"), & + enum_desc=s2a("Single Gaussian with Colvalent radius", & + "Atomic density expanded in multiple Gaussians (NYI)"), & + enum_i_vals=(/shape_function_gaussian, shape_function_density/)) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="REFERENCE_CHARGE", & + description="Charge of atomic partitioning function for Hirshfeld method.", & + usage="REFERENCE_CHARGE {Atomic,Mulliken}", repeats=.FALSE., n_var=1, & + default_i_val=ref_charge_atomic, & + enum_c_vals=s2a("ATOMIC", "MULLIKEN"), & + enum_desc=s2a("Use atomic core charges", "Calculate Mulliken charges (NYI)"), & + enum_i_vals=(/ref_charge_atomic, ref_charge_mulliken/)) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="USER_RADIUS", & + description="Use user defined covalent radii for single Gaussian Hirshfeld partitioning."// & + " These radii are defined by the keyword ATOMIC_RADII", & + usage="USER_RADIUS yes", repeats=.FALSE., n_var=1, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="ATOMIC_RADII", & + description="Defines custom radii to setup the spherical Gaussians.", & + usage="ATOMIC_RADII {real} {real} {real}", repeats=.FALSE., & + unit_str="angstrom", & + type_of_var=real_t, n_var=-1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL cp_print_key_section_create(print_key, "PROGRAM_RUN_INFO", & + description="Controls the printing of basic info about the method", & + print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__") + CALL section_add_subsection(section, print_key) + CALL section_release(print_key) + + END SUBROUTINE create_hirshfeld_constraint_section + ! ************************************************************************************************** !> \brief ... !> \param section ... @@ -4865,7 +5338,7 @@ CONTAINS CPASSERT(.NOT. ASSOCIATED(section)) CALL section_create(section, "OUTER_SCF", & description="parameters controlling the outer SCF loop", & - n_keywords=9, n_subsections=0, repeats=.FALSE.) + n_keywords=11, n_subsections=0, repeats=.FALSE.) NULLIFY (keyword) @@ -4879,28 +5352,61 @@ CONTAINS description="Specifies which kind of outer SCF should be employed", & usage="TYPE DDAPC_CONSTRAINT ", & default_i_val=outer_scf_none, & - enum_c_vals=s2a("DDAPC_CONSTRAINT", "S2_CONSTRAINT", "BECKE_CONSTRAINT", "BASIS_CENTER_OPT", "NONE"), & + enum_c_vals=s2a("DDAPC_CONSTRAINT", "S2_CONSTRAINT", "BECKE_CONSTRAINT", & + "BASIS_CENTER_OPT", "CDFT_CONSTRAINT", "NONE"), & enum_desc=s2a("Enforce a constraint on the DDAPC, requires the corresponding section", & "Enforce a constraint on the S2, requires the corresponding section", & - "Enforce a constraint on the Becke weight population,requires the corresponding section", & - "Optimize positions of basis functions, if atom types FLOATING_BASIS_CENTER are defined", & + "Enforce a constraint on the Becke weight population, "// & + "requires the corresponding section", & + "Enforce a constraint on a generic CDFT weight population, "// & + "requires the corresponding section"// & + " which determines the type of weight used "// & + "(currently only Gaussian Hirshfeld supported)", & + "Optimize positions of basis functions, if atom types FLOATING_BASIS_CENTER "// & + " are defined", & "Do nothing in the outer loop, useful for resetting the inner loop,"), & enum_i_vals=(/outer_scf_ddapc_constraint, outer_scf_s2_constraint, & - outer_scf_becke_constraint, outer_scf_basis_center_opt, outer_scf_none/)) + outer_scf_becke_constraint, outer_scf_basis_center_opt, & + outer_scf_cdft_constraint, outer_scf_none/)) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - CALL keyword_create( & - keyword, name="OPTIMIZER", & - description="Method used to bring the outer loop to a stationary point", & - usage="OPTIMIZER SD", & - default_i_val=outer_scf_optimizer_none, & - enum_c_vals=s2a("SD", "DIIS", "NONE", "BISECT"), & - enum_desc=s2a("Takes steps in the direction of the gradient, multiplied by step_size", & - "Uses a Direct Inversion in the Iterative Subspace method", & - "Do nothing, useful only with the none type", & - "Bisection on the gradient, useful for difficult one dimensional cases"), & - enum_i_vals=(/outer_scf_optimizer_sd, outer_scf_optimizer_diis, outer_scf_optimizer_none, outer_scf_optimizer_bisect/)) + CALL keyword_create(keyword, name="OPTIMIZER", & + description="Method used to bring the outer loop to a stationary point", & + usage="OPTIMIZER SD", & + default_i_val=outer_scf_optimizer_none, & + enum_c_vals=s2a("SD", "DIIS", "NONE", "BISECT", "BROYDEN", "NEWTON"), & + enum_desc=s2a("Takes steps in the direction of the gradient, multiplied by step_size", & + "Uses a Direct Inversion in the Iterative Subspace method", & + "Do nothing, useful only with the none type", & + "Bisection of the gradient, useful for difficult one dimensional cases", & + "Broyden's method. Variant defined in BROYDEN_TYPE.", & + "Newton's method."), & + enum_i_vals=(/outer_scf_optimizer_sd, outer_scf_optimizer_diis, outer_scf_optimizer_none, & + outer_scf_optimizer_bisect, outer_scf_optimizer_broyden, & + outer_scf_optimizer_newton/)) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="JACOBIAN_TYPE", & + description="Finite difference method used to calculate the inverse Jacobian "// & + "needed by some optimizers.", & + usage="JACOBIAN_TYPE FD1", & + default_i_val=jacobian_fd1, & + enum_c_vals=s2a("FD1", "FD1_BACKWARD", "FD2", "FD2_BACKWARD", "FD1_CENTRAL"), & + enum_desc=s2a("First order forward difference (one extra energy evaluation per constraint)", & + "First order backward difference (one extra energy evaluation per constraint)", & + "Second order forward difference (two extra energy evaluations per constraint)", & + "Second order backward difference (two extra energy evaluations per constraint)", & + "First order central difference (two extra energy evaluations per constraint)"), & + enum_i_vals=(/jacobian_fd1, jacobian_fd1_backward, jacobian_fd2, & + jacobian_fd2_backward, jacobian_fd1_central/)) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="JACOBIAN_STEP", & + description="Step size to use in the calculation of the inverse Jacobian with finite differences.", & + usage="JACOBIAN_STEP 1.0E-4 ", default_r_val=1.0E-4_dp) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) diff --git a/src/input_cp2k_mixed.F b/src/input_cp2k_mixed.F index 82d1035226..ec521bd57f 100644 --- a/src/input_cp2k_mixed.F +++ b/src/input_cp2k_mixed.F @@ -10,6 +10,9 @@ !> \author Teodoro Laino [tlaino] - University of Zurich ! ************************************************************************************************** MODULE input_cp2k_mixed + USE bibliography, ONLY: Holmberg2017,& + Mavros2015,& + Migliore2009 USE cp_output_handling, ONLY: add_last_numeric,& cp_print_key_section_create,& low_print_level,& @@ -30,6 +33,7 @@ MODULE input_cp2k_mixed USE input_val_types, ONLY: char_t,& integer_t,& lchar_t,& + logical_t,& real_t USE kinds, ONLY: dp USE string_utilities, ONLY: s2a @@ -106,15 +110,108 @@ CONTAINS ! Double force_eval CALL section_create(subsection, name="LINEAR", & description="Linear combination between two force_eval: F= lambda F1 + (1-lambda) F2", & - n_keywords=1, n_subsections=0, repeats=.FALSE.) + n_keywords=11, n_subsections=0, repeats=.FALSE.) + CALL keyword_create(keyword, name="LAMBDA", & description="Specify the mixing parameter lambda in the formula.", & usage="lambda ", type_of_var=real_t) CALL section_add_keyword(subsection, keyword) CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="MIXED_CDFT", & + description="Controls the activation of a mixed CDFT calculation. "// & + "The two force_evals determine"// & + " the involved CDFT states (requires the corresponding sections).", & + usage="MIXED_CDFT", type_of_var=logical_t, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE., citations=(/Holmberg2017/)) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="MIXED_CDFT_COUPLING", & + description="Parameter determining how often the CDFT electronic coupling element "// & + " is calculated. Use a negative number to disable and 0 means every step.", & + usage="MIXED_CDFT_COUPLING ", & + default_i_val=-1, & + type_of_var=integer_t, n_var=1) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="MIXED_CDFT_DLB", & + description="Controls the activation of dynamic load balancing during a mixed CDFT calculation."// & + " Requires Gaussian cavity confinement.", & + usage="MIXED_CDFT_DLB", type_of_var=logical_t, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="MIXED_CDFT_METRIC", & + description="Compute reliability metric for the CDFT electronic coupling element by diagonalizing"// & + " the difference density matrix.", & + usage="MIXED_CDFT_METRIC", type_of_var=logical_t, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE., & + citations=(/Mavros2015/)) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="MIXED_CDFT_WFN_OVERLAP", & + description="Compute CDFT electronic coupling element using the wavefunction overlap "// & + " method in addition to the standard orthogonalization procedure "// & + " (MIXED_CDFT_COUPLING). In this method, the unconstrained KS ground state"// & + " wavefunction (WFN_RESTART_FILE_NAME) is represented as a linear combination"// & + " of the two CDFT states.", & + usage="MIXED_CDFT_WFN_OVERLAP", type_of_var=logical_t, & + default_l_val=.FALSE., lone_keyword_l_val=.TRUE., & + citations=(/Migliore2009/)) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="WFN_RESTART_FILE_NAME", & + description="Name of the wavefunction restart file that defines the unconstrained "// & + " KS ground state, which is used to compute the electronic coupling with"// & + " the wavefunction overlap method. May include a path.", & + usage="WFN_RESTART_FILE_NAME ", & + type_of_var=lchar_t) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="EPS_SVD", & + description="Determines the matrix inversion solver needed by the orthogonalization procedure. "// & + " Default value implies LU decomposition, while values between 0.0 and 1.0 "// & + "imply SVD decomposition. For SVD, the value acts as a threshold"// & + " for screening singular values so that only values above it are included"// & + " in the matrix pseudoinverse.", & + usage="EPS_SVD ", type_of_var=real_t, & + default_r_val=0.0_dp, repeats=.FALSE.) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="LOAD_SCALE", & + description="Control parameter for dynamic load balancing during a mixed CDFT calculation."// & + " See code for details.", & + usage="LOAD_SCALE ", type_of_var=real_t, & + default_r_val=2.0_dp) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="MORE_WORK", & + description="Control parameter for dynamic load balancing during a mixed CDFT calculation."// & + " See code for details.", & + usage="MORE_WORK ", type_of_var=integer_t, & + default_i_val=0, repeats=.FALSE.) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="VERY_OVERLOADED", & + description="Control parameter for dynamic load balancing during a mixed CDFT calculation."// & + " See code for details.", & + usage="VERY_OVERLOADED ", type_of_var=real_t, & + default_r_val=0.0_dp, repeats=.FALSE.) + CALL section_add_keyword(subsection, keyword) + CALL keyword_release(keyword) + CALL section_add_subsection(section, subsection) CALL section_release(subsection) - + ! CALL section_create(subsection, name="COUPLING", & description="Coupling between two force_eval: E=(E1+E2 - sqrt((E1-E2)**2+4*H12**2))/2", & n_keywords=1, n_subsections=0, repeats=.FALSE.) diff --git a/src/input_cp2k_properties_dft.F b/src/input_cp2k_properties_dft.F index 10d76821fc..78735d2e87 100644 --- a/src/input_cp2k_properties_dft.F +++ b/src/input_cp2k_properties_dft.F @@ -26,13 +26,14 @@ MODULE input_cp2k_properties_dft USE input_constants, ONLY: & current_gauge_atom, current_gauge_r, current_gauge_r_and_step_func, & current_orb_center_atom, current_orb_center_box, current_orb_center_common, & - current_orb_center_wannier, do_ddapc_constraint, do_ddapc_restraint, do_et_becke, & - do_et_ddapc, do_full_density, do_no_et, do_spin_density, ot_precond_full_all, & - ot_precond_full_kinetic, ot_precond_full_single, ot_precond_full_single_inverse, & - ot_precond_none, ot_precond_s_inverse, use_mom_ref_coac, use_mom_ref_com, & - use_mom_ref_user, use_mom_ref_zero, xas_dip_len, xas_dip_vel + current_orb_center_wannier, do_et_becke, do_et_ddapc, do_full_density, do_no_et, & + do_spin_density, ot_precond_full_all, ot_precond_full_kinetic, ot_precond_full_single, & + ot_precond_full_single_inverse, ot_precond_none, ot_precond_s_inverse, use_mom_ref_coac, & + use_mom_ref_com, use_mom_ref_user, use_mom_ref_zero, xas_dip_len, xas_dip_vel USE input_cp2k_atprop, ONLY: create_atprop_section - USE input_cp2k_dft, ONLY: create_interp_section,& + USE input_cp2k_dft, ONLY: create_becke_restraint_section,& + create_ddapc_restraint_section,& + create_interp_section,& create_localize_section,& create_mgrid_section USE input_cp2k_resp, ONLY: create_resp_section @@ -930,22 +931,22 @@ CONTAINS n_keywords=1, n_subsections=4, repeats=.FALSE.) NULLIFY (subsection) - CALL create_restraint_A(subsection, "DDAPC_RESTRAINT_A") + CALL create_ddapc_restraint_section(subsection, "DDAPC_RESTRAINT_A") CALL section_add_subsection(section, subsection) CALL section_release(subsection) NULLIFY (subsection) - CALL create_restraint_A(subsection, "DDAPC_RESTRAINT_B") + CALL create_ddapc_restraint_section(subsection, "DDAPC_RESTRAINT_B") CALL section_add_subsection(section, subsection) CALL section_release(subsection) NULLIFY (subsection) - CALL create_restraint_A(subsection, "BECKE_RESTRAINT_A") + CALL create_becke_restraint_section(subsection, "BECKE_RESTRAINT_A") CALL section_add_subsection(section, subsection) CALL section_release(subsection) NULLIFY (subsection) - CALL create_restraint_A(subsection, "BECKE_RESTRAINT_B") + CALL create_becke_restraint_section(subsection, "BECKE_RESTRAINT_B") CALL section_add_subsection(section, subsection) CALL section_release(subsection) @@ -954,7 +955,7 @@ CONTAINS usage="TYPE_OF_CONSTRAINT DDAPC", & enum_c_vals=s2a("NONE", "DDAPC", "BECKE"), & enum_i_vals=(/do_no_et, do_et_ddapc, do_et_becke/), & - enum_desc=s2a("NONE", "ddapc_restraint", "Sperical potential"), & + enum_desc=s2a("NONE", "DDAPC Constraint", "Becke constraint"), & default_i_val=do_no_et) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) @@ -968,83 +969,6 @@ CONTAINS END SUBROUTINE create_et_coupling_section -! ************************************************************************************************** -!> \brief ... -!> \param section ... -!> \param section_name ... -! ************************************************************************************************** - SUBROUTINE create_restraint_A(section, section_name) - TYPE(section_type), POINTER :: section - CHARACTER(len=*), INTENT(in) :: section_name - - CHARACTER(len=*), PARAMETER :: routineN = 'create_restraint_A', & - routineP = moduleN//':'//routineN - - TYPE(keyword_type), POINTER :: keyword - TYPE(section_type), POINTER :: print_key - - NULLIFY (keyword, print_key) - CPASSERT(.NOT. ASSOCIATED(section)) - CALL section_create(section, TRIM(ADJUSTL(section_name)), & - description="Use DDAPC charges in a restraint (check code for details),"// & - " section can be repeated, but only one constraint is possible at the moment.", & - n_keywords=7, n_subsections=0, repeats=.FALSE.) - - CALL keyword_create(keyword, name="STRENGTH", & - description="force constant of the restraint", & - usage="STRENGTH {real} ", default_r_val=0.1_dp) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) - - CALL keyword_create(keyword, name="TYPE_OF_DENSITY", & - description="Specifies the type of density used for the fitting", & - usage="TYPE_OF_DENSITY (FULL|SPIN)", & - enum_c_vals=s2a("FULL", "SPIN"), & - enum_i_vals=(/do_full_density, do_spin_density/), & - enum_desc=s2a("Full density", "Spin density"), & - default_i_val=do_full_density) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) - - CALL keyword_create(keyword, name="TARGET", & - description="target value of the restraint", & - usage="TARGET {real} ", default_r_val=1._dp) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) - - CALL keyword_create(keyword, name="ATOMS", & - description="Specifies the list of atoms that is summed in the restraint", & - usage="ATOMS {integer} {integer} .. {integer}", & - n_var=-1, type_of_var=integer_t) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) - - CALL keyword_create( & - keyword, name="COEFF", & - description="Defines the the coefficient of the atom in the atom list (default is one), currently DDAPC only ", & - usage="COEFF 1.0 -1.0", & - type_of_var=real_t, n_var=-1) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) - - CALL keyword_create(keyword, name="FUNCTIONAL_FORM", & - description="Specifies the functional form of the term added", & - usage="FUNCTIONAL_FORM RESTRAINT", & - enum_c_vals=s2a("RESTRAINT", "CONSTRAINT"), & - enum_i_vals=(/do_ddapc_restraint, do_ddapc_constraint/), & - enum_desc=s2a("Harmonic potential: s*(q-t)**2", "Constraint form: s*(q-t)"), & - default_i_val=do_ddapc_restraint) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) - - CALL cp_print_key_section_create(print_key, "program_run_info", & - description="Controls the printing basic info about the method", & - print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__") - CALL section_add_subsection(section, print_key) - CALL section_release(print_key) - - END SUBROUTINE create_restraint_A - ! ************************************************************************************************** !> \brief creates an input section for tddfpt calculation !> \param section section to create diff --git a/src/input_restart_force_eval.F b/src/input_restart_force_eval.F index ea0fdb8b20..cc2f925639 100644 --- a/src/input_restart_force_eval.F +++ b/src/input_restart_force_eval.F @@ -92,9 +92,9 @@ CONTAINS LOGICAL :: multiple_subsys, skip_vel_section TYPE(cell_type), POINTER :: cell TYPE(cp_subsys_type), POINTER :: subsys - TYPE(section_vals_type), POINTER :: cell_section, force_env_sections, & - qmmm_section, rng_section, & - subsys_section + TYPE(section_vals_type), POINTER :: cell_section, dft_section, & + force_env_sections, qmmm_section, & + rng_section, subsys_section TYPE(virial_type), POINTER :: virial NULLIFY (rng_section, subsys_section, cell_section, virial, subsys, cell) @@ -150,6 +150,17 @@ CONTAINS CALL update_cell_section(cell, cell_section) END DO END IF + ! With mixed CDFT, update value of constraint Lagrangian + IF (ASSOCIATED(force_env%mixed_env)) THEN + IF (force_env%mixed_env%do_mixed_cdft) THEN + DO iforce_eval = 2, nforce_eval + dft_section => section_vals_get_subs_vals3(force_env_sections, "DFT", & + i_rep_section=i_force_eval(iforce_eval)) + CALL section_vals_val_set(dft_section, "QS%BECKE_RESTRAINT%STRENGTH", & + r_val=force_env%mixed_env%strength(iforce_eval-1)) + END DO + END IF + END IF END IF IF (myid == ehrenfest) CALL section_vals_val_set(root_section, "FORCE_EVAL%DFT%REAL_TIME_PROPAGATION%INITIAL_WFN", & diff --git a/src/mixed_cdft_methods.F b/src/mixed_cdft_methods.F new file mode 100644 index 0000000000..a9794daa7e --- /dev/null +++ b/src/mixed_cdft_methods.F @@ -0,0 +1,4010 @@ +!--------------------------------------------------------------------------------------------------! +! CP2K: A general program to perform molecular dynamics simulations ! +! Copyright (C) 2000 - 2017 CP2K developers group ! +!--------------------------------------------------------------------------------------------------! + +! ************************************************************************************************** +!> \brief Methods for mixed CDFT calculations +!> \par History +!> Separated CDFT routines from mixed_environment_utils +!> \author Nico Holmberg [01.2017] +! ************************************************************************************************** +MODULE mixed_cdft_methods + USE atomic_kind_types, ONLY: atomic_kind_type,& + get_atomic_kind + USE cell_types, ONLY: cell_type,& + pbc + USE cp_blacs_env, ONLY: cp_blacs_env_create,& + cp_blacs_env_release,& + cp_blacs_env_retain,& + cp_blacs_env_type + USE cp_control_types, ONLY: becke_control_create,& + dft_control_type + USE cp_dbcsr_diag, ONLY: cp_dbcsr_syevd + USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,& + copy_fm_to_dbcsr_bc,& + cp_dbcsr_sm_fm_multiply + USE cp_fm_basic_linalg, ONLY: cp_fm_invert,& + cp_fm_transpose + USE cp_fm_struct, ONLY: cp_fm_struct_create,& + cp_fm_struct_release,& + cp_fm_struct_type + USE cp_fm_types, ONLY: cp_fm_copy_general,& + cp_fm_create,& + cp_fm_get_info,& + cp_fm_p_type,& + cp_fm_release,& + cp_fm_set_all,& + cp_fm_to_fm,& + cp_fm_type + USE cp_gemm_interface, ONLY: cp_gemm + USE cp_log_handling, ONLY: cp_get_default_logger,& + cp_logger_type,& + cp_to_string + USE cp_output_handling, ONLY: cp_print_key_finished_output,& + cp_print_key_unit_nr + USE cp_realspace_grid_cube, ONLY: cp_pw_to_cube + USE cp_realspace_grid_init, ONLY: init_input_type + USE cp_subsys_types, ONLY: cp_subsys_get,& + cp_subsys_type + USE cp_units, ONLY: cp_unit_from_cp2k + USE cube_utils, ONLY: init_cube_info,& + return_cube_max_iradius + USE d3_poly, ONLY: init_d3_poly_module + USE dbcsr_api, ONLY: & + dbcsr_add, dbcsr_create, dbcsr_desymmetrize, dbcsr_get_info, dbcsr_init_p, dbcsr_p_type, & + dbcsr_release, dbcsr_release_p, dbcsr_scale, dbcsr_type + USE force_env_types, ONLY: force_env_get,& + force_env_type,& + multiple_fe_list,& + use_qmmm,& + use_qmmmx,& + use_qs_force + USE gaussian_gridlevels, ONLY: init_gaussian_gridlevel + USE global_types, ONLY: global_environment_type + USE hirshfeld_methods, ONLY: create_shape_function + USE hirshfeld_types, ONLY: create_hirshfeld_type,& + hirshfeld_type,& + release_hirshfeld_type,& + set_hirshfeld_info + USE input_constants, ONLY: becke_cutoff_element,& + becke_cutoff_global,& + cdft_density_constraint,& + do_spin_density,& + shape_function_gaussian + USE input_section_types, ONLY: section_vals_duplicate,& + section_vals_get_subs_vals,& + section_vals_release,& + section_vals_type,& + section_vals_val_get + USE kinds, ONLY: default_path_length,& + dp,& + int_8 + USE machine, ONLY: m_walltime + USE mathlib, ONLY: diamat_all + USE memory_utilities, ONLY: reallocate + USE message_passing, ONLY: mp_bcast,& + mp_irecv,& + mp_isend,& + mp_sum,& + mp_test,& + mp_testall,& + mp_wait,& + mp_waitall + USE mixed_cdft_types, ONLY: mixed_cdft_type,& + mixed_cdft_type_create + USE mixed_environment_types, ONLY: get_mixed_env,& + mixed_environment_type,& + set_mixed_env + USE particle_list_types, ONLY: particle_list_type + USE particle_types, ONLY: particle_type + USE pw_env_methods, ONLY: pw_env_create + USE pw_env_types, ONLY: pw_env_get,& + pw_env_type + USE pw_grid_types, ONLY: HALFSPACE,& + pw_grid_type + USE pw_grids, ONLY: do_pw_grid_blocked_false,& + pw_grid_create,& + pw_grid_release,& + pw_grid_setup + USE pw_methods, ONLY: pw_scale + USE pw_pool_types, ONLY: pw_pool_create,& + pw_pool_create_pw,& + pw_pool_give_back_pw,& + pw_pool_p_type,& + pw_pool_type + USE pw_types, ONLY: REALDATA3D,& + REALSPACE + USE qs_collocate_density, ONLY: collocate_pgf_product_rspace + USE qs_energy_types, ONLY: qs_energy_type + USE qs_environment_types, ONLY: get_qs_env,& + qs_environment_type + USE qs_kind_types, ONLY: create_qs_kind_set,& + qs_kind_type + USE qs_mo_io, ONLY: read_mo_set,& + wfn_restart_file_name + USE qs_mo_methods, ONLY: make_basis_simple,& + make_basis_sm + USE qs_mo_types, ONLY: allocate_mo_set,& + deallocate_mo_set,& + mo_set_p_type,& + set_mo_set + USE qs_modify_pab_block, ONLY: FUNC_AB + USE realspace_grid_types, ONLY: & + realspace_grid_desc_p_type, realspace_grid_input_type, realspace_grid_p_type, & + realspace_grid_type, rs2pw, rs_grid_create, rs_grid_create_descriptor, rs_grid_print, & + rs_grid_release, rs_grid_retain, rs_grid_zero, rs_pw_transfer + USE util, ONLY: sort +#include "./base/base_uses.f90" + + IMPLICIT NONE + + PRIVATE + + CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mixed_cdft_methods' + LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE. + + PUBLIC :: mixed_cdft_init, & + mixed_cdft_build_weight, & + mixed_cdft_calculate_coupling + +CONTAINS + +! ************************************************************************************************** +!> \brief Initialize a mixed CDFT calculation (currently only relevant with Becke constraint) +!> \param force_env the force_env that holds the CDFT states +!> \param calculate_forces determines if forces should be calculted +!> \par History +!> 01.2016 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE mixed_cdft_init(force_env, calculate_forces) + TYPE(force_env_type), POINTER :: force_env + LOGICAL, INTENT(IN) :: calculate_forces + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_init', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, i, iforce_eval, imap, iounit, j, max_nkinds, n_force_eval, nbecke, ncpu, & + nforce_eval, nkinds, ntargets, offset, req(3) + INTEGER, ALLOCATABLE, DIMENSION(:, :) :: bounds + INTEGER, DIMENSION(2, 3) :: bo, bo_mixed + INTEGER, DIMENSION(3) :: higher_grid_layout + INTEGER, DIMENSION(:), POINTER :: grid_span, i_force_eval, mixed_rs_dims, & + odd, recvbuffer, recvbuffer2, & + sendbuffer, spherical + INTEGER, DIMENSION(:, :), POINTER :: atoms, npts, rs_dims, settings_int + LOGICAL :: is_match, is_odd, is_qmmm, is_spherical + REAL(KIND=dp) :: radius + REAL(KIND=dp), DIMENSION(:), POINTER :: cutoff, rel_cutoff + REAL(KIND=dp), DIMENSION(:, :), POINTER :: coeffs, confine_bounds, cutoffs, radii, & + settings_real + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(cell_type), POINTER :: cell_mix + TYPE(cp_blacs_env_type), POINTER :: blacs_env + TYPE(cp_logger_type), POINTER :: logger + TYPE(cp_subsys_type), POINTER :: subsys_mix + TYPE(dft_control_type), POINTER :: dft_control + TYPE(force_env_type), POINTER :: force_env_qs + TYPE(global_environment_type), POINTER :: globenv + TYPE(mixed_cdft_type), POINTER :: mixed_cdft + TYPE(mixed_environment_type), POINTER :: mixed_env + TYPE(particle_list_type), POINTER :: particles_mix + TYPE(pw_env_type), POINTER :: pw_env + TYPE(pw_grid_type), POINTER :: pw_grid + TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + TYPE(realspace_grid_desc_p_type), DIMENSION(:), & + POINTER :: rs_descs + TYPE(realspace_grid_input_type) :: input_settings + TYPE(realspace_grid_p_type), DIMENSION(:), POINTER :: rs_grids + TYPE(section_vals_type), POINTER :: force_env_section, force_env_sections, kind_section, & + md_section, mixed_section, print_section, root_section, rs_grid_section, subsys_section + + NULLIFY (cell_mix, subsys_mix, force_env_qs, force_env_section, subsys_section, & + print_section, root_section, kind_section, force_env_sections, rs_grid_section, & + mixed_section, md_section, mixed_env, mixed_cdft, pw_env, auxbas_pw_pool, & + pw_pools, qs_env, pw_grid, dft_control, sendbuffer, grid_span, odd, spherical, & + mixed_rs_dims, i_force_eval, recvbuffer, recvbuffer2, npts, rs_dims, atoms, & + settings_int, cutoff, rel_cutoff, coeffs, settings_real, confine_bounds, & + cutoffs, blacs_env, globenv, atomic_kind_set, qs_kind_set, rs_descs, rs_grids) + + is_qmmm = .FALSE. + logger => cp_get_default_logger() + CPASSERT(ASSOCIATED(force_env)) + CALL timeset(routineN, handle) + ! First determine if the calculation is pure DFT or QMMM and find the qs force_env + nforce_eval = SIZE(force_env%sub_force_env) + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + SELECT CASE (force_env%sub_force_env (iforce_eval)%force_env%in_use) + CASE (use_qs_force) + force_env_qs => force_env%sub_force_env(iforce_eval)%force_env + CASE (use_qmmm) + is_qmmm = .TRUE. + ! This is really the container for QMMM + force_env_qs => force_env%sub_force_env(iforce_eval)%force_env + CASE (use_qmmmx) + CALL cp_abort(__LOCATION__, & + "No force mixing allowed for mixed CDFT QM/MM") + CASE DEFAULT + CPASSERT(.FALSE.) + END SELECT + END DO + CPASSERT(ASSOCIATED(force_env_qs)) + CALL force_env_get(force_env=force_env, force_env_section=force_env_section) + ! Get infos about the mixed subsys + IF (.NOT. is_qmmm) THEN + CALL force_env_get(force_env=force_env, & + subsys=subsys_mix, & + cell=cell_mix) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles_mix) + ELSE + CALL get_qs_env(force_env_qs%qmmm_env%qs_env, & + cp_subsys=subsys_mix, & + cell=cell_mix) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles_mix) + END IF + ncpu = force_env%para_env%num_pe + mixed_env => force_env%mixed_env + mixed_section => section_vals_get_subs_vals(force_env_section, "MIXED") + print_section => section_vals_get_subs_vals(force_env_section, "MIXED%PRINT%PROGRAM_RUN_INFO") + iounit = cp_print_key_unit_nr(logger, print_section, '', extension='.mixedLog') + ! Init mixed_cdft_type + ALLOCATE (mixed_cdft) + CALL mixed_cdft_type_create(mixed_cdft) + ! Store QMMM flag + mixed_env%do_mixed_qmmm_cdft = is_qmmm + ! Setup dynamic load balancing + CALL section_vals_val_get(mixed_section, "LINEAR%MIXED_CDFT_DLB", l_val=mixed_cdft%dlb) + mixed_cdft%dlb = mixed_cdft%dlb .AND. calculate_forces ! disable if forces are not needed + IF (mixed_cdft%dlb) THEN + ALLOCATE (mixed_cdft%dlb_control) + NULLIFY (mixed_cdft%dlb_control%weight, mixed_cdft%dlb_control%gradients, & + mixed_cdft%dlb_control%cavity, mixed_cdft%dlb_control%target_list, & + mixed_cdft%dlb_control%bo, mixed_cdft%dlb_control%expected_work, & + mixed_cdft%dlb_control%prediction_error, mixed_cdft%dlb_control%sendbuff, & + mixed_cdft%dlb_control%recvbuff, mixed_cdft%dlb_control%recv_work_repl, & + mixed_cdft%dlb_control%recv_info) + CALL section_vals_val_get(mixed_section, "LINEAR%LOAD_SCALE", r_val=mixed_cdft%dlb_control%load_scale) + CALL section_vals_val_get(mixed_section, "LINEAR%VERY_OVERLOADED", & + r_val=mixed_cdft%dlb_control%very_overloaded) + CALL section_vals_val_get(mixed_section, "LINEAR%MORE_WORK", i_val=mixed_cdft%dlb_control%more_work) + END IF + ! Metric/Wavefunction overlap method + mixed_cdft%calculate_metric = .FALSE. + mixed_cdft%wfn_overlap_method = .FALSE. + IF (mixed_env%do_mixed_et) THEN + CALL section_vals_val_get(mixed_section, "LINEAR%MIXED_CDFT_METRIC", l_val=mixed_cdft%calculate_metric) + CALL section_vals_val_get(mixed_section, "LINEAR%MIXED_CDFT_WFN_OVERLAP", l_val=mixed_cdft%wfn_overlap_method) + END IF + ! Inversion method + CALL section_vals_val_get(mixed_section, "LINEAR%EPS_SVD", r_val=mixed_cdft%eps_svd) + IF (mixed_cdft%eps_svd .LT. 0.0_dp .OR. mixed_cdft%eps_svd .GT. 1.0_dp) & + CALL cp_abort(__LOCATION__, & + "Illegal value for EPS_SVD. Value must be between 0.0 and 1.0.") + ! Start building the mixed auxbas_pw_pool + CALL pw_grid_create(pw_grid, force_env%para_env%group) + CALL pw_env_create(mixed_cdft%pw_env) + ! Allocate storage for temporaries + ALLOCATE (grid_span(nforce_eval)) + grid_span = 0 + ALLOCATE (npts(3, nforce_eval)) + npts = 0 + ALLOCATE (cutoff(nforce_eval)) + cutoff = 0.0_dp + ALLOCATE (rel_cutoff(nforce_eval)) + rel_cutoff = 0.0_dp + ALLOCATE (spherical(nforce_eval)) + spherical = 0 + is_spherical = .FALSE. + ALLOCATE (rs_dims(2, nforce_eval)) + rs_dims = 0 + ALLOCATE (odd(nforce_eval)) + odd = 0 + is_odd = .FALSE. + ALLOCATE (atoms(SIZE(particles_mix%els), nforce_eval)) + atoms = 0 + ALLOCATE (coeffs(SIZE(particles_mix%els), nforce_eval)) + coeffs = 0.0_dp + ALLOCATE (settings_int(17, nforce_eval)) + settings_int = 0 + ALLOCATE (settings_real(6, nforce_eval)) + settings_real = 0.0_dp + ALLOCATE (confine_bounds(2, nforce_eval)) + confine_bounds = 0.0_dp + max_nkinds = 30 + ALLOCATE (cutoffs(max_nkinds, nforce_eval)) + cutoffs = 0.0_dp + ALLOCATE (radii(max_nkinds, nforce_eval)) + radii = 0.0_dp + ! Get information from the sub_force_envs + ! TODO: transfer logicals as logicals instead of ints + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + IF (is_qmmm) THEN + qs_env => force_env_qs%qmmm_env%qs_env + ELSE + CALL force_env_get(force_env_qs, qs_env=qs_env) + END IF + CALL get_qs_env(qs_env, pw_env=pw_env, dft_control=dft_control) + IF (.NOT. dft_control%qs_control%becke_restraint) & + CALL cp_abort(__LOCATION__, & + "Mixed CDFT currently only supports the Becke constraint."// & + "Becke constraint must be active in QS section of both force_evals!") + CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) + bo = auxbas_pw_pool%pw_grid%bounds_local + ! Only the rank 0 process collects info about pw_grid and becke + IF (force_env_qs%para_env%mepos == & + force_env_qs%para_env%source) THEN + grid_span(iforce_eval) = auxbas_pw_pool%pw_grid%grid_span + npts(:, iforce_eval) = auxbas_pw_pool%pw_grid%npts + cutoff(iforce_eval) = auxbas_pw_pool%pw_grid%cutoff + rel_cutoff(iforce_eval) = dft_control%qs_control%relative_cutoff + IF (auxbas_pw_pool%pw_grid%spherical) spherical(iforce_eval) = 1 + rs_dims(:, iforce_eval) = auxbas_pw_pool%pw_grid%para%rs_dims + IF (auxbas_pw_pool%pw_grid%grid_span == HALFSPACE) odd(iforce_eval) = 1 + IF (dft_control%qs_control%becke_control%natoms .GT. SIZE(atoms, 1)) & + CALL cp_abort(__LOCATION__, & + "More Becke constraint atoms than defined in mixed section."// & + " Use default values for MIXED\MAPPING.") + atoms(1:dft_control%qs_control%becke_control%natoms, iforce_eval) = dft_control%qs_control%becke_control%atoms + coeffs(1:dft_control%qs_control%becke_control%natoms, iforce_eval) = dft_control%qs_control%becke_control%coeff + ! Only GAPW needs to keep a copy of these arrays for constraint integration + IF (.NOT. dft_control%qs_control%gapw) THEN + DEALLOCATE (dft_control%qs_control%becke_control%atoms) + DEALLOCATE (dft_control%qs_control%becke_control%coeff) + END IF + settings_int(1, iforce_eval) = dft_control%qs_control%becke_control%confine_method + settings_int(2, iforce_eval) = dft_control%qs_control%becke_control%cutoff_type + IF (dft_control%qs_control%becke_control%confine) settings_int(3, iforce_eval) = 1 + IF (dft_control%qs_control%becke_control%dynamic_confine) settings_int(4, iforce_eval) = 1 + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + settings_int(5, iforce_eval) = 1 + CALL release_hirshfeld_type(dft_control%qs_control%becke_control%cavity_env) + END IF + IF (dft_control%qs_control%becke_control%should_skip) settings_int(6, iforce_eval) = 1 + IF (dft_control%qs_control%becke_control%print_cavity) settings_int(7, iforce_eval) = 1 + IF (dft_control%qs_control%becke_control%in_memory) settings_int(8, iforce_eval) = 1 + settings_int(9, iforce_eval) = dft_control%qs_control%becke_control%confine_dir + IF (dft_control%qs_control%becke_control%adjust) settings_int(10, iforce_eval) = 1 + IF (dft_control%qs_control%becke_control%atomic_charges) settings_int(11, iforce_eval) = 1 + settings_int(12, iforce_eval) = dft_control%qs_control%becke_control%cavity_shape + settings_int(13, iforce_eval) = dft_control%multiplicity + IF (qs_env%has_unit_metric) THEN + settings_int(14, iforce_eval) = 1 + ELSE + settings_int(14, iforce_eval) = 0 + END IF + settings_int(15, iforce_eval) = dft_control%qs_control%becke_control%constraint_type + settings_int(16, iforce_eval) = dft_control%qs_control%becke_control%combined_type + IF (dft_control%qs_control%becke_control%use_bohr) THEN + settings_int(17, iforce_eval) = 1 + ELSE + settings_int(17, iforce_eval) = 0 + END IF + settings_real(1, iforce_eval) = dft_control%qs_control%becke_control%dynamic_radius + settings_real(2, iforce_eval) = dft_control%qs_control%becke_control%rcavity + settings_real(3, iforce_eval) = dft_control%qs_control%becke_control%rglobal + settings_real(4, iforce_eval) = dft_control%qs_control%becke_control%eps_cavity + settings_real(5, iforce_eval) = dft_control%qs_control%eps_rho_rspace + settings_real(6, iforce_eval) = pw_env%cube_info(pw_env%auxbas_grid)%max_rad_ga + confine_bounds(:, iforce_eval) = dft_control%qs_control%becke_control%confine_bounds + IF (dft_control%qs_control%becke_control%cutoff_type == becke_cutoff_element) THEN + nkinds = SIZE(dft_control%qs_control%becke_control%cutoffs_tmp) + IF (nkinds .GT. max_nkinds) & + CALL cp_abort(__LOCATION__, & + "More than "//TRIM(cp_to_string(max_nkinds))//" unique elements"// & + "were defined in BECKE_RESTRAINT\ELEMENT_CUTOFF. Are you sure"// & + " your input is correct? If yes, please increase max_nkinds and recompile.") + cutoffs(1:nkinds, iforce_eval) = dft_control%qs_control%becke_control%cutoffs_tmp(:) + DEALLOCATE (dft_control%qs_control%becke_control%cutoffs_tmp) + END IF + IF (dft_control%qs_control%becke_control%adjust) THEN + CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set) + IF (.NOT. SIZE(atomic_kind_set) == SIZE(dft_control%qs_control%becke_control%radii_tmp)) & + CALL cp_abort(__LOCATION__, & + "Length of keyword BECKE_RESTRAINT\ATOMIC_RADII does not "// & + "match number of atomic kinds in the input coordinate file.") + nkinds = SIZE(dft_control%qs_control%becke_control%radii_tmp) + IF (nkinds .GT. max_nkinds) & + CALL cp_abort(__LOCATION__, & + "More than "//TRIM(cp_to_string(max_nkinds))//" unique elements"// & + "were defined in BECKE_RESTRAINT\ATOMIC_RADII. Are you sure"// & + " your input is correct? If yes, please increase max_nkinds and recompile.") + radii(1:nkinds, iforce_eval) = dft_control%qs_control%becke_control%radii_tmp(:) + DEALLOCATE (dft_control%qs_control%becke_control%radii_tmp) + END IF + END IF + END DO + ! Make sure the grids are consistent + CALL mp_sum(grid_span, force_env%para_env%group) + CALL mp_sum(npts, force_env%para_env%group) + CALL mp_sum(cutoff, force_env%para_env%group) + CALL mp_sum(rel_cutoff, force_env%para_env%group) + CALL mp_sum(spherical, force_env%para_env%group) + CALL mp_sum(rs_dims, force_env%para_env%group) + CALL mp_sum(odd, force_env%para_env%group) + is_match = .TRUE. + is_match = is_match .AND. (grid_span(1) == grid_span(2)) + is_match = is_match .AND. (npts(1, 1) == npts(1, 2)) + is_match = is_match .AND. (cutoff(1) == cutoff(2)) + is_match = is_match .AND. (rel_cutoff(1) == rel_cutoff(2)) + is_match = is_match .AND. (spherical(1) == spherical(2)) + is_match = is_match .AND. (rs_dims(1, 1) == rs_dims(1, 2)) + is_match = is_match .AND. (rs_dims(2, 1) == rs_dims(2, 2)) + is_match = is_match .AND. (odd(1) == odd(2)) + IF (.NOT. is_match) & + CALL cp_abort(__LOCATION__, & + "Mismatch detected in the &MGRID settings of the two force_evals.") + IF (spherical(1) == 1) is_spherical = .TRUE. + IF (odd(1) == 1) is_odd = .TRUE. + ! Make sure Becke settings are consistent and transfer them + CALL mp_sum(atoms, force_env%para_env%group) + CALL mp_sum(coeffs, force_env%para_env%group) + nbecke = 0 + nkinds = 0 + DO i = 1, SIZE(atoms, 1) + IF (atoms(i, 1) /= atoms(i, 2)) is_match = .FALSE. + IF (coeffs(i, 1) /= coeffs(i, 2)) is_match = .FALSE. + IF (atoms(i, 1) /= 0) nbecke = nbecke+1 + END DO + IF (.NOT. is_match) & + CALL cp_abort(__LOCATION__, & + "Mismatch detected in the &BECKE_RESTRAINT settings of the two force_evals.") + CALL becke_control_create(mixed_cdft%becke_control) + ALLOCATE (mixed_cdft%becke_control%atoms(nbecke)) + mixed_cdft%becke_control%atoms = atoms(1:nbecke, 1) + ALLOCATE (mixed_cdft%becke_control%coeff(nbecke)) + mixed_cdft%becke_control%coeff = coeffs(1:nbecke, 1) + mixed_cdft%becke_control%natoms = nbecke + CALL mp_sum(settings_int, force_env%para_env%group) + CALL mp_sum(settings_real, force_env%para_env%group) + CALL mp_sum(confine_bounds, force_env%para_env%group) + DO i = 1, SIZE(settings_int, 1) + IF (settings_int(i, 1) /= settings_int(i, 2)) is_match = .FALSE. + IF (i <= 5) THEN + IF (settings_real(i, 1) /= settings_real(i, 2)) is_match = .FALSE. + END IF + END DO + IF (.NOT. is_match) & + CALL cp_abort(__LOCATION__, & + "Mismatch detected in the &BECKE_RESTRAINT settings of the two force_evals.") + is_match = is_match .AND. (confine_bounds(1, 1) == confine_bounds(1, 2)) + is_match = is_match .AND. (confine_bounds(2, 1) == confine_bounds(2, 2)) + IF (.NOT. is_match) & + CALL cp_abort(__LOCATION__, & + "Mismatch detected in the &BECKE_RESTRAINT&CONFINE_BOUNDS"// & + " settings of the two force_evals.") + mixed_cdft%becke_control%confine_method = settings_int(1, 1) + mixed_cdft%becke_control%cutoff_type = settings_int(2, 1) + nkinds = 0 + IF (mixed_cdft%becke_control%cutoff_type == becke_cutoff_element) THEN + CALL mp_sum(cutoffs, force_env%para_env%group) + DO i = 1, SIZE(cutoffs, 1) + IF (cutoffs(i, 1) /= cutoffs(i, 2)) is_match = .FALSE. + IF (cutoffs(i, 1) /= 0.0_dp) nkinds = nkinds+1 + END DO + IF (.NOT. is_match) & + CALL cp_abort(__LOCATION__, & + "Mismatch detected in the &BECKE_RESTRAINT&ELEMENT_CUTOFF"// & + " settings of the two force_evals.") + ALLOCATE (mixed_cdft%becke_control%cutoffs_tmp(nkinds)) + mixed_cdft%becke_control%cutoffs_tmp = cutoffs(1:nkinds, 1) + END IF + IF (settings_int(3, 1) == 1) mixed_cdft%becke_control%confine = .TRUE. + IF (settings_int(4, 1) == 1) mixed_cdft%becke_control%dynamic_confine = .TRUE. + IF (settings_int(5, 1) == 1) mixed_cdft%becke_control%cavity_confine = .TRUE. + IF (settings_int(6, 1) == 1) mixed_cdft%becke_control%should_skip = .TRUE. + IF (settings_int(7, 1) == 1) mixed_cdft%becke_control%print_cavity = .TRUE. + IF (settings_int(8, 1) == 1) mixed_cdft%becke_control%in_memory = .TRUE. + mixed_cdft%becke_control%confine_dir = settings_int(9, 1) + IF (settings_int(10, 1) == 1) mixed_cdft%becke_control%adjust = .TRUE. + IF (mixed_cdft%becke_control%adjust) THEN + CALL mp_sum(radii, force_env%para_env%group) + DO i = 1, SIZE(radii, 1) + IF (radii(i, 1) /= radii(i, 2)) is_match = .FALSE. + IF (radii(i, 1) /= 0.0_dp) nkinds = nkinds+1 + END DO + IF (.NOT. is_match) & + CALL cp_abort(__LOCATION__, & + "Mismatch detected in the &BECKE_RESTRAINT&ATOMIC_RADII"// & + " settings of the two force_evals.") + ALLOCATE (mixed_cdft%becke_control%radii(nkinds)) + mixed_cdft%becke_control%radii = radii(1:nkinds, 1) + END IF + IF (settings_int(11, 1) == 1) mixed_cdft%becke_control%atomic_charges = .TRUE. + mixed_cdft%becke_control%cavity_shape = settings_int(12, 1) + mixed_cdft%multiplicity = settings_int(13, 1) + mixed_cdft%has_unit_metric = .FALSE. + IF (settings_int(14, 1) == 1) mixed_cdft%has_unit_metric = .FALSE. + mixed_cdft%constraint_type = settings_int(15, 1) + IF (mixed_cdft%constraint_type /= cdft_density_constraint) & + CALL cp_abort(__LOCATION__, & + "Unsupported constraint type. Mixed CDFT only accepts total density "// & + " density constraints at this moment.") + mixed_cdft%combined_type = settings_int(16, 1) + IF (settings_int(17, 1) == 1) mixed_cdft%becke_control%use_bohr = .TRUE. + mixed_cdft%becke_control%dynamic_radius = settings_real(1, 1) + mixed_cdft%becke_control%rcavity = settings_real(2, 1) + mixed_cdft%becke_control%rglobal = settings_real(3, 1) + mixed_cdft%becke_control%eps_cavity = settings_real(4, 1) + mixed_cdft%eps_rho_rspace = settings_real(5, 1) + mixed_cdft%becke_control%confine_bounds = confine_bounds(:, 1) + radius = settings_real(6, 1) + ! Initialize Gaussian cavity confinement + IF (mixed_cdft%becke_control%cavity_confine) THEN + CALL create_hirshfeld_type(mixed_cdft%becke_control%cavity_env) + CALL set_hirshfeld_info(mixed_cdft%becke_control%cavity_env, & + shape_function_type=shape_function_gaussian, iterative=.FALSE., & + radius_type=mixed_cdft%becke_control%cavity_shape, & + use_bohr=mixed_cdft%becke_control%use_bohr) + END IF + mixed_cdft%first_iteration = .TRUE. + ! MD related settings + CALL force_env_get(force_env, root_section=root_section) + md_section => section_vals_get_subs_vals(root_section, "MOTION%MD") + CALL section_vals_val_get(md_section, "TIMESTEP", r_val=mixed_cdft%sim_dt) + CALL section_vals_val_get(md_section, "STEP_START_VAL", i_val=mixed_cdft%sim_step) + mixed_cdft%sim_step = mixed_cdft%sim_step-1 ! to get the first step correct + mixed_cdft%sim_dt = cp_unit_from_cp2k(mixed_cdft%sim_dt, "fs") + ! Some CDFT features are currently disabled for mixed calculations: check that these features were not requested + IF (.NOT. mixed_cdft%becke_control%confine_dir == 3) & + CALL cp_abort(__LOCATION__, & + "Only z-direction allowed for static/dynamic confinement with mixed CDFT") + IF (mixed_cdft%becke_control%atomic_charges) & + CALL cp_abort(__LOCATION__, & + "Calculation of atomic Becke charges not supported with mixed CDFT") + IF (mixed_cdft%dlb .AND. .NOT. mixed_cdft%becke_control%cavity_confine) & + CALL cp_abort(__LOCATION__, & + "Mixed CDFT load balancing requires Gaussian cavity confinement.") + ! Decide what kind of layout to use and setup the grid + ! Processor mappings currently supported: + ! (2np,1) --> (np,1) + ! (nx,2ny) --> (nx,ny) + ! (nx,ny) --> (nx*ny/2,1) (required when xc_smooth is in use and with intermediate proc counts) + ! + ! For cases 2 and 3, dlb redistributes YZ slices from overloaded processors to underloaded processors + ! For case 1, XZ slices are redistributed + ! These mappings could be unified. Now we essentially have separate code for cases 1-2 and 3. + ! This leads to very messy code especially with dlb turned on... + ! In terms of memory usage, it would be beneficial to replace case 1 with 3 + ! and implement a similar arbitrary mapping to replace case 2 + + mixed_cdft%is_pencil = .FALSE. ! Flag to control the first two mappings + mixed_cdft%is_special = .FALSE. ! Flag to control the last mapping + ! With xc smoothing, the grid is always (ncpu/2,1) distributed + ! and correct behavior cannot be guaranteed for ncpu/2 > nx, so we abort... + IF (ncpu/2 .GT. npts(1, 1)) & + CALL cp_abort(__LOCATION__, & + "ncpu/2 => nx: decrease ncpu or disable xc_smoothing") + ! + ALLOCATE (mixed_rs_dims(2)) + IF (rs_dims(2, 1) /= 1) mixed_cdft%is_pencil = .TRUE. + IF (.NOT. mixed_cdft%is_pencil .AND. ncpu .GT. npts(1, 1)) mixed_cdft%is_special = .TRUE. + IF (mixed_cdft%is_special) THEN + mixed_rs_dims = (/-1, -1/) + ELSE IF (mixed_cdft%is_pencil) THEN + mixed_rs_dims = (/rs_dims(1, 1), 2*rs_dims(2, 1)/) + ELSE + mixed_rs_dims = (/2*rs_dims(1, 1), 1/) + END IF + CALL pw_grid_setup(cell_mix%hmat, pw_grid, grid_span=grid_span(1), npts=npts(:, 1), & + cutoff=cutoff(1), spherical=is_spherical, odd=is_odd, & + fft_usage=.TRUE., ncommensurate=0, icommensurate=1, & + blocked=do_pw_grid_blocked_false, rs_dims=mixed_rs_dims, & + iounit=iounit) + ! Check if the layout was succesfully created + IF (mixed_cdft%is_special) THEN + IF (.NOT. pw_grid%para%rs_dims(2) /= 1) is_match = .FALSE. + ELSE IF (mixed_cdft%is_pencil) THEN + IF (.NOT. pw_grid%para%rs_dims(1) == mixed_rs_dims(1)) is_match = .FALSE. + ELSE + IF (.NOT. pw_grid%para%rs_dims(2) == 1) is_match = .FALSE. + END IF + IF (.NOT. is_match) & + CALL cp_abort(__LOCATION__, & + "Unable to create a suitable grid distribution "// & + "for mixed CDFT calculations. Try decreasing the total number "// & + " of processors or disabling xc_smoothing.") + ! Deallocate temporaries + DEALLOCATE (mixed_rs_dims) + DEALLOCATE (grid_span) + DEALLOCATE (npts) + DEALLOCATE (spherical) + DEALLOCATE (rs_dims) + DEALLOCATE (odd) + DEALLOCATE (atoms) + DEALLOCATE (coeffs) + DEALLOCATE (cutoffs) + DEALLOCATE (radii) + DEALLOCATE (settings_int) + DEALLOCATE (settings_real) + DEALLOCATE (confine_bounds) + ! Create the pool + bo_mixed = pw_grid%bounds_local + ALLOCATE (pw_pools(1)) + NULLIFY (pw_pools(1)%pool) + CALL pw_pool_create(pw_pools(1)%pool, pw_grid=pw_grid) + ! Gaussian confinement/wavefunction overlap method needs qs_kind_set + ! Gaussian cavity confinement also needs the auxbas_rs_grid + IF (mixed_cdft%becke_control%cavity_confine .OR. & + mixed_cdft%wfn_overlap_method) THEN + print_section => section_vals_get_subs_vals(force_env_section, & + "PRINT%GRID_INFORMATION") + ALLOCATE (mixed_cdft%pw_env%gridlevel_info) + CALL init_gaussian_gridlevel(mixed_cdft%pw_env%gridlevel_info, & + ngrid_levels=1, cutoff=cutoff, & + rel_cutoff=rel_cutoff(1), & + print_section=print_section) + ALLOCATE (rs_descs(1)) + ALLOCATE (rs_grids(1)) + ALLOCATE (mixed_cdft%pw_env%cube_info(1)) + higher_grid_layout = (/-1, -1, -1/) + CALL init_d3_poly_module() + CALL init_cube_info(mixed_cdft%pw_env%cube_info(1), & + pw_grid%dr(:), pw_grid%dh(:, :), & + pw_grid%dh_inv(:, :), & + pw_grid%orthorhombic, radius) + NULLIFY (root_section, force_env_section, force_env_sections, rs_grid_section) + CALL force_env_get(force_env, root_section=root_section) + force_env_sections => section_vals_get_subs_vals(root_section, "FORCE_EVAL") + CALL multiple_fe_list(force_env_sections, root_section, i_force_eval, n_force_eval) + CALL section_vals_duplicate(force_env_sections, force_env_section, & + i_force_eval(2), i_force_eval(2)) + rs_grid_section => section_vals_get_subs_vals(force_env_section, "DFT%MGRID%RS_GRID") + CALL init_input_type(input_settings, & + nsmax=2*MAX(1, return_cube_max_iradius(mixed_cdft%pw_env%cube_info(1)))+1, & + rs_grid_section=rs_grid_section, ilevel=1, & + higher_grid_layout=higher_grid_layout) + NULLIFY (rs_descs(1)%rs_desc) + CALL rs_grid_create_descriptor(rs_descs(1)%rs_desc, pw_grid, input_settings) + IF (rs_descs(1)%rs_desc%distributed) higher_grid_layout = rs_descs(1)%rs_desc%group_dim + NULLIFY (rs_grids(1)%rs_grid) + CALL rs_grid_create(rs_grids(1)%rs_grid, rs_descs(1)%rs_desc) + CALL rs_grid_print(rs_grids(1)%rs_grid, iounit) + mixed_cdft%pw_env%rs_descs => rs_descs + mixed_cdft%pw_env%rs_grids => rs_grids + ! qs_kind_set + subsys_section => section_vals_get_subs_vals(force_env_sections, "SUBSYS", & + i_rep_section=i_force_eval(1)) + kind_section => section_vals_get_subs_vals(subsys_section, "KIND") + NULLIFY (qs_kind_set) + CALL cp_subsys_get(subsys_mix, atomic_kind_set=atomic_kind_set) + CALL create_qs_kind_set(qs_kind_set, atomic_kind_set, kind_section, & + force_env%para_env, force_env_section) + mixed_cdft%qs_kind_set => qs_kind_set + DEALLOCATE (i_force_eval) + CALL section_vals_release(force_env_section) + END IF + CALL force_env_get(force_env=force_env, & + force_env_section=force_env_section) + DEALLOCATE (cutoff, rel_cutoff) + CALL pw_grid_release(pw_grid) + mixed_cdft%pw_env%auxbas_grid = 1 + NULLIFY (mixed_cdft%pw_env%pw_pools) + mixed_cdft%pw_env%pw_pools => pw_pools + ! Determine which processors need to exchange data when redistributing the weight/gradient + IF (.NOT. mixed_cdft%is_special) THEN + ALLOCATE (mixed_cdft%dest_list(2)) + ALLOCATE (mixed_cdft%source_list(2)) + imap = force_env%para_env%mepos/2 + mixed_cdft%dest_list = (/imap, imap+force_env%para_env%num_pe/2/) + imap = MOD(force_env%para_env%mepos, force_env%para_env%num_pe/2)+ & + MODULO(force_env%para_env%mepos, force_env%para_env%num_pe/2) + mixed_cdft%source_list = (/imap, imap+1/) + ! Determine bounds of the data that is replicated + ALLOCATE (mixed_cdft%recv_bo(4)) + ALLOCATE (sendbuffer(2), recvbuffer(2), recvbuffer2(2)) + IF (mixed_cdft%is_pencil) THEN + sendbuffer = (/bo_mixed(1, 2), bo_mixed(2, 2)/) + ELSE + sendbuffer = (/bo_mixed(1, 1), bo_mixed(2, 1)/) + END IF + ! Communicate bounds in steps + CALL mp_isend(msgin=sendbuffer, dest=mixed_cdft%dest_list(1), & + request=req(1), comm=force_env%para_env%group) + CALL mp_irecv(msgout=recvbuffer, source=mixed_cdft%source_list(1), & + request=req(2), comm=force_env%para_env%group) + CALL mp_irecv(msgout=recvbuffer2, source=mixed_cdft%source_list(2), & + request=req(3), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + CALL mp_isend(msgin=sendbuffer, dest=mixed_cdft%dest_list(2), & + request=req(1), comm=force_env%para_env%group) + CALL mp_waitall(req) + mixed_cdft%recv_bo(1:2) = recvbuffer + mixed_cdft%recv_bo(3:4) = recvbuffer2 + DEALLOCATE (sendbuffer, recvbuffer, recvbuffer2) + ELSE + ! work out the pw grid points each proc holds in the two (identical) parallel proc groups + ! note we only care about the x dir since we assume the y dir is not subdivided + ALLOCATE (bounds(0:auxbas_pw_pool%pw_grid%para%group_size-1, 1:2)) + DO i = 0, auxbas_pw_pool%pw_grid%para%group_size-1 + bounds(i, 1:2) = auxbas_pw_pool%pw_grid%para%bo(1:2, 1, i, 1) + bounds(i, 1:2) = bounds(i, 1:2)-auxbas_pw_pool%pw_grid%npts(1)/2-1 + END DO + ! work out which procs to send my grid points + ! first get the number of target procs per group + ntargets = 0 + offset = -1 + DO i = 0, auxbas_pw_pool%pw_grid%para%group_size-1 + IF ((bounds(i, 1) .GE. bo_mixed(1, 1) .AND. bounds(i, 1) .LE. bo_mixed(2, 1)) .OR. & + (bounds(i, 2) .GE. bo_mixed(1, 1) .AND. bounds(i, 2) .LE. bo_mixed(2, 1))) THEN + ntargets = ntargets+1 + IF (offset == -1) offset = i + ELSE IF (bounds(i, 2) .GT. bo_mixed(2, 1)) THEN + EXIT + ELSE + CYCLE + END IF + END DO + ALLOCATE (mixed_cdft%dest_list(ntargets)) + ALLOCATE (mixed_cdft%dest_list_bo(2, ntargets)) + ! now determine the actual grid points to send + j = 1 + DO i = offset, offset+ntargets-1 + mixed_cdft%dest_list(j) = i + mixed_cdft%dest_list_bo(:, j) = (/bo_mixed(1, 1)+(bounds(i, 1)-bo_mixed(1, 1)), & + bo_mixed(2, 1)+(bounds(i, 2)-bo_mixed(2, 1))/) + j = j+1 + END DO + ALLOCATE (mixed_cdft%dest_list_save(ntargets), mixed_cdft%dest_bo_save(2, ntargets)) + ! We need to store backups of these arrays since they might get reallocated during dlb + mixed_cdft%dest_list_save = mixed_cdft%dest_list + mixed_cdft%dest_bo_save = mixed_cdft%dest_list_bo + ! finally determine which procs will send me grid points + ! now we need info about y dir also + DEALLOCATE (bounds) + ALLOCATE (bounds(0:pw_pools(1)%pool%pw_grid%para%group_size-1, 1:4)) + DO i = 0, pw_pools(1)%pool%pw_grid%para%group_size-1 + bounds(i, 1:2) = pw_pools(1)%pool%pw_grid%para%bo(1:2, 1, i, 1) + bounds(i, 3:4) = pw_pools(1)%pool%pw_grid%para%bo(1:2, 2, i, 1) + bounds(i, 1:2) = bounds(i, 1:2)-pw_pools(1)%pool%pw_grid%npts(1)/2-1 + bounds(i, 3:4) = bounds(i, 3:4)-pw_pools(1)%pool%pw_grid%npts(2)/2-1 + END DO + ntargets = 0 + offset = -1 + DO i = 0, pw_pools(1)%pool%pw_grid%para%group_size-1 + IF ((bo(1, 1) .GE. bounds(i, 1) .AND. bo(1, 1) .LE. bounds(i, 2)) .OR. & + (bo(2, 1) .GE. bounds(i, 1) .AND. bo(2, 1) .LE. bounds(i, 2))) THEN + ntargets = ntargets+1 + IF (offset == -1) offset = i + ELSE IF (bo(2, 1) .LT. bounds(i, 1)) THEN + EXIT + ELSE + CYCLE + END IF + END DO + ALLOCATE (mixed_cdft%source_list(ntargets)) + ALLOCATE (mixed_cdft%source_list_bo(4, ntargets)) + j = 1 + DO i = offset, offset+ntargets-1 + mixed_cdft%source_list(j) = i + IF (bo(1, 1) .GE. bounds(i, 1) .AND. bo(2, 1) .LE. bounds(i, 2)) THEN + mixed_cdft%source_list_bo(:, j) = (/bo(1, 1), bo(2, 1), & + bounds(i, 3), bounds(i, 4)/) + ELSE IF (bo(1, 1) .GE. bounds(i, 1) .AND. bo(1, 1) .LE. bounds(i, 2)) THEN + mixed_cdft%source_list_bo(:, j) = (/bo(1, 1), bounds(i, 2), & + bounds(i, 3), bounds(i, 4)/) + ELSE + mixed_cdft%source_list_bo(:, j) = (/bounds(i, 1), bo(2, 1), & + bounds(i, 3), bounds(i, 4)/) + END IF + j = j+1 + END DO + ALLOCATE (mixed_cdft%source_list_save(ntargets), mixed_cdft%source_bo_save(4, ntargets)) + ! We need to store backups of these arrays since they might get reallocated during dlb + mixed_cdft%source_list_save = mixed_cdft%source_list + mixed_cdft%source_bo_save = mixed_cdft%source_list_bo + DEALLOCATE (bounds) + END IF + ! Setup mixed blacs_env for redistributing arrays during ET coupling calculation + IF (mixed_env%do_mixed_et) THEN + NULLIFY (root_section) + CALL force_env_get(force_env, globenv=globenv, root_section=root_section) + CALL cp_blacs_env_create(blacs_env, force_env%para_env, globenv%blacs_grid_layout, & + globenv%blacs_repeatable) + mixed_cdft%blacs_env => blacs_env + CALL cp_blacs_env_retain(mixed_cdft%blacs_env) + CALL cp_blacs_env_release(blacs_env) + END IF + ! Write information about the mixed CDFT calculation + IF (iounit > 0) THEN + WRITE (iounit, *) "" + WRITE (iounit, FMT="(T2,A,T71)") "MIXED_CDFT| Activating mixed CDFT calculation" + WRITE (iounit, FMT="(T2,A,T71)") "MIXED_CDFT| Becke constraint is first built using all available processors" + WRITE (iounit, FMT="(T2,A,T71)") "MIXED_CDFT| and then copied to both states with their own processor groups" + WRITE (iounit, FMT="(T2,A,T71,L10)") & + "MIXED_CDFT| Calculating electronic coupling between states: ", mixed_env%do_mixed_et + WRITE (iounit, FMT="(T2,A,T71,L10)") & + "MIXED_CDFT| Dynamic load balancing enabled: ", mixed_cdft%dlb + IF (mixed_cdft%dlb) THEN + WRITE (iounit, FMT="(T2,A,T71)") "MIXED_CDFT| Dynamic load balancing parameters: " + WRITE (iounit, FMT="(T2,A,T71,F10.2)") & + "MIXED_CDFT| load_scale:", mixed_cdft%dlb_control%load_scale + WRITE (iounit, FMT="(T2,A,T71,F10.2)") & + "MIXED_CDFT| very_overloaded:", mixed_cdft%dlb_control%very_overloaded + WRITE (iounit, FMT="(T2,A,T71,I10)") & + "MIXED_CDFT| more_work:", mixed_cdft%dlb_control%more_work + END IF + IF (mixed_env%do_mixed_et) THEN + IF (mixed_cdft%eps_svd == 0.0_dp) THEN + WRITE (iounit, FMT="(T2,A,T71)") "MIXED_CDFT| Matrix inversions calculated with LU decomposition." + ELSE + WRITE (iounit, FMT="(T2,A,T71)") "MIXED_CDFT| Matrix inversions calculated with SVD decomposition." + WRITE (iounit, FMT="(T2,A,T71,ES10.2)") "MIXED_CDFT| EPS_SVD:", mixed_cdft%eps_svd + END IF + END IF + END IF + CALL set_mixed_env(mixed_env, cdft_control=mixed_cdft) + CALL cp_print_key_finished_output(iounit, logger, force_env_section, & + "MIXED%PRINT%PROGRAM_RUN_INFO") + CALL timestop(handle) + + END SUBROUTINE mixed_cdft_init + +! ************************************************************************************************** +!> \brief Build CDFT weight and gradient in parallel on all available processors +!> \param force_env the force_env that holds the CDFT states +!> \param calculate_forces determines if forces should be calculted +!> \par History +!> 01.2016 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE mixed_cdft_build_weight(force_env, calculate_forces) + TYPE(force_env_type), POINTER :: force_env + LOGICAL, INTENT(IN) :: calculate_forces + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_build_weight', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, handle2, i, iforce_eval, ind, INDEX(6), iounit, j, lb_min, & + my_special_work, natom, nforce_eval, recv_offset, req(3), ub_max + INTEGER, DIMENSION(2, 3) :: bo + INTEGER, DIMENSION(:), POINTER :: lb, req_total, sendbuffer_i, ub + REAL(KIND=dp) :: t1, t2 + TYPE(cp_logger_type), POINTER :: logger + TYPE(cp_subsys_type), POINTER :: subsys_mix + TYPE(dft_control_type), POINTER :: dft_control + TYPE(force_env_type), POINTER :: force_env_qs + TYPE(mixed_cdft_type), POINTER :: mixed_cdft + TYPE(mixed_environment_type), POINTER :: mixed_env + TYPE(particle_list_type), POINTER :: particles_mix + TYPE(pw_env_type), POINTER :: pw_env + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool, mixed_auxbas_pw_pool + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(section_vals_type), POINTER :: force_env_section, print_section + + TYPE buffers + INTEGER :: imap(6) + INTEGER, DIMENSION(:), & + POINTER :: iv => null() + LOGICAL, DIMENSION(:, :, :), & + POINTER :: b3 => null() + REAL(KIND=dp), POINTER, & + DIMENSION(:, :, :) :: r3 => null() + REAL(KIND=dp), POINTER, & + DIMENSION(:, :, :, :) :: r4 => null() + END TYPE buffers + TYPE(buffers), DIMENSION(:), POINTER :: recvbuffer + + NULLIFY (subsys_mix, force_env_qs, particles_mix, force_env_section, print_section, & + mixed_env, mixed_cdft, pw_env, auxbas_pw_pool, mixed_auxbas_pw_pool, & + qs_env, dft_control, sendbuffer_i, lb, ub, req_total, recvbuffer) + + logger => cp_get_default_logger() + CPASSERT(ASSOCIATED(force_env)) + nforce_eval = SIZE(force_env%sub_force_env) + CALL timeset(routineN, handle) + t1 = m_walltime() + ! Get infos about the mixed subsys + CALL force_env_get(force_env=force_env, & + subsys=subsys_mix, & + force_env_section=force_env_section) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles_mix) + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + SELECT CASE (force_env%sub_force_env (iforce_eval)%force_env%in_use) + CASE (use_qs_force) + force_env_qs => force_env%sub_force_env(iforce_eval)%force_env + CASE (use_qmmm) + force_env_qs => force_env%sub_force_env(iforce_eval)%force_env + CASE DEFAULT + CPASSERT(.FALSE.) + END SELECT + END DO + IF (.NOT. force_env%mixed_env%do_mixed_qmmm_cdft) THEN + CALL force_env_get(force_env=force_env_qs, & + qs_env=qs_env, & + subsys=subsys_mix) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles_mix) + ELSE + qs_env => force_env_qs%qmmm_env%qs_env + CALL get_qs_env(qs_env, cp_subsys=subsys_mix) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles_mix) + END IF + mixed_env => force_env%mixed_env + print_section => section_vals_get_subs_vals(force_env_section, "MIXED%PRINT%PROGRAM_RUN_INFO") + iounit = cp_print_key_unit_nr(logger, print_section, '', extension='.mixedLog') + CALL get_mixed_env(mixed_env, cdft_control=mixed_cdft) + CPASSERT(ASSOCIATED(mixed_cdft)) + ! Calculate the Becke weight function and gradient on all np processors + CALL pw_env_get(pw_env=mixed_cdft%pw_env, auxbas_pw_pool=mixed_auxbas_pw_pool) + natom = SIZE(particles_mix%els) + CALL mixed_becke_constraint(force_env, calculate_forces) + ! Start replicating the working arrays on both np/2 processor groups + mixed_cdft%sim_step = mixed_cdft%sim_step+1 + CALL get_qs_env(qs_env, pw_env=pw_env, dft_control=dft_control) + CPASSERT(dft_control%qs_control%becke_restraint) + CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) + bo = auxbas_pw_pool%pw_grid%bounds_local + ! First determine the size of the arrays along the confinement dir + IF (mixed_cdft%is_special) THEN + my_special_work = 2 + ELSE + my_special_work = 1 + END IF + ALLOCATE (recvbuffer(SIZE(mixed_cdft%source_list))) + ALLOCATE (req_total(my_special_work*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list))) + ALLOCATE (lb(SIZE(mixed_cdft%source_list)), ub(SIZE(mixed_cdft%source_list))) + IF (mixed_cdft%becke_control%cavity_confine .AND. & + .NOT. mixed_cdft%becke_control%dynamic_confine) THEN + ! Only Gaussian confinement => the bounds depend on the processor and need to be communicated + ALLOCATE (sendbuffer_i(2)) + IF (mixed_cdft%becke_control%confine_bounds_int(2) .LT. & + mixed_auxbas_pw_pool%pw_grid%bounds_local(2, 3)) THEN + sendbuffer_i(2) = mixed_cdft%becke_control%confine_bounds_int(2)-1 + ELSE + sendbuffer_i(2) = mixed_cdft%becke_control%confine_bounds_int(2) + END IF + IF (mixed_cdft%becke_control%confine_bounds_int(1) .GT. & + mixed_auxbas_pw_pool%pw_grid%bounds_local(1, 3)) THEN + sendbuffer_i(1) = mixed_cdft%becke_control%confine_bounds_int(1)+1 + ELSE + sendbuffer_i(1) = mixed_cdft%becke_control%confine_bounds_int(1) + END IF + DO i = 1, SIZE(mixed_cdft%source_list) + ALLOCATE (recvbuffer(i)%iv(2)) + CALL mp_irecv(msgout=recvbuffer(i)%iv, source=mixed_cdft%source_list(i), & + request=req_total(i), & + comm=force_env%para_env%group) + END DO + DO i = 1, my_special_work + DO j = 1, SIZE(mixed_cdft%dest_list) + ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list) + CALL mp_isend(msgin=sendbuffer_i, & + dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + request=req_total(ind), & + comm=force_env%para_env%group) + END DO + END DO + CALL mp_waitall(req_total) + ! Find the largest/smallest value of ub/lb + DEALLOCATE (sendbuffer_i) + lb_min = HUGE(0) + ub_max = -HUGE(0) + DO i = 1, SIZE(mixed_cdft%source_list) + lb(i) = recvbuffer(i)%iv(1) + ub(i) = recvbuffer(i)%iv(2) + IF (lb(i) .LT. lb_min) lb_min = lb(i) + IF (ub(i) .GT. ub_max) ub_max = ub(i) + DEALLOCATE (recvbuffer(i)%iv) + END DO + ! Take into account the grids already communicated during dlb + IF (mixed_cdft%dlb) THEN + IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + DO j = 1, SIZE(mixed_cdft%dlb_control%recv_work_repl) + IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN + DO i = 1, SIZE(mixed_cdft%dlb_control%recvbuff(j)%buffs) + IF (LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 3) & + .LT. lb_min) lb_min = LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 3) + IF (UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 3) & + .GT. ub_max) ub_max = UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 3) + END DO + END IF + END DO + END IF + END IF + ELSE IF (mixed_cdft%becke_control%dynamic_confine .OR. & + mixed_cdft%becke_control%confine) THEN + ! No Gaussian confinement or mixed confinement => the bounds are the same on all processors + ub_max = mixed_cdft%becke_control%confine_bounds_int(2)-1 + lb_min = mixed_cdft%becke_control%confine_bounds_int(1)+1 + lb = lb_min + ub = ub_max + ELSE + ! No confinement + ub_max = bo(2, 3) + lb_min = bo(1, 3) + lb = lb_min + ub = ub_max + END IF + ! Determine the sender specific indices of grid slices that are to be received + CALL timeset(routineN//"_comm", handle2) + DO j = 1, SIZE(recvbuffer) + ind = j+(j/2) + IF (mixed_cdft%is_special) THEN + recvbuffer(j)%imap = (/mixed_cdft%source_list_bo(1, j), mixed_cdft%source_list_bo(2, j), & + mixed_cdft%source_list_bo(3, j), mixed_cdft%source_list_bo(4, j), & + lb(j), ub(j)/) + ELSE IF (mixed_cdft%is_pencil) THEN + recvbuffer(j)%imap = (/bo(1, 1), bo(2, 1), mixed_cdft%recv_bo(ind), mixed_cdft%recv_bo(ind+1), lb(j), ub(j)/) + ELSE + recvbuffer(j)%imap = (/mixed_cdft%recv_bo(ind), mixed_cdft%recv_bo(ind+1), bo(1, 2), bo(2, 2), lb(j), ub(j)/) + END IF + END DO + IF (mixed_cdft%dlb .AND. .NOT. mixed_cdft%is_special) THEN + IF (mixed_cdft%dlb_control%recv_work_repl(1) .OR. mixed_cdft%dlb_control%recv_work_repl(2)) THEN + DO j = 1, 2 + recv_offset = 0 + IF (mixed_cdft%dlb_control%recv_work_repl(j)) & + recv_offset = SUM(mixed_cdft%dlb_control%recv_info(j)%target_list(2, :)) + IF (mixed_cdft%is_pencil) THEN + recvbuffer(j)%imap(1) = recvbuffer(j)%imap(1)+recv_offset + ELSE + recvbuffer(j)%imap(3) = recvbuffer(j)%imap(3)+recv_offset + END IF + END DO + END IF + END IF + ! Transfer the arrays one-by-one and deallocate shared storage + ! Start with theweight function + DO j = 1, SIZE(mixed_cdft%source_list) + ALLOCATE (recvbuffer(j)%r3(recvbuffer(j)%imap(1):recvbuffer(j)%imap(2), & + recvbuffer(j)%imap(3):recvbuffer(j)%imap(4), & + recvbuffer(j)%imap(5):recvbuffer(j)%imap(6))) + + CALL mp_irecv(msgout=recvbuffer(j)%r3, source=mixed_cdft%source_list(j), & + request=req_total(j), comm=force_env%para_env%group) + END DO + DO i = 1, my_special_work + DO j = 1, SIZE(mixed_cdft%dest_list) + ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list) + IF (mixed_cdft%is_special) THEN + CALL mp_isend(msgin=mixed_cdft%sendbuff(j)%weight, & + dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + request=req_total(ind), & + comm=force_env%para_env%group) + ELSE + CALL mp_isend(msgin=mixed_cdft%weight, dest=mixed_cdft%dest_list(j), & + request=req_total(ind), comm=force_env%para_env%group) + END IF + END DO + END DO + CALL mp_waitall(req_total) + IF (mixed_cdft%is_special) THEN + DO j = 1, SIZE(mixed_cdft%dest_list) + DEALLOCATE (mixed_cdft%sendbuff(j)%weight) + END DO + ELSE + DEALLOCATE (mixed_cdft%weight) + END IF + ! In principle, we could reduce the memory footprint of becke_pot by only transfering the nonzero portion + ! of the potential, but this would require a custom integrate_v_rspace + CALL pw_pool_create_pw(auxbas_pw_pool, dft_control%qs_control%becke_control%becke_pot%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + dft_control%qs_control%becke_control%becke_pot%pw%cr3d = 0.0_dp + ! Assemble the recved slices + DO j = 1, SIZE(mixed_cdft%source_list) + dft_control%qs_control%becke_control%becke_pot%pw%cr3d(recvbuffer(j)%imap(1):recvbuffer(j)%imap(2), & + recvbuffer(j)%imap(3):recvbuffer(j)%imap(4), & + recvbuffer(j)%imap(5):recvbuffer(j)%imap(6)) = & + recvbuffer(j)%r3 + END DO + ! Do the same for slices sent during dlb + IF (mixed_cdft%dlb) THEN + IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + DO j = 1, SIZE(mixed_cdft%dlb_control%recv_work_repl) + IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN + DO i = 1, SIZE(mixed_cdft%dlb_control%recvbuff(j)%buffs) + index = (/LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 1), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 1), & + LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 2), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 2), & + LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 3), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, 3)/) + dft_control%qs_control%becke_control%becke_pot%pw%cr3d(INDEX(1):INDEX(2), & + INDEX(3):INDEX(4), & + INDEX(5):INDEX(6)) = & + mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight + DEALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight) + END DO + END IF + END DO + END IF + END IF + ! Gaussian confinement cavity + IF (mixed_cdft%becke_control%cavity_confine) THEN + DO j = 1, SIZE(mixed_cdft%source_list) + CALL mp_irecv(msgout=recvbuffer(j)%r3, source=mixed_cdft%source_list(j), & + request=req_total(j), comm=force_env%para_env%group) + END DO + DO i = 1, my_special_work + DO j = 1, SIZE(mixed_cdft%dest_list) + ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list) + IF (mixed_cdft%is_special) THEN + CALL mp_isend(msgin=mixed_cdft%sendbuff(j)%cavity, & + dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + request=req_total(ind), & + comm=force_env%para_env%group) + ELSE + CALL mp_isend(msgin=mixed_cdft%cavity, dest=mixed_cdft%dest_list(j), & + request=req_total(ind), comm=force_env%para_env%group) + END IF + END DO + END DO + CALL mp_waitall(req_total) + IF (mixed_cdft%is_special) THEN + DO j = 1, SIZE(mixed_cdft%dest_list) + DEALLOCATE (mixed_cdft%sendbuff(j)%cavity) + END DO + ELSE + DEALLOCATE (mixed_cdft%cavity) + END IF + ! We only need the nonzero part of the confinement cavity + ALLOCATE (dft_control%qs_control%becke_control%cavity_mat(bo(1, 1):bo(2, 1), & + bo(1, 2):bo(2, 2), & + lb_min:ub_max)) + dft_control%qs_control%becke_control%cavity_mat = 0.0_dp + + DO j = 1, SIZE(mixed_cdft%source_list) + dft_control%qs_control%becke_control%cavity_mat(recvbuffer(j)%imap(1):recvbuffer(j)%imap(2), & + recvbuffer(j)%imap(3):recvbuffer(j)%imap(4), & + recvbuffer(j)%imap(5):recvbuffer(j)%imap(6)) = recvbuffer(j)%r3 + END DO + IF (mixed_cdft%dlb) THEN + IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + DO j = 1, SIZE(mixed_cdft%dlb_control%recv_work_repl) + IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN + DO i = 1, SIZE(mixed_cdft%dlb_control%recvbuff(j)%buffs) + index = (/LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, 1), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, 1), & + LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, 2), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, 2), & + LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, 3), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, 3)/) + dft_control%qs_control%becke_control%cavity_mat(INDEX(1):INDEX(2), & + INDEX(3):INDEX(4), & + INDEX(5):INDEX(6)) = & + mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity + DEALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity) + END DO + END IF + END DO + END IF + END IF + END IF + DO j = 1, SIZE(mixed_cdft%source_list) + DEALLOCATE (recvbuffer(j)%r3) + END DO + IF (calculate_forces) THEN + ! List of skipped grid points for other confiment methods + IF (mixed_cdft%becke_control%should_skip .AND. .NOT. & + mixed_cdft%becke_control%cavity_confine) THEN + CALL mp_isend(msgin=mixed_cdft%becke_control%skip_list, dest=mixed_cdft%dest_list(1), & + request=req(1), comm=force_env%para_env%group) + DO j = 1, 2 + ALLOCATE (recvbuffer(j)%b3(recvbuffer(j)%imap(1):recvbuffer(j)%imap(2), & + recvbuffer(j)%imap(3):recvbuffer(j)%imap(4), & + recvbuffer(j)%imap(5):recvbuffer(j)%imap(6))) + CALL mp_irecv(msgout=recvbuffer(j)%b3, source=mixed_cdft%source_list(j), & + request=req(j+1), comm=force_env%para_env%group) + END DO + CALL mp_wait(req(1)) + CALL mp_isend(msgin=mixed_cdft%becke_control%skip_list, dest=mixed_cdft%dest_list(2), & + request=req(1), comm=force_env%para_env%group) + CALL mp_waitall(req) + DEALLOCATE (mixed_cdft%becke_control%skip_list) + ALLOCATE (dft_control%qs_control%becke_control%skip_list(bo(1, 1):bo(2, 1), & + bo(1, 2):bo(2, 2), & + lb_min:ub_max)) + DO j = 1, 2 + dft_control%qs_control%becke_control%skip_list(recvbuffer(j)%imap(1):recvbuffer(j)%imap(2), & + recvbuffer(j)%imap(3):recvbuffer(j)%imap(4), & + recvbuffer(j)%imap(5):recvbuffer(j)%imap(6)) = & + recvbuffer(j)%b3 + DEALLOCATE (recvbuffer(j)%b3) + END DO + END IF + ! Gradients of the weight function + DO j = 1, SIZE(mixed_cdft%source_list) + ALLOCATE (recvbuffer(j)%r4(3*natom, recvbuffer(j)%imap(1):recvbuffer(j)%imap(2), & + recvbuffer(j)%imap(3):recvbuffer(j)%imap(4), & + recvbuffer(j)%imap(5):recvbuffer(j)%imap(6))) + CALL mp_irecv(msgout=recvbuffer(j)%r4, source=mixed_cdft%source_list(j), & + request=req_total(j), comm=force_env%para_env%group) + END DO + DO i = 1, my_special_work + DO j = 1, SIZE(mixed_cdft%dest_list) + ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list) + IF (mixed_cdft%is_special) THEN + CALL mp_isend(msgin=mixed_cdft%sendbuff(j)%gradients, & + dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + request=req_total(ind), & + comm=force_env%para_env%group) + ELSE + CALL mp_isend(msgin=mixed_cdft%becke_control%gradients, dest=mixed_cdft%dest_list(j), & + request=req_total(ind), comm=force_env%para_env%group) + END IF + END DO + END DO + CALL mp_waitall(req_total) + IF (mixed_cdft%is_special) THEN + DO j = 1, SIZE(mixed_cdft%dest_list) + DEALLOCATE (mixed_cdft%sendbuff(j)%gradients) + END DO + DEALLOCATE (mixed_cdft%sendbuff) + ELSE + DEALLOCATE (mixed_cdft%becke_control%gradients) + END IF + ALLOCATE (dft_control%qs_control%becke_control%gradients(3*natom, bo(1, 1):bo(2, 1), & + bo(1, 2):bo(2, 2), lb_min:ub_max)) + DO j = 1, SIZE(mixed_cdft%source_list) + dft_control%qs_control%becke_control%gradients(:, recvbuffer(j)%imap(1):recvbuffer(j)%imap(2), & + recvbuffer(j)%imap(3):recvbuffer(j)%imap(4), & + recvbuffer(j)%imap(5):recvbuffer(j)%imap(6)) = & + recvbuffer(j)%r4 + DEALLOCATE (recvbuffer(j)%r4) + END DO + IF (mixed_cdft%dlb) THEN + IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + DO j = 1, SIZE(mixed_cdft%dlb_control%recv_work_repl) + IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN + DO i = 1, SIZE(mixed_cdft%dlb_control%recvbuff(j)%buffs) + index = (/LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, 2), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, 2), & + LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, 3), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, 3), & + LBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, 4), & + UBOUND(mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, 4)/) + dft_control%qs_control%becke_control%gradients(:, INDEX(1):INDEX(2), & + INDEX(3):INDEX(4), & + INDEX(5):INDEX(6)) = & + mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients + DEALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients) + END DO + END IF + END DO + END IF + END IF + END IF + ! Clean up remaining temporaries + IF (mixed_cdft%dlb) THEN + IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + DO j = 1, SIZE(mixed_cdft%dlb_control%recv_work_repl) + IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN + IF (ASSOCIATED(mixed_cdft%dlb_control%recv_info(j)%target_list)) & + DEALLOCATE (mixed_cdft%dlb_control%recv_info(j)%target_list) + DEALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs) + END IF + END DO + DEALLOCATE (mixed_cdft%dlb_control%recv_info, mixed_cdft%dlb_control%recvbuff) + END IF + IF (ASSOCIATED(mixed_cdft%dlb_control%target_list)) & + DEALLOCATE (mixed_cdft%dlb_control%target_list) + DEALLOCATE (mixed_cdft%dlb_control%recv_work_repl) + END IF + DEALLOCATE (recvbuffer) + DEALLOCATE (req_total) + DEALLOCATE (lb) + DEALLOCATE (ub) + CALL timestop(handle2) + ! Set some flags so the weight is not rebuilt during SCF + dft_control%qs_control%becke_control%external_control = .TRUE. + dft_control%qs_control%becke_control%need_pot = .FALSE. + ! Store the bound indices for force calculation + IF (calculate_forces) THEN + ! Note: these are the final bounds i.e. the first nonzero elements of the arrays... + ! On the contrary, mixed_cdft%....%bounds include (possibly) the zero elements + ! This is messy and needs to be fixed + dft_control%qs_control%becke_control%confine_bounds_int(2) = ub_max + dft_control%qs_control%becke_control%confine_bounds_int(1) = lb_min + END IF + CALL pw_scale(dft_control%qs_control%becke_control%becke_pot%pw, & + dft_control%qs_control%becke_control%becke_pot%pw%pw_grid%dvol) + ! Set flags for ET coupling calculation + IF (mixed_env%do_mixed_et) THEN + IF (MODULO(mixed_cdft%sim_step, mixed_env%et_freq) == 0) THEN + dft_control%qs_control%cdft_control%do_et = .TRUE. + dft_control%qs_control%cdft_control%calculate_metric = mixed_cdft%calculate_metric + END IF + END IF + t2 = m_walltime() + IF (iounit > 0) THEN + WRITE (iounit, '(A)') ' ' + WRITE (iounit, '(T2,A,F6.1,A)') 'MIXED_CDFT| Becke constraint built in ', t2-t1, ' seconds' + WRITE (iounit, '(A)') ' ' + END IF + CALL cp_print_key_finished_output(iounit, logger, force_env_section, & + "MIXED%PRINT%PROGRAM_RUN_INFO") + CALL timestop(handle) + + END SUBROUTINE mixed_cdft_build_weight + +! ************************************************************************************************** +!> \brief ET coupling adapted to mixed calculations +!> \param force_env the force_env that holds the CDFT states +!> \par History +!> 02.15 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE mixed_cdft_calculate_coupling(force_env) + TYPE(force_env_type), POINTER :: force_env + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_calculate_coupling', & + routineP = moduleN//':'//routineN + + CHARACTER(LEN=default_path_length) :: file_name + INTEGER :: handle, iforce_eval, iounit, ispin, j, k, my_id, nao, ncol_local, ncol_overlap, & + ncol_wmat, nforce_eval, nmo, nrow_local, nrow_overlap, nrow_wmat, nspins + INTEGER, ALLOCATABLE, DIMENSION(:) :: ncol_mo, nrow_mo + LOGICAL :: exist, natom_mismatch + REAL(KIND=dp) :: coupling_wfn, energy_a, energy_b, & + maxocc, Sda, strength_a, strength_b, & + Waa, Wbb, Wda + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: a, b, evals, metric, S_det + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: overlaps + REAL(KIND=dp), DIMENSION(2) :: c, eigenv + REAL(KIND=dp), DIMENSION(2, 2) :: S_mat, tmp_mat, U, W_mat + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(cp_blacs_env_type), POINTER :: blacs_env + TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: mixed_wmat_tmp, rest_MO, wmat_tmp + TYPE(cp_fm_p_type), DIMENSION(:, :), POINTER :: matrix_p_tmp, mixed_matrix_p_tmp, & + mixed_mo_coeff, mo_coeff_tmp + TYPE(cp_fm_p_type), POINTER :: matrix_s_tmp, mixed_matrix_s_tmp + TYPE(cp_fm_struct_type), POINTER :: fm_struct_mo, fm_struct_overlap, & + fm_struct_tmp, fm_struct_wmat, & + mo_mo_fmstruct + TYPE(cp_fm_type), POINTER :: inverse_mat, mo_overlap, mo_tmp, SMO, & + Tinverse, tmp2 + TYPE(cp_logger_type), POINTER :: logger + TYPE(cp_subsys_type), POINTER :: subsys_mix + TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: density_matrix + TYPE(dbcsr_type) :: desymm_tmp, e_vectors, mixed_wmat_a, & + mixed_wmat_b + TYPE(dbcsr_type), POINTER :: mixed_matrix_s + TYPE(dft_control_type), POINTER :: dft_control + TYPE(mixed_cdft_type), POINTER :: mixed_cdft + TYPE(mixed_environment_type), POINTER :: mixed_env + TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mo_set + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(qs_energy_type), POINTER :: energy + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + TYPE(section_vals_type), POINTER :: force_env_section, linear_section, & + print_section + + NULLIFY (subsys_mix, force_env_section, print_section, & + linear_section, mixed_env, mixed_cdft, qs_env, dft_control, & + fm_struct_mo, fm_struct_wmat, fm_struct_overlap, fm_struct_tmp, & + mo_mo_fmstruct, inverse_mat, SMO, Tinverse, tmp2, mo_overlap, & + mo_tmp, mixed_matrix_s_tmp, matrix_s_tmp, mixed_wmat_tmp, & + wmat_tmp, rest_MO, mixed_mo_coeff, mo_coeff_tmp, matrix_p_tmp, & + mixed_matrix_p_tmp, mixed_matrix_s, density_matrix, blacs_env, & + energy, mo_set, particle_set, qs_kind_set, atomic_kind_set) + + logger => cp_get_default_logger() + + CPASSERT(ASSOCIATED(force_env)) + CALL timeset(routineN, handle) + CALL force_env_get(force_env=force_env, & + force_env_section=force_env_section) + mixed_env => force_env%mixed_env + nforce_eval = SIZE(force_env%sub_force_env) + print_section => section_vals_get_subs_vals(force_env_section, "MIXED%PRINT%PROGRAM_RUN_INFO") + iounit = cp_print_key_unit_nr(logger, print_section, '', extension='.mixedLog') + CALL get_mixed_env(mixed_env, cdft_control=mixed_cdft) + CPASSERT(ASSOCIATED(mixed_cdft)) + ! Get qs_env and nspins + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + IF (force_env%mixed_env%do_mixed_qmmm_cdft) THEN + qs_env => force_env%sub_force_env(iforce_eval)%force_env%qmmm_env%qs_env + ELSE + CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, qs_env=qs_env) + END IF + CALL get_qs_env(qs_env, dft_control=dft_control) + nspins = dft_control%nspins + END DO + ! Transfer data from sub_force_envs to temporaries + ALLOCATE (mo_coeff_tmp(2, nspins), wmat_tmp(2), matrix_s_tmp, nrow_mo(nspins), ncol_mo(nspins)) + IF (mixed_cdft%calculate_metric) ALLOCATE (matrix_p_tmp(2, nspins)) + NULLIFY (matrix_s_tmp%matrix) + DO iforce_eval = 1, nforce_eval + ! Temporary arrays need to be nulled on every process + NULLIFY (wmat_tmp(iforce_eval)%matrix) + DO ispin = 1, nspins + NULLIFY (mo_coeff_tmp(iforce_eval, ispin)%matrix) + IF (mixed_cdft%calculate_metric) & + NULLIFY (matrix_p_tmp(iforce_eval, ispin)%matrix) + END DO + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + ! From this point onward, we access data local to the sub_force_envs + CALL get_qs_env(qs_env, blacs_env=blacs_env) + ! Store dimensions of the transferred arrays + CALL dbcsr_get_info(dft_control%qs_control%cdft_control%matrix_s%matrix, & + nfullrows_total=nrow_overlap, nfullcols_total=ncol_overlap) + CALL dbcsr_get_info(dft_control%qs_control%cdft_control%wmat%matrix, & + nfullrows_total=nrow_wmat, nfullcols_total=ncol_wmat) + ! MO Coefficients + DO ispin = 1, nspins + CALL cp_fm_get_info(dft_control%qs_control%cdft_control%mo_coeff(ispin)%matrix, & + ncol_global=ncol_mo(ispin), nrow_global=nrow_mo(ispin)) + CALL cp_fm_create(matrix=mo_coeff_tmp(iforce_eval, ispin)%matrix, & + matrix_struct=dft_control%qs_control%cdft_control%mo_coeff(ispin)%matrix%matrix_struct, & + name="MO_COEFF_"//TRIM(ADJUSTL(cp_to_string(iforce_eval)))//"_" & + //TRIM(ADJUSTL(cp_to_string(ispin)))//"_MATRIX") + CALL cp_fm_to_fm(dft_control%qs_control%cdft_control%mo_coeff(ispin)%matrix, & + mo_coeff_tmp(iforce_eval, ispin)%matrix) + CALL cp_fm_release(dft_control%qs_control%cdft_control%mo_coeff(ispin)%matrix) + END DO + DEALLOCATE (dft_control%qs_control%cdft_control%mo_coeff) + ! Matrix representation of weight function (dbcsr -> fm) + CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=nrow_wmat, ncol_global=ncol_wmat, context=blacs_env, & + para_env=force_env%sub_force_env(iforce_eval)%force_env%para_env, & + square_blocks=.TRUE.) + CALL cp_fm_create(wmat_tmp(iforce_eval)%matrix, fm_struct_tmp, name="fm_matrix") + CALL cp_fm_struct_release(fm_struct_tmp) + CALL dbcsr_desymmetrize(dft_control%qs_control%cdft_control%wmat%matrix, desymm_tmp) + CALL copy_dbcsr_to_fm(desymm_tmp, wmat_tmp(iforce_eval)%matrix) + CALL dbcsr_release(desymm_tmp) + CALL dbcsr_release_p(dft_control%qs_control%cdft_control%wmat%matrix) + ! Overlap matrix is the same for both sub_force_envs, so we just copy the first one (dbcsr -> fm) + IF (iforce_eval == 1) THEN + CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=nrow_overlap, & + ncol_global=ncol_overlap, context=blacs_env, & + para_env=force_env%sub_force_env(iforce_eval)%force_env%para_env) + CALL cp_fm_create(matrix_s_tmp%matrix, fm_struct_tmp, name="s_matrix") + CALL cp_fm_struct_release(fm_struct_tmp) + CALL dbcsr_desymmetrize(dft_control%qs_control%cdft_control%matrix_s%matrix, desymm_tmp) + CALL copy_dbcsr_to_fm(desymm_tmp, matrix_s_tmp%matrix) + CALL dbcsr_release(desymm_tmp) + END IF + CALL dbcsr_release_p(dft_control%qs_control%cdft_control%matrix_s%matrix) + ! Density_matrix (dbcsr -> fm) + IF (mixed_cdft%calculate_metric) THEN + DO ispin = 1, nspins + ! Size AOxAO + CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol_overlap, & + ncol_global=ncol_overlap, context=blacs_env, & + para_env=force_env%sub_force_env(iforce_eval)%force_env%para_env) + CALL cp_fm_create(matrix_p_tmp(iforce_eval, ispin)%matrix, fm_struct_tmp, name="dm_matrix") + CALL cp_fm_struct_release(fm_struct_tmp) + CALL dbcsr_desymmetrize(dft_control%qs_control%cdft_control%matrix_p(ispin)%matrix, desymm_tmp) + CALL copy_dbcsr_to_fm(desymm_tmp, matrix_p_tmp(iforce_eval, ispin)%matrix) + CALL dbcsr_release(desymm_tmp) + CALL dbcsr_release_p(dft_control%qs_control%cdft_control%matrix_p(ispin)%matrix) + END DO + DEALLOCATE (dft_control%qs_control%cdft_control%matrix_p) + END IF + END DO + ! Create needed fm structs + CALL cp_fm_struct_create(fm_struct_wmat, nrow_global=nrow_wmat, ncol_global=ncol_wmat, & + context=mixed_cdft%blacs_env, para_env=force_env%para_env) + CALL cp_fm_struct_create(fm_struct_overlap, nrow_global=nrow_overlap, ncol_global=ncol_overlap, & + context=mixed_cdft%blacs_env, para_env=force_env%para_env) + ! Redistribute arrays with copy_general (this is not optimal for dbcsr matrices but...) + ALLOCATE (mixed_mo_coeff(2, nspins)) + ALLOCATE (mixed_wmat_tmp(2), mixed_matrix_s_tmp) + IF (mixed_cdft%calculate_metric) THEN + ALLOCATE (density_matrix(2, nspins), mixed_matrix_p_tmp(2, nspins)) + END IF + DO iforce_eval = 1, nforce_eval + ! MO coefficients + DO ispin = 1, nspins + NULLIFY (fm_struct_mo) + CALL cp_fm_struct_create(fm_struct_mo, nrow_global=nrow_mo(ispin), ncol_global=ncol_mo(ispin), & + context=mixed_cdft%blacs_env, para_env=force_env%para_env) + NULLIFY (mixed_mo_coeff(iforce_eval, ispin)%matrix) + CALL cp_fm_create(matrix=mixed_mo_coeff(iforce_eval, ispin)%matrix, & + matrix_struct=fm_struct_mo, & + name="MO_COEFF_"//TRIM(ADJUSTL(cp_to_string(iforce_eval)))//"_" & + //TRIM(ADJUSTL(cp_to_string(ispin)))//"_MATRIX") + CALL cp_fm_copy_general(mo_coeff_tmp(iforce_eval, ispin)%matrix, & + mixed_mo_coeff(iforce_eval, ispin)%matrix, & + global_context=mixed_cdft%blacs_env%group) + CALL cp_fm_release(mo_coeff_tmp(iforce_eval, ispin)%matrix) + CALL cp_fm_struct_release(fm_struct_mo) + END DO + ! Weight + NULLIFY (mixed_wmat_tmp(iforce_eval)%matrix) + CALL cp_fm_create(matrix=mixed_wmat_tmp(iforce_eval)%matrix, & + matrix_struct=fm_struct_wmat, & + name="WEIGHT_"//TRIM(ADJUSTL(cp_to_string(iforce_eval)))//"_MATRIX") + CALL cp_fm_copy_general(wmat_tmp(iforce_eval)%matrix, & + mixed_wmat_tmp(iforce_eval)%matrix, & + global_context=mixed_cdft%blacs_env%group) + CALL cp_fm_release(wmat_tmp(iforce_eval)%matrix) + ! (fm -> dbcsr) + IF (iforce_eval == 1) THEN + CALL copy_fm_to_dbcsr_bc(mixed_wmat_tmp(iforce_eval)%matrix, mixed_wmat_a) + ELSE + CALL copy_fm_to_dbcsr_bc(mixed_wmat_tmp(iforce_eval)%matrix, mixed_wmat_b) + END IF + CALL cp_fm_release(mixed_wmat_tmp(iforce_eval)%matrix) + ! Density matrix (fm -> dbcsr) + IF (mixed_cdft%calculate_metric) THEN + DO ispin = 1, nspins + NULLIFY (mixed_matrix_p_tmp(iforce_eval, ispin)%matrix) + NULLIFY (density_matrix(iforce_eval, ispin)%matrix) + ALLOCATE (density_matrix(iforce_eval, ispin)%matrix) + CALL cp_fm_create(matrix=mixed_matrix_p_tmp(iforce_eval, ispin)%matrix, & + matrix_struct=fm_struct_overlap, & + name="DENSITY_"//TRIM(ADJUSTL(cp_to_string(iforce_eval)))//"_" & + //TRIM(ADJUSTL(cp_to_string(ispin)))//"_MATRIX") + CALL cp_fm_copy_general(matrix_p_tmp(iforce_eval, ispin)%matrix, & + mixed_matrix_p_tmp(iforce_eval, ispin)%matrix, & + global_context=mixed_cdft%blacs_env%group) + CALL cp_fm_release(matrix_p_tmp(iforce_eval, ispin)%matrix) + CALL copy_fm_to_dbcsr_bc(mixed_matrix_p_tmp(iforce_eval, ispin)%matrix, & + density_matrix(iforce_eval, ispin)%matrix) + CALL cp_fm_release(mixed_matrix_p_tmp(iforce_eval, ispin)%matrix) + END DO + END IF + END DO + CALL cp_fm_struct_release(fm_struct_wmat) + DEALLOCATE (mo_coeff_tmp, wmat_tmp, mixed_wmat_tmp) + IF (mixed_cdft%calculate_metric) THEN + DEALLOCATE (matrix_p_tmp) + DEALLOCATE (mixed_matrix_p_tmp) + END IF + ! Overlap (fm -> dbcsr) + NULLIFY (mixed_matrix_s_tmp%matrix) + CALL dbcsr_init_p(mixed_matrix_s) + CALL cp_fm_create(matrix=mixed_matrix_s_tmp%matrix, & + matrix_struct=fm_struct_overlap, & + name="OVERLAP_MATRIX") + CALL cp_fm_struct_release(fm_struct_overlap) + CALL cp_fm_copy_general(matrix_s_tmp%matrix, & + mixed_matrix_s_tmp%matrix, & + global_context=mixed_cdft%blacs_env%group) + CALL cp_fm_release(matrix_s_tmp%matrix) + CALL copy_fm_to_dbcsr_bc(mixed_matrix_s_tmp%matrix, mixed_matrix_s) + CALL cp_fm_release(mixed_matrix_s_tmp%matrix) + DEALLOCATE (matrix_s_tmp, mixed_matrix_s_tmp) + ! Begin coupling calculation + ! Create the MO_MO fm struct (mo_mo_fm_pools%struct) + ! The number of MOs/AOs is equal to the number of columns/rows of mo_coeff(:,:)%matrix + + ! TODO: Handle magnetization/combined constraints + my_id = -1 + !my_id=dft_control%qs_control%becke_control%density_type + ALLOCATE (rest_MO(2), a(nspins), b(nspins), S_det(nspins)) + DO ispin = 1, nspins + NULLIFY (fm_struct_mo, mo_mo_fmstruct) + nao = nrow_mo(ispin) + nmo = ncol_mo(ispin) + CALL cp_fm_struct_create(fm_struct_mo, nrow_global=nrow_mo(ispin), ncol_global=ncol_mo(ispin), & + context=mixed_cdft%blacs_env, para_env=force_env%para_env) + CALL cp_fm_struct_create(mo_mo_fmstruct, nrow_global=nmo, ncol_global=nmo, & + context=mixed_cdft%blacs_env, para_env=force_env%para_env) + CALL cp_fm_create(matrix=tmp2, matrix_struct=fm_struct_mo, & + name="ET_TMP"//TRIM(ADJUSTL(cp_to_string(2)))//"MATRIX") + CALL cp_fm_struct_release(fm_struct_mo) + CALL cp_fm_create(matrix=inverse_mat, matrix_struct=mo_mo_fmstruct, & + name="INVERSE"//TRIM(ADJUSTL(cp_to_string(2)))//"MATRIX") + CALL cp_fm_create(matrix=Tinverse, matrix_struct=mo_mo_fmstruct, & + name="T_INVERSE"//TRIM(ADJUSTL(cp_to_string(2)))//"MATRIX") + CALL cp_fm_create(matrix=SMO, matrix_struct=mo_mo_fmstruct, & + name="ET_SMO"//TRIM(ADJUSTL(cp_to_string(1)))//"MATRIX") + DO j = 1, 2 + NULLIFY (rest_MO(j)%matrix) + CALL cp_fm_create(matrix=rest_MO(j)%matrix, matrix_struct=mo_mo_fmstruct, & + name="ET_rest_MO"//TRIM(ADJUSTL(cp_to_string(j)))//"MATRIX") + END DO + CALL cp_fm_struct_release(mo_mo_fmstruct) + ! calculate the MO overlap (C_d)^T S C_a + CALL cp_dbcsr_sm_fm_multiply(mixed_matrix_s, mixed_mo_coeff(1, ispin)%matrix, & + tmp2, nmo, 1.0_dp, 0.0_dp) + CALL cp_gemm('T', 'N', nmo, nmo, nao, 1.0_dp, & + mixed_mo_coeff(2, ispin)%matrix, & + tmp2, 0.0_dp, SMO) + ! calculate the MO-representation of the restraint matrix A (C_d)^T W_a C_a + CALL cp_dbcsr_sm_fm_multiply(mixed_wmat_a, & + mixed_mo_coeff(1, ispin)%matrix, & + tmp2, nmo, 1.0_dp, 0.0_dp) + CALL cp_gemm('T', 'N', nmo, nmo, nao, 1.0_dp, & + mixed_mo_coeff(2, ispin)%matrix, & + tmp2, 0.0_dp, rest_MO(1)%matrix) + ! calculate the MO-representation of the restraint matrix D (C_a)^T W_d C_d + CALL cp_dbcsr_sm_fm_multiply(mixed_wmat_b, & + mixed_mo_coeff(2, ispin)%matrix, & + tmp2, nmo, 1.0_dp, 0.0_dp) + CALL cp_gemm('T', 'N', nmo, nmo, nao, 1.0_dp, & + mixed_mo_coeff(1, ispin)%matrix, & + tmp2, 0.0_dp, rest_MO(2)%matrix) + ! Invert and calculate determinant + CALL cp_fm_invert(SMO, inverse_mat, S_det(ispin), eps_svd=mixed_cdft%eps_svd) + CALL cp_fm_get_info(inverse_mat, nrow_local=nrow_local, ncol_local=ncol_local) + ! + b(ispin) = 0.0_dp + DO j = 1, ncol_local + DO k = 1, nrow_local + b(ispin) = b(ispin)+rest_MO(2)%matrix%local_data(k, j)*inverse_mat%local_data(k, j) + END DO + END DO + ! + CALL cp_fm_transpose(inverse_mat, Tinverse) + a(ispin) = 0.0_dp + DO j = 1, ncol_local + DO k = 1, nrow_local + a(ispin) = a(ispin)+rest_MO(1)%matrix%local_data(k, j)*Tinverse%local_data(k, j) + END DO + END DO + IF ((my_id == do_spin_density) .AND. ispin == 2) THEN + a(ispin) = -a(ispin) + b(ispin) = -b(ispin) + END IF + ! Compute density matrix difference P = P_D - P_A + IF (mixed_cdft%calculate_metric) THEN + CALL dbcsr_add(density_matrix(1, ispin)%matrix, density_matrix(2, ispin)%matrix, -1.0_dp, 1.0_dp) + CALL dbcsr_release_p(density_matrix(2, ispin)%matrix) + END IF + ! + CALL mp_sum(a(ispin), force_env%para_env%group) + CALL mp_sum(b(ispin), force_env%para_env%group) + ! Release work + CALL cp_fm_release(tmp2) + CALL cp_fm_release(rest_MO(1)%matrix) + CALL cp_fm_release(rest_MO(2)%matrix) + CALL cp_fm_release(SMO) + CALL cp_fm_release(Tinverse) + CALL cp_fm_release(inverse_mat) + END DO + ! solve eigenstates for the projector matrix + IF (nspins == 2) THEN + Sda = ABS(S_det(1)*S_det(2)) ! The sign might be wrong on some processors (used to be?) + Wda = ((a(1)+a(2))+(b(1)+b(2)))*0.5_dp*Sda + ELSE + Sda = S_det(1)**2 + Wda = (a(1)+b(1))*Sda + END IF + ! Transfer info about the constraint calculations + Waa = 0.0_dp + Wbb = 0.0_dp + strength_a = mixed_env%strength(1) + strength_b = mixed_env%strength(2) + energy_a = 0.0_dp + energy_b = 0.0_dp + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + CALL get_qs_env(qs_env, energy=energy) + IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%mepos == & + force_env%sub_force_env(iforce_eval)%force_env%para_env%source) THEN + IF (iforce_eval == 1) THEN + Waa = dft_control%qs_control%cdft_control%value(1) + energy_a = energy%total + ELSE + Wbb = dft_control%qs_control%cdft_control%value(1) + energy_b = energy%total + END IF + END IF + END DO + CALL mp_sum(Waa, force_env%para_env%group) + CALL mp_sum(Wbb, force_env%para_env%group) + CALL mp_sum(energy_a, force_env%para_env%group) + CALL mp_sum(energy_b, force_env%para_env%group) + ! Compute metric to assess reliability of coupling + IF (mixed_cdft%calculate_metric) THEN + ALLOCATE (metric(nspins)) + metric = 0.0_dp + CALL dbcsr_create(e_vectors, template=density_matrix(1, 1)%matrix) + ! Take into account doubly occupied orbitals without LSD + IF (nspins == 1) CALL dbcsr_scale(density_matrix(1, 1)%matrix, alpha_scalar=0.5_dp) + DO ispin = 1, nspins + ALLOCATE (evals(ncol_mo(ispin))) + CALL cp_dbcsr_syevd(density_matrix(1, ispin)%matrix, e_vectors, evals, & + para_env=force_env%para_env, blacs_env=mixed_cdft%blacs_env) + CALL dbcsr_release_p(density_matrix(1, ispin)%matrix) + DO j = 1, ncol_mo(ispin) + metric(ispin) = metric(ispin)+(evals(j)**2-evals(j)**4) + END DO + DEALLOCATE (evals) + END DO + CALL dbcsr_release(e_vectors) + DEALLOCATE (density_matrix) + metric = metric/4.0_dp + END IF + ! Compute coupling also with the wavefunction overlap method, see Migliore2009 + ! Requires the unconstrained KS ground state wavefunction as input + IF (mixed_cdft%wfn_overlap_method) THEN + ! Create mo_set for input wfn + ALLOCATE (mo_set(nspins)) + IF (nspins == 2) THEN + maxocc = 1.0_dp + ELSE + maxocc = 2.0_dp + END IF + DO ispin = 1, nspins + nao = nrow_mo(ispin) + nmo = ncol_mo(ispin) + NULLIFY (mo_set(ispin)%mo_set) + ! Only OT with fully occupied orbitals is implicitly supported (TODO: add check in _init) + CALL allocate_mo_set(mo_set(ispin)%mo_set, nao=nao, nmo=nmo, nelectron=INT(maxocc*nmo), & + n_el_f=REAL(maxocc*nmo, dp), maxocc=maxocc, & + flexible_electron_count=0.0_dp) + CALL set_mo_set(mo_set(ispin)%mo_set, uniform_occupation=.TRUE., homo=nmo) + CALL cp_fm_create(matrix=mo_set(ispin)%mo_set%mo_coeff, & + matrix_struct=mixed_mo_coeff(1, ispin)%matrix%matrix_struct, & + name="GS_MO_COEFF"//TRIM(ADJUSTL(cp_to_string(ispin)))//"MATRIX") + ALLOCATE (mo_set(ispin)%mo_set%eigenvalues(nmo)) + ALLOCATE (mo_set(ispin)%mo_set%occupation_numbers(nmo)) + END DO + ! Read wfn file (note we assume that the basis set is the same) + IF (force_env%mixed_env%do_mixed_qmmm_cdft) & + ! This really shouldnt be a problem? + CALL cp_abort(__LOCATION__, & + "QMMM + wavefunction overlap method not supported.") + CALL force_env_get(force_env=force_env, subsys=subsys_mix) + linear_section => section_vals_get_subs_vals(force_env_section, "MIXED%LINEAR") + CALL cp_subsys_get(subsys_mix, atomic_kind_set=atomic_kind_set, particle_set=particle_set) + CPASSERT(ASSOCIATED(mixed_cdft%qs_kind_set)) + IF (force_env%para_env%ionode) & + CALL wfn_restart_file_name(file_name, exist, linear_section, logger) + CALL mp_bcast(exist, force_env%para_env%source, force_env%para_env%group) + CALL mp_bcast(file_name, force_env%para_env%source, force_env%para_env%group) + IF (.NOT. exist) & + CALL cp_abort(__LOCATION__, & + "User requested to restart the wavefunction from the file named: "// & + TRIM(file_name)//". This file does not exist. Please check the existence of"// & + " the file or change properly the value of the keyword WFN_RESTART_FILE_NAME in"// & + " section FORCE_EVAL\MIXED\LINEAR.") + CALL read_mo_set(mo_array=mo_set, atomic_kind_set=atomic_kind_set, & + qs_kind_set=mixed_cdft%qs_kind_set, particle_set=particle_set, & + para_env=force_env%para_env, id_nr=0, multiplicity=mixed_cdft%multiplicity, & + dft_section=linear_section, natom_mismatch=natom_mismatch, & + cdft=.TRUE.) + IF (natom_mismatch) & + CALL cp_abort(__LOCATION__, & + "Restart wfn file has a wrong number of atoms") + ! Orthonormalize wfn + DO ispin = 1, nspins + IF (mixed_cdft%has_unit_metric) THEN + CALL make_basis_simple(mo_set(ispin)%mo_set%mo_coeff, ncol_mo(ispin)) + ELSE + CALL make_basis_sm(mo_set(ispin)%mo_set%mo_coeff, ncol_mo(ispin), mixed_matrix_s) + END IF + END DO + ! Calculate MO overlaps between reference state (R) and CDFT states A/D + ALLOCATE (overlaps(2, nspins)) + overlaps = 0.0_dp + DO ispin = 1, nspins + nao = nrow_mo(ispin) + nmo = ncol_mo(ispin) + CALL cp_fm_struct_create(mo_mo_fmstruct, nrow_global=nmo, ncol_global=nmo, & + context=mixed_cdft%blacs_env, para_env=force_env%para_env) + CALL cp_fm_create(matrix=mo_overlap, matrix_struct=mo_mo_fmstruct, & + name="MO_OVERLAP_MATRIX") + CALL cp_fm_create(matrix=inverse_mat, matrix_struct=mo_mo_fmstruct, & + name="INVERSE_MO_OVERLAP_MATRIX") + CALL cp_fm_struct_release(mo_mo_fmstruct) + CALL cp_fm_create(matrix=mo_tmp, & + matrix_struct=mixed_mo_coeff(1, ispin)%matrix%matrix_struct, & + name="OVERLAP_MO_COEFF") + ! S*C_r + CALL cp_dbcsr_sm_fm_multiply(mixed_matrix_s, mo_set(ispin)%mo_set%mo_coeff, & + mo_tmp, nmo, 1.0_dp, 0.0_dp) + DO j = 1, 2 + ! C_j^T * (S*C_r) + CALL cp_fm_set_all(mo_overlap, alpha=0.0_dp) + CALL cp_gemm('T', 'N', nmo, nmo, nao, 1.0_dp, & + mixed_mo_coeff(j, ispin)%matrix, & + mo_tmp, 0.0_dp, mo_overlap) + CALL cp_fm_invert(mo_overlap, inverse_mat, overlaps(j, ispin), eps_svd=mixed_cdft%eps_svd) + END DO + CALL cp_fm_release(mo_overlap) + CALL cp_fm_release(inverse_mat) + CALL cp_fm_release(mo_tmp) + CALL deallocate_mo_set(mo_set(ispin)%mo_set) + END DO + DEALLOCATE (mo_set) + IF (nspins == 2) THEN + overlaps(1, 1) = ABS(overlaps(1, 1)*overlaps(1, 2)) ! A in eq. 12c + overlaps(2, 1) = ABS(overlaps(2, 1)*overlaps(2, 2)) ! B in eq. 12c + ELSE + overlaps(1, 1) = overlaps(1, 1)**2 + overlaps(2, 1) = overlaps(2, 1)**2 + END IF + ! Calculate coupling using eq. 12c + coupling_wfn = ABS((overlaps(1, 1)*overlaps(2, 1)/(overlaps(1, 1)**2-overlaps(2, 1)**2))* & + (energy_b-energy_a)/(1.0_dp-Sda**2)* & + (1.0_dp-(overlaps(1, 1)**2+overlaps(2, 1)**2)/(2.0_dp*overlaps(1, 1)*overlaps(2, 1))*Sda)) + DEALLOCATE (overlaps) + END IF + ! Release remaining work + DEALLOCATE (nrow_mo, ncol_mo) + DO iforce_eval = 1, nforce_eval + DO ispin = 1, nspins + CALL cp_fm_release(mixed_mo_coeff(iforce_eval, ispin)%matrix) + END DO + END DO + CALL dbcsr_release(mixed_wmat_a) + CALL dbcsr_release(mixed_wmat_b) + CALL dbcsr_release_p(mixed_matrix_s) + DEALLOCATE (mixed_mo_coeff, rest_MO) + ! construct S and W + S_mat(1, 1) = 1.0_dp + S_mat(2, 2) = 1.0_dp + S_mat(2, 1) = Sda + S_mat(1, 2) = Sda + W_mat(1, 1) = Wbb + W_mat(2, 2) = Waa + W_mat(2, 1) = Wda + W_mat(1, 2) = Wda + ! Invert S via eigendecomposition and compute S^-(1/2) + CALL diamat_all(S_mat, eigenv, .TRUE.) + IF (eigenv(1) .LT. 1.0e-14_dp) eigenv(1) = 1.0e-14_dp ! Safeguard against division with 0 and negative numbers + IF (eigenv(2) .LT. 1.0e-14_dp) eigenv(2) = 1.0e-14_dp + U = 0.0_dp + U(1, 1) = 1.0_dp/SQRT(eigenv(1)) + U(2, 2) = 1.0_dp/SQRT(eigenv(2)) + tmp_mat = MATMUL(U, TRANSPOSE(S_mat)) + U = MATMUL(S_mat, tmp_mat) ! S^(-1/2) + ! Orthogonalize states i.e. solve generalized eigenvalue eq WV = SVL + ! Convert to standard eigenvalue problem via symmetric orthogonalisation + tmp_mat = MATMUL(W_mat, U) ! + W_mat = MATMUL(U, tmp_mat) ! W' = S^(-1/2) * W * S^(-1/2) + CALL diamat_all(W_mat, eigenv, .TRUE.) ! Solve W'V' = AV' + tmp_mat = MATMUL(U, W_mat) ! Reverse transformation V = S^(-1/2) V + ! Construct final, orthogonal diabatic Hamiltonian matrix H + W_mat(1, 1) = energy_b + W_mat(2, 2) = energy_a + c(1) = (energy_b+strength_b*Wbb)*Sda-strength_b*Wda ! H_AB = F_B*S_AB + V_B * W_AB + c(2) = (energy_a+strength_a*Waa)*Sda-strength_a*Wda ! H_BA = F_A*S_BA - V_A * W_BA + W_mat(1, 2) = (c(1)+c(2))*0.5_dp ! H''(1,2) = 0.5*(H_AB+H_AB) = H''(2,1) + W_mat(2, 1) = W_mat(1, 2) + S_mat = MATMUL(W_mat, (tmp_mat)) ! H'' * V + W_mat = MATMUL(TRANSPOSE(tmp_mat), S_mat) ! H = V^T * H'' * V + IF (iounit > 0) THEN + WRITE (iounit, '(/,T3,A,T66)') & + '------------------------- CDFT coupling information -------------------------' + WRITE (iounit, '(T3,A,T66,(3X,F12.2))') & + 'Information at step (fs) :', mixed_cdft%sim_step*mixed_cdft%sim_dt + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') 'Strength of constraint A :', strength_a + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') 'Strength of constraint B :', strength_b + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') 'Final value of constraint A :', Waa + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') 'Final value of constraint B :', Wbb + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') 'Overlap between states A and B :', Sda + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') 'Charge transfer energy (B-A) (Ha) :', (energy_b-energy_a) + WRITE (iounit, *) + IF (ABS(W_mat(1, 2))*1.0E3_dp .GE. 0.1_dp) THEN + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') & + 'Diabatic electronic coupling (mHartree):', ABS(W_mat(1, 2)*1.0E3_dp) + ELSE + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') & + 'Diabatic electronic coupling (microHartree):', ABS(W_mat(1, 2)*1.0E6_dp) + END IF + IF (mixed_cdft%calculate_metric) THEN + WRITE (iounit, *) + IF (nspins == 1) THEN + WRITE (iounit, '(T3,A,T66,(3X,F12.6))') 'Coupling reliability metric (0 is ideal):', metric + ELSE + WRITE (iounit, '(T3,A,T54,(3X,2F12.6))') & + 'Coupling reliability metric (0 is ideal):', metric(1), metric(2) + END IF + END IF + IF (mixed_cdft%wfn_overlap_method) THEN + WRITE (iounit, *) + IF (coupling_wfn*1.0E3_dp .GE. 0.1_dp) THEN + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') & + 'Diabatic coupling (wavefunction overlap method, mHartree):', coupling_wfn*1.0E3_dp + ELSE + WRITE (iounit, '(T3,A,T60,(3X,F18.12))') & + 'Diabatic coupling (wavefunction overlap method, microHartree):', coupling_wfn*1.0E6_dp + END IF + END IF + WRITE (iounit, '(T3,A)') & + '------------------------------------------------------------------------------' + END IF + DEALLOCATE (a, b, S_det) + IF (mixed_cdft%calculate_metric) DEALLOCATE (metric) + + CALL cp_print_key_finished_output(iounit, logger, force_env_section, & + "MIXED%PRINT%PROGRAM_RUN_INFO") + CALL timestop(handle) + + END SUBROUTINE mixed_cdft_calculate_coupling +! ************************************************************************************************** +!> \brief Becke constraint adapted to mixed calculations, details in et_coupling.F +!> \param force_env the force_env that holds the CDFT states +!> \param calculate_forces determines if forces should be calculted +!> \par History +!> 02.2016 created [Nico Holmberg] +!> 03.2016 added dynamic load balancing (dlb) +!> changed pw_p_type data types to rank-3 reals to accommodate dlb +!> and to reduce overall memory footprint +!> split to subroutines [Nico Holmberg] +!> 04.2016 introduced mixed grid mapping [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE mixed_becke_constraint(force_env, calculate_forces) + TYPE(force_env_type), POINTER :: force_env + LOGICAL, INTENT(IN) :: calculate_forces + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_becke_constraint', & + routineP = moduleN//':'//routineN + + INTEGER :: handle + INTEGER, ALLOCATABLE, DIMENSION(:) :: catom + LOGICAL :: in_memory, store_vectors + LOGICAL, ALLOCATABLE, DIMENSION(:) :: is_constraint + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: coefficients + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: position_vecs, R12 + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: pair_dist_vecs + TYPE(cp_logger_type), POINTER :: logger + TYPE(mixed_cdft_type), POINTER :: mixed_cdft + TYPE(mixed_environment_type), POINTER :: mixed_env + + NULLIFY (mixed_env, mixed_cdft) + store_vectors = .TRUE. + logger => cp_get_default_logger() + CALL timeset(routineN, handle) + mixed_env => force_env%mixed_env + CALL get_mixed_env(mixed_env, cdft_control=mixed_cdft) + CALL mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, & + is_constraint, in_memory, store_vectors, & + R12, position_vecs, pair_dist_vecs, & + coefficients, catom) + CALL mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & + is_constraint, store_vectors, R12, & + position_vecs, pair_dist_vecs, & + coefficients, catom) + CALL timestop(handle) + + END SUBROUTINE mixed_becke_constraint +! ************************************************************************************************** +!> \brief Initialize the mixed Becke constraint calculation +!> \param force_env the force_env that holds the CDFT states +!> \param mixed_cdft container for structures needed to build the mixed CDFT constraint +!> \param calculate_forces determines if forces should be calculted +!> \param is_constraint a list used to determine which atoms in the system define the constraint +!> \param in_memory decides whether to build the weight function gradients in parallel before solving +!> the CDFT states or later during the SCF procedure of the individual states +!> \param store_vectors should temporary arrays be stored in memory to accelerate the calculation +!> \param R12 temporary array holding the pairwise atomic distances +!> \param position_vecs temporary array holding the pbc corrected atomic position vectors +!> \param pair_dist_vecs temporary array holding the pairwise displament vectors +!> \param coefficients array that determines how atoms should be summed to form the constraint +!> \param catom temporary array to map the global index of constraint atoms to their position +!> in a list that holds only constraint atoms +!> \par History +!> 03.2016 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, & + is_constraint, in_memory, store_vectors, & + R12, position_vecs, pair_dist_vecs, coefficients, & + catom) + TYPE(force_env_type), POINTER :: force_env + TYPE(mixed_cdft_type), POINTER :: mixed_cdft + LOGICAL, INTENT(IN) :: calculate_forces + LOGICAL, ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: is_constraint + LOGICAL, INTENT(OUT) :: in_memory + LOGICAL, INTENT(IN) :: store_vectors + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), & + INTENT(out) :: R12, position_vecs + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), & + INTENT(out) :: pair_dist_vecs + REAL(kind=dp), ALLOCATABLE, DIMENSION(:), & + INTENT(OUT) :: coefficients + INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(out) :: catom + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_becke_constraint_init', & + routineP = moduleN//':'//routineN + + CHARACTER(len=2) :: element_symbol + INTEGER :: atom_a, bounds(2), dir, handle, i, iatom, iex, iforce_eval, ikind, iounit, & + ithread, j, jatom, katom, lb_index, my_work, my_work_size, natom, nforce_eval, nkind, & + np(3), npme, nthread, numexp, offset_dlb, tmp_index(2), ub_index, unit_nr + INTEGER, DIMENSION(2, 3) :: bo, bo_conf + INTEGER, DIMENSION(:), POINTER :: atom_list, cores, stride + LOGICAL :: build + REAL(kind=dp) :: alpha, chi, coef, dynamic_radius, ircov, & + jrcov, lb, ra(3), tmp_const, ub, uij + REAL(kind=dp), DIMENSION(3) :: cell_v, dist_vec, dr, r, r1, shift + REAL(KIND=dp), DIMENSION(:, :), POINTER :: pab + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(cell_type), POINTER :: cell + TYPE(cp_logger_type), POINTER :: logger + TYPE(cp_subsys_type), POINTER :: subsys_mix + TYPE(force_env_type), POINTER :: force_env_qs + TYPE(hirshfeld_type), POINTER :: cavity_env + TYPE(particle_list_type), POINTER :: particles + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + TYPE(realspace_grid_type), POINTER :: rs_cavity + TYPE(section_vals_type), POINTER :: force_env_section, print_section + + NULLIFY (pab, cell, force_env_qs, particle_set, force_env_section, print_section, & + qs_kind_set, particles, subsys_mix, rs_cavity, cavity_env, auxbas_pw_pool, & + atomic_kind_set) + logger => cp_get_default_logger() + nforce_eval = SIZE(force_env%sub_force_env) + CALL timeset(routineN, handle) + CALL force_env_get(force_env=force_env, force_env_section=force_env_section) + IF (.NOT. force_env%mixed_env%do_mixed_qmmm_cdft) THEN + CALL force_env_get(force_env=force_env, & + subsys=subsys_mix, & + cell=cell) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles, & + particle_set=particle_set) + ELSE + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + force_env_qs => force_env%sub_force_env(iforce_eval)%force_env + END DO + CALL get_qs_env(force_env_qs%qmmm_env%qs_env, & + cp_subsys=subsys_mix, & + cell=cell) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles, & + particle_set=particle_set) + END IF + natom = SIZE(particles%els) + print_section => section_vals_get_subs_vals(force_env_section, "MIXED%PRINT%PROGRAM_RUN_INFO") + IF (.NOT. ASSOCIATED(mixed_cdft%becke_control%cutoffs)) THEN + CALL cp_subsys_get(subsys_mix, atomic_kind_set=atomic_kind_set) + ALLOCATE (mixed_cdft%becke_control%cutoffs(natom)) + SELECT CASE (mixed_cdft%becke_control%cutoff_type) + CASE (becke_cutoff_global) + mixed_cdft%becke_control%cutoffs(:) = mixed_cdft%becke_control%rglobal + CASE (becke_cutoff_element) + IF (.NOT. SIZE(atomic_kind_set) == SIZE(mixed_cdft%becke_control%cutoffs_tmp)) & + CALL cp_abort(__LOCATION__, & + "Size of keyword BECKE_RESTRAINT\ELEMENT_CUTOFFS does"// & + "not match number of atomic kinds in the input coordinate file.") + DO ikind = 1, SIZE(atomic_kind_set) + CALL get_atomic_kind(atomic_kind_set(ikind), natom=katom, atom_list=atom_list) + DO iatom = 1, katom + atom_a = atom_list(iatom) + mixed_cdft%becke_control%cutoffs(atom_a) = mixed_cdft%becke_control%cutoffs_tmp(ikind) + END DO + END DO + DEALLOCATE (mixed_cdft%becke_control%cutoffs_tmp) + END SELECT + END IF + build = .FALSE. + IF (mixed_cdft%becke_control%adjust .AND. & + .NOT. ASSOCIATED(mixed_cdft%becke_control%aij)) THEN + ALLOCATE (mixed_cdft%becke_control%aij(natom, natom)) + build = .TRUE. + END IF + ALLOCATE (catom(mixed_cdft%becke_control%natoms)) + IF (mixed_cdft%becke_control%dynamic_confine .OR. & + mixed_cdft%becke_control%save_pot .OR. & + mixed_cdft%becke_control%cavity_confine .OR. & + mixed_cdft%becke_control%should_skip .OR. & + mixed_cdft%first_iteration) THEN + ALLOCATE (is_constraint(natom)) + is_constraint = .FALSE. + END IF + in_memory = calculate_forces .AND. mixed_cdft%becke_control%in_memory + IF (in_memory .NEQV. calculate_forces) & + CALL cp_abort(__LOCATION__, & + "The flag BECKE_RESTRAINT\IN_MEMORY must be activated "// & + "for the calculation of mixed CDFT forces") + IF (in_memory .OR. mixed_cdft%first_iteration) ALLOCATE (coefficients(natom)) + DO i = 1, mixed_cdft%becke_control%natoms + catom(i) = mixed_cdft%becke_control%atoms(i) + IF (mixed_cdft%becke_control%dynamic_confine .OR. & + mixed_cdft%becke_control%save_pot .OR. & + mixed_cdft%becke_control%cavity_confine .OR. & + mixed_cdft%becke_control%should_skip .OR. & + mixed_cdft%first_iteration) & + is_constraint(catom(i)) = .TRUE. + IF (in_memory .OR. mixed_cdft%first_iteration) & + coefficients(catom(i)) = mixed_cdft%becke_control%coeff(i) + ENDDO + CALL pw_env_get(pw_env=mixed_cdft%pw_env, auxbas_pw_pool=auxbas_pw_pool) + bo = auxbas_pw_pool%pw_grid%bounds_local + np = auxbas_pw_pool%pw_grid%npts + dr = auxbas_pw_pool%pw_grid%dr + shift = -REAL(MODULO(np, 2), dp)*dr/2.0_dp + IF (store_vectors) THEN + IF (in_memory) ALLOCATE (pair_dist_vecs(3, natom, natom)) + ALLOCATE (position_vecs(3, natom)) + END IF + DO i = 1, 3 + cell_v(i) = cell%hmat(i, i) + END DO + IF (mixed_cdft%becke_control%confine) THEN + dir = mixed_cdft%becke_control%confine_dir + lb = mixed_cdft%becke_control%confine_bounds(1) + ub = mixed_cdft%becke_control%confine_bounds(2) + lb = lb-cell%hmat(dir, dir)/2._dp + ub = ub-cell%hmat(dir, dir)/2._dp + ELSE IF (mixed_cdft%becke_control%dynamic_confine) THEN + dir = mixed_cdft%becke_control%confine_dir + lb = HUGE(0.0_dp) + ub = -HUGE(0.0_dp) + dynamic_radius = mixed_cdft%becke_control%dynamic_radius + END IF + ALLOCATE (R12(natom, natom)) + DO iatom = 1, natom-1 + DO jatom = iatom+1, natom + r = particle_set(iatom)%r + r1 = particle_set(jatom)%r + DO i = 1, 3 + r(i) = MODULO(r(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp + r1(i) = MODULO(r1(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp + END DO + dist_vec = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + IF (store_vectors) THEN + position_vecs(:, iatom) = r(:) + IF (iatom == 1 .AND. jatom == natom) position_vecs(:, jatom) = r1(:) + IF (in_memory) THEN + pair_dist_vecs(:, iatom, jatom) = dist_vec(:) + pair_dist_vecs(:, jatom, iatom) = -dist_vec(:) + END IF + END IF + R12(iatom, jatom) = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + R12(jatom, iatom) = R12(iatom, jatom) + IF (mixed_cdft%becke_control%dynamic_confine .AND. & + is_constraint(iatom) .AND. is_constraint(jatom)) THEN + IF ((r(dir)+dynamic_radius) .GT. ub) ub = r(dir)+dynamic_radius + IF ((r1(dir)+dynamic_radius) .GT. ub) ub = r1(dir)+dynamic_radius + IF ((r(dir)-dynamic_radius) .LT. lb) lb = r(dir)-dynamic_radius + IF ((r1(dir)-dynamic_radius) .LT. lb) lb = r1(dir)-dynamic_radius + END IF + IF (build) THEN + CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, & + kind_number=ikind) + ircov = mixed_cdft%becke_control%radii(ikind) + CALL get_atomic_kind(atomic_kind=particle_set(jatom)%atomic_kind, & + kind_number=ikind) + jrcov = mixed_cdft%becke_control%radii(ikind) + IF (ircov .NE. jrcov) THEN + chi = ircov/jrcov + uij = (chi-1.0_dp)/(chi+1.0_dp) + mixed_cdft%becke_control%aij(iatom, jatom) = uij/(uij**2-1.0_dp) + IF (mixed_cdft%becke_control%aij(iatom, jatom) & + .GT. 0.5_dp) THEN + mixed_cdft%becke_control%aij(iatom, jatom) = 0.5_dp + ELSE IF (mixed_cdft%becke_control%aij(iatom, jatom) & + .LT. -0.5_dp) THEN + mixed_cdft%becke_control%aij(iatom, jatom) = -0.5_dp + END IF + ELSE + mixed_cdft%becke_control%aij(iatom, jatom) = 0.0_dp + END IF + mixed_cdft%becke_control%aij(jatom, iatom) = & + -mixed_cdft%becke_control%aij(iatom, jatom) + END IF + END DO + END DO + ! Dump some additional information about the calculation + IF (mixed_cdft%first_iteration) THEN + print_section => section_vals_get_subs_vals(force_env_section, "MIXED%PRINT%PROGRAM_RUN_INFO") + iounit = cp_print_key_unit_nr(logger, print_section, '', extension='.mixedLog') + IF (iounit > 0) THEN + WRITE (iounit, '(/,T3,A,T66)') & + '----------------------------- Becke atomic parameters -----------------------------' + IF (mixed_cdft%becke_control%adjust) THEN + WRITE (iounit, '(/,T3,A,A)') & + 'Atom Element Coefficient', ' Cutoff (angstrom) CDFT Radius (angstrom)' + DO iatom = 1, natom + CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, & + element_symbol=element_symbol, & + kind_number=ikind) + ircov = cp_unit_from_cp2k(mixed_cdft%becke_control%radii(ikind), "angstrom") + IF (is_constraint(iatom)) THEN + coef = coefficients(iatom) + ELSE + coef = 0.0_dp + END IF + WRITE (iounit, "(i7,T15,A2,T23,F8.3,T39,F8.3,T61,F8.3,T75,F8.3)") & + iatom, element_symbol, coef, & + cp_unit_from_cp2k(mixed_cdft%becke_control%cutoffs(iatom), "angstrom"), & + ircov + END DO + ELSE + WRITE (iounit, '(/,T3,A,A)') & + 'Atom Element Coefficient', ' Cutoff (angstrom)' + DO iatom = 1, natom + CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, & + element_symbol=element_symbol) + IF (is_constraint(iatom)) THEN + coef = coefficients(iatom) + ELSE + coef = 0.0_dp + END IF + WRITE (iounit, "(i7,T15,A2,T23,F8.3,T39,F8.3,T61,F8.3,T75)") & + iatom, element_symbol, coef, & + cp_unit_from_cp2k(mixed_cdft%becke_control%cutoffs(iatom), "angstrom") + END DO + END IF + WRITE (iounit, '(/,T3,A)') & + '-----------------------------------------------------------------------------------' + END IF + CALL cp_print_key_finished_output(iounit, logger, force_env_section, & + "MIXED%PRINT%PROGRAM_RUN_INFO") + mixed_cdft%first_iteration = .FALSE. + END IF + + IF (mixed_cdft%becke_control%dynamic_confine .OR. & + mixed_cdft%becke_control%confine) THEN + tmp_const = (ub-shift(dir))/dr(dir) + IF (tmp_const .GE. 0.0_dp) THEN + ub_index = CEILING(tmp_const) + ELSE + ub_index = FLOOR(tmp_const) + END IF + tmp_const = (lb-shift(dir))/dr(dir) + IF (tmp_const .GE. 0.0_dp) THEN + lb_index = CEILING(tmp_const) + ELSE + lb_index = FLOOR(tmp_const) + END IF + mixed_cdft%becke_control%confine_bounds_int(1) = lb_index + mixed_cdft%becke_control%confine_bounds_int(2) = ub_index + END IF + IF (mixed_cdft%becke_control%cavity_confine) THEN + CPASSERT(ASSOCIATED(mixed_cdft%qs_kind_set)) + cavity_env => mixed_cdft%becke_control%cavity_env + qs_kind_set => mixed_cdft%qs_kind_set + CALL cp_subsys_get(subsys_mix, atomic_kind_set=atomic_kind_set) + nkind = SIZE(qs_kind_set) + IF (.NOT. ASSOCIATED(cavity_env%kind_shape_fn)) & + CALL create_shape_function(cavity_env, qs_kind_set, atomic_kind_set, & + radius=mixed_cdft%becke_control%rcavity, & + radii_list=mixed_cdft%becke_control%radii) + NULLIFY (rs_cavity) + CALL pw_env_get(pw_env=mixed_cdft%pw_env, auxbas_rs_grid=rs_cavity, & + auxbas_pw_pool=auxbas_pw_pool) + ! be careful in parallel nsmax is choosen with multigrid in mind! + CALL rs_grid_retain(rs_cavity) + CALL rs_grid_zero(rs_cavity) + ALLOCATE (pab(1, 1)) + nthread = 1 + ithread = 0 + DO ikind = 1, SIZE(atomic_kind_set) + numexp = cavity_env%kind_shape_fn(ikind)%numexp + IF (numexp <= 0) CYCLE + CALL get_atomic_kind(atomic_kind_set(ikind), natom=katom, atom_list=atom_list) + ALLOCATE (cores(katom)) + DO iex = 1, numexp + alpha = cavity_env%kind_shape_fn(ikind)%zet(iex) + coef = cavity_env%kind_shape_fn(ikind)%coef(iex) + npme = 0 + cores = 0 + DO iatom = 1, katom + IF (rs_cavity%desc%parallel .AND. .NOT. rs_cavity%desc%distributed) THEN + ! replicated realspace grid, split the atoms up between procs + IF (MODULO(iatom, rs_cavity%desc%group_size) == rs_cavity%desc%my_pos) THEN + npme = npme+1 + cores(npme) = iatom + ENDIF + ELSE + npme = npme+1 + cores(npme) = iatom + ENDIF + END DO + DO j = 1, npme + iatom = cores(j) + atom_a = atom_list(iatom) + pab(1, 1) = coef + IF (store_vectors) THEN + ra(:) = position_vecs(:, atom_a)+cell_v(:)/2._dp + ELSE + ra(:) = pbc(particle_set(atom_a)%r, cell) + END IF + IF (is_constraint(atom_a)) & + CALL collocate_pgf_product_rspace(0, alpha, 0, 0, 0.0_dp, 0, ra, & + (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, 1.0_dp, pab, 0, 0, & + rs_cavity, cell, mixed_cdft%pw_env%cube_info(1), & + mixed_cdft%eps_rho_rspace, ga_gb_function=FUNC_AB, & + ithread=ithread, use_subpatch=.TRUE., & + subpatch_pattern=0_int_8, lmax_global=0) + END DO + END DO + DEALLOCATE (cores) + END DO + DEALLOCATE (pab) + CALL pw_pool_create_pw(auxbas_pw_pool, mixed_cdft%becke_control%cavity%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + CALL rs_pw_transfer(rs_cavity, mixed_cdft%becke_control%cavity%pw, rs2pw) + CALL rs_grid_release(rs_cavity) + IF (.NOT. mixed_cdft%becke_control%dynamic_confine) THEN + CALL hfun_zero(mixed_cdft%becke_control%cavity%pw%cr3d, & + mixed_cdft%becke_control%eps_cavity, & + just_zero=.FALSE., bounds=bounds, work=my_work) + IF (mixed_cdft%is_pencil .OR. mixed_cdft%is_special) THEN + my_work_size = (bounds(2)-bounds(1)+1)*(bo(2, 2)-bo(1, 2)+1) + ELSE + my_work_size = (bounds(2)-bounds(1)+1)*(bo(2, 1)-bo(1, 1)+1) + END IF + mixed_cdft%becke_control%confine_bounds_int(1) = bounds(1) + mixed_cdft%becke_control%confine_bounds_int(2) = bounds(2) + END IF + IF (mixed_cdft%becke_control%print_cavity) THEN + CALL hfun_zero(mixed_cdft%becke_control%cavity%pw%cr3d, & + mixed_cdft%becke_control%eps_cavity, just_zero=.TRUE.) + NULLIFY (stride) + ALLOCATE (stride(3)) + stride = (/2, 2, 2/) + unit_nr = cp_print_key_unit_nr(logger, print_section, "", & + middle_name="BECKE_CAVITY", & + extension=".cube", file_position="REWIND", & + log_filename=.FALSE.) + IF (force_env%para_env%mepos == force_env%para_env%source .AND. unit_nr .LT. 1) & + CALL cp_abort(__LOCATION__, & + "Please turn on PROGRAM_RUN_INFO to print cavity") + CALL cp_pw_to_cube(mixed_cdft%becke_control%cavity%pw, & + unit_nr, "CAVITY", particles=particles, & + stride=stride) + CALL cp_print_key_finished_output(unit_nr, logger, print_section, '') + DEALLOCATE (stride) + END IF + END IF + bo_conf = bo + IF (mixed_cdft%becke_control%dynamic_confine .OR. & + mixed_cdft%becke_control%confine) THEN + IF (ub_index .GT. bo(2, dir)) THEN + tmp_index(2) = bo(2, dir)-1 + ELSE + tmp_index(2) = ub_index-1 + END IF + IF (lb_index .LT. bo(1, dir)) THEN + tmp_index(1) = bo(1, dir)+1 + ELSE + tmp_index(1) = lb_index+1 + END IF + bo_conf(2, dir) = tmp_index(2) + bo_conf(1, dir) = tmp_index(1) + ELSE IF (mixed_cdft%becke_control%cavity_confine) THEN + IF (bounds(2) .LT. bo(2, 3)) bo_conf(2, 3) = bounds(2)-1 + IF (bounds(1) .GT. bo(1, 3)) bo_conf(1, 3) = bounds(1)+1 + END IF + + ! Load balance + IF (mixed_cdft%dlb) & + CALL mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & + my_work_size, natom, bo, bo_conf) + ! The bounds have been finalized => time to allocate storage for working matrices + offset_dlb = 0 + IF (mixed_cdft%dlb) THEN + IF (mixed_cdft%dlb_control%send_work .AND. .NOT. mixed_cdft%is_special) & + offset_dlb = SUM(mixed_cdft%dlb_control%target_list(2, :)) + END IF + IF (mixed_cdft%becke_control%cavity_confine) THEN + ! Get rid of the zero part of the confinement cavity (cr3d -> real(:,:,:)) + IF (mixed_cdft%is_special) THEN + ALLOCATE (mixed_cdft%sendbuff(SIZE(mixed_cdft%dest_list))) + DO i = 1, SIZE(mixed_cdft%dest_list) + ALLOCATE (mixed_cdft%sendbuff(i)%cavity(mixed_cdft%dest_list_bo(1, i):mixed_cdft%dest_list_bo(2, i), & + bo(1, 2):bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%sendbuff(i)%cavity = mixed_cdft%becke_control%cavity%pw%cr3d(mixed_cdft%dest_list_bo(1, i): & + mixed_cdft%dest_list_bo(2, i), & + bo(1, 2):bo(2, 2), & + bo_conf(1, 3):bo_conf(2, 3)) + END DO + ELSE IF (mixed_cdft%is_pencil) THEN + ALLOCATE (mixed_cdft%cavity(bo(1, 1)+offset_dlb:bo(2, 1), bo(1, 2):bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%cavity = mixed_cdft%becke_control%cavity%pw%cr3d(bo(1, 1)+offset_dlb:bo(2, 1), & + bo(1, 2):bo(2, 2), & + bo_conf(1, 3):bo_conf(2, 3)) + ELSE + ALLOCATE (mixed_cdft%cavity(bo(1, 1):bo(2, 1), bo(1, 2)+offset_dlb:bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%cavity = mixed_cdft%becke_control%cavity%pw%cr3d(bo(1, 1):bo(2, 1), & + bo(1, 2)+offset_dlb:bo(2, 2), & + bo_conf(1, 3):bo_conf(2, 3)) + END IF + CALL pw_pool_give_back_pw(auxbas_pw_pool, mixed_cdft%becke_control%cavity%pw) + END IF + IF (mixed_cdft%is_special) THEN + DO i = 1, SIZE(mixed_cdft%dest_list) + ALLOCATE (mixed_cdft%sendbuff(i)%weight(mixed_cdft%dest_list_bo(1, i):mixed_cdft%dest_list_bo(2, i), & + bo(1, 2):bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%sendbuff(i)%weight = 0.0_dp + END DO + ELSE IF (mixed_cdft%is_pencil) THEN + ALLOCATE (mixed_cdft%weight(bo(1, 1)+offset_dlb:bo(2, 1), bo(1, 2):bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%weight = 0.0_dp + ELSE + ALLOCATE (mixed_cdft%weight(bo(1, 1):bo(2, 1), bo(1, 2)+offset_dlb:bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%weight = 0.0_dp + END IF + IF (in_memory) THEN + IF (mixed_cdft%is_special) THEN + DO i = 1, SIZE(mixed_cdft%dest_list) + ALLOCATE (mixed_cdft%sendbuff(i)%gradients(3*natom, mixed_cdft%dest_list_bo(1, i): & + mixed_cdft%dest_list_bo(2, i), & + bo(1, 2):bo(2, 2), & + bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%sendbuff(i)%gradients = 0.0_dp + END DO + ELSE IF (mixed_cdft%is_pencil) THEN + ALLOCATE (mixed_cdft%becke_control%gradients(3*natom, bo(1, 1)+offset_dlb:bo(2, 1), & + bo(1, 2):bo(2, 2), & + bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%becke_control%gradients = 0.0_dp + ELSE + ALLOCATE (mixed_cdft%becke_control%gradients(3*natom, bo(1, 1):bo(2, 1), & + bo(1, 2)+offset_dlb:bo(2, 2), & + bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%becke_control%gradients = 0.0_dp + END IF + IF (mixed_cdft%becke_control%should_skip .AND. .NOT. & + mixed_cdft%becke_control%cavity_confine) THEN + ALLOCATE (mixed_cdft%becke_control%skip_list(bo_conf(1, 1):bo_conf(2, 1), & + bo_conf(1, 2):bo_conf(2, 2), & + bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%becke_control%skip_list = .FALSE. + END IF + END IF + + CALL timestop(handle) + + END SUBROUTINE mixed_becke_constraint_init + +! ************************************************************************************************** +!> \brief Setup load balancing for mixed Becke calculation +!> \param force_env the force_env that holds the CDFT states +!> \param mixed_cdft container for structures needed to build the mixed CDFT constraint +!> \param my_work an estimate of the work per processor +!> \param my_work_size size of the smallest array slice per processor. overloaded processors will +!> redistribute works as integer multiples of this value. +!> \param natom the total number of atoms +!> \param bo bounds of the realspace grid that holds the electron density +!> \param bo_conf same as bo, but bounds along z-direction have been compacted with confinement +!> \par History +!> 03.2016 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & + my_work_size, natom, bo, bo_conf) + TYPE(force_env_type), POINTER :: force_env + TYPE(mixed_cdft_type), POINTER :: mixed_cdft + INTEGER, INTENT(IN) :: my_work, my_work_size, natom + INTEGER, DIMENSION(2, 3) :: bo, bo_conf + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_becke_constraint_dlb', & + routineP = moduleN//':'//routineN + INTEGER, PARAMETER :: should_deallocate = 7000, & + uninitialized = -7000 + + INTEGER :: actually_sent, exhausted_work, handle, i, ind, ispecial, j, max_targets, & + more_work, my_pos, my_req(2), my_special_work, my_target, no_overloaded, no_underloaded, & + nsend, nsend_limit, nsend_max, offset, offset_proc, offset_special, req(4), send_total, & + tags(2) + INTEGER, DIMENSION(:), POINTER :: buffsize, cumulative_work, expected_work, load_imbalance, & + nrecv, nsend_proc, req_recv, req_total, sendbuffer, should_warn, tmp, work_index, & + work_size + INTEGER, DIMENSION(:, :), POINTER :: targets, tmp_bo + LOGICAL :: consistent + LOGICAL, DIMENSION(:), POINTER :: mask_recv, mask_send, touched + REAL(kind=dp) :: average_work, load_scale, & + very_overloaded, work_factor + REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: cavity + TYPE(cp_logger_type), POINTER :: logger + + TYPE buffers + LOGICAL, POINTER, DIMENSION(:) :: bv + INTEGER, POINTER, DIMENSION(:) :: iv + END TYPE buffers + TYPE(buffers), POINTER, DIMENSION(:) :: recvbuffer, sbuff + CHARACTER(len=2) :: dummy + + logger => cp_get_default_logger() + CALL timeset(routineN, handle) + mixed_cdft%dlb_control%recv_work = .FALSE. + mixed_cdft%dlb_control%send_work = .FALSE. + NULLIFY (expected_work, work_index, load_imbalance, work_size, & + cumulative_work, sendbuffer, buffsize, req_recv, req_total, & + tmp, nrecv, nsend_proc, targets, tmp_bo, touched, & + mask_recv, mask_send, cavity, recvbuffer, sbuff) + ! These numerical values control data redistribution and are system sensitive + ! Currently they are not refined during run time which may cause crashes + ! However, using too many processors or a confinement cavity that is too large relative to the + ! total system volume are more likely culprits. + load_scale = mixed_cdft%dlb_control%load_scale + very_overloaded = mixed_cdft%dlb_control%very_overloaded + more_work = mixed_cdft%dlb_control%more_work + max_targets = 40 + work_factor = 0.8_dp + ! Reset targets/sources + IF (mixed_cdft%is_special) THEN + DEALLOCATE (mixed_cdft%dest_list, mixed_cdft%dest_list_bo, & + mixed_cdft%source_list, mixed_cdft%source_list_bo) + ALLOCATE (mixed_cdft%dest_list(SIZE(mixed_cdft%dest_list_save)), & + mixed_cdft%dest_list_bo(SIZE(mixed_cdft%dest_bo_save, 1), SIZE(mixed_cdft%dest_bo_save, 2)), & + mixed_cdft%source_list(SIZE(mixed_cdft%source_list_save)), & + mixed_cdft%source_list_bo(SIZE(mixed_cdft%source_bo_save, 1), SIZE(mixed_cdft%source_bo_save, 2))) + mixed_cdft%dest_list = mixed_cdft%dest_list_save + mixed_cdft%source_list = mixed_cdft%source_list_save + mixed_cdft%dest_list_bo = mixed_cdft%dest_bo_save + mixed_cdft%source_list_bo = mixed_cdft%source_bo_save + END IF + ALLOCATE (mixed_cdft%dlb_control%expected_work(force_env%para_env%num_pe), & + expected_work(force_env%para_env%num_pe), & + work_size(force_env%para_env%num_pe)) + IF (debug_this_module) THEN + ALLOCATE (should_warn(force_env%para_env%num_pe)) + should_warn = 0 + END IF + expected_work = 0 + expected_work(force_env%para_env%mepos+1) = my_work + work_size = 0 + work_size(force_env%para_env%mepos+1) = my_work_size + IF (ASSOCIATED(mixed_cdft%dlb_control%prediction_error)) THEN + IF (mixed_cdft%is_pencil .OR. mixed_cdft%is_special) THEN + work_size(force_env%para_env%mepos+1) = work_size(force_env%para_env%mepos+1)- & + NINT(REAL(mixed_cdft%dlb_control% & + prediction_error(force_env%para_env%mepos+1), dp)/ & + REAL(bo(2, 1)-bo(1, 1)+1, dp)) + ELSE + work_size(force_env%para_env%mepos+1) = work_size(force_env%para_env%mepos+1)- & + NINT(REAL(mixed_cdft%dlb_control% & + prediction_error(force_env%para_env%mepos+1), dp)/ & + REAL(bo(2, 2)-bo(1, 2)+1, dp)) + END IF + END IF + CALL mp_sum(expected_work, force_env%para_env%group) + CALL mp_sum(work_size, force_env%para_env%group) + ! We store the unsorted expected work to refine the estimate on subsequent calls to this routine + mixed_cdft%dlb_control%expected_work = expected_work + ! Take into account the prediction error of the last step + IF (ASSOCIATED(mixed_cdft%dlb_control%prediction_error)) & + expected_work = expected_work-mixed_cdft%dlb_control%prediction_error + ! + average_work = REAL(SUM(expected_work), dp)/REAL(force_env%para_env%num_pe, dp) + ALLOCATE (work_index(force_env%para_env%num_pe), & + load_imbalance(force_env%para_env%num_pe), & + targets(2, force_env%para_env%num_pe)) + load_imbalance = expected_work-NINT(average_work) + no_overloaded = 0 + no_underloaded = 0 + targets = 0 + ! Convert the load imbalance to a multiple of the actual work size + DO i = 1, force_env%para_env%num_pe + IF (load_imbalance(i) .GT. 0) THEN + no_overloaded = no_overloaded+1 + ! Allow heavily overloaded processors to dump more data since most likely they have a lot of 'real' work + IF (expected_work(i) .GT. NINT(very_overloaded*average_work)) THEN + load_imbalance(i) = (CEILING(REAL(load_imbalance(i), dp)/REAL(work_size(i), dp))+more_work)*work_size(i) + ELSE + load_imbalance(i) = CEILING(REAL(load_imbalance(i), dp)/REAL(work_size(i), dp))*work_size(i) + END IF + ELSE + ! Allow the underloaded processors to take load_scale amount of additional work + ! otherwise we may be unable to exhaust all overloaded processors + load_imbalance(i) = NINT(load_imbalance(i)*load_scale) + no_underloaded = no_underloaded+1 + END IF + END DO + CALL sort(expected_work, force_env%para_env%num_pe, indices=work_index) + ! Redistribute work in order from the most overloaded processors to the most underloaded processors + ! Each underloaded processor is limited to one overloaded processor + IF (load_imbalance(force_env%para_env%mepos+1) > 0) THEN + offset = 0 + mixed_cdft%dlb_control%send_work = .TRUE. + ! Build up the total amount of work that needs redistribution + ALLOCATE (cumulative_work(force_env%para_env%num_pe)) + cumulative_work = 0 + DO i = force_env%para_env%num_pe, force_env%para_env%num_pe-no_overloaded+1, -1 + IF (work_index(i) == force_env%para_env%mepos+1) THEN + EXIT + ELSE + offset = offset+load_imbalance(work_index(i)) + IF (i == force_env%para_env%num_pe) THEN + cumulative_work(i) = load_imbalance(work_index(i)) + ELSE + cumulative_work(i) = cumulative_work(i+1)+load_imbalance(work_index(i)) + END IF + END IF + END DO + my_pos = i + j = force_env%para_env%num_pe + nsend_max = load_imbalance(work_index(j))/work_size(work_index(j)) + exhausted_work = 0 + ! Determine send offset by going through all processors that are more overloaded than my_pos + DO i = 1, no_underloaded + IF (my_pos == force_env%para_env%num_pe) EXIT + nsend = -load_imbalance(work_index(i))/work_size(work_index(j)) + IF (nsend .LT. 1) nsend = 1 + nsend_max = nsend_max-nsend + IF (nsend_max .LT. 0) nsend = nsend+nsend_max + exhausted_work = exhausted_work+nsend*work_size(work_index(j)) + offset = offset-nsend*work_size(work_index(j)) + IF (offset .LT. 0) EXIT + IF (exhausted_work .EQ. cumulative_work(j)) THEN + j = j-1 + nsend_max = load_imbalance(work_index(j))/work_size(work_index(j)) + END IF + END DO + ! Underloaded processors were fully exhausted: rewind index + ! Load balancing will fail if this happens on multiple processors + IF (i .GT. no_underloaded) THEN + i = no_underloaded + END IF + my_target = i + DEALLOCATE (cumulative_work) + ! Determine how much and who to send slices of my grid points + nsend_max = load_imbalance(force_env%para_env%mepos+1)/work_size(force_env%para_env%mepos+1) + ! This the actual number of available array slices + IF (mixed_cdft%is_pencil .OR. mixed_cdft%is_special) THEN + nsend_limit = bo(2, 1)-bo(1, 1)+1 + ELSE + nsend_limit = bo(2, 2)-bo(1, 2)+1 + END IF + IF (.NOT. mixed_cdft%is_special) THEN + ALLOCATE (mixed_cdft%dlb_control%target_list(3, max_targets)) + ELSE + ALLOCATE (mixed_cdft%dlb_control%target_list(3+2*SIZE(mixed_cdft%dest_list), max_targets)) + ALLOCATE (touched(SIZE(mixed_cdft%dest_list))) + touched = .FALSE. + END IF + mixed_cdft%dlb_control%target_list = uninitialized + i = 1 + ispecial = 1 + offset_special = 0 + targets(1, my_pos) = my_target + send_total = 0 + ! Main loop. Note, we actually allow my_pos to offload more slices than nsend_max + DO + nsend = -load_imbalance(work_index(my_target))/work_size(force_env%para_env%mepos+1) + IF (nsend .LT. 1) nsend = 1 ! send at least one block + ! Prevent over redistribution: leave at least (1-work_factor)*nsend_limit slices to my_pos + IF (nsend .GT. NINT(work_factor*nsend_limit-send_total)) THEN + nsend = NINT(work_factor*nsend_limit-send_total) + IF (debug_this_module) & + should_warn(force_env%para_env%mepos+1) = 1 + END IF + mixed_cdft%dlb_control%target_list(1, i) = work_index(my_target)-1 ! This is the actual processor rank + IF (mixed_cdft%is_special) THEN + mixed_cdft%dlb_control%target_list(2, i) = 0 + actually_sent = nsend + DO j = ispecial, SIZE(mixed_cdft%dest_list) + mixed_cdft%dlb_control%target_list(2, i) = mixed_cdft%dlb_control%target_list(2, i)+1 + touched(j) = .TRUE. + IF (nsend .LT. mixed_cdft%dest_list_bo(2, j)-mixed_cdft%dest_list_bo(1, j)+1) THEN + mixed_cdft%dlb_control%target_list(3+2*j-1, i) = mixed_cdft%dest_list_bo(1, j) + mixed_cdft%dlb_control%target_list(3+2*j, i) = mixed_cdft%dest_list_bo(1, j)+nsend-1 + mixed_cdft%dest_list_bo(1, j) = mixed_cdft%dest_list_bo(1, j)+nsend + nsend = 0 + EXIT + ELSE + mixed_cdft%dlb_control%target_list(3+2*j-1, i) = mixed_cdft%dest_list_bo(1, j) + mixed_cdft%dlb_control%target_list(3+2*j, i) = mixed_cdft%dest_list_bo(2, j) + nsend = nsend-(mixed_cdft%dest_list_bo(2, j)-mixed_cdft%dest_list_bo(1, j)+1) + mixed_cdft%dest_list_bo(1:2, j) = should_deallocate + END IF + IF (nsend .LE. 0) EXIT + END DO + IF (mixed_cdft%dest_list_bo(1, ispecial) .EQ. should_deallocate) ispecial = j+1 + actually_sent = actually_sent-nsend + nsend_max = nsend_max-actually_sent + send_total = send_total+actually_sent + ELSE + mixed_cdft%dlb_control%target_list(2, i) = nsend + nsend_max = nsend_max-nsend + send_total = send_total+nsend + END IF + IF (nsend_max .LT. 0) nsend_max = 0 + IF (nsend_max .EQ. 0) EXIT + IF (my_target /= no_underloaded) THEN + my_target = my_target+1 + ELSE + ! If multiple processors execute this block load balancing will fail + mixed_cdft%dlb_control%target_list(2, i) = mixed_cdft%dlb_control%target_list(2, i)+nsend_max + nsend_max = 0 + EXIT + END IF + i = i+1 + IF (i .GT. max_targets) & + CALL cp_abort(__LOCATION__, & + "Load balancing error: increase max_targets") + END DO + IF (.NOT. mixed_cdft%is_special) THEN + CALL reallocate(mixed_cdft%dlb_control%target_list, 1, 3, 1, i) + ELSE + CALL reallocate(mixed_cdft%dlb_control%target_list, 1, 3+2*SIZE(mixed_cdft%dest_list), 1, i) + END IF + targets(2, my_pos) = my_target + ! Equalize the load on the target processors + IF (.NOT. mixed_cdft%is_special) THEN + IF (send_total .GT. NINT(work_factor*nsend_limit)) send_total = NINT(work_factor*nsend_limit)-1 + nsend = NINT(REAL(send_total, dp)/REAL(SIZE(mixed_cdft%dlb_control%target_list, 2), dp)) + mixed_cdft%dlb_control%target_list(2, :) = nsend + END IF + ELSE + DO i = 1, no_underloaded + IF (work_index(i) == force_env%para_env%mepos+1) EXIT + END DO + my_pos = i + END IF + CALL mp_sum(targets, force_env%para_env%group) + IF (debug_this_module) THEN + CALL mp_sum(should_warn, force_env%para_env%group) + IF (ANY(should_warn == 1)) & + CALL cp_warn(__LOCATION__, & + "MIXED_CDFT DLB: Attempted to redistribute more array"// & + " slices than actually available. Leaving a fraction of the total "// & + " slices on the overloaded processor. Perhaps you have set LOAD_SCALE too high?") + DEALLOCATE (should_warn) + END IF + ! check that there is one-to-one mapping between over- and underloaded processors + IF (force_env%para_env%mepos == force_env%para_env%source) THEN + consistent = .TRUE. + IF (debug_this_module) THEN + PRINT*, 'no_underloaded', no_underloaded + PRINT*, 'Work size', work_size + PRINT*, 'Load imbalance', load_imbalance + PRINT*, 'targets', work_index(force_env%para_env%num_pe), targets(:, force_env%para_env%num_pe) + END IF + DO i = force_env%para_env%num_pe-1, force_env%para_env%num_pe-no_overloaded+1, -1 + IF (debug_this_module) PRINT*, 'targets', work_index(i), targets(1, i), targets(2, i) + IF (targets(1, i) .GT. no_underloaded) consistent = .FALSE. + IF (targets(1, i) .GT. targets(2, i+1)) THEN + CYCLE + ELSE + consistent = .FALSE. + END IF + END DO + IF (.NOT. consistent) & + CALL cp_abort(__LOCATION__, & + "Load balancing error: too much data to redistribute."// & + " Increase LOAD_SCALE or change the number of processors."// & + " If the confinement cavity occupies a large volume relative"// & + " to the total system volume, it might be worth disabling DLB.") + END IF + ! Tell the target processors which grid points they should compute + IF (my_pos .LE. no_underloaded) THEN + DO i = force_env%para_env%num_pe, force_env%para_env%num_pe-no_overloaded+1, -1 + IF (targets(1, i) .LE. my_pos .AND. targets(2, i) .GE. my_pos) THEN + mixed_cdft%dlb_control%recv_work = .TRUE. + mixed_cdft%dlb_control%my_source = work_index(i)-1 + EXIT + END IF + END DO + IF (mixed_cdft%dlb_control%recv_work) THEN + IF (.NOT. mixed_cdft%is_special) THEN + ALLOCATE (mixed_cdft%dlb_control%bo(12)) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%bo, source=mixed_cdft%dlb_control%my_source, & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + mixed_cdft%dlb_control%my_dest_repl = (/mixed_cdft%dlb_control%bo(11), mixed_cdft%dlb_control%bo(12)/) + mixed_cdft%dlb_control%dest_tags_repl = (/mixed_cdft%dlb_control%bo(9), mixed_cdft%dlb_control%bo(10)/) + ALLOCATE (mixed_cdft%dlb_control%cavity(mixed_cdft%dlb_control%bo(1):mixed_cdft%dlb_control%bo(2), & + mixed_cdft%dlb_control%bo(3):mixed_cdft%dlb_control%bo(4), & + mixed_cdft%dlb_control%bo(7):mixed_cdft%dlb_control%bo(8))) + ALLOCATE (mixed_cdft%dlb_control%weight(mixed_cdft%dlb_control%bo(1):mixed_cdft%dlb_control%bo(2), & + mixed_cdft%dlb_control%bo(3):mixed_cdft%dlb_control%bo(4), & + mixed_cdft%dlb_control%bo(7):mixed_cdft%dlb_control%bo(8))) + ALLOCATE (mixed_cdft%dlb_control%gradients(3*natom, & + mixed_cdft%dlb_control%bo(1):mixed_cdft%dlb_control%bo(2), & + mixed_cdft%dlb_control%bo(3):mixed_cdft%dlb_control%bo(4), & + mixed_cdft%dlb_control%bo(7):mixed_cdft%dlb_control%bo(8))) + mixed_cdft%dlb_control%gradients = 0.0_dp + mixed_cdft%dlb_control%weight = 0.0_dp + CALL mp_irecv(msgout=mixed_cdft%dlb_control%cavity, source=mixed_cdft%dlb_control%my_source, & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + DEALLOCATE (mixed_cdft%dlb_control%bo) + ELSE + ALLOCATE (buffsize(1)) + CALL mp_irecv(msgout=buffsize, source=mixed_cdft%dlb_control%my_source, & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + ALLOCATE (mixed_cdft%dlb_control%bo(12*buffsize(1))) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%bo, source=mixed_cdft%dlb_control%my_source, & + request=req(1), comm=force_env%para_env%group) + ALLOCATE (mixed_cdft%dlb_control%sendbuff(buffsize(1))) + ALLOCATE (req_recv(buffsize(1))) + DEALLOCATE (buffsize) + CALL mp_wait(req(1)) + DO j = 1, SIZE(mixed_cdft%dlb_control%sendbuff) + ALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%cavity(mixed_cdft%dlb_control%bo(12*(j-1)+1): & + mixed_cdft%dlb_control%bo(12*(j-1)+2), & + mixed_cdft%dlb_control%bo(12*(j-1)+3): & + mixed_cdft%dlb_control%bo(12*(j-1)+4), & + mixed_cdft%dlb_control%bo(12*(j-1)+7): & + mixed_cdft%dlb_control%bo(12*(j-1)+8))) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%sendbuff(j)%cavity, & + source=mixed_cdft%dlb_control%my_source, & + request=req_recv(j), comm=force_env%para_env%group) + ALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%weight(mixed_cdft%dlb_control%bo(12*(j-1)+1): & + mixed_cdft%dlb_control%bo(12*(j-1)+2), & + mixed_cdft%dlb_control%bo(12*(j-1)+3): & + mixed_cdft%dlb_control%bo(12*(j-1)+4), & + mixed_cdft%dlb_control%bo(12*(j-1)+7): & + mixed_cdft%dlb_control%bo(12*(j-1)+8))) + ALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%gradients(3*natom, & + mixed_cdft%dlb_control%bo(12*(j-1)+1): & + mixed_cdft%dlb_control%bo(12*(j-1)+2), & + mixed_cdft%dlb_control%bo(12*(j-1)+3): & + mixed_cdft%dlb_control%bo(12*(j-1)+4), & + mixed_cdft%dlb_control%bo(12*(j-1)+7): & + mixed_cdft%dlb_control%bo(12*(j-1)+8))) + mixed_cdft%dlb_control%sendbuff(j)%weight = 0.0_dp + mixed_cdft%dlb_control%sendbuff(j)%gradients = 0.0_dp + mixed_cdft%dlb_control%sendbuff(j)%tag = (/mixed_cdft%dlb_control%bo(12*(j-1)+9), & + mixed_cdft%dlb_control%bo(12*(j-1)+10)/) + mixed_cdft%dlb_control%sendbuff(j)%rank = (/mixed_cdft%dlb_control%bo(12*(j-1)+11), & + mixed_cdft%dlb_control%bo(12*(j-1)+12)/) + END DO + CALL mp_waitall(req_recv) + DEALLOCATE (req_recv) + END IF + END IF + ELSE + IF (.NOT. mixed_cdft%is_special) THEN + offset = 0 + ALLOCATE (sendbuffer(12)) + send_total = 0 + DO i = 1, SIZE(mixed_cdft%dlb_control%target_list, 2) + tags = (/(i-1)*3+1+force_env%para_env%mepos*6*max_targets, & + (i-1)*3+1+3*max_targets+force_env%para_env%mepos*6*max_targets/) ! Unique communicator tags + mixed_cdft%dlb_control%target_list(3, i) = tags(1) + IF (mixed_cdft%is_pencil) THEN + sendbuffer = (/bo_conf(1, 1)+offset, & + bo_conf(1, 1)+offset+(mixed_cdft%dlb_control%target_list(2, i)-1), & + bo_conf(1, 2), bo_conf(2, 2), bo(1, 3), bo(2, 3), bo_conf(1, 3), bo_conf(2, 3), & + tags(1), tags(2), mixed_cdft%dest_list(1), mixed_cdft%dest_list(2)/) + ELSE + sendbuffer = (/bo_conf(1, 1), bo_conf(2, 1), & + bo_conf(1, 2)+offset, & + bo_conf(1, 2)+offset+(mixed_cdft%dlb_control%target_list(2, i)-1), & + bo(1, 3), bo(2, 3), bo_conf(1, 3), bo_conf(2, 3), tags(1), tags(2), & + mixed_cdft%dest_list(1), mixed_cdft%dest_list(2)/) + END IF + send_total = send_total+mixed_cdft%dlb_control%target_list(2, i)-1 + CALL mp_isend(msgin=sendbuffer, dest=mixed_cdft%dlb_control%target_list(1, i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + IF (mixed_cdft%is_pencil) THEN + ALLOCATE (cavity(bo_conf(1, 1)+offset: & + bo_conf(1, 1)+offset+(mixed_cdft%dlb_control%target_list(2, i)-1), & + bo_conf(1, 2):bo_conf(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + cavity = mixed_cdft%becke_control%cavity%pw%cr3d(bo_conf(1, 1)+offset: & + bo_conf(1, 1)+offset+ & + (mixed_cdft%dlb_control%target_list(2, i)-1), & + bo_conf(1, 2):bo_conf(2, 2), & + bo_conf(1, 3):bo_conf(2, 3)) + ELSE + ALLOCATE (cavity(bo_conf(1, 1):bo_conf(2, 1), & + bo_conf(1, 2)+offset: & + bo_conf(1, 2)+offset+(mixed_cdft%dlb_control%target_list(2, i)-1), & + bo_conf(1, 3):bo_conf(2, 3))) + cavity = mixed_cdft%becke_control%cavity%pw%cr3d(bo_conf(1, 1):bo_conf(2, 1), & + bo_conf(1, 2)+offset: & + bo_conf(1, 2)+offset+ & + (mixed_cdft%dlb_control%target_list(2, i)-1), & + bo_conf(1, 3):bo_conf(2, 3)) + END IF + CALL mp_isend(msgin=cavity, & + dest=mixed_cdft%dlb_control%target_list(1, i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + offset = offset+mixed_cdft%dlb_control%target_list(2, i) + DEALLOCATE (cavity) + END DO + IF (mixed_cdft%is_pencil) THEN + mixed_cdft%dlb_control%distributed(1) = bo_conf(1, 1) + mixed_cdft%dlb_control%distributed(2) = bo_conf(1, 1)+offset-1 + ELSE + mixed_cdft%dlb_control%distributed(1) = bo_conf(1, 2) + mixed_cdft%dlb_control%distributed(2) = bo_conf(1, 2)+offset-1 + END IF + DEALLOCATE (sendbuffer) + ELSE + ALLOCATE (buffsize(1)) + DO i = 1, SIZE(mixed_cdft%dlb_control%target_list, 2) + buffsize = mixed_cdft%dlb_control%target_list(2, i) + ! Unique communicator tags (dont actually need these, should be removed) + tags = (/(i-1)*3+1+force_env%para_env%mepos*6*max_targets, & + (i-1)*3+1+3*max_targets+force_env%para_env%mepos*6*max_targets/) + DO j = 4, SIZE(mixed_cdft%dlb_control%target_list, 1) + IF (mixed_cdft%dlb_control%target_list(j, i) .GT. uninitialized) EXIT + END DO + offset_special = j + offset_proc = j-4-(j-4)/2 + CALL mp_isend(msgin=buffsize, & + dest=mixed_cdft%dlb_control%target_list(1, i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + ALLOCATE (sendbuffer(12*buffsize(1))) + DO j = 1, buffsize(1) + sendbuffer(12*(j-1)+1:12*(j-1)+12) = (/mixed_cdft%dlb_control%target_list(offset_special+2*(j-1), i), & + mixed_cdft%dlb_control%target_list(offset_special+2*j-1, i), & + bo_conf(1, 2), bo_conf(2, 2), bo(1, 3), bo(2, 3), & + bo_conf(1, 3), bo_conf(2, 3), tags(1), tags(2), & + mixed_cdft%dest_list(j+offset_proc), & + mixed_cdft%dest_list(j+offset_proc)+force_env%para_env%num_pe/2/) + END DO + CALL mp_isend(msgin=sendbuffer, & + dest=mixed_cdft%dlb_control%target_list(1, i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + DEALLOCATE (sendbuffer) + DO j = 1, buffsize(1) + ALLOCATE (cavity(mixed_cdft%dlb_control%target_list(offset_special+2*(j-1), i): & + mixed_cdft%dlb_control%target_list(offset_special+2*j-1, i), & + bo_conf(1, 2):bo_conf(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + cavity = mixed_cdft%becke_control%cavity%pw%cr3d(LBOUND(cavity, 1):UBOUND(cavity, 1), & + bo_conf(1, 2):bo_conf(2, 2), & + bo_conf(1, 3):bo_conf(2, 3)) + CALL mp_isend(msgin=cavity, & + dest=mixed_cdft%dlb_control%target_list(1, i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + DEALLOCATE (cavity) + END DO + END DO + DEALLOCATE (buffsize) + END IF + END IF + DEALLOCATE (expected_work, work_size, load_imbalance, work_index, targets) + ! Once calculated, data defined on the distributed grid points is sent directly to the processors that own the + ! grid points after the constraint is copied onto the two processor groups, instead of sending the data back to + ! the original owner + IF (mixed_cdft%is_special) THEN + my_special_work = 2 + ALLOCATE (mask_send(SIZE(mixed_cdft%dest_list)), mask_recv(SIZE(mixed_cdft%source_list))) + ALLOCATE (nsend_proc(SIZE(mixed_cdft%dest_list)), nrecv(SIZE(mixed_cdft%source_list))) + nrecv = 0 + nsend_proc = 0 + mask_recv = .FALSE. + mask_send = .FALSE. + ELSE + my_special_work = 1 + END IF + ALLOCATE (recvbuffer(SIZE(mixed_cdft%source_list)), sbuff(SIZE(mixed_cdft%dest_list))) + ALLOCATE (req_total(my_special_work*SIZE(mixed_cdft%source_list)+(my_special_work**2)*SIZE(mixed_cdft%dest_list))) + ALLOCATE (mixed_cdft%dlb_control%recv_work_repl(SIZE(mixed_cdft%source_list))) + DO i = 1, SIZE(mixed_cdft%source_list) + NULLIFY (recvbuffer(i)%bv, recvbuffer(i)%iv) + ALLOCATE (recvbuffer(i)%bv(1), recvbuffer(i)%iv(3)) + CALL mp_irecv(msgout=recvbuffer(i)%bv, & + source=mixed_cdft%source_list(i), & + request=req_total(i), tag=1, comm=force_env%para_env%group) + IF (mixed_cdft%is_special) & + CALL mp_irecv(msgout=recvbuffer(i)%iv, & + source=mixed_cdft%source_list(i), & + request=req_total(i+SIZE(mixed_cdft%source_list)), & + tag=2, comm=force_env%para_env%group) + END DO + DO i = 1, my_special_work + DO j = 1, SIZE(mixed_cdft%dest_list) + IF (i == 1) THEN + NULLIFY (sbuff(j)%iv, sbuff(j)%bv) + ALLOCATE (sbuff(j)%bv(1)) + sbuff(j)%bv = mixed_cdft%dlb_control%send_work + IF (mixed_cdft%is_special) THEN + ALLOCATE (sbuff(j)%iv(3)) + sbuff(j)%iv(1:2) = mixed_cdft%dest_list_bo(1:2, j) + sbuff(j)%iv(3) = 0 + IF (sbuff(j)%iv(1) .EQ. should_deallocate) mask_send(j) = .TRUE. + IF (mixed_cdft%dlb_control%send_work) THEN + sbuff(j)%bv = touched(j) + IF (touched(j)) THEN + nsend = 0 + DO ispecial = 1, SIZE(mixed_cdft%dlb_control%target_list, 2) + IF (mixed_cdft%dlb_control%target_list(4+2*(j-1), ispecial) .NE. uninitialized) & + nsend = nsend+1 + END DO + sbuff(j)%iv(3) = nsend + nsend_proc(j) = nsend + END IF + END IF + END IF + END IF + ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+my_special_work*SIZE(mixed_cdft%source_list) + CALL mp_isend(msgin=sbuff(j)%bv, & + dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + request=req_total(ind), tag=1, & + comm=force_env%para_env%group) + IF (mixed_cdft%is_special) & + CALL mp_isend(msgin=sbuff(j)%iv, & + dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + request=req_total(ind+2*SIZE(mixed_cdft%dest_list)), tag=2, & + comm=force_env%para_env%group) + END DO + END DO + CALL mp_waitall(req_total) + DEALLOCATE (req_total) + DO i = 1, SIZE(mixed_cdft%source_list) + mixed_cdft%dlb_control%recv_work_repl(i) = recvbuffer(i)%bv(1) + IF (mixed_cdft%is_special .AND. mixed_cdft%dlb_control%recv_work_repl(i)) THEN + mixed_cdft%source_list_bo(1:2, i) = recvbuffer(i)%iv(1:2) + nrecv(i) = recvbuffer(i)%iv(3) + IF (recvbuffer(i)%iv(1) .EQ. should_deallocate) mask_recv(i) = .TRUE. + END IF + DEALLOCATE (recvbuffer(i)%bv) + IF (ASSOCIATED(recvbuffer(i)%iv)) DEALLOCATE (recvbuffer(i)%iv) + END DO + DO j = 1, SIZE(mixed_cdft%dest_list) + DEALLOCATE (sbuff(j)%bv) + IF (ASSOCIATED(sbuff(j)%iv)) DEALLOCATE (sbuff(j)%iv) + END DO + DEALLOCATE (recvbuffer) + ! For some reason if debug_this_module is true and is_special is false, the deallocate statement + ! on line 3433 gets executed no matter what (gfortran 5.3.0 bug?). Printing out the variable seems to fix it... + IF (debug_this_module) THEN + WRITE (dummy, *) mixed_cdft%is_special + END IF + IF (.NOT. mixed_cdft%is_special) THEN + IF (mixed_cdft%dlb_control%send_work) THEN + ALLOCATE (sendbuffer(6)) + IF (mixed_cdft%is_pencil) THEN + sendbuffer = (/SIZE(mixed_cdft%dlb_control%target_list, 2), bo_conf(1, 3), bo_conf(2, 3), & + bo_conf(1, 1), bo_conf(1, 2), bo_conf(2, 2)/) + ELSE + sendbuffer = (/SIZE(mixed_cdft%dlb_control%target_list, 2), bo_conf(1, 3), bo_conf(2, 3), & + bo_conf(1, 2), bo_conf(1, 1), bo_conf(2, 1)/) + END IF + END IF + + IF (mixed_cdft%dlb_control%recv_work_repl(1) .OR. mixed_cdft%dlb_control%recv_work_repl(2)) THEN + ALLOCATE (mixed_cdft%dlb_control%recv_info(2)) + NULLIFY (mixed_cdft%dlb_control%recv_info(1)%target_list, mixed_cdft%dlb_control%recv_info(2)%target_list) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(2)) + NULLIFY (mixed_cdft%dlb_control%recvbuff(1)%buffs, mixed_cdft%dlb_control%recvbuff(2)%buffs) + END IF + DO i = 1, 2 + IF (mixed_cdft%dlb_control%recv_work_repl(i) .AND. & + mixed_cdft%dlb_control%send_work) THEN + ALLOCATE (mixed_cdft%dlb_control%recv_info(i)%matrix_info(6)) + IF (i == 2) mixed_cdft%dlb_control%target_list(3, :) = mixed_cdft%dlb_control%target_list(3, :)+ & + 3*max_targets + CALL mp_irecv(msgout=mixed_cdft%dlb_control%recv_info(i)%matrix_info, & + source=mixed_cdft%source_list(i), & + request=my_req(1), comm=force_env%para_env%group) + CALL mp_isend(msgin=sendbuffer, & + dest=mixed_cdft%dest_list(i), & + request=my_req(2), comm=force_env%para_env%group) + CALL mp_waitall(my_req) + ALLOCATE (mixed_cdft%dlb_control%recv_info(i)% & + target_list(3, mixed_cdft%dlb_control%recv_info(i)%matrix_info(1))) + CALL mp_irecv(mixed_cdft%dlb_control%recv_info(i)%target_list, & + source=mixed_cdft%source_list(i), & + request=my_req(1), comm=force_env%para_env%group) + CALL mp_isend(msgin=mixed_cdft%dlb_control%target_list, & + dest=mixed_cdft%dest_list(i), & + request=my_req(2), comm=force_env%para_env%group) + CALL mp_waitall(my_req) + ELSE IF (mixed_cdft%dlb_control%recv_work_repl(i)) THEN + ! Determine which processors will send me data + ALLOCATE (mixed_cdft%dlb_control%recv_info(i)%matrix_info(6)) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%recv_info(i)%matrix_info, & + source=mixed_cdft%source_list(i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + ALLOCATE (mixed_cdft%dlb_control%recv_info(i)% & + target_list(3, mixed_cdft%dlb_control%recv_info(i)%matrix_info(1))) + CALL mp_irecv(mixed_cdft%dlb_control%recv_info(i)%target_list, & + source=mixed_cdft%source_list(i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + ELSE IF (mixed_cdft%dlb_control%send_work) THEN + ! Tell my destination processors which processors will send them data + IF (i == 2) & + mixed_cdft%dlb_control%target_list(3, :) = mixed_cdft%dlb_control%target_list(3, :)+3*max_targets + CALL mp_isend(msgin=sendbuffer, & + dest=mixed_cdft%dest_list(i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + CALL mp_isend(msgin=mixed_cdft%dlb_control%target_list, & + dest=mixed_cdft%dest_list(i), & + request=req(1), comm=force_env%para_env%group) + CALL mp_wait(req(1)) + END IF + END DO + IF (ASSOCIATED(sendbuffer)) DEALLOCATE (sendbuffer) + ELSE + IF (mixed_cdft%dlb_control%send_work) THEN + ALLOCATE (req_total(COUNT(mixed_cdft%dlb_control%recv_work_repl)+2*COUNT(touched))) + ELSE IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + ALLOCATE (req_total(COUNT(mixed_cdft%dlb_control%recv_work_repl))) + END IF + IF (mixed_cdft%dlb_control%send_work) THEN + ind = COUNT(mixed_cdft%dlb_control%recv_work_repl) + DO j = 1, SIZE(mixed_cdft%dest_list) + IF (touched(j)) THEN + ALLOCATE (sbuff(j)%iv(4+3*nsend_proc(j))) + sbuff(j)%iv(1:4) = (/bo_conf(1, 2), bo_conf(2, 2), bo_conf(1, 3), bo_conf(2, 3)/) + offset = 5 + DO i = 1, SIZE(mixed_cdft%dlb_control%target_list, 2) + IF (mixed_cdft%dlb_control%target_list(4+2*(j-1), i) .NE. uninitialized) THEN + sbuff(j)%iv(offset:offset+2) = (/mixed_cdft%dlb_control%target_list(1, i), & + mixed_cdft%dlb_control%target_list(4+2*(j-1), i), & + mixed_cdft%dlb_control%target_list(4+2*j-1, i)/) + offset = offset+3 + END IF + END DO + DO ispecial = 1, my_special_work + CALL mp_isend(msgin=sbuff(j)%iv, & + dest=mixed_cdft%dest_list(j)+(ispecial-1)*force_env%para_env%num_pe/2, & + request=req_total(ind+ispecial), comm=force_env%para_env%group) + END DO + ind = ind+my_special_work + END IF + END DO + END IF + IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + ALLOCATE (mixed_cdft%dlb_control%recv_info(SIZE(mixed_cdft%source_list))) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(SIZE(mixed_cdft%source_list))) + ind = 1 + DO j = 1, SIZE(mixed_cdft%source_list) + NULLIFY (mixed_cdft%dlb_control%recv_info(j)%target_list, & + mixed_cdft%dlb_control%recvbuff(j)%buffs) + IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN + ALLOCATE (mixed_cdft%dlb_control%recv_info(j)%matrix_info(4+3*nrecv(j))) + CALL mp_irecv(mixed_cdft%dlb_control%recv_info(j)%matrix_info, & + source=mixed_cdft%source_list(j), & + request=req_total(ind), comm=force_env%para_env%group) + ind = ind+1 + END IF + END DO + END IF + IF (ASSOCIATED(req_total)) THEN + CALL mp_waitall(req_total) + DEALLOCATE (req_total) + END IF + IF (ANY(mask_send)) THEN + ALLOCATE (tmp(SIZE(mixed_cdft%dest_list)-COUNT(mask_send)), & + tmp_bo(2, SIZE(mixed_cdft%dest_list)-COUNT(mask_send))) + i = 1 + DO j = 1, SIZE(mixed_cdft%dest_list) + IF (.NOT. mask_send(j)) THEN + tmp(i) = mixed_cdft%dest_list(j) + tmp_bo(1:2, i) = mixed_cdft%dest_list_bo(1:2, j) + i = i+1 + END IF + END DO + DEALLOCATE (mixed_cdft%dest_list, mixed_cdft%dest_list_bo) + ALLOCATE (mixed_cdft%dest_list(SIZE(tmp)), mixed_cdft%dest_list_bo(2, SIZE(tmp))) + mixed_cdft%dest_list = tmp + mixed_cdft%dest_list_bo = tmp_bo + DEALLOCATE (tmp, tmp_bo) + END IF + IF (ANY(mask_recv)) THEN + ALLOCATE (tmp(SIZE(mixed_cdft%source_list)-COUNT(mask_recv)), & + tmp_bo(4, SIZE(mixed_cdft%source_list)-COUNT(mask_recv))) + i = 1 + DO j = 1, SIZE(mixed_cdft%source_list) + IF (.NOT. mask_recv(j)) THEN + tmp(i) = mixed_cdft%source_list(j) + tmp_bo(1:4, i) = mixed_cdft%source_list_bo(1:4, j) + i = i+1 + END IF + END DO + DEALLOCATE (mixed_cdft%source_list, mixed_cdft%source_list_bo) + ALLOCATE (mixed_cdft%source_list(SIZE(tmp)), mixed_cdft%source_list_bo(4, SIZE(tmp))) + mixed_cdft%source_list = tmp + mixed_cdft%source_list_bo = tmp_bo + DEALLOCATE (tmp, tmp_bo) + END IF + DEALLOCATE (mask_recv, mask_send) + DEALLOCATE (nsend_proc, nrecv) + IF (mixed_cdft%dlb_control%send_work) THEN + DO j = 1, SIZE(mixed_cdft%dest_list) + IF (touched(j)) DEALLOCATE (sbuff(j)%iv) + END DO + IF (ASSOCIATED(touched)) DEALLOCATE (touched) + END IF + END IF + DEALLOCATE (sbuff) + CALL timestop(handle) + + END SUBROUTINE mixed_becke_constraint_dlb + +! ************************************************************************************************** +!> \brief Low level routine to build mixed Becke constraint and gradients +!> \param force_env the force_env that holds the CDFT states +!> \param mixed_cdft container for structures needed to build the mixed CDFT constraint +!> \param in_memory decides whether to build the weight function gradients in parallel before solving +!> the CDFT states or later during the SCF procedure of the individual states +!> \param is_constraint a list used to determine which atoms in the system define the constraint +!> \param store_vectors should temporary arrays be stored in memory to accelerate the calculation +!> \param R12 temporary array holding the pairwise atomic distances +!> \param position_vecs temporary array holding the pbc corrected atomic position vectors +!> \param pair_dist_vecs temporary array holding the pairwise displament vectors +!> \param coefficients array that determines how atoms should be summed to form the constraint +!> \param catom temporary array to map the global index of constraint atoms to their position +!> in a list that holds only constraint atoms +!> \par History +!> 03.2016 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & + is_constraint, store_vectors, R12, position_vecs, & + pair_dist_vecs, coefficients, catom) + TYPE(force_env_type), POINTER :: force_env + TYPE(mixed_cdft_type), POINTER :: mixed_cdft + LOGICAL, INTENT(IN) :: in_memory + LOGICAL, ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: is_constraint + LOGICAL, INTENT(IN) :: store_vectors + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), & + INTENT(INOUT) :: R12, position_vecs + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), & + INTENT(INOUT) :: pair_dist_vecs + REAL(kind=dp), ALLOCATABLE, DIMENSION(:), & + INTENT(INOUT) :: coefficients + INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: catom + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_becke_constraint_low', & + routineP = moduleN//':'//routineN + + INTEGER :: dir, handle, i, iatom, icomm, iforce_eval, ind(3), index, ip, ispecial, iwork, j, & + jatom, jcomm, k, lb_index, my_special_work, my_work, natom, nbuffs, nforce_eval, np(3), & + nsent_total, nskipped, nwork, offset, offset_repl, ub_index + INTEGER, DIMENSION(:), POINTER :: req_recv, work, work_dlb + INTEGER, DIMENSION(:, :), POINTER :: nsent, req_send + LOGICAL :: completed_recv, should_communicate + LOGICAL, ALLOCATABLE, DIMENSION(:) :: skip_me + LOGICAL, ALLOCATABLE, DIMENSION(:, :) :: completed + REAL(kind=dp) :: dist1, dist2, dmyexp, my1, my1_homo, & + myexp, sum_cell_f_all, & + sum_cell_f_constr, th, tmp_const + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: cell_functions, distances, ds_dR_i, & + ds_dR_j + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: d_sum_const_dR, d_sum_Pm_dR, & + distance_vecs, dP_i_dRi + REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dP_i_dRj + REAL(kind=dp), DIMENSION(3) :: cell_v, dist_vec, dmy_dR_i, dmy_dR_j, & + dr, dr1_r2, dr_i_dR, dr_ij_dR, & + dr_j_dR, grid_p, r, r1, shift + REAL(kind=dp), DIMENSION(:), POINTER :: cutoffs + REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: cavity, weight + REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: gradients + TYPE(cell_type), POINTER :: cell + TYPE(cp_logger_type), POINTER :: logger + TYPE(cp_subsys_type), POINTER :: subsys_mix + TYPE(force_env_type), POINTER :: force_env_qs + TYPE(particle_list_type), POINTER :: particles + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool + + logger => cp_get_default_logger() + NULLIFY (work, req_recv, req_send, work_dlb, nsent, cutoffs, cavity, & + weight, gradients, cell, subsys_mix, force_env_qs, & + particle_set, particles, auxbas_pw_pool) + CALL timeset(routineN, handle) + nforce_eval = SIZE(force_env%sub_force_env) + IF (.NOT. force_env%mixed_env%do_mixed_qmmm_cdft) THEN + CALL force_env_get(force_env=force_env, & + subsys=subsys_mix, & + cell=cell) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles, & + particle_set=particle_set) + ELSE + DO iforce_eval = 1, nforce_eval + IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE + force_env_qs => force_env%sub_force_env(iforce_eval)%force_env + END DO + CALL get_qs_env(force_env_qs%qmmm_env%qs_env, & + cp_subsys=subsys_mix, & + cell=cell) + CALL cp_subsys_get(subsys=subsys_mix, & + particles=particles, & + particle_set=particle_set) + END IF + natom = SIZE(particles%els) + CALL pw_env_get(pw_env=mixed_cdft%pw_env, auxbas_pw_pool=auxbas_pw_pool) + np = auxbas_pw_pool%pw_grid%npts + dr = auxbas_pw_pool%pw_grid%dr + shift = -REAL(MODULO(np, 2), dp)*dr/2.0_dp + dir = mixed_cdft%becke_control%confine_dir + lb_index = mixed_cdft%becke_control%confine_bounds_int(1) + ub_index = mixed_cdft%becke_control%confine_bounds_int(2) + ALLOCATE (cell_functions(natom), skip_me(natom)) + IF (store_vectors) THEN + ALLOCATE (distances(natom)) + ALLOCATE (distance_vecs(3, natom)) + END IF + IF (in_memory) THEN + ALLOCATE (ds_dR_j(3)) + ALLOCATE (ds_dR_i(3)) + ALLOCATE (d_sum_Pm_dR(3, natom)) + ALLOCATE (d_sum_const_dR(3, natom)) + ALLOCATE (dP_i_dRj(3, natom, natom)) + ALLOCATE (dP_i_dRi(3, natom)) + th = 1.0e-8_dp + END IF + IF (mixed_cdft%dlb) THEN + ALLOCATE (work(force_env%para_env%num_pe), work_dlb(force_env%para_env%num_pe)) + work = 0 + work_dlb = 0 + END IF + my_work = 1 + my_special_work = 1 + ! Load balancing: allocate storage for receiving buffers and post recv requests + IF (mixed_cdft%dlb) THEN + IF (mixed_cdft%dlb_control%recv_work) THEN + my_work = 2 + IF (.NOT. mixed_cdft%is_special) THEN + ALLOCATE (req_send(2, 3)) + ELSE + ALLOCATE (req_send(2, 3*SIZE(mixed_cdft%dlb_control%sendbuff))) + END IF + END IF + IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + IF (.NOT. mixed_cdft%is_special) THEN + offset_repl = 0 + IF (mixed_cdft%dlb_control%recv_work_repl(1) .AND. mixed_cdft%dlb_control%recv_work_repl(2)) THEN + ALLOCATE (req_recv(3*(SIZE(mixed_cdft%dlb_control%recv_info(1)%target_list, 2)+ & + SIZE(mixed_cdft%dlb_control%recv_info(2)%target_list, 2)))) + offset_repl = 3*SIZE(mixed_cdft%dlb_control%recv_info(1)%target_list, 2) + ELSE IF (mixed_cdft%dlb_control%recv_work_repl(1)) THEN + ALLOCATE (req_recv(3*(SIZE(mixed_cdft%dlb_control%recv_info(1)%target_list, 2)))) + ELSE + ALLOCATE (req_recv(3*(SIZE(mixed_cdft%dlb_control%recv_info(2)%target_list, 2)))) + END IF + ELSE + nbuffs = 0 + offset_repl = 1 + DO j = 1, SIZE(mixed_cdft%dlb_control%recv_work_repl) + IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN + nbuffs = nbuffs+(SIZE(mixed_cdft%dlb_control%recv_info(j)%matrix_info)-4)/3 + END IF + END DO + ALLOCATE (req_recv(3*nbuffs)) + END IF + DO j = 1, SIZE(mixed_cdft%dlb_control%recv_work_repl) + IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN + IF (.NOT. mixed_cdft%is_special) THEN + offset = 0 + index = j+(j/2) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(SIZE(mixed_cdft%dlb_control%recv_info(j)%target_list, 2))) + DO i = 1, SIZE(mixed_cdft%dlb_control%recv_info(j)%target_list, 2) + IF (mixed_cdft%is_pencil) THEN + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + weight(mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + cavity(mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + gradients(3*natom, & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) + ELSE + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + weight(mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + cavity(mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + gradients(3*natom, & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) + END IF + CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, & + source=mixed_cdft%dlb_control%recv_info(j)%target_list(1, i), & + request=req_recv(3*(i-1)+(j-1)*offset_repl+1), & + comm=force_env%para_env%group, & + tag=mixed_cdft%dlb_control%recv_info(j)%target_list(3, i)) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, & + source=mixed_cdft%dlb_control%recv_info(j)%target_list(1, i), & + request=req_recv(3*(i-1)+(j-1)*offset_repl+2), & + comm=force_env%para_env%group, & + tag=mixed_cdft%dlb_control%recv_info(j)%target_list(3, i)+1) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, & + source=mixed_cdft%dlb_control%recv_info(j)%target_list(1, i), & + request=req_recv(3*(i-1)+(j-1)*offset_repl+3), & + comm=force_env%para_env%group, & + tag=mixed_cdft%dlb_control%recv_info(j)%target_list(3, i)+2) + offset = offset+mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) + END DO + DEALLOCATE (mixed_cdft%dlb_control%recv_info(j)%matrix_info) + ELSE + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)% & + buffs((SIZE(mixed_cdft%dlb_control%recv_info(j)%matrix_info)-4)/3)) + index = 6 + DO i = 1, SIZE(mixed_cdft%dlb_control%recvbuff(j)%buffs) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + weight(mixed_cdft%dlb_control%recv_info(j)%matrix_info(index): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(index+1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(1): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4))) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + cavity(mixed_cdft%dlb_control%recv_info(j)%matrix_info(index): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(index+1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(1): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4))) + ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & + gradients(3*natom, mixed_cdft%dlb_control%recv_info(j)%matrix_info(index): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(index+1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(1): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(2), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(3): & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4))) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, & + source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index-1), & + request=req_recv(offset_repl), & + comm=force_env%para_env%group, tag=1) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, & + source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index-1), & + request=req_recv(offset_repl+1), & + comm=force_env%para_env%group, tag=2) + CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, & + source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index-1), & + request=req_recv(offset_repl+2), & + comm=force_env%para_env%group, tag=3) + index = index+3 + offset_repl = offset_repl+3 + END DO + DEALLOCATE (mixed_cdft%dlb_control%recv_info(j)%matrix_info) + END IF + END IF + END DO + END IF + END IF + cutoffs => mixed_cdft%becke_control%cutoffs + should_communicate = .FALSE. + DO i = 1, 3 + cell_v(i) = cell%hmat(i, i) + END DO + DO iwork = my_work, 1, -1 + IF (iwork == 2) THEN + IF (.NOT. mixed_cdft%is_special) THEN + cavity => mixed_cdft%dlb_control%cavity + weight => mixed_cdft%dlb_control%weight + gradients => mixed_cdft%dlb_control%gradients + ALLOCATE (completed(2, 3), nsent(2, 3)) + ELSE + my_special_work = SIZE(mixed_cdft%dlb_control%sendbuff) + ALLOCATE (completed(2, 3*my_special_work), nsent(2, 3*my_special_work)) + END IF + completed = .FALSE. + nsent = 0 + ELSE + IF (.NOT. mixed_cdft%is_special) THEN + weight => mixed_cdft%weight + cavity => mixed_cdft%cavity + gradients => mixed_cdft%becke_control%gradients + ELSE + my_special_work = SIZE(mixed_cdft%dest_list) + END IF + END IF + DO ispecial = 1, my_special_work + nwork = 0 + IF (mixed_cdft%is_special) THEN + IF (iwork == 1) THEN + weight => mixed_cdft%sendbuff(ispecial)%weight + cavity => mixed_cdft%sendbuff(ispecial)%cavity + gradients => mixed_cdft%sendbuff(ispecial)%gradients + ELSE + weight => mixed_cdft%dlb_control%sendbuff(ispecial)%weight + cavity => mixed_cdft%dlb_control%sendbuff(ispecial)%cavity + gradients => mixed_cdft%dlb_control%sendbuff(ispecial)%gradients + END IF + END IF + DO k = LBOUND(weight, 1), UBOUND(weight, 1) + IF (mixed_cdft%dlb .AND. mixed_cdft%is_pencil .AND. .NOT. mixed_cdft%is_special) THEN + IF (mixed_cdft%dlb_control%send_work) THEN + IF (k .GE. mixed_cdft%dlb_control%distributed(1) .AND. & + k .LE. mixed_cdft%dlb_control%distributed(2)) THEN + CYCLE + END IF + END IF + END IF + DO j = LBOUND(weight, 2), UBOUND(weight, 2) + IF (mixed_cdft%dlb .AND. .NOT. mixed_cdft%is_pencil .AND. .NOT. mixed_cdft%is_special) THEN + IF (mixed_cdft%dlb_control%send_work) THEN + IF (j .GE. mixed_cdft%dlb_control%distributed(1) .AND. & + j .LE. mixed_cdft%dlb_control%distributed(2)) THEN + CYCLE + END IF + END IF + END IF + ! Check if any of the buffers have become available for deallocation + IF (should_communicate) THEN + DO icomm = 1, SIZE(nsent, 2) + DO jcomm = 1, SIZE(nsent, 1) + IF (nsent(jcomm, icomm) == 1) CYCLE + CALL mp_test(req_send(jcomm, icomm), completed(jcomm, icomm)) + IF (completed(jcomm, icomm)) THEN + nsent(jcomm, icomm) = nsent(jcomm, icomm)+1 + nsent_total = nsent_total+1 + IF (nsent_total == SIZE(nsent, 1)*SIZE(nsent, 2)) should_communicate = .FALSE. + END IF + IF (ALL(completed(:, icomm))) THEN + IF (MODULO(icomm, 3) == 1) THEN + IF (.NOT. mixed_cdft%is_special) THEN + DEALLOCATE (mixed_cdft%dlb_control%cavity) + ELSE + DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm-1)/3+1)%cavity) + END IF + ELSE IF (MODULO(icomm, 3) == 2) THEN + IF (.NOT. mixed_cdft%is_special) THEN + DEALLOCATE (mixed_cdft%dlb_control%weight) + ELSE + DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm-1)/3+1)%weight) + END IF + ELSE + IF (.NOT. mixed_cdft%is_special) THEN + DEALLOCATE (mixed_cdft%dlb_control%gradients) + ELSE + DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm-1)/3+1)%gradients) + END IF + END IF + END IF + END DO + END DO + END IF + ! Poll to prevent starvation + IF (ASSOCIATED(req_recv)) & + completed_recv = mp_testall(req_recv) + ! + DO i = LBOUND(weight, 3), UBOUND(weight, 3) + IF (mixed_cdft%becke_control%cavity_confine) THEN + IF (cavity(k, j, i) < mixed_cdft%becke_control%eps_cavity) CYCLE + END IF + IF (mixed_cdft%becke_control%confine .OR. & + mixed_cdft%becke_control%dynamic_confine) THEN + ind = (/k, j, i/) + IF (ind(dir) .LE. lb_index .OR. ind(dir) .GE. ub_index) CYCLE + END IF + grid_p(1) = k*dr(1)+shift(1) + grid_p(2) = j*dr(2)+shift(2) + grid_p(3) = i*dr(3)+shift(3) + nskipped = 0 + cell_functions = 1.0_dp + skip_me = .FALSE. + IF (store_vectors) distances = 0.0_dp + IF (in_memory) THEN + d_sum_Pm_dR = 0.0_dp + d_sum_const_dR = 0.0_dp + dP_i_dRi = 0.0_dp + END IF + DO iatom = 1, natom + IF (skip_me(iatom)) THEN + cell_functions(iatom) = 0.0_dp + IF (mixed_cdft%becke_control%should_skip) THEN + IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (nskipped == mixed_cdft%becke_control%natoms) THEN + IF (in_memory) THEN + IF (mixed_cdft%becke_control%cavity_confine) THEN + cavity(k, j, i) = 0.0_dp + ELSE + mixed_cdft%becke_control%skip_list(k, j, i) = .TRUE. + END IF + END IF + EXIT + END IF + END IF + CYCLE + END IF + IF (store_vectors) THEN + IF (distances(iatom) .EQ. 0.0_dp) THEN + r = position_vecs(:, iatom) + dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + distance_vecs(:, iatom) = dist_vec + distances(iatom) = dist1 + ELSE + dist_vec = distance_vecs(:, iatom) + dist1 = distances(iatom) + END IF + ELSE + r = particle_set(iatom)%r + DO ip = 1, 3 + r(ip) = MODULO(r(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + END DO + dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + END IF + IF (dist1 .LE. cutoffs(iatom)) THEN + IF (in_memory) THEN + IF (dist1 .LE. th) dist1 = th + dr_i_dR(:) = dist_vec(:)/dist1 + END IF + DO jatom = 1, natom + IF (jatom .NE. iatom) THEN + IF (jatom < iatom) THEN + IF (.NOT. skip_me(jatom)) CYCLE + END IF + IF (store_vectors) THEN + IF (distances(jatom) .EQ. 0.0_dp) THEN + r1 = position_vecs(:, jatom) + dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + distance_vecs(:, jatom) = dist_vec + distances(jatom) = dist2 + ELSE + dist_vec = distance_vecs(:, jatom) + dist2 = distances(jatom) + END IF + ELSE + r1 = particle_set(jatom)%r + DO ip = 1, 3 + r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + END DO + dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) + END IF + IF (in_memory) THEN + IF (store_vectors) THEN + dr1_r2 = pair_dist_vecs(:, iatom, jatom) + ELSE + dr1_r2 = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + END IF + IF (dist2 .LE. th) dist2 = th + tmp_const = (R12(iatom, jatom)**3) + dr_ij_dR(:) = dr1_r2(:)/tmp_const + !derivativ w.r.t. Rj + dr_j_dR = dist_vec(:)/dist2 + dmy_dR_j(:) = -(dr_j_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:)) + !derivativ w.r.t. Ri + dmy_dR_i(:) = dr_i_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:) + END IF + my1 = (dist1-dist2)/R12(iatom, jatom) + IF (mixed_cdft%becke_control%adjust) THEN + my1_homo = my1 + my1 = my1+ & + mixed_cdft%becke_control%aij(iatom, jatom)*(1.0_dp-my1**2) + END IF + myexp = 1.5_dp*my1-0.5_dp*my1**3 + IF (in_memory) THEN + dmyexp = 1.5_dp-1.5_dp*my1**2 + tmp_const = (1.5_dp**2)*dmyexp*(1-myexp**2)* & + (1.0_dp-((1.5_dp*myexp-0.5_dp*(myexp**3))**2)) + + ds_dR_i(:) = -0.5_dp*tmp_const*dmy_dR_i(:) + ds_dR_j(:) = -0.5_dp*tmp_const*dmy_dR_j(:) + IF (mixed_cdft%becke_control%adjust) THEN + tmp_const = 1.0_dp-2.0_dp*my1_homo*mixed_cdft%becke_control%aij(iatom, jatom) + ds_dR_i(:) = ds_dR_i(:)*tmp_const + ds_dR_j(:) = ds_dR_j(:)*tmp_const + END IF + END IF + myexp = 1.5_dp*myexp-0.5_dp*myexp**3 + myexp = 1.5_dp*myexp-0.5_dp*myexp**3 + tmp_const = 0.5_dp*(1.0_dp-myexp) + cell_functions(iatom) = cell_functions(iatom)*tmp_const + IF (in_memory) THEN + IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const+th + dP_i_dRi(:, iatom) = dP_i_dRi(:, iatom)+ds_dR_i(:)/tmp_const + dP_i_dRj(:, iatom, jatom) = ds_dR_j(:)/tmp_const + END IF + + IF (dist2 .LE. cutoffs(jatom)) THEN + tmp_const = 0.5_dp*(1.0_dp+myexp) + cell_functions(jatom) = cell_functions(jatom)*tmp_const + IF (in_memory) THEN + IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const+th + dP_i_dRj(:, jatom, iatom) = -ds_dR_i(:)/tmp_const + dP_i_dRi(:, jatom) = dP_i_dRi(:, jatom)-ds_dR_j(:)/tmp_const + END IF + ELSE + skip_me(jatom) = .TRUE. + END IF + END IF + END DO + IF (in_memory) THEN + dP_i_dRi(:, iatom) = cell_functions(iatom)*dP_i_dRi(:, iatom) + d_sum_Pm_dR(:, iatom) = d_sum_Pm_dR(:, iatom)+dP_i_dRi(:, iatom) + IF (is_constraint(iatom)) & + d_sum_const_dR(:, iatom) = d_sum_const_dR(:, iatom)+dP_i_dRi(:, iatom)* & + coefficients(iatom) + DO jatom = 1, natom + IF (jatom .NE. iatom) THEN + IF (jatom < iatom) THEN + IF (.NOT. skip_me(jatom)) THEN + dP_i_dRj(:, iatom, jatom) = cell_functions(iatom)*dP_i_dRj(:, iatom, jatom) + d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) + IF (is_constraint(iatom)) & + d_sum_const_dR(:, jatom) = d_sum_const_dR(:, jatom)+ & + dP_i_dRj(:, iatom, jatom)* & + coefficients(iatom) + CYCLE + END IF + END IF + dP_i_dRj(:, iatom, jatom) = cell_functions(iatom)*dP_i_dRj(:, iatom, jatom) + d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) + IF (is_constraint(iatom)) & + d_sum_const_dR(:, jatom) = d_sum_const_dR(:, jatom)+dP_i_dRj(:, iatom, jatom)* & + coefficients(iatom) + END IF + END DO + END IF + ELSE + cell_functions(iatom) = 0.0_dp + skip_me(iatom) = .TRUE. + IF (mixed_cdft%becke_control%should_skip) THEN + IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (nskipped == mixed_cdft%becke_control%natoms) THEN + IF (in_memory) THEN + IF (mixed_cdft%becke_control%cavity_confine) THEN + cavity(k, j, i) = 0.0_dp + ELSE + mixed_cdft%becke_control%skip_list(k, j, i) = .TRUE. + END IF + END IF + EXIT + END IF + END IF + END IF + END DO + IF (nskipped == mixed_cdft%becke_control%natoms) CYCLE + sum_cell_f_constr = 0.0_dp + DO ip = 1, mixed_cdft%becke_control%natoms + sum_cell_f_constr = sum_cell_f_constr+cell_functions(catom(ip))* & + mixed_cdft%becke_control%coeff(ip) + END DO + sum_cell_f_all = 0.0_dp + nwork = nwork+1 + DO ip = 1, natom + sum_cell_f_all = sum_cell_f_all+cell_functions(ip) + END DO + IF (in_memory) THEN + DO iatom = 1, natom + IF (ABS(sum_cell_f_all) .GT. 0.0_dp) THEN + gradients(3*(iatom-1)+1:3*(iatom-1)+3, k, j, i) = & + d_sum_const_dR(:, iatom)/sum_cell_f_all-sum_cell_f_constr* & + d_sum_Pm_dR(:, iatom)/(sum_cell_f_all**2) + END IF + END DO + END IF + IF (ABS(sum_cell_f_all) .GT. 0.000001) & + weight(k, j, i) = sum_cell_f_constr/sum_cell_f_all + END DO ! i + END DO ! j + END DO ! k + ! Load balancing: post send requests + IF (iwork == 2) THEN + IF (.NOT. mixed_cdft%is_special) THEN + DO i = 1, SIZE(req_send, 1) + CALL mp_isend(msgin=mixed_cdft%dlb_control%cavity, & + dest=mixed_cdft%dlb_control%my_dest_repl(i), & + request=req_send(i, 1), comm=force_env%para_env%group, & + tag=mixed_cdft%dlb_control%dest_tags_repl(i)) + CALL mp_isend(msgin=mixed_cdft%dlb_control%weight, & + dest=mixed_cdft%dlb_control%my_dest_repl(i), & + request=req_send(i, 2), comm=force_env%para_env%group, & + tag=mixed_cdft%dlb_control%dest_tags_repl(i)+1) + CALL mp_isend(msgin=mixed_cdft%dlb_control%gradients, & + dest=mixed_cdft%dlb_control%my_dest_repl(i), & + request=req_send(i, 3), comm=force_env%para_env%group, & + tag=mixed_cdft%dlb_control%dest_tags_repl(i)+2) + END DO + should_communicate = .TRUE. + nsent_total = 0 + ELSE + DO i = 1, SIZE(req_send, 1) + CALL mp_isend(msgin=mixed_cdft%dlb_control%sendbuff(ispecial)%cavity, & + dest=mixed_cdft%dlb_control%sendbuff(ispecial)%rank(i), & + request=req_send(i, 3*(ispecial-1)+1), & + comm=force_env%para_env%group, tag=1) + CALL mp_isend(msgin=mixed_cdft%dlb_control%sendbuff(ispecial)%weight, & + dest=mixed_cdft%dlb_control%sendbuff(ispecial)%rank(i), & + request=req_send(i, 3*(ispecial-1)+2), & + comm=force_env%para_env%group, tag=2) + CALL mp_isend(msgin=mixed_cdft%dlb_control%sendbuff(ispecial)%gradients, & + dest=mixed_cdft%dlb_control%sendbuff(ispecial)%rank(i), & + request=req_send(i, 3*(ispecial-1)+3), & + comm=force_env%para_env%group, tag=3) + END DO + IF (ispecial .EQ. my_special_work) THEN + should_communicate = .TRUE. + nsent_total = 0 + END IF + END IF + work(mixed_cdft%dlb_control%my_source+1) = work(mixed_cdft%dlb_control%my_source+1)+nwork + work_dlb(force_env%para_env%mepos+1) = work_dlb(force_env%para_env%mepos+1)+nwork + ELSE + IF (mixed_cdft%dlb) work(force_env%para_env%mepos+1) = work(force_env%para_env%mepos+1)+nwork + IF (mixed_cdft%dlb) work_dlb(force_env%para_env%mepos+1) = work_dlb(force_env%para_env%mepos+1)+nwork + END IF + END DO ! ispecial + END DO ! iwork + ! Load balancing: wait for communication and deallocate sending buffers + IF (mixed_cdft%dlb) THEN + IF (mixed_cdft%dlb_control%recv_work .AND. & + ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + IF (should_communicate) THEN + CALL mp_waitall(req_send) + END IF + CALL mp_waitall(req_recv) + IF (ASSOCIATED(mixed_cdft%dlb_control%cavity)) & + DEALLOCATE (mixed_cdft%dlb_control%cavity) + IF (ASSOCIATED(mixed_cdft%dlb_control%weight)) & + DEALLOCATE (mixed_cdft%dlb_control%weight) + IF (ASSOCIATED(mixed_cdft%dlb_control%gradients)) & + DEALLOCATE (mixed_cdft%dlb_control%gradients) + IF (mixed_cdft%is_special) THEN + DO j = 1, SIZE(mixed_cdft%dlb_control%sendbuff) + IF (ASSOCIATED(mixed_cdft%dlb_control%sendbuff(j)%cavity)) & + DEALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%cavity) + IF (ASSOCIATED(mixed_cdft%dlb_control%sendbuff(j)%weight)) & + DEALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%weight) + IF (ASSOCIATED(mixed_cdft%dlb_control%sendbuff(j)%gradients)) & + DEALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%gradients) + END DO + DEALLOCATE (mixed_cdft%dlb_control%sendbuff) + END IF + DEALLOCATE (req_send, req_recv) + ELSE IF (mixed_cdft%dlb_control%recv_work) THEN + IF (should_communicate) THEN + CALL mp_waitall(req_send) + END IF + IF (ASSOCIATED(mixed_cdft%dlb_control%cavity)) & + DEALLOCATE (mixed_cdft%dlb_control%cavity) + IF (ASSOCIATED(mixed_cdft%dlb_control%weight)) & + DEALLOCATE (mixed_cdft%dlb_control%weight) + IF (ASSOCIATED(mixed_cdft%dlb_control%gradients)) & + DEALLOCATE (mixed_cdft%dlb_control%gradients) + IF (mixed_cdft%is_special) THEN + DO j = 1, SIZE(mixed_cdft%dlb_control%sendbuff) + IF (ASSOCIATED(mixed_cdft%dlb_control%sendbuff(j)%cavity)) & + DEALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%cavity) + IF (ASSOCIATED(mixed_cdft%dlb_control%sendbuff(j)%weight)) & + DEALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%weight) + IF (ASSOCIATED(mixed_cdft%dlb_control%sendbuff(j)%gradients)) & + DEALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%gradients) + END DO + DEALLOCATE (mixed_cdft%dlb_control%sendbuff) + END IF + DEALLOCATE (req_send) + ELSE IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN + CALL mp_waitall(req_recv) + DEALLOCATE (req_recv) + END IF + END IF + IF (mixed_cdft%dlb) THEN + CALL mp_sum(work, force_env%para_env%group) + CALL mp_sum(work_dlb, force_env%para_env%group) + IF (.NOT. ASSOCIATED(mixed_cdft%dlb_control%prediction_error)) & + ALLOCATE (mixed_cdft%dlb_control%prediction_error(force_env%para_env%num_pe)) + mixed_cdft%dlb_control%prediction_error = mixed_cdft%dlb_control%expected_work-work + IF (debug_this_module) THEN + IF (force_env%para_env%mepos == force_env%para_env%source) THEN + PRINT*, 'Actual work', work + PRINT*, 'Actual work with redistribution', work_dlb + PRINT*, 'Expected work', mixed_cdft%dlb_control%expected_work + PRINT*, 'prediction_error', mixed_cdft%dlb_control%prediction_error + END IF + END IF + DEALLOCATE (work, work_dlb, mixed_cdft%dlb_control%expected_work) + END IF + NULLIFY (gradients, weight, cavity) + IF (ALLOCATED(coefficients)) & + DEALLOCATE (coefficients) + IF (in_memory) THEN + DEALLOCATE (ds_dR_j) + DEALLOCATE (ds_dR_i) + DEALLOCATE (d_sum_Pm_dR) + DEALLOCATE (d_sum_const_dR) + DEALLOCATE (dP_i_dRj) + DEALLOCATE (dP_i_dRi) + NULLIFY (gradients) + IF (store_vectors) THEN + DEALLOCATE (pair_dist_vecs) + END IF + END IF + NULLIFY (cutoffs) + IF (ALLOCATED(is_constraint)) & + DEALLOCATE (is_constraint) + DEALLOCATE (catom) + DEALLOCATE (R12) + DEALLOCATE (cell_functions) + DEALLOCATE (skip_me) + IF (ALLOCATED(completed)) & + DEALLOCATE (completed) + IF (ASSOCIATED(nsent)) & + DEALLOCATE (nsent) + IF (store_vectors) THEN + DEALLOCATE (distances) + DEALLOCATE (distance_vecs) + DEALLOCATE (position_vecs) + END IF + IF (ASSOCIATED(req_send)) & + DEALLOCATE (req_send) + IF (ASSOCIATED(req_recv)) & + DEALLOCATE (req_recv) + CALL timestop(handle) + + END SUBROUTINE mixed_becke_constraint_low + +! ************************************************************************************************** +!> \brief Determine confinement bounds along confinement dir (hardcoded to be z) +!> and determine the number of nonzero entries +!> Optionally zero entries below a given threshold +!> \param fun input 3D potential (real space) +!> \param th threshold for screening values +!> \param just_zero determines if fun should only be zeroed without returning bounds/work +!> \param bounds the confinement bounds: fun is nonzero only between these values along 3rd dimension +!> \param work an estimate of the total number of grid points where fun is nonzero +! ************************************************************************************************** + SUBROUTINE hfun_zero(fun, th, just_zero, bounds, work) + REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT) :: fun + REAL(KIND=dp), INTENT(IN) :: th + LOGICAL :: just_zero + INTEGER, OPTIONAL :: bounds(2), work + + CHARACTER(len=*), PARAMETER :: routineN = 'hfun_zero', routineP = moduleN//':'//routineN + + INTEGER :: i1, i2, i3, lb, n1, n2, n3, nzeroed, & + nzeroed_total, ub + LOGICAL :: lb_final, ub_final + + n1 = SIZE(fun, 1) + n2 = SIZE(fun, 2) + n3 = SIZE(fun, 3) + nzeroed_total = 0 + IF (.NOT. just_zero) THEN + CPASSERT(PRESENT(bounds)) + CPASSERT(PRESENT(work)) + lb = 1 + lb_final = .FALSE. + ub_final = .FALSE. + END IF + DO i3 = 1, n3 + IF (.NOT. just_zero) nzeroed = 0 + DO i2 = 1, n2 + DO i1 = 1, n1 + IF (fun(i1, i2, i3) < th) THEN + IF (.NOT. just_zero) THEN + nzeroed = nzeroed+1 + nzeroed_total = nzeroed_total+1 + ELSE + fun(i1, i2, i3) = 0.0_dp + END IF + END IF + END DO + END DO + IF (.NOT. just_zero) THEN + IF (nzeroed == (n2*n1)) THEN + IF (.NOT. lb_final) THEN + lb = i3 + ELSE IF (.NOT. ub_final) THEN + ub = i3 + ub_final = .TRUE. + END IF + ELSE + IF (.NOT. lb_final) lb_final = .TRUE. + IF (ub_final) ub_final = .FALSE. ! Safeguard against "holes" + END IF + END IF + END DO + IF (.NOT. just_zero) THEN + IF (.NOT. ub_final) ub = n3 + bounds(1) = lb + bounds(2) = ub + bounds = bounds-(n3/2)-1 + work = n3*n2*n1-nzeroed_total + END IF + + END SUBROUTINE hfun_zero + +END MODULE mixed_cdft_methods diff --git a/src/mixed_cdft_types.F b/src/mixed_cdft_types.F new file mode 100644 index 0000000000..d5e73c726b --- /dev/null +++ b/src/mixed_cdft_types.F @@ -0,0 +1,350 @@ +!--------------------------------------------------------------------------------------------------! +! CP2K: A general program to perform molecular dynamics simulations ! +! Copyright (C) 2000 - 2017 CP2K developers group ! +!--------------------------------------------------------------------------------------------------! + +! ************************************************************************************************** +!> \brief Types for mixed CDFT calculations +!> \par History +!> Separated CDFT routines from mixed_environment_types +!> \author Nico Holmberg [01.2017] +! ************************************************************************************************** +MODULE mixed_cdft_types + USE cp_blacs_env, ONLY: cp_blacs_env_release,& + cp_blacs_env_type + USE cp_control_types, ONLY: becke_control_release,& + becke_restraint_type + USE kinds, ONLY: dp + USE pw_env_types, ONLY: pw_env_release,& + pw_env_type + USE qs_kind_types, ONLY: deallocate_qs_kind_set,& + qs_kind_type +#include "./base/base_uses.f90" + + IMPLICIT NONE + PRIVATE + +! ************************************************************************************************** +!> \brief Buffers for load balancing +!> \param rank indices of the processors the data in this buffer should be sent to +!> \param tag mpi tags for the messages to send +!> \param cavity the cavity to send +!> \param weight the weight to send +!> \param gradients the gradients to send +! ************************************************************************************************** + TYPE buffers + INTEGER :: rank(2), tag(2) + REAL(KIND=dp), POINTER, & + DIMENSION(:, :, :) :: cavity, weight + REAL(KIND=dp), POINTER, & + DIMENSION(:, :, :, :) :: gradients + END TYPE buffers +! ************************************************************************************************** +!> \brief To build array of buffers +!> \param buffs the pointer to the buffers type +! ************************************************************************************************** + TYPE p_buffers + TYPE(buffers), DIMENSION(:), POINTER :: buffs + END TYPE p_buffers +! ************************************************************************************************** +!> \brief Information about load balancing +!> \param matrix_info size of the target_list array to receive and grid point bounds of the data +!> \param target_list the target_list array of the processor that sends me data +! ************************************************************************************************** + TYPE repl_info + INTEGER, DIMENSION(:), POINTER :: matrix_info + INTEGER, DIMENSION(:, :), POINTER :: target_list + END TYPE repl_info +! ************************************************************************************************** +!> \brief Load balancing control for mixed CDFT calculation +!> \param my_source index of the processor which will send this processor data +!> \param distributed bounds that determine which grid points this processor will compute after +!> applying load balancing (is_special = .FALSE.) +!> \param my_dest_repl the dest_list arrays of all processors which send additional work to this +!> processor (indices of the processors where the redistributed slices should be +!> returned) +!> \param dest_tags_repl tags for the send messages (is_special = .FALSE.) +!> \param more_work allow heavily overloaded processors to redistribute more_work slices +!> \param bo bounds of the data that this processor will send to other processors which tells the +!> receivers how to rearrange the data correctly +!> \param expected_work a list of the estimated work per processor +!> \param prediction_error the difference between the estimated and actual work per processor +!> \param target_list a list of processors to send data and the size of data to send +!> \param recv_work flag that determines if this processor will receive data from others +!> \param send_work flag that determines if this processor will send data to others +!> \param recv_work_repl list of processor indices where this processor will send data during load +!> balancing +!> \param load_scale allow underloaded processors to accept load_scale additional work +!> \param very_overloaded value to determine which processors are heavily overloaded +!> \param cavity the cavity that this processor builds in addition to its own cavity defined +!> on the grid points which were redistributed to this processor +!> \param weight the weight that this processor builds in addition to its own weight +!> \param gradients the gradients that this processor builds in addition to its own gradients +!> \param sendbuffer buffer to hold the data this processor will send +!> \param sendbuffer buffer to hold the data this processor will receive +!> \param recv_info additional information on the data this processor will receive +! ************************************************************************************************** + TYPE mixed_cdft_dlb_type + INTEGER :: my_source, distributed(2), & + my_dest_repl(2), dest_tags_repl(2), & + more_work + INTEGER, DIMENSION(:), POINTER :: bo, expected_work, & + prediction_error + INTEGER, DIMENSION(:, :), POINTER :: target_list + LOGICAL :: recv_work, send_work + LOGICAL, DIMENSION(:), POINTER :: recv_work_repl + REAL(KIND=dp) :: load_scale, very_overloaded + REAL(KIND=dp), POINTER, & + DIMENSION(:, :, :) :: cavity, weight + REAL(KIND=dp), POINTER, & + DIMENSION(:, :, :, :) :: gradients + ! Should convert to TYPE(p_buffers), POINTER + TYPE(buffers), DIMENSION(:), POINTER :: sendbuff + TYPE(p_buffers), DIMENSION(:), POINTER :: recvbuff + TYPE(repl_info), DIMENSION(:), POINTER :: recv_info + END TYPE mixed_cdft_dlb_type +! ************************************************************************************************** +!> \brief Main mixed CDFT control type +!> \param sim_step counter to keep track of the simulation step for MD +!> \param multiplicity spin multiplicity +!> \param constraint_type determins what kind of constraint to use +!> \param combined_type for combined density+spin constraint, determines which atoms to apply the +!> spin constraint +!> \param source_list a list of processors which will send this processor data +!> \param dest_list a list of processors which this processor will send data to +!> \param recv_bo bounds of the data which this processor will receive (is_special = .FALSE.) +!> \param source_list_save permanent copy of source_list which might get reallocated during +!> load balancing +!> \param dest_list_save permanent copy of dest_list which might get reallocated during +!> load balancing +!> \param source_list_bo bounds of the data which this processor will receive (is_special = .TRUE.) +!> \param dest_list_bo bounds of the data this processor will send (is_special = .TRUE.) +!> \param source_bo_save permanent copy of source_list_bo +!> \param deset_bo_save permanent copy of dest_list_bo +!> \param is_pencil flag controlling which scheme to use for constraint replication +!> \param dlb flag to enable dynamic load balancing +!> \param is_special another flag controlling which scheme to use for constraint replication +!> \param first_iteration flag to mark the first iteration e.g. during MD to output information +!> \param calculate_metric flag which determines if the coupling reliablity metric should be computed +!> \param wnf_ovelap_method flag to enable the wavefunction overlap method for computing the coupling +!> \param has_unit_metric flag to determine if the basis set has unit metric +!> \param eps_rho_rspace threshold to determine when the realspace density can be considered zero +!> \param sim_dt timestep of the MD simulation +!> \param eps_svd value that controls which matrix inversion method to use +!> \param weight the constraint weight function +!> \param cavity the confinement cavity: the weight function is nonzero only within the cavity +!> \param becke_control container for becke_restraint_type +!> \param sendbuff buffer that holds the data to be replicated +!> \param blacs_env the blacs_env needed to redistribute arrays during a coupling calculation +!> \param dlb_control container for load balancing structures +!> \param qs_kind_set the qs_kind_set needed to setup a confinement cavity +!> \param pw_env the pw_env that holds the fully distributed realspace grid +! ************************************************************************************************** + TYPE mixed_cdft_type + INTEGER :: sim_step, multiplicity, & + constraint_type, combined_type + INTEGER, POINTER, DIMENSION(:) :: source_list, dest_list, & + recv_bo, source_list_save, & + dest_list_save + INTEGER, POINTER, DIMENSION(:, :) :: source_list_bo, dest_list_bo, & + source_bo_save, dest_bo_save + LOGICAL :: is_pencil, dlb, & + is_special, first_iteration, & + calculate_metric, & + wfn_overlap_method, & + has_unit_metric + REAL(KIND=dp) :: eps_rho_rspace, sim_dt, & + eps_svd + REAL(KIND=dp), POINTER, DIMENSION(:, :, :) :: weight, cavity + TYPE(becke_restraint_type), POINTER :: becke_control + TYPE(buffers), DIMENSION(:), POINTER :: sendbuff + TYPE(cp_blacs_env_type), POINTER :: blacs_env + TYPE(mixed_cdft_dlb_type), POINTER :: dlb_control + TYPE(qs_kind_type), DIMENSION(:), & + POINTER :: qs_kind_set + TYPE(pw_env_type), POINTER :: pw_env + END TYPE mixed_cdft_type + +! *** Public data types *** + + PUBLIC :: mixed_cdft_type + +! *** Public subroutines *** + + PUBLIC :: mixed_cdft_type_create, & + mixed_cdft_type_release + + CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mixed_cdft_types' + +CONTAINS + +! ************************************************************************************************** +!> \brief inits the given mixed_cdft_type +!> \param cdft_control the object to init +!> \author Nico Holmberg [01.2017] +! ************************************************************************************************** + SUBROUTINE mixed_cdft_type_create(cdft_control) + TYPE(mixed_cdft_type), POINTER :: cdft_control + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_type_create', & + routineP = moduleN//':'//routineN + + NULLIFY (cdft_control%pw_env, cdft_control%blacs_env, cdft_control%qs_kind_set) + NULLIFY (cdft_control%dlb_control, cdft_control%dest_list_bo, cdft_control%dest_list) + NULLIFY (cdft_control%dest_bo_save, cdft_control%dest_list_save, cdft_control%source_list) + NULLIFY (cdft_control%source_list_save, cdft_control%source_bo_save, cdft_control%source_list_bo) + NULLIFY (cdft_control%cavity, cdft_control%weight, cdft_control%sendbuff) + NULLIFY (cdft_control%becke_control, cdft_control%recv_bo) + + END SUBROUTINE mixed_cdft_type_create + +! ************************************************************************************************** +!> \brief releases the given mixed_cdft_type +!> \param cdft_control the object to release +!> \author Nico Holmberg [01.2017] +! ************************************************************************************************** + SUBROUTINE mixed_cdft_type_release(cdft_control) + TYPE(mixed_cdft_type), POINTER :: cdft_control + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_type_release', & + routineP = moduleN//':'//routineN + + INTEGER :: i + + CALL pw_env_release(cdft_control%pw_env) + IF (ASSOCIATED(cdft_control%dest_list)) & + DEALLOCATE (cdft_control%dest_list) + IF (ASSOCIATED(cdft_control%dest_list_save)) & + DEALLOCATE (cdft_control%dest_list_save) + IF (ASSOCIATED(cdft_control%dest_list_bo)) & + DEALLOCATE (cdft_control%dest_list_bo) + IF (ASSOCIATED(cdft_control%dest_bo_save)) & + DEALLOCATE (cdft_control%dest_bo_save) + IF (ASSOCIATED(cdft_control%source_list)) & + DEALLOCATE (cdft_control%source_list) + IF (ASSOCIATED(cdft_control%source_list_save)) & + DEALLOCATE (cdft_control%source_list_save) + IF (ASSOCIATED(cdft_control%source_list_bo)) & + DEALLOCATE (cdft_control%source_list_bo) + IF (ASSOCIATED(cdft_control%source_bo_save)) & + DEALLOCATE (cdft_control%source_bo_save) + IF (ASSOCIATED(cdft_control%recv_bo)) & + DEALLOCATE (cdft_control%recv_bo) + IF (ASSOCIATED(cdft_control%weight)) & + DEALLOCATE (cdft_control%weight) + IF (ASSOCIATED(cdft_control%cavity)) & + DEALLOCATE (cdft_control%cavity) + IF (ASSOCIATED(cdft_control%dlb_control)) & + CALL mixed_cdft_dlb_release(cdft_control%dlb_control) + IF (ASSOCIATED(cdft_control%sendbuff)) THEN + DO i = 1, SIZE(cdft_control%sendbuff) + CALL mixed_cdft_buffers_release(cdft_control%sendbuff(i)) + END DO + DEALLOCATE (cdft_control%sendbuff) + END IF + CALL becke_control_release(cdft_control%becke_control) + IF (ASSOCIATED(cdft_control%blacs_env)) & + CALL cp_blacs_env_release(cdft_control%blacs_env) + IF (ASSOCIATED(cdft_control%qs_kind_set)) & + CALL deallocate_qs_kind_set(cdft_control%qs_kind_set) + DEALLOCATE (cdft_control) + + END SUBROUTINE mixed_cdft_type_release + +! ************************************************************************************************** +!> \brief releases the given load balancing control +!> \param dlb_control the object to release +!> \author Nico Holmberg [01.2017] +! ************************************************************************************************** + SUBROUTINE mixed_cdft_dlb_release(dlb_control) + TYPE(mixed_cdft_dlb_type), POINTER :: dlb_control + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_dlb_release', & + routineP = moduleN//':'//routineN + + INTEGER :: i + + IF (ASSOCIATED(dlb_control%recv_work_repl)) & + DEALLOCATE (dlb_control%recv_work_repl) + IF (ASSOCIATED(dlb_control%sendbuff)) THEN + DO i = 1, SIZE(dlb_control%sendbuff) + CALL mixed_cdft_buffers_release(dlb_control%sendbuff(i)) + END DO + DEALLOCATE (dlb_control%sendbuff) + END IF + IF (ASSOCIATED(dlb_control%recvbuff)) THEN + DO i = 1, SIZE(dlb_control%recvbuff) + CALL mixed_cdft_p_buffers_release(dlb_control%recvbuff(i)) + END DO + DEALLOCATE (dlb_control%recvbuff) + END IF + IF (ASSOCIATED(dlb_control%recv_info)) THEN + DO i = 1, SIZE(dlb_control%recv_info) + IF (ASSOCIATED(dlb_control%recv_info(i)%matrix_info)) & + DEALLOCATE (dlb_control%recv_info(i)%matrix_info) + IF (ASSOCIATED(dlb_control%recv_info(i)%target_list)) & + DEALLOCATE (dlb_control%recv_info(i)%target_list) + END DO + DEALLOCATE (dlb_control%recv_info) + END IF + IF (ASSOCIATED(dlb_control%bo)) & + DEALLOCATE (dlb_control%bo) + IF (ASSOCIATED(dlb_control%expected_work)) & + DEALLOCATE (dlb_control%expected_work) + IF (ASSOCIATED(dlb_control%prediction_error)) & + DEALLOCATE (dlb_control%prediction_error) + IF (ASSOCIATED(dlb_control%target_list)) & + DEALLOCATE (dlb_control%target_list) + IF (ASSOCIATED(dlb_control%cavity)) & + DEALLOCATE (dlb_control%cavity) + IF (ASSOCIATED(dlb_control%weight)) & + DEALLOCATE (dlb_control%weight) + IF (ASSOCIATED(dlb_control%gradients)) & + DEALLOCATE (dlb_control%gradients) + DEALLOCATE (dlb_control) + + END SUBROUTINE mixed_cdft_dlb_release + +! ************************************************************************************************** +!> \brief releases the given buffers +!> \param buffer the object to release +!> \author Nico Holmberg [01.2017] +! ************************************************************************************************** + SUBROUTINE mixed_cdft_buffers_release(buffer) + TYPE(buffers) :: buffer + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_buffers_release', & + routineP = moduleN//':'//routineN + + IF (ASSOCIATED(buffer%cavity)) & + DEALLOCATE (buffer%cavity) + IF (ASSOCIATED(buffer%weight)) & + DEALLOCATE (buffer%weight) + IF (ASSOCIATED(buffer%gradients)) & + DEALLOCATE (buffer%gradients) + + END SUBROUTINE mixed_cdft_buffers_release + +! ************************************************************************************************** +!> \brief releases the given pointer of buffers +!> \param p_buffer the object to release +!> \author Nico Holmberg [01.2017] +! ************************************************************************************************** + SUBROUTINE mixed_cdft_p_buffers_release(p_buffer) + TYPE(p_buffers) :: p_buffer + + CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_p_buffers_release', & + routineP = moduleN//':'//routineN + + INTEGER :: i + + IF (ASSOCIATED(p_buffer%buffs)) THEN + DO i = 1, SIZE(p_buffer%buffs) + CALL mixed_cdft_buffers_release(p_buffer%buffs(i)) + END DO + DEALLOCATE (p_buffer%buffs) + END IF + + END SUBROUTINE mixed_cdft_p_buffers_release + +END MODULE mixed_cdft_types diff --git a/src/mixed_environment_types.F b/src/mixed_environment_types.F index 5c1f628ffc..4543f38bbb 100644 --- a/src/mixed_environment_types.F +++ b/src/mixed_environment_types.F @@ -33,6 +33,8 @@ MODULE mixed_environment_types USE kinds, ONLY: default_path_length,& default_string_length,& dp + USE mixed_cdft_types, ONLY: mixed_cdft_type,& + mixed_cdft_type_release USE mixed_energy_types, ONLY: deallocate_mixed_energy,& mixed_energy_type USE molecule_kind_list_types, ONLY: molecule_kind_list_create,& @@ -55,27 +57,33 @@ MODULE mixed_environment_types ! ************************************************************************************************** !> \param mixed_env the pointer to the mixed_env !> \par History -!> 11/06 -!> \author fschiff +!> 11/06 Created [fschiff] +!> 12/15-12/16 Mixed CDFT [Nico Holmberg] ! ************************************************************************************************** TYPE mixed_environment_type - INTEGER :: id_nr, ref_count - TYPE(cell_type), POINTER :: cell_ref - TYPE(mixed_energy_type), POINTER :: mixed_energy - TYPE(cp_para_env_type), POINTER :: para_env - TYPE(cp_subsys_type), POINTER :: subsys + INTEGER :: id_nr, ref_count + TYPE(cell_type), POINTER :: cell_ref + TYPE(mixed_energy_type), POINTER :: mixed_energy + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(cp_subsys_type), POINTER :: subsys TYPE(section_vals_type), POINTER :: input REAL(KIND=dp), DIMENSION(:), POINTER :: energies ! Parallelization of multiple force_eval INTEGER :: new_group, ngroups INTEGER, DIMENSION(:), POINTER :: group_distribution TYPE(cp_para_env_p_type), DIMENSION(:), POINTER :: sub_para_env - TYPE(cp_logger_p_type), DIMENSION(:), POINTER :: sub_logger + TYPE(cp_logger_p_type), DIMENSION(:), POINTER :: sub_logger REAL(KIND=dp), POINTER, DIMENSION(:) :: val CHARACTER(LEN=default_string_length), & - DIMENSION(:), POINTER :: par + DIMENSION(:), POINTER :: par REAL(KIND=dp) :: dx, lerr CHARACTER(default_path_length) :: coupling_function + ! Mixed CDFT control parameters + LOGICAL :: do_mixed_cdft, do_mixed_et, & + do_mixed_qmmm_cdft + INTEGER :: et_freq + REAL(KIND=dp), DIMENSION(:), POINTER :: strength + TYPE(mixed_cdft_type), POINTER :: cdft_control END TYPE mixed_environment_type ! ************************************************************************************************** @@ -123,12 +131,13 @@ CONTAINS !> \param subsys ... !> \param input ... !> \param results ... +!> \param cdft_control ... ! ************************************************************************************************** SUBROUTINE get_mixed_env(mixed_env, atomic_kind_set, particle_set, & local_particles, local_molecules, molecule_kind_set, & molecule_set, cell, cell_ref, & mixed_energy, para_env, sub_para_env, subsys, & - input, results) + input, results, cdft_control) TYPE(mixed_environment_type), INTENT(IN) :: mixed_env TYPE(atomic_kind_type), OPTIONAL, POINTER :: atomic_kind_set(:) @@ -144,6 +153,7 @@ CONTAINS TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys TYPE(section_vals_type), OPTIONAL, POINTER :: input TYPE(cp_result_type), OPTIONAL, POINTER :: results + TYPE(mixed_cdft_type), OPTIONAL, POINTER :: cdft_control CHARACTER(len=*), PARAMETER :: routineN = 'get_mixed_env', routineP = moduleN//':'//routineN @@ -160,6 +170,7 @@ CONTAINS IF (PRESENT(mixed_energy)) mixed_energy => mixed_env%mixed_energy IF (PRESENT(para_env)) para_env => mixed_env%para_env IF (PRESENT(sub_para_env)) sub_para_env => mixed_env%sub_para_env + IF (PRESENT(cdft_control)) cdft_control => mixed_env%cdft_control IF (PRESENT(subsys)) subsys => mixed_env%subsys CALL cp_subsys_get(mixed_env%subsys, & atomic_kinds=atomic_kinds, & @@ -197,6 +208,12 @@ CONTAINS NULLIFY (mixed_env%par) NULLIFY (mixed_env%val) NULLIFY (mixed_env%subsys) + NULLIFY (mixed_env%cdft_control) + NULLIFY (mixed_env%strength) + mixed_env%do_mixed_cdft = .FALSE. + mixed_env%do_mixed_et = .FALSE. + mixed_env%do_mixed_qmmm_cdft = .FALSE. + mixed_env%et_freq = -1 CALL cp_para_env_retain(para_env) mixed_env%para_env => para_env mixed_env%ref_count = 1 @@ -219,11 +236,12 @@ CONTAINS !> \param subsys ... !> \param input ... !> \param sub_para_env ... +!> \param cdft_control ... ! ************************************************************************************************** SUBROUTINE set_mixed_env(mixed_env, atomic_kind_set, particle_set, & local_particles, local_molecules, molecule_kind_set, & molecule_set, cell_ref, mixed_energy, subsys, & - input, sub_para_env) + input, sub_para_env, cdft_control) TYPE(mixed_environment_type), POINTER :: mixed_env TYPE(atomic_kind_type), OPTIONAL, POINTER :: atomic_kind_set(:) @@ -237,6 +255,7 @@ CONTAINS TYPE(section_vals_type), OPTIONAL, POINTER :: input TYPE(cp_para_env_p_type), DIMENSION(:), OPTIONAL, & POINTER :: sub_para_env + TYPE(mixed_cdft_type), OPTIONAL, POINTER :: cdft_control CHARACTER(len=*), PARAMETER :: routineN = 'set_mixed_env', routineP = moduleN//':'//routineN @@ -266,6 +285,7 @@ CONTAINS IF (PRESENT(sub_para_env)) THEN mixed_env%sub_para_env => sub_para_env END IF + IF (PRESENT(cdft_control)) mixed_env%cdft_control => cdft_control IF (PRESENT(atomic_kind_set)) THEN CALL atomic_kind_list_create(atomic_kinds, & els_ptr=atomic_kind_set) @@ -375,6 +395,10 @@ CONTAINS IF (ASSOCIATED(mixed_env%group_distribution)) THEN DEALLOCATE (mixed_env%group_distribution) END IF + IF (ASSOCIATED(mixed_env%cdft_control)) & + CALL mixed_cdft_type_release(mixed_env%cdft_control) + IF (ASSOCIATED(mixed_env%strength)) & + DEALLOCATE (mixed_env%strength) DEALLOCATE (mixed_env) END IF END IF diff --git a/src/mpiwrap/message_passing.F b/src/mpiwrap/message_passing.F index fa900c3111..745f330258 100644 --- a/src/mpiwrap/message_passing.F +++ b/src/mpiwrap/message_passing.F @@ -140,7 +140,7 @@ MODULE message_passing PUBLIC :: mp_gather, mp_alltoall, mp_sendrecv, mp_allgather, mp_iallgather PUBLIC :: mp_isend, mp_irecv, mp_ibcast PUBLIC :: mp_shift, mp_isendrecv, mp_wait, mp_waitall, mp_waitany, mp_testany - PUBLIC :: mp_testall, mp_iscatter + PUBLIC :: mp_testall, mp_iscatter, mp_test PUBLIC :: mp_gatherv PUBLIC :: mp_send, mp_recv @@ -185,7 +185,11 @@ MODULE message_passing END INTERFACE INTERFACE mp_testall - MODULE PROCEDURE mp_testall_t2 + MODULE PROCEDURE mp_testall_tv + END INTERFACE + + INTERFACE mp_test + MODULE PROCEDURE mp_test_1 END INTERFACE INTERFACE mp_testany @@ -474,22 +478,24 @@ MODULE message_passing END INTERFACE INTERFACE mp_isend - MODULE PROCEDURE mp_isend_iv, mp_isend_im2, mp_isend_im3, & - mp_isend_lv, mp_isend_lm2, mp_isend_lm3, & - mp_isend_rv, mp_isend_rm2, mp_isend_rm3, & - mp_isend_dv, mp_isend_dm2, mp_isend_dm3, & - mp_isend_cv, mp_isend_cm2, mp_isend_cm3, & - mp_isend_zv, mp_isend_zm2, mp_isend_zm3 + MODULE PROCEDURE mp_isend_iv, mp_isend_im2, mp_isend_im3, mp_isend_im4, & + mp_isend_lv, mp_isend_lm2, mp_isend_lm3, mp_isend_lm4, & + mp_isend_rv, mp_isend_rm2, mp_isend_rm3, mp_isend_rm4, & + mp_isend_dv, mp_isend_dm2, mp_isend_dm3, mp_isend_dm4, & + mp_isend_cv, mp_isend_cm2, mp_isend_cm3, mp_isend_cm4, & + mp_isend_zv, mp_isend_zm2, mp_isend_zm3, mp_isend_zm4 + MODULE PROCEDURE mp_isend_bv, mp_isend_bm3 MODULE PROCEDURE mp_isend_custom END INTERFACE INTERFACE mp_irecv - MODULE PROCEDURE mp_irecv_iv, mp_irecv_im2, mp_irecv_im3, & - mp_irecv_lv, mp_irecv_lm2, mp_irecv_lm3, & - mp_irecv_rv, mp_irecv_rm2, mp_irecv_rm3, & - mp_irecv_dv, mp_irecv_dm2, mp_irecv_dm3, & - mp_irecv_cv, mp_irecv_cm2, mp_irecv_cm3, & - mp_irecv_zv, mp_irecv_zm2, mp_irecv_zm3 + MODULE PROCEDURE mp_irecv_iv, mp_irecv_im2, mp_irecv_im3, mp_irecv_im4, & + mp_irecv_lv, mp_irecv_lm2, mp_irecv_lm3, mp_irecv_lm4, & + mp_irecv_rv, mp_irecv_rm2, mp_irecv_rm3, mp_irecv_rm4, & + mp_irecv_dv, mp_irecv_dm2, mp_irecv_dm3, mp_irecv_dm4, & + mp_irecv_cv, mp_irecv_cm2, mp_irecv_cm3, mp_irecv_cm4, & + mp_irecv_zv, mp_irecv_zm2, mp_irecv_zm3, mp_irecv_zm4 + MODULE PROCEDURE mp_irecv_bv, mp_irecv_bm3 MODULE PROCEDURE mp_irecv_custom END INTERFACE @@ -1731,37 +1737,60 @@ CONTAINS ! ************************************************************************************************** !> \brief Tests for completion of the given requests. !> \brief We use mpi_test so that we can use a single status. -!> \param requests ... -!> \retval flag ... +!> \param requests the list of requests to test +!> \retval flag logical which determines if requests are complete !> \par History -!> 24.2016 created +!> 3.2016 adapted to any shape [Nico Holmberg] !> \author Alfio Lazzaro ! ************************************************************************************************** - FUNCTION mp_testall_t2(requests) RESULT(flag) - INTEGER, DIMENSION(2), INTENT(inout) :: requests + FUNCTION mp_testall_tv(requests) RESULT(flag) + INTEGER, DIMENSION(:) :: requests LOGICAL :: flag INTEGER :: ierr #if defined(__parallel) - LOGICAL :: flag1 + INTEGER :: i + LOGICAL, DIMENSION(:), POINTER :: flags #endif ierr = 0 flag = .TRUE. #if defined(__parallel) - CALL mpi_test(requests(1), flag, MPI_STATUS_IGNORE, ierr) - IF (ierr /= 0) CALL mp_stop(ierr, "mpi_testall @ mp_testall_t2") - ! - CALL mpi_test(requests(2), flag1, MPI_STATUS_IGNORE, ierr) - IF (ierr /= 0) CALL mp_stop(ierr, "mpi_testall @ mp_testall_t2") - ! - flag = flag .AND. flag1 + ALLOCATE (flags(SIZE(requests))) + DO i = 1, SIZE(requests) + CALL mpi_test(requests(i), flags(i), MPI_STATUS_IGNORE, ierr) + IF (ierr /= 0) CALL mp_stop(ierr, "mpi_testall @ mp_testall_tv") + flag = flag .AND. flags(i) + END DO + DEALLOCATE (flags) #else requests = mp_request_null #endif - END FUNCTION mp_testall_t2 + END FUNCTION mp_testall_tv + +! ************************************************************************************************** +!> \brief Tests for completion of the given request. +!> \param request the request +!> \param flag logical which determines if the request is completed +!> \par History +!> 3.2016 created +!> \author Nico Holmberg +! ************************************************************************************************** + SUBROUTINE mp_test_1(request, flag) + INTEGER, INTENT(inout) :: request + LOGICAL, INTENT(out) :: flag + + INTEGER :: ierr + + ierr = 0 + +#if defined(__parallel) + CALL mpi_test(request, flag, MPI_STATUS_IGNORE, ierr) + IF (ierr /= 0) CALL mp_stop(ierr, "mpi_test @ mp_test_1") +#endif + END SUBROUTINE mp_test_1 ! ************************************************************************************************** !> \brief tests for completion of the given requests @@ -2160,6 +2189,250 @@ CONTAINS CALL mp_timestop(handle) END SUBROUTINE mp_bcast_bv +! ************************************************************************************************** +!> \brief Non-blocking send of logical vector data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request communication request index +!> \param tag message tag +!> \par History +!> 3.2016 added _bv subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_iv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ************************************************************************************************** + SUBROUTINE mp_isend_bv(msgin, dest, comm, request, tag) + LOGICAL, DIMENSION(:) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_bv', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + LOGICAL :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN, handle) + +#if defined(__parallel) + t_start = m_walltime() + my_tag = 0 + IF (PRESENT(tag)) my_tag = tag + + msglen = SIZE(msgin, 1) + IF (msglen > 0) THEN + CALL mpi_isend(msgin(1), msglen, MPI_LOGICAL, dest, my_tag, & + comm, request, ierr) + ELSE + CALL mpi_isend(foo, msglen, MPI_LOGICAL, dest, my_tag, & + comm, request, ierr) + END IF + IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN) + + t_end = m_walltime() + CALL add_perf(perf_id=11, count=1, time=t_end-t_start, msg_size=msglen*loglen) +#else + CPABORT("mp_isend called in non parallel case") + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request = 0 +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_bv + +! ************************************************************************************************** +!> \brief Non-blocking recieve of logical vector data +!> \param msgout the received message +!> \param source the source processor +!> \param comm the communicator object +!> \param request communication request index +!> \param tag message tag +!> \par History +!> 3.2016 added _bv subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_iv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ************************************************************************************************** + SUBROUTINE mp_irecv_bv(msgout, source, comm, request, tag) + LOGICAL, DIMENSION(:) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_bv', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + LOGICAL :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN, handle) + +#if defined(__parallel) + t_start = m_walltime() + my_tag = 0 + IF (PRESENT(tag)) my_tag = tag + + msglen = SIZE(msgout, 1) + IF (msglen > 0) THEN + CALL mpi_irecv(msgout(1), msglen, MPI_LOGICAL, source, my_tag, & + comm, request, ierr) + ELSE + CALL mpi_irecv(foo, msglen, MPI_LOGICAL, source, my_tag, & + comm, request, ierr) + END IF + IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ircv @ "//routineN) + + t_end = m_walltime() + CALL add_perf(perf_id=12, count=1, time=t_end-t_start, msg_size=msglen*loglen) +#else + CPABORT("mp_irecv called in non parallel case") + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request = 0 +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_bv + +! ************************************************************************************************** +!> \brief Non-blocking send of rank-3 logical data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request communication request index +!> \param tag message tag +!> \par History +!> 2.2016 added _bm3 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_iv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ************************************************************************************************** + SUBROUTINE mp_isend_bm3(msgin, dest, comm, request, tag) + LOGICAL, DIMENSION(:, :, :) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_bm3', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + LOGICAL :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN, handle) + +#if defined(__parallel) + t_start = m_walltime() + my_tag = 0 + IF (PRESENT(tag)) my_tag = tag + + msglen = SIZE(msgin, 1)*SIZE(msgin, 2)*SIZE(msgin, 3) + IF (msglen > 0) THEN + CALL mpi_isend(msgin(1, 1, 1), msglen, MPI_LOGICAL, dest, my_tag, & + comm, request, ierr) + ELSE + CALL mpi_isend(foo, msglen, MPI_LOGICAL, dest, my_tag, & + comm, request, ierr) + END IF + IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN) + + t_end = m_walltime() + CALL add_perf(perf_id=11, count=1, time=t_end-t_start, msg_size=msglen*loglen) +#else + CPABORT("mp_isend called in non parallel case") + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request = 0 +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_bm3 + +! ************************************************************************************************** +!> \brief Non-blocking receive of rank-3 logical data +!> \param msgout the received message +!> \param source the source processor +!> \param comm the communicator object +!> \param request communication request index +!> \param tag message tag +!> \par History +!> 2.2016 added _bm3 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_iv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ************************************************************************************************** + SUBROUTINE mp_irecv_bm3(msgout, source, comm, request, tag) + LOGICAL, DIMENSION(:, :, :) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_bm3', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + LOGICAL :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN, handle) + +#if defined(__parallel) + t_start = m_walltime() + my_tag = 0 + IF (PRESENT(tag)) my_tag = tag + + msglen = SIZE(msgout, 1)*SIZE(msgout, 2)*SIZE(msgout, 3) + IF (msglen > 0) THEN + CALL mpi_irecv(msgout(1, 1, 1), msglen, MPI_LOGICAL, source, my_tag, & + comm, request, ierr) + ELSE + CALL mpi_irecv(foo, msglen, MPI_LOGICAL, source, my_tag, & + comm, request, ierr) + END IF + IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ircv @ "//routineN) + + t_end = m_walltime() + CALL add_perf(perf_id=12, count=1, time=t_end-t_start, msg_size=msglen*loglen) +#else + CPABORT("mp_irecv called in non parallel case") + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request = 0 +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_bm3 + ! ************************************************************************************************** !> \brief ... !> \param msg ... diff --git a/src/mpiwrap/message_passing__nametype1_.template b/src/mpiwrap/message_passing__nametype1_.template index 0e2299fa09..18316c8456 100644 --- a/src/mpiwrap/message_passing__nametype1_.template +++ b/src/mpiwrap/message_passing__nametype1_.template @@ -3169,6 +3169,68 @@ CALL mp_timestop(handle) END SUBROUTINE mp_isend_[nametype1]m3 +! ***************************************************************************** +!> \brief Non-blocking send of rank-4 data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _[nametype1]m4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_isend_[nametype1]v +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_isend_[nametype1]m4(msgin,dest,comm,request,tag) + [type1], DIMENSION(:, :, :, :) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_[nametype1]m4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + [type1] :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgin,1)*SIZE(msgin,2)*SIZE(msgin,3)*SIZE(msgin,4) + IF (msglen>0) THEN + CALL mpi_isend(msgin(1,1,1,1),msglen,[mpi_type1],dest,my_tag,& + comm,request,ierr) + ELSE + CALL mpi_isend(foo,msglen,[mpi_type1],dest,my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_isend @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=11,count=1,time=t_end-t_start,msg_size=msglen*[bytes1]) +#else + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + ierr=1 + request=0 + CALL mp_stop( ierr, "mp_isend called in non parallel case" ) +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_[nametype1]m4 + ! ***************************************************************************** !> \brief Non-blocking receive of vector data !> \param msgout ... @@ -3356,6 +3418,67 @@ CALL mp_timestop(handle) END SUBROUTINE mp_irecv_[nametype1]m3 +! ***************************************************************************** +!> \brief Non-blocking receive of rank-4 data +!> \param msgout the output message +!> \param source the source processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _[nametype1]m4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_[nametype1]v +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_irecv_[nametype1]m4(msgout,source,comm,request,tag) + [type1], DIMENSION(:, :, :, :) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_[nametype1]m4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + [type1] :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgout,1)*SIZE(msgout,2)*SIZE(msgout,3)*SIZE(msgout,4) + IF (msglen>0) THEN + CALL mpi_irecv(msgout(1,1,1,1),msglen,[mpi_type1],source, my_tag,& + comm,request,ierr) + ELSE + CALL mpi_irecv(foo,msglen,[mpi_type1],source, my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_ircv @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=12,count=1,time=t_end-t_start,msg_size=msglen*[bytes1]) +#else + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request=0 + CPABORT("mp_irecv called in non parallel case") +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_[nametype1]m4 + ! ***************************************************************************** !> \brief Window initialization function for vector data !> \param base ... diff --git a/src/mpiwrap/message_passing_c.f90 b/src/mpiwrap/message_passing_c.f90 index 9ba2a5d0c8..c1ca6009f6 100644 --- a/src/mpiwrap/message_passing_c.f90 +++ b/src/mpiwrap/message_passing_c.f90 @@ -3169,6 +3169,68 @@ CALL mp_timestop(handle) END SUBROUTINE mp_isend_cm3 +! ***************************************************************************** +!> \brief Non-blocking send of rank-4 data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _cm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_isend_cv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_isend_cm4(msgin,dest,comm,request,tag) + COMPLEX(kind=real_4), DIMENSION(:, :, :, :) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_cm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + COMPLEX(kind=real_4) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgin,1)*SIZE(msgin,2)*SIZE(msgin,3)*SIZE(msgin,4) + IF (msglen>0) THEN + CALL mpi_isend(msgin(1,1,1,1),msglen,MPI_COMPLEX,dest,my_tag,& + comm,request,ierr) + ELSE + CALL mpi_isend(foo,msglen,MPI_COMPLEX,dest,my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_isend @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=11,count=1,time=t_end-t_start,msg_size=msglen*(2*real_4_size)) +#else + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + ierr=1 + request=0 + CALL mp_stop( ierr, "mp_isend called in non parallel case" ) +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_cm4 + ! ***************************************************************************** !> \brief Non-blocking receive of vector data !> \param msgout ... @@ -3356,6 +3418,67 @@ CALL mp_timestop(handle) END SUBROUTINE mp_irecv_cm3 +! ***************************************************************************** +!> \brief Non-blocking receive of rank-4 data +!> \param msgout the output message +!> \param source the source processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _cm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_cv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_irecv_cm4(msgout,source,comm,request,tag) + COMPLEX(kind=real_4), DIMENSION(:, :, :, :) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_cm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + COMPLEX(kind=real_4) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgout,1)*SIZE(msgout,2)*SIZE(msgout,3)*SIZE(msgout,4) + IF (msglen>0) THEN + CALL mpi_irecv(msgout(1,1,1,1),msglen,MPI_COMPLEX,source, my_tag,& + comm,request,ierr) + ELSE + CALL mpi_irecv(foo,msglen,MPI_COMPLEX,source, my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_ircv @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=12,count=1,time=t_end-t_start,msg_size=msglen*(2*real_4_size)) +#else + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request=0 + CPABORT("mp_irecv called in non parallel case") +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_cm4 + ! ***************************************************************************** !> \brief Window initialization function for vector data !> \param base ... diff --git a/src/mpiwrap/message_passing_d.f90 b/src/mpiwrap/message_passing_d.f90 index 648dcc2955..77f8dbdc03 100644 --- a/src/mpiwrap/message_passing_d.f90 +++ b/src/mpiwrap/message_passing_d.f90 @@ -3169,6 +3169,68 @@ CALL mp_timestop(handle) END SUBROUTINE mp_isend_dm3 +! ***************************************************************************** +!> \brief Non-blocking send of rank-4 data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _dm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_isend_dv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_isend_dm4(msgin,dest,comm,request,tag) + REAL(kind=real_8), DIMENSION(:, :, :, :) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_dm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + REAL(kind=real_8) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgin,1)*SIZE(msgin,2)*SIZE(msgin,3)*SIZE(msgin,4) + IF (msglen>0) THEN + CALL mpi_isend(msgin(1,1,1,1),msglen,MPI_DOUBLE_PRECISION,dest,my_tag,& + comm,request,ierr) + ELSE + CALL mpi_isend(foo,msglen,MPI_DOUBLE_PRECISION,dest,my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_isend @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=11,count=1,time=t_end-t_start,msg_size=msglen*real_8_size) +#else + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + ierr=1 + request=0 + CALL mp_stop( ierr, "mp_isend called in non parallel case" ) +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_dm4 + ! ***************************************************************************** !> \brief Non-blocking receive of vector data !> \param msgout ... @@ -3356,6 +3418,67 @@ CALL mp_timestop(handle) END SUBROUTINE mp_irecv_dm3 +! ***************************************************************************** +!> \brief Non-blocking receive of rank-4 data +!> \param msgout the output message +!> \param source the source processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _dm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_dv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_irecv_dm4(msgout,source,comm,request,tag) + REAL(kind=real_8), DIMENSION(:, :, :, :) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_dm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + REAL(kind=real_8) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgout,1)*SIZE(msgout,2)*SIZE(msgout,3)*SIZE(msgout,4) + IF (msglen>0) THEN + CALL mpi_irecv(msgout(1,1,1,1),msglen,MPI_DOUBLE_PRECISION,source, my_tag,& + comm,request,ierr) + ELSE + CALL mpi_irecv(foo,msglen,MPI_DOUBLE_PRECISION,source, my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_ircv @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=12,count=1,time=t_end-t_start,msg_size=msglen*real_8_size) +#else + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request=0 + CPABORT("mp_irecv called in non parallel case") +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_dm4 + ! ***************************************************************************** !> \brief Window initialization function for vector data !> \param base ... diff --git a/src/mpiwrap/message_passing_i.f90 b/src/mpiwrap/message_passing_i.f90 index 2e54b98f47..338612ce8b 100644 --- a/src/mpiwrap/message_passing_i.f90 +++ b/src/mpiwrap/message_passing_i.f90 @@ -3169,6 +3169,68 @@ CALL mp_timestop(handle) END SUBROUTINE mp_isend_im3 +! ***************************************************************************** +!> \brief Non-blocking send of rank-4 data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _im4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_isend_iv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_isend_im4(msgin,dest,comm,request,tag) + INTEGER(KIND=int_4), DIMENSION(:, :, :, :) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_im4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + INTEGER(KIND=int_4) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgin,1)*SIZE(msgin,2)*SIZE(msgin,3)*SIZE(msgin,4) + IF (msglen>0) THEN + CALL mpi_isend(msgin(1,1,1,1),msglen,MPI_INTEGER,dest,my_tag,& + comm,request,ierr) + ELSE + CALL mpi_isend(foo,msglen,MPI_INTEGER,dest,my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_isend @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=11,count=1,time=t_end-t_start,msg_size=msglen*int_4_size) +#else + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + ierr=1 + request=0 + CALL mp_stop( ierr, "mp_isend called in non parallel case" ) +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_im4 + ! ***************************************************************************** !> \brief Non-blocking receive of vector data !> \param msgout ... @@ -3356,6 +3418,67 @@ CALL mp_timestop(handle) END SUBROUTINE mp_irecv_im3 +! ***************************************************************************** +!> \brief Non-blocking receive of rank-4 data +!> \param msgout the output message +!> \param source the source processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _im4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_iv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_irecv_im4(msgout,source,comm,request,tag) + INTEGER(KIND=int_4), DIMENSION(:, :, :, :) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_im4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + INTEGER(KIND=int_4) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgout,1)*SIZE(msgout,2)*SIZE(msgout,3)*SIZE(msgout,4) + IF (msglen>0) THEN + CALL mpi_irecv(msgout(1,1,1,1),msglen,MPI_INTEGER,source, my_tag,& + comm,request,ierr) + ELSE + CALL mpi_irecv(foo,msglen,MPI_INTEGER,source, my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_ircv @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=12,count=1,time=t_end-t_start,msg_size=msglen*int_4_size) +#else + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request=0 + CPABORT("mp_irecv called in non parallel case") +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_im4 + ! ***************************************************************************** !> \brief Window initialization function for vector data !> \param base ... diff --git a/src/mpiwrap/message_passing_l.f90 b/src/mpiwrap/message_passing_l.f90 index a81932caee..2cd7e38a35 100644 --- a/src/mpiwrap/message_passing_l.f90 +++ b/src/mpiwrap/message_passing_l.f90 @@ -3169,6 +3169,68 @@ CALL mp_timestop(handle) END SUBROUTINE mp_isend_lm3 +! ***************************************************************************** +!> \brief Non-blocking send of rank-4 data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _lm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_isend_lv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_isend_lm4(msgin,dest,comm,request,tag) + INTEGER(KIND=int_8), DIMENSION(:, :, :, :) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_lm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + INTEGER(KIND=int_8) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgin,1)*SIZE(msgin,2)*SIZE(msgin,3)*SIZE(msgin,4) + IF (msglen>0) THEN + CALL mpi_isend(msgin(1,1,1,1),msglen,MPI_INTEGER8,dest,my_tag,& + comm,request,ierr) + ELSE + CALL mpi_isend(foo,msglen,MPI_INTEGER8,dest,my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_isend @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=11,count=1,time=t_end-t_start,msg_size=msglen*int_8_size) +#else + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + ierr=1 + request=0 + CALL mp_stop( ierr, "mp_isend called in non parallel case" ) +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_lm4 + ! ***************************************************************************** !> \brief Non-blocking receive of vector data !> \param msgout ... @@ -3356,6 +3418,67 @@ CALL mp_timestop(handle) END SUBROUTINE mp_irecv_lm3 +! ***************************************************************************** +!> \brief Non-blocking receive of rank-4 data +!> \param msgout the output message +!> \param source the source processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _lm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_lv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_irecv_lm4(msgout,source,comm,request,tag) + INTEGER(KIND=int_8), DIMENSION(:, :, :, :) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_lm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + INTEGER(KIND=int_8) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgout,1)*SIZE(msgout,2)*SIZE(msgout,3)*SIZE(msgout,4) + IF (msglen>0) THEN + CALL mpi_irecv(msgout(1,1,1,1),msglen,MPI_INTEGER8,source, my_tag,& + comm,request,ierr) + ELSE + CALL mpi_irecv(foo,msglen,MPI_INTEGER8,source, my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_ircv @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=12,count=1,time=t_end-t_start,msg_size=msglen*int_8_size) +#else + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request=0 + CPABORT("mp_irecv called in non parallel case") +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_lm4 + ! ***************************************************************************** !> \brief Window initialization function for vector data !> \param base ... diff --git a/src/mpiwrap/message_passing_r.f90 b/src/mpiwrap/message_passing_r.f90 index 3368bbe535..acb0e4b973 100644 --- a/src/mpiwrap/message_passing_r.f90 +++ b/src/mpiwrap/message_passing_r.f90 @@ -3169,6 +3169,68 @@ CALL mp_timestop(handle) END SUBROUTINE mp_isend_rm3 +! ***************************************************************************** +!> \brief Non-blocking send of rank-4 data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _rm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_isend_rv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_isend_rm4(msgin,dest,comm,request,tag) + REAL(kind=real_4), DIMENSION(:, :, :, :) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_rm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + REAL(kind=real_4) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgin,1)*SIZE(msgin,2)*SIZE(msgin,3)*SIZE(msgin,4) + IF (msglen>0) THEN + CALL mpi_isend(msgin(1,1,1,1),msglen,MPI_REAL,dest,my_tag,& + comm,request,ierr) + ELSE + CALL mpi_isend(foo,msglen,MPI_REAL,dest,my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_isend @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=11,count=1,time=t_end-t_start,msg_size=msglen*real_4_size) +#else + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + ierr=1 + request=0 + CALL mp_stop( ierr, "mp_isend called in non parallel case" ) +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_rm4 + ! ***************************************************************************** !> \brief Non-blocking receive of vector data !> \param msgout ... @@ -3356,6 +3418,67 @@ CALL mp_timestop(handle) END SUBROUTINE mp_irecv_rm3 +! ***************************************************************************** +!> \brief Non-blocking receive of rank-4 data +!> \param msgout the output message +!> \param source the source processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _rm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_rv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_irecv_rm4(msgout,source,comm,request,tag) + REAL(kind=real_4), DIMENSION(:, :, :, :) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_rm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + REAL(kind=real_4) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgout,1)*SIZE(msgout,2)*SIZE(msgout,3)*SIZE(msgout,4) + IF (msglen>0) THEN + CALL mpi_irecv(msgout(1,1,1,1),msglen,MPI_REAL,source, my_tag,& + comm,request,ierr) + ELSE + CALL mpi_irecv(foo,msglen,MPI_REAL,source, my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_ircv @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=12,count=1,time=t_end-t_start,msg_size=msglen*real_4_size) +#else + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request=0 + CPABORT("mp_irecv called in non parallel case") +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_rm4 + ! ***************************************************************************** !> \brief Window initialization function for vector data !> \param base ... diff --git a/src/mpiwrap/message_passing_z.f90 b/src/mpiwrap/message_passing_z.f90 index ab1de9a9d3..facba60010 100644 --- a/src/mpiwrap/message_passing_z.f90 +++ b/src/mpiwrap/message_passing_z.f90 @@ -3169,6 +3169,68 @@ CALL mp_timestop(handle) END SUBROUTINE mp_isend_zm3 +! ***************************************************************************** +!> \brief Non-blocking send of rank-4 data +!> \param msgin the input message +!> \param dest the destination processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _zm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_isend_zv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_isend_zm4(msgin,dest,comm,request,tag) + COMPLEX(kind=real_8), DIMENSION(:, :, :, :) :: msgin + INTEGER, INTENT(IN) :: dest, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_isend_zm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + COMPLEX(kind=real_8) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgin,1)*SIZE(msgin,2)*SIZE(msgin,3)*SIZE(msgin,4) + IF (msglen>0) THEN + CALL mpi_isend(msgin(1,1,1,1),msglen,MPI_DOUBLE_COMPLEX,dest,my_tag,& + comm,request,ierr) + ELSE + CALL mpi_isend(foo,msglen,MPI_DOUBLE_COMPLEX,dest,my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_isend @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=11,count=1,time=t_end-t_start,msg_size=msglen*(2*real_8_size)) +#else + MARK_USED(msgin) + MARK_USED(dest) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + ierr=1 + request=0 + CALL mp_stop( ierr, "mp_isend called in non parallel case" ) +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_isend_zm4 + ! ***************************************************************************** !> \brief Non-blocking receive of vector data !> \param msgout ... @@ -3356,6 +3418,67 @@ CALL mp_timestop(handle) END SUBROUTINE mp_irecv_zm3 +! ***************************************************************************** +!> \brief Non-blocking receive of rank-4 data +!> \param msgout the output message +!> \param source the source processor +!> \param comm the communicator object +!> \param request the communication request id +!> \param tag the message tag +!> \par History +!> 2.2016 added _zm4 subroutine [Nico Holmberg] +!> \author fawzi +!> \note see mp_irecv_zv +!> \note +!> arrays can be pointers or assumed shape, but they must be contiguous! +! ***************************************************************************** + SUBROUTINE mp_irecv_zm4(msgout,source,comm,request,tag) + COMPLEX(kind=real_8), DIMENSION(:, :, :, :) :: msgout + INTEGER, INTENT(IN) :: source, comm + INTEGER, INTENT(out) :: request + INTEGER, INTENT(in), OPTIONAL :: tag + + CHARACTER(len=*), PARAMETER :: routineN = 'mp_irecv_zm4', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ierr +#if defined(__parallel) + INTEGER :: msglen, my_tag + COMPLEX(kind=real_8) :: foo(1) +#endif + + ierr = 0 + CALL mp_timeset(routineN,handle) + +#if defined(__parallel) + t_start = m_walltime ( ) + my_tag = 0 + IF (PRESENT(tag)) my_tag=tag + + msglen = SIZE(msgout,1)*SIZE(msgout,2)*SIZE(msgout,3)*SIZE(msgout,4) + IF (msglen>0) THEN + CALL mpi_irecv(msgout(1,1,1,1),msglen,MPI_DOUBLE_COMPLEX,source, my_tag,& + comm,request,ierr) + ELSE + CALL mpi_irecv(foo,msglen,MPI_DOUBLE_COMPLEX,source, my_tag,& + comm,request,ierr) + END IF + IF ( ierr /= 0 ) CALL mp_stop( ierr, "mpi_ircv @ "//routineN ) + + t_end = m_walltime ( ) + CALL add_perf(perf_id=12,count=1,time=t_end-t_start,msg_size=msglen*(2*real_8_size)) +#else + MARK_USED(msgout) + MARK_USED(source) + MARK_USED(comm) + MARK_USED(request) + MARK_USED(tag) + request=0 + CPABORT("mp_irecv called in non parallel case") +#endif + CALL mp_timestop(handle) + END SUBROUTINE mp_irecv_zm4 + ! ***************************************************************************** !> \brief Window initialization function for vector data !> \param base ... diff --git a/src/pw/pw_methods.F b/src/pw/pw_methods.F index 3c0fec5ba1..11beb9684c 100644 --- a/src/pw/pw_methods.F +++ b/src/pw/pw_methods.F @@ -61,6 +61,7 @@ MODULE pw_methods PUBLIC :: pw_derive, pw_dr2, pw_write PUBLIC :: pw_integral_ab, pw_integral_a2b PUBLIC :: pw_dr2_gg, pw_integrate_function + PUBLIC :: pw_set CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_methods' LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE. @@ -1953,5 +1954,51 @@ CONTAINS END FUNCTION pw_integrate_function +! ************************************************************************************************** +!> \brief Initialize pw values using values from a real array data, which might be defined on a +!> smaller grid than pw but which is contained in it +!> \param pw the pw to initialize +!> \param values the array holding the input data +!> \par History +!> Created 12.2016 +!> \author Nico Holmberg +! ************************************************************************************************** + SUBROUTINE pw_set(pw, values) + + TYPE(pw_type), INTENT(INOUT) :: pw + REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN), & + POINTER :: values + + CHARACTER(len=*), PARAMETER :: routineN = 'pw_set', routineP = moduleN//':'//routineN + + INTEGER :: handle, i, j, k + LOGICAL :: is_match + + CALL timeset(routineN, handle) + CPASSERT(pw%ref_count > 0) + IF (pw%in_use == REALDATA3D) THEN + is_match = .TRUE. + is_match = is_match .AND. (LBOUND(values, 1) .GE. LBOUND(pw%cr3d, 1)) + is_match = is_match .AND. (UBOUND(values, 1) .LE. UBOUND(pw%cr3d, 1)) + is_match = is_match .AND. (LBOUND(values, 2) .GE. LBOUND(pw%cr3d, 2)) + is_match = is_match .AND. (UBOUND(values, 2) .LE. UBOUND(pw%cr3d, 2)) + is_match = is_match .AND. (LBOUND(values, 3) .GE. LBOUND(pw%cr3d, 3)) + is_match = is_match .AND. (UBOUND(values, 3) .LE. UBOUND(pw%cr3d, 3)) + IF (.NOT. is_match) & + CPABORT("Incompatible data fields") + DO i = LBOUND(values, 3), UBOUND(values, 3) + DO j = LBOUND(values, 2), UBOUND(values, 2) + DO k = LBOUND(values, 1), UBOUND(values, 1) + pw%cr3d(k, j, i) = values(k, j, i) + END DO + END DO + END DO + ELSE + CPABORT("Illegal pw type, should be REALDATA3D.") + END IF + CALL timestop(handle) + + END SUBROUTINE pw_set + END MODULE pw_methods diff --git a/src/qs_energy_init.F b/src/qs_energy_init.F index facd7531bb..bdc963653f 100644 --- a/src/qs_energy_init.F +++ b/src/qs_energy_init.F @@ -19,7 +19,8 @@ MODULE qs_energy_init dbcsr_type USE efield_utils, ONLY: calculate_ecore_efield USE input_constants, ONLY: kg_tnadd_atomic,& - kg_tnadd_embed + kg_tnadd_embed,& + outer_scf_hirshfeld_constraint USE input_section_types, ONLY: section_vals_type USE kg_environment, ONLY: kg_build_neighborlist,& kg_build_subsets @@ -251,7 +252,12 @@ CONTAINS CALL kpoint_init_cell_index(kpoints, sab_nl, para_env, dft_control) ENDIF - dft_control%qs_control%becke_control%need_pot = .TRUE. + IF (.NOT. dft_control%qs_control%becke_control%external_control) & + dft_control%qs_control%becke_control%need_pot = .TRUE. + IF (dft_control%qs_control%cdft) THEN + IF (dft_control%qs_control%cdft_control%type == outer_scf_hirshfeld_constraint) & + dft_control%qs_control%cdft_control%need_pot = .TRUE. + END IF ! Calculate the overlap and the core Hamiltonian integral matrix IF (dft_control%qs_control%semi_empirical) THEN diff --git a/src/qs_energy_types.F b/src/qs_energy_types.F index 419ec428d7..6de9ee6052 100644 --- a/src/qs_energy_types.F +++ b/src/qs_energy_types.F @@ -43,6 +43,7 @@ MODULE qs_energy_types qmmm_nu, & mulliken, & becke, & + cdft, & ee, & ee_core, & efield, & @@ -172,6 +173,7 @@ CONTAINS qs_energy%image_charge = 0.0_dp qs_energy%mulliken = 0.0_dp qs_energy%becke = 0.0_dp + qs_energy%cdft = 0.0_dp qs_energy%efield = 0.0_dp qs_energy%efield_core = 0.0_dp qs_energy%ee = 0.0_dp diff --git a/src/qs_environment_types.F b/src/qs_environment_types.F index 0de10e07d7..6eb3f408f3 100644 --- a/src/qs_environment_types.F +++ b/src/qs_environment_types.F @@ -58,6 +58,8 @@ MODULE qs_environment_types set_hartree_local USE hfx_types, ONLY: hfx_release,& hfx_type + USE input_constants, ONLY: energy_force_run,& + energy_run USE input_section_types, ONLY: section_vals_release,& section_vals_retain,& section_vals_type @@ -219,6 +221,7 @@ MODULE qs_environment_types LOGICAL :: linres_run LOGICAL :: calc_image_preconditioner LOGICAL :: do_transport + LOGICAL :: single_point_run REAL(KIND=dp) :: sim_time REAL(KIND=dp) :: start_time, target_time REAL(KIND=dp), DIMENSION(:, :), POINTER :: image_matrix @@ -871,6 +874,7 @@ CONTAINS qs_env%id_nr = last_qs_env_id_nr qs_env%run_rtp = .FALSE. qs_env%linres_run = .FALSE. + qs_env%single_point_run = .FALSE. qs_env%qmmm = .FALSE. qs_env%qmmm_periodic = .FALSE. qs_env%requires_mo_derivs = .FALSE. @@ -881,6 +885,8 @@ CONTAINS IF (PRESENT(globenv)) THEN qs_env%target_time = globenv%cp2k_target_time qs_env%start_time = globenv%cp2k_start_time + qs_env%single_point_run = (globenv%run_type_id == energy_run .OR. & + globenv%run_type_id == energy_force_run) ELSE qs_env%target_time = 0.0_dp qs_env%start_time = 0.0_dp diff --git a/src/qs_force.F b/src/qs_force.F index 1c981b7a73..c91b767b07 100644 --- a/src/qs_force.F +++ b/src/qs_force.F @@ -31,7 +31,8 @@ MODULE qs_force dbcsr_set USE dft_plus_u, ONLY: plus_u USE efield_utils, ONLY: calculate_ecore_efield - USE input_constants, ONLY: do_admm_purify_none + USE input_constants, ONLY: do_admm_purify_none,& + outer_scf_hirshfeld_constraint USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type,& section_vals_val_get @@ -179,10 +180,11 @@ CONTAINS atom_of_kind=atom_of_kind, & kind_of=kind_of) - NULLIFY (force, subsys) + NULLIFY (force, subsys, dft_control) CALL get_qs_env(qs_env, & force=force, & - subsys=subsys) + subsys=subsys, & + dft_control=dft_control) IF (.NOT. ASSOCIATED(force)) THEN ! *** Allocate the force data structure *** nkind = SIZE(atomic_kind_set) @@ -195,15 +197,23 @@ CONTAINS END IF CALL zero_qs_force(force) + ! Check if Becke potential is needed and save it until forces have been calculated + IF (dft_control%qs_control%becke_restraint) & + dft_control%qs_control%becke_control%save_pot = .TRUE. + + IF (dft_control%qs_control%cdft) THEN + IF (dft_control%qs_control%cdft_control%type == outer_scf_hirshfeld_constraint) & + dft_control%qs_control%cdft_control%save_pot = .TRUE. + END IF + ! Set parameter for P screening with MP2 IF (ASSOCIATED(qs_env%mp2_env)) qs_env%mp2_env%not_last_hfx = .TRUE. ! recalculate energy with forces CALL qs_energies(qs_env, calc_forces=.TRUE.) - NULLIFY (dft_control, para_env) + NULLIFY (para_env) CALL get_qs_env(qs_env, & - dft_control=dft_control, & para_env=para_env) ! Now we handle some special cases diff --git a/src/qs_ks_apply_restraints.F b/src/qs_ks_apply_restraints.F index f240ff6e6e..7e4781866d 100644 --- a/src/qs_ks_apply_restraints.F +++ b/src/qs_ks_apply_restraints.F @@ -8,6 +8,7 @@ ! ************************************************************************************************** MODULE qs_ks_apply_restraints USE cp_control_types, ONLY: becke_restraint_type,& + cdft_control_type,& dft_control_type USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,& copy_fm_to_dbcsr @@ -18,7 +19,14 @@ MODULE qs_ks_apply_restraints USE dbcsr_api, ONLY: dbcsr_copy,& dbcsr_p_type,& dbcsr_set - USE et_coupling, ONLY: becke_restraint + USE et_coupling, ONLY: becke_restraint,& + hirshfeld_constraint + USE input_constants, ONLY: cdft_combined_acceptor,& + cdft_combined_all,& + cdft_combined_constraint,& + cdft_combined_donor,& + outer_scf_becke_constraint,& + outer_scf_hirshfeld_constraint USE kinds, ONLY: dp USE mulliken, ONLY: mulliken_restraint USE pw_methods, ONLY: pw_scale @@ -45,16 +53,17 @@ MODULE qs_ks_apply_restraints CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_ks_apply_restraints' PUBLIC :: qs_ks_becke_restraint, qs_ks_mulliken_restraint, qs_ks_s2_restraint + PUBLIC :: qs_ks_cdft_constraint CONTAINS ! ************************************************************************************************** -!> \brief ... -!> \param qs_env ... -!> \param auxbas_pw_pool ... -!> \param calculate_forces ... -!> \param matrix_s ... -!> \param becke ... +!> \brief Apply a Becke constraint +!> \param qs_env the qs_env where to apply the constraint +!> \param auxbas_pw_pool the pool that owns the real space grid where the Becke potential is defined +!> \param calculate_forces if forces should be calculated +!> \param matrix_s the overlap matrix +!> \param becke the Becke control type ! ************************************************************************************************** SUBROUTINE qs_ks_becke_restraint(qs_env, auxbas_pw_pool, calculate_forces, matrix_s, becke) TYPE(qs_environment_type), POINTER :: qs_env @@ -66,6 +75,7 @@ CONTAINS CHARACTER(LEN=*), PARAMETER :: routineN = 'qs_ks_becke_restraint', & routineP = moduleN//':'//routineN + INTEGER :: iatom REAL(KIND=dp) :: inv_vol TYPE(dft_control_type), POINTER :: dft_control @@ -77,22 +87,56 @@ CONTAINS CPASSERT(SIZE(matrix_s, 2) == 1) !***** Check if becke potential is needed to constrain charges ***** becke => dft_control%qs_control%becke_control - IF (becke%need_pot .OR. calculate_forces) THEN - CALL pw_pool_create_pw(auxbas_pw_pool, becke%becke_pot%pw, use_data=REALDATA3D, & - in_space=REALSPACE) - CALL becke_restraint(qs_env, becke_const=becke%becke_pot, calc_pot=.TRUE., & - calculate_forces=calculate_forces) + IF (becke%need_pot) THEN + CALL pw_pool_create_pw(auxbas_pw_pool, becke%becke_pot%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + IF (becke%atomic_charges) THEN + DO iatom = 1, becke%natoms + CALL pw_pool_create_pw(auxbas_pw_pool, becke%charge(iatom)%pw, & + use_data=REALDATA3D, in_space=REALSPACE) + END DO + END IF + CALL becke_restraint(qs_env, becke_const=becke%becke_pot, charge=becke%charge, & + calc_pot=.TRUE., calculate_forces=calculate_forces) CALL pw_scale(becke%becke_pot%pw, becke%becke_pot%pw%pw_grid%dvol) + IF (dft_control%qs_control%becke_control%constraint_type == cdft_combined_constraint) THEN + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ! Do nothing + CASE (cdft_combined_acceptor, cdft_combined_donor) + CALL pw_scale(becke%combined_weight%pw, becke%becke_pot%pw%pw_grid%dvol) + END SELECT + END IF becke%need_pot = .FALSE. ELSE inv_vol = 1.0_dp/becke%becke_pot%pw%pw_grid%dvol CALL pw_scale(becke%becke_pot%pw, inv_vol) - CALL becke_restraint(qs_env, becke%becke_pot, calc_pot=.FALSE., & + IF (dft_control%qs_control%becke_control%constraint_type == cdft_combined_constraint) THEN + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ! Do nothing + CASE (cdft_combined_acceptor, cdft_combined_donor) + IF (.NOT. ASSOCIATED(becke%combined_mat)) & + CALL pw_scale(becke%combined_weight%pw, inv_vol) + END SELECT + END IF + CALL becke_restraint(qs_env, becke%becke_pot, charge=becke%charge, calc_pot=.FALSE., & calculate_forces=calculate_forces) CALL pw_scale(becke%becke_pot%pw, becke%becke_pot%pw%pw_grid%dvol) - ENDIF + IF (dft_control%qs_control%becke_control%constraint_type == cdft_combined_constraint) THEN + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ! Do nothing + CASE (cdft_combined_acceptor, cdft_combined_donor) + CALL pw_scale(becke%combined_weight%pw, becke%becke_pot%pw%pw_grid%dvol) + END SELECT + END IF + END IF IF (dft_control%qs_control%et_coupling_calc) THEN + ! Combined constraint not allowed + IF (becke%constraint_type == cdft_combined_constraint) & + CPABORT("Use MIXED_CDFT for ET coupling calculation with combined constraint.") IF (qs_env%et_coupling%keep_matrix) THEN IF (qs_env%et_coupling%first_run) THEN NULLIFY (qs_env%et_coupling%rest_mat(1)%matrix) @@ -103,8 +147,8 @@ CONTAINS CALL integrate_v_rspace(becke%becke_pot, & hmat=qs_env%et_coupling%rest_mat(1), & qs_env=qs_env, calculate_forces=.FALSE.) - qs_env%et_coupling%order_p = dft_control%qs_control%becke_control%becke_order_p - qs_env%et_coupling%e1 = dft_control%qs_control%becke_control%strength + qs_env%et_coupling%order_p = dft_control%qs_control%becke_control%becke_order_p(1) + qs_env%et_coupling%e1 = dft_control%qs_control%becke_control%strength(1) qs_env%et_coupling%keep_matrix = .FALSE. ELSE NULLIFY (qs_env%et_coupling%rest_mat(2)%matrix) @@ -122,6 +166,52 @@ CONTAINS END IF END SUBROUTINE qs_ks_becke_restraint +! ************************************************************************************************** +!> \brief Apply a CDFT constraint +!> \param qs_env the qs_env where to apply the constraint +!> \param auxbas_pw_pool the pool that owns the real space grid where the CDFT potential is defined +!> \param calculate_forces if forces should be calculated +!> \param cdft_control the CDFT control type +! ************************************************************************************************** + SUBROUTINE qs_ks_cdft_constraint(qs_env, auxbas_pw_pool, calculate_forces, cdft_control) + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool + LOGICAL, INTENT(in) :: calculate_forces + TYPE(cdft_control_type), POINTER :: cdft_control + + CHARACTER(LEN=*), PARAMETER :: routineN = 'qs_ks_cdft_constraint', & + routineP = moduleN//':'//routineN + + REAL(KIND=dp) :: inv_vol + TYPE(dft_control_type), POINTER :: dft_control + + NULLIFY (dft_control) + CALL get_qs_env(qs_env, dft_control=dft_control) + IF (dft_control%qs_control%cdft) THEN + cdft_control => dft_control%qs_control%cdft_control + SELECT CASE (cdft_control%type) + CASE (outer_scf_hirshfeld_constraint) + IF (cdft_control%need_pot) THEN + CALL pw_pool_create_pw(auxbas_pw_pool, cdft_control%weight%pw, use_data=REALDATA3D, & + in_space=REALSPACE) + CALL hirshfeld_constraint(qs_env, cdft_control, calc_pot=.TRUE., & + calculate_forces=calculate_forces) + CALL pw_scale(cdft_control%weight%pw, cdft_control%weight%pw%pw_grid%dvol) + cdft_control%need_pot = .FALSE. + ELSE + inv_vol = 1.0_dp/cdft_control%weight%pw%pw_grid%dvol + CALL pw_scale(cdft_control%weight%pw, inv_vol) + CALL hirshfeld_constraint(qs_env, cdft_control, calc_pot=.FALSE., & + calculate_forces=calculate_forces) + CALL pw_scale(cdft_control%weight%pw, cdft_control%weight%pw%pw_grid%dvol) + END IF + CASE (outer_scf_becke_constraint) + ! Do nothing, yet. Case handled by separate call to qs_ks_becke_restraint + END SELECT + END IF + + END SUBROUTINE qs_ks_cdft_constraint + ! ************************************************************************************************** !> \brief ... !> \param energy ... diff --git a/src/qs_ks_methods.F b/src/qs_ks_methods.F index 1efc80721e..d601b2b813 100644 --- a/src/qs_ks_methods.F +++ b/src/qs_ks_methods.F @@ -28,6 +28,7 @@ MODULE qs_ks_methods USE cell_types, ONLY: cell_type USE cp_blacs_env, ONLY: cp_blacs_env_type USE cp_control_types, ONLY: becke_restraint_type,& + cdft_control_type,& dft_control_type USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,& @@ -66,7 +67,12 @@ MODULE qs_ks_methods USE hartree_local_methods, ONLY: Vh_1c_gg_integrals USE hfx_admm_utils, ONLY: hfx_admm_init,& hfx_ks_matrix - USE input_constants, ONLY: do_ppl_grid + USE input_constants, ONLY: cdft_combined_acceptor,& + cdft_combined_all,& + cdft_combined_constraint,& + cdft_combined_donor,& + do_ppl_grid,& + outer_scf_hirshfeld_constraint USE input_section_types, ONLY: section_vals_get,& section_vals_get_subs_vals,& section_vals_type,& @@ -120,6 +126,7 @@ MODULE qs_ks_methods integrate_v_core_rspace,& integrate_v_rspace_one_center USE qs_ks_apply_restraints, ONLY: qs_ks_becke_restraint,& + qs_ks_cdft_constraint,& qs_ks_mulliken_restraint,& qs_ks_s2_restraint USE qs_ks_atom, ONLY: update_ks_atom @@ -216,7 +223,8 @@ CONTAINS routineP = moduleN//':'//routineN CHARACTER(len=default_string_length) :: name - INTEGER :: handle, img, ispin, nimages, ns, nspins + INTEGER :: handle, iatom, img, ispin, nimages, ns, & + nspins LOGICAL :: do_adiabatic_rescaling, do_ddapc, do_hfx, do_ppl, gapw, gapw_xc, & hfx_treat_lsd_in_core, just_energy_xc, my_print, use_virial REAL(KIND=dp) :: ecore_ppl, edisp, ee_ener, ekin_mol, & @@ -224,6 +232,7 @@ CONTAINS REAL(KIND=dp), DIMENSION(3, 3) :: h_stress TYPE(admm_type), POINTER :: admm_env TYPE(becke_restraint_type), POINTER :: becke + TYPE(cdft_control_type), POINTER :: cdft_control TYPE(cell_type), POINTER :: cell TYPE(cp_logger_type), POINTER :: logger TYPE(cp_para_env_type), POINTER :: para_env @@ -458,6 +467,9 @@ CONTAINS ! Check if becke potential is needed to constrain charges CALL qs_ks_becke_restraint(qs_env, auxbas_pw_pool, calculate_forces, matrix_s, becke) + ! Check if CDFT constraint is needed + CALL qs_ks_cdft_constraint(qs_env, auxbas_pw_pool, calculate_forces, cdft_control) + ! Adds the External Potential if requested IF (dft_control%apply_external_potential) THEN ! Compute the energy due to the external potential @@ -653,7 +665,7 @@ CONTAINS CALL sum_up_and_integrate(qs_env, ks_matrix, rho, my_rho, vppl_rspace, & v_rspace_new, v_rspace_new_aux_fit, v_tau_rspace, v_tau_rspace_aux_fit, & v_efield_rspace, v_sic_rspace, v_spin_ddapc_rest_r, v_sccs_rspace, becke, & - calculate_forces) + cdft_control, calculate_forces) IF (dft_control%qs_control%do_kg) THEN CPASSERT(nimages == 1) @@ -676,6 +688,41 @@ CONTAINS IF (calculate_forces .AND. dft_control%qs_control%becke_restraint) THEN CALL pw_pool_give_back_pw(auxbas_pw_pool, becke%becke_pot%pw) + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + DO iatom = 1, dft_control%qs_control%becke_control%natoms + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%charge(iatom)%pw) + END DO + END IF + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + IF (.NOT. ASSOCIATED(becke%cavity_mat)) THEN + CALL pw_pool_give_back_pw(auxbas_pw_pool, becke%cavity%pw) + ELSE + DEALLOCATE (becke%cavity_mat) + END IF + END IF + IF (ASSOCIATED(dft_control%qs_control%becke_control%charges_fragment)) & + DEALLOCATE (dft_control%qs_control%becke_control%charges_fragment) + IF (dft_control%qs_control%becke_control%constraint_type == cdft_combined_constraint) THEN + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ! Do nothing + CASE (cdft_combined_acceptor, cdft_combined_donor) + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%combined_weight%pw) + END SELECT + END IF + dft_control%qs_control%becke_control%save_pot = .FALSE. + dft_control%qs_control%becke_control%need_pot = .TRUE. + dft_control%qs_control%becke_control%external_control = .FALSE. + END IF + + IF (calculate_forces .AND. dft_control%qs_control%cdft) THEN + IF (cdft_control%type == outer_scf_hirshfeld_constraint) THEN + CALL pw_pool_give_back_pw(auxbas_pw_pool, cdft_control%weight%pw) + cdft_control%save_pot = .FALSE. + cdft_control%need_pot = .TRUE. + END IF END IF IF (dft_control%do_sccs) THEN @@ -780,7 +827,7 @@ CONTAINS energy%becke+energy%dft_plus_u+energy%kTS+ & energy%efield+energy%efield_core+energy%ee+ & energy%ee_core+energy%exc_aux_fit+energy%image_charge+ & - energy%sccs_pol+energy%sccs_mpc + energy%sccs_pol+energy%sccs_mpc+energy%cdft IF (abnormal_value(energy%total)) & CPABORT("KS energy is an abnormal value (NaN/Inf).") diff --git a/src/qs_ks_utils.F b/src/qs_ks_utils.F index 9d405e1896..8850c3ac79 100644 --- a/src/qs_ks_utils.F +++ b/src/qs_ks_utils.F @@ -20,6 +20,7 @@ MODULE qs_ks_utils USE cell_types, ONLY: cell_type USE cp_control_types, ONLY: becke_restraint_type,& + cdft_control_type,& dft_control_type USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,& copy_fm_to_dbcsr,& @@ -47,14 +48,10 @@ MODULE qs_ks_utils dbcsr_add, dbcsr_allocate_matrix_set, dbcsr_copy, dbcsr_deallocate_matrix, & dbcsr_deallocate_matrix_set, dbcsr_get_info, dbcsr_init_p, dbcsr_multiply, dbcsr_p_type, & dbcsr_release_p, dbcsr_scale, dbcsr_scale_by_vector, dbcsr_set, dbcsr_trace, dbcsr_type - USE input_constants, ONLY: do_ppl_grid,& - sic_ad,& - sic_eo,& - sic_list_all,& - sic_list_unpaired,& - sic_mauri_spz,& - sic_mauri_us,& - sic_none + USE input_constants, ONLY: & + cdft_combined_acceptor, cdft_combined_all, cdft_combined_donor, & + cdft_magnetization_constraint, do_ppl_grid, outer_scf_hirshfeld_constraint, sic_ad, & + sic_eo, sic_list_all, sic_list_unpaired, sic_mauri_spz, sic_mauri_us, sic_none USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type,& section_vals_val_get @@ -1165,6 +1162,7 @@ CONTAINS !> \param v_spin_ddapc_rest_r ... !> \param v_sccs_rspace ... !> \param becke ... +!> \param cdft_control ... !> \param calculate_forces ... !> \par History !> - refactoring 04.03.2011 [MI] @@ -1176,7 +1174,8 @@ CONTAINS v_rspace_new_aux_fit, v_tau_rspace, & v_tau_rspace_aux_fit, v_efield_rspace, & v_sic_rspace, v_spin_ddapc_rest_r, & - v_sccs_rspace, becke, calculate_forces) + v_sccs_rspace, becke, cdft_control, & + calculate_forces) TYPE(qs_environment_type), POINTER :: qs_env TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix @@ -1188,14 +1187,15 @@ CONTAINS TYPE(pw_p_type) :: v_efield_rspace, v_sic_rspace, & v_spin_ddapc_rest_r, v_sccs_rspace TYPE(becke_restraint_type), POINTER :: becke + TYPE(cdft_control_type), POINTER :: cdft_control LOGICAL, INTENT(in) :: calculate_forces CHARACTER(LEN=*), PARAMETER :: routineN = 'sum_up_and_integrate', & routineP = moduleN//':'//routineN - INTEGER :: handle, ispin, nspins + INTEGER :: handle, ispin, ivar, nspins, nvar LOGICAL :: do_ppl, gapw, gapw_xc - REAL(dp) :: dvol + REAL(dp) :: dvol, sign TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ksmat, matrix_ks_aux_fit, & matrix_ks_aux_fit_dft, rho_ao, & rho_ao_aux @@ -1275,8 +1275,32 @@ CONTAINS END IF END IF IF (dft_control%qs_control%becke_restraint) THEN - v_rspace_new(ispin)%pw%cr3d = v_rspace_new(ispin)%pw%cr3d & - +becke%becke_pot%pw%cr3d*dft_control%qs_control%becke_control%strength + nvar = SIZE(becke%strength) + DO ivar = 1, nvar + IF (ivar == 2) THEN + sign = 1.0_dp + IF (ispin == 2) sign = -1.0_dp + SELECT CASE (becke%combined_type) + CASE (cdft_combined_all) + v_rspace_new(ispin)%pw%cr3d = v_rspace_new(ispin)%pw%cr3d & + +sign*becke%becke_pot%pw%cr3d*becke%strength(ivar) + CASE (cdft_combined_acceptor, cdft_combined_donor) + v_rspace_new(ispin)%pw%cr3d = v_rspace_new(ispin)%pw%cr3d & + +sign*becke%combined_weight%pw%cr3d*becke%strength(ivar) + END SELECT + ELSE + sign = 1.0_dp + IF (ispin == 2 .AND. becke%constraint_type == cdft_magnetization_constraint) & + sign = -1.0_dp + v_rspace_new(ispin)%pw%cr3d = v_rspace_new(ispin)%pw%cr3d & + +sign*becke%becke_pot%pw%cr3d*becke%strength(ivar) + END IF + END DO + END IF + IF (dft_control%qs_control%cdft) THEN + IF (cdft_control%type == outer_scf_hirshfeld_constraint) & + v_rspace_new(ispin)%pw%cr3d = v_rspace_new(ispin)%pw%cr3d & + +cdft_control%weight%pw%cr3d*cdft_control%strength(1) END IF ! The efield contribution IF (dft_control%apply_efield_field) THEN diff --git a/src/qs_mo_io.F b/src/qs_mo_io.F index 274e186eeb..79f98e5bc8 100644 --- a/src/qs_mo_io.F +++ b/src/qs_mo_io.F @@ -494,9 +494,11 @@ CONTAINS !> \param multiplicity ... !> \param dft_section ... !> \param natom_mismatch ... +!> \param cdft ... ! ************************************************************************************************** SUBROUTINE read_mo_set_from_restart(mo_array, atomic_kind_set, qs_kind_set, particle_set, & - para_env, id_nr, multiplicity, dft_section, natom_mismatch) + para_env, id_nr, multiplicity, dft_section, natom_mismatch, & + cdft) TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mo_array TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set @@ -506,6 +508,7 @@ CONTAINS INTEGER, INTENT(IN) :: id_nr, multiplicity TYPE(section_vals_type), POINTER :: dft_section LOGICAL, INTENT(OUT), OPTIONAL :: natom_mismatch + LOGICAL, INTENT(IN), OPTIONAL :: cdft CHARACTER(LEN=*), PARAMETER :: routineN = 'read_mo_set_from_restart', & routineP = moduleN//':'//routineN @@ -513,11 +516,13 @@ CONTAINS CHARACTER(LEN=default_path_length) :: file_name INTEGER :: group, handle, ispin, natom, nspin, & restart_unit, source - LOGICAL :: exist + LOGICAL :: exist, my_cdft TYPE(cp_logger_type), POINTER :: logger CALL timeset(routineN, handle) logger => cp_get_default_logger() + my_cdft = .FALSE. + IF (PRESENT(cdft)) my_cdft = cdft nspin = SIZE(mo_array) restart_unit = -1 @@ -558,10 +563,13 @@ CONTAINS ! Close restart file IF (para_env%ionode) CALL close_file(unit_number=restart_unit) - DO ispin = 1, nspin - CALL write_mo_set(mo_array(ispin)%mo_set, atomic_kind_set, qs_kind_set, & - particle_set, 4, dft_section) - END DO + ! CDFT has no real dft_section and does not need to print + IF (.NOT. my_cdft) THEN + DO ispin = 1, nspin + CALL write_mo_set(mo_array(ispin)%mo_set, atomic_kind_set, qs_kind_set, & + particle_set, 4, dft_section) + END DO + END IF CALL timestop(handle) diff --git a/src/qs_outer_scf.F b/src/qs_outer_scf.F index faa34aca80..0f883ce90e 100644 --- a/src/qs_outer_scf.F +++ b/src/qs_outer_scf.F @@ -11,16 +11,20 @@ ! ************************************************************************************************** MODULE qs_outer_scf USE cp_control_types, ONLY: becke_restraint_type,& + cdft_control_type,& ddapc_restraint_type,& dft_control_type,& s2_restraint_type USE input_constants, ONLY: & - do_ddapc_constraint, do_s2_constraint, outer_scf_basis_center_opt, & - outer_scf_becke_constraint, outer_scf_ddapc_constraint, outer_scf_none, & - outer_scf_optimizer_bisect, outer_scf_optimizer_diis, outer_scf_optimizer_none, & + cdft2ot, cdft_combined_constraint, cdft_density_constraint, cdft_magnetization_constraint, & + do_ddapc_constraint, do_s2_constraint, ot2cdft, outer_scf_basis_center_opt, & + outer_scf_becke_constraint, outer_scf_cdft_constraint, outer_scf_ddapc_constraint, & + outer_scf_none, outer_scf_optimizer_bisect, outer_scf_optimizer_broyden, & + outer_scf_optimizer_diis, outer_scf_optimizer_newton, outer_scf_optimizer_none, & outer_scf_optimizer_sd, outer_scf_s2_constraint USE kinds, ONLY: dp - USE mathlib, ONLY: diamat_all + USE mathlib, ONLY: diamat_all,& + invert_matrix USE qs_basis_gradient, ONLY: qs_basis_center_gradient,& qs_update_basis_center_pos,& return_basis_center_gradient_norm @@ -43,19 +47,24 @@ MODULE qs_outer_scf ! *** Public subroutines *** PUBLIC :: outer_loop_gradient, outer_loop_optimize, outer_loop_update_qs_env, & - outer_loop_variables_count, outer_loop_extrapolate + outer_loop_variables_count, outer_loop_extrapolate, & + outer_loop_switch, outer_loop_purge_history CONTAINS ! ************************************************************************************************** -!> \brief returns the number of variables that is employed in the outer loop -!> \param scf_control ... -!> \retval res ... +!> \brief returns the number of variables that is employed in the outer loop. with a CDFT constraint +!> this value is returned by the cdft_control type +!> \param scf_control the outer loop control type +!> \param cdft_control the cdft loop control type +!> \retval res the number of variables !> \par History !> 03.2006 created [Joost VandeVondele] ! ************************************************************************************************** - FUNCTION outer_loop_variables_count(scf_control) RESULT(res) + FUNCTION outer_loop_variables_count(scf_control, cdft_control) RESULT(res) TYPE(scf_control_type), POINTER :: scf_control + TYPE(cdft_control_type), INTENT(IN), OPTIONAL, & + POINTER :: cdft_control INTEGER :: res SELECT CASE (scf_control%outer_scf%type) @@ -63,8 +72,17 @@ CONTAINS res = 1 CASE (outer_scf_s2_constraint) res = 1 - CASE (outer_scf_becke_constraint) - res = 1 + CASE (outer_scf_becke_constraint, outer_scf_cdft_constraint) + IF (PRESENT(cdft_control)) THEN + SELECT CASE (cdft_control%constraint_type) + CASE (cdft_density_constraint, cdft_magnetization_constraint) + res = 1 + CASE (cdft_combined_constraint) + res = 2 + END SELECT + ELSE + res = 1 + END IF CASE (outer_scf_basis_center_opt) res = 1 CASE (outer_scf_none) ! just needed to communicate the gradient criterium @@ -89,9 +107,10 @@ CONTAINS CHARACTER(LEN=*), PARAMETER :: routineN = 'outer_loop_gradient', & routineP = moduleN//':'//routineN - INTEGER :: handle, ihistory, n + INTEGER :: handle, ihistory, ivar, n LOGICAL :: is_constraint TYPE(becke_restraint_type), POINTER :: becke_control + TYPE(cdft_control_type), POINTER :: cdft_control TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control TYPE(dft_control_type), POINTER :: dft_control TYPE(qs_energy_type), POINTER :: energy @@ -139,9 +158,19 @@ CONTAINS CASE (outer_scf_becke_constraint) CPASSERT(dft_control%qs_control%becke_restraint) becke_control => dft_control%qs_control%becke_control - scf_env%outer_scf%variables(:, ihistory) = becke_control%strength - scf_env%outer_scf%gradient(:, ihistory) = becke_control%becke_order_p- & - becke_control%target + DO ivar = 1, SIZE(scf_env%outer_scf%gradient, 1) + scf_env%outer_scf%variables(ivar, ihistory) = becke_control%strength(ivar) + scf_env%outer_scf%gradient(ivar, ihistory) = becke_control%becke_order_p(ivar)- & + becke_control%target(ivar) + END DO + CASE (outer_scf_cdft_constraint) + CPASSERT(dft_control%qs_control%cdft) + cdft_control => dft_control%qs_control%cdft_control + DO ivar = 1, SIZE(scf_env%outer_scf%gradient, 1) + scf_env%outer_scf%variables(ivar, ihistory) = cdft_control%strength(ivar) + scf_env%outer_scf%gradient(ivar, ihistory) = cdft_control%value(ivar)- & + cdft_control%target(ivar) + END DO CASE (outer_scf_basis_center_opt) CALL qs_basis_center_gradient(qs_env) scf_env%outer_scf%gradient(:, ihistory) = return_basis_center_gradient_norm(qs_env) @@ -157,10 +186,11 @@ CONTAINS ! ************************************************************************************************** !> \brief optimizes the parameters of the outer_scf -!> \param scf_env ... -!> \param scf_control ... +!> \param scf_env the scf_env where to optimize the parameters +!> \param scf_control control parameters for the optimization !> \par History !> 03.2006 created [Joost VandeVondele] +!> 01.2017 added Broyden and Newton optimizers [Nico Holmberg] !> \note !> ought to be general, and independent of the actual kind of variables ! ************************************************************************************************** @@ -172,16 +202,17 @@ CONTAINS routineP = moduleN//':'//routineN INTEGER :: handle, i, ibuf, ihigh, ihistory, ilow, & - j, jbuf, nb, optimizer_type - INTEGER, ALLOCATABLE, DIMENSION(:) :: ipivot - REAL(KIND=dp) :: interval, tmp + j, jbuf, nb, nvar, optimizer_type + REAL(KIND=dp) :: interval, inv_error, scale, tmp REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: ev - REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: a, b + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: a, b, f, jacobian, x + REAL(KIND=dp), DIMENSION(:, :), POINTER :: inv_jacobian CALL timeset(routineN, handle) ihistory = scf_env%outer_scf%iter_count optimizer_type = scf_control%outer_scf%optimizer + NULLIFY (inv_jacobian) IF (scf_control%outer_scf%type == outer_scf_basis_center_opt) THEN scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory) @@ -237,7 +268,7 @@ CONTAINS optimizer_type = outer_scf_optimizer_sd CYCLE ELSE - ALLOCATE (b(nb+1, nb+1), a(nb+1, nb+1), ev(nb+1), ipivot(nb+1)) + ALLOCATE (b(nb+1, nb+1), a(nb+1, nb+1), ev(nb+1)) DO I = 1, nb DO J = I, nb ibuf = ihistory-nb+i @@ -268,8 +299,69 @@ CONTAINS scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory+1)+ & ev(i)*scf_env%outer_scf%variables(:, ibuf) ENDDO - DEALLOCATE (b, ev) + DEALLOCATE (a, b, ev) ENDIF + CASE (outer_scf_optimizer_broyden) + CPASSERT(SIZE(scf_env%outer_scf%gradient, 2) >= 3) + nvar = SIZE(scf_env%outer_scf%gradient, 1) + IF (ihistory < 2) THEN + ! Need two history values to use Broyden, switch to sd + optimizer_type = outer_scf_optimizer_sd + CYCLE + END IF + IF (nvar == 1) THEN + ! 1D case secant method + scf_env%outer_scf%variables(1, ihistory+1) = scf_env%outer_scf%variables(1, ihistory)- & + (scf_env%outer_scf%variables(1, ihistory)- & + scf_env%outer_scf%variables(1, ihistory-1))/ & + (scf_env%outer_scf%gradient(1, ihistory)- & + scf_env%outer_scf%gradient(1, ihistory-1))* & + scf_env%outer_scf%gradient(1, ihistory) + ELSE + ALLOCATE (f(nvar, 1), x(nvar, 1)) + DO i = 1, nvar + f(i, 1) = scf_env%outer_scf%gradient(i, ihistory)-scf_env%outer_scf%gradient(i, ihistory-1) + x(i, 1) = scf_env%outer_scf%variables(i, ihistory)-scf_env%outer_scf%variables(i, ihistory-1) + END DO + ! Use finite difference Jacobian as initial guess + ! TODO: Add possibility to restart Jacobian + IF (ihistory == 2) THEN + IF (.NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) & + ALLOCATE (scf_env%outer_scf%inv_jacobian(nvar, nvar)) + inv_jacobian => scf_env%outer_scf%inv_jacobian + ALLOCATE (jacobian(nvar, nvar)) + jacobian = 0.0_dp + DO i = 1, nvar + jacobian(i, i) = f(i, 1)/x(i, 1) + END DO + CALL invert_matrix(jacobian, inv_jacobian, inv_error) + scale = SUM(MATMUL(TRANSPOSE(x), MATMUL(inv_jacobian, f))) + DEALLOCATE (jacobian) + ELSE + SELECT CASE (scf_control%outer_scf%jacobian_type) + CASE DEFAULT + ! Broyden's 1st method + ! Update inverse Jacobian: dx_n = \delta x_n; df_n = \delta f_n + ! J_(n+1)^(-1) = J_n^(-1) + (dx_n - J_n^(-1)*df_n)*(dx_n^T * J_n^(-1))/(dx_n^T * J_n^(-1) * df_n) + inv_jacobian => scf_env%outer_scf%inv_jacobian + scale = SUM(MATMUL(TRANSPOSE(x), MATMUL(inv_jacobian, f))) + scale = 1.0_dp/scale + IF (scale < 1.0E-12_dp) scale = 1.0E-12_dp + inv_jacobian = inv_jacobian+scale*MATMUL((x-MATMUL(inv_jacobian, f)), & + MATMUL(TRANSPOSE(x), inv_jacobian)) + END SELECT + END IF + ! Broyden update: x_(n+1) = x_n - J^(-1)*f(x_n) + scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory)- & + MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, ihistory)) + ! Clean up + DEALLOCATE (f, x) + END IF + CASE (outer_scf_optimizer_newton) + CPASSERT(ASSOCIATED(scf_env%outer_scf%inv_jacobian)) + inv_jacobian => scf_env%outer_scf%inv_jacobian + scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory)- & + MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, ihistory)) CASE DEFAULT CPABORT("") END SELECT @@ -299,6 +391,7 @@ CONTAINS INTEGER :: handle, ihistory, n LOGICAL :: is_constraint TYPE(becke_restraint_type), POINTER :: becke_control + TYPE(cdft_control_type), POINTER :: cdft_control TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control TYPE(dft_control_type), POINTER :: dft_control TYPE(s2_restraint_type), POINTER :: s2_restraint_control @@ -325,7 +418,12 @@ CONTAINS s2_restraint_control%strength = scf_env%outer_scf%variables(1, ihistory+1) CASE (outer_scf_becke_constraint) becke_control => dft_control%qs_control%becke_control - becke_control%strength = scf_env%outer_scf%variables(1, ihistory+1) + becke_control%strength(:) = scf_env%outer_scf%variables(:, ihistory+1) + IF (dft_control%qs_control%cdft) & + dft_control%qs_control%cdft_control%strength(:) = becke_control%strength(:) + CASE (outer_scf_cdft_constraint) + cdft_control => dft_control%qs_control%cdft_control + cdft_control%strength(:) = scf_env%outer_scf%variables(:, ihistory+1) CASE (outer_scf_basis_center_opt) CALL qs_update_basis_center_pos(qs_env) CASE DEFAULT @@ -339,7 +437,7 @@ CONTAINS ! ************************************************************************************************** !> \brief uses the outer_scf_history to extrapolate new values for the variables !> and updates their value in qs_env accordingly -!> \param qs_env ... +!> \param qs_env the qs_environment_type where to update the variables !> \par History !> 03.2006 created [Joost VandeVondele] !> \note @@ -392,8 +490,11 @@ CONTAINS outer_scf_history(1, ivec) = & dft_control%qs_control%s2_restraint_control%strength CASE (outer_scf_becke_constraint) - outer_scf_history(1, ivec) = & - dft_control%qs_control%becke_control%strength + outer_scf_history(:, ivec) = & + dft_control%qs_control%becke_control%strength(:) + CASE (outer_scf_cdft_constraint) + outer_scf_history(:, ivec) = & + dft_control%qs_control%cdft_control%strength(:) CASE (outer_scf_basis_center_opt) outer_scf_history(1, ivec) = 0.0_dp CASE DEFAULT @@ -421,7 +522,11 @@ CONTAINS CASE (outer_scf_s2_constraint) dft_control%qs_control%s2_restraint_control%strength = extrapolation(1) CASE (outer_scf_becke_constraint) - dft_control%qs_control%becke_control%strength = extrapolation(1) + dft_control%qs_control%becke_control%strength(:) = extrapolation(:) + IF (dft_control%qs_control%cdft) & + dft_control%qs_control%cdft_control%strength(:) = dft_control%qs_control%becke_control%strength(:) + CASE (outer_scf_cdft_constraint) + dft_control%qs_control%cdft_control%strength(:) = extrapolation(:) CASE (outer_scf_basis_center_opt) ! nothing to do CASE DEFAULT @@ -434,4 +539,124 @@ CONTAINS END SUBROUTINE outer_loop_extrapolate +! ************************************************************************************************** +!> \brief switch between two outer_scf envs stored in cdft_control +!> \param scf_env the scf_env where values need to be updated using cdft_control +!> \param scf_control the scf_control where values need to be updated using cdft_control +!> \param cdft_control container for the second outer_scf env +!> \param dir determines what switching operation to perform +!> \par History +!> 12.2015 created [Nico Holmberg] +! ************************************************************************************************** + + SUBROUTINE outer_loop_switch(scf_env, scf_control, cdft_control, dir) + TYPE(qs_scf_env_type), POINTER :: scf_env + TYPE(scf_control_type), POINTER :: scf_control + TYPE(cdft_control_type), POINTER :: cdft_control + INTEGER, INTENT(IN) :: dir + + CHARACTER(len=*), PARAMETER :: routineN = 'outer_loop_switch', & + routineP = moduleN//':'//routineN + + SELECT CASE (dir) + ! Constraint -> OT + CASE (cdft2ot) + ! Switch data in scf_control + scf_control%outer_scf%have_scf = cdft_control%ot_control%have_scf + scf_control%outer_scf%max_scf = cdft_control%ot_control%max_scf + scf_control%outer_scf%eps_scf = cdft_control%ot_control%eps_scf + scf_control%outer_scf%step_size = cdft_control%ot_control%step_size + scf_control%outer_scf%type = cdft_control%ot_control%type + scf_control%outer_scf%optimizer = cdft_control%ot_control%optimizer + scf_control%outer_scf%diis_buffer_length = cdft_control%ot_control%diis_buffer_length + scf_control%outer_scf%bisect_trust_count = cdft_control%ot_control%bisect_trust_count + scf_control%outer_scf%jacobian_type = cdft_control%ot_control%jacobian_type + ! Switch data in scf_env: first save current values for constraint + cdft_control%constraint%iter_count = scf_env%outer_scf%iter_count + cdft_control%constraint%energy = scf_env%outer_scf%energy + cdft_control%constraint%variables = scf_env%outer_scf%variables + cdft_control%constraint%gradient = scf_env%outer_scf%gradient + cdft_control%constraint%count = scf_env%outer_scf%count + ! Now switch + IF (ASSOCIATED(scf_env%outer_scf%energy)) & + DEALLOCATE (scf_env%outer_scf%energy) + ALLOCATE (scf_env%outer_scf%energy(scf_control%outer_scf%max_scf+1)) + scf_env%outer_scf%energy = 0.0_dp + IF (ASSOCIATED(scf_env%outer_scf%variables)) & + DEALLOCATE (scf_env%outer_scf%variables) + ALLOCATE (scf_env%outer_scf%variables(1, scf_control%outer_scf%max_scf+1)) + scf_env%outer_scf%variables = 0.0_dp + IF (ASSOCIATED(scf_env%outer_scf%gradient)) & + DEALLOCATE (scf_env%outer_scf%gradient) + ALLOCATE (scf_env%outer_scf%gradient(1, scf_control%outer_scf%max_scf+1)) + scf_env%outer_scf%gradient = 0.0_dp + IF (ASSOCIATED(scf_env%outer_scf%count)) & + DEALLOCATE (scf_env%outer_scf%count) + ALLOCATE (scf_env%outer_scf%count(scf_control%outer_scf%max_scf+1)) + scf_env%outer_scf%count = 0 + ! OT -> constraint + CASE (ot2cdft) + scf_control%outer_scf%have_scf = cdft_control%constraint_control%have_scf + scf_control%outer_scf%max_scf = cdft_control%constraint_control%max_scf + scf_control%outer_scf%eps_scf = cdft_control%constraint_control%eps_scf + scf_control%outer_scf%step_size = cdft_control%constraint_control%step_size + scf_control%outer_scf%type = cdft_control%constraint_control%type + scf_control%outer_scf%optimizer = cdft_control%constraint_control%optimizer + scf_control%outer_scf%diis_buffer_length = cdft_control%constraint_control%diis_buffer_length + scf_control%outer_scf%bisect_trust_count = cdft_control%constraint_control%bisect_trust_count + scf_control%outer_scf%jacobian_type = cdft_control%constraint_control%jacobian_type + IF (ASSOCIATED(scf_env%outer_scf%energy)) & + DEALLOCATE (scf_env%outer_scf%energy) + ALLOCATE (scf_env%outer_scf%energy(scf_control%outer_scf%max_scf+1)) + scf_env%outer_scf%energy = cdft_control%constraint%energy + IF (ASSOCIATED(scf_env%outer_scf%variables)) & + DEALLOCATE (scf_env%outer_scf%variables) + ALLOCATE (scf_env%outer_scf%variables(SIZE(cdft_control%constraint%variables, 1), & + scf_control%outer_scf%max_scf+1)) + scf_env%outer_scf%variables = cdft_control%constraint%variables + IF (ASSOCIATED(scf_env%outer_scf%gradient)) & + DEALLOCATE (scf_env%outer_scf%gradient) + ALLOCATE (scf_env%outer_scf%gradient(SIZE(cdft_control%constraint%gradient, 1), & + scf_control%outer_scf%max_scf+1)) + scf_env%outer_scf%gradient = cdft_control%constraint%gradient + IF (ASSOCIATED(scf_env%outer_scf%count)) & + DEALLOCATE (scf_env%outer_scf%count) + ALLOCATE (scf_env%outer_scf%count(scf_control%outer_scf%max_scf+1)) + scf_env%outer_scf%count = cdft_control%constraint%count + scf_env%outer_scf%iter_count = cdft_control%constraint%iter_count + CASE DEFAULT + CPABORT("") + END SELECT + + END SUBROUTINE outer_loop_switch + +! ************************************************************************************************** +!> \brief purges outer_scf_history zeroing everything except +!> the latest value of the outer_scf variable stored in qs_control +!> \param qs_env the qs_environment_type where to purge +!> \par History +!> 05.2016 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE outer_loop_purge_history(qs_env) + TYPE(qs_environment_type), POINTER :: qs_env + + CHARACTER(LEN=*), PARAMETER :: routineN = 'outer_loop_purge_history', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, outer_scf_ihistory + REAL(kind=dp), DIMENSION(:, :), POINTER :: outer_scf_history + + CALL timeset(routineN, handle) + + CALL get_qs_env(qs_env, outer_scf_history=outer_scf_history, & + outer_scf_ihistory=outer_scf_ihistory) + CPASSERT(SIZE(outer_scf_history, 2) > 0) + outer_scf_ihistory = 0 + outer_scf_history = 0.0_dp + CALL set_qs_env(qs_env, outer_scf_ihistory=outer_scf_ihistory) + + CALL timestop(handle) + + END SUBROUTINE outer_loop_purge_history + END MODULE qs_outer_scf diff --git a/src/qs_scf.F b/src/qs_scf.F index dde8cb3612..37147a567d 100644 --- a/src/qs_scf.F +++ b/src/qs_scf.F @@ -39,13 +39,18 @@ !> intermediate energy communication with external communicator added !> - kpoints (08.2014, JGH) !> - unified k-point and gamma-point code (2014.11) [Ole Schuett] +!> - added extra SCF loop for CDFT constraints (12.2015) [Nico Holmberg] !> \author Matthias Krack (30.04.2001) ! ************************************************************************************************** MODULE qs_scf USE atomic_kind_types, ONLY: atomic_kind_type - USE cp_control_types, ONLY: dft_control_type - USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm - USE cp_fm_types, ONLY: cp_fm_release,& + USE cp_control_types, ONLY: cdft_control_type,& + dft_control_type + USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,& + copy_fm_to_dbcsr + USE cp_fm_types, ONLY: cp_fm_create,& + cp_fm_release,& + cp_fm_to_fm,& cp_fm_type USE cp_log_handling, ONLY: cp_get_default_logger,& cp_logger_type,& @@ -64,14 +69,17 @@ MODULE qs_scf dbcsr_deallocate_matrix,& dbcsr_deallocate_matrix_set,& dbcsr_get_info,& + dbcsr_init_p,& dbcsr_p_type,& + dbcsr_set,& dbcsr_type - USE input_constants, ONLY: history_guess,& - ot_precond_full_all,& - ot_precond_full_single,& - ot_precond_full_single_inverse,& - ot_precond_none,& - ot_precond_s_inverse + USE input_constants, ONLY: & + cdft2ot, cdft_combined_acceptor, cdft_combined_all, cdft_combined_constraint, & + cdft_combined_donor, history_guess, jacobian_fd1, jacobian_fd1_backward, & + jacobian_fd1_central, jacobian_fd2, jacobian_fd2_backward, ot2cdft, ot_precond_full_all, & + ot_precond_full_single, ot_precond_full_single_inverse, ot_precond_none, & + ot_precond_s_inverse, outer_scf_hirshfeld_constraint, outer_scf_optimizer_broyden, & + outer_scf_optimizer_newton USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type USE kinds, ONLY: default_string_length,& @@ -80,6 +88,7 @@ MODULE qs_scf USE kpoint_types, ONLY: kpoint_type USE machine, ONLY: m_flush,& m_walltime + USE mathlib, ONLY: invert_matrix USE message_passing, ONLY: mp_send USE particle_types, ONLY: particle_type USE preconditioner, ONLY: prepare_preconditioner,& @@ -97,21 +106,29 @@ MODULE qs_scf USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& set_qs_env + USE qs_integrate_potential, ONLY: integrate_v_rspace USE qs_kind_types, ONLY: qs_kind_type USE qs_ks_methods, ONLY: qs_ks_update_qs_env USE qs_ks_types, ONLY: qs_ks_did_change,& qs_ks_env_type USE qs_mo_io, ONLY: write_mo_set - USE qs_mo_methods, ONLY: make_basis_simple,& + USE qs_mo_methods, ONLY: calculate_density_matrix,& + make_basis_simple,& make_basis_sm USE qs_mo_occupation, ONLY: set_mo_occupation - USE qs_mo_types, ONLY: get_mo_set,& + USE qs_mo_types, ONLY: deallocate_mo_set,& + duplicate_mo_set,& + get_mo_set,& mo_set_p_type USE qs_ot, ONLY: qs_ot_new_preconditioner USE qs_ot_scf, ONLY: ot_scf_init,& ot_scf_read_input - USE qs_outer_scf, ONLY: outer_loop_optimize,& + USE qs_outer_scf, ONLY: outer_loop_gradient,& + outer_loop_optimize,& + outer_loop_purge_history,& + outer_loop_switch,& outer_loop_update_qs_env + USE qs_rho_methods, ONLY: qs_rho_update_rho USE qs_rho_types, ONLY: qs_rho_get,& qs_rho_type USE qs_scf_initialization, ONLY: qs_scf_env_initialize @@ -123,7 +140,9 @@ MODULE qs_scf qs_scf_new_mos_kp,& qs_scf_rho_update,& qs_scf_set_loop_flags - USE qs_scf_output, ONLY: qs_scf_loop_info,& + USE qs_scf_output, ONLY: qs_scf_cdft_info,& + qs_scf_cdft_initial_info,& + qs_scf_loop_info,& qs_scf_loop_print,& qs_scf_outer_loop_info,& qs_scf_write_mos @@ -132,7 +151,8 @@ MODULE qs_scf block_davidson_diag_method_nr, block_krylov_diag_method_nr, filter_matrix_diag_method_nr, & general_diag_method_nr, ot_diag_method_nr, ot_method_nr, qs_scf_env_type, scf_env_release, & special_diag_method_nr - USE qs_wf_history_methods, ONLY: wfi_update + USE qs_wf_history_methods, ONLY: wfi_purge_history,& + wfi_update USE scf_control_types, ONLY: scf_control_type #include "./base/base_uses.f90" @@ -141,8 +161,9 @@ MODULE qs_scf PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_scf' + LOGICAL, PRIVATE :: reuse_precond = .FALSE. - PUBLIC :: scf, scf_env_cleanup, scf_env_do_scf + PUBLIC :: scf, scf_env_cleanup, scf_env_do_scf, cdft_scf CONTAINS @@ -195,8 +216,13 @@ CONTAINS scf_control%outer_scf%have_scf = .FALSE. END IF - CALL scf_env_do_scf(scf_env=scf_env, scf_control=scf_control, qs_env=qs_env, & - converged=converged, should_stop=should_stop) + IF (.NOT. dft_control%qs_control%cdft) THEN + CALL scf_env_do_scf(scf_env=scf_env, scf_control=scf_control, qs_env=qs_env, & + converged=converged, should_stop=should_stop) + ELSE + ! Third SCF loop needed for CDFT with OT to properly restart OT inner loop + CALL cdft_scf(qs_env=qs_env, should_stop=should_stop) + END IF ! If SCF has not converged, then we should not start MP2 IF (ASSOCIATED(qs_env%mp2_env)) qs_env%mp2_env%hf_fail = .NOT. converged @@ -205,7 +231,17 @@ CONTAINS IF ((ASSOCIATED(qs_env%wf_history)) .AND. & ((scf_control%density_guess .NE. history_guess) .OR. & (.NOT. first_step_flag))) THEN - CALL wfi_update(qs_env%wf_history, qs_env=qs_env, dt=1.0_dp) + IF (.NOT. dft_control%qs_control%cdft) THEN + CALL wfi_update(qs_env%wf_history, qs_env=qs_env, dt=1.0_dp) + ELSE + IF (dft_control%qs_control%cdft_control%should_purge) THEN + CALL wfi_purge_history(qs_env) + CALL outer_loop_purge_history(qs_env) + dft_control%qs_control%cdft_control%should_purge = .FALSE. + ELSE + CALL wfi_update(qs_env%wf_history, qs_env=qs_env, dt=1.0_dp) + END IF + END IF ELSE IF ((scf_control%density_guess .EQ. history_guess) .AND. & (first_step_flag)) THEN scf_control%max_scf = max_scf_tmp @@ -218,6 +254,8 @@ CONTAINS ! *** cleanup CALL scf_env_cleanup(scf_env) + IF (dft_control%qs_control%cdft) & + CALL cdft_control_cleanup(dft_control%qs_control%cdft_control) END IF @@ -248,8 +286,8 @@ CONTAINS CHARACTER(LEN=*), PARAMETER :: routineN = 'scf_env_do_scf', routineP = moduleN//':'//routineN CHARACTER(LEN=default_string_length) :: description, name - INTEGER :: ext_master_id, external_comm, handle, handle2, i_tmp, ic, ispin, iter_count, & - output_unit, scf_energy_message_tag, total_steps + INTEGER :: ext_master_id, external_comm, handle, handle2, i_tmp, iatom, ic, ispin, & + iter_count, output_unit, scf_energy_message_tag, total_steps LOGICAL :: diis_step, do_kpoints, energy_only, exit_inner_loop, exit_outer_loop, & inner_loop_converged, just_energy, outer_loop_converged REAL(KIND=dp) :: t1, t2 @@ -464,6 +502,10 @@ CONTAINS converged = inner_loop_converged .AND. outer_loop_converged + IF (dft_control%qs_control%cdft) & + dft_control%qs_control%cdft_control%total_steps = & + dft_control%qs_control%cdft_control%total_steps+total_steps + IF (.NOT. converged) CPWARN("SCF run NOT converged") ! if needed copy mo_coeff dbcsr->fm for later use in post_scf!fm->dbcsr @@ -477,11 +519,43 @@ CONTAINS ENDDO !fm -> dbcsr IF (dft_control%qs_control%becke_restraint) THEN - CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) - CALL pw_pool_give_back_pw(auxbas_pw_pool, & - dft_control%qs_control%becke_control%becke_pot%pw) - dft_control%qs_control%becke_control%need_pot = .TRUE. + ! Check if Becke potential is not needed for force evaluation or CDFT and deallocate + IF (.NOT. dft_control%qs_control%becke_control%save_pot .AND. & + .NOT. dft_control%qs_control%cdft) THEN + CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%becke_pot%pw) + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + DO iatom = 1, dft_control%qs_control%becke_control%natoms + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%charge(iatom)%pw) + END DO + DEALLOCATE (dft_control%qs_control%becke_control%charge) + END IF + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + IF (.NOT. ASSOCIATED(dft_control%qs_control%becke_control%cavity_mat)) THEN + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%cavity%pw) + ELSE + DEALLOCATE (dft_control%qs_control%becke_control%cavity_mat) + END IF + END IF + IF (ASSOCIATED(dft_control%qs_control%becke_control%charges_fragment)) & + DEALLOCATE (dft_control%qs_control%becke_control%charges_fragment) + IF (dft_control%qs_control%becke_control%constraint_type == cdft_combined_constraint) THEN + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ! Do nothing + CASE (cdft_combined_acceptor, cdft_combined_donor) + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%combined_weight%pw) + END SELECT + END IF + dft_control%qs_control%becke_control%need_pot = .TRUE. + dft_control%qs_control%becke_control%external_control = .FALSE. + END IF END IF + CALL cp_rm_iter_level(logger%iter_info, level_name="QS_SCF") CALL timestop(handle) @@ -649,9 +723,10 @@ CONTAINS ! if an old preconditioner is still around (i.e. outer SCF is active), ! remove it if this could be worthwhile - CALL restart_preconditioner(qs_env, scf_env%ot_preconditioner, & - scf_env%qs_ot_env(1)%settings%preconditioner_type, & - dft_control%nspins) + IF (.NOT. reuse_precond) & + CALL restart_preconditioner(qs_env, scf_env%ot_preconditioner, & + scf_env%qs_ot_env(1)%settings%preconditioner_type, & + dft_control%nspins) ! ! preconditioning still needs to be done correctly with has_unit_metric @@ -663,12 +738,14 @@ CONTAINS orthogonality_metric => matrix_s(1)%matrix ENDIF - CALL prepare_preconditioner(qs_env, mos, matrix_ks, matrix_s, scf_env%ot_preconditioner, & - scf_env%qs_ot_env(1)%settings%preconditioner_type, & - scf_env%qs_ot_env(1)%settings%precond_solver_type, & - scf_env%qs_ot_env(1)%settings%energy_gap, dft_control%nspins, & - has_unit_metric=has_unit_metric, & - chol_type=scf_env%qs_ot_env(1)%settings%cholesky_type) + IF (.NOT. reuse_precond) & + CALL prepare_preconditioner(qs_env, mos, matrix_ks, matrix_s, scf_env%ot_preconditioner, & + scf_env%qs_ot_env(1)%settings%preconditioner_type, & + scf_env%qs_ot_env(1)%settings%precond_solver_type, & + scf_env%qs_ot_env(1)%settings%energy_gap, dft_control%nspins, & + has_unit_metric=has_unit_metric, & + chol_type=scf_env%qs_ot_env(1)%settings%cholesky_type) + IF (reuse_precond) reuse_precond = .FALSE. CALL ot_scf_init(mo_array=mos, matrix_s=orthogonality_metric, & broyden_adaptive_sigma=qs_env%broyden_adaptive_sigma, & @@ -802,9 +879,456 @@ CONTAINS IF (ASSOCIATED(scf_env%outer_scf%energy)) THEN DEALLOCATE (scf_env%outer_scf%energy) ENDIF + IF (ASSOCIATED(scf_env%outer_scf%inv_jacobian)) THEN + DEALLOCATE (scf_env%outer_scf%inv_jacobian) + ENDIF CALL timestop(handle) END SUBROUTINE scf_env_cleanup +! ************************************************************************************************** +!> \brief perform a CDFT scf procedure in the given qs_env +!> \param qs_env the qs_environment where to perform the scf procedure +!> \param should_stop flag determing if calculation should stop +!> \par History +!> 12.2015 Created +!> \author Nico Holmberg +! ************************************************************************************************** + SUBROUTINE cdft_scf(qs_env, should_stop) + TYPE(qs_environment_type), POINTER :: qs_env + LOGICAL, INTENT(OUT) :: should_stop + + CHARACTER(len=*), PARAMETER :: routineN = 'cdft_scf', routineP = moduleN//':'//routineN + + INTEGER :: handle, iatom, ispin, output_unit + LOGICAL :: cdft_loop_converged, converged, & + exit_cdft_loop, first_iteration + TYPE(cdft_control_type), POINTER :: cdft_control + TYPE(cp_logger_type), POINTER :: logger + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, rho_ao + TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_env_type), POINTER :: pw_env + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool + TYPE(qs_energy_type), POINTER :: energy + TYPE(qs_ks_env_type), POINTER :: ks_env + TYPE(qs_rho_type), POINTER :: rho + TYPE(qs_scf_env_type), POINTER :: scf_env + TYPE(scf_control_type), POINTER :: scf_control + TYPE(section_vals_type), POINTER :: dft_section, input, scf_section + + NULLIFY (scf_env, ks_env, energy, rho, matrix_s, rho_ao, cdft_control, logger, & + dft_control, pw_env, auxbas_pw_pool, energy, ks_env, scf_env, dft_section, & + input, scf_section, scf_control) + logger => cp_get_default_logger() + + CPASSERT(ASSOCIATED(qs_env)) + CALL get_qs_env(qs_env, scf_env=scf_env, energy=energy, & + dft_control=dft_control, scf_control=scf_control, & + ks_env=ks_env, input=input) + + CALL timeset(routineN//"_loop", handle) + dft_section => section_vals_get_subs_vals(input, "DFT") + scf_section => section_vals_get_subs_vals(dft_section, "SCF") + output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%PROGRAM_RUN_INFO", & + extension=".scfLog") + first_iteration = .TRUE. + + cdft_control => dft_control%qs_control%cdft_control + + scf_env%outer_scf%iter_count = 0 + cdft_control%total_steps = 0 + + ! Write some info about the CDFT calculation + IF (output_unit > 0) THEN + WRITE (UNIT=output_unit, FMT="(/,/,T2,A)") & + "CDFT EXTERNAL SCF WAVEFUNCTION OPTIMIZATION" + CALL qs_scf_cdft_initial_info(output_unit, cdft_control, dft_control) + END IF + IF (cdft_control%reuse_precond) THEN + reuse_precond = .FALSE. + cdft_control%nreused = 0 + END IF + cdft_outer_loop: DO + ! Change outer_scf settings to OT settings + CALL outer_loop_switch(scf_env, scf_control, cdft_control, cdft2ot) + ! Solve electronic structure with fixed value of constraint + CALL scf_env_do_scf(scf_env=scf_env, scf_control=scf_control, qs_env=qs_env, & + converged=converged, should_stop=should_stop) + ! Decide whether to reuse the preconditioner on the next iteration + IF (cdft_control%reuse_precond) THEN + ! For convergence in exactly one step, the preconditioner is always reused (assuming max_reuse > 0) + ! usually this means that the electronic structure has already converged to the correct state + ! but the constraint optimizer keeps jumping over the optimal solution + IF (scf_env%outer_scf%iter_count == 1 .AND. scf_env%iter_count == 1 & + .AND. cdft_control%total_steps /= 1) & + cdft_control%nreused = cdft_control%nreused-1 + ! SCF converged in less than precond_freq steps + IF (scf_env%outer_scf%iter_count == 1 .AND. scf_env%iter_count .LE. cdft_control%precond_freq .AND. & + cdft_control%total_steps /= 1 .AND. cdft_control%nreused .LT. cdft_control%max_reuse) THEN + reuse_precond = .TRUE. + cdft_control%nreused = cdft_control%nreused+1 + ELSE + reuse_precond = .FALSE. + cdft_control%nreused = 0 + END IF + END IF + ! Update history purging counters + IF (first_iteration .AND. cdft_control%purge_history) THEN + cdft_control%istep = cdft_control%istep+1 + IF (scf_env%outer_scf%iter_count .GT. 1) THEN + cdft_control%nbad_conv = cdft_control%nbad_conv+1 + IF (cdft_control%nbad_conv .GE. cdft_control%purge_freq .AND. & + cdft_control%istep .GE. cdft_control%purge_offset) THEN + cdft_control%nbad_conv = 0 + cdft_control%istep = 0 + cdft_control%should_purge = .TRUE. + END IF + END IF + END IF + first_iteration = .FALSE. + ! Change outer_scf settings to CDFT settings + CALL outer_loop_switch(scf_env, scf_control, cdft_control, ot2cdft) + CALL qs_scf_check_outer_exit(qs_env, scf_env, scf_control, should_stop, & + cdft_loop_converged, exit_cdft_loop) + CALL qs_scf_cdft_info(output_unit, scf_control, scf_env, cdft_control, & + energy, cdft_control%total_steps, & + should_stop, cdft_loop_converged, cdft_loop=.TRUE.) + IF (exit_cdft_loop) EXIT cdft_outer_loop + ! Check if inverse Jacobian needs to be calculated + CALL outer_loop_calculate_inverse_jacobian(qs_env) + ! Optimize constraint + CALL outer_loop_optimize(scf_env, scf_control) + CALL outer_loop_update_qs_env(qs_env, scf_env) + CALL qs_ks_did_change(ks_env, potential_changed=.TRUE.) + END DO cdft_outer_loop + + IF (dft_control%qs_control%becke_restraint) THEN + ! Store needed arrays for ET coupling calculation + IF (cdft_control%do_et) THEN + CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s) + CALL dbcsr_init_p(cdft_control%wmat%matrix) + CALL dbcsr_copy(cdft_control%wmat%matrix, matrix_s(1)%matrix, & + name="ET_RESTRAINT_MATRIX") + CALL dbcsr_set(cdft_control%wmat%matrix, 0.0_dp) + CALL integrate_v_rspace(dft_control%qs_control%becke_control%becke_pot, & + hmat=cdft_control%wmat, qs_env=qs_env, & + calculate_forces=.FALSE., & + gapw=dft_control%qs_control%gapw) + CALL dbcsr_init_p(cdft_control%matrix_s%matrix) + CALL dbcsr_copy(cdft_control%matrix_s%matrix, matrix_s(1)%matrix, & + name="OVERLAP") + NULLIFY (cdft_control%mo_coeff) + ALLOCATE (cdft_control%mo_coeff(dft_control%nspins)) + DO ispin = 1, dft_control%nspins + NULLIFY (cdft_control%mo_coeff(ispin)%matrix) + CALL cp_fm_create(matrix=cdft_control%mo_coeff(ispin)%matrix, & + matrix_struct=qs_env%mos(ispin)%mo_set%mo_coeff%matrix_struct, & + name="MO_COEFF_A"//TRIM(ADJUSTL(cp_to_string(ispin)))//"MATRIX") + CALL cp_fm_to_fm(qs_env%mos(ispin)%mo_set%mo_coeff, & + cdft_control%mo_coeff(ispin)%matrix) + END DO + IF (cdft_control%calculate_metric) THEN + CALL get_qs_env(qs_env, rho=rho) + CALL qs_rho_get(rho, rho_ao=rho_ao) + ALLOCATE (cdft_control%matrix_p(dft_control%nspins)) + DO ispin = 1, dft_control%nspins + NULLIFY (cdft_control%matrix_p(ispin)%matrix) + CALL dbcsr_init_p(cdft_control%matrix_p(ispin)%matrix) + CALL dbcsr_copy(cdft_control%matrix_p(ispin)%matrix, rho_ao(ispin)%matrix, & + name="DENSITY MATRIX") + END DO + END IF + END IF + ! Forces are not needed => time to deallocate Becke + IF (.NOT. dft_control%qs_control%becke_control%save_pot) THEN + CALL get_qs_env(qs_env, pw_env=pw_env) + CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%becke_pot%pw) + IF (dft_control%qs_control%becke_control%atomic_charges) THEN + DO iatom = 1, dft_control%qs_control%becke_control%natoms + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%charge(iatom)%pw) + END DO + DEALLOCATE (dft_control%qs_control%becke_control%charge) + END IF + IF (dft_control%qs_control%becke_control%cavity_confine) THEN + IF (.NOT. ASSOCIATED(dft_control%qs_control%becke_control%cavity_mat)) THEN + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%cavity%pw) + ELSE + DEALLOCATE (dft_control%qs_control%becke_control%cavity_mat) + END IF + END IF + IF (ASSOCIATED(dft_control%qs_control%becke_control%charges_fragment)) & + DEALLOCATE (dft_control%qs_control%becke_control%charges_fragment) + IF (dft_control%qs_control%becke_control%constraint_type == cdft_combined_constraint) THEN + SELECT CASE (dft_control%qs_control%becke_control%combined_type) + CASE (cdft_combined_all) + ! Do nothing + CASE (cdft_combined_acceptor, cdft_combined_donor) + CALL pw_pool_give_back_pw(auxbas_pw_pool, & + dft_control%qs_control%becke_control%combined_weight%pw) + END SELECT + END IF + dft_control%qs_control%becke_control%need_pot = .TRUE. + dft_control%qs_control%becke_control%external_control = .FALSE. + END IF + END IF + + IF (dft_control%qs_control%cdft) THEN + IF (cdft_control%type == outer_scf_hirshfeld_constraint) THEN + IF (.NOT. cdft_control%save_pot) THEN + CALL get_qs_env(qs_env, pw_env=pw_env) + CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) + CALL pw_pool_give_back_pw(auxbas_pw_pool, cdft_control%weight%pw) + cdft_control%need_pot = .TRUE. + END IF + END IF + END IF + CALL timestop(handle) + + END SUBROUTINE cdft_scf + +! ************************************************************************************************** +!> \brief perform cleanup operations for cdft_control +!> \param cdft_control container for the external CDFT SCF loop variables +!> \par History +!> 12.2015 created [Nico Holmberg] +!> \author Nico Holmberg +! ************************************************************************************************** + SUBROUTINE cdft_control_cleanup(cdft_control) + TYPE(cdft_control_type), POINTER :: cdft_control + + CHARACTER(len=*), PARAMETER :: routineN = 'cdft_control_cleanup', & + routineP = moduleN//':'//routineN + + IF (ASSOCIATED(cdft_control%constraint%variables)) & + DEALLOCATE (cdft_control%constraint%variables) + IF (ASSOCIATED(cdft_control%constraint%count)) & + DEALLOCATE (cdft_control%constraint%count) + IF (ASSOCIATED(cdft_control%constraint%gradient)) & + DEALLOCATE (cdft_control%constraint%gradient) + IF (ASSOCIATED(cdft_control%constraint%energy)) & + DEALLOCATE (cdft_control%constraint%energy) + + END SUBROUTINE cdft_control_cleanup + +! ************************************************************************************************** +!> \brief Calculates the finite difference inverse Jacobian +!> \param qs_env the qs_environment_type where to compute the Jacobian +!> \par History +!> 01.2017 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE outer_loop_calculate_inverse_jacobian(qs_env) + TYPE(qs_environment_type), POINTER :: qs_env + + CHARACTER(LEN=*), PARAMETER :: routineN = 'outer_loop_calculate_inverse_jacobian', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, i, ispin, iter_count, iwork, j, & + max_scf, nspins, nvar, nwork, & + output_unit, pwork + LOGICAL :: converged, should_stop + REAL(KIND=dp) :: dh, inv_error + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: coeff, step_multiplier + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: jacobian + REAL(KIND=dp), DIMENSION(:), POINTER :: energy + REAL(KIND=dp), DIMENSION(:, :), POINTER :: gradient, inv_jacobian + TYPE(cdft_control_type), POINTER :: cdft_control + TYPE(cp_logger_type), POINTER :: logger + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: p_rmpv + TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp + TYPE(dft_control_type), POINTER :: dft_control + TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos, mos_stashed + TYPE(qs_ks_env_type), POINTER :: ks_env + TYPE(qs_rho_type), POINTER :: rho + TYPE(qs_scf_env_type), POINTER :: scf_env + TYPE(scf_control_type), POINTER :: scf_control + TYPE(section_vals_type), POINTER :: input, scf_section + + CALL timeset(routineN, handle) + + NULLIFY (energy, gradient, p_rmpv, rho_ao_kp, mos, rho, & + mos_stashed, ks_env, scf_env, scf_control, dft_control, & + cdft_control, input, scf_section, inv_jacobian) + logger => cp_get_default_logger() + + CPASSERT(ASSOCIATED(qs_env)) + CALL get_qs_env(qs_env, scf_env=scf_env, ks_env=ks_env, & + scf_control=scf_control, mos=mos, rho=rho, & + dft_control=dft_control, input=input) + + SELECT CASE (scf_control%outer_scf%optimizer) + CASE DEFAULT + scf_control%outer_scf%build_jacobian = .FALSE. + CASE (outer_scf_optimizer_newton) + scf_control%outer_scf%build_jacobian = .TRUE. + CASE (outer_scf_optimizer_broyden) + ! TODO: Add Broyden variants where the explicit Jacobian is built + scf_control%outer_scf%build_jacobian = .FALSE. + END SELECT + + IF (scf_control%outer_scf%build_jacobian) THEN + ! Get output_unit + scf_section => section_vals_get_subs_vals(input, "DFT%SCF") + output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%PROGRAM_RUN_INFO", & + extension=".scfLog") + ! Save last converged state so we can roll back to it (mo_coeff and some outer_loop variables) + nspins = dft_control%nspins + ALLOCATE (mos_stashed(nspins)) + DO ispin = 1, nspins + CALL duplicate_mo_set(mos_stashed(ispin)%mo_set, mos(ispin)%mo_set) + END DO + CALL qs_rho_get(rho, rho_ao_kp=rho_ao_kp) + p_rmpv => rho_ao_kp(:, 1) + cdft_control => dft_control%qs_control%cdft_control + IF (.NOT. ASSOCIATED(cdft_control)) & + CALL cp_abort(__LOCATION__, "Optimizers that need the explicit Jacobian can"// & + " only be used together with a valid CDFT constraint") + ! Allocate work + nvar = SIZE(scf_env%outer_scf%variables, 1) + max_scf = scf_control%outer_scf%max_scf+1 + iter_count = scf_env%outer_scf%iter_count + ALLOCATE (gradient(nvar, max_scf)) + gradient = scf_env%outer_scf%gradient + ALLOCATE (energy(max_scf)) + energy = scf_env%outer_scf%energy + ALLOCATE (jacobian(nvar, nvar)) + jacobian = 0.0_dp + ! Setup finite difference scheme + SELECT CASE (scf_control%outer_scf%jacobian_type) + CASE DEFAULT + CALL cp_abort(__LOCATION__, "Unknown Jacobian type: "// & + cp_to_string(scf_control%outer_scf%jacobian_type)) + CASE (jacobian_fd1) + nwork = 0 + pwork = 1 + ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork)) + coeff(nwork) = -1.0_dp + coeff(pwork) = 1.0_dp + step_multiplier = 1.0_dp + dh = scf_control%outer_scf%jacobian_step + CASE (jacobian_fd1_backward) + nwork = -1 + pwork = 0 + ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork)) + coeff(nwork) = -1.0_dp + coeff(pwork) = 1.0_dp + step_multiplier = -1.0_dp + dh = scf_control%outer_scf%jacobian_step + CASE (jacobian_fd2) + nwork = 0 + pwork = 2 + ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork)) + coeff(0) = -3.0_dp/2.0_dp + coeff(1) = 2.0_dp + coeff(2) = -1.0_dp/2.0_dp + step_multiplier = 1.0_dp + step_multiplier(2) = 2.0_dp + dh = 2.0_dp*scf_control%outer_scf%jacobian_step + CASE (jacobian_fd2_backward) + nwork = -2 + pwork = 0 + ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork)) + coeff(0) = 3.0_dp/2.0_dp + coeff(-1) = -2.0_dp + coeff(-2) = 1.0_dp/2.0_dp + step_multiplier = -1.0_dp + step_multiplier(-2) = -2.0_dp + dh = 2.0_dp*scf_control%outer_scf%jacobian_step + CASE (jacobian_fd1_central) + nwork = -1 + pwork = 1 + ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork)) + coeff(nwork) = -1.0_dp/2.0_dp + coeff(pwork) = 1.0_dp/2.0_dp + step_multiplier = 1.0_dp + step_multiplier(nwork) = -1.0_dp + dh = 2.0_dp*scf_control%outer_scf%jacobian_step + END SELECT + DO i = 1, nvar + jacobian(i, :) = coeff(0)*scf_env%outer_scf%gradient(i, iter_count) + END DO + ! Print some info + IF (output_unit > 0) THEN + WRITE (output_unit, FMT="(/,A)") & + " ============================== CDFT SCF LOOP ==================================" + WRITE (output_unit, FMT="(A)") & + " Evaluating inverse Jacobian using finite differences" + SELECT CASE (scf_control%outer_scf%jacobian_type) + CASE (jacobian_fd1) + WRITE (output_unit, '(A)') " Type : First order forward difference" + CASE (jacobian_fd1_backward) + WRITE (output_unit, '(A)') " Type : First order backward difference" + CASE (jacobian_fd2) + WRITE (output_unit, '(A)') " Type : Second order forward difference" + CASE (jacobian_fd2_backward) + WRITE (output_unit, '(A)') " Type : Second order backward difference" + CASE (jacobian_fd1_central) + WRITE (output_unit, '(A)') " Type : First order central difference" + CASE DEFAULT + CALL cp_abort(__LOCATION__, "Unknown Jacobian type: "// & + cp_to_string(scf_control%outer_scf%jacobian_type)) + END SELECT + WRITE (output_unit, '(A,ES12.4)') " Step size : ", scf_control%outer_scf%jacobian_step + END IF + ! Calculate the Jacobian by perturbing each Lagrangian and recalculating the energy self-consistently + DO i = 1, nvar + DO iwork = nwork, pwork + IF (iwork == 0) CYCLE + scf_env%outer_scf%variables(i, iter_count+1) = scf_env%outer_scf%variables(i, iter_count)+ & + step_multiplier(iwork)* & + scf_control%outer_scf%jacobian_step + CALL outer_loop_update_qs_env(qs_env, scf_env) + CALL qs_ks_did_change(ks_env, potential_changed=.TRUE.) + CALL outer_loop_switch(scf_env, scf_control, cdft_control, cdft2ot) + CALL scf_env_do_scf(scf_env=scf_env, scf_control=scf_control, qs_env=qs_env, & + converged=converged, should_stop=should_stop) + CALL outer_loop_switch(scf_env, scf_control, cdft_control, ot2cdft) + ! Update (iter_count + 1) element of gradient + scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count+1 + CALL outer_loop_gradient(qs_env, scf_env) + scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count-1 + ! Update Jacobian + DO j = 1, nvar + jacobian(j, i) = jacobian(j, i)+coeff(iwork)*scf_env%outer_scf%gradient(j, iter_count+1) + END DO + ! Reset everything to last converged state + scf_env%outer_scf%variables(i, iter_count+1) = 0.0_dp + scf_env%outer_scf%gradient = gradient + scf_env%outer_scf%energy = energy + DO ispin = 1, nspins + CALL duplicate_mo_set(mos(ispin)%mo_set, mos_stashed(ispin)%mo_set) + IF (mos(ispin)%mo_set%use_mo_coeff_b) THEN + CALL copy_fm_to_dbcsr(mos(ispin)%mo_set%mo_coeff, & + mos(ispin)%mo_set%mo_coeff_b) + ENDIF + CALL calculate_density_matrix(mos(ispin)%mo_set, & + p_rmpv(ispin)%matrix) + END DO + CALL qs_rho_update_rho(rho, qs_env=qs_env) + CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.TRUE.) + END DO + END DO + ! Finalize and invert Jacobian + jacobian = jacobian/dh + IF (.NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) & + ALLOCATE (scf_env%outer_scf%inv_jacobian(nvar, nvar)) + inv_jacobian => scf_env%outer_scf%inv_jacobian + CALL invert_matrix(jacobian, inv_jacobian, inv_error) + ! Release temporary storage + DO ispin = 1, nspins + CALL deallocate_mo_set(mos_stashed(ispin)%mo_set) + END DO + DEALLOCATE (mos_stashed, jacobian, gradient, energy, coeff, step_multiplier) + IF (output_unit > 0) & + WRITE (output_unit, FMT="(/,A)") & + " ============================= JACOBIAN CALCULATED =============================" + END IF + CALL timestop(handle) + + END SUBROUTINE outer_loop_calculate_inverse_jacobian + END MODULE qs_scf diff --git a/src/qs_scf_initialization.F b/src/qs_scf_initialization.F index a81a170ace..96bf376f3c 100644 --- a/src/qs_scf_initialization.F +++ b/src/qs_scf_initialization.F @@ -46,7 +46,8 @@ MODULE qs_scf_initialization USE input_constants, ONLY: & broy_mix, broy_mix_new, cholesky_dbcsr, cholesky_inverse, cholesky_off, & diag_block_davidson, diag_block_krylov, diag_filter_matrix, diag_ot, diag_standard, & - direct_p_mix, kerker_mix, multisec_mix, no_mix, plus_u_lowdin, pulay_mix, & + direct_p_mix, kerker_mix, multisec_mix, no_mix, ot2cdft, outer_scf_becke_constraint, & + outer_scf_hirshfeld_constraint, outer_scf_none, plus_u_lowdin, pulay_mix, & wfi_frozen_method_nr, wfi_use_guess_method_nr USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type,& @@ -84,6 +85,7 @@ MODULE qs_scf_initialization init_mo_set,& mo_set_p_type USE qs_outer_scf, ONLY: outer_loop_extrapolate,& + outer_loop_switch,& outer_loop_variables_count USE qs_rho_atom_types, ONLY: rho_atom_type USE qs_rho_methods, ONLY: duplicate_rho_type,& @@ -169,7 +171,14 @@ CONTAINS CALL qs_scf_ensure_mixing_store(qs_env, scf_env) - CALL qs_scf_ensure_outer_loop_vars(scf_env, my_scf_control) + ! Initialize outer loop variables: handle CDFT and regular outer loop separately + dft_control%qs_control%cdft = (dft_control%qs_control%cdft .AND. my_scf_control%use_ot) + IF (dft_control%qs_control%cdft) THEN + CALL qs_scf_ensure_cdft_loop_vars(qs_env, scf_env, dft_control, & + scf_control=my_scf_control) + ELSE + CALL qs_scf_ensure_outer_loop_vars(scf_env, my_scf_control) + END IF CALL init_scf_run(scf_env, qs_env, my_scf_section, my_scf_control) @@ -281,6 +290,100 @@ CONTAINS END SUBROUTINE qs_scf_ensure_outer_loop_vars +! ************************************************************************************************** +!> \brief performs allocation of CDFT SCF variables +!> \param qs_env the qs_env where to perform the allocation +!> \param scf_env the currently active scf_env +!> \param dft_control the dft_control that holds the cdft_control type +!> \param scf_control the currently active scf_control +! ************************************************************************************************** + SUBROUTINE qs_scf_ensure_cdft_loop_vars(qs_env, scf_env, dft_control, scf_control) + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(qs_scf_env_type), POINTER :: scf_env + TYPE(dft_control_type), POINTER :: dft_control + TYPE(scf_control_type), POINTER :: scf_control + + CHARACTER(len=*), PARAMETER :: routineN = 'qs_scf_ensure_cdft_loop_vars', & + routineP = moduleN//':'//routineN + + INTEGER :: nhistory, nvariables + LOGICAL :: do_kpoints + REAL(KIND=dp), DIMENSION(:, :), POINTER :: outer_scf_history + + CALL get_qs_env(qs_env=qs_env, do_kpoints=do_kpoints) + ! Check only one constraint section is active + IF (dft_control%qs_control%becke_restraint .AND. & + dft_control%qs_control%cdft_control%type == outer_scf_hirshfeld_constraint) & + CPABORT("Only one constraint can be active simultaneously") + ! Test kpoints + IF (do_kpoints) & + CPABORT("CDFT calculation not possible with kpoints") + ! Initialize CDFT and outer_loop variables (constraint settings active in scf_control) + IF (dft_control%qs_control%cdft_control%constraint_control%have_scf) THEN + nhistory = dft_control%qs_control%cdft_control%constraint_control%max_scf+1 + IF (scf_control%outer_scf%type /= outer_scf_none) THEN + nvariables = outer_loop_variables_count(scf_control, & + dft_control%qs_control%cdft_control) + ELSE + ! First iteration: scf_control has not yet been updated + SELECT CASE (dft_control%qs_control%cdft_control%type) + CASE (outer_scf_becke_constraint) + nvariables = SIZE(dft_control%qs_control%becke_control%target) + CASE (outer_scf_hirshfeld_constraint) + nvariables = SIZE(dft_control%qs_control%cdft_control%target) + END SELECT + END IF + ALLOCATE (dft_control%qs_control%cdft_control%constraint%variables(nvariables, nhistory)) + ALLOCATE (dft_control%qs_control%cdft_control%constraint%count(nhistory)) + dft_control%qs_control%cdft_control%constraint%count = 0 + ALLOCATE (dft_control%qs_control%cdft_control%constraint%gradient(nvariables, nhistory)) + ALLOCATE (dft_control%qs_control%cdft_control%constraint%energy(nhistory)) + CALL qs_scf_ensure_outer_loop_vars(scf_env, scf_control) + ENDIF + ! Executed only on first call (OT settings active in scf_control) + ! Save OT settings and constraint initial values in CDFT control + ! Then switch to constraint outer_scf settings for proper initialization of history + NULLIFY (outer_scf_history) + IF (scf_control%outer_scf%have_scf) THEN + IF (scf_control%outer_scf%type == outer_scf_none) THEN + dft_control%qs_control%cdft_control%ot_control%have_scf = .TRUE. + dft_control%qs_control%cdft_control%ot_control%max_scf = scf_control%outer_scf%max_scf + dft_control%qs_control%cdft_control%ot_control%eps_scf = scf_control%outer_scf%eps_scf + dft_control%qs_control%cdft_control%ot_control%step_size = scf_control%outer_scf%step_size + dft_control%qs_control%cdft_control%ot_control%type = scf_control%outer_scf%type + dft_control%qs_control%cdft_control%ot_control%optimizer = scf_control%outer_scf%optimizer + dft_control%qs_control%cdft_control%ot_control%diis_buffer_length = scf_control%outer_scf%diis_buffer_length + dft_control%qs_control%cdft_control%ot_control%jacobian_type = scf_control%outer_scf%jacobian_type + dft_control%qs_control%cdft_control%ot_control%bisect_trust_count = scf_control%outer_scf%bisect_trust_count + nvariables = 1 + ! Constraint specific initializations + IF (dft_control%qs_control%becke_restraint) THEN + nvariables = SIZE(dft_control%qs_control%becke_control%target) + IF (.NOT. ASSOCIATED(dft_control%qs_control%cdft_control%target)) & + ALLOCATE (dft_control%qs_control%cdft_control%target(nvariables)) + IF (.NOT. ASSOCIATED(dft_control%qs_control%cdft_control%value)) & + ALLOCATE (dft_control%qs_control%cdft_control%value(nvariables)) + IF (.NOT. ASSOCIATED(dft_control%qs_control%cdft_control%strength)) & + ALLOCATE (dft_control%qs_control%cdft_control%strength(nvariables)) + dft_control%qs_control%cdft_control%target = dft_control%qs_control%becke_control%target + dft_control%qs_control%cdft_control%constraint_type = dft_control%qs_control%becke_control%constraint_type + dft_control%qs_control%cdft_control%combined_type = dft_control%qs_control%becke_control%combined_type + END IF + ! In case constraint and ot extrapolation orders are different, make sure to use former + IF (scf_control%outer_scf%extrapolation_order /= & + dft_control%qs_control%cdft_control%constraint_control%extrapolation_order & + .OR. nvariables == 2) THEN + DEALLOCATE (qs_env%outer_scf_history) + nhistory = dft_control%qs_control%cdft_control%constraint_control%extrapolation_order + ALLOCATE (outer_scf_history(nvariables, nhistory)) + CALL set_qs_env(qs_env, outer_scf_history=outer_scf_history) + END IF + CALL outer_loop_switch(scf_env, scf_control, dft_control%qs_control%cdft_control, ot2cdft) + END IF + END IF + + END SUBROUTINE qs_scf_ensure_cdft_loop_vars + ! ************************************************************************************************** !> \brief performs allocation of the mixing storage !> \param qs_env ... diff --git a/src/qs_scf_loop_utils.F b/src/qs_scf_loop_utils.F index a94f740846..425920911d 100644 --- a/src/qs_scf_loop_utils.F +++ b/src/qs_scf_loop_utils.F @@ -480,8 +480,9 @@ CONTAINS outer_loop_converged = .FALSE. CALL outer_loop_gradient(qs_env, scf_env) - outer_loop_eps = SQRT(SUM(scf_env%outer_scf%gradient(:, scf_env%outer_scf%iter_count)**2))/ & - SIZE(scf_env%outer_scf%gradient, 1) + ! Multiple constraints: get largest deviation + outer_loop_eps = SQRT(MAXVAL(scf_env%outer_scf%gradient(:, scf_env%outer_scf%iter_count)**2)) + IF (outer_loop_eps < scf_control%outer_scf%eps_scf) outer_loop_converged = .TRUE. END IF diff --git a/src/qs_scf_output.F b/src/qs_scf_output.F index 0aa2f39081..7a5237c23b 100644 --- a/src/qs_scf_output.F +++ b/src/qs_scf_output.F @@ -5,7 +5,8 @@ MODULE qs_scf_output USE atomic_kind_types, ONLY: atomic_kind_type - USE cp_control_types, ONLY: dft_control_type + USE cp_control_types, ONLY: cdft_control_type,& + dft_control_type USE cp_dbcsr_output, ONLY: cp_dbcsr_write_sparse_matrix USE cp_log_handling, ONLY: cp_get_default_logger,& cp_logger_type @@ -16,6 +17,13 @@ MODULE qs_scf_output USE cp_para_types, ONLY: cp_para_env_type USE cp_units, ONLY: cp_unit_from_cp2k USE dbcsr_api, ONLY: dbcsr_p_type + USE input_constants, ONLY: & + becke_cavity_conf, becke_cutoff_element, becke_cutoff_global, becke_dynamic_conf, & + becke_mixed_conf, becke_none_conf, becke_static_conf, cdft_combined_acceptor, & + cdft_combined_all, cdft_combined_constraint, cdft_combined_donor, cdft_density_constraint, & + cdft_magnetization_constraint, outer_scf_becke_constraint, outer_scf_hirshfeld_constraint, & + outer_scf_optimizer_bisect, outer_scf_optimizer_broyden, outer_scf_optimizer_diis, & + outer_scf_optimizer_sd, radius_covalent, radius_single, radius_user, radius_vdw USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type,& section_vals_val_get @@ -60,7 +68,9 @@ MODULE qs_scf_output qs_scf_loop_print, & qs_scf_outer_loop_info, & qs_scf_initial_info, & - qs_scf_write_mos + qs_scf_write_mos, & + qs_scf_cdft_info, & + qs_scf_cdft_initial_info CONTAINS @@ -191,8 +201,7 @@ CONTAINS REAL(KIND=dp) :: outer_loop_eps - outer_loop_eps = SQRT(SUM(scf_env%outer_scf%gradient(:, scf_env%outer_scf%iter_count)**2))/ & - SIZE(scf_env%outer_scf%gradient, 1) + outer_loop_eps = SQRT(MAXVAL(scf_env%outer_scf%gradient(:, scf_env%outer_scf%iter_count)**2)) IF (output_unit > 0) WRITE (output_unit, '(/,T3,A,I4,A,E10.2,A,F22.10)') & "outer SCF iter = ", scf_env%outer_scf%iter_count, & " RMS gradient = ", outer_loop_eps, " energy =", energy%total @@ -604,4 +613,265 @@ CONTAINS END SUBROUTINE qs_scf_loop_print +! ************************************************************************************************** +!> \brief writes CDFT constraint information and optionally CDFT scf loop info +!> \param output_unit where to write the information +!> \param scf_control settings of the SCF loop +!> \param scf_env the env which holds convergence data +!> \param cdft_control the env which holds information about the constraint +!> \param energy the total energy +!> \param total_steps the total number of performed SCF iterations +!> \param should_stop if the calculation should stop +!> \param outer_loop_converged logical which determines if the CDFT SCF loop converged +!> \param cdft_loop logical which determines a CDFT SCF loop is active +!> \par History +!> 12.2015 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE qs_scf_cdft_info(output_unit, scf_control, scf_env, cdft_control, & + energy, total_steps, should_stop, outer_loop_converged, & + cdft_loop) + INTEGER :: output_unit + TYPE(scf_control_type), POINTER :: scf_control + TYPE(qs_scf_env_type), POINTER :: scf_env + TYPE(cdft_control_type), POINTER :: cdft_control + TYPE(qs_energy_type), POINTER :: energy + INTEGER :: total_steps + LOGICAL, INTENT(IN) :: should_stop, outer_loop_converged, & + cdft_loop + + CHARACTER(LEN=*), PARAMETER :: routineN = 'qs_scf_cdft_info', & + routineP = moduleN//':'//routineN + + REAL(KIND=dp) :: outer_loop_eps + + IF (cdft_loop) THEN + outer_loop_eps = SQRT(MAXVAL(scf_env%outer_scf%gradient(:, scf_env%outer_scf%iter_count)**2)) + IF (output_unit > 0) WRITE (output_unit, '(/,T3,A,I4,A,E10.2,A,F22.10)') & + "CDFT SCF iter = ", scf_env%outer_scf%iter_count, & + " RMS gradient = ", outer_loop_eps, " energy =", energy%total + IF (outer_loop_converged) THEN + IF (output_unit > 0) WRITE (output_unit, '(T3,A,I4,A,I4,A,/)') & + "CDFT SCF loop converged in", scf_env%outer_scf%iter_count, & + " iterations or ", total_steps, " steps" + END IF + IF ((scf_env%outer_scf%iter_count > scf_control%outer_scf%max_scf .OR. should_stop) & + .AND. .NOT. outer_loop_converged) THEN + IF (output_unit > 0) WRITE (output_unit, '(T3,A,I4,A,I4,A,/)') & + "CDFT SCF loop FAILED to converge after ", & + scf_env%outer_scf%iter_count, " iterations or ", total_steps, " steps" + END IF + END IF + IF (output_unit > 0) THEN + SELECT CASE (cdft_control%type) + CASE (outer_scf_hirshfeld_constraint) + WRITE (output_unit, '(/,T3,A,T60)') & + '------------------- Hirshfeld constraint information -------------------' + CASE (outer_scf_becke_constraint) + WRITE (output_unit, '(/,T3,A,T60)') & + '--------------------- Becke constraint information ---------------------' + END SELECT + SELECT CASE (cdft_control%constraint_type) + CASE (cdft_density_constraint, cdft_magnetization_constraint) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Target value of constraint :', cdft_control%target(1) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Current value of constraint :', cdft_control%value(1) + WRITE (output_unit, '(T3,A,T59,(3X,ES13.3))') & + 'Deviation from target :', cdft_control%value(1)-cdft_control%target(1) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Strength of constraint :', cdft_control%strength(1) + CASE (cdft_combined_constraint) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Target value of charge constraint :', cdft_control%target(1) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Target value of spin constraint :', cdft_control%target(2) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Current value of charge constraint:', cdft_control%value(1) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Current value of spin constraint :', cdft_control%value(2) + WRITE (output_unit, '(T3,A,T59,(3X,ES13.3))') & + 'Deviation from target (charge) :', cdft_control%value(1)-cdft_control%target(1) + WRITE (output_unit, '(T3,A,T59,(3X,ES13.3))') & + 'Deviation from target (spin) :', cdft_control%value(2)-cdft_control%target(2) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Strength of constraint (charge) :', cdft_control%strength(1) + WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & + 'Strength of constraint (spin) :', cdft_control%strength(2) + END SELECT + WRITE (output_unit, '(T3,A)') & + '------------------------------------------------------------------------' + END IF + END SUBROUTINE qs_scf_cdft_info + +! ************************************************************************************************** +!> \brief writes information about the CDFT env +!> \param output_unit where to write the information +!> \param cdft_control the CDFT env that stores information about the constraint calculation +!> \param dft_control container for Becke constraint related information +!> \par History +!> 12.2015 created [Nico Holmberg] +! ************************************************************************************************** + SUBROUTINE qs_scf_cdft_initial_info(output_unit, cdft_control, dft_control) + INTEGER :: output_unit + TYPE(cdft_control_type), POINTER :: cdft_control + TYPE(dft_control_type), POINTER :: dft_control + + CHARACTER(LEN=*), PARAMETER :: routineN = 'qs_scf_cdft_initial_info', & + routineP = moduleN//':'//routineN + + CHARACTER, DIMENSION(3) :: dir = (/"x", "y", "z"/) + + IF (output_unit > 0) THEN + WRITE (output_unit, '(/,A)') & + " ---------------------------------- CDFT --------------------------------------" + SELECT CASE (cdft_control%constraint_type) + CASE (cdft_density_constraint) + WRITE (output_unit, '(A)') & + " Optimizing charge density constraint in an external SCF loop " + CASE (cdft_magnetization_constraint) + WRITE (output_unit, '(A)') & + " Optimizing magnetization density constraint in an external SCF loop " + CASE (cdft_combined_constraint) + WRITE (output_unit, '(A)') & + " Optimizing combined charge-spin constraint in an external SCF loop " + SELECT CASE (cdft_control%combined_type) + CASE (cdft_combined_all) + WRITE (output_unit, '(A)') & + " spin constraint defined on all constraint atoms " + CASE (cdft_combined_acceptor) + WRITE (output_unit, '(A)') & + " spin constraint defined on acceptor constraint atoms " + CASE (cdft_combined_donor) + WRITE (output_unit, '(A)') & + " spin constraint defined on donor constraint atoms " + END SELECT + END SELECT + SELECT CASE (cdft_control%constraint_control%optimizer) + CASE (outer_scf_optimizer_sd) + WRITE (output_unit, '(A)') & + " Minimizer : SD : steepest descent" + CASE (outer_scf_optimizer_broyden) + WRITE (output_unit, '(A)') & + " Minimizer : Broyden : Broyden's method" + CASE (outer_scf_optimizer_diis) + WRITE (output_unit, '(A)') & + " Minimizer : DIIS : direct inversion" + WRITE (output_unit, '(A)') & + " in the iterative subspace" + WRITE (output_unit, '(A,I3,A)') & + " using ", & + cdft_control%constraint_control%diis_buffer_length, " DIIS vectors" + CASE (outer_scf_optimizer_bisect) + WRITE (output_unit, '(A)') & + " Minimizer : BISECT : gradient bisection" + WRITE (output_unit, '(A,I3)') & + " using a trust count of", & + cdft_control%constraint_control%bisect_trust_count + END SELECT + SELECT CASE (cdft_control%type) + CASE (outer_scf_hirshfeld_constraint) + WRITE (output_unit, '(A)') " Type of constraint : Hirshfeld" + CASE (outer_scf_becke_constraint) + WRITE (output_unit, '(A)') " Type of constraint : Becke" + WRITE (output_unit, '(A)') " " + SELECT CASE (dft_control%qs_control%becke_control%cutoff_type) + CASE (becke_cutoff_global) + WRITE (output_unit, '(A,F8.3,A)') & + " Cutoff for partitioning :", cp_unit_from_cp2k(dft_control%qs_control%becke_control%rglobal, & + "angstrom"), " angstrom" + CASE (becke_cutoff_element) + WRITE (output_unit, '(A)') & + " Using element specific cutoffs for partitioning" + END SELECT + WRITE (output_unit, '(A,L7)') & + " Skipping distant gpoints: ", dft_control%qs_control%becke_control%should_skip + WRITE (output_unit, '(A,L7)') & + " Precompute gradients : ", dft_control%qs_control%becke_control%in_memory + WRITE (output_unit, '(A,L7)') & + " Using fragment densities: ", dft_control%qs_control%becke_control%fragment_density + WRITE (output_unit, '(A)') " " + WRITE (output_unit, '(A,L7)') & + " Reusing preconditioner : ", dft_control%qs_control%cdft_control%reuse_precond + IF (dft_control%qs_control%cdft_control%reuse_precond) THEN + WRITE (output_unit, '(A,I3,A,I3,A)') & + " using old preconditioner for upto ", & + cdft_control%max_reuse, " subsequent CDFT SCF" + WRITE (output_unit, '(A,I3,A,I3,A)') & + " iterations if the relevant loop converged in less than ", & + cdft_control%precond_freq, " steps" + END IF + WRITE (output_unit, '(A)') " " + IF (dft_control%qs_control%becke_control%atomic_charges) & + WRITE (output_unit, '(A)') & + " Calculating atomic Becke charges" + IF (dft_control%qs_control%becke_control%adjust) & + WRITE (output_unit, '(A)') & + " Using atomic radii to generate a heteronuclear charge partitioning" + WRITE (output_unit, '(A)') " " + SELECT CASE (dft_control%qs_control%becke_control%confine_method) + CASE (becke_none_conf) + WRITE (output_unit, '(A)') & + " No confinement is active" + CASE (becke_static_conf) + WRITE (output_unit, '(A,A3,A)') & + " Static confinement is active along ", & + dir(dft_control%qs_control%becke_control%confine_dir), " axis" + WRITE (output_unit, '(A,F8.4,F8.4)') & + " Confinement bounds : ", dft_control%qs_control%becke_control%confine_bounds(1), & + dft_control%qs_control%becke_control%confine_bounds(2) + CASE (becke_dynamic_conf) + WRITE (output_unit, '(A,A3,A,F8.4)') & + " Dynamic confinement is active along ", dir(dft_control%qs_control%becke_control%confine_dir), & + " axis using a radius of ", dft_control%qs_control%becke_control%dynamic_radius + CASE (becke_cavity_conf) + WRITE (output_unit, '(A)') " Confinement using a Gaussian shaped cavity is active" + SELECT CASE (dft_control%qs_control%becke_control%cavity_shape) + CASE (radius_single) + WRITE (output_unit, '(A,F8.4, A)') & + " Type of Gaussian : Fixed radius: ", & + cp_unit_from_cp2k(dft_control%qs_control%becke_control%rcavity, "angstrom"), " angstrom" + CASE (radius_covalent) + WRITE (output_unit, '(A)') & + " Type of Gaussian : Covalent radius " + CASE (radius_vdw) + WRITE (output_unit, '(A)') & + " Type of Gaussian : vdW radius " + CASE (radius_user) + WRITE (output_unit, '(A)') & + " Type of Gaussian : User radius " + END SELECT + WRITE (output_unit, '(A,ES12.4)') & + " Cavity threshold : ", dft_control%qs_control%becke_control%eps_cavity + CASE (becke_mixed_conf) + WRITE (output_unit, '(A)') & + " Mixed confinement is active" + WRITE (output_unit, '(A,A3,A,F8.4)') & + " Dynamic confinement is active along ", dir(dft_control%qs_control%becke_control%confine_dir), & + " axis using a radius of ", dft_control%qs_control%becke_control%dynamic_radius + WRITE (output_unit, '(A)') " Confinement using a Gaussian shaped cavity is active" + SELECT CASE (dft_control%qs_control%becke_control%cavity_shape) + CASE (radius_single) + WRITE (output_unit, '(A,F8.4,A)') & + " Type of Gaussian : Fixed radius: ", & + cp_unit_from_cp2k(dft_control%qs_control%becke_control%rcavity, "angstrom"), " angstrom" + CASE (radius_covalent) + WRITE (output_unit, '(A)') & + " Type of Gaussian : Covalent radius " + CASE (radius_vdw) + WRITE (output_unit, '(A)') & + " Type of Gaussian : vdW radius " + CASE (radius_user) + WRITE (output_unit, '(A)') & + " Type of Gaussian : User radius " + END SELECT + WRITE (output_unit, '(A,ES12.4)') & + " Cavity threshold : ", dft_control%qs_control%becke_control%eps_cavity + END SELECT + END SELECT + WRITE (output_unit, '(/,A)') & + " ---------------------------------- CDFT --------------------------------------" + END IF + + END SUBROUTINE qs_scf_cdft_initial_info + END MODULE qs_scf_output diff --git a/src/qs_scf_post_gpw.F b/src/qs_scf_post_gpw.F index 65264d5114..9d27a5d7ea 100644 --- a/src/qs_scf_post_gpw.F +++ b/src/qs_scf_post_gpw.F @@ -74,6 +74,8 @@ MODULE qs_scf_post_gpw do_loc_homo,& do_loc_lumo,& ot_precond_full_all,& + radius_covalent,& + radius_user,& ref_charge_atomic,& ref_charge_mulliken USE input_section_types, ONLY: section_get_ival,& @@ -2819,10 +2821,10 @@ CONTAINS END SUBROUTINE write_mo_free_results ! ************************************************************************************************** -!> \brief ... -!> \param qs_env ... -!> \param input_section ... -!> \param unit_nr ... +!> \brief Calculates Hirshfeld charges +!> \param qs_env the qs_env where to calculate the charges +!> \param input_section the input section for Hirshfeld charges +!> \param unit_nr the output unit number ! ************************************************************************************************** SUBROUTINE hirshfeld_charges(qs_env, input_section, unit_nr) TYPE(qs_environment_type), POINTER :: qs_env @@ -2833,10 +2835,11 @@ CONTAINS routineP = moduleN//':'//routineN INTEGER :: i, iat, ikind, natom, nkind, nspin, & - refc, shapef + radius_type, refc, shapef INTEGER, DIMENSION(:), POINTER :: atom_list - LOGICAL :: do_sc, paw_atom + LOGICAL :: do_radius, do_sc, paw_atom REAL(KIND=dp) :: zeff + REAL(KIND=dp), DIMENSION(:), POINTER :: radii REAL(KIND=dp), DIMENSION(:, :), POINTER :: charges TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(atomic_kind_type), POINTER :: atomic_kind @@ -2851,19 +2854,33 @@ CONTAINS TYPE(rho0_mpole_type), POINTER :: rho0_mpole NULLIFY (hirshfeld_env) + NULLIFY (radii) CALL create_hirshfeld_type(hirshfeld_env) ! CALL get_qs_env(qs_env, nkind=nkind, natom=natom) ALLOCATE (hirshfeld_env%charges(natom)) ! input options CALL section_vals_val_get(input_section, "SELF_CONSISTENT", l_val=do_sc) + CALL section_vals_val_get(input_section, "USER_RADIUS", l_val=do_radius) CALL section_vals_val_get(input_section, "SHAPE_FUNCTION", i_val=shapef) CALL section_vals_val_get(input_section, "REFERENCE_CHARGE", i_val=refc) + IF (do_radius) THEN + radius_type = radius_user + CALL section_vals_val_get(input_section, "ATOMIC_RADII", r_vals=radii) + IF (.NOT. SIZE(radii) == nkind) & + CALL cp_abort(__LOCATION__, & + "Length of keyword HIRSHFELD\ATOMIC_RADII does not "// & + "match number of atomic kinds in the input coordinate file.") + ELSE + radius_type = radius_covalent + END IF CALL set_hirshfeld_info(hirshfeld_env, shape_function_type=shapef, & - iterative=do_sc, ref_charge=refc) + iterative=do_sc, ref_charge=refc, & + radius_type=radius_type) ! shape function CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, atomic_kind_set=atomic_kind_set) - CALL create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set) + CALL create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set, & + radii_list=radii) ! reference charges CALL get_qs_env(qs_env, rho=rho) CALL qs_rho_get(rho, rho_ao_kp=matrix_p) diff --git a/src/qs_scf_types.F b/src/qs_scf_types.F index 97f4951876..74cf15cb77 100644 --- a/src/qs_scf_types.F +++ b/src/qs_scf_types.F @@ -78,6 +78,7 @@ MODULE qs_scf_types REAL(KIND=dp), DIMENSION(:), POINTER :: energy REAL(KIND=dp), DIMENSION(:, :), POINTER :: variables REAL(KIND=dp), DIMENSION(:, :), POINTER :: gradient + REAL(KIND=dp), DIMENSION(:, :), POINTER :: inv_jacobian INTEGER, DIMENSION(:), POINTER :: count END TYPE qs_outer_scf_type @@ -171,6 +172,7 @@ CONTAINS NULLIFY (scf_env%outer_scf%gradient) NULLIFY (scf_env%outer_scf%energy) NULLIFY (scf_env%outer_scf%count) + NULLIFY (scf_env%outer_scf%inv_jacobian) NULLIFY (scf_env%scf_work1) NULLIFY (scf_env%scf_work2) NULLIFY (scf_env%ortho) @@ -329,6 +331,9 @@ CONTAINS IF (ASSOCIATED(scf_env%outer_scf%gradient)) THEN DEALLOCATE (scf_env%outer_scf%gradient) END IF + IF (ASSOCIATED(scf_env%outer_scf%inv_jacobian)) THEN + DEALLOCATE (scf_env%outer_scf%inv_jacobian) + END IF IF (ASSOCIATED(scf_env%outer_scf%energy)) THEN DEALLOCATE (scf_env%outer_scf%energy) END IF diff --git a/src/qs_wf_history_methods.F b/src/qs_wf_history_methods.F index bf2e45bd41..9f44d3ac16 100644 --- a/src/qs_wf_history_methods.F +++ b/src/qs_wf_history_methods.F @@ -67,7 +67,8 @@ MODULE qs_wf_history_methods RECIPROCALSPACE,& pw_p_type USE qs_environment_types, ONLY: get_qs_env,& - qs_environment_type + qs_environment_type,& + set_qs_env USE qs_ks_types, ONLY: qs_ks_did_change USE qs_matrix_pools, ONLY: mpools_get,& qs_matrix_pools_type @@ -86,7 +87,8 @@ MODULE qs_wf_history_methods qs_scf_env_type USE qs_wf_history_types, ONLY: qs_wf_history_type,& qs_wf_snapshot_type,& - wfi_get_snapshot + wfi_get_snapshot,& + wfi_release USE scf_control_types, ONLY: scf_control_type #include "./base/base_uses.f90" @@ -99,7 +101,7 @@ MODULE qs_wf_history_methods PUBLIC :: wfi_create, wfi_update, wfi_create_for_kp, & wfi_extrapolate, wfi_get_method_label, & - reorthogonalize_vectors + reorthogonalize_vectors, wfi_purge_history CONTAINS @@ -1076,4 +1078,64 @@ CONTAINS CALL timestop(handle) END SUBROUTINE reorthogonalize_vectors +! ************************************************************************************************** +!> \brief purges wf_history retaining only the latest snapshot +!> \param qs_env the qs env with the latest result, and that will contain +!> the purged wf_history +!> \par History +!> 05.2016 created [Nico Holmberg] +!> \author Nico Holmberg +! ************************************************************************************************** + SUBROUTINE wfi_purge_history(qs_env) + TYPE(qs_environment_type), POINTER :: qs_env + + CHARACTER(len=*), PARAMETER :: routineN = 'wfi_purge_history', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, output_unit, print_level + TYPE(cp_logger_type), POINTER :: logger + TYPE(dft_control_type), POINTER :: dft_control + TYPE(qs_wf_history_type), POINTER :: wf_history + + NULLIFY (dft_control, wf_history) + + CALL timeset(routineN, handle) + logger => cp_get_default_logger() + print_level = logger%iter_info%print_level + output_unit = cp_print_key_unit_nr(logger, qs_env%input, "DFT%SCF%PRINT%PROGRAM_RUN_INFO", & + extension=".scfLog") + + CPASSERT(ASSOCIATED(qs_env)) + CPASSERT(qs_env%ref_count > 0) + CPASSERT(ASSOCIATED(qs_env%wf_history)) + CPASSERT(qs_env%wf_history%ref_count > 0) + CALL get_qs_env(qs_env, dft_control=dft_control) + + SELECT CASE (qs_env%wf_history%interpolation_method_nr) + CASE (wfi_use_guess_method_nr, wfi_use_prev_wf_method_nr, & + wfi_use_prev_p_method_nr, wfi_use_prev_rho_r_method_nr, & + wfi_frozen_method_nr) + ! do nothing + CASE (wfi_linear_wf_method_nr, wfi_linear_p_method_nr, & + wfi_linear_ps_method_nr, wfi_ps_method_nr, & + wfi_aspc_nr) + IF (qs_env%wf_history%snapshot_count .GE. 2) THEN + IF (debug_this_module .AND. output_unit > 0) & + WRITE (output_unit, FMT="(T2,A)") "QS| Purging WFN history" + CALL wfi_create(wf_history, interpolation_method_nr= & + dft_control%qs_control%wf_interpolation_method_nr, & + extrapolation_order=dft_control%qs_control%wf_extrapolation_order, & + has_unit_metric=qs_env%has_unit_metric) + CALL set_qs_env(qs_env=qs_env, & + wf_history=wf_history) + CALL wfi_release(wf_history) + CALL wfi_update(qs_env%wf_history, qs_env=qs_env, dt=1.0_dp) + END IF + CASE DEFAULT + CPABORT("Unknown extrapolation method.") + END SELECT + CALL timestop(handle) + + END SUBROUTINE wfi_purge_history + END MODULE qs_wf_history_methods diff --git a/src/scf_control_types.F b/src/scf_control_types.F index 07804a5f3a..193f606695 100644 --- a/src/scf_control_types.F +++ b/src/scf_control_types.F @@ -23,8 +23,9 @@ MODULE scf_control_types atomic_guess, core_guess, diag_ot, direct_p_mix, general_roks, high_spin_roks, & ot_algo_taylor_or_diag, outer_scf_basis_center_opt, outer_scf_becke_constraint, & outer_scf_ddapc_constraint, outer_scf_none, outer_scf_optimizer_bisect, & - outer_scf_optimizer_diis, outer_scf_optimizer_none, outer_scf_optimizer_sd, & - outer_scf_s2_constraint, smear_energy_window, smear_fermi_dirac, smear_list + outer_scf_optimizer_broyden, outer_scf_optimizer_diis, outer_scf_optimizer_newton, & + outer_scf_optimizer_none, outer_scf_optimizer_sd, outer_scf_s2_constraint, & + smear_energy_window, smear_fermi_dirac, smear_list USE input_cp2k_dft, ONLY: create_scf_section USE input_enumeration_types, ONLY: enum_i2c,& enumeration_type @@ -80,6 +81,10 @@ MODULE scf_control_types !> \param id_nr unique number to identify an scf control !> \param ref_count reference count (see cp2k/doc/ReferenceCounting.html) !> \param added_mos additional number of MOs that might be used in the SCF +!> \param build_jacobian logical which determines if the inverse Jacobian should be computed +!> \param step_size the optimizer step size +!> \param jacobian_step the step size for calculating the finite difference Jacobian +!> \param jacobian_type the finite difference scheme to compute the Jacobian !> \par History !> 09.2002 created [fawzi] !> \author Fawzi Mohamed @@ -87,13 +92,16 @@ MODULE scf_control_types TYPE outer_scf_control_type LOGICAL :: have_scf + LOGICAL :: build_jacobian INTEGER :: max_scf - REAL(KIND=dp) :: eps_scf, step_size + REAL(KIND=dp) :: eps_scf, step_size, & + jacobian_step INTEGER :: TYPE INTEGER :: optimizer INTEGER :: diis_buffer_length INTEGER :: extrapolation_order INTEGER :: bisect_trust_count + INTEGER :: jacobian_type END TYPE outer_scf_control_type TYPE smear_type @@ -259,6 +267,9 @@ CONTAINS scf_control%outer_scf%type = -1 scf_control%outer_scf%optimizer = -1 scf_control%outer_scf%diis_buffer_length = -1 + scf_control%outer_scf%jacobian_type = -1 + scf_control%outer_scf%jacobian_step = 0.0_dp + scf_control%outer_scf%build_jacobian = .FALSE. ! Smearing of the MO occupations @@ -494,6 +505,10 @@ CONTAINS i_val=scf_control%outer_scf%max_scf) CALL section_vals_val_get(outer_scf_section, "EXTRAPOLATION_ORDER", & i_val=scf_control%outer_scf%extrapolation_order) + CALL section_vals_val_get(outer_scf_section, "JACOBIAN_TYPE", & + i_val=scf_control%outer_scf%jacobian_type) + CALL section_vals_val_get(outer_scf_section, "JACOBIAN_STEP", & + r_val=scf_control%outer_scf%jacobian_step) END IF smear_section => section_vals_get_subs_vals(scf_section, "SMEAR") @@ -738,6 +753,10 @@ CONTAINS WRITE (output_unit, '(T25,A)') "DIIS optimization" WRITE (output_unit, '(T25,A,T72,I9)') "DIIS buffer length", & scf_control%outer_scf%diis_buffer_length + CASE (outer_scf_optimizer_broyden) + WRITE (output_unit, '(T25,A)') "Optimization with Broyden's method" + CASE (outer_scf_optimizer_newton) + WRITE (output_unit, '(T25,A)') "Optimization with Newton's method" CASE DEFAULT CPABORT("") END SELECT diff --git a/tests/QS/regtest-cdft-1/TEST_FILES b/tests/QS/regtest-cdft-1/TEST_FILES new file mode 100644 index 0000000000..62479d1aae --- /dev/null +++ b/tests/QS/regtest-cdft-1/TEST_FILES @@ -0,0 +1,16 @@ +# runs are executed in the same order as in this file +# the second field tells which test should be run in order to compare with the last available output +# see regtest/TEST_FILES +# +water-noconstraint.inp 1 1e-13 -17.09794893929815 +# These tests give identical value of constraint +water-cdft-1.inp 71 1e-12 7.979480462990 +water-cdft-2.inp 71 1e-12 7.979480462990 +water-cdft-3.inp 71 1e-12 7.979480462990 +water-cdft-4.inp 71 1e-12 7.979480462990 +water-cdft-5.inp 71 1e-12 7.979480462990 +water-cdft-6.inp 71 1e-12 7.979480462990 +# The constraint value differs because the confinement is too tight +water-cdft-7.inp 71 1e-12 7.894206878787 +water-cdft-8.inp 71 1e-12 7.979416440315 +#EOF diff --git a/tests/QS/regtest-cdft-1/TEST_FILES_RESET b/tests/QS/regtest-cdft-1/TEST_FILES_RESET new file mode 100644 index 0000000000..3734215b96 --- /dev/null +++ b/tests/QS/regtest-cdft-1/TEST_FILES_RESET @@ -0,0 +1,3 @@ +# +# add files to be reset here +# \ No newline at end of file diff --git a/tests/QS/regtest-cdft-1/becke_qs.inc b/tests/QS/regtest-cdft-1/becke_qs.inc new file mode 100644 index 0000000000..3434d812be --- /dev/null +++ b/tests/QS/regtest-cdft-1/becke_qs.inc @@ -0,0 +1,73 @@ +&QS + METHOD GPW + EPS_DEFAULT 1.0E-12 + MAP_CONSISTENT + EXTRAPOLATION ASPC + EXTRAPOLATION_ORDER 3 + &CDFT + TYPE_OF_CONSTRAINT BECKE + &OUTER_SCF ON + EPS_SCF 1.0e-0 + TYPE BECKE_CONSTRAINT + OPTIMIZER BISECT + BISECT_TRUST_COUNT 8 + EXTRAPOLATION_ORDER 2 + MAX_SCF 0 + STEP_SIZE -0.1 + &END + &END CDFT + &BECKE_RESTRAINT + @IF ( ${BECKE_ADJUST_SIZE} == TRUE ) + ! Defaults to false + ADJUST_SIZE TRUE + ATOMIC_RADII 0.630 0.320 + @ENDIF + @IF ( ${BECKE_ATOMIC_CHARGES} == TRUE ) + ! Defaults to false + ATOMIC_CHARGES TRUE + @ENDIF + STRENGTH ${BECKE_STR} + TARGET ${BECKE_TARGET} + @IF ( ${BECKE_CUTOFF_ELEMENT} == TRUE ) + CUTOFF_TYPE ELEMENT + ! Note these values are in angstrom + ELEMENT_CUTOFF 2.0 2.0 + @ENDIF + @IF ( ${BECKE_GLOBAL_CUTOFF} == TRUE ) + CUTOFF_TYPE GLOBAL + GLOBAL_CUTOFF 2.0 + @ENDIF + @IF ( ${BECKE_IN_MEMORY} == TRUE ) + ! Defaults to false + IN_MEMORY TRUE + @ENDIF + @IF ( ${BECKE_CAVITY_CONFINE} == TRUE ) + ! Defaults to NONE + CONFINE CAVITY + EPS_CAVITY 1.0E-6 + CAVITY_SHAPE ${BECKE_CAVITY_SHAPE} + ! For shape single + CAVITY_RADIUS 1.3 + CAVITY_USE_BOHR FALSE + @ENDIF + @IF ( ${BECKE_SHOULD_SKIP} == TRUE ) + ! Defaults to false + SHOULD_SKIP TRUE + @ENDIF + @IF ( ${BECKE_CAVITY_PRINT} == TRUE ) + ! Defaults to false + CAVITY_PRINT TRUE + @ENDIF + ATOMS 1..3 + COEFF 1 1 1 + CONSTRAINT_TYPE TOTAL + &PROGRAM_RUN_INFO ON + &EACH + QS_SCF 1 + &END EACH + COMMON_ITERATION_LEVELS 2 + ADD_LAST NUMERIC + FILENAME ./${PROJECT_NAME} + &END PROGRAM_RUN_INFO + &END BECKE_RESTRAINT +&END QS diff --git a/tests/QS/regtest-cdft-1/dft-common-params.inc b/tests/QS/regtest-cdft-1/dft-common-params.inc new file mode 100644 index 0000000000..6a0a421758 --- /dev/null +++ b/tests/QS/regtest-cdft-1/dft-common-params.inc @@ -0,0 +1,76 @@ +&DFT + @IF ( ${BECKE_ACTIVE} == TRUE ) + @include becke_qs.inc + @ENDIF + @IF ( ${BECKE_ACTIVE} == FALSE ) + &QS + METHOD GPW + EPS_DEFAULT 1.0E-12 + MAP_CONSISTENT + EXTRAPOLATION ASPC + EXTRAPOLATION_ORDER 3 + &END QS + @ENDIF + BASIS_SET_FILE_NAME BASIS_MOLOPT + POTENTIAL_FILE_NAME POTENTIAL + @IF ( ${RESTART_WFN} == TRUE ) + WFN_RESTART_FILE_NAME ${WFN_FILE} + @ENDIF + LSD + CHARGE 0 + &MGRID + CUTOFF 100 + NGRIDS 5 + &END MGRID + &SCF + @IF ( ${RESTART_WFN} == TRUE ) + SCF_GUESS RESTART + @ENDIF + @IF ( ${RESTART_WFN} == FALSE ) + SCF_GUESS ATOMIC + @ENDIF + EPS_SCF 1.0E-5 + CHOLESKY INVERSE_DBCSR + MAX_SCF 20 + &OT ON + MINIMIZER DIIS + PRECONDITIONER FULL_ALL + ALGORITHM IRAC + &END OT + &OUTER_SCF ON + EPS_SCF 1.0E-5 + MAX_SCF 2 + &END + &PRINT + &RESTART + FILENAME ./${PROJECT_NAME} + BACKUP_COPIES 0 + COMMON_ITERATION_LEVELS 1 + &EACH + JUST_ENERGY ${WRITE_WFN} + QS_SCF 0 + &END EACH + &END RESTART + &RESTART_HISTORY OFF + &END RESTART_HISTORY + &END PRINT + &END SCF + &XC + &XC_FUNCTIONAL PBE + &END XC_FUNCTIONAL + &XC_GRID + XC_DERIV SPLINE2 + XC_SMOOTH_RHO NONE + &END XC_GRID + &END XC + &PRINT + &MULLIKEN OFF + &END MULLIKEN + &HIRSHFELD OFF + &END HIRSHFELD + &END PRINT +&END DFT +&PRINT + &FORCES ON + &END +&END diff --git a/tests/QS/regtest-cdft-1/subsys.inc b/tests/QS/regtest-cdft-1/subsys.inc new file mode 100644 index 0000000000..6a723a3171 --- /dev/null +++ b/tests/QS/regtest-cdft-1/subsys.inc @@ -0,0 +1,20 @@ +&SUBSYS + &CELL + PERIODIC XYZ + ABC 15. 15. 15. + &END CELL + &TOPOLOGY + COORD_FILE_FORMAT XYZ + COORD_FILE_NAME water.xyz + &CENTER_COORDINATES OFF + &END CENTER_COORDINATES + &END TOPOLOGY + &KIND O + BASIS_SET SZV-MOLOPT-SR-GTH + POTENTIAL GTH-PBE-q6 + &END KIND + &KIND H + BASIS_SET SZV-MOLOPT-SR-GTH + POTENTIAL GTH-PBE-q1 + &END KIND +&END SUBSYS diff --git a/tests/QS/regtest-cdft-1/water-cdft-1.inp b/tests/QS/regtest-cdft-1/water-cdft-1.inp new file mode 100644 index 0000000000..0764ba8078 --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-cdft-1.inp @@ -0,0 +1,35 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE water-noconstraint-1_0.wfn +@SET PROJECT_NAME water-cdft-1 +@SET WRITE_WFN 0 + +@SET BECKE_ACTIVE TRUE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE FALSE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water-cdft-2.inp b/tests/QS/regtest-cdft-1/water-cdft-2.inp new file mode 100644 index 0000000000..0a02795deb --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-cdft-2.inp @@ -0,0 +1,35 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE water-noconstraint-1_0.wfn +@SET PROJECT_NAME water-cdft-2 +@SET WRITE_WFN 0 + +@SET BECKE_ACTIVE TRUE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT TRUE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water-cdft-3.inp b/tests/QS/regtest-cdft-1/water-cdft-3.inp new file mode 100644 index 0000000000..ba94c165f4 --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-cdft-3.inp @@ -0,0 +1,35 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE water-noconstraint-1_0.wfn +@SET PROJECT_NAME water-cdft-3 +@SET WRITE_WFN 0 + +@SET BECKE_ACTIVE TRUE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water-cdft-4.inp b/tests/QS/regtest-cdft-1/water-cdft-4.inp new file mode 100644 index 0000000000..4584a4c99a --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-cdft-4.inp @@ -0,0 +1,35 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE water-noconstraint-1_0.wfn +@SET PROJECT_NAME water-cdft-4 +@SET WRITE_WFN 0 + +@SET BECKE_ACTIVE TRUE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water-cdft-5.inp b/tests/QS/regtest-cdft-1/water-cdft-5.inp new file mode 100644 index 0000000000..a2c83ec162 --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-cdft-5.inp @@ -0,0 +1,35 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE water-noconstraint-1_0.wfn +@SET PROJECT_NAME water-cdft-5 +@SET WRITE_WFN 0 + +@SET BECKE_ACTIVE TRUE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water-cdft-6.inp b/tests/QS/regtest-cdft-1/water-cdft-6.inp new file mode 100644 index 0000000000..13cbc7753d --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-cdft-6.inp @@ -0,0 +1,35 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE water-noconstraint-1_0.wfn +@SET PROJECT_NAME water-cdft-6 +@SET WRITE_WFN 0 + +@SET BECKE_ACTIVE TRUE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE SINGLE +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water-cdft-7.inp b/tests/QS/regtest-cdft-1/water-cdft-7.inp new file mode 100644 index 0000000000..9d2e7d5397 --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-cdft-7.inp @@ -0,0 +1,35 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE water-noconstraint-1_0.wfn +@SET PROJECT_NAME water-cdft-7 +@SET WRITE_WFN 0 + +@SET BECKE_ACTIVE TRUE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE COVALENT +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water-cdft-8.inp b/tests/QS/regtest-cdft-1/water-cdft-8.inp new file mode 100644 index 0000000000..2af66123c4 --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-cdft-8.inp @@ -0,0 +1,35 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE water-noconstraint-1_0.wfn +@SET PROJECT_NAME water-cdft-8 +@SET WRITE_WFN 0 + +@SET BECKE_ACTIVE TRUE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE USER +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water-noconstraint.inp b/tests/QS/regtest-cdft-1/water-noconstraint.inp new file mode 100644 index 0000000000..9a15641244 --- /dev/null +++ b/tests/QS/regtest-cdft-1/water-noconstraint.inp @@ -0,0 +1,34 @@ +@SET RESTART_WFN FALSE +@SET PROJECT_NAME water-noconstraint +@SET WRITE_WFN 1 + +@SET BECKE_ACTIVE FALSE +@SET BECKE_TARGET 8.0 +@SET BECKE_STR 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE FALSE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-1/water.xyz b/tests/QS/regtest-cdft-1/water.xyz new file mode 100644 index 0000000000..e304a34229 --- /dev/null +++ b/tests/QS/regtest-cdft-1/water.xyz @@ -0,0 +1,5 @@ +3 +fragment a +O 8.973310 7.488240 7.183015 +H 8.017530 7.477070 7.328865 +H 9.347810 7.444760 8.067115 \ No newline at end of file diff --git a/tests/QS/regtest-cdft-2/H-noconstraint.inp b/tests/QS/regtest-cdft-2/H-noconstraint.inp new file mode 100644 index 0000000000..1b1db579c0 --- /dev/null +++ b/tests/QS/regtest-cdft-2/H-noconstraint.inp @@ -0,0 +1,44 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME H-noconstraint +@SET WRITE_WFN 0 +@SET CHARGE 0 +@SET WRITE_CUBE TRUE +@SET XYZFILE H.xyz + +@SET BECKE_ACTIVE FALSE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 0 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE FALSE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/H.xyz b/tests/QS/regtest-cdft-2/H.xyz new file mode 100644 index 0000000000..f440fdfc36 --- /dev/null +++ b/tests/QS/regtest-cdft-2/H.xyz @@ -0,0 +1,3 @@ +1 + +H 7.500000 7.500000 7.900000 diff --git a/tests/QS/regtest-cdft-2/He+-noconstraint.inp b/tests/QS/regtest-cdft-2/He+-noconstraint.inp new file mode 100644 index 0000000000..0c5002d62b --- /dev/null +++ b/tests/QS/regtest-cdft-2/He+-noconstraint.inp @@ -0,0 +1,44 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME He+-noconstraint +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE TRUE +@SET XYZFILE He.xyz + +@SET BECKE_ACTIVE FALSE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 0 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE FALSE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/He.xyz b/tests/QS/regtest-cdft-2/He.xyz new file mode 100644 index 0000000000..8cae23a8ae --- /dev/null +++ b/tests/QS/regtest-cdft-2/He.xyz @@ -0,0 +1,3 @@ +1 + +He 7.500000 7.500000 7.100000 diff --git a/tests/QS/regtest-cdft-2/HeH-cdft-1.inp b/tests/QS/regtest-cdft-2/HeH-cdft-1.inp new file mode 100644 index 0000000000..0cb869587f --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH-cdft-1.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-1 +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 0 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/HeH-cdft-2.inp b/tests/QS/regtest-cdft-2/HeH-cdft-2.inp new file mode 100644 index 0000000000..998068a274 --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH-cdft-2.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-2 +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT TRUE +@SET MAX_SCF 0 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/HeH-cdft-3.inp b/tests/QS/regtest-cdft-2/HeH-cdft-3.inp new file mode 100644 index 0000000000..9cfa81ee7c --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH-cdft-3.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-3 +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 0 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/HeH-cdft-4.inp b/tests/QS/regtest-cdft-2/HeH-cdft-4.inp new file mode 100644 index 0000000000..eb513a3770 --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH-cdft-4.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-4 +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT TRUE +@SET MAX_SCF 0 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/HeH-cdft-5.inp b/tests/QS/regtest-cdft-2/HeH-cdft-5.inp new file mode 100644 index 0000000000..0b4c4a6954 --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH-cdft-5.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-5 +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 1 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE FALSE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY_FORCE + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/HeH-cdft-6.inp b/tests/QS/regtest-cdft-2/HeH-cdft-6.inp new file mode 100644 index 0000000000..5768b0e2c1 --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH-cdft-6.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-6 +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 1 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY_FORCE + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/HeH-cdft-7.inp b/tests/QS/regtest-cdft-2/HeH-cdft-7.inp new file mode 100644 index 0000000000..90d7072d7d --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH-cdft-7.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-7 +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 1 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY_FORCE + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/HeH-noconstraint.inp b/tests/QS/regtest-cdft-2/HeH-noconstraint.inp new file mode 100644 index 0000000000..ea7af63f1d --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH-noconstraint.inp @@ -0,0 +1,44 @@ +@SET RESTART_WFN FALSE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-noconstraint +@SET WRITE_WFN 1 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE FALSE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 0 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE FALSE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-2/HeH.xyz b/tests/QS/regtest-cdft-2/HeH.xyz new file mode 100644 index 0000000000..16b9bd1fcc --- /dev/null +++ b/tests/QS/regtest-cdft-2/HeH.xyz @@ -0,0 +1,4 @@ +2 + +He 7.500000 7.500000 7.100000 +H 7.500000 7.500000 7.900000 diff --git a/tests/QS/regtest-cdft-2/TEST_FILES b/tests/QS/regtest-cdft-2/TEST_FILES new file mode 100644 index 0000000000..5a8e2fac91 --- /dev/null +++ b/tests/QS/regtest-cdft-2/TEST_FILES @@ -0,0 +1,17 @@ +# runs are executed in the same order as in this file +# the second field tells which test should be run in order to compare with the last available output +# see regtest/TEST_FILES +# +HeH-noconstraint.inp 1 1e-13 -2.92909797857414 +He+-noconstraint.inp 1 1e-13 -1.97024649506553 +H-noconstraint.inp 1 1e-13 -0.45619409564056 +# These tests use different constraint formalisms so their value differs (see outputted charges) +HeH-cdft-1.inp 71 1e-12 1.200259777690 +HeH-cdft-2.inp 71 1e-12 1.599346939652 +HeH-cdft-3.inp 71 1e-12 1.415422840116 +HeH-cdft-4.inp 71 1e-12 1.706928470865 +# These tests give identical value of atomic forces (there is some numerical noise when the number of mpiranks is varied) +HeH-cdft-5.inp 72 7e-12 0.0968896882177 +HeH-cdft-6.inp 72 6e-12 0.0968896882177 +HeH-cdft-7.inp 72 6e-12 0.0968896882177 +#EOF diff --git a/tests/QS/regtest-cdft-2/TEST_FILES_RESET b/tests/QS/regtest-cdft-2/TEST_FILES_RESET new file mode 100644 index 0000000000..3734215b96 --- /dev/null +++ b/tests/QS/regtest-cdft-2/TEST_FILES_RESET @@ -0,0 +1,3 @@ +# +# add files to be reset here +# \ No newline at end of file diff --git a/tests/QS/regtest-cdft-2/becke_qs.inc b/tests/QS/regtest-cdft-2/becke_qs.inc new file mode 100644 index 0000000000..eb72badf23 --- /dev/null +++ b/tests/QS/regtest-cdft-2/becke_qs.inc @@ -0,0 +1,84 @@ +&QS + METHOD GPW + EPS_DEFAULT 1.0E-12 + MAP_CONSISTENT + EXTRAPOLATION ASPC + EXTRAPOLATION_ORDER 3 + &CDFT + TYPE_OF_CONSTRAINT BECKE + &OUTER_SCF ON + EPS_SCF 1.0e-0 + TYPE BECKE_CONSTRAINT + OPTIMIZER BISECT + BISECT_TRUST_COUNT 8 + EXTRAPOLATION_ORDER 2 + MAX_SCF ${MAX_SCF} + STEP_SIZE -0.001 + &END + &END CDFT + &BECKE_RESTRAINT + @IF ( ${BECKE_ADJUST_SIZE} == TRUE ) + ! Defaults to false + ADJUST_SIZE TRUE + ATOMIC_RADII 0.460 0.320 + @ENDIF + @IF ( ${BECKE_ATOMIC_CHARGES} == TRUE ) + ! Defaults to false + ATOMIC_CHARGES TRUE + @ENDIF + STRENGTH ${BECKE_STR} + ! The constraint target: sum_i coeff_i * N_i + ! where N_i is the number of VALENCE electrons on i + TARGET ${BECKE_TARGET} + @IF ( ${BECKE_CUTOFF_ELEMENT} == TRUE ) + CUTOFF_TYPE ELEMENT + ELEMENT_CUTOFF 2.0 2.0 + @ENDIF + @IF ( ${BECKE_GLOBAL_CUTOFF} == TRUE ) + CUTOFF_TYPE GLOBAL + GLOBAL_CUTOFF 2.0 + @ENDIF + @IF ( ${BECKE_IN_MEMORY} == TRUE ) + ! Defaults to false + IN_MEMORY TRUE + @ENDIF + @IF ( ${BECKE_CAVITY_CONFINE} == TRUE ) + ! Defaults to NONE + CONFINE CAVITY + EPS_CAVITY 1.0E-6 + CAVITY_SHAPE ${BECKE_CAVITY_SHAPE} + ! For shape single + CAVITY_RADIUS 1.3 + CAVITY_USE_BOHR FALSE + @ENDIF + @IF ( ${BECKE_SHOULD_SKIP} == TRUE ) + ! Defaults to false + SHOULD_SKIP TRUE + @ENDIF + @IF ( ${BECKE_CAVITY_PRINT} == TRUE ) + ! Defaults to false + CAVITY_PRINT TRUE + @ENDIF + @IF ( ${BECKE_FRAGMENT} == TRUE ) + ! Need absolute weight to use fragment densities + ATOMS 1 + COEFF 1 + FRAGMENT_DENSITIES + FRAGMENT_A_FILE_NAME He+-noconstraint-ELECTRON_DENSITY-1_0.cube + FRAGMENT_B_FILE_NAME H-noconstraint-ELECTRON_DENSITY-1_0.cube + @ENDIF + @IF ( ${BECKE_FRAGMENT} == FALSE ) + ATOMS 1..2 + COEFF 1 -1 + @ENDIF + CONSTRAINT_TYPE TOTAL + &PROGRAM_RUN_INFO ON + &EACH + QS_SCF 1 + &END EACH + COMMON_ITERATION_LEVELS 2 + ADD_LAST NUMERIC + FILENAME ./${PROJECT_NAME} + &END PROGRAM_RUN_INFO + &END BECKE_RESTRAINT +&END QS diff --git a/tests/QS/regtest-cdft-2/dft-common-params.inc b/tests/QS/regtest-cdft-2/dft-common-params.inc new file mode 100644 index 0000000000..dbd8ae3d87 --- /dev/null +++ b/tests/QS/regtest-cdft-2/dft-common-params.inc @@ -0,0 +1,83 @@ +&DFT + @IF ( ${BECKE_ACTIVE} == TRUE ) + @include becke_qs.inc + @ENDIF + @IF ( ${BECKE_ACTIVE} == FALSE ) + &QS + METHOD GPW + EPS_DEFAULT 1.0E-12 + MAP_CONSISTENT + EXTRAPOLATION ASPC + EXTRAPOLATION_ORDER 3 + &END QS + @ENDIF + BASIS_SET_FILE_NAME BASIS_MOLOPT + POTENTIAL_FILE_NAME POTENTIAL + @IF ( ${RESTART_WFN} == TRUE ) + WFN_RESTART_FILE_NAME ${WFN_FILE} + @ENDIF + LSD + CHARGE ${CHARGE} + &MGRID + CUTOFF 100 + NGRIDS 5 + &END MGRID + &SCF + @IF ( ${RESTART_WFN} == TRUE ) + SCF_GUESS RESTART + @ENDIF + @IF ( ${RESTART_WFN} == FALSE ) + SCF_GUESS ATOMIC + @ENDIF + EPS_SCF 1.0E-5 + CHOLESKY INVERSE_DBCSR + MAX_SCF 20 + &OT ON + ! DIIS convergence might not be constant with different mpiranks => use CG + MINIMIZER CG + PRECONDITIONER FULL_ALL + ALGORITHM IRAC + &END OT + &OUTER_SCF ON + EPS_SCF 1.0E-5 + MAX_SCF 2 + &END + &PRINT + &RESTART + FILENAME ./${PROJECT_NAME} + BACKUP_COPIES 0 + COMMON_ITERATION_LEVELS 1 + &EACH + JUST_ENERGY ${WRITE_WFN} + QS_SCF 0 + &END EACH + &END RESTART + &RESTART_HISTORY OFF + &END RESTART_HISTORY + &END PRINT + &END SCF + &XC + &XC_FUNCTIONAL PBE + &END XC_FUNCTIONAL + &XC_GRID + XC_DERIV SPLINE2 + XC_SMOOTH_RHO NONE + &END XC_GRID + &END XC + &PRINT + &MULLIKEN OFF + &END MULLIKEN + &HIRSHFELD OFF + &END HIRSHFELD + @IF ( ${WRITE_CUBE} == TRUE ) + &E_DENSITY_CUBE ON + STRIDE 1 1 1 + &END E_DENSITY_CUBE + @ENDIF + &END PRINT +&END DFT +&PRINT + &FORCES ON + NDIGITS 13 + &END +&END diff --git a/tests/QS/regtest-cdft-2/subsys.inc b/tests/QS/regtest-cdft-2/subsys.inc new file mode 100644 index 0000000000..2d3595a43a --- /dev/null +++ b/tests/QS/regtest-cdft-2/subsys.inc @@ -0,0 +1,20 @@ +&SUBSYS + &CELL + PERIODIC XYZ + ABC 15. 15. 15. + &END CELL + &TOPOLOGY + COORD_FILE_FORMAT XYZ + COORD_FILE_NAME ${XYZFILE} + &CENTER_COORDINATES OFF + &END CENTER_COORDINATES + &END TOPOLOGY + &KIND He + BASIS_SET SZV-MOLOPT-SR-GTH + POTENTIAL GTH-PBE-q2 + &END KIND + &KIND H + BASIS_SET SZV-MOLOPT-SR-GTH + POTENTIAL GTH-PBE-q1 + &END KIND +&END SUBSYS diff --git a/tests/QS/regtest-cdft-3/HeH-cdft-state-1.inp b/tests/QS/regtest-cdft-3/HeH-cdft-state-1.inp new file mode 100644 index 0000000000..3ee6613015 --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-cdft-state-1.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-state-1 +@SET WRITE_WFN 1 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-cdft-state-2.inp b/tests/QS/regtest-cdft-3/HeH-cdft-state-2.inp new file mode 100644 index 0000000000..a8ee4a403b --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-cdft-state-2.inp @@ -0,0 +1,46 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-cdft-state-2 +@SET WRITE_WFN 1 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES TRUE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_2} + @SET BECKE_TARGET ${BECKE_TARGET_2} + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-mixed-cdft-1.inp b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-1.inp new file mode 100644 index 0000000000..135c9d88cc --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-1.inp @@ -0,0 +1,100 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE_1 HeH-cdft-state-1-1_0.wfn +@SET WFN_FILE_2 HeH-cdft-state-2-1_0.wfn +@SET PROJECT_NAME HeH-mixed-cdft-1 +@SET NAME ${PROJECT_NAME} +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.707711420058 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 -1.008285468010 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +@SET USE_DLB FALSE +@SET COMPUTE_METRIC FALSE +@SET WFN_OVERLAP_METHOD FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&MULTIPLE_FORCE_EVALS + FORCE_EVAL_ORDER 2 3 + MULTIPLE_SUBSYS F +&END +&FORCE_EVAL + METHOD MIXED + &MIXED + MIXING_TYPE LINEAR_COMBINATION + NGROUPS 2 + &LINEAR + LAMBDA 1.0 + MIXED_CDFT TRUE + MIXED_CDFT_COUPLING 1 + @IF ( ${USE_DLB} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_DLB TRUE + LOAD_SCALE 2 + MORE_WORK 0 + VERY_OVERLOADED 15 + @ENDIF + @IF ( ${COMPUTE_METRIC} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_METRIC TRUE + @ENDIF + @IF ( ${WFN_OVERLAP_METHOD} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_WFN_OVERLAP TRUE + WFN_RESTART_FILE_NAME HeH-noconstraint-1_0.wfn + @ENDIF + &END LINEAR + &PRINT + &PROGRAM_RUN_INFO + &END + &END PRINT + &END MIXED + @include subsys.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @SET PROJECT_NAME ${NAME}-state-1 + @SET WFN_FILE ${WFN_FILE_1} + @include dft-common-params.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_2} + @SET BECKE_TARGET ${BECKE_TARGET_2} + @SET PROJECT_NAME ${NAME}-state-2 + @SET WFN_FILE ${WFN_FILE_2} + @include dft-common-params.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-mixed-cdft-2.inp b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-2.inp new file mode 100644 index 0000000000..b240ee9a08 --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-2.inp @@ -0,0 +1,100 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE_1 HeH-cdft-state-1-1_0.wfn +@SET WFN_FILE_2 HeH-cdft-state-2-1_0.wfn +@SET PROJECT_NAME HeH-mixed-cdft-2 +@SET NAME ${PROJECT_NAME} +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.707711420058 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 -1.008285468010 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +@SET USE_DLB FALSE +@SET COMPUTE_METRIC TRUE +@SET WFN_OVERLAP_METHOD FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&MULTIPLE_FORCE_EVALS + FORCE_EVAL_ORDER 2 3 + MULTIPLE_SUBSYS F +&END +&FORCE_EVAL + METHOD MIXED + &MIXED + MIXING_TYPE LINEAR_COMBINATION + NGROUPS 2 + &LINEAR + LAMBDA 1.0 + MIXED_CDFT TRUE + MIXED_CDFT_COUPLING 1 + @IF ( ${USE_DLB} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_DLB TRUE + LOAD_SCALE 2 + MORE_WORK 0 + VERY_OVERLOADED 15 + @ENDIF + @IF ( ${COMPUTE_METRIC} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_METRIC TRUE + @ENDIF + @IF ( ${WFN_OVERLAP_METHOD} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_WFN_OVERLAP TRUE + WFN_RESTART_FILE_NAME HeH-noconstraint-1_0.wfn + @ENDIF + &END LINEAR + &PRINT + &PROGRAM_RUN_INFO + &END + &END PRINT + &END MIXED + @include subsys.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @SET PROJECT_NAME ${NAME}-state-1 + @SET WFN_FILE ${WFN_FILE_1} + @include dft-common-params.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_2} + @SET BECKE_TARGET ${BECKE_TARGET_2} + @SET PROJECT_NAME ${NAME}-state-2 + @SET WFN_FILE ${WFN_FILE_2} + @include dft-common-params.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-mixed-cdft-3.inp b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-3.inp new file mode 100644 index 0000000000..57c0ab9c40 --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-3.inp @@ -0,0 +1,100 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE_1 HeH-cdft-state-1-1_0.wfn +@SET WFN_FILE_2 HeH-cdft-state-2-1_0.wfn +@SET PROJECT_NAME HeH-mixed-cdft-3 +@SET NAME ${PROJECT_NAME} +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.707711420058 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 -1.008285468010 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +@SET USE_DLB FALSE +@SET COMPUTE_METRIC FALSE +@SET WFN_OVERLAP_METHOD TRUE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&MULTIPLE_FORCE_EVALS + FORCE_EVAL_ORDER 2 3 + MULTIPLE_SUBSYS F +&END +&FORCE_EVAL + METHOD MIXED + &MIXED + MIXING_TYPE LINEAR_COMBINATION + NGROUPS 2 + &LINEAR + LAMBDA 1.0 + MIXED_CDFT TRUE + MIXED_CDFT_COUPLING 1 + @IF ( ${USE_DLB} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_DLB TRUE + LOAD_SCALE 2 + MORE_WORK 0 + VERY_OVERLOADED 15 + @ENDIF + @IF ( ${COMPUTE_METRIC} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_METRIC TRUE + @ENDIF + @IF ( ${WFN_OVERLAP_METHOD} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_WFN_OVERLAP TRUE + WFN_RESTART_FILE_NAME HeH-noconstraint-1_0.wfn + @ENDIF + &END LINEAR + &PRINT + &PROGRAM_RUN_INFO + &END + &END PRINT + &END MIXED + @include subsys.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @SET PROJECT_NAME ${NAME}-state-1 + @SET WFN_FILE ${WFN_FILE_1} + @include dft-common-params.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_2} + @SET BECKE_TARGET ${BECKE_TARGET_2} + @SET PROJECT_NAME ${NAME}-state-2 + @SET WFN_FILE ${WFN_FILE_2} + @include dft-common-params.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-mixed-cdft-4.inp b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-4.inp new file mode 100644 index 0000000000..28cab872b1 --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-4.inp @@ -0,0 +1,103 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE_1 HeH-cdft-state-1-1_0.wfn +@SET WFN_FILE_2 HeH-cdft-state-2-1_0.wfn +@SET PROJECT_NAME HeH-mixed-cdft-4 +@SET NAME ${PROJECT_NAME} +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.707711420058 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 -1.008285468010 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +@SET USE_DLB FALSE +@SET COMPUTE_METRIC FALSE +@SET WFN_OVERLAP_METHOD FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY_FORCE + PRINT_LEVEL MEDIUM + &TIMINGS + THRESHOLD 0.001 + &END +&END GLOBAL + +&MULTIPLE_FORCE_EVALS + FORCE_EVAL_ORDER 2 3 + MULTIPLE_SUBSYS F +&END +&FORCE_EVAL + METHOD MIXED + &MIXED + MIXING_TYPE LINEAR_COMBINATION + NGROUPS 2 + &LINEAR + LAMBDA 1.0 + MIXED_CDFT TRUE + MIXED_CDFT_COUPLING 1 + @IF ( ${USE_DLB} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_DLB TRUE + LOAD_SCALE 2 + MORE_WORK 0 + VERY_OVERLOADED 15 + @ENDIF + @IF ( ${COMPUTE_METRIC} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_METRIC TRUE + @ENDIF + @IF ( ${WFN_OVERLAP_METHOD} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_WFN_OVERLAP TRUE + WFN_RESTART_FILE_NAME HeH-noconstraint-1_0.wfn + @ENDIF + &END LINEAR + &PRINT + &PROGRAM_RUN_INFO + &END + &END PRINT + &END MIXED + @include subsys.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @SET PROJECT_NAME ${NAME}-state-1 + @SET WFN_FILE ${WFN_FILE_1} + @include dft-common-params.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_2} + @SET BECKE_TARGET ${BECKE_TARGET_2} + @SET PROJECT_NAME ${NAME}-state-2 + @SET WFN_FILE ${WFN_FILE_2} + @include dft-common-params.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-mixed-cdft-5.inp b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-5.inp new file mode 100644 index 0000000000..c3fe31a1c4 --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-5.inp @@ -0,0 +1,103 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE_1 HeH-cdft-state-1-1_0.wfn +@SET WFN_FILE_2 HeH-cdft-state-2-1_0.wfn +@SET PROJECT_NAME HeH-mixed-cdft-5 +@SET NAME ${PROJECT_NAME} +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.707711420058 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 -1.008285468010 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +@SET USE_DLB TRUE +@SET COMPUTE_METRIC FALSE +@SET WFN_OVERLAP_METHOD FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY_FORCE + PRINT_LEVEL MEDIUM + &TIMINGS + THRESHOLD 0.001 + &END +&END GLOBAL + +&MULTIPLE_FORCE_EVALS + FORCE_EVAL_ORDER 2 3 + MULTIPLE_SUBSYS F +&END +&FORCE_EVAL + METHOD MIXED + &MIXED + MIXING_TYPE LINEAR_COMBINATION + NGROUPS 2 + &LINEAR + LAMBDA 1.0 + MIXED_CDFT TRUE + MIXED_CDFT_COUPLING 1 + @IF ( ${USE_DLB} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_DLB TRUE + LOAD_SCALE 2 + MORE_WORK 0 + VERY_OVERLOADED 15 + @ENDIF + @IF ( ${COMPUTE_METRIC} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_METRIC TRUE + @ENDIF + @IF ( ${WFN_OVERLAP_METHOD} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_WFN_OVERLAP TRUE + WFN_RESTART_FILE_NAME HeH-noconstraint-1_0.wfn + @ENDIF + &END LINEAR + &PRINT + &PROGRAM_RUN_INFO + &END + &END PRINT + &END MIXED + @include subsys.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @SET PROJECT_NAME ${NAME}-state-1 + @SET WFN_FILE ${WFN_FILE_1} + @include dft-common-params.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_2} + @SET BECKE_TARGET ${BECKE_TARGET_2} + @SET PROJECT_NAME ${NAME}-state-2 + @SET WFN_FILE ${WFN_FILE_2} + @include dft-common-params.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-mixed-cdft-6.inp b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-6.inp new file mode 100644 index 0000000000..83f466ba28 --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-6.inp @@ -0,0 +1,114 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE_1 HeH-cdft-state-1-1_0.wfn +@SET WFN_FILE_2 HeH-cdft-state-2-1_0.wfn +@SET PROJECT_NAME HeH-mixed-cdft-6 +@SET NAME ${PROJECT_NAME} +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.707711420058 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 -1.008285468010 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +@SET USE_DLB FALSE +@SET COMPUTE_METRIC FALSE +@SET WFN_OVERLAP_METHOD FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE MD + PRINT_LEVEL MEDIUM + &TIMINGS + THRESHOLD 0.001 + &END +&END GLOBAL +&MOTION + &MD + ENSEMBLE NVT + STEPS 2 + TIMESTEP 0.5 + TEMPERATURE 300 + &THERMOSTAT + TYPE CSVR + &END THERMOSTAT + &END MD +&END MOTION + +&MULTIPLE_FORCE_EVALS + FORCE_EVAL_ORDER 2 3 + MULTIPLE_SUBSYS F +&END +&FORCE_EVAL + METHOD MIXED + &MIXED + MIXING_TYPE LINEAR_COMBINATION + NGROUPS 2 + &LINEAR + LAMBDA 1.0 + MIXED_CDFT TRUE + MIXED_CDFT_COUPLING 1 + @IF ( ${USE_DLB} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_DLB TRUE + LOAD_SCALE 2 + MORE_WORK 0 + VERY_OVERLOADED 15 + @ENDIF + @IF ( ${COMPUTE_METRIC} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_METRIC TRUE + @ENDIF + @IF ( ${WFN_OVERLAP_METHOD} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_WFN_OVERLAP TRUE + WFN_RESTART_FILE_NAME HeH-noconstraint-1_0.wfn + @ENDIF + &END LINEAR + &PRINT + &PROGRAM_RUN_INFO + &END + &END PRINT + &END MIXED + @include subsys.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @SET PROJECT_NAME ${NAME}-state-1 + @SET WFN_FILE ${WFN_FILE_1} + @include dft-common-params.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_2} + @SET BECKE_TARGET ${BECKE_TARGET_2} + @SET PROJECT_NAME ${NAME}-state-2 + @SET WFN_FILE ${WFN_FILE_2} + @include dft-common-params.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-mixed-cdft-7.inp b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-7.inp new file mode 100644 index 0000000000..2f5201718a --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-mixed-cdft-7.inp @@ -0,0 +1,114 @@ +@SET RESTART_WFN TRUE +@SET WFN_FILE_1 HeH-cdft-state-1-1_0.wfn +@SET WFN_FILE_2 HeH-cdft-state-2-1_0.wfn +@SET PROJECT_NAME HeH-mixed-cdft-7 +@SET NAME ${PROJECT_NAME} +@SET WRITE_WFN 0 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE TRUE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 5 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.707711420058 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 -1.008285468010 + +@SET BECKE_GLOBAL_CUTOFF FALSE +@SET BECKE_CUTOFF_ELEMENT TRUE + +@SET BECKE_ADJUST_SIZE TRUE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE TRUE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP TRUE + +@SET BECKE_IN_MEMORY TRUE + +@SET USE_DLB TRUE +@SET COMPUTE_METRIC FALSE +@SET WFN_OVERLAP_METHOD FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE MD + PRINT_LEVEL MEDIUM + &TIMINGS + THRESHOLD 0.001 + &END +&END GLOBAL +&MOTION + &MD + ENSEMBLE NVT + STEPS 2 + TIMESTEP 0.5 + TEMPERATURE 300 + &THERMOSTAT + TYPE CSVR + &END THERMOSTAT + &END MD +&END MOTION + +&MULTIPLE_FORCE_EVALS + FORCE_EVAL_ORDER 2 3 + MULTIPLE_SUBSYS F +&END +&FORCE_EVAL + METHOD MIXED + &MIXED + MIXING_TYPE LINEAR_COMBINATION + NGROUPS 2 + &LINEAR + LAMBDA 1.0 + MIXED_CDFT TRUE + MIXED_CDFT_COUPLING 1 + @IF ( ${USE_DLB} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_DLB TRUE + LOAD_SCALE 2 + MORE_WORK 0 + VERY_OVERLOADED 15 + @ENDIF + @IF ( ${COMPUTE_METRIC} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_METRIC TRUE + @ENDIF + @IF ( ${WFN_OVERLAP_METHOD} == TRUE ) + ! Defaults to FALSE + MIXED_CDFT_WFN_OVERLAP TRUE + WFN_RESTART_FILE_NAME HeH-noconstraint-1_0.wfn + @ENDIF + &END LINEAR + &PRINT + &PROGRAM_RUN_INFO + &END + &END PRINT + &END MIXED + @include subsys.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_1} + @SET BECKE_TARGET ${BECKE_TARGET_1} + @SET PROJECT_NAME ${NAME}-state-1 + @SET WFN_FILE ${WFN_FILE_1} + @include dft-common-params.inc +&END FORCE_EVAL + +&FORCE_EVAL + METHOD QS + @SET BECKE_STR ${BECKE_STR_2} + @SET BECKE_TARGET ${BECKE_TARGET_2} + @SET PROJECT_NAME ${NAME}-state-2 + @SET WFN_FILE ${WFN_FILE_2} + @include dft-common-params.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH-noconstraint.inp b/tests/QS/regtest-cdft-3/HeH-noconstraint.inp new file mode 100644 index 0000000000..ea7af63f1d --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH-noconstraint.inp @@ -0,0 +1,44 @@ +@SET RESTART_WFN FALSE +@SET WFN_FILE HeH-noconstraint-1_0.wfn +@SET PROJECT_NAME HeH-noconstraint +@SET WRITE_WFN 1 +@SET CHARGE 1 +@SET WRITE_CUBE FALSE +@SET XYZFILE HeH.xyz + +@SET BECKE_ACTIVE FALSE +@SET BECKE_FRAGMENT FALSE +@SET MAX_SCF 0 +! He+ H +@SET BECKE_TARGET_1 0.0 +@SET BECKE_STR_1 0.0 +! He H+ +@SET BECKE_TARGET_2 2.0 +@SET BECKE_STR_2 0.0 + +@SET BECKE_GLOBAL_CUTOFF TRUE +@SET BECKE_CUTOFF_ELEMENT FALSE + +@SET BECKE_ADJUST_SIZE FALSE + +@SET BECKE_ATOMIC_CHARGES FALSE + +@SET BECKE_CAVITY_CONFINE FALSE +@SET BECKE_CAVITY_SHAPE VDW +@SET BECKE_CAVITY_PRINT FALSE + +@SET BECKE_SHOULD_SKIP FALSE + +@SET BECKE_IN_MEMORY FALSE + +&GLOBAL + PROJECT ${PROJECT_NAME} + RUN_TYPE ENERGY + PRINT_LEVEL MEDIUM +&END GLOBAL + +&FORCE_EVAL + METHOD QS + @include dft-common-params.inc + @include subsys.inc +&END FORCE_EVAL diff --git a/tests/QS/regtest-cdft-3/HeH.xyz b/tests/QS/regtest-cdft-3/HeH.xyz new file mode 100644 index 0000000000..16b9bd1fcc --- /dev/null +++ b/tests/QS/regtest-cdft-3/HeH.xyz @@ -0,0 +1,4 @@ +2 + +He 7.500000 7.500000 7.100000 +H 7.500000 7.500000 7.900000 diff --git a/tests/QS/regtest-cdft-3/TEST_FILES b/tests/QS/regtest-cdft-3/TEST_FILES new file mode 100644 index 0000000000..1f8791c46e --- /dev/null +++ b/tests/QS/regtest-cdft-3/TEST_FILES @@ -0,0 +1,18 @@ +# runs are executed in the same order as in this file +# the second field tells which test should be run in order to compare with the last available output +# see regtest/TEST_FILES +# +HeH-noconstraint.inp 1 1e-13 -2.92909797857414 +HeH-cdft-state-1.inp 71 4e-10 0.058799058192 +HeH-cdft-state-2.inp 71 2e-10 1.819331392252 +# These tests compute the electronic coupling and related quantities +HeH-mixed-cdft-1.inp 73 5e-10 510.592548695828 +HeH-mixed-cdft-2.inp 73 5e-10 510.592548695828 +HeH-mixed-cdft-3.inp 74 5e-10 560.222792273994 +# These tests give identical values of energies/atomic forces +HeH-mixed-cdft-4.inp 11 1e-13 -2.348554384953704 +HeH-mixed-cdft-5.inp 11 1e-13 -2.348554384953704 +# MD tests +HeH-mixed-cdft-6.inp 11 2e-13 -2.350318822849201 +HeH-mixed-cdft-7.inp 11 2e-13 -2.350318822849201 +#EOF diff --git a/tests/QS/regtest-cdft-3/TEST_FILES_RESET b/tests/QS/regtest-cdft-3/TEST_FILES_RESET new file mode 100644 index 0000000000..3734215b96 --- /dev/null +++ b/tests/QS/regtest-cdft-3/TEST_FILES_RESET @@ -0,0 +1,3 @@ +# +# add files to be reset here +# \ No newline at end of file diff --git a/tests/QS/regtest-cdft-3/becke_qs.inc b/tests/QS/regtest-cdft-3/becke_qs.inc new file mode 100644 index 0000000000..9ba626dffd --- /dev/null +++ b/tests/QS/regtest-cdft-3/becke_qs.inc @@ -0,0 +1,84 @@ +&QS + METHOD GPW + EPS_DEFAULT 1.0E-12 + MAP_CONSISTENT + EXTRAPOLATION ASPC + EXTRAPOLATION_ORDER 3 + &CDFT + TYPE_OF_CONSTRAINT BECKE + &OUTER_SCF ON + EPS_SCF 2.0e-1 + TYPE BECKE_CONSTRAINT + OPTIMIZER BISECT + BISECT_TRUST_COUNT 8 + EXTRAPOLATION_ORDER 2 + MAX_SCF ${MAX_SCF} + STEP_SIZE -1.0 + &END + &END CDFT + &BECKE_RESTRAINT + @IF ( ${BECKE_ADJUST_SIZE} == TRUE ) + ! Defaults to false + ADJUST_SIZE TRUE + ATOMIC_RADII 0.460 0.320 + @ENDIF + @IF ( ${BECKE_ATOMIC_CHARGES} == TRUE ) + ! Defaults to false + ATOMIC_CHARGES TRUE + @ENDIF + STRENGTH ${BECKE_STR} + ! The constraint target: sum_i coeff_i * N_i + ! where N_i is the number of VALENCE electrons on i + TARGET ${BECKE_TARGET} + @IF ( ${BECKE_CUTOFF_ELEMENT} == TRUE ) + CUTOFF_TYPE ELEMENT + ELEMENT_CUTOFF 2.0 2.0 + @ENDIF + @IF ( ${BECKE_GLOBAL_CUTOFF} == TRUE ) + CUTOFF_TYPE GLOBAL + GLOBAL_CUTOFF 2.0 + @ENDIF + @IF ( ${BECKE_IN_MEMORY} == TRUE ) + ! Defaults to false + IN_MEMORY TRUE + @ENDIF + @IF ( ${BECKE_CAVITY_CONFINE} == TRUE ) + ! Defaults to NONE + CONFINE CAVITY + EPS_CAVITY 1.0E-6 + CAVITY_SHAPE ${BECKE_CAVITY_SHAPE} + ! For shape single + CAVITY_RADIUS 1.3 + CAVITY_USE_BOHR FALSE + @ENDIF + @IF ( ${BECKE_SHOULD_SKIP} == TRUE ) + ! Defaults to false + SHOULD_SKIP TRUE + @ENDIF + @IF ( ${BECKE_CAVITY_PRINT} == TRUE ) + ! Defaults to false + CAVITY_PRINT TRUE + @ENDIF + @IF ( ${BECKE_FRAGMENT} == TRUE ) + ! Need absolute weight to use fragment densities + ATOMS 1 + COEFF 1 + FRAGMENT_DENSITIES + FRAGMENT_A_FILE_NAME He+-noconstraint-ELECTRON_DENSITY-1_0.cube + FRAGMENT_B_FILE_NAME H-noconstraint-ELECTRON_DENSITY-1_0.cube + @ENDIF + @IF ( ${BECKE_FRAGMENT} == FALSE ) + ATOMS 1..2 + COEFF 1 -1 + @ENDIF + CONSTRAINT_TYPE TOTAL + &PROGRAM_RUN_INFO ON + &EACH + QS_SCF 1 + &END EACH + COMMON_ITERATION_LEVELS 2 + ADD_LAST NUMERIC + FILENAME ./${PROJECT_NAME} + &END PROGRAM_RUN_INFO + &END BECKE_RESTRAINT +&END QS diff --git a/tests/QS/regtest-cdft-3/dft-common-params.inc b/tests/QS/regtest-cdft-3/dft-common-params.inc new file mode 100644 index 0000000000..c201198778 --- /dev/null +++ b/tests/QS/regtest-cdft-3/dft-common-params.inc @@ -0,0 +1,82 @@ +&DFT + @IF ( ${BECKE_ACTIVE} == TRUE ) + @include becke_qs.inc + @ENDIF + @IF ( ${BECKE_ACTIVE} == FALSE ) + &QS + METHOD GPW + EPS_DEFAULT 1.0E-12 + MAP_CONSISTENT + EXTRAPOLATION ASPC + EXTRAPOLATION_ORDER 3 + &END QS + @ENDIF + BASIS_SET_FILE_NAME BASIS_MOLOPT + POTENTIAL_FILE_NAME POTENTIAL + @IF ( ${RESTART_WFN} == TRUE ) + WFN_RESTART_FILE_NAME ${WFN_FILE} + @ENDIF + LSD + CHARGE ${CHARGE} + &MGRID + CUTOFF 100 + NGRIDS 5 + &END MGRID + &SCF + @IF ( ${RESTART_WFN} == TRUE ) + SCF_GUESS RESTART + @ENDIF + @IF ( ${RESTART_WFN} == FALSE ) + SCF_GUESS ATOMIC + @ENDIF + EPS_SCF 1.0E-5 + CHOLESKY INVERSE_DBCSR + MAX_SCF 20 + &OT ON + ! DIIS convergence might not be constant with different mpiranks => use CG + MINIMIZER CG + PRECONDITIONER FULL_ALL + ALGORITHM IRAC + &END OT + &OUTER_SCF ON + EPS_SCF 1.0E-5 + MAX_SCF 2 + &END + &PRINT + &RESTART + FILENAME ./${PROJECT_NAME} + BACKUP_COPIES 0 + COMMON_ITERATION_LEVELS 1 + &EACH + JUST_ENERGY ${WRITE_WFN} + QS_SCF 0 + &END EACH + &END RESTART + &RESTART_HISTORY OFF + &END RESTART_HISTORY + &END PRINT + &END SCF + &XC + &XC_FUNCTIONAL PBE + &END XC_FUNCTIONAL + &XC_GRID + XC_DERIV SPLINE2 + XC_SMOOTH_RHO NONE + &END XC_GRID + &END XC + &PRINT + &MULLIKEN OFF + &END MULLIKEN + &HIRSHFELD OFF + &END HIRSHFELD + @IF ( ${WRITE_CUBE} == TRUE ) + &E_DENSITY_CUBE ON + STRIDE 1 1 1 + &END E_DENSITY_CUBE + @ENDIF + &END PRINT +&END DFT +&PRINT + &FORCES ON + &END +&END diff --git a/tests/QS/regtest-cdft-3/subsys.inc b/tests/QS/regtest-cdft-3/subsys.inc new file mode 100644 index 0000000000..2d3595a43a --- /dev/null +++ b/tests/QS/regtest-cdft-3/subsys.inc @@ -0,0 +1,20 @@ +&SUBSYS + &CELL + PERIODIC XYZ + ABC 15. 15. 15. + &END CELL + &TOPOLOGY + COORD_FILE_FORMAT XYZ + COORD_FILE_NAME ${XYZFILE} + &CENTER_COORDINATES OFF + &END CENTER_COORDINATES + &END TOPOLOGY + &KIND He + BASIS_SET SZV-MOLOPT-SR-GTH + POTENTIAL GTH-PBE-q2 + &END KIND + &KIND H + BASIS_SET SZV-MOLOPT-SR-GTH + POTENTIAL GTH-PBE-q1 + &END KIND +&END SUBSYS diff --git a/tests/QS/regtest-ot/H2-BECKE-MD.inp b/tests/QS/regtest-ot/H2-BECKE-MD.inp index 9e1287f09f..e145aba3ec 100644 --- a/tests/QS/regtest-ot/H2-BECKE-MD.inp +++ b/tests/QS/regtest-ot/H2-BECKE-MD.inp @@ -17,7 +17,9 @@ TARGET 0.2000 ATOMS 1 2 COEFF 1 -1 - FUNCTIONAL_FORM CONSTRAINT + CUTOFF_TYPE GLOBAL + ! 6.0 bohr + GLOBAL_CUTOFF 3.1750632515399997 &END &END QS &SCF diff --git a/tests/QS/regtest-ot/H2-diffBECKE-ET_coupling.inp b/tests/QS/regtest-ot/H2-diffBECKE-ET_coupling.inp index 43cf60442f..50a7060d86 100644 --- a/tests/QS/regtest-ot/H2-diffBECKE-ET_coupling.inp +++ b/tests/QS/regtest-ot/H2-diffBECKE-ET_coupling.inp @@ -8,14 +8,18 @@ TARGET 0.2000 ATOMS 1 2 COEFF 1 -1 - FUNCTIONAL_FORM CONSTRAINT + CUTOFF_TYPE GLOBAL + ! 6.0 bohr + GLOBAL_CUTOFF 3.1750632515399997 &END &BECKE_RESTRAINT_B STRENGTH -0.000000000000000000 TARGET -0.2000 ATOMS 1 2 COEFF 1 -1 - FUNCTIONAL_FORM CONSTRAINT + CUTOFF_TYPE GLOBAL + ! 6.0 bohr + GLOBAL_CUTOFF 3.1750632515399997 &END &END &END diff --git a/tests/TEST_DIRS b/tests/TEST_DIRS index 6740a78d1b..8da7da1520 100644 --- a/tests/TEST_DIRS +++ b/tests/TEST_DIRS @@ -3,6 +3,9 @@ # Directories have been reordered according the execution time needed for a gfortran pdbg run using 2 MPI tasks # in case a new directory is added just add it at the top of the list.. # the order will be regularly checked and modified... +QS/regtest-cdft-3 parallel mpiranks>1 +QS/regtest-cdft-2 +QS/regtest-cdft-1 Fist/regtest-plumed2 plumed2 TMC/regtest_ana_on_the_fly parallel mpiranks>2 QS/regtest-sccs-3 diff --git a/tests/TEST_TYPES b/tests/TEST_TYPES index f500eb5f98..256945a520 100644 --- a/tests/TEST_TYPES +++ b/tests/TEST_TYPES @@ -1,4 +1,4 @@ -70 +74 Total energy:!3 POTENTIAL ENERGY!4 Total energy \[eV\]:!4 @@ -69,6 +69,10 @@ Energy Level: !9 TDDFPT|[[:space:]]*1 !3 Log(1-CN):!10 \ TEMPERATURE \[K\] !4 +Current value of constraint !6 +SUM OF ATOMIC FORCES !8 +Diabatic electronic coupling !5 +Diabatic coupling !7 # # these are the tests the can be selected for regtesting. # do regtest will grep for test_grep (first column) and look if the numeric value