compute_mbe_gradient Subroutine

private subroutine compute_mbe_gradient(fragment_idx, fragment, lookup, results, delta_gradients, n, sys_geom, world_comm)

Uses

  • proc~~compute_mbe_gradient~~UsesGraph proc~compute_mbe_gradient compute_mbe_gradient module~mqc_result_types mqc_result_types proc~compute_mbe_gradient->module~mqc_result_types module~mqc_error mqc_error module~mqc_result_types->module~mqc_error pic_mpi_lib pic_mpi_lib module~mqc_result_types->pic_mpi_lib pic_types pic_types module~mqc_result_types->pic_types

Bottom-up computation of n-body gradient correction Exactly mirrors the energy MBE logic: deltaG = G - sum(all subset deltaGs) All gradients are in system coordinates, so subtraction is simple Bond connectivity is accessed via sys_geom%bonds

Arguments

Type IntentOptional Attributes Name
integer(kind=int64), intent(in) :: fragment_idx
integer, intent(in) :: fragment(:)
type(fragment_lookup_t), intent(in) :: lookup
type(calculation_result_t), intent(in) :: results(:)
real(kind=dp), intent(inout) :: delta_gradients(:,:,:)

(3, total_atoms, fragment_count)
integer, intent(in) :: n
type(system_geometry_t), intent(in) :: sys_geom
type(comm_t), intent(in), optional :: world_comm

MPI communicator for abort

Calls

proc~~compute_mbe_gradient~~CallsGraph proc~compute_mbe_gradient compute_mbe_gradient abort_comm abort_comm proc~compute_mbe_gradient->abort_comm error error proc~compute_mbe_gradient->error proc~fragment_lookup_find fragment_lookup_t%fragment_lookup_find proc~compute_mbe_gradient->proc~fragment_lookup_find proc~get_next_combination get_next_combination proc~compute_mbe_gradient->proc~get_next_combination proc~map_fragment_to_system_gradient map_fragment_to_system_gradient proc~compute_mbe_gradient->proc~map_fragment_to_system_gradient fnv_1a_hash fnv_1a_hash proc~fragment_lookup_find->fnv_1a_hash proc~arrays_equal_internal arrays_equal_internal proc~fragment_lookup_find->proc~arrays_equal_internal sort sort proc~fragment_lookup_find->sort proc~map_fragment_to_system_gradient->abort_comm proc~map_fragment_to_system_gradient->error configuration configuration proc~map_fragment_to_system_gradient->configuration debug debug proc~map_fragment_to_system_gradient->debug proc~build_fragment_from_indices build_fragment_from_indices proc~map_fragment_to_system_gradient->proc~build_fragment_from_indices proc~error_get_full_trace error_t%error_get_full_trace proc~map_fragment_to_system_gradient->proc~error_get_full_trace proc~error_has_error error_t%error_has_error proc~map_fragment_to_system_gradient->proc~error_has_error proc~fragment_destroy physical_fragment_t%fragment_destroy proc~map_fragment_to_system_gradient->proc~fragment_destroy proc~redistribute_cap_gradients redistribute_cap_gradients proc~map_fragment_to_system_gradient->proc~redistribute_cap_gradients proc~build_fragment_from_indices->proc~error_has_error proc~add_hydrogen_caps add_hydrogen_caps proc~build_fragment_from_indices->proc~add_hydrogen_caps proc~calculate_monomer_distance calculate_monomer_distance proc~build_fragment_from_indices->proc~calculate_monomer_distance proc~check_duplicate_atoms check_duplicate_atoms proc~build_fragment_from_indices->proc~check_duplicate_atoms proc~count_hydrogen_caps count_hydrogen_caps proc~build_fragment_from_indices->proc~count_hydrogen_caps proc~error_add_context error_t%error_add_context proc~build_fragment_from_indices->proc~error_add_context proc~fragment_compute_nelec physical_fragment_t%fragment_compute_nelec proc~build_fragment_from_indices->proc~fragment_compute_nelec proc~error_get_full_trace->proc~error_has_error proc~basis_set_destroy molecular_basis_type%basis_set_destroy proc~fragment_destroy->proc~basis_set_destroy proc~atomic_basis_destroy atomic_basis_type%atomic_basis_destroy proc~basis_set_destroy->proc~atomic_basis_destroy proc~to_angstrom to_angstrom proc~calculate_monomer_distance->proc~to_angstrom proc~check_duplicate_atoms->error proc~element_number_to_symbol element_number_to_symbol proc~check_duplicate_atoms->proc~element_number_to_symbol proc~error_set error_t%error_set proc~check_duplicate_atoms->proc~error_set to_char to_char proc~check_duplicate_atoms->to_char proc~cgto_destroy cgto_type%cgto_destroy proc~atomic_basis_destroy->proc~cgto_destroy

