map_fragment_to_system_hessian Subroutine

private subroutine map_fragment_to_system_hessian(frag_hess, monomers, sys_geom, sys_hess)

Uses

  • proc~~map_fragment_to_system_hessian~~UsesGraph proc~map_fragment_to_system_hessian map_fragment_to_system_hessian module~mqc_error mqc_error proc~map_fragment_to_system_hessian->module~mqc_error module~mqc_physical_fragment mqc_physical_fragment proc~map_fragment_to_system_hessian->module~mqc_physical_fragment module~mqc_physical_fragment->module~mqc_error module~mqc_cgto mqc_cgto module~mqc_physical_fragment->module~mqc_cgto module~mqc_elements mqc_elements module~mqc_physical_fragment->module~mqc_elements module~mqc_geometry mqc_geometry module~mqc_physical_fragment->module~mqc_geometry module~mqc_physical_constants mqc_physical_constants module~mqc_physical_fragment->module~mqc_physical_constants module~mqc_xyz_reader mqc_xyz_reader module~mqc_physical_fragment->module~mqc_xyz_reader pic_types pic_types module~mqc_physical_fragment->pic_types module~mqc_cgto->pic_types module~mqc_elements->pic_types pic_ascii pic_ascii module~mqc_elements->pic_ascii module~mqc_geometry->pic_types module~mqc_physical_constants->pic_types module~mqc_xyz_reader->module~mqc_error module~mqc_xyz_reader->module~mqc_geometry module~mqc_xyz_reader->pic_types

Map fragment Hessian to system Hessian coordinates with hydrogen cap redistribution Bond connectivity is accessed via sys_geom%bonds

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in) :: frag_hess(:,:)

(3natoms_frag, 3natoms_frag)
integer, intent(in) :: monomers(:)
type(system_geometry_t), intent(in) :: sys_geom
real(kind=dp), intent(inout) :: sys_hess(:,:)

(3total_atoms, 3total_atoms)

Calls

proc~~map_fragment_to_system_hessian~~CallsGraph proc~map_fragment_to_system_hessian map_fragment_to_system_hessian 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~~map_fragment_to_system_hessian~~CalledByGraph proc~map_fragment_to_system_hessian map_fragment_to_system_hessian proc~compute_mbe compute_mbe proc~compute_mbe->proc~map_fragment_to_system_hessian proc~compute_mbe_hessian compute_mbe_hessian proc~compute_mbe->proc~compute_mbe_hessian proc~compute_mbe_hessian->proc~map_fragment_to_system_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
type(error_t), private :: error
type(physical_fragment_t), private :: fragment

Source Code

   subroutine map_fragment_to_system_hessian(frag_hess, monomers, sys_geom, sys_hess)
      !! Map fragment Hessian to system Hessian coordinates with hydrogen cap redistribution
      !! Bond connectivity is accessed via sys_geom%bonds
      use mqc_physical_fragment, only: build_fragment_from_indices, redistribute_cap_hessian
      use mqc_error, only: error_t
      real(dp), intent(in) :: frag_hess(:, :)  !! (3*natoms_frag, 3*natoms_frag)
      integer, intent(in) :: monomers(:)
      type(system_geometry_t), intent(in) :: sys_geom
      real(dp), intent(inout) :: sys_hess(:, :)  !! (3*total_atoms, 3*total_atoms)

      type(physical_fragment_t) :: fragment
      type(error_t) :: error

      ! Zero out
      sys_hess = 0.0_dp

      if (allocated(sys_geom%bonds)) then
         ! Rebuild fragment to get local→global mapping and cap information
         call build_fragment_from_indices(sys_geom, monomers, fragment, error, sys_geom%bonds)
         call redistribute_cap_hessian(fragment, frag_hess, sys_hess)
         call fragment%destroy()
      else
         ! Old code path for fragments without hydrogen caps
         ! Map fragment Hessian to system positions (fixed-size monomers only)
         block
            integer :: i_mon, j_mon, i_atom, j_atom
            integer :: frag_atom_i, frag_atom_j, sys_atom_i, sys_atom_j
            integer :: frag_row_start, frag_col_start, sys_row_start, sys_col_start
            integer :: n_monomers

            n_monomers = size(monomers)
            frag_atom_i = 0

            ! Map each monomer's atoms
            do i_mon = 1, n_monomers
               do i_atom = 1, sys_geom%atoms_per_monomer
                  frag_atom_i = frag_atom_i + 1
                  sys_atom_i = (monomers(i_mon) - 1)*sys_geom%atoms_per_monomer + i_atom
                  frag_row_start = (frag_atom_i - 1)*3 + 1
                  sys_row_start = (sys_atom_i - 1)*3 + 1

                  ! Map this atom's Hessian blocks with all other atoms in fragment
                  frag_atom_j = 0
                  do j_mon = 1, n_monomers
                     do j_atom = 1, sys_geom%atoms_per_monomer
                        frag_atom_j = frag_atom_j + 1
                        sys_atom_j = (monomers(j_mon) - 1)*sys_geom%atoms_per_monomer + j_atom
                        frag_col_start = (frag_atom_j - 1)*3 + 1
                        sys_col_start = (sys_atom_j - 1)*3 + 1

                        ! Copy the 3×3 block for this atom pair
                        sys_hess(sys_row_start:sys_row_start + 2, sys_col_start:sys_col_start + 2) = &
                           frag_hess(frag_row_start:frag_row_start + 2, frag_col_start:frag_col_start + 2)
                     end do
                  end do
               end do
            end do
         end block
      end if

   end subroutine map_fragment_to_system_hessian