hessian_worker Module Subroutine

module subroutine hessian_worker(world_comm, sys_geom, config)

Uses

  • proc~~hessian_worker~~UsesGraph proc~hessian_worker hessian_worker module~mqc_finite_differences mqc_finite_differences proc~hessian_worker->module~mqc_finite_differences module~mqc_method_base mqc_method_base proc~hessian_worker->module~mqc_method_base module~mqc_method_factory mqc_method_factory proc~hessian_worker->module~mqc_method_factory module~mqc_calculation_defaults mqc_calculation_defaults module~mqc_finite_differences->module~mqc_calculation_defaults module~mqc_physical_fragment mqc_physical_fragment module~mqc_finite_differences->module~mqc_physical_fragment pic_types pic_types module~mqc_finite_differences->pic_types module~mqc_method_base->module~mqc_physical_fragment module~mqc_result_types mqc_result_types module~mqc_method_base->module~mqc_result_types module~mqc_method_base->pic_types module~mqc_method_factory->module~mqc_method_base mctc_env mctc_env module~mqc_method_factory->mctc_env module~mqc_method_config mqc_method_config module~mqc_method_factory->module~mqc_method_config module~mqc_method_dft mqc_method_dft module~mqc_method_factory->module~mqc_method_dft module~mqc_method_hf mqc_method_hf module~mqc_method_factory->module~mqc_method_hf module~mqc_method_mcscf mqc_method_mcscf module~mqc_method_factory->module~mqc_method_mcscf module~mqc_method_types mqc_method_types module~mqc_method_factory->module~mqc_method_types module~mqc_method_xtb mqc_method_xtb module~mqc_method_factory->module~mqc_method_xtb module~mqc_method_factory->pic_types module~mqc_calculation_defaults->pic_types module~mqc_method_config->module~mqc_method_types module~mqc_method_config->pic_types module~mqc_method_dft->module~mqc_method_base module~mqc_method_dft->module~mqc_physical_fragment module~mqc_method_dft->module~mqc_result_types module~mqc_method_dft->pic_types module~mqc_method_hf->module~mqc_method_base module~mqc_method_hf->module~mqc_physical_fragment module~mqc_method_hf->module~mqc_result_types module~mqc_method_hf->pic_types module~mqc_method_mcscf->module~mqc_method_base module~mqc_method_mcscf->module~mqc_physical_fragment module~mqc_method_mcscf->module~mqc_result_types module~mqc_method_mcscf->pic_types module~mqc_method_types->pic_types module~mqc_method_xtb->module~mqc_method_base module~mqc_method_xtb->mctc_env module~mqc_method_xtb->module~mqc_physical_fragment module~mqc_method_xtb->module~mqc_result_types module~mqc_method_xtb->pic_types mctc_io mctc_io module~mqc_method_xtb->mctc_io module~mqc_error mqc_error module~mqc_method_xtb->module~mqc_error pic_logger pic_logger module~mqc_method_xtb->pic_logger pic_timer pic_timer module~mqc_method_xtb->pic_timer tblite_container tblite_container module~mqc_method_xtb->tblite_container tblite_context_type tblite_context_type module~mqc_method_xtb->tblite_context_type tblite_solvation tblite_solvation module~mqc_method_xtb->tblite_solvation tblite_wavefunction tblite_wavefunction module~mqc_method_xtb->tblite_wavefunction tblite_xtb_calculator tblite_xtb_calculator module~mqc_method_xtb->tblite_xtb_calculator tblite_xtb_gfn1 tblite_xtb_gfn1 module~mqc_method_xtb->tblite_xtb_gfn1 tblite_xtb_gfn2 tblite_xtb_gfn2 module~mqc_method_xtb->tblite_xtb_gfn2 tblite_xtb_singlepoint tblite_xtb_singlepoint module~mqc_method_xtb->tblite_xtb_singlepoint module~mqc_physical_fragment->pic_types 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_physical_fragment->module~mqc_error 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 module~mqc_result_types->pic_types module~mqc_result_types->module~mqc_error pic_mpi_lib pic_mpi_lib module~mqc_result_types->pic_mpi_lib 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->pic_types module~mqc_xyz_reader->module~mqc_error module~mqc_xyz_reader->module~mqc_geometry

Worker for distributed Hessian calculation Requests displacement indices, computes gradients, and sends results back

