Some improvements to the active space code (#5039)

This commit is contained in:
Frederick Stein 2026-04-02 13:46:51 +02:00 committed by GitHub
parent 7c0fd7cb22
commit 3db43b466e
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
7 changed files with 36 additions and 96 deletions

View file

@ -96,7 +96,9 @@ CONTAINS
CALL keyword_release(keyword)
CALL keyword_create(keyword, __LOCATION__, name="ACTIVE_ORBITAL_INDICES", &
description="The indices of the active orbitals. Requires ORBITAL_SELECTION MANUAL!", &
description="The indices of the active orbitals. Requires ORBITAL_SELECTION MANUAL! "// &
"Need to be as many indices as active orbitals times the number of spin "// &
"channels (2 if ROKS or UKS/LSD else 1).", &
usage="ACTIVE_ORBITAL_INDICES 2 3 {...}", n_var=-1, default_i_vals=[-1], &
type_of_var=integer_t)
CALL section_add_keyword(section, keyword)

View file

@ -122,8 +122,7 @@ MODULE qs_active_space_methods
csr_idx_from_combined, &
csr_idx_to_combined, &
eri_type, &
eri_type_eri_element_func, &
get_irange_csr
eri_type_eri_element_func
USE qs_active_space_utils, ONLY: eri_to_array, &
subspace_matrix_to_array
USE qs_collocate_density, ONLY: calculate_wavefunction
@ -1324,10 +1323,10 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_eri_gpw'
INTEGER :: col_local, color, handle, i1, i2, i3, i4, i_multigrid, icount2, intcount, &
irange(2), isp, isp1, isp2, ispin, iwa1, iwa12, iwa2, iwb1, iwb12, iwb2, iwbs, iwbt, &
iwfn, n_multigrid, ncol_global, ncol_local, nmm, nmo, nmo1, nmo2, nrow_global, &
nrow_local, nspins, number_of_subgroups, nx, row_local, stored_integrals
INTEGER :: col_local, color, handle, i1, i2, i3, i4, i_multigrid, icount2, intcount, isp, &
isp1, isp2, ispin, iwa1, iwa12, iwa2, iwb1, iwb12, iwb2, iwbs, iwbt, iwfn, n_multigrid, &
ncol_global, ncol_local, nmm, nmo, nmo1, nmo2, nrow_global, nrow_local, nspins, &
number_of_subgroups, nx, row_local, stored_integrals
INTEGER, ALLOCATABLE, DIMENSION(:) :: eri_index
INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
LOGICAL :: print1, print2, &
@ -1631,7 +1630,6 @@ CONTAINS
DO isp1 = 1, nspins
CALL get_mo_set(mo_set=mos(isp1), nmo=nmo1)
nmm = (nmo1*(nmo1 + 1))/2
irange = get_irange_csr(nmm, eri_env%comm_exchange)
DO i1 = 1, SIZE(orbitals, 1)
iwa1 = orbitals(i1, isp1)
IF (eri_env%eri_gpw%store_wfn) THEN
@ -1644,8 +1642,8 @@ CONTAINS
iwa2 = orbitals(i2, isp1)
iwa12 = csr_idx_to_combined(iwa1, iwa2, nmo1)
! Skip calculation directly if the pair is not part of our subgroup
IF (iwa12 < irange(1) .OR. iwa12 > irange(2)) CYCLE
iwa12 = iwa12 - irange(1) + 1
IF (MOD(iwa12 - 1, eri_env%comm_exchange%num_pe) /= eri_env%comm_exchange%mepos) CYCLE
iwa12 = (iwa12 - 1)/eri_env%comm_exchange%num_pe + 1
IF (eri_env%eri_gpw%store_wfn) THEN
wfn2 => wfn_a(iwa2, isp1)
ELSE
@ -2561,7 +2559,6 @@ CONTAINS
INTEGER :: handle, i1, i12, i12l, i2, i3, i34, &
i34l, i4, irptr, m1, m2, nindex, &
nmo_total, norb
INTEGER, DIMENSION(2) :: irange
REAL(dp) :: erint
TYPE(mp_comm_type) :: mp_group
@ -2572,14 +2569,13 @@ CONTAINS
nmo_total = SIZE(p_mat, 1)
nindex = (nmo_total*(nmo_total + 1))/2
CALL mp_group%set_handle(eri%mp_group%get_handle())
irange = get_irange_csr(nindex, comm_exchange)
DO m1 = 1, norb
i1 = active_orbitals(m1, 1)
DO m2 = m1, norb
i2 = active_orbitals(m2, 1)
i12 = csr_idx_to_combined(i1, i2, nmo_total)
IF (i12 >= irange(1) .AND. i12 <= irange(2)) THEN
i12l = i12 - irange(1) + 1
IF (MOD(i12 - 1, comm_exchange%num_pe) == comm_exchange%mepos) THEN
i12l = (i12 - 1)/comm_exchange%num_pe + 1
irptr = eri%rowptr_local(i12l) - 1
DO i34l = 1, eri%nzerow_local(i12l)
i34 = eri%colind_local(irptr + i34l)
@ -2651,7 +2647,6 @@ CONTAINS
INTEGER :: handle, i1, i12, i12l, i2, i3, i34, &
i34l, i4, irptr, m1, m2, nindex, &
nmo_total, norb, spin1, spin2
INTEGER, DIMENSION(2) :: irange
REAL(dp) :: erint
TYPE(mp_comm_type) :: mp_group
@ -2660,7 +2655,6 @@ CONTAINS
norb = SIZE(active_orbitals, 1)
nmo_total = SIZE(p_a_mat, 1)
nindex = (nmo_total*(nmo_total + 1))/2
irange = get_irange_csr(nindex, comm_exchange)
IF (tr_mixed_eri) THEN
spin1 = 2
spin2 = 1
@ -2673,8 +2667,8 @@ CONTAINS
DO m2 = m1, norb
i2 = active_orbitals(m2, spin1)
i12 = csr_idx_to_combined(i1, i2, nmo_total)
IF (i12 >= irange(1) .AND. i12 <= irange(2)) THEN
i12l = i12 - irange(1) + 1
IF (MOD(i12 - 1, comm_exchange%num_pe) == comm_exchange%mepos) THEN
i12l = (i12 - 1)/comm_exchange%num_pe + 1
irptr = eri_aa%rowptr_local(i12l) - 1
DO i34l = 1, eri_aa%nzerow_local(i12l)
i34 = eri_aa%colind_local(irptr + i34l)
@ -2709,14 +2703,13 @@ CONTAINS
END DO
!
irange = get_irange_csr(nindex, comm_exchange)
DO m1 = 1, norb
i1 = active_orbitals(m1, 1)
DO m2 = m1, norb
i2 = active_orbitals(m2, 1)
i12 = csr_idx_to_combined(i1, i2, nmo_total)
IF (i12 >= irange(1) .AND. i12 <= irange(2)) THEN
i12l = i12 - irange(1) + 1
IF (MOD(i12 - 1, comm_exchange%num_pe) == comm_exchange%mepos) THEN
i12l = (i12 - 1)/comm_exchange%num_pe + 1
irptr = eri_ab%rowptr_local(i12l) - 1
DO i34l = 1, eri_ab%nzerow_local(i12l)
i34 = eri_ab%colind_local(irptr + i34l)

View file

@ -36,7 +36,7 @@ MODULE qs_active_space_types
PUBLIC :: active_space_type, eri_type, eri_type_eri_element_func
PUBLIC :: create_active_space_type, release_active_space_type
PUBLIC :: csr_idx_to_combined, csr_idx_from_combined, get_irange_csr
PUBLIC :: csr_idx_to_combined, csr_idx_from_combined
! **************************************************************************************************
!> \brief Quantities needed for AS determination
@ -281,45 +281,6 @@ CONTAINS
END SUBROUTINE csr_idx_from_combined
! **************************************************************************************************
!> \brief calculates index range for processor in group mp_group
!> \param nindex the number of indices
!> \param mp_group message-passing group ID
!> \return a range tuple
!> \par History
!> 04.2016 created [JGH]
! **************************************************************************************************
FUNCTION get_irange_csr(nindex, mp_group) RESULT(irange)
USE message_passing, ONLY: mp_comm_type
INTEGER, INTENT(IN) :: nindex
CLASS(mp_comm_type), INTENT(IN) :: mp_group
INTEGER, DIMENSION(2) :: irange
REAL(KIND=dp) :: rat
ASSOCIATE (numtask => mp_group%num_pe, taskid => mp_group%mepos)
IF (numtask == 1 .AND. taskid == 0) THEN
irange(1) = 1
irange(2) = nindex
ELSEIF (numtask >= nindex) THEN
IF (taskid >= nindex) THEN
irange(1) = 1
irange(2) = 0
ELSE
irange(1) = taskid + 1
irange(2) = taskid + 1
END IF
ELSE
rat = REAL(nindex, KIND=dp)/REAL(numtask, KIND=dp)
irange(1) = NINT(rat*taskid) + 1
irange(2) = NINT(rat*taskid + rat)
END IF
END ASSOCIATE
END FUNCTION get_irange_csr
! **************************************************************************************************
!> \brief Calls the provided function for each element in the ERI
!> \param this object reference
@ -342,7 +303,7 @@ CONTAINS
CHARACTER(LEN=*), PARAMETER :: routineN = "eri_type_eri_foreach"
INTEGER :: i1, i12, i12l, i2, i3, i34, i34l, i4, m1, m2, m3, m4, &
irange(2), irptr, nspin, nindex, nmo, proc, nonzero_elements_local, handle, dummy_int(1)
irptr, nspin, nindex, nmo, proc, nonzero_elements_local, handle, dummy_int(1)
INTEGER, ALLOCATABLE, DIMENSION(:) :: colind, offsets, nonzero_elements_global
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: erival
REAL(KIND=dp) :: erint, dummy_real(1)
@ -365,7 +326,6 @@ CONTAINS
CALL mp_group%set_handle(eri%mp_group%get_handle())
nmo = SIZE(active_orbitals, 1)
! Irrelevant in case of half-transformed integrals
irange = get_irange_csr(nindex, this%comm_exchange)
ALLOCATE (erival(nindex), colind(nindex))
ALLOCATE (offsets(0:mp_group%num_pe - 1), &
nonzero_elements_global(0:mp_group%num_pe - 1))
@ -375,7 +335,7 @@ CONTAINS
DO m2 = m1, nmo
i2 = active_orbitals(m2, spin1)
i12 = csr_idx_to_combined(i1, i2, norb)
i12l = i12 - irange(1) + 1
i12l = (i12 - 1)/this%comm_exchange%num_pe + 1
! In case of half-transformed integrals, every process might carry integrals of a row
! The number of integrals varies between processes and rows (related to the randomized
@ -383,7 +343,8 @@ CONTAINS
! 1) Collect the amount of local data from each process
nonzero_elements_local = 0
IF (i12 >= irange(1) .AND. i12 <= irange(2)) nonzero_elements_local = eri%nzerow_local(i12l)
IF (MOD(i12 - 1, this%comm_exchange%num_pe) == this%comm_exchange%mepos) &
nonzero_elements_local = eri%nzerow_local(i12l)
CALL mp_group%allgather(nonzero_elements_local, nonzero_elements_global)
! 2) Prepare arrays for communication (calculate the offsets and the total number of elements)
@ -393,7 +354,7 @@ CONTAINS
END DO
nindex = offsets(mp_group%num_pe - 1) + nonzero_elements_global(mp_group%num_pe - 1)
irptr = 1
IF (i12 >= irange(1) .AND. i12 <= irange(2)) THEN
IF (MOD(i12 - 1, this%comm_exchange%num_pe) == this%comm_exchange%mepos) THEN
irptr = eri%rowptr_local(i12l)
! Exchange actual data