Called by

proc~~compute_mbe_gradient~~CalledByGraph proc~compute_mbe_gradient compute_mbe_gradient proc~compute_mbe compute_mbe proc~compute_mbe->proc~compute_mbe_gradient proc~global_coordinator global_coordinator proc~global_coordinator->proc~compute_mbe proc~serial_fragment_processor serial_fragment_processor proc~serial_fragment_processor->proc~compute_mbe interface~global_coordinator global_coordinator interface~global_coordinator->proc~global_coordinator interface~serial_fragment_processor serial_fragment_processor interface~serial_fragment_processor->proc~serial_fragment_processor proc~mbe_run_distributed mbe_context_t%mbe_run_distributed proc~mbe_run_distributed->interface~global_coordinator proc~mbe_run_serial mbe_context_t%mbe_run_serial proc~mbe_run_serial->interface~serial_fragment_processor

Variables

Type Visibility Attributes Name Initial
logical, private :: has_next
integer, private :: i
integer, private :: indices(MAX_MBE_LEVEL)
integer, private :: subset(MAX_MBE_LEVEL)
integer(kind=int64), private :: subset_idx
integer, private :: subset_size

Source Code

   subroutine compute_mbe_gradient(fragment_idx, fragment, lookup, results, delta_gradients, n, sys_geom, world_comm)
      !! Bottom-up computation of n-body gradient correction
      !! Exactly mirrors the energy MBE logic: deltaG = G - sum(all subset deltaGs)
      !! All gradients are in system coordinates, so subtraction is simple
      !! Bond connectivity is accessed via sys_geom%bonds
      use mqc_result_types, only: calculation_result_t
      integer(int64), intent(in) :: fragment_idx
      integer, intent(in) :: fragment(:), n
      type(fragment_lookup_t), intent(in) :: lookup
      type(calculation_result_t), intent(in) :: results(:)
      real(dp), intent(inout) :: delta_gradients(:, :, :)  !! (3, total_atoms, fragment_count)
      type(system_geometry_t), intent(in) :: sys_geom
      type(comm_t), intent(in), optional :: world_comm  !! MPI communicator for abort

      integer :: subset_size, i
      integer :: indices(MAX_MBE_LEVEL), subset(MAX_MBE_LEVEL)  ! Stack arrays to avoid heap contention
      integer(int64) :: subset_idx
      logical :: has_next

      ! Start with the full n-mer gradient mapped to system coordinates
      call map_fragment_to_system_gradient(results(fragment_idx)%gradient, fragment, &
                                           sys_geom, delta_gradients(:, :, fragment_idx), world_comm)

      ! Subtract all proper subsets (size 1 to n-1)
      ! This is EXACTLY like the energy calculation, but for each gradient component
      do subset_size = 1, n - 1
         ! Initialize first combination
         do i = 1, subset_size
            indices(i) = i
         end do

         ! Loop through all combinations
         do
            ! Build current subset
            do i = 1, subset_size
               subset(i) = fragment(indices(i))
            end do

            ! Look up subset index
            subset_idx = lookup%find(subset(1:subset_size), subset_size)
            if (subset_idx < 0) then
               call logger%error("Subset not found in MBE gradient computation")
               if (present(world_comm)) then
                  call abort_comm(world_comm, 1)
               else
                  error stop "Subset not found in MBE gradient!"
               end if
            end if

            ! Subtract pre-computed delta gradient (simple array subtraction in system coords)
            delta_gradients(:, :, fragment_idx) = delta_gradients(:, :, fragment_idx) - &
                                                  delta_gradients(:, :, subset_idx)

            ! Get next combination
            call get_next_combination(indices, subset_size, n, has_next)
            if (.not. has_next) exit
         end do
      end do

   end subroutine compute_mbe_gradient