compute_mbe_hessian Subroutine

private subroutine compute_mbe_hessian(fragment_idx, fragment, lookup, results, delta_hessians, n, sys_geom)

Uses

  • proc~~compute_mbe_hessian~~UsesGraph proc~compute_mbe_hessian compute_mbe_hessian module~mqc_error mqc_error proc~compute_mbe_hessian->module~mqc_error module~mqc_result_types mqc_result_types proc~compute_mbe_hessian->module~mqc_result_types 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 Hessian correction Mirrors MBE gradient logic but for second derivatives 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_hessians(:,:,:)

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

Calls

proc~~compute_mbe_hessian~~CallsGraph proc~compute_mbe_hessian compute_mbe_hessian proc~fragment_lookup_find fragment_lookup_t%fragment_lookup_find proc~compute_mbe_hessian->proc~fragment_lookup_find proc~get_next_combination get_next_combination proc~compute_mbe_hessian->proc~get_next_combination proc~map_fragment_to_system_hessian map_fragment_to_system_hessian proc~compute_mbe_hessian->proc~map_fragment_to_system_hessian 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~build_fragment_from_indices build_fragment_from_indices proc~map_fragment_to_system_hessian->proc~build_fragment_from_indices proc~fragment_destroy physical_fragment_t%fragment_destroy proc~map_fragment_to_system_hessian->proc~fragment_destroy proc~redistribute_cap_hessian redistribute_cap_hessian proc~map_fragment_to_system_hessian->proc~redistribute_cap_hessian 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~error_has_error error_t%error_has_error proc~build_fragment_from_indices->proc~error_has_error proc~fragment_compute_nelec physical_fragment_t%fragment_compute_nelec proc~build_fragment_from_indices->proc~fragment_compute_nelec 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 error error 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_hessian~~CalledByGraph proc~compute_mbe_hessian compute_mbe_hessian proc~compute_mbe compute_mbe proc~compute_mbe->proc~compute_mbe_hessian 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 :: hess_dim
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_hessian(fragment_idx, fragment, lookup, results, delta_hessians, n, sys_geom)
      !! Bottom-up computation of n-body Hessian correction
      !! Mirrors MBE gradient logic but for second derivatives
      !! Bond connectivity is accessed via sys_geom%bonds
      use mqc_result_types, only: calculation_result_t
      use mqc_error, only: error_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_hessians(:, :, :)  !! (3*total_atoms, 3*total_atoms, fragment_count)
      type(system_geometry_t), intent(in) :: sys_geom

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

      hess_dim = 3*sys_geom%total_atoms

      ! Start with the full n-mer Hessian mapped to system coordinates
      call map_fragment_to_system_hessian(results(fragment_idx)%hessian, fragment, &
                                          sys_geom, delta_hessians(:, :, fragment_idx))

      ! Subtract all proper subsets (size 1 to n-1)
      do subset_size = 1, n - 1
         ! Initialize first combination
         do i = 1, subset_size
            indices(i) = i
         end do

         has_next = .true.
         do while (has_next)
            do i = 1, subset_size
               subset(i) = fragment(indices(i))
            end do
            subset_idx = lookup%find(subset(1:subset_size), subset_size)

            if (subset_idx > 0) then
               ! Subtract this subset's delta Hessian
               delta_hessians(:, :, fragment_idx) = delta_hessians(:, :, fragment_idx) - &
                                                    delta_hessians(:, :, subset_idx)
            end if

            call get_next_combination(indices, subset_size, n, has_next)
         end do
      end do

   end subroutine compute_mbe_hessian