View file

@ -21,8 +21,7 @@ MODULE qs_active_space_utils
USE message_passing, ONLY: mp_comm_type
USE qs_active_space_types, ONLY: csr_idx_from_combined,&
csr_idx_to_combined,&
eri_type,&
get_irange_csr
eri_type
#include "./base/base_uses.f90"
IMPLICIT NONE
@ -92,7 +91,6 @@ CONTAINS
ijkl, ijlk, irptr, j, jikl, jilk, k, &
klij, klji, l, lkij, lkji, nindex, &
nmo_active, nmo_max
INTEGER, DIMENSION(2) :: irange
REAL(KIND=dp) :: erival
TYPE(dbcsr_csr_type), POINTER :: eri
TYPE(mp_comm_type) :: mp_group
@ -109,7 +107,6 @@ CONTAINS
END IF
CALL mp_group%set_handle(eri%mp_group%get_handle())
irange = get_irange_csr(nindex, mp_group)
array = 0.0_dp
@ -118,8 +115,8 @@ CONTAINS
DO j = i, nmo_active
i2 = active_orbitals(j, spin1)
i12 = csr_idx_to_combined(i1, i2, nmo_max)
IF (i12 >= irange(1) .AND. i12 <= irange(2)) THEN
i12l = i12 - irange(1) + 1
IF (MOD(i12 - 1, eri_env%comm_exchange%num_pe) == eri_env%comm_exchange%mepos) THEN
i12l = (i12 - 1)/eri_env%comm_exchange%num_pe + 1
irptr = eri%rowptr_local(i12l) - 1
DO i34l = 1, eri%nzerow_local(i12l)
i34 = eri%colind_local(irptr + i34l)