Arguments

Type IntentOptional Attributes Name
type(comm_t), intent(in) :: world_comm
type(system_geometry_t), intent(in) :: sys_geom
type(driver_config_t), intent(in) :: config

Driver configuration

Calls

proc~~hessian_worker~~CallsGraph proc~hessian_worker hessian_worker abort_comm abort_comm proc~hessian_worker->abort_comm calc_gradient calc_gradient proc~hessian_worker->calc_gradient error error proc~hessian_worker->error irecv irecv proc~hessian_worker->irecv isend isend proc~hessian_worker->isend proc~copy_and_displace_geometry copy_and_displace_geometry proc~hessian_worker->proc~copy_and_displace_geometry proc~create_method create_method proc~hessian_worker->proc~create_method proc~error_get_message error_t%error_get_message proc~hessian_worker->proc~error_get_message proc~fragment_compute_nelec physical_fragment_t%fragment_compute_nelec proc~hessian_worker->proc~fragment_compute_nelec proc~result_destroy calculation_result_t%result_destroy proc~hessian_worker->proc~result_destroy send send proc~hessian_worker->send to_char to_char proc~hessian_worker->to_char proc~factory_create method_factory_t%factory_create proc~create_method->proc~factory_create proc~result_reset calculation_result_t%result_reset proc~result_destroy->proc~result_reset proc~configure_dft configure_dft proc~factory_create->proc~configure_dft proc~configure_hf configure_hf proc~factory_create->proc~configure_hf proc~configure_mcscf configure_mcscf proc~factory_create->proc~configure_mcscf proc~configure_xtb configure_xtb proc~factory_create->proc~configure_xtb proc~energy_reset energy_t%energy_reset proc~result_reset->proc~energy_reset proc~error_clear error_t%error_clear proc~result_reset->proc~error_clear state_weights state_weights proc~configure_mcscf->state_weights proc~method_type_to_string method_type_to_string proc~configure_xtb->proc~method_type_to_string proc~xtb_has_solvation xtb_config_t%xtb_has_solvation proc~configure_xtb->proc~xtb_has_solvation proc~mp2_reset mp2_energy_t%mp2_reset proc~energy_reset->proc~mp2_reset

Called by

proc~~hessian_worker~~CalledByGraph proc~hessian_worker hessian_worker interface~hessian_worker hessian_worker interface~hessian_worker->proc~hessian_worker proc~distributed_unfragmented_hessian distributed_unfragmented_hessian proc~distributed_unfragmented_hessian->interface~hessian_worker interface~distributed_unfragmented_hessian distributed_unfragmented_hessian interface~distributed_unfragmented_hessian->proc~distributed_unfragmented_hessian proc~run_unfragmented_calculation run_unfragmented_calculation proc~run_unfragmented_calculation->interface~distributed_unfragmented_hessian proc~run_calculation run_calculation proc~run_calculation->proc~run_unfragmented_calculation

Variables

Type Visibility Attributes Name Initial
integer, private :: atom_idx
class(qc_method_t), private, allocatable :: calculator

Polymorphic calculator
integer, private :: coord
integer, private :: disp_idx
type(physical_fragment_t), private :: displaced_geom
integer, private :: dummy_msg
type(physical_fragment_t), private :: full_system
type(calculation_result_t), private :: grad_result
integer, private :: gradient_type
type(method_config_t), private :: local_config

Local copy for verbose override
integer, private :: n_atoms
type(request_t), private :: req
type(MPI_Status), private :: status