View file

@ -1005,9 +1005,9 @@ CONTAINS
! Note (TL) : even the new DCD format is unfortunately too poor
! for our capabilities.. for example here the printing
! of the geometry could be nested inside several iteration
! levels.. this cannot be exactly reproduce with DCD.
! levels.. this cannot be exactly reproduced with DCD.
! Just as a compromise let's pick-up the value of the MD iteration
! level. In any case this is not any sensible information for the standard..
! level. In any case this is not any sensible information for the standard.
iskip = section_get_ival(print_key, "EACH%MD")
WRITE (iunit) "CORD", 0, -1, iskip, &
0, 0, 0, 0, 0, 0, REAL(0, KIND=sp), 1, 0, 0, 0, 0, 0, 0, 0, 0, 24

View file

@ -105,16 +105,12 @@ CONTAINS
CALL timestop(handle)
END SUBROUTINE ot_scf_read_input
! **************************************************************************************************
!
! performs the actual minimisation, needs only limited info
! updated for restricted calculations
! matrix_dedc is the derivative of the energy with respect to the orbitals (except for a factor 2*fi)
! a null pointer for matrix_s implies that matrix_s is the unit matrix
!
!
! **************************************************************************************************
!> \brief ...
!> \brief performs the actual minimisation, needs only limited info
!> updated for restricted calculations
!> matrix_dedc is the derivative of the energy with respect to the orbitals (except for a factor 2*fi)
!> a null pointer for matrix_s implies that matrix_s is the unit matrix
!> \param mo_array ...
!> \param matrix_dedc ...
!> \param smear ...
@ -339,12 +335,10 @@ CONTAINS
CALL timestop(handle)
END SUBROUTINE ot_scf_mini
!
! initialises qs_ot_env so that mo_coeff is the current point
! and that the mimizization can be started.
!
! **************************************************************************************************
!> \brief ...
!> \brief initialises qs_ot_env so that mo_coeff is the current point
!> and that the minization can be started.
!> \param mo_array ...
!> \param matrix_s ...
!> \param qs_ot_env ...

View file

@ -548,10 +548,8 @@ CONTAINS
END IF
END SUBROUTINE print_density_output_message
! **************************************************************************************************
!> \brief collects possible post - scf calculations and prints info / computes properties.
! **************************************************************************************************
!> \brief ...
!> \brief collects possible post - scf calculations and prints info / computes properties.
!> \param qs_env the qs_env in which the qs_env lives
!> \param wf_type ...
!> \param do_mp2 ...
@ -1045,11 +1043,6 @@ CONTAINS
CALL cp_fm_release(mixed_localized)
DEALLOCATE (mixed_orbs)
DEALLOCATE (mixed_evals)
! Print Total Dipole if the localization has been performed
! Revisit the formalism later
!IF (qs_loc_env_mixed%do_localize) THEN
! CALL loc_dipole(input, dft_control, qs_loc_env_mixed, logger, qs_env)
!END IF
END IF
END IF