Source Code

   module subroutine hessian_worker(world_comm, sys_geom, config)
      !! Worker for distributed Hessian calculation
      !! Requests displacement indices, computes gradients, and sends results back
      use mqc_finite_differences, only: copy_and_displace_geometry
      use mqc_method_base, only: qc_method_t
      use mqc_method_factory, only: create_method

      type(comm_t), intent(in) :: world_comm
      type(system_geometry_t), intent(in) :: sys_geom
      type(driver_config_t), intent(in) :: config  !! Driver configuration

      type(physical_fragment_t) :: full_system, displaced_geom
      type(calculation_result_t) :: grad_result
      integer :: n_atoms, disp_idx, atom_idx, coord, gradient_type, dummy_msg
      type(MPI_Status) :: status
      type(request_t) :: req
      class(qc_method_t), allocatable :: calculator  !! Polymorphic calculator
      type(method_config_t) :: local_config  !! Local copy for verbose override

      n_atoms = sys_geom%total_atoms

      ! Build full system geometry
      full_system%n_atoms = n_atoms
      full_system%n_caps = 0
      allocate (full_system%element_numbers(n_atoms))
      allocate (full_system%coordinates(3, n_atoms))
      full_system%element_numbers = sys_geom%element_numbers
      full_system%coordinates = sys_geom%coordinates
      full_system%charge = sys_geom%charge
      full_system%multiplicity = sys_geom%multiplicity
      call full_system%compute_nelec()

      ! Create calculator using factory
      local_config = config%method_config
      local_config%verbose = .false.
      calculator = create_method(local_config)

      dummy_msg = 0
      do
         ! Request work from coordinator
         call isend(world_comm, dummy_msg, 0, TAG_WORKER_REQUEST, req)
         call wait(req)
         call irecv(world_comm, disp_idx, 0, MPI_ANY_TAG, req)
         call wait(req, status)

         if (status%MPI_TAG == TAG_WORKER_FINISH) exit

         ! Compute displacement index to atom and coordinate
         atom_idx = (disp_idx - 1)/3 + 1
         coord = mod(disp_idx - 1, 3) + 1

         ! Compute FORWARD gradient
         call copy_and_displace_geometry(full_system, atom_idx, coord, config%hessian%displacement, displaced_geom)
         call calculator%calc_gradient(displaced_geom, grad_result)

         if (grad_result%has_error) then
            call logger%error("Worker gradient calculation error for forward displacement "// &
                              to_char(disp_idx)//": "//grad_result%error%get_message())
            call abort_comm(world_comm, 1)
         end if
         if (.not. grad_result%has_gradient) then
            call logger%error("Worker failed gradient for forward displacement "//to_char(disp_idx))
            call abort_comm(world_comm, 1)
         end if

         ! Send: displacement index, gradient type (1=forward), gradient data, dipole flag, dipole
         gradient_type = 1
         call isend(world_comm, disp_idx, 0, TAG_WORKER_SCALAR_RESULT, req)
         call wait(req)
         call isend(world_comm, gradient_type, 0, TAG_WORKER_SCALAR_RESULT, req)
         call wait(req)
         call send(world_comm, grad_result%gradient, 0, TAG_WORKER_SCALAR_RESULT)
         call send(world_comm, grad_result%has_dipole, 0, TAG_WORKER_SCALAR_RESULT)
         if (grad_result%has_dipole) then
            call send(world_comm, grad_result%dipole, 0, TAG_WORKER_SCALAR_RESULT)
         end if

         call grad_result%destroy()
         call displaced_geom%destroy()

         ! Compute BACKWARD gradient
         call copy_and_displace_geometry(full_system, atom_idx, coord, -config%hessian%displacement, displaced_geom)
         call calculator%calc_gradient(displaced_geom, grad_result)

         if (grad_result%has_error) then
            call logger%error("Worker gradient calculation error for backward displacement "// &
                              to_char(disp_idx)//": "//grad_result%error%get_message())
            call abort_comm(world_comm, 1)
         end if
         if (.not. grad_result%has_gradient) then
            call logger%error("Worker failed gradient for backward displacement "//to_char(disp_idx))
            call abort_comm(world_comm, 1)
         end if

         ! Send: displacement index, gradient type (2=backward), gradient data, dipole flag, dipole
         gradient_type = 2
         call isend(world_comm, disp_idx, 0, TAG_WORKER_SCALAR_RESULT, req)
         call wait(req)
         call isend(world_comm, gradient_type, 0, TAG_WORKER_SCALAR_RESULT, req)
         call wait(req)
         call send(world_comm, grad_result%gradient, 0, TAG_WORKER_SCALAR_RESULT)
         call send(world_comm, grad_result%has_dipole, 0, TAG_WORKER_SCALAR_RESULT)
         if (grad_result%has_dipole) then
            call send(world_comm, grad_result%dipole, 0, TAG_WORKER_SCALAR_RESULT)
         end if

         call grad_result%destroy()
         call displaced_geom%destroy()
      end do

      ! Cleanup
      deallocate (calculator)

   end subroutine hessian_